/SNOBOL 8.2 COMPILER. 31 AUGUST 76 PAL SOURCE / / / / THIS IS THE SOURCE FILE FOR THE SNOBOL-8.2 LANGUAGE COMPILER. THIS /PROGRAM IS DESIGNED TO RUN ON ANY STANDARD PDP-8 OS/8 SYSTEM WITH AT LEAST /8K. THE MACHINE READABLE USER DOCUMENTATION IS CONTAINED IN THE FILE /SNOUSER.DC ON THE NETWORK. ANY BUGS DISCOVERED SHOULD BE REFERRED TO THE /APPROPRIATE PERSON(S), WHO IS CURRENTLY FRED DALRYMPLE. / /FRED DALRYMPLE *0 DECIMAL 94 /VERSION NUMBER OCTAL / PAGE USAGE (FIELD 0) ***OUT OF DATE / /200 SNOBOL-FRONT2 (26) 146 (4) * /400 FRONT4-MAIN0A (22) 145 (11) /600 MAIN01-MAIN18 (27) 150 (1) /1000 MAIN19-MAIN55 (24) 135 (17) /1200 MAIN56-MAIN63 (17) 150 (11) /1400 MAIN70-MAIN78 (16) 147 (13) /1600 MAIN79-END4 (27) 150 (1) /2000 END7-PUTOUT (23) 152 (3) /2200 SCANNR-SCAN08 (10) 160 (10) /2400 SCAN09-SCAN16 (7) 133 (36) /2600 SCAN20-SCAN2S (21) 135 (20) /3000 SCAN24-SCAN2C (12) 162 (4) /3200 SCAN2M-SCAN30 (25) 125 (26) /3400 CLOSE-CLOS10 (22) 125 (31) * /3600 CLOS11-CLOS23 (15) 135 (26) /4000 CLOS24-ERR17 (35) 121 (22) /4200 ERR18-ENDRD (17) 146 (13) /4400 RETRN-WRSPO (3) 174 (1) /4600 WROCTO-SERCH (5) 155 (16) /5000 MACH-RDPOL (4) 104 (70) /5200 WRPOL-WPSTR (3) 170 (5) /5400 RDCHR (12) 165 (1) /5600 WRCHR-PRN (13) 150 (15) INHAN=6000 /INPUT HANDLER /6200 OUTHAN=6400 /OUTPUT HANDLER /6600 /7000 LITERALS AND STORAGE / PAGE USAGE (FIELD 1) / / /200 INPUT BUFFER /400 / /600 OUTPUT BUFFER /1000 /1200 /1400 / /1600 TEXT IBUF=200 /ADDRESS OF THE INPUT BUFFER NTOPIB=-600 /NEGATIVE TOP OF THE INPUT BUFFER OBUF=600 / OUTPUT BUFFER NTOPOB=-1600 /NEG. TOP OF OUTPUT BUFFER / DEFINITIONS /STORAGE DELIMITERS STRDEL=0000 /BEGINNING OR END OF STRING FREE= 7777 /FREE WORD IN STORAGE LINK= 7776 /LINK CODE POLEND=7775 /END OF POOL /USR LOCATIONS OFLTAB=7600 /CD OUTPUT FILE TABLE (FIELD 1) IFLTAB=7617 /CD INPT FILE TABLE (FIELD 1) /PARSING DELIMITERS UPARR= 23 COMMA= 22 COLON= 21 SPACE= 20 SEMI= 17 OR= 16 EQUAL= 15 LESS= 14 BACK= 12 END= 11 EOL= 10 LPAREN= 6 RPAREN= 4 STAR= 3 SLASH= 2 ADD= 1 SUB= 0 /POINT COMMAND ARGUMENT DESCRIPTORS VARORLIT= 1 NOARG= 2 LABEL= 4 JMPTR= 10 VAR= 20 ANY= 37-LABEL-JMPTR CPAL= 100 CSNO= 200 CEXIT= 400 CEND= 1000 CCONTR=1700 /ALL COMPILER CONTROL TYPES / PAGE ZERO STORAGE *10 INDEX0, 0 /AUTO-INDEX REGISTERS INDEX1, 0 INDEX2, 0 INDEX3, 0 LINEP, 0 /LINE IMAGE PTR AGVPTR, 0 /ARITH GEN VAR POOL PTR INDEX6, 0 INDEX7, 0 ACCNUM, 0 /NUMBER ACCUMULATION (SCAN) LPOOL, 0 /WHICH LITERAL POOL TO REFERENCE DEL, 0 /ATOM DELIMITER (SCAN) LAST, 0 /LAST DELIMITER IN ARITHMETIC STATEMENT T1, 0 /TEMPORARIES T2, 0 / T3, 0 / T4, 0 TX, 0 /VERY TEMPORARIES TXX, 0 TOP, 0 /LAST USED ADDRESS IN STORAGE PLUS 1 ARGCNT, 0 /ARGUMENT COUNT FOR POINT COMMAND CLEN, 0 /LENGTH OF THIS SNOBOL INST IN PAL CODE PAGLEN, 0 /CURRENT LENGTH OF OBJECT PAGE TMODE, 0 /MODE FOR THIS INSTRUCTION NXTSTR, 0 /BEGINNING OF NEW LITERAL T1MAT, 0 /WRITE CURSOR FOR WRPOOL SCURS, 0; 0 /HOLD CURSOR THROUGH EXTCUR-EXFCUR OCURSR, 0; 0 /OUTPUT STREAM CURSOR IMCNT, 0 /COUNT FOR LINE IMAGE VALID, 0 /VALID TYPE TO BE FOUND BY SCAN HPOOL, 0 /POOL HEAD (FOR WRPOOL) AGVCNT, 0 /COUNT FOR ARITH GEN VAR POOL PTR INFLPT, 0; 0 /PTR TO INPUT FILE LIST AND COUNT IHAN, 0 /LOCATION OF INPUT HANDLER OHAN, 0 /LOCATION OF OUTPUT HANDLER FOUTBK, 0 /FIRST BLOCK NUMBER IN OUTPUT FILE OFLAG, 0 /FLAG OUTPUT FILE BEING USED LITFND, 0 /FLAG LITERAL FOUND (SCAN) EQLSEN, 0 /FLAG EQUAL SIGN SEEN LABELF, 0 /FLAG LABEL BEING PARSED (SCAN) TRASEN, 0 /FLAG TRANSFER SEEN OUTF, 0 /FLAG OLINE PUT (PUTOUT) ACMIND, 0 /FLAG ACCUM IS INDIRECT (SCAN) PTATOM, 0 /FLAG .A ATOM SEEN (SCAN) MODECH, 0 /FLAG MODE CHANGED STRF, 0 /FLAG NOT INPUT FILE (FOR GETCHR) F0CLR=. /IMPURE AREA - VARIABLES BETWEEN HERE AND F0CLRL /ARE CLEARED AUTOMATICALLY AT INITIALIZATION CHOLD, 0 /HOLD CHARACTER FOR GETCHR LOOK AHEAD CURSOR, 0; 0 /POINTER TO INPUT STREAM OCNT, 0 /TELETYPE COLUMN POSITION TOCNT, 0 /HIGHEST OCNT VALUE GENLIT, 0 /GENERATED LITERALS COUNT PAGLIT, 0 /GEN LITS FOR PAGING PAL FILE OVERF, 0 /FLAG OVERWRITING POOL (DELETE SUBSTRING) LINDF, 0 /FLAG INDIRECT LABEL USAGE VINDF, 0 /FLAG INDIRECT VARIABLE USAGE COLINE, 0 /CURRENT POSITION POINTER FOR OLINE CPOLIN, 0 /CURRENT POSITION POINTER FOR POLINE F0CLRL=.-F0CLR /THIS IS THE END OF THE AUTOMATIC CLEAR AREA ONAME, ZBLOCK 4 /OUTPUT FILE NAME / CONSTANTS ZERO= CLA CLL ONE= CLA CLL IAC TWO= CLA CLL IAC RAL THREE= CLA CLL CML IAC RAL FOUR= CLA CLL IAC RTL SIX= CLA CLL CML IAC RTL C5, 5 C7, 7 C10, 10 C12, 12 C240, 240 C260, 260 C377, 377 C7400, 7400 SARG, 4000 /SUBSTITUTE ARG BIT NONE= CLA CLL CMA NTWO= CLA CLL CMA RAL NTHREE= CLA CLL CMA RTL NC1, -1 NC2, -2 NC3, -3 NC4, -4 NC5, -5 NC6, -6 NC7, -7 NC10, -10 NC12, -12 NC212, -212 NC260, -260 / ROUTINES AND COMMON POINTERS ACUM, ACCUM /POINT TO FIRST WORD OF ACCUM ACUMM, ACCUM-1 / CONVD, CVD /CONVERT THE AC TO DECIMAL CTYPE, CTTYPE /TYPE CHARACTERS (CHAR/WORD); PTR IN AC DELPOL, DPOOL /DELETE A POOL'S STORAGE (PTR IN AC) ENDRD, ENDRED /READ FROM INPUT UNTIL EOL GETCHR, RDCHR /RETURN NEXT CHAR FROM INPUT IN AC GETCHS, RDCHRS /READ CHARACTER AND DON'T MODIFY INTST, INTRPT /TEST FOR INTERRUPT LUSR, 200 /ADDRESS OF USR (FIELD 1) WHEN LOCKED MAKASC, CALASC /GENERATE CALL TO ASC WITH GEN'ED LIT PRINT, PRN /TYPE A CHARACTER PUTACR, PACCUR /PUT ACCUM ONTO OLINE WITH RETURN PUTCHR, WRCHR /WRITE CHAR TO OUTPUT (CHAR IN AC) PUTNAM, PTNAME /PUT NAME TO OUTPUT FROM POOL (PTR IN T1) PUTOC, PUTOCT /PUT OCTAL NUMBER IN AC TO OUTPUT PUTOUT, PTOUT /WRITE LINE AND GENERATED CODE TO OUTPUT RDPOOL, RDPOL /READ CHAR FROM A POOL (PTR IN T1) RETORN, RETRN /PUT CARRAIGE RETURN ON OLINE RETTRN, TYRET /TYPE A CARRAIGE RETURN SCAN, SCANNR /PARSE NEXT ATOM (ACCUM, DEL) SEARCH, SERCH /SEARCH POOL (PTR IN T1) FOR (ACCUM) SAVACM, SVACUM /STORE ACCUM IN SACCUM SHACUM, SHFTAC /SHIFT ACCUM ONE CHAR LEFT TYPE, TTYPE /TYPE PACKED STRING USR, 7700 /USR LOCATION WHEN NOT LOCKED WROCO, WROCTO /WRITE OCTAL NUMBER IN AC TO OLINE WROLIN, WRITO /WRITE CHAR TO OLINE WRPOLN, WRITPO /WRITE CHAR ON POLINE WRPOOL, WRPOL /WRITE CHAR TO A POOL (PTR IN T1MAT) WRPPSO, WRPPO /WRITE PACKED STRING TO POLINE WRPSO, WRIPO /WRITE PACKED STRING TO OLINE WRPS, WPSTR /WRITE PACKED STRING TO OUTPUT WRSTPO, WRSPO /WRITE STRING TO POLINE (PTR IN AC) WRSTR, WRSTRG /WRITE STRING (PTR IN AC) TO OUTPUT WRSTRO, WRSTO /WRITE STRING (PTR IN AC) TO OLINE / THIS IS THE FRONT END OF THE COMPILER. INPUT AND OUTPUT FILES /ARE SETUP VIA THE COMMAND DECODER. *200 SNOBOL, ZERO CDF 0 CIF 10 JMS I USR /CALL THE USR 10 /LOCK IT IN CORE CIF 10 JMS I LUSR /CALL AGAIN 5 /FOR THE CD 2316 /"SN" - DEFAULT EXTENSION 0 /PRESERVE TENTATIVE FILES TAD (IFLTAB DCA INFLPT /POINTER TO INPUT FILE LIST TAD NC10 DCA INFLPT+1 /AND COUNT TAD (OUTHAN /WHERE TO PUT HANDLER IAC /2 PAGE HANDLER IS OK DCA OFHANL CDF 10 TAD I (OFLTAB+1 /TRANSFER OUTPUT FILENAME TO PAGE ZERO DCA ONAME TAD I (OFLTAB+2 DCA ONAME+1 TAD I (OFLTAB+3 DCA ONAME+2 TAD I (OFLTAB+4 DCA ONAME+3 TAD (ONAME DCA OFLNM /SAVE ADDRESS OF FILE NAME TAD I (OFLTAB /GET OUTPUT FILE DEVICE # DCA OFLAG TAD OFLAG /FLAG WHETHER ITS SPECIFIED OR NOT SNA /SPECIFIED? JMP FRONT1 /NO / GET THE OUTPUT HANDLER CDF 0 /SET THE BASE FIELD CIF 10 JMS I LUSR /CALL 1 /TO FETCH THE HANDLER OFHANL, 0 /LOCATION OF HANDLER HLT /NO TAD OFLAG /GET DEVICE NUMBER CIF 10 JMS I LUSR /CALL 3 /TO ENTER OFLNM, ONAME /FILENAME OFLEN, 0 JMP ERR24 /CANT ENTER CDF 10 TAD OFHANL /GET LOCATION OF HANDLER DCA OHAN /SAVE TAD OFLNM /GET STARTING BLOCK DCA FOUTBK TAD FOUTBK DCA I (OUTBLK TAD OFLEN / CLL CML RAR /CoNVERT TO TWO BLOCK SIZE DCA I (OBCNT /SAVE NEGATIVE LENGTH TAD (OBUF DCA OCURSR /SETUP THE OUTPUT CURSOR ONE DCA OCURSR+1 TAD (TOPF1 DCA I (BASE /SETUP POINTERS TO THE BOTTOM OF FREE SPACE TAD (TOPF1 DCA TOP FRONT1, CDF 0 CIF 10 JMS I LUSR /CALL ONCE MORE 11 /TO BE DISMISSED TAD OFLAG SNA CLA /DOING OUTPUT? JMP FRONT4 CDF 10 TAD (INITAL /INITIALIZATION MESSAGES JMS I WRPS /WRITE IT TAD I (7666 /GET SYSTEM DATE WORD SNA /SPECIFIED? JMP FRONT2 /NO DCA TX TAD TX AND C7 /SAVE YEAR TAD C260 DCA I (YEAR TAD TX RTR; RAR /SHIFT FOR DAY DCA TX TAD (DAY-1 DCA INDEX1 /WHERE TO PUT DAY TAD TX AND (37 /SAVE DAYS JMS I CONVD /CONVERT TO DECIMAL TAD (MONTH-1 DCA INDEX1 TAD TX RTR; RTR; RAR AND (17 /SAVE MONTH JMS I CONVD /PUT IT TAD (MONTH-1 /MESSAGE JMS I WRSTR /PUT IT FRONT2, TAD (INITA2 /INITIAL CODE JMS I WRPS / JMP I (.&7600+200 /*** PAGE BOUND PAGE / INITIALIZE COUNTERS, POOLS, ETC. FRONT4, CDF 0 TAD (F0CLR-1 /CLEAR FIELD 0 IMPURE AREA DCA INDEX1 TAD (-F0CLRL DCA TX DCA I INDEX1 ISZ TX JMP .-2 CDF 10 TAD (F1CLR-1 /CLEAR FIELD 1 IMPURE AREA DCA INDEX1 TAD (-F1CLRL DCA TX DCA I INDEX1 ISZ TX JMP .-2 TAD (1-LINEL DCA IMCNT /MAX LINE LENGTH TAD (LINEIM-1 DCA LINEP /PTR TO LINE BUFFER TAD (-NTOPIB DCA CURSOR ONE /INITIALIZE THE INPUT CURSOR DCA CURSOR+1 TAD C5 DCA PAGLEN /LENGTH OF OBJECT PAGE / THIS IS THE MAIN LOOP FOR ASSIGNING ANOTHER INPUT FILE FOR /COMPILATION. IF THERE ARE NO MORE, CLOSE IS CALLED. NEXTIN, ISZ INFLPT+1 /ANY MORE? SKP /YES JMP CLOSE /NO - DONE TAD I INFLPT /GET NEXT DEVICE NUMBER SNA /ANY? JMP CLOSE /NO - DONE RTR; RTR /GET MINUS LENGTH AND C377 TAD (7400-1 /EXTEND SIGN DCA I (IBCNT /AND SAVE TAD (INHAN /AREA FOR INPUT HANDLER IAC /2-PAGER IS OK DCA IFHANL TAD I INFLPT /GET DEVICE # AGAIN CDF 0 CIF 10 JMS I USR /CALL THE USR 1 /TO GET THE HANDLER IFHANL, 0 HLT /SHOULDN'T TAD IFHANL /LOCATION OF HANDLER DCA IHAN /SAVE IT /FROM HERE ON, THE DATA FIELD IS ONE EXCEPT FOR USR AND HANDLER CALLS CDF 10 ISZ INFLPT /POINT TO NEXT WD TAD I INFLPT /GET STARTING BLOCK # DCA I (INBLK /SAVE IT ISZ INFLPT /AND BUMP / THIS IS THE MAIN COMPILER LOOP. PARSING EACH NEW INPUT LINE /IS BEGUN HERE. MAIN, NONE DCA TRASEN /TRANSFER NOT SEEN YET DCA MODECH /MODE NOT CHANGED DCA CLEN /ZERO LENGTH DCA ARGCNT /ZERO ARGUMENT LIST TAD I (MODE DCA TMODE /SETUP CURRENT MODE JMS I INTST /TEST FOR INTERRUPT /SCAN FOR A LABEL OR STATEMENT MAIN00, TAD (ANY DCA VALID /VALID TYPE TO BE FOUND BY SCAN JMS I SCAN /GET THE FIRST ATOM TAD ACCNUM SZA CLA /A NUMBER? JMP ERR5 /YES TAD I ACUM SZA CLA /NO - A WORD? JMP MAIN01 /YES NTWO /(-SLASH) TAD DEL /NO - GET THE DELIMITER SNA /COMMENT? JMP END6 /YES TAD NC6 /(-EOL) SNA /END OF LINE? JMP MAIN /YES - GO AGAIN TAD NC1 SNA /END OF FILE? JMP NEXTIN /YES - GET ANOTHER FILE TAD NC10 /(END-COLON) SNA /COLON? JMP END2 /YES TAD NC2 /(COLON-UPARR) SZA CLA /UPARROW? JMP ERR10 /NO - SOURCE ERROR TAD MODECH /GET THE MODE CHANGED FLAG SZA CLA /HAS IT? JMP MAIN0A /YES ISZ MODECH /NO - SO NOW IT DOES TAD TMODE CMA /AND COMPLEMENT THE MODE FLAG DCA TMODE MAIN0A, TAD TMODE / SNA CLA /SNOBOL MODE NOW? JMP MAIN00 /YES - GO AGAIN ISZ CLEN /NO - BUMP THE INST LENGTH TAD LINEP DCA TX /GET POINTER TO UPARROW IN SOURCE TAD C240 DCA I TX /REPLACE BY A SPACE JMP MAIN00 /GO AGAIN PAGE /HERE IF A NAME WAS FOUND FIRST ON THE LINE MAIN01, TAD DEL /GET THE DELIMITER TAD (-COMMA /WAS IT A COMMA? SZA CLA JMP MAIN02 /NO TAD LITFND SNA CLA /WAS IT A LITERAL? JMP ERR5 /YES - ERROR DCA I (ACCUM+6 /STRDEL TAD ACUMM JMS I WRSTPO /WRITE ON PRE-OLINE TAD (254 / JMS I WRPOLN /AND A COMMA JMP MAIN00 /AND GET ANOTHER ATOM MAIN02, TAD TMODE SZA CLA /PAL MODE? JMP PALEND /YES - HANDLE PAL END OF LINE / HERE WHEN WE HAVE A NAME NOT DELIMITED BY A COMMA IN SNOBOL MODE. /PRESUMABLY, IF IT BEGINS WITH A PERIOD, IT IS A STANDARD SNOBOL COMMAND /LINE, OTHERWISE IT IS PATTERN MATCHING OR ASSIGNMENT. MAIN05, TAD I ACUM /GET FIRST CHAR OF NAME TAD (-256 SZA CLA /PERIOD? JMP MAIN50 /NO MUST BE ASSIGNMENT OR PATTERN MATCHING JMS I SHACUM /SHIFT ACCUM ONE LEFT TAD (CMDTAB /PTR TO COMMANDS TABLE DCA T1 / NONE /ONE INFORMATION WORD AFTER STRDEL DCA T2 /IN THE COMMAND POOL TAD ACUMM /POSITION OF ARGUMENT JMS I SEARCH /MATCH FOUND? JMP ERR15 /NO JMS I RDPOOL /YES - GET VALID ARG TYPES HLT DCA VALID /SAVE TAD VALID AND (CCONTR /TEST FOR COMPILER CONTROL STA SZA CLA /IS IT? JMP MAIN15 /YES ISZ CLEN /NO - BUMP OBJ LENGTH TAD (LITJMS /"JMS I X" JMS I WRPSO JMS I PUTACR /PUT ACCUM TO OLINE / THIS CODE HANDLES ARGUMENTS TO THE POINT COMMANDS, THIS IS DIRECTED /BY THE 'VALID' CODES FOR EACH COMMAND. TAD VALID RTR /(NOARG=2) SZL CLA /NO ARGUMENT FOR THIS COMMAND? JMP END1 /NO - DO END OF LINE PARSE TAD DEL /GET THE DELIMITER TAD (-SPACE SZA CLA /MUST BE SPACE JMP ERR20 JMS I SCAN /GET NEXT ATOM TAD ACCNUM SZA CLA /NUMBER GIVEN? JMP ERR5 /YES - BAD ARGUMENT TYPE TAD I ACUM SNA CLA /ANY WORD? JMP ERR20 /NO - TOO FEW ARGUMENTS JMS I PUTACR /YES - WRITE ACCUM AND RETURN MAIN14, ISZ CLEN /ANOTHER WORD JMP END1 /FINISH THE END OF LINE /HANDLE COMPILER CONTROL STATEMENTS MAIN15, TAD VALID /GET WHICH INST AND (CPAL SZA CLA /.PAL STATEMENT? JMP MAIN16 /YES TAD VALID AND (CSNO /NO CHECK .SNOBOL COMMAND SZA CLA JMP MAIN20 /YES TAD (EXITCL /EXIT CALL JMS I WRPSO /WRITE IT ISZ CLEN JMP MAIN14 /FINISH PARSE /.PAL COMMAND MAIN16, DCA ACCNUM /ARG TAD DEL SNA /DELIMITER A MINUS? JMP MAIN17 /NO TAD (-SPACE SZA CLA /DELIMITER A SPACE? JMP ERR14 /NO - BAD ARGUMENT NONE MAIN17, DCA T4 /MINUS SEEN FLAG MAIN18, JMS I GETCHR /GET NEXT CHAR JMP ERR6 / TAD NC260 SPA /OCTAL '0' OR ABOVE? JMP MAI19A /NO TAD NC10 SMA /RANGE 0 - 7? JMP MAIN19 /NO TAD C10 DCA TX TAD ACCNUM /GET SUM CLL RAL CLL RAL CLL RAL /SHIFT OVER TAD TX /ADD IN CHAR DCA ACCNUM /UPDATE JMP MAIN18 /AND AGAIN PAGE /HERE WHEN LENGTH OF PAL CODE HAS BEEN ACCUMULATED MAIN19, TAD C10 MAI19A, TAD C260 /RECONSTITUTE THE CHARACTER DCA CHOLD /AND SAVE FOR EOL PARSE TAD ACCNUM /GET VALUE TAD (-200 SMA CLA /TOO BIG? JMP ERR16 /YES TAD ACCNUM /NO, GET IT AGAIN ISZ T4 /MINUS? CMA IAC /YES, DO IT DCA CLEN /LENGTH OF THIS BLOCK NONE DCA I (MODE /CHANGE MODE JMP ENDLIN /DO END OF LINE PARSE /.SNOBOL COMMAND MAIN20, DCA I (MODE /SNOBOL MODE JMP END1 /PARSE EOL /ASSIGNMENT OR PATTERN MATCHING MAIN50, ONE /(VARORLIT) ARGUMENT TYPES ALLOWED DCA VALID DCA EQLSEN /EQUAL NOT SEEN YET TAD DEL /GET DELIMITER TAD (-EQUAL SNA CLA /ASSIGNMENT? JMP MAIN70 /YES DCA ARGCNT /CLEAR ARGUMENT COUNT TAD (PATCAL /PATTERN MATCH INITIALIZATION JMS I WRPSO /WRITE IT TAD SARG JMS I WROLIN /PUT ARGCNT SUBSTITUTE TAD DEL TAD NC12 /(-BACK) SZA CLA /BACKARROW? (ANCHOR MODE) JMP MAIN51 /NO TAD (NCMDF /FLAG ANCHOR MODE JMS I WRPSO / JMP MAIN52 MAIN51, JMS I RETORN /PUT CARRAIGE RETURN MAIN52, JMS I PUTACR /PUT ACCUM (BASE VARIABLE) THREE TAD CLEN DCA CLEN /UPDATE LENGTH NTHREE /(-STAR) TAD DEL /TEST LEGAL DELIMITERS SNA JMP MAIN59 /DO FILLER TAD NC7 /(STAR-BACK) SNA /BACKARROW? JMP MAIN53 /YES TAD (BACK-EQUAL SNA /AN EQUAL SIGN? JMP MAIN5A /YES TAD (EQUAL-SPACE SZA CLA /SPACE? JMP ERR14 /NO - SYNTAX ERROR /MAIN PATTERN MATCHING PARSING LOOP MAIN53, ONE /(VAROLIT) DCA VALID JMS I SCAN /GET NEXT ATOM TAD ACCNUM SZA CLA /ACCUMULATED NUMBER? JMP ERR5 /YES - ERROR MAIN5B, TAD I ACUM / SZA CLA /ACCUMULATED ATOM? JMP MAIN56 /YES JMP MAIN55 /NO TEST DELIMITERS MAIN54, TAD DEL TAD (-OR /"!" SNA CLA /? JMP MAIN57 /YES MAIN55, NTWO /(-SLASH) TAD DEL SNA /COMMENT? JMP END6 TAD NC1 /(SLASH-STAR) SNA /IS IT A FILLER? JMP MAIN59 /YES TAD NC5 /(-STAR-EOL) SNA /END OF LINE? JMP I PUTOUT /YES - FINISH UP TAD NC1 /(EOL-END) SNA /END OF FILE? JMP I PUTOUT TAD (END-LESS SNA /FENCE (<) ? JMP MAIN58 /YES TAD NC1 /(LESS-EQUAL) SNA /EQUAL SIGN? JMP MAIN5A /YES TAD (-3 /(EQUAL-SPACE) SNA /SPACE? JMP MAIN53 /YES, GO AGAIN TAD NC1 /(SPACE-COLON) SNA CLA /COLON? JMP END2 /YES JMP ERR14 /NO - BAD DELIMITER PAGE /HANDLE ACCUMULATED NAME MAIN56, ISZ CLEN /INST LENGTH ISZ ARGCNT /ARGUMENT COUNT JMS I PUTACR /PUT ACCUM JMP MAIN54 /AND CONTINUE /HANDLE OR MAIN57, ISZ EQLSEN /EQUAL SIGN SEEN? SKP /NO JMP ERR17 /YES - ERROR TAD I ACUM SNA CLA /WAS THIS PRECEDED BY AN ARG? JMP ERR18 /NO ISZ CLEN ISZ ARGCNT TAD (ORCODE JMS I WRPSO /WRITE AN OR CODE JMS I SCAN /GET NEXT TAD I ACUM SNA CLA /AN ARG HERE TOO? JMP ERR18 /NO - ERROR JMP MAIN56 /YES DO IT /HANDLE THE FENCE MAIN58, ISZ EQLSEN /EQUAL SIGN SEEN? SKP JMP ERR17 /YES TAD (FCODE /FENCE CODE JMS I WRPSO /PUT IT JMP MAIN5R /DONE /HANDLE AN EQUAL SIGN MAIN5A, ISZ EQLSEN /EQUAL ALREADY SEEN? SKP JMP ERR17 /YES TAD (EQUALC /EQUAL CODE JMS I WRPSO /PUT NONE DCA EQLSEN /SET FLAG MAIN5R, ISZ ARGCNT ISZ CLEN JMP MAIN53 /GO /HANDLE A FILLER MAIN59, ISZ EQLSEN /EQUAL SEEN? SKP JMP ERR17 ISZ ARGCNT ISZ ARGCNT /UPDATE THE ARGUMENT COUNT ISZ CLEN ISZ CLEN /AND THE INST LENGTH TAD (VAR DCA VALID /VALID TYPE TO BE FOUND BY SCAN JMS I SCAN /GET THE FILLER VAR NAME TAD (FILLER JMS I WRPSO /GET THE BEGINNING FILLER CODE JMS I SAVACM /SAVE ACCUM TAD DEL TAD (-STAR SNA /ARBITRARY LENGTH FILLER? JMP MAIN62 /YES IAC SZA CLA /SLASH? JMP ERR14 /NO - ERROR ONE /(VARORLIT) DCA VALID /ARG TYPE JMS I SCAN /GET LENGTH TAD DEL TAD (-STAR SZA CLA /MUST BE MATCHING STAR JMP ERR14 /NO TAD ACCNUM SNA /SPECIFIC NUMBER? JMP MAIN63 /NO CLL RTL; RAL /SHIFT ONE OCTAL DIGIT UP DCA T1 NTHREE /COUNT DCA T2 /DECODE FILLER LENGTH MAIN61, TAD T1 RTL; RAL /SHIFT LEFT ONE DIGIT DCA T1 /UPDATE T1 TAD T1 RAL /SHIFT LEFTMOST DIGIT AROUND AND C7 TAD C260 /TURN DIGIT INTO CHAR JMS I WROLIN /WRITE IT ISZ T2 JMP MAIN61 /NOT YET MAIN62, TAD (FILEND JMS I WRPSO /WRITE FILLER END MAIN64, TAD ACMIND SZA CLA /INDIRECT? JMS I RETORN /YES - PUT RETURN FIRST TAD I (SACCUM /TEST FOR NULL NAME SNA CLA JMP MAIN65 TAD (SACCUM-1 /PUT THE VARAIBLE NAME JMS I WRSTRO MAIN66, JMS I RETORN /PUT A RETURN JMP MAIN5R /UPDATE ARGCNT, CLEN AND GO AGAIN /MAKE XASC CALL FOR VARIABLE FILLER LENGTH MAIN63, JMS I MAKASC /MAKE ASC CALL TAD (SHFT3 JMS I WRPPSO /WRITE A SHIFT TAD (DCAGVC-1 JMS I WRSTPO /WRITE THE STORE JMS I RETORN /PUT RETURN TAD I (DCAGV /GET FINISHING LITERAL JMS I WROLIN /PUT IT TAD (STOR JMS I WRPSO /PUT STORAGE FOR IT FOUR TAD CLEN DCA CLEN /UPDATE THE LENGTH OF THE INST JMP MAIN64 /GO PAGE MAIN65, TAD C260 /NULL NAME - PUT A ZERO JMS I WROLIN JMP MAIN66 /HANDLE SIMPLE ASSIGNMENT STATEMENTS - EITHER PATTERN MATCHING /OR ARITHMETIC MAIN70, JMS I SAVACM /SAVE ACCUM ONE DCA LAST /LAST DELIMITER SEEN (1 = ADD) JMS I SCAN /GET NEXT ATOM TAD (ARGENV-1 /ARITH GEN VAR TABLE DCA AGVPTR /PTR TAD NC10 DCA AGVCNT /COUNT TAD DEL /GET THE DELIMITER SNA /SUBTRACTION? JMP MAIN74 /YES TAD NC1 SNA CLA /ADDITION? JMP MAIN74 /YES TAD ACCNUM SZA CLA /NO, ANY ACCUMULATED NUMBER? JMP ERR5 /YES - ERROR TAD (PATCAL JMS I WRPSO /WRITE PATTERN HEADER TAD SARG JMS I WROLIN /ARGCNT SUBSTITUTE JMS I RETORN /RETURN TAD (SACCUM-1 JMS I WRSTRO /PUT BASE VARIABLE JMS I RETORN TAD (EQUALC JMS I WRPSO /WRITE EQUAL CODE ONE DCA ARGCNT /SET THE ARG LENGTH COUNT FOUR TAD CLEN DCA CLEN JMP MAIN5B /HANDLE NAME /HANDLE ARITHMETIC ASSIGNMENT STATEMENTS MAIN73, JMS I SCAN /GET NEXT ATOM MAIN74, TAD ACCNUM SZA CLA /CONSTANT? JMP MAIN77 /YES TAD I ACUM SNA CLA /VAR GIVEN? JMP MAIN75 /NO JMS I MAKASC /WRITE A CALL TO ASC TAD LAST SZA CLA /NEGATIVE OF THIS NAME? JMP MAIN7A TAD (COMPC JMS I WRPPSO /YES - WRITE COMPLEMENT ISZ CLEN MAIN7A, TAD (DCAGVC-1 JMS I WRSTPO /WRITE A STORE ISZ CLEN TAD I (DCAGV /GET LIT ISZ AGVCNT /LIT OVERFLOW? SKP JMP ERR25 /YES DCA I AGVPTR /NO - PUT INTO LIST TAD I (DCAGV /GET GEN'ED LIT DCA I (TADGV TAD (TADCON-1 /DO A TAD OF IT JMS I WRSTRO / ISZ CLEN /HANDLE NEXT DELIMITER MAIN75, TAD DEL SNA /MINUS? JMP MAIN76 /YES TAD NC1 SZA CLA /NO, ADDITION? JMP MAIN79 /NO, FINISH UP ONE /YES MAIN76, DCA LAST /UPDATE LAST DELIMITER JMP MAIN73 /AND GO AGAIN /HANDLE CONSTANT MAIN77, DCA I (TADGV /NO GENERATED LITERAL TAD (TADCON-1 / JMS I WRSTRO /WRITE TAD TAD ("( JMS I WROLIN /PUT CONSTANT ISZ CLEN ISZ CLEN /INST LENGTH TAD LAST /GET LAST DELIM SZA CLA /SUBTRACTION? JMP MAIN78 /NO TAD ("- /YES JMS I WROLIN /PUT A MINUS MAIN78, TAD ACCNUM /GET THE CONST JMS I WROCO /WRITE IT JMS I RETORN JMP MAIN75 /GO /FINISH UP AFTER ARITHMETIC ASSIGNMENT MAIN79, TAD (LITJMS /INT CALL JMS I WRPSO /WRITE IT TAD (XINT JMS I WRPSO TAD (SACCUM-1 JMS I WRSTRO /WRITE THE BASE VAR JMS I RETORN ISZ CLEN ISZ CLEN TAD C10 TAD AGVCNT /ANY GENED LITS FOR THIS STA? SNA JMP END1 /NO - PROCEED CMA IAC /YES DCA AGVCNT /SAVE NEG COUNT TAD (ARGENV-1 /PTR TO TABLE DCA AGVPTR / TAD (JMPCAL JMS I WRPSO /JUMP AROUND LITS JMP I (.&7600+200 /***PAGE BOUNDS PAGE TAD AGVCNT CMA IAC; IAC / JMS I WROCO /DISTANCE JMS I RETORN ISZ CLEN MAIN80, TAD I AGVPTR /GET NEXT JMS I WROLIN /WRITE VAR TAD (STOR JMS I WRPSO /WRITE STORAGE ISZ CLEN ISZ AGVCNT /DONE? JMP MAIN80 /NO JMP END1 /YES /THIS ROUTINE HANDLES THE END OF LINE PARSING. FROM THE INPUT /CURSOR ON TO THE END OF THE LINE SHOULD BE ONLY (AT THE /MOST) A TRANSFER SPECIFICATION, OR A COMMENT FIELD. ENDLIN, TWO /(NOARG) DCA VALID /AN ARGUMENT IS ILLEGAL JMS I SCAN /GET THE NEXT ATOM END1, NTWO /(-SLASH) TAD DEL /GET THE DELIMITER SNA /COMMENT? JMP END6 /YES TAD NC6 /(SLASH-EOL) SNA /END OF LINE? JMP I PUTOUT /YES - PUT OUTPUT LINE TAD NC1 SNA /END OF FILE? JMP I PUTOUT /YES TAD NC7 /(END-SPACE) SNA /SPACE? JMP ENDLIN /YES - TRY AGAIN TAD NC1 /(-COLON) SZA CLA /COLON (TRANSFER)? JMP ERR14 /NO END2, ISZ TRASEN /TRANSFER ALREADY SEEN? JMP ERR19 /YES - ERROR JMS I GETCHR /GET THE NEXT CHAR JMP ERR6 DCA LAST /SAVE IT TAD LAST TAD (-"( /OPEN PARENTHESIS? SNA /I.E. UNCONDITIONAL TRANSFER? JMP END4 /YES TAD (-36 /(-"F) SNA /FAIL CONDITION? JMP END3 TAD (-15 /NO - -"S SZA CLA /MUST BE SUCCESS CONDITION JMP ERR10 TAD ("N-"Z END3, TAD ("Z DCA I (TESTQ /PUT CONDITION IN TEST TWO /(NOARG) DCA VALID /VALID TYPE JMS I SCAN /GET THE NEXT TAD DEL TAD NC6 /(-LPAREN) SZA CLA /NOW MUST BE OPEN PAREN JMP ERR14 TAD (TESTSF-1 JMS I WRSTRO /WRITE TEST ISZ CLEN ISZ CLEN JMP END4+1 /PARSE LABEL PART OF TRANSFER FIELD END4, DCA LAST /UNCONDITIONAL TAD (JMPTR+LABEL / DCA VALID /FIND LABEL JMS I SCAN /GET NAME TAD I ACUM SNA CLA /ANY? JMP ERR20 /NO TAD DEL TAD NC4 /(-RPAREN) SZA CLA /MUST BE CLOSE JMP ERR14 TAD (JMPLAB JMS I WRPSO /WRITE JMP JMS I PUTACR /PUT ACCUM TAD ACMIND SNA CLA /IS ACCUM INDIRECT? JMP END7 /NO TAD LAST /GET TRANSFER CONDITION SZA CLA /MUST BE UNCONDITIONAL JMP ERR11 TAD (STOR /STORAGE DEFINITION JMS I WRPSO /WRITE IT JMP END7 END7, ISZ CLEN ISZ CLEN /BUMP INST LENGTH CNT JMS I GETCHR /GET NEXT JMP I PUTOUT DCA T1 TAD T1 TAD (-"F /FAIL NOW? SNA JMP END5 /YES TAD (-15 SNA CLA /SUCCESS? JMP END5 TAD T1 /NO - DCA CHOLD /SAVE THE CHARACTER JMP ENDLIN /AND PROCESS IT PAGE END5, TAD LAST SNA /UNCONDITIONAL BEFORE? JMP ERR19 /YES CMA IAC TAD T1 /SAME CONDITION? SNA CLA JMP ERR22 /YES JMS I GETCHR /GET THE PAREN JMP ERR6 /NO TAD (-"( SZA CLA /MUST BE JMP ERR14 /NOT JMP END4 /DO THAT LABEL /COMMENT - SCAN UNTIL THE END OF THE LINE IS READ END6, JMS I ENDRD /READ THROUGH END OF LINE JMP I PUTOUT /tHIS ROUTINE HANDLES THE END OF LINE ACTION FOR PAL MODE STATEMENTS PALEND, TAD MODECH SNA CLA /DID THE MODE CHANGE? JMP PALEN2 /NO TAD ("/ JMS I WRPOLN /YES - NOTE A COMMENT TAD CLEN CMA IAC DCA T1 /SAVE THE CoUNT OF WORDS PALEN1, TAD ("^ /WRITE ENOUGH UPARROWS JMS I WRPOLN ISZ T1 JMP PALEN1 TAD (RETURN-1 JMS I WRSTPO /PUT A RETURN AFTER THEM /NOW wRITE THE PAL LINE PALEN2, TAD ACUMM JMS I WRSTRO /PUT ACCUM TO OLINE TAD (1-LINEIM TAD LINEP SNA CLA /IS THE LINE ALREADY FINISHED? JMP PALEN4 /YES TAD C240 /PUT AN EXTRA SPACE JMS I WROLIN TAD I (CDEL /GET DELIMITER JMS I WROLIN /PUT IT AFTER ACCUM PALEN3, JMS I GETCHR /GeT tHE NEXT CHARACTER JMP I PUTOUT TAD NC212 SNA /END OF LINE? JMP PALEN4 TAD (212 /NO - RESTORE THE CHARACTER JMS I WROLIN /AND WRITE IT JMP PALEN3 PALEN4, TAD (RETURN-1 JMS I WRSTRO /PUT FINAL RETURN JMP I PUTOUT PAGE /HERE TO WRITE OUT POLINE AND OLINE AND SETUP FOR THE NEXT STATEMENT. PTOUT, ZERO TAD (-176 TAD PAGLEN /WILL THIS INST FIT ON THIS PAGE? TAD CLEN /GET SUM OF SIZES SPA CLA /? JMP PUT0 /YES - GO AHEAD TAD (PAGJMP /JMP CODE JMS I WRPS /WRITE DIRECTLY ONTO OUTPUT ISZ PAGLIT TAD PAGLIT /GET A NEW PAGE LITERAL JMS I PUTOC /PUT THE NUMBER TAD (PAGFIN /FINISH INFO JMS I WRPS /PUT IT DCA PAGLEN /ZERO NEW PAGE LENGTH PUT0, TAD CLEN TAD PAGLEN /GET NEW PAGE SIZE DCA PAGLEN /AND SAVE TAD TMODE SZA CLA /PAL MODE? JMP PUT7 /YES - DON'T PUT SOURCE TAD ("/ JMS I PUTCHR /COMMENT OUT THE LINE JMS I (PLINE /PUT SOURCE LINE ONTO OUTPUT TAD (RETURN-1 JMS I WRSTR /PUT EOL PUT7, NONE DCA OUTF /OLINE NOT PUT YET NTHREE DCA I COLINE /CLOSE OLINE NTHREE DCA I CPOLINE /AND POLINE TAD I (POLINE /PRE-OUT FIRST SNA JMP PUT4 /EMPTY - SKIP IT /DO TRANSFER FROM THE OUTPUT POOLS TO OUTPUT PUT1, DCA T1 PUT2, JMS I RDPOOL /READ FROM POOL JMP PUT4 /DONE DCA T2 TAD T2 AND SARG /SUBSTITUTE? SZA CLA JMP PUT3 /YES TAD T2 JMS I PUTCHR /NO - WRITE IT JMP PUT2 /AND AGAIN PUT3, TAD T2 /GET ARG TAD SARG / SNA CLA /ARGCNT SUBSTITUTE? JMP PUT6 /YES TAD ("X /NO - SUBSTITUTE "XL" JMS I PUTCHR TAD ("L JMS I PUTCHR /PUT THEM TAD T2 TAD SARG /SUBTRACT SARG JMS I PUTOC /PUT IT JMP PUT2 /AND AGAIN PUT4, ISZ OUTF /OLINE DONE YET? JMP PUT5 /YES TAD I (OLINE /NO - USE IT SZA JMP PUT1 /GO PUT5, TAD I (POLINE JMS I DELPOL /DELETE POLINE DCA I (POLINE /DELETE PTR DCA CPOLINE TAD I (OLINE JMS I DELPOL /AND OLINE DCA I (OLINE /AND THE PTR DCA COLINE JMP MAIN /AND NEXT LINE PUT6, TAD ARGCNT /SUBSTITUTE ARGCNT - GET IT JMS I PUTOC /WRITE IT JMP PUT2 /AND AGAIN PAGE / THIS ROUTINE HAS THE RESPONSIBILITY OF PERFORMING PRIMARY PARSING /OF THE INPUT FILE. ON A CALL TO SCAN, THE INPUT LINE IS READ UNTIL /A DELIMITER IS FOUND. ANY IDENTIFIER IS STORED IN ACCUM, ANY NUMBER /ACCUMULATION IS PERFORMED AND STORED INTO ACCNUM. IF THE DELIMITER /IS A SPACE, SCAN WILL SEARCH FOR THE NEXT DELIMITER AFTER THAT, IF /NONE, THEN SPACE IS RETURNED AS THE DELIMITER. ARGUMENT ACCUMULA- /TION IS GUIDED BY THE CODE CONTAINED IN LOCATION VALID. ZERO /CLEAR AC VIA SCANNR-2 JMP I SCANNR /RETURN VIA SCANNR-1 SCANNR, 0 DCA ACMIND /CLEAR ACCUM IS INDIRECT FLAG DCA LABELF /CLEAR LABEL FLAG DCA PTATOM /CLEAR "THIS IS" .A ATOM FLAG DCA ACCNUM /CLEAR ACCUMULATED NUMBER DCA DEL /CLEAR DEL DCA LITFND /LITERAL FOUND FLAG TAD NC10 DCA T3 /COUNT FOR ACCUM TAD ACUMM DCA INDEX1 /SETUP PTR TAD ACUMM DCA INDEX7 TAD NC10 DCA TX DCA I INDEX7 /CLEAR ACCUM ISZ TX JMP .-2 /ALL OF IT SCAN00, TAD (DELST-1 DCA INDEX6 /PTR TO DELIMITERS JMS I GETCHR /GET NEXT CHAR JMP SCAN08 DCA T4 TAD T4 TAD (-"" SNA /DOUBLE QUOTE? JMP SCAN09 /YES TAD NC5 /' SNA CLA /SINGLE? JMP SCAN09 /YES SCAN01, TAD T4 /GET CHAR AGAIN TAD I INDEX6 /GET NEGATIVE DELIMITER SNA CLA /MATCH? JMP SCAN06 /YES TAD I INDEX6 /GET THE DELIMETER CODE SZA CLA /NULL? JMP SCAN01 /NO - TRY NEXT TAD DEL /GET DELIMITER SNA CLA /ALREADY FOUND? JMP SCAN02 /NO TAD T4 /YES, HOLD THIS CHARACTER DCA CHOLD JMP SCAN07 /AND DONE SCAN02, TAD LITFND /LITERAL FOUND ALREADY? SZA CLA JMP SCAN05 /YES TAD I ACUM SZA CLA /NAME ACCUMULATED? JMP SCAN04 /YES TAD T4 /NO, GET CHAR TAD NC260 SPA /BELOW "0"? JMP SCAN03 /YES, NOT NUMBER TAD NC12 / SMA /DIGIT? JMP SCAN03 /NO TAD C12 /YES - GET BACK NUMBER DCA TX /SAVE IT TAD TMODE SZA CLA /sNOBOL MODE? JMP SCAN04 /NO - DON'T CONVERT THE NUMBER TAD NC12 /DECIMAL -10 DCA T1 /COUNT TAD ACCNUM /GET SUM ISZ T1 /MULTIPLY BY 10 JMP .-2 TAD TX /AND ADD IN NEW DIGIT DCA ACCNUM /UPDATE SUM JMP SCAN00 /GO AGAIN SCAN03, ZERO TAD ACCNUM /CHAR IS NOT A NUMBER SZA CLA /ANY ACCUMULATED NUMBER? JMP ERR4 /YES - ERROR SCAN04, ISZ T3 /INC ACCUM CNT TAD T3 /GET THE CNT SMA CLA /ACCUM FULL? JMP SCAN00 /YES - THROW AWAY CHAR TAD T4 DCA I INDEX1 /NO, SAVE CHAR JMP SCAN00 /AND DO THE NEXT ONE SCAN05, TAD (SPACE DCA DEL /FORCE SPACE TAD T4 DCA CHOLD /HOLD THIS CHARACTER JMP SCAN07 /AND ALMOST DONE SCAN06, TAD I INDEX6 /DELIMITER FOUND - GET CODE DCA DEL /SAVE TAD T4 DCA I (CDEL /SAVE THAT DELIMITER TAD ACCNUM TAD LITFND TAD I ACUM SZA CLA /ANY ARGUMENTS FOUND? JMP SCAN0A /YES TAD DEL TAD (-SPACE SZA CLA /SPACE AS A DELIMITER? JMP SCAN0A DCA DEL /YES - CLEAR DEL JMP SCAN00 /AND IGNORE THE SPACE SCAN0A, TAD DEL TAD (-SPACE /IS IT A SPACE? SNA CLA JMP SCAN00 /YES, TRY TO FIND A BETTER ONE SCAN07, TAD ACCNUM SZA CLA /ACCUMULATED NUMBER? JMP SCANNR-1 /YES TAD I ACUM ISZ LITFND /LITERAL FOUND? SNA CLA /OR NO ACCUMULATED NAME? JMP SCANNR-2 /YES - DONE JMP SCAN22 SCAN08, TAD (END /END OF FILE DCA DEL JMP SCANNR-1 /DONE PAGE /HERE TO HANDLE A LITERAL. THE LITERAL WILL BE STORED JUST ABOVE /THE TOP OF USED STORAGE IN FIELD 1. IF IT IS ALREADY IN A POOL, /THEN THE NAME IS RETURNED, OTHERWISE, IT IS ADDED TO THE APPROP- /RIATE POOL AND THE NEW NAME IS RETURNED. SCAN09, TAD LITFND TAD I ACUM SZA CLA /ANY ATOM? JMP SCAN05 /YES - USE IT TAD VALID /NO, GET VALID ARG TYPES AND (VARORLIT SNA CLA /APPROPRIATE? JMP ERR5 /NO TAD T4 /GET TYPE OF QUOTE CMA IAC DCA T3 /SAVE NEGATIVE JMS I GETCHR /GET BUT DON'T MODIFY THE NEXT CHAR JMP ERR6 DCA T1 TAD T1 TAD T3 /GET THE INITIAL QUOTE CHARACTER SZA CLA /NULL STRING? SCAN10, TAD T1 /NO - USE THE CHARACTER AND C7 /HASH FOR LITERAL POOLS DCA LPOOL /SAVE IT NONE DCA LITFND /LITERAL FOUND FLAG THREE TAD TOP DCA NXTSTR /GET A FREE ADDRESS NONE DCA I TOP TAD TOP DCA INDEX2 NONE DCA I INDEX2 /FREE UP TWO LOCATIONS AT TOP DCA I INDEX2 /SAVE STRDEL TAD NXTSTR DCA INDEX6 /SAVE PUT PTR TAD T1 /GET CHARACTER AGAIN ISZ PTATOM /IS THIS A .A LITERAL? JMP SCAN12 /NO JMP SCAN13 /YES SCAN11, JMS I GETCHR /GET AND DON'T MODIFY CHAR JMP ERR6 DCA T1 /SAVE IT TAD T1 SCAN12, TAD T3 /GET FINAL QUOTE CHAR SNA CLA /IS THIS IT? JMP SCAN14 /YES TAD T1 DCA I INDEX6 /NO, PUT CHAR JMP SCAN11 /AND ON SCAN13, DCA I INDEX6 /.A ATOM - PUT THE LITERAL SCAN14, DCA I INDEX6 /STRDEL TAD (LITS /LITERAL POINTERS TAD LPOOL /WHICH ONE DCA T4 TAD I T4 /GET THE PTR SNA /EMPTY? JMP SCAN15 /YES IAC /SKIP THE NAME WORD DCA T1 /SAVE POINTER FOR SEARCH NONE /ONE INFO WORD AFTER STRDEL IN LITERAL DCA T2 /POOLS (EXCEPT THE LAST STRING BECAUSE THE /WORD ACTUALLY PRECEEDS THE STRINGS) TAD NXTSTR /SEARCH LITERAL POOL FOR NEW LITERAL JMS I SEARCH /HAS THE STRING ALREADY BEEN ENTERED? JMP SCAN20 NONE TAD T1MAT /YES - POINT TO LITERAL NAME DCA T2 TAD I T2 /GET THE LITERAL NAME TAD SARG /FLAG SUBSTITUTE DCA I ACUM JMP SCAN21 /HERE TO ADD THE NEW STRING TO THE APPROPRIATE POOL SCAN15, NONE TAD NXTSTR DCA TX NONE DCA I TX /FREE UP EXTRA STRDEL ISZ NXTSTR /DON'T INCLUDE INITIAL STRDEL SCAN16, NONE TAD NXTSTR /POINT TO THE NEW STRING DCA I T4 /SAVE IN POOL ISZ GENLIT /GENERATE A NEW LITERAL TAD GENLIT /GET IT TAD SARG /ADD IN SUBSTITUTE BIT DCA I ACUM /SAVE LITERAL TAD GENLIT DCA I INDEX2 /PUT BEFORE STRING IN POOL NTHREE DCA I INDEX6 /PUT POLEND ONE TAD INDEX6 DCA TOP /UPDATE THE TOP POINTER JMP SCAN21 /DONE SCAN20, NONE /LITERAL NOT IN POOL TAD T1 DCA T4 /POS OF LIT POOL STRDEL BEFORE POLEND NTWO /LINK CODE DCA I T4 /PUT IT ISZ T4 /POINT TO LINK ADDRESS JMP SCAN16 /ADD NEW STRING TO POOL /DONE STRING ACCUMULATION SCAN21, TAD PTATOM SNA CLA /WAS THIS A .ANNN LITERAL? JMP SCANNR-1 /YES - THEN DONE TAD (SPACE /NO - FORCE A SPACE DCA DEL /AS A DELIMITER JMP SCAN00 /BUT LOOK FOR A BETTER ONE /@ SEEN - HANDLE INDIRECT FOR ACCUM SCAN2G, ISZ ACMIND /SET FLAG FOR INDIRECT JMS I SHACUM /SHIFT ACCUM TAD I ACUM TAD (-330 JMP SCAN2I PAGE /ADD ACCUMULATED NAME TO VARPOL OR LABPOL SCAN22, NTWO /(NOARG) TAD VALID /GET VALID TYPE SNA CLA /NO ARGUMENT ALLOWED? JMP ERR5 /YES - ERROR TAD I ACUM /NO - GET THE FIRST CHARACTER TAD (-256 SNA /PERIOD? JMP SCAN27 /YES DCA TX TAD TMODE /GET THE COMPILER MODE SZA CLA /SNOBOL MODE? JMP SCAN2S /NO - ONLY LOOK AT LABELS SCAN2T, TAD TX / TAD (-22 SNA /"@" INDIRECT? JMP SCAN2G /YES TAD (-30 SCAN2I, SNA /NO, "X"? JMP ERR7 /YES - RESTRICTED TAD (27 SPA /A LETTER? JMP ERR10 /NO TAD (-32 SMA CLA /? JMP ERR10 /NO DCA I (ACCUM+6 /TRUNCATE TO SIX CHARACTERS TAD (SPFNPL /SPECIAL FUNCTION POOL DCA T1 DCA T2 /NO INFO WORDS TAD ACUMM JMS I SEARCH /IS THIS IDENTIFIER A FUNCTION? JMP .+2 JMP SCAN2P /YES - JUST RETURN IT ONE TAD TOP DCA INDEX3 /PTR TO FREE SPACE TAD INDEX3 DCA NXTSTR /SAVE IT NONE DCA I TOP NONE DCA I NXTSTR /FREE UP SPACES AT TOP DCA I INDEX3 /STRDEL TO COVER ANY PREVIOUS NAME TAD ACUMM DCA INDEX1 /SETUP READ PTR SCAN23, TAD I INDEX1 /GET NEXT SNA /DONE? JMP SCAN24 /YES DCA TX TAD TX TAD NC260 /CHECK FOR ALPHA OR NUMERIC SPA / JMP ERR10 TAD NC12 SPA /NUMBER? JMP SCAN2H /YES TAD NC7 SPA /ALPHABETIC? JMP ERR10 /NO TAD (-32 SMA CLA /? JMP ERR10 SCAN2H, ZERO TAD TX /CHAR IS OK, GET IT BACK DCA I INDEX3 /PUT IT JMP SCAN23 /CONTINUE SCAN2P, TAD DEL TAD (-COMMA SZA CLA /IS THIS A LABEL? JMP SCANNR-1 /NO - DONE TAD VALID TAD (-ANY SZA CLA /IS IT REALLY A LABEL? JMP SCANNR-1 JMP ERR7 /YES - CANNOT BE A SPECIAL FUNCTION NAME SCAN2S, TAD DEL TAD (-COMMA /IS THIS A LABEL? SZA CLA JMP SCANNR-1 /NO - DONE JMP SCAN2T /YES - PROCESS IT /HERE WHEN ACCUM IS CHECKED AND STORED - PUT POOL DELIMITERS /AND TEST IF THIS NAME IS ALREADY IN A POOL. SCAN24, DCA I INDEX3 /STRDEL TAD DEL /GET THE DELIMITER TAD (-COMMA /LABEL? SNA CLA /? JMP SCAN2D /YES TAD ACMIND SZA CLA /INDIRECT? JMP SCAN2J /YES - VAR TAD VALID AND (LABEL /IS THIS A LABEL REF? SZA CLA JMP SCAN2N /YES SCAN2J, TAD (VARPOL /USE VARIABLE POOL JMP SCAN2K SCAN2D, TAD VALID TAD (-ANY SZA CLA /IS THIS REALLY A LABEL? JMP ERR14 /NO - BAD DELIMETER ISZ LABELF /FLAG LABEL BEING pROCESSED TAD ACMIND /INDIRECT? SZA CLA /MUST NOT BE JMP ERR11 SCAN2N, TAD ACMIND SZA CLA JMP SCAN2J /INDIRECT LABEL REF THROUGH A VARIABLE TAD (LABPOL /USE THE LABEL POOL JMP I (.&7600+200 /***PAGE BOUNDS PAGE SCAN2K, DCA T4 /SAVE POOL HEADER ADDRESS TAD I T4 /GET THE POOL LOCATION SNA /POOL EMPTY? JMP SCAN2Q DCA T1 /NO - SAVE PTR DCA T2 /NO INFO WORDS TAD ACUMM JMS I SEARCH /SEARCH FOR OCCURANCE JMP SCAN2A /NOT FOUND TAD LABELF SZA CLA /LABEL BEING PROCESSED? JMP ERR12 /YES - MULT. DEF. LABEL JMP SCAN2M /OTHERWISE TEST FOR INDIRECT /HERE IF THE NAME IS NOT FOUND IN THE POOL SCAN2A, TAD VALID AND (LABEL /LOOKING FOR A LABEL REF? SZA CLA / JMP SCAN2C /YES /HERE IF APPENDING TO POOL SCAN2F, NONE TAD T1 DCA T4 /BACKUP T1 TO POINT TO OLD STRDEL NTWO DCA I T4 /MAKE IT A LINK ISZ T4 /POINT TO ADDRESS WD ONE JMP SCAN2E SCAN2Q, TAD VALID /HERE ON EMPTY MAIN POOL AND (LABEL SZA CLA /LOOKING FOR A LABEL REF? JMP SCAN2C /YES - TEST UNDEFINED LABELS POOL SCAN2B, ONE TAD NXTSTR DCA TX NONE DCA I TX /FREE UP STRDEL BEFORE NAME TWO SCAN2E, TAD NXTSTR /POS OF NEW NAME DCA I T4 /UPDATE PTR NTHREE DCA I INDEX3 /PUT POLEND ONE TAD INDEX3 /GET NEW TOP DCA TOP TAD VALID AND (LABEL SZA CLA /LABEL REF? JMP SCAN2M /YES - CHECK INDIRECT TAD LABELF SNA CLA /LABEL DEFINITION? JMP SCAN2M /LABEL DEFINED - CHECK UNDEFINED LABEL POOL TO SOLVE ANY UNDEFINED /REFERENCES TAD I (ULBPOL /GET POOL PTR SNA /EMPTY? JMP SCAN2M /YES - CHECK INDIRECT DCA T1 DCA T2 /NO INFO WORDS TAD ACUMM JMS I SEARCH /LOOK FOR ATOM JMP SCAN2M /NOT FOUND - DO INDIRECT /HERE TO DELETE THE ENTRY IN A POOL POINTED TO BY T1 AND T1MAT JMS I RDPOOL /TRY TO GET THE NEXT CHARACTER JMP .+2 JMP SCAN25 /GOT IT TAD I (ULBPOL /NO CHARACTER - ARE WE DELETING THE ONLY ENTRY? CMA IAC TAD T1MAT SZA CLA JMP SCAN2R /NO - WRITE THE END CODE TAD I (ULBPOL JMS I DELPOL /YES - DELETE IT DCA I (ULBPOL /ZERO THE POINTER JMP SCAN2M /DONE SCAN25, ISZ OVERF /OVERWRITING POOL JMS I WRPOOL /WRITE THE CHARACTER JMS I RDPOOL /READ NEXT FROM POOL JMP .+2 /END OF POOL JMP SCAN25+1 /AND AGAIN SCAN2R, ISZ OVERF NONE JMS I WRPOOL /WRITE END CODE DCA OVERF /DONE OVERWRITING JMP SCAN2M /CHECK FOR INDIRECT /HERE TO SEARCH THE UNDEFINED LABELS POOL (WITH LABEL REF) SCAN2C, TAD (ULBPOL DCA T4 /PTR TO HEAD OF POOL TAD I (ULBPOL /GET PTR SNA /EMPTY? JMP SCAN2B /YES - APPEND DCA T1 DCA T2 /NO INFO WORDS TAD ACUMM JMS I SEARCH /SEARCH POOL JMP SCAN2F /FAIL - APPEND TO POOL JMP SCAN2M /CHECK FOR INDIRECT /CHECK FOR ACCUM BEING INDIRECT, HANDLE AND RETURN SCAN2M, TAD ACMIND SNA CLA /INDIRECT? JMP SCANNR-1 /NO - DONE TAD (INDCAL /XIND CALL JMS I WRPPSO /WRITE IT ON PRE-OUT TAD ACUMM JMS I WRSTPO /WRITE ACCUM ISZ GENLIT TAD GENLIT /GENERATE A NEW LITERAL TAD SARG /SUBSTITUTE ARG DCA I (DCAGV TAD (DCAGVC-1 /DCA SAVE OF NAME JMS I WRSTPO THREE TAD CLEN DCA CLEN /UPDATE INST LENGTH TAD VALID AND (LABEL /LABEL REF? SNA CLA /? JMP .+3 /NO ISZ LINDF /YES - INDICATE USAGE JMP .+2 ISZ VINDF /NO - SET VAR IND FLAG JMP I (.&7600+200 /***PAGE BOUNDS PAGE TAD VALID AND (JMPTR SZA CLA /TO BE USED AS A JUMP ADDRESS? JMP SCAN2L /YES TAD I (DCAGV /GET LIT # DCA I ACUM /SUBSTITUTE ARG TAD (", DCA I (ACCUM+1 TAD C260 DCA I (ACCUM+2 /PUT 'NAME,0' DCA I (ACCUM+3 /NULL JMP SCANNR-1 /DONE SCAN2L, TAD ("I DCA I ACUM /INDIRECT JUMP TAD C240 DCA I (ACCUM+1 TAD I (DCAGV DCA I (ACCUM+2 /TO INDIRECT NAME TAD (215 DCA I (ACCUM+3 TAD (212 DCA I (ACCUM+4 TAD I (DCAGV /GENERATED NAME AGAIN DCA I (ACCUM+5 /PUT IT DCA I (ACCUM+6 /NULL JMP SCANNR-1 /DONE /DOT SEEN AS FIRST CHARACTER, CHECK FOR .ANNN SCAN27, TAD I (ACCUM+1 TAD (-301 /"A"? SZA CLA JMP SCAN30 /NO TAD TMODE /GET COMPILER MODE SZA CLA /SNOBOL MODE? JMP SCANNR-1 /NO - DONE TAD (ACCUM+1 /PTR TO REST OF ATOM DCA INDEX1 DCA T1 /NUMBER ACCUMULATION SCAN28, TAD I INDEX1 /GET NEXT CHARACTER SNA /MORE? JMP SCAN29 /NO - DONE TAD NC260 SPA /BELOW A NUMBER? JMP SCAN30 /YES - PASS IT BY TAD NC10 SMA JMP SCAN30 /NOT A NUMBER TAD C10 /CONVERT TO OCTAL DCA TX TAD T1 CLL RTL; RAL /SHIFT TOTAL TAD TX /ADD IN NEXT DIGIT TO TOTAL DCA T1 JMP SCAN28 /AND DO NEXT SCAN29, TAD T1 /GET ACCUMULATED CHAR SNA CLA /OK IF NOT .EQ. 0 JMP ERR9 NONE DCA PTATOM /SET .A LITERAL FLAG DCA I (ACCUM+1 /CLEAR ACCUM JMP SCAN10 /AND GO /PERIOD NAME FOUND - CHECK VALID TYPES SCAN30, ZERO TAD VALID /GET VALID CODES TAD (-ANY /LOOKING FOR A COMMAND? SZA CLA JMP ERR7 /NO - ILLEGAL NAME JMP SCANNR-1 /YES - DONE /WRITE END CODE AND CLOSE OUTPUT FILE CLOSE, TAD OFLAG /DOING OUTPUT? SNA CLA JMP CLOS20 /NO SKIP TAD (ENDC1 /FIRST END CODE JMS I WRPS /WRITE IT TAD I (VARPOL SNA /ANY VARIABLES? JMP CLOS2 DCA T1 /POINTER CLOS1, JMS I PUTNAM /PUT NEXT JMP CLOS2 /END OF POOL TAD (STOR JMS I WRPS /WRITE A WD OF STORAGE JMP CLOS1 /AND NEXT CLOS2, TAD (ENDC2 /) JMS I WRPS /WRITE MORE CODE TAD (LITS-1 DCA INDEX1 TAD NC10 /NUMBER OF LITERALS DCA T3 CLOS3, TAD I INDEX1 /GET NEXT PTR SNA /EMPTY? JMP CLOS6 /YES DCA T1 JMP I (.&7600+200 /***PAGE BOUNDS PAGE CLOS4, JMS I RDPOOL /GET THE NEXT LITERAL NAME JMP CLOS6 DCA T2 TAD ("X JMS I PUTCHR /PUT AN "X" TAD ("L JMS I PUTCHR TAD T2 /GET THE NAME JMS I PUTOC /PUT NAME TAD (ENDC3 JMS I WRPS /POINTER FOR LIT TAD T2 JMS I PUTOC /NAME AGAIN TAD (RETURN-1 JMS I WRSTR /AND RETURN CLOS5, JMS I RDPOOL /GET NEXT (OF STR) JMP CLOS6 /DONE SNA CLA /STRDEL? JMP CLOS4 /YES - DO NEXT JMP CLOS5 /NO, KEEP LOOKING CLOS6, ISZ T3 /MORE? JMP CLOS3 /YES - GO TAD (ENDC6 /MORE INFO JMS I WRPS TAD LINDF /LABEL INDIRECT SEEN FLAG TAD VINDF /VAR " " " SNA CLA /ANY SEEN? JMP CLOS8 /NO TAD (ENDC5 JMS I WRPS /DEFINE XIND TAD LINDF /LABEL USAGE? SNA CLA JMP CLOS7 /NO TAD I (LABPOL /GET POOL HEADER SNA /EMPTY? JMP ERR23 JMS CLOS30 /NO - PUT IT CLOS7, TAD VINDF /VARIABLE USAGE? SNA CLA JMP CLOS8 /NO - DONE INDIRECTS TAD I (VARPOL JMS CLOS30 /PUT VARS CLOS8, TAD C260 /END OF TABLE JMS I PUTCHR TAD (LITS-1 DCA INDEX1 TAD NC10 DCA T3 /COUNT CLOS9, TAD I INDEX1 /NEXT LIT PTR SNA /EMPTY? JMP CLOS16 /YES DCA T1 /SAVE PTR CLOS10, JMS I RDPOOL JMP CLOS16 /POOL DONE DCA T2 TAD (ENDC7 JMS I WRPS /WRITE BEG TAD T2 JMS I PUTOC TAD (", JMS I PUTCHR /PUT COMMA /DECODE LITERALS INTO 3 CHAR/2 WORD FORMAT CLOS11, DCA I ACUM DCA I (ACCUM+1 TAD ACUMM DCA INDEX2 /PTR TO PUT CODES NTHREE DCA T2 /COUNT CLOS12, JMS I RDPOOL /GET THE NEXT CHAR HLT SNA /STRDEL? JMP CLOS14 /YES ISZ T2 /3RD CHAR? JMP CLOS13 /NO DCA T4 TAD T4 RTL; RTL /SHIFT FOR TOP CHAR AND C7400 /SAVE TOP BITS TAD I ACUM /ADD IN BOTTOM JMS I PUTOC /PUT IT TAD (RETURN-1 JMS I WRSTR /PUT RETURN TAD T4 RTR; RTR; RAR /SHIFT FOR BOTTOM AND C7400 TAD I (ACCUM+1 /BOTTOM WD JMS I PUTOC /PUT IT TAD (RETURN-1 JMS I WRSTR /AND RETURN JMP CLOS11 /AGAIN CLOS13, DCA I INDEX2 /SAVE 1ST OR 2ND CHAR JMP CLOS12 CLOS14, TAD I ACUM JMS I PUTOC /PUT PARTAIL WORDS OF LITERAL OUT TAD (RETURN-1 JMS I WRSTR TAD I (ACCUM+1 JMS I PUTOC TAD (RETURN-1 JMS I WRSTR NONE JMS I PUTOC /PUT END OF STRING TAD (RETURN-1 JMS I WRSTR JMP CLOS10 /DO THE NEXT STRING PAGE /HERE WHEN LITERAL POOL DONE CLOS16, ISZ T3 /MORE? JMP CLOS9 /YES - GO TAD (ENDC10 /LAST BIT JMS I WRPS TAD I (OUTBLK /GET CURRECT BLOCK NUMBER CMA IAC DCA T1 /SAVE NEG CLOS17, JMS I PUTCHR /PUT ZEROS TAD I (OUTBLK TAD T1 SNA CLA /UNTIL A BLOCK IS WRITTEN JMP CLOS17 /AGAIN TAD FOUTBK /GET THE FIRST OUTPUT BLOCK NUMBER CMA IAC TAD I (OUTBLK DCA CLOS19 /# OF BLOCKS WRITTEN TAD I (OFLTAB /GET OUTPUT DEVICE # AGAIN CDF 0 CIF 10 JMS I USR /CALL USR 4 /TO CLOSE OUTPUT ONAME /OUTPUT FILE NAME CLOS19, 0 /# OF BLOCKS JMP ERR3 /ERROR CDF 10 CLOS20, JMS I RETTRN /TYPE A RETURN TAD I (ULBPOL /UNDEFINDED LABEL POOL SNA /EMPTY? JMP CLOS24+1 /YES - DONE HERE DCA T1 /SAVE PTR TO LABELS TAD (ENDC20 /UNDEFINED LABELS MESSAGE JMS I TYPE CLOS21, JMS I RDPOOL /NEXT JMP CLOS24 SNA /STRDEL? JMP CLOS23 /YES CLOS22, JMS I PRINT /NO - PRINT IT JMP CLOS21 /AND GO AGAIN CLOS23, JMS I RDPOOL /GET NEXT JMP CLOS24 /DONE DCA T2 TAD (", JMS I PRINT TAD C240 JMS I PRINT TAD T2 /GET BACK CHAR JMP CLOS22 /CONTINUE /HERE TO DO TOTAL ERRORS MESSAGE CLOS24, JMS I RETTRN JMS I RETTRN TAD I (ERRC SNA /ERRORS? JMP CLOS29 /NO TAD (-144 SMA CLA /OVER 100 ERRORS? JMP CLOS28 /YES TAD (SACCUM-1 DCA INDEX1 /WHERE TO PUT NUMBER DCA I (SACCUM+2 TAD I (ERRC / JMS I CONVD /CONVERT IT TO DECIMAL TAD (SACCUM-1 JMS I CTYPE /TYPE THE NUMBER JMP CLOS32 CLOS28, TAD (ENDC21 /OVER 100 ERRORS, GIVE 'MANY' JMS I TYPE JMP CLOS32 CLOS29, TAD (ENDC22 /'NO' JMS I TYPE CLOS32, TAD (ENDC23 /'ERRORS DETECTED' JMS I TYPE JMP GOMON /GO TO OS/8 /PUT INDIRECT INFO FOR CLOSE CLOS30, 0 CLOS31, DCA T1 /PTR TO POOL TAD T1 DCA T2 /SAVE PTR TAD (ENDC24 JMS I WRPS /WRITE JMS I PUTNAM /PUT NAME JMP I CLOS30 TAD T2 DCA T1 /BACKUP TAD (ENDC5 JMS I WRPS JMS I PUTNAM /PUT NAME AGAIN JMP I CLOS30 TAD (RETURN-1 JMS I WRSTR JMS I RDPOOL /ANOTHER? JMP I CLOS30 /NO - DONE NONE TAD T1 JMP CLOS31 /AGAIN / THIS PAGE CONTAINS ERROR MESSAGES FOR COMPILER AND SOURCE ERRORS. ERR1, ZERO TAD (1-LINEL DCA IMCNT /BUFFER COUNT TAD (LINEIM-1 DCA LINEP /PTR TO BUFFER TAD (ERLTL /LINE TOO LONG JMP ERRH ERR2, TAD (EROFF /OUTPUT FILE IS FULL JMS I TYPE GOMON, CDF 0 JMP I (7600 /GO TO OS/8 PAGE ERR3, CDF 10 TAD (EROER /OUTPUT ERROR JMP ERRH ERR4, TAD (ERIVN /INVALID NUMBER JMP ERRH ERR5, TAD (ERIARG /ILLEGAL ARGUMENT TYPE JMP ERRH ERR6, TAD (ERPEOF /PREMATURE EOF JMP ERRH ERR7, TAD (ERNIR /RESTRICTED NAME JMP ERRH ERR9, TAD (ERLIV /LITERAL HAS ILLEGAL VALUE JMP ERRH ERR10, ZERO TAD (ERIC /ILLEGAL CHARACTER JMP ERRH ERR11, TAD (ERLNI /LABEL MAY NOT BE INDIRECT JMP ERRH ERR12, TAD (ERMDL /MULT. DEF. LABEL JMP ERRH ERR14, TAD (ERID /ILLEGAL DELIMITER JMP ERRH ERR15, TAD (ERUC /UNRECOGNIZED COMMAND JMP ERRH ERR16, TAD (ERARTB /ARG IS TOO LARGE (OR SMALL) JMP ERRH ERR17, TAD (ERNAE /ARG MAY NOT APPEAR AFTER EQUAL JMP ERRH ERR18, TAD (ERMHA /OR MUST BE PRECEDED AND FOLLOWED JMP ERRH / BY AN ARGUMENT ERR19, TAD (EROOT /ONLY ONE TRANSFER IS LEGAL JMP ERRH ERR20, TAD (ERTFA /TOO FEW ARGS JMP ERRH ERR22, TAD (ERSTC /SAME TRANSFER CONDITION JMP ERRH ERR23, TAD (ERNLD /NO LABELS DEFINED FOR TRANSFER TABLE JMS I TYPE JMP MAIN ERR24, CDF 10 TAD (ERCNT /CANT ENTER OUTPUT FILE JMS I TYPE JMP SNOBOL /GO AGAIN ERR25, ZERO TAD (ERAGVO /ARITH GEN VAR OVERFLOW / THIS ROUTINE HANDLES TYPING THE SOURCE LINE IN ERROR AND THEN THE /ERROR MESSAGE. WHEN DONE, CONTROL IS RETURNED TO THE MAIN PARSING /LOOP. ERRH, ISZ I (ERRC DCA T2 /SAVE PTR TO MESSAGE JMS I RETTRN /TYPE A RETURN TAD LINEP DCA INDEX7 TAD LINEP TAD (1-LINEIM SZA CLA /LINE FULL? DCA I INDEX7 /NULL FOR LINE IMAGE TAD (LINEIM-1 JMS I CTYPE /FIRST PART OF THE LINE TAD TOCNT /CURRENT CHAR POS TAD NC1 /MARK THE PREVIOUS CMA IAC DCA T1 /SAVE NEG COUNT TAD LINEP /GET LINE BUFFER PTR DCA T3 TAD T3 TAD (1-LINEIM SNA CLA /FULL LINE ALREADY? JMP ERRH1-1 JMS I ENDRD /FINISH READING THE LINE TAD T3 JMS I CTYPE /AND TYPE IT JMS I RETTRN /TERMINATE LINE ERRH1, TAD OCNT TAD T1 SNA CLA /RIGHT POSITION YET? JMP ERRH2 /YES TAD C240 JMS I PRINT /NO - TYPE A SPACE JMP ERRH1 /AGAIN ERRH2, TAD (ERPONT JMS I TYPE /POINT AT THE ERROR TAD T2 /ERROR MESSAGE PTR JMS I TYPE /GIVE IT JMS I RETTRN JMP I PUTOUT /DO NEXT LINE /TYPE THE FIXED POOL STARTING AT C(AC)+1 CTTYPE, 0 DCA INDEX7 /PTR TO STRING CTTYP1, TAD I INDEX7 /GET NEXT SNA /ANY? JMP I CTTYPE /NO, DONE JMS I PRINT /YES - TYPE IT JMP CTTYP1 /AGAIN / PUT NAME IN POOL POINTED TO BY T1 TO OUTPUT PTNAME, 0 PTNAM1, JMS I RDPOOL /READ A CHAR JMP I PTNAME /NONE - DONE SNA /STRDEL? JMP PTNAM2 JMS I PUTCHR /NO - PUT IT JMP PTNAM1 /AGAIN PTNAM2, ISZ PTNAME JMP I PTNAME /DONE PAGE /SAVE ACCUM IN SACCUM SVACUM, 0 TAD ACUMM DCA INDEX6 TAD (SACCUM-1 DCA INDEX7 TAD NC10 /COUNT DCA TX SVAC1, TAD I INDEX6 DCA I INDEX7 /MOVE IT ISZ TX JMP SVAC1 JMP I SVACUM /DONE / PUT ACCUM ONTO OLINE WITH RETURN PACCUR, 0 TAD ACUMM JMS I WRSTRO /PUT ACCUM TO OLINE JMS I RETORN /AND RETURN JMP I PACCUR /AND DONE / PUT SOURCE LINE ONTO OUTPUT PLINE, 0 TAD (LINEIM-1 /PTR TO LINE JMS I WRSTR /WRITE IT TAD (LINEIM-1 DCA LINEP TAD (1-LINEL DCA IMCNT JMP I PLINE /DONE /READ UNTIL END OF LINE OR END OF FILE ENDRED, 0 TAD (1-LINEIM TAD LINEP SNA CLA /ALREADY END OF LINE? JMP I ENDRED ENDRD1, JMS I GETCHR /GET NEXT JMP I ENDRED /DONE - EOF TAD NC212 SZA CLA /EOL? JMP ENDRD1 /NO DCA CHOLD JMP I ENDRED /YES - DONE /WRITE CARRAIGE RETURN ON OLINE RETRN, 0 TAD (RETURN-1 JMS I WRSTRO /WRITE JMP I RETRN /DONE /CONVERT THE NUMBER IN THE AC TO A TWO DIGIT DECIMAL NUMBER (OUTPUT /PTR IN INDEX1) CVD, 0 DCA INDEX7 /SAVE NUM DCA INDEX6 /COUNT TAD INDEX7 /GET IT CVD1, TAD NC12 /SUBTRACT DEC 10 SPA /DONE? JMP CVD2 /YES ISZ INDEX6 /NO - BUMP COUNT JMP CVD1 / CVD2, TAD C12 /DIGIT BACK TO NORMAL DCA INDEX7 TAD INDEX6 SNA /ANY TENS? JMP CVD4 /NO TAD C260 /YES - CAUSE ASCII CVD3, DCA I INDEX1 /PUT TAD INDEX7 /GET SINGLES PLACE TAD C260 /ASCIIIZE DCA I INDEX1 /PUT THAT JMP I CVD /DONE CVD4, TAD C240 /TENS A ZERO - USE A SPACE JMP CVD3 /TYPE A PACKED STRING - PTR IN AC TTYPE, 0 JMS EXTCUR /SETUP CURSOR FROM THE AC TTYP1, JMS I GETCHS /GET NEXT JMP TTYP2 / JMS I PRINT /TYPE IT JMP TTYP1 /AGAIN TTYP2, JMS EXFCUR /RESTORE CURSOR JMP I TTYPE /DONE /WRITE PACKED STRING TO OLINE, PTR IN (AC) WRIPO, 0 JMS EXTCUR /SETUP CURSOR WRIP1, JMS I GETCHS / JMP WRIP2 JMS I WROLIN /PUT IT JMP WRIP1 WRIP2, JMS EXFCUR /RESTORE CURSOR JMP I WRIPO /DONE /SETUP AND EXCHANGE CURSOR FROM THE LOCATION CONTAINED IN THE AC EXTCUR, 0 DCA TX /SAVE LOC TAD CURSOR DCA SCURS /SAVE CURSOR TAD CURSOR+1 DCA SCURS+1 TAD TX /GET BACK ADDR DCA CURSOR ONE DCA CURSOR+1 /CHAR POS JMP I EXTCUR /DONE EXFCUR, 0 TAD SCURS DCA CURSOR /RESTORE CURSOR FROM STORAGE TAD SCURS+1 DCA CURSOR+1 / JMP I EXFCUR /AND DONE /WRITE LINEAR STRING ONTO OUTPUT FROM C(AC)+1 WRSTRG, 0 DCA INDEX7 /PTR TO STRING WRSTR1, TAD I INDEX7 /GET NEXT SNA /STRDEL? JMP I WRSTRG /YES - DONE JMS I PUTCHR /NO - PUT IT JMP WRSTR1 /NEXT / WRITE CHAR TO OLINE FROM AC WRITO, 0 DCA TX /SAVE CHAR TAD (OLINE DCA HPOOL /HEAD OF POOL TAD COLINE /PTR TO END OF OLINE DCA T1MAT TAD TX /GET CHAR JMS I WRPOOL /WRITE IT TAD T1MAT DCA COLINE /UPDATE OLINE JMP I WRITO /DONE PAGE /WRITE A PACKED STRING TO POLINE. PTR IN (AC) WRPPO, 0 JMS EXTCUR WRPP1, JMS I GETCHS /GET THE NEXT CHARACTER JMP WRPP2 JMS I WRPOLN /PUT ON POLINE JMP WRPP1 WRPP2, JMS EXFCUR JMP I WRPPO /DONE /WRITE LINEAR STRING TO OLINE POOL FROM C(AC)+1 WRSTO, 0 DCA INDEX7 /SAVE PTR TAD (OLINE DCA HPOOL /HEAD OF POOL TAD COLINE DCA T1MAT /SAVE PTR TO OLINE WRSTO1, TAD I INDEX7 /GET NEXT SNA /DONE? JMP WRSTO2 /YES JMS I WRPOOL /NO - WRITE THE CHAR JMP WRSTO1 WRSTO2, TAD T1MAT /GET UPDATED PTR DCA COLINE / JMP I WRSTO /DONE / WRITE CHAR ON POLINE POOL FROM AC WRITPO, 0 DCA TX /SAVE CHAR TAD (POLINE DCA HPOOL /HEAD OF POOL TAD CPOLIN /PTR TO END OF POLINE DCA T1MAT TAD TX /GET THE CHARACTER JMS I WRPOOL TAD T1MAT DCA CPOLIN /UPDATE PTR JMP I WRITPO /DONE /WRITE LINEAR STRING ONTO POLINE POOL FROM C(AC)+1 WRSPO, 0 DCA INDEX7 /PTR TAD (POLINE DCA HPOOL /HEAD OF POOL TAD CPOLIN DCA T1MAT /PTR TO POLINE POOL WRSPO1, TAD I INDEX7 /GET NEXT CHAR SNA /DONE? JMP WRSPO2 /YES JMS I WRPOOL /NO, WRITE CHAR JMP WRSPO1 /AND NEXT WRSPO2, TAD T1MAT DCA CPOLIN /UPDATE PTR JMP I WRSPO /DONE / WRITE OCTAL NUMBER IN AC ONTO OLINE WROCTO, 0 DCA T2 /SAVE NUMBER TAD NC4 /COUNT DCA T1 TAD (OLINE DCA HPOOL /HEAD OF POOL TAD COLINE /PTR TO OLINE DCA T1MAT WROC1, TAD T2 /GET NUM RTL; RAL /SHIFT DCA T2 TAD T2 RAL /GET NEXT DIGIT AND C7 TAD C260 /FORM DIGIT JMS I WRPOOL /WRITE IT ISZ T1 /MORE? JMP WROC1 /YES TAD T1MAT DCA COLINE /NO, UPDATE PTR JMP I WROCTO /DONE / DELETE THE POOL POINTED TO BY (AC) DPOOL, 0 SNA /ANYTHING TO DELETE? JMP I DPOOL /NO - RETURN DPOOL0, DCA TX /SAVE PTR DPOOL1, TWO TAD I TX SNA /IS THIS A LINK WORD? JMP DPOOL3 IAC SNA CLA /NO - A POLEND? JMP DPOOL4 /YES NONE DCA I TX /NO - FREE UP WORD ISZ TX /POINT TO NEXT JMP DPOOL1 /GO AGAIN DPOOL3, NONE DCA I TX /FREE LINK WD ISZ TX TAD I TX /GET LINK ADDR DCA TXX NONE DCA I TX /FREE LINK ADDR WD TAD TXX /GET NEXT ADDR JMP DPOOL0 /AND GO DPOOL4, NONE DCA I TX /CLEAR POLEND JMP I DPOOL / CHECK FROM INTERRUPT FROM KEYBOARD INTRPT, 0 KSF /ANYTHING TYPED? JMP I INTRPT /NO KRS /YES - GET IT TAD (-203 SZA CLA /CONTROL C? JMP I INTRPT /NO - IGNORE IT KCC /REMOVE THE CHARACTER TAD (CNTLC JMS I TYPE /TYPE "^C" CDF 0 JMP I (7600 /AND GO TO MONITOR / SHIFT ACCUM ONE CHARACTER LEFT SHFTAC, 0 TAD ACUM DCA INDEX6 /READ ACCUM PTR TAD ACUMM DCA INDEX7 /PUT PTR TAD NC10 DCA TX /COUNT SHFT1, TAD I INDEX6 /GET THE NEXT DCA I INDEX7 ISZ TX /MORE? JMP SHFT1 /YES JMP I SHFTAC /NO - DONE PAGE / TYPE A RETURN ON THE TELETYPE TYRET, 0 TAD (RETURN-1 JMS I CTYPE /TYPE A RETURN JMP I TYRET / ROUTINE TO SEARCH THE POOL POINTED TO BY T1 FOR THE STRING POINTED /TO BY (AC)+1. ASSUME (T2) WORDS TO BE IGNORED AFTER EACH STRDEL. SKIP /ON SUCCESS. SERCH, 0 DCA SERCHA /SAVE POSITION OF ATOM TO SEARCH FOR SERCH1, TAD SERCHA /POS OF ATOM DCA INDEX1 /PTR FOR MATCH TAD T1 DCA T1MAT /POS OF T1 WHEN MATCH SUCCEEDS JMS MATCH /IS THIS A MATCH? JMP SERCH2 /NO ISZ SERCH /YES - SET FOR SKIP JMP I SERCH /AND DO IT SERCH2, THREE TAD I T1 SNA CLA /POLEND? JMP I SERCH /YES - FAIL NONE TAD T1 /GET CHAR POS DCA T1 /BACKUP SERCH3, JMS I RDPOOL /GET THE NEXT CHARACTER JMP I SERCH /FAIL - END OF POOL SZA CLA /STRDEL? JMP SERCH3 NONE TAD T2 DCA TX /NEG COUNT OF INFO WORDS SERCH4, ISZ TX JMP .+2 JMP SERCH1 /DONE SKIPPING THEM JMS I RDPOOL JMP I SERCH /FAIL ON POLEND ZERO JMP SERCH4 /GO FOR MORE SERCHA, 0 /ARGUMENT ADDRESS / THIS ROUTINE DETERMINES WHETHER THE STRING (PTR IN INDEX1) /MATCHES A SUBSTRING IN THE POOL POINTED TO BY T1. SKIP ON /SUCCESS. MATCH, 0 JMS I RDPOOL /GET NEXT CHAR FROM THE POOL JMP I MATCH /END OF POOL SNA /STRDEL? JMP MAT1 /YES DCA TX /NO, SAVE CHAR TAD I INDEX1 /GET MATCH CHAR SNA /STRDEL? JMP I MATCH /YES - FAIL CMA IAC TAD TX / SZA CLA /MATCH? JMP I MATCH /NO JMP MATCH+1 /YES, SO FAR MAT1, TAD I INDEX1 /GET CHAR SNA CLA /STRDEL? ISZ MATCH /YES - SKIP JMP I MATCH /NO - FAIL / WRITE AN XASC CALL ON PRE-OLINE CALASC, 0 ISZ GENLIT /BUMP GEN LIT COUNT TAD GENLIT TAD SARG /FORM SUBSTITUTE CODE DCA I (DCAGV /SAVE IT TAD (LITJMS /ASC CALL JMS I WRPPSO /PUT IT TAD (XASC JMS I WRPPSO TAD ACUMM JMS I WRSTPO /AND ACCUM TAD (RETURN JMS I WRPPSO ISZ CLEN ISZ CLEN /BUMP INST LENGTH COUNT JMP I CALASC /DONE / WRITE OCTAL NUMBER IN AC ONTO OUTPUT PUTOCT, 0 DCA P2 TAD NC4 DCA P1 /COUNT PUTO1, TAD P2 /GET NUMBER CLL RTL; RAL /SHIFT DCA P2 TAD P2 /SAVE RAL AND C7 TAD C260 /FORM A DIGIT JMS I PUTCHR /WRITE IT ISZ P1 / JMP PUTO1 /MORE JMP I PUTOCT /DONE P1, 0 /LOCALS FOR PUTOCT P2, 0 / READ A CHARACTER FROM THE POOL POINTED TO BY T1, SKIP ON /SUCCESS. RDPOL, 0 RDP0, THREE TAD I T1 /GET CHAR SNA /POLEND? JMP I RDPOL /YES - FAIL ISZ T1 /UPDATE THE POINTER TAD NC1 SNA /LINK (-2) ? JMP RDP1 /YES TAD NC2 /NORMALIZE ISZ RDPOL /NO - SKIP RETURN JMP I RDPOL /DONE RDP1, TAD I T1 /GET THE ADDR DCA T1 /UPDATE PTR JMP RDP0 /GO AGAIN / WRITE A CHARACTER INTO THE POOL POINTED TO BY T1MAT. THE CHAR IS /SUPPLIED IN THE AC. REQUIRES WT1. WRPOL, 0 DCA WT1 /SAVE THE CHARACTER TAD T1MAT /GET THE POOL POINTER SNA /ASSIGNED AN ADDRESS? JMS WRPAA /NO - GET ONE JMS WRPCA /AND CHECK IT DCA T1MAT ONE TAD WT1 /GET THE CHAR SNA JMP WRP1 /WRITE END CODE IF NULL TAD NC1 WRP0, DCA I T1MAT /WRITE THE CHARACTER ISZ T1MAT JMP I WRPOL /AND DONE WT1, 0 /TEMPORARY FOR WRPOL PAGE WRP1, TAD OVERF SNA CLA /OVERWRITING POOL? JMP WRP2 TAD T1MAT JMS I DELPOL /YES - DELETE THE OLD END OF THE POOL WRP2, NTHREE JMP WRP0 /PUT POLEND AND DONE /FIND A VALID ADDRESS FOR A POOL EXTENSION. USES WT2, WT3 AND WT5. WRPAA, 0 TAD I (BASE /BASE OF DYNAMIC STORAGE DCA WT2 WRPA0, TAD NC5 DCA WT5 /NUMBER OF FREE SPACES NECESSARY WRPA1, ONE DCA WT3 /SAVE MATCH WORD (FREE) WRPA2, TAD WT2 /SEARCH FOR A FREE AREA CMA IAC TAD TOP SNA CLA /HAVE WE EXHAUSTED USED SPACE? JMP WRPA6 TAD WT3 /NO - GET THE SEARCH WORD TAD I WT2 /GET THE WORD FROM STORAGE ISZ WT2 /POINT TO NEXT WORD SNA /MATCH? JMP WRPA3 IAC /NO - CHECK FOR POLEND (CANNOT BE SNA CLA / LINK IF WT2 IS FREE) JMP WRPA0 TWO /NO - SET THE MATCH TO LINK (MATCHES POLEND TOO) JMP WRPA1+1 /AND GO AGAIN /FOUND THE MATCHED WORD - IF POLEND, THEN SET TO FREE AND LOOK FOR ENOUGH /FREE WORDS; IF FREE, INCREMENT WT5 AND CHECK THE NEXT WORD UNLESS WT5 /HAS GONE TO ZERO IN WHICH CASE, WE FOUND A FREE ADDRESS. WRPA3, NTWO TAD WT3 /GET THE MATCH WORD SNA CLA /LINK? JMP WRPA7 /YES - SKIP POINTER WORD ISZ WT5 /NO - BUMP FREE COUNT JMP WRPA2 /AND TRY FOR MORE JMP WRPA4 WRPA7, ISZ WT2 /POINT PAST THE LINK ADDRESS WORD JMP WRPA0 /AND LOOK FOR FREE SPACE WRPA6, JMS WRPA10 /CLEAR AREA AT TOP WRPA4, TAD WT5 /POINT TO THE FIRST FREE WORD TAD C5 CMA IAC TAD WT2 /CURRENT POINTER DCA TX TAD T1MAT /GET POINTER TO PREVIOUS WORD SZA CLA JMP WRPA5 TAD TX DCA I HPOOL /UNSPECIFIED - UPDATE POOL HEADER WRPA5, TAD TX /GET BACK ADDRESS JMP I WRPAA /DONE WRPA10, 0 /THIS CODE FREES NEW AREA AT THE TOP OF STORAGE NONE TAD TOP DCA INDEX0 TAD NC10 DCA TX NONE DCA I INDEX0 /CLEAR THE NEW FREE SPACE ISZ TX JMP .-3 TAD TOP TAD C10 DCA TOP /AND UPDATE TOP JMP I WRPA10 / CHECK THIS ADDRESS (IN AC) FOR WRITING A CHARACTER HERE (THERE MUST /BE AT LEAST TWO FREE WORDS FOLLOWING IT). IF THERE IS NO ROOM, WRITE /A LINK CODE AND FIND A GOOD ADDRESS. REQUIRES WT4. WRPCA, 0 DCA WT4 /SAVE TWO TAD WT4 CMA IAC TAD TOP /OVER THE TOP? SPA SNA CLA JMP WRPCA3 /YES TAD OVERF SZA CLA /OVERWRITING POOL? JMP WRPCA2 /YES TWO TAD WT4 /GET IT AGAIN DCA TX ONE TAD I TX SNA CLA /USED? JMP WRPCA3+1 /NO NTWO /LINK CODE DCA I WT4 ISZ WT4 JMS WRPAA /GET ANOTHER ADDR DCA I WT4 /PUT IT TAD I WT4 /GET IT BACK JMP I WRPCA /AND DONE WRPCA2, TWO TAD I WT4 /GET CURRENT LOCATION SZA CLA /LINK CODE? JMP WRPCA3+1 /NO, USE ADDRESS ISZ WT4 /YES - POINT TO LINK ADDR TAD I WT4 /GET THE LINK ADDRESS JMP WRPCA+1 /AND CHECK IT WRPCA3, JMS WRPA10 /GET FREE SPACE AT THE TOP OF STORAGE TAD WT4 /GET BACK THE ORIGINAL JMP I WRPCA /AND DONE WT2, 0 /TEMPORARIES FOR WRPAA AND WRPCA WT3, 0 WT4, 0 WT5, 0 /WRITE PACKED STRING TO OUTPUT WPSTR, 0 JMS EXTCUR /EXCHANGE CURSOR WPSTR1, JMS I GETCHS /GET NEXT JMP WPSTR2 JMS I PUTCHR /PUT IT JMP WPSTR1 WPSTR2, JMS EXFCUR /RESTORE CURSOR JMP I WPSTR PAGE /READ THE NEXT CHARACTER FROM THE INPUT BUFFER. SKIP ON SUCCESS. /THE POINTER TO THE INPUT BUFFER IS IN CURSOR AND CURSOR + 1. THE /NEXT CHARACTER'S LOCATION IS IN CURSOR AND THE CHARACTER NUMBER (1, /2 OR 3) IS IN CURSOR+1. RDCHR, 0 TAD CHOLD /GET THE TEMPORARY CHARACTER HOLD SNA JMP RDCH DCA TX /SAVE IT ISZ RDCHR /IF SPECIFIED, SKIP DCA CHOLD /DELETE IT TAD TX /BUT USE IT JMP I RDCHR RDCH, NONE JMP RDCHR0 /SKIP RDCHRS ENTRY RDCHRS, 0 /ENTER HERE TO NOT MODIFY CHARACTER TAD RDCHRS / DCA RDCHR /SETUP EXIT ROUTE RDCHR0, DCA STRF /SET FLAG TAD CURSOR TAD (NTOPIB /NEG TOP OF INPUT BUFFER SNA CLA /BUFFER EXHAUSTED? JMP RDCH5 NTHREE TAD CURSOR+1 /GET CHAR POS SZA CLA /THIRD? JMP RDCH4 /NO NTWO TAD CURSOR /YES - POINT AT FIRST WD DCA INDEX7 TAD I INDEX7 / AND C7400 /SAVE TOP 4 BITS CLL RTR; RTR /SHIFT DCA TX TAD I INDEX7 AND C7400 /BOTTOM 4 BITS CLL RTL; RTL; RAL /SHIFT THOSE INTO POSITION TAD TX DCA TX /SAVE CHAR ISZ CURSOR /BUMP POS PTR ONE DCA CURSOR+1 /FIRST CHAR AGAIN RDCH1, ISZ STRF /DON'T MODIFY FLAG? JMP RDCH3 /YES - DON'T MODIFY CHAR TAD TX /GET THE CHAR SNA /NULL? JMP RDCH /YES - TRY FOR NEXT CHARACTER TAD NC212 /CHECK FOR EOL SPA / JMP RDCH2 /NO TAD NC3 SPA /LF, VT, FF? JMP RDCH /YES - IGNORE THEM SNA /RETURN? JMP RDCH7 /YES - EOL TAD (-13 SNA /CONTROL X? JMP RDCH9 /YES TAD NC2 SNA /CONTROL Z? JMP RDCH9 /YES TAD (-145 SNA CLA /RUBOUT? JMP RDCH /YES - IGNORE IT RDCH2, ZERO TAD TX /GET CHARACTER ISZ IMCNT /LINE IMAGE COUNT SKP JMP ERR1 /OVERFLOW DCA I LINEP /PUT CHAR RDCH3, TAD TX /AND GET IT BACK SZA /NO SKIP IF NULL ISZ RDCHR /SKIP RETURN JMP I RDCHR /AND DONE RDCH4, TAD I CURSOR /GET 1ST OR 2ND CHAR AND C377 DCA TX /SAVE IT ISZ CURSOR+1 /UPDATE PTR NTWO TAD CURSOR+1 /GET CHAR POS SNA CLA /NOW SECOND? ISZ CURSOR /YES - BUMP WD PTR JMP RDCH1 /AND FINISH RDCH5, TAD I (IBCNT ISZ I (IBCNT /TEST IF ANY MORE PAGES LEFT IN THE FILE SMA SZA CLA JMP RDCH9 /NO - FAIL TAD LUSR /(IBUF) PTR TO BUFFER DCA CURSOR /UPDATE PTR TAD I (INBLK / DCA IBLK /SETUP WHICH BLOCK ISZ I (INBLK /UPD PTR CDF 0 JMS I IHAN /CALL THE HANDLER 0210 /READ 1 BLOCK TO FIELD 1 IBUF /LOCATION OF BUFFER IBLK, 0 /WHICH BLOCK TO READ JMP RDCH8 /DONE - EOF CDF 10 RDCH6, TAD STRF SZA CLA /WHICH ENTRY POINT? JMP RDCH /RDCHR JMP RDCHR0 /RDCHRS RDCH7, ZERO TAD (212 /EOL - FORCE LF DCA TX DCA I LINEP /NULL THE END OF THE LINE TAD (1-LINEL DCA IMCNT /FINISH LINE IMAGE TAD (LINEIM-1 DCA LINEP /UPD PTR JMP RDCH3 /AND DONE RDCH8, CDF 10 SMA CLA /FATAL ERROR RETURN? JMP RDCH6 /NO - ASSUME WE GOT A PARTIAL BLOCK RDCH9, TAD (-NTOPIB DCA CURSOR /CLEAR THE BUFFER POINTER JMP I RDCHR /DONE PAGE / WRITE THE CHARACTER IN THE AC TO THE OUTPUT BUFFER. WRCHR, 0 DCA TX /SAVE CHAR TAD OFLAG /DOING OUTPUT? SNA CLA JMP I WRCHR /NO - FLUSH TAD (NTOPOB TAD OCURSR / SZA CLA /BUFFER FULL? JMP WRCH1 /NO TAD (OBUF DCA OCURSR /YES - FIX PTR ONE DCA OCURSR+1 TAD I (OUTBLK /WHICH OUTPUT BLOCK TO WRITE DCA OBLK ISZ I (OUTBLK /UPDATE ISZ I (OUTBLK CDF 0 JMS I OHAN /CALL THE HANDLER 4410 /WRITE 4 PAGES FROM FIELD 1 OBUF /OUTPUT BUFFER OBLK, 0 /WHICH BLOCK JMP ERR3 /OUTPUT ERROR CDF 10 ISZ I (OBCNT /OUTPUT FILE FULL? JMP .+2 JMP ERR2 /YES - ERROR WRCH1, NTHREE TAD OCURSR+1 SZA CLA /THIRD CHARACTER? JMP WRCH3 /NO NONE TAD OCURSR / DCA TXX /TOP BITS GO INTO THE PREV WD TAD TX /GET THE CHAR RTL; RTL /SHIFT INTO PLACE AND C7400 /TOP 4 BITS TAD I TXX /ADD IN OTHER CHAR DCA I TXX /SAVE TAD TX /GET THE CHAR AGAIN RTR; RTR; RAR /SHIFT AGAIN AND C7400 /SAVE BOTTOM 4 BITS TAD I OCURSR /ADD IN CHAR DCA I OCURSR /AND SAVE ONE /1ST CHAR AGAIN DCA OCURSR+1 / ISZ OCURSR /UPD PTR JMP I WRCHR /DONE WRCH3, TAD TX /GET CHAR AND C377 /TRUNCATE DCA I OCURSR /SAVE IT ISZ OCURSR+1 /UPD CHAR CNT NTWO TAD OCURSR+1 /GET WHICH CHAR SNA CLA /FIRST? ISZ OCURSR /YES - UPD PTR JMP I WRCHR /NO - DONE /TELETYPE OUTPUT ROUTINE PRN, 0 DCA TPRN /SAVE CHAR JMS I INTST /CHECK FOR INTERRUPT TAD OCNT SNA CLA /ANY CHARACTERS ON LINE YET? JMP PRN2 PRN0, TAD TPRN TAD (-215 / SNA /RETURN? DCA OCNT /YES - ZERO COUNT TAD (4 SNA CLA /TAB? JMP PRN1 /YES TAD TPRN JMS PRX /NO - TYPE THE CHAR JMP I PRN /DONE PRN1, TAD C240 /TYPE A SPACE JMS PRX TAD OCNT /UNTIL OCNT AND C7 SZA CLA /GOES TO MOD 8 JMP PRN1 /NO JMP I PRN /YES - THEN DONE PRN2, TAD TPRN TAD NC212 SNA CLA /ONLY A LINE FEED? JMP PRN0 /YES TAD ("/ JMS I PUTCHR /COMMENT OUT LINE IN OUTPUT JMP PRN0 PRX, 0 TLS /TYPE THE CHARACTER TAD (-232 /-^Z SMA SZA /PRINTING CHAR? ISZ OCNT /YES - BUMP POS TAD (232 JMS I PUTCHR /WRITE IT IN THE OUTPUT FILE TAD OCNT SZA DCA TOCNT /SAVE TOCNT AS TOP OCNT TSF JMP .-1 JMP I PRX /AND DONE TPRN, 0 /TEMPORARY CHARACTER HOLD FIELD 1 *1600 / COMMAND POOL CMDTAB, "P;"A;"L; STRDEL; CPAL "S;"N;"O;"B;"O;"L; STRDEL; CSNO "L;"O;"O;"K;"U;"P; STRDEL; VARORLIT "E;"N;"T;"E;"R; STRDEL; VARORLIT "I;"C;"L;"O;"S;"E; STRDEL; NOARG "O;"C;"L;"O;"S;"E; STRDEL; NOARG "P;"U;"S;"H;"J; STRDEL; LABEL "P;"O;"P;"J; STRDEL; NOARG "E;"X;"I;"T; STRDEL; CEXIT "E;"N;"D; STRDEL; CEND "P;"U;"S;"H; STRDEL; VAR "P;"O;"P; STRDEL; VAR POLEND /END OF COMMAND POOL / SPECIAL FUNCTION NAMES POOL SPFNPL, "O;"U;"T;"P;"U;"T;STRDEL "I;"N;"P;"U;"T;STRDEL "O;"U;"T;"H;"O;"L;STRDEL "R;"E;"A;"D;STRDEL "W;"R;"I;"T;"E;STRDEL "W;"R;"I;"T;"E;"H;STRDEL "P;"O;"S;"R;STRDEL POLEND / DELIMITER TABLE DELST, -211; SPACE -212; EOL -215; SPACE -240; SPACE -241; OR -250; LPAREN -251; RPAREN -252; STAR -253; ADD -254; COMMA -257; SLASH -272; COLON -273; SEMI -275; EQUAL -274; LESS -336; UPARR -337; BACK -255; SUB /END OF TABLE (NOTE SUB = 0) / VARIOUS BULK STORAGE LINEL=120 /LENGTH OF LINE INPUT BUFFER (80 CHARACTERS) LINEIM, ZBLOCK 116 /LINE INPUT IMAGE 215;212;0 /FOR OVERFLOW CONDITIONS ACCUM, ZBLOCK 10 /7 CHARACTER IDENTIFIER ACCUMULATION (SCAN) BASE, 0 /BASE OF POOL STORAGE INBLK, 0 /WHICH INPUT BLOCK IBCNT, 0 /NEG LENGTH OF INPUT FILE (BLOCKS) OUTBLK, 0 /WHICH OUTPUT BLOCK OBCNT, 0 /NEG LENGTH OF OUTPUT FILE CDEL, 0 /HOLD DELIMITER CHARACTER F1CLR=. /IMPURE AREA - ANY LOCATIONS BETWEEN HERE /AND F1CLRL ARE AUTOMATICALLY CLEARED AT /INITIALIZATION LITS, ZBLOCK 10 /LITERAL POOL HEADERS ARGENV, ZBLOCK 10 /ARITHMETIC GENERATED VARIABLES STORAGE SACCUM, ZBLOCK 10 /SAVE ACCUM BLOCK OLINE, 0 /HEADER FOR OLINE POOL POLINE, 0 /HEADER FOR POLINE POOL LABPOL, 0 /HEADER FOR LABEL POOL VARPOL, 0 /HEADER FOR VARIABLE POOL ULBPOL, 0 /HEADER FOR UNDEFINED LABELS POOL ERRC, 0 /COMPILATION ERROR COUNT MODE, 0 /COMPILER MODE (0: SNOBOL, 1: PAL) F1CLRL=.-F1CLR /HERE ENDS THE AUTOMATIC CLEAR AREA FOR FIELD 1 / MODIFIABLE LITERALS MONTH, 0;0;"/ DAY, 0;0;"/;"7 YEAR, 0;0 RETURN, 215;212;0 DCAGVC, 215;212;"D;"C;"A;" DCAGV, 0;215;212;0 TADCON, "T;"A;"D;" TADGV, 0;215;212;0 TESTSF, "T;"A;"D;" ;"X;"S;"U;"C;"C;"E;"S;215;212;"S TESTQ, 0;"A;" ;"C;"L;"A;215;212;0 / TEXT FOR WRITE PACKED STRING ROUTINES INITAL, /SNOBOL 8.2> 6257;7323;6317;7702;5714;4240;4256;4662;0;0 INITA2, /;;JMS I XINIT;XIND;X0;XVLEN;XTOP; 4215;5212;6712;1715;5240;0311;6330;7311;4311;6724;6212;4730;4316;6704 5612;330;6615;4212;6326;2714;4316;5215;6330;7724;4320;5215;212;0 LITJMS, /JMS I X 6712;1715;5240;311;330;0 XASC, /ASC; 6301;1723;215;212 XINT, /INT; 6711;2316;215;212 NCMDF, /-4000; 5655;264;4260;6660;212;0 FILEND, /0; 260;273 EXITCL, /JMP I (7600; 6712;315;5240;311;5650;3267;4260;6660;212;0 ORCODE, /XORC; 6730;1317;4303;5215;0;0 EQUALC, /XEQC; 6730;705;4303;5215;0;0 COMPC, /CMA IAC; 6303;0715;6240;0711;4303;5215;0;0 SHFT3, /CLL RAL; CLL RAL; CLL RAL; 6303;6314;6240;722;4314;5215;6303;6314;6240;0722;4314;5215 6303;6314;6240;722;4314;5215;0;0 FCODE, /XFENC; 6330;2706;4316;6703;212;0 JMPCAL, /JMP .+ 6712;315;5240;5656;0;0 STOR, /, 0; 5654;211;215;212 CNTLC, /^C; 4336;6703;212;0 JMPLAB, /JMP_ 6712;315;240;0 PAGJMP, /JMP I (.&7600+200;PAGE;XP 6712;315;5240;311;5250;3256;5667;266;5660;1253;4260;6660;6212 720;4307;6705;6612;330;0;0 PAGFIN, /=.; 4275;6656;212;0 FILLER, /XFLC; 6330;6306;303;273 PATCAL, /JMS I XPAT 6712;1715;5240;311;6330;720;4324;5215;0;0 INDCAL, /JMS I XINDRC; 6712;1715;5240;311;6330;7311;6304;1722;215;212 ENDC1, /;PAGE;X0,; 6615;212;6301;2707;4215;5212;5330;6260;215;212 ENDC2, /;XVLEN=.-X0 6612;3330;6314;7305;5275;6656;4330;6660;212;212 ENDC3, /, XX 6654;4211;330;0 ENDC5, /.; 4256;5215;0;0 ENDC6, /;FIELD 1;*XFIELD1;XIND= 4215;5212;6306;2711;5314;0304;4261;5215;6252;3330;6311;6305;4304 6661;6612;4212;6311;2316;275;0 ENDC7, /;XX 6615;4212;330;0 ENDC10, /;XTOP=.;$$$; 4215;5212;6330;7724;5320;7275;4215;5212;5244;2244;4615;5212;0;0 ENDC20, /UNDEFINED ADDRESSES:_ 6325;2316;6305;4706;6316;2305;6240;2301;6304;2722;6323;2723 5323;272;240;240 ENDC21, /MANY 6315;7301;331;0 ENDC22, /NO 316;317 ENDC23, / ERRORS DETECTED; 6640;1305;6722;1317;6323;2240;6305;2724;6303;2724;4304;5215;212;0 ENDC24, /TEXT . 6724;4305;5324;7211;0;0 / ERROR MESSAGES ERPONT, /^; 336;240 ERLTL, /LINE TOO LONG 6314;7311;6705;2240;5317;317;6314;7317;307;0 EROFF, /OUTPUT FILE FULL 6717;2325;6720;2325;6240;4706;5314;305;6306;6325;314;0 EROER, /OUTPUT ERROR 6717;2325;6720;2325;6640;1305;6722;1317;0;0 ERIVN, /INVALID NUMBER 6711;3316;6301;4714;6304;7240;6325;1315;305;322 ERIARG, /ILLEGAL ARGUMENT TYPE 6311;6314;6305;707;6314;640;6722;2707;6315;7305;6724;2240;6331;2720;0;0 ERPEOF, /PRE-MATURE EOF 6320;2722;6255;715;6724;1325;6305;2640;317;306 ERNIR, /NAMES MAY NOT BEGIN WITH X OR . 6316;6701;5305;0323;6715;4701;6240;7716;6324;1240;6305;4707;6716;3640 6311;4324;5240;330;5317;322;256;0 ERLIV, /ILLEGAL LITERAL VALUE 6311;6314;6305;707;6314;6240;6311;2724;6322;6301;6240;726 6314;2725;0;0 ERIC, /ILLEGAL CHARACTER 6311;6314;6305;707;6314;1640;6710;1301;6701;2303;305;322 ERLNI, /LABEL MAY NOT BE INDIRECT 6314;1301;5305;0314;6715;4701;6240;7716;6324;1240;6305;4640;6316 4704;6322;1705;324;0 ERMDL, /MULTIPLY DEFINED LABEL 6315;6325;6724;311;5314;331;6304;3305;6311;2716;6304;6240 6301;2702;314;0 ERID, /ILLEGAL DELIMITER 6311;6314;6305;707;6314;2240;6305;4714;6715;2311;305;322 ERUC, /UNRECOGNIZED COMMAND 6725;1316;6305;7703;6307;4716;6332;2305;6240;7703;6315;715;316;304 ERARTB, /MAGNITUDE OF ARGUMENT IS TOO LARGE 6315;3701;6716;2311;6325;2704;6240;3317;6640;1301;6307;6725;6705 2316;6640;1711;6240;7724;6317;6240;6301;3722;305;0 ERNAE, /ARGUMENT MAY NOT FOLLOW AN EQUAL 6301;3722;6325;2715;5316;324;6715;4701;6240;7716;6324;3240;6317 6314;5317;327;5301;316;6705;2721;301;314 ERMHA, /OR MUST BE PRECEDED AND FOLLOWED BY A NAME 5317;322;6715;1725;6324;1240;6705;240;6322;1705;6305;2305;5305;304;6301 2316;6240;7706;6314;7714;6327;2305;6640;4702;5240;301;6316;6701;305;0 EROOT, /ONLY ONE TRANSFER IS LEGAL 6317;6316;6331;7640;5316;305;6324;722;6316;3323;5305;322;5311;323 6314;3705;301;314 ERTFA, /TOO FEW ARGUMENTS 6324;7717;6240;2706;6327;640;6722;2707;6315;7305;324;323 ERSTC, /SAME TRANSFER CONDITION 6323;6701;6705;2240;6322;7301;6323;2706;6322;1640;6317;2316;6311;4724 317;316 ERNLD, /NO LABELS DEFINED FOR INDIRECT TABLE 5316;317;6314;1301;6705;1714;6240;2704;6306;7311;5305;304;6706;1317 6240;7311;6705;2303;6240;724;6302;2714;0;0 ERCNT, /CANT ENTER OUTPUT FILE 6303;7301;6324;2640;6316;2724;6322;7640;6725;324;5325;324;6306;6311 305;0 ERAGVO, /GEN VAR OVERFLOW 6307;7305;6240;726;6322;7640;6726;1305;6306;7714;327;0 TOPF1=. /TOP OF FIELD 1 STORAGE $$$$$$$$$$$$$$$$$$$