!PRIM+PERM FOR IMP15 COMPILER !NUMERIC MCODE ADDRESSES 0:3 & 256:287 REFER TO COMM. TABLE (0:31) ! 256/0: NEST POINTER (256 MUST BE USED FOR VALUE) ! 257/1: WL A (MOSTLY 2ND PARAM) ! 258/2: WL B (MOSTLY 1ST PARAM) ! 259/3: WL C (MOSTLY ARRAY ELEMENT AD: NON-ZERO EXCEPT AS INDIC) ! 260: INPUT STREAM ! 261: OUTPUT STREAM ! 262: INPUT SR AD ! 263: OUTPUT SR AD ! 264: SPARE ! 265: STREAM TABLE AD ! 266: LOWER STORE LIMIT AD ! 267: DT HANDLER AD (FOR DA) ! 268: ERROR HANDLER AD (FOR DA) ! 272 (2) 286: INPUT STREAM SLOTS ! 273 (2) 287: OUTPUT STREAM SLOTS !INITIAL DECLARATION IS KNOWN TO LOADER %INTEGER A,B,C; !WORKING LOCATIONS %ROUTINE D; !MONITOR %OWNINTEGER N=-14 %LAC* 262; %DAC C; !SAVE LAST CHAR L1: %OPR 6145;!CLL!CLC; !CLOSE ALL FILES L2: %JMS* 274 %ISZ L2; %ISZ N; %JMP L1 %END; !EXIT TO CAL %ROUTINE E; !NEST %INTEGER Z %DAC B %LAC* 256; %DAC Z; !NEST POINTER %SAD* 266; %JMP L1; !MONITOR IF NP = LIM %TAD #-1; %DAC* 256; !DECREMENT %LAC B; %DAC* Z %RETURN L1: %JMS* D; %LIT 4; !MONITOR 4 %END %ROUTINE F; !SET LINK IF B <= AC %DAC A %OPR 2049;!CLL!CMA; %ADD B %TAD #-131072 %LAC A; !RESTORE AC %END %ROUTINE G; !SET LINK IF B >= AC %DAC A; %LAC B %OPR 2049;!CLL!CMA; %ADD A %TAD #-131072 %LAC A; !RESTORE AC %END %ROUTINE H; !ARRAY REFERENCE %DAC A; !INDEX %XCT* H; %DAC C; !BASE ADDRESS %LAC A; %TAD* C; !INDEX-UPPER %OPR 192;!SMA!SZA; %JMP L1; !SHOULD BE <= 0 %ISZ C; %TAD* C; !+LENGTH %OPR 704;!SPA!SNA; %JMP L1; !SHOULD BE > 0 %TAD C; %DAC C; !AD OF ELEMENT %ISZ H; !BUMP PAST PARAM %RETURN L1: %JMS* D; %LIT 160; !MONITOR 32 +A %END %ROUTINE I; !ARRAY DECLARATION %INTEGER X,Z %DAC A; %OPR 1;!CMA; %DAC X; !X = -UPPER-1 %TAD B; %DAC Z; !+LOWER %OPR 6208;!SMA!CLL!CLA; %JMP L1; !SHOULD BE < 0 %SAD C; %OPR 2;!CML; !SET LINK IF C ZERO %LAC Z; %OPR 768;!SZL; %OPR 16;!RAR; !HALVE IF BYTE %TAD #-2; %TAD* 256; %DAC C; !NEW VALUE OF NP %OPR 1;!CMA; %TAD* 266; !COMPARE WITH LIMIT %OPR 64;!SMA; %JMP L2; !SHOULD BE GREATER %LAC C; %DAC* 256 %LAC X; %TAD #1; %ISZ C; %DAC* C; !DOPE1 = -UPPER %TAD B; %OPR 1;!CMA; %TAD #2 %ISZ C; %DAC* C; !DOPE2 = LENGTH %LAC #-1; %TAD C; !AD OF DOPE1 %RETURN L1: %JMS* D; %LIT 220; !MONITOR 28 +A +B L2: %JMS* D; %LIT 4; !MONITOR 4 %END %ROUTINE J; !SHIFT %DAC A; %OPR 577;!SPA!CMA; %JMP L2 %DAC A; %LAC B L1: %ISZ A; %OPR 2568;!SKP!RCL; %JMP* J; !LEFT SHIFT %JMP L1 L2: %LAC B L3: %OPR 2064;!RCR; %ISZ A; %JMP L3; !RIGHT SHIFT %END %ROUTINE K; !OR = \A&B!!A %DAC A; %OPR 1;!CMA; %AND B; %XOR A %END %ROUTINE L; !* %INTEGER W,X,Y %DAC A %OPR 65;!SMA!CMA %OPR 513;!SKP!CMA; %TAD #1 %DAC Y; !MOD(A) %LAC #-19; %DAC W; !COUNT %LAC B; %OPR 640;!SNA; %JMP* L %OPR 2115;!SMA!CMA!STL %OPR 513;!SKP!CMA; %TAD #1 L1: %ISZ W; %OPR 72;!SMA!RAL; %JMP L1 %DAC X; !MOD(B) SCALED %OPR 1;!CMA; %TAD #1; %XOR X %AND Y; %OPR 2178;!SZA!STL; %JMP L4 %LAC X L2: %OPR 2824;!SZL!RCL; %TAD Y %ISZ W; %JMP L2 %OPR 256;!SNL; %JMP L4 %DAC X; !MOD(A*B) %LAC B; %XOR A %OPR 4673;!SPA!CLC; %JMP L3 %LAC X; %OPR 64;!SMA; %JMP* L %JMP L4 L3: %TAD X; %OPR 65;!SMA!CMA; %JMP* L %OPR 640;!SNA; %JMP* L L4: %JMS* D; %LIT 193; !MONITOR 1 +A +B %END %ROUTINE M; !// %INTEGER V,W,X,Y,Z %DAC A %OPR 640;!SNA; %JMP L6 %OPR 65;!SMA!CMA %OPR 513;!SKP!CMA; %TAD #1 %DAC Y; !MOD(A) %LAC B %OPR 65;!SMA!CMA %OPR 513;!SKP!CMA; %TAD #1 %DAC X; !MOD(B) %OPR 1; %TAD #1; %TAD Y; !MOD(A)-MOD(B) %OPR 2632;!SPA!RCL; %JMP L1 %OPR 4224;!SZA!CLA; %JMP* M %OPR 2;!CML %JMP L4 L1: %DZM W L2: %ISZ W; %TAD X %OPR 584;!SPA!RAL; %JMP L2 %OPR 16;!RAR; %TAD X; %DAC Z %TAD #1; %XOR Z; %DAC V; !MASK FOR ANS %OPR 1; %AND Z; %DAC Z; !MOD(A)<= 0 %DAC Z; !COUNT %LAC #1; !START WITH 1 L1: %ISZ Z; %OPR 512;!SKP; %JMP* O %JMS L; !MULTIPLY BY B %JMP L1 L2: %JMS* D; %LIT 216; !MONITOR 24 +A +B %END %ROUTINE P; !ENTRY & EXIT %INTEGER RAD,CAD,VAD,NAD %DAC A; !SAVE AC %LAC P; %AND #32767 %TAD #-1; %DAC CAD; !*CALL OF P %TAD #-1; %DAC RAD; !*RETURN AD %TAD* P; %DAC VAD; !VAR BASE %LAC* RAD; %SAD CAD; %JMP L5; !EXIT -> %ISZ P %LAC* 256; %DAC B %TAD* P; %ISZ P; %DAC* 256; !NEW VAL OF NP %OPR 1;!CMA; %TAD* 266; !TEST AGAINST LIM %OPR 576;!SPA; %JMP L1; !OK -> %JMS D; %LIT 4; !MONITOR 4 (FATAL) L1: %LAC A; %DAC* B; !STORE LAST PAR (IF ANY) %LAC* 256; %TAD #65537; %DAC NAD; !+1 +65536 %LAC* VAD; %DAC* NAD; %ISZ NAD; !STORE OLD NEST BASE %LAC* 256; %DAC* VAD; !SET NEW NEST BASE %LAC* RAD; %DAC* NAD; !STORE RETURN AD %LAC CAD; %DAC* RAD; !SET TO RECALL P ON EXIT L2: %ISZ VAD; %ISZ NAD %LAC* VAD; %OPR 8;!RAL; !INSPECT FLAG BIT %OPR 592;!SPA!RAR; %JMP L3; !VALUE TYPE -> %SAD CAD; %JMP L4; !FINISHED -> %DAC B; !NAME TYPE: SWOP %LAC* NAD; %AND #-65537; %DAC* VAD %LAC B; %DAC* NAD %JMP L2 L3: %LAC NAD; %DAC* VAD; !POINTER TO NEST %JMP L2 L4: %LAC A; !RESTORE AC %JMP* P L5: %LAC* VAD; %DAC* 256; !RESTORE NP %LAC* 0; %DAC* VAD; !AND OLD NEST BASE %TAD #65538; %DAC NAD; !+2 +65536 %LAC* 0; %DAC RAD; !RECOVER RETURN AD L6: %ISZ VAD; %ISZ NAD %LAC* VAD; %OPR 8;!RAL; !INSPECT FLAG BIT %OPR 592;!SPA!RAR; %JMP L7; !VALUE TYPE -> %SAD CAD; %JMP L9; !FINISHED -> %LAC* 0; !OLD CONTENTS %JMP L8 L7: %ISZ* 256; %LAC NAD; !OLD POINTER L8: %DAC* VAD %JMP L6 L9: %LAC P; %OPR 8;!RAL; %LAC A; !RESTORE AC AND LINK %JMP* RAD %END %ROUTINE Q; !SET FAULT TRAP %OWNINTEGERARRAY F(0:32) %JMS H; %LAD F; !ARRAY REF %LAC Q; %DAC* C; !STORE IN F() %LAC* 256; %DAC* Q; !STORE NP %ISZ Q; %ISZ Q; !BUMP PAST NP + JMP %LAD Q1; %DAC D; !DIVERT MONITOR CALLS %RETURN Q1: %LIT 0; !ENTRY POINT FOR TRAP %LAC* Q1; %DAC Q2; !FAULT NUMBER %AND #63; %TAD #2; %ADA F; %DAC C; !ADDRESS OF SLOT %LAC* C; %OPR 128;!SZA; %JMP Q3; !TRAPPED -> %JMS D; !DIRECT CALL ON MONITOR Q2: %LIT 0; !WITH SAME FAULT NUM %JMP* Q1; !NEEDED FOR DIAG Q3: %DAC Q %LAC* Q; %DAC* 256; !RESTORE NP %ISZ Q; !BUMP TO EXIT TO JUMP %END %ROUTINE R; !DIRECT ACCESS %OWNINTEGER RET=3,WAIT=2,WL,FU1; !!!ABS %OWNINTEGER FU,BN,WC,BS; !!!ORDER IMPORTANT %AND #32767; %OPR 1;!CMA; %DAC WC; !- LAST AD - 1 %LAC* 0; %AND #32767; %DAC BS; !FIRST AD %LAC* 0; %DAC WL; %LAC* WL; %DAC BN; !BLOCK NUM %LAC* 0; !UNIT %OPR 704;!SPA!SNA; !CHECK # 0 IF WRITE %OPR 320;!SMA!SNL; %JMP L1; !!!LINK PRESERVED %JMS* D; %LIT 19; !MONITOR 19 L1: %TAD #8_12000; !READ CONTINUOUS %OPR 768;!SZL; %TAD #8_2000; !OR WRITE %DAC FU1; !FUNCTION + UNIT %LAC WC; %TAD BS; %DAC WC; !WORD COUNT (NEG) L2: %OPR 64;!SMA; %JMP L3 %TAD #256; %ISZ* WL; !INC BLOCK NUM %JMP L2 L3: %LAC FU; %OPR 192;!SMA!SZA; %JMP L4; !SEEK IN PROGRESS -> %LAC FU1; %DAC FU %LAD FU; !AD OF DT VECTOR %JMS* RET; %JMP* 267; !CALL DT HANDLER %LAC WC; %OPR 64;!SMA; %JMP* R; !SEEK ONLY => L4: %JMS* RET %LAC FU; %OPR 192;!SMA!SZA; %JMP* WAIT %IOT 34;!ION %OPR 65;!SMA!CMA; %JMP* R; !OK => %JMS* RET; %JMP* 268; !CALL ERROR HANDLER ->L3 %END %ROUTINE S %END %ROUTINE T; !BYTE ARRAY REF %DAC A; !INDEX %XCT* T; %DAC C; !BASE ADDRESS %LAC A; %TAD* C; !INDEX - UPPER %OPR 192;!SMA!SZA; %JMP L1; !SHOULD BE <= 0 %ISZ C; %TAD* C; !LENGTH %OPR 2768;!SPA!SNA!RCR; %JMP L1; !SHOULD BE > 0 %OPR 768;!SZL; %TAD #-131072 %ADD #-131072; %TAD C; !BYTE ADDRESS %DAC C %ISZ T %RETURN L1: %JMS* D; %LIT 160; !MONITOR 32 +A %END %ROUTINE U; !BYTE VAL %DAC C; %OPR 8;!RAL %LAC* C; %OPR 256;!SNL; %JMP L1; !RIGHT-HAND -> %OPR 2064;!RCR %OPR 1040;!RTR; %OPR 1040 %OPR 1040; %OPR 1040 L1: %AND #511 %END %ROUTINE V; !BYTE DEST %AND #511; %DAC B %XCT* V; %DAC C %OPR 64;!SMA; %JMP L1; !RIGHT-HAND -> %LAC B; %OPR 2056;!RCL %OPR 1032;!RTL; %OPR 1032 %OPR 1032; %OPR 1032; %DAC B %LAC #-512; %OPR 513;!SKP!CMA L1: %LAC #-512; %AND* C; %TAD B; %DAC* C %END %ROUTINE W %END %OWNINTEGER X; !OUTPOS %ROUTINE Y; !PRINTTEXT %ROUTINE PRINT %AND #127 %OPR 2690;!SNA!STL; %JMP* PRINT; !IGNORE NULL %ISZ X; %SAD #10; %DZM X; !UPDATE OUTPOS %JMS* 263; !CALL OUTPUT SR %OPR 768;!SZL; %JMP* PRINT %JMS* D; %LIT 29; !MONITOR 29 %END L1: %LAC* Y; %OPR 16;!RAR %OPR 1040;!RTR; %OPR 1040; %OPR 1040 %JMS PRINT; !CHAR1 %LAC* Y %JMS PRINT; !CHAR2 %LAC* Y; %ISZ Y %OPR 64;!SMA; %JMP L1 %END %ENDOFPRIM %OWNINTEGER PS=' ' %OWNINTEGER NL=10 %INTEGERFN ADDR(%INTEGERNAME N); !!!KNOWN TO COMPILER %END %INTEGERMAP INTEGER(%INTEGER N) %DAC C %END %ROUTINESPEC SELECT INPUT(%INTEGER S) %ROUTINE SELECT INPUT %DAC 260; %OPR 2056;!RCL %AND #15; %TAD 265; %DAC C; !INPUT SLOT %LAC* C L1: %DAC 262 %LAC* 262; %OPR 576;!SPA; %JMP L1; !CHAINED FILE -> %END %ROUTINESPEC SELECT OUTPUT(%INTEGER S) %ROUTINE SELECT OUTPUT %DAC 261; %OPR 2050;!STL; %OPR 8;!RAL %AND #15; %TAD 265; %DAC C; !OUTPUT SLOT %LAC X; %DAC* 263; !SAVE OUTPOS %LAC* C; %DAC 263 %LAC* 263; %DAC X; !SET OUTPOS %END %ROUTINE READ CH(%INTEGERNAME X) %LAC* 262; %OPR 2176;!SZA!CLL; %JMP L6; !CHAR PENDING -> L2: %JMS* 262; %OPR 768;!SZL; %JMP L6; !OK -> %OPR 64;!SMA; %JMP L3; !NOT CHAINED FILE -> %DAC* 262; %DAC 262; !MOVE DOWN CHAIN %OPR 6144;!CLL!CLA %JMP L2 L3: %DZM* 262 %OPR 128;!SZA; %JMP L4 %MONITOR 9; !END OF FILE L4: %DAC A; !DATA ERROR %MONITOR 143; !MONITOR 15 +A L6: %DZM* 262 %DAC X %END %ROUTINESPEC PRINT CH(%INTEGER K) %ROUTINE PRINT CH %OPR 2050;!STL; %JMS* 263; !CALL OUTPUT SR %OPR 768;!SZL; %JMP* PRINTCH %DAC A %JMS* D; %LIT 157; !MONITOR 29 +A %END %INTEGERFN NEXT SYMBOL %LAC* 262 %OPR 2176;!SZA!CLL; %JMP* NEXT SYMBOL; !CHAR PENDING => L2: %JMS* 262; %OPR 768;!SZL; %JMP L5; !OK -> %OPR 64;!SMA; %JMP L3; !NOT CHAINED FILE -> %DAC* 262; %DAC 262; !MOVE DOWN CHAIN %OPR 6144;!CLL!CLA %JMP L2 L3: %DZM* 262 %OPR 128;!SZA; %JMP L4 %MONITOR 9; !END OF FILE L4: %DAC A; !DATA ERROR %MONITOR 143; !MONITOR 15 +A L5: %TAD #-32 %OPR 576;!SPA; %SAD #-22; %JMP L8; !NEWLINE -> %OPR 6144;!CLL!CLA %JMP L2 L8: %TAD #32; %DAC* 262 %END %ROUTINE READ SYMBOL(%INTEGERNAME I) I = NEXT SYMBOL %DZM* 262 %END %ROUTINE SKIP SYMBOL %JMS NEXTSYMBOL; %DZM* 262 %END %ROUTINESPEC PRINT SYMBOL(%INTEGER K) %ROUTINE PRINT SYMBOL %OPR 2626;!SPA!SNA!STL; %JMP* PRINTSYMBOL %ISZ X; %SAD NL; %DZM X; !UPDATE OUTPOS %JMS* 263; !CALL OUTPUT SR %OPR 768;!SZL; %JMP* PRINT SYMBOL %DAC A %JMS* D; %LIT 157; !MONITOR 29 +A %END %ROUTINE NEWLINE PRINT SYMBOL(NL) %END %ROUTINE NEWLINES(%INTEGER N) L1: %RETURN %IF N <= 0; NEWLINE; N = N-1 %JMP L1 %END %ROUTINE SPACE PRINT SYMBOL(' ') %END %ROUTINE SPACES(%INTEGER N) L1: %RETURN %IF N <= 0; SPACE; N = N-1 %JMP L1 %END %ROUTINE READ(%INTEGERNAME I) %INTEGER SIGN,J 1: J = NEXT SYMBOL ->2 %IF J # ' ' %AND J # NL; SKIP SYMBOL ->1 2: SIGN = J-'-' ->3 %IF SIGN # 0 SKIP SYMBOL; J = NEXT SYMBOL 3: J = J-'0' %MONITOR 14 %UNLESS J >= 0 %AND J-9 <= 0 I = J 4: SKIP SYMBOL; J = NEXT SYMBOL-'0' ->5 %UNLESS J >= 0 %AND J-9 <= 0 I = (I<<2+I)<<1+J ->4 5: I = -I %IF SIGN = 0 %END %ROUTINE WRITE(%INTEGER V,P) %INTEGER SIGN,D %ROUTINE STRIP(%INTEGER N) ->3 %IF N = -1 D = 0 1: ->2 %IF V+N < 0; V = V+N; D = D+1; ->1 2: ->4 %IF SIGN < 0 %OR D # 0 P = P+1 %RETURN 3: D = V 4: ->5 %IF SIGN < 0 SPACES(P-6); PRINT SYMBOL(SIGN); SIGN = -1 5: PRINT SYMBOL(D+'0') %END SIGN = PS ->1 %IF V >= 0; V = -V; SIGN = '-' 1: STRIP(-100000); STRIP(-10000); STRIP(-1000) STRIP(-100); STRIP(-10); STRIP(-1) %END %ROUTINE CLOSE INPUT %OPR 6145;!CLL!CLC; %JMS* 262; %DZM* 262 %LAC 260; %OPR 2056;!RCL %AND #15; %TAD 265; %DAC C %LAC* C; %DAC 262; %DZM* 262 %END %ROUTINE CLOSE OUTPUT %OPR 6145;!CLL!CLC; %JMS* 263 %END %ROUTINESPEC READ DA(%INTEGER S %INTEGERNAME BLOCK,FROM,TO) %ROUTINE READ DA %OPR 2048;!CLL; %JMS R %END %ROUTINESPEC WRITE DA(%INTEGER S %INTEGERNAME BLOCK,FROM,TO) %ROUTINE WRITE DA %OPR 2050;!STL; %JMS R %END %INTEGERFN INSTREAM %LAC 260 %END %INTEGERFN OUTSTREAM %LAC 261 %END %INTEGERFN INDEV %LAC 262; %OPR 1032;!RTL; %OPR 1032; %AND #3 %END %INTEGERFN OUTDEV %LAC 263; %OPR 1032;!RTL; %OPR 1032; %AND #3 %END %INTEGERFN INPUT %OWNINTEGER KE=36, KI=37; !!!ABS %LAC 262; %AND #8_300000; !INDEV KB? %XOR #8_100000; !NON-ZERO IF NOT %TAD* KE; %SAD* KI; %LAC* 262; !NSYM IF KB IDLE %END %ROUTINE PROMPT(%INTEGER K) %RETURN %UNLESS INPUT = 0 %LAC K; %TAD #-131072; !ADD SIGN BIT %OPR 2050;!STL; %JMS* 262; %DZM* 262 %END %INTEGERFN FREE STORE %LAC* 266; %OPR 1;!CMA; %TAD* 256; !NP - LOLIM %END %INTEGERFN TINT %OWNINTEGER IM=11; !!!ABS %IOT 2;!IOF; %LAC* IM; %DZM* IM; %IOT 34;!ION %END %INTEGERFN OUTPOS %LAC X %END %ENDOFPERM