/ 8BAL : PDP-8 MACRO LANGUAGE /PB / / / / 8BAL---MACRO PROCESSOR FOR THE PDP-8 / REQUIRES PS/8 AND AT LEAST 8K OF CORE / WRITTEN BY DAVID M. KRISTOL, SUMMER, 1971 / / THIS IS 8BAL VERSION 4.1 7DEC72 / / / ASSEMBLY PARAMETERS: / INBLSZ: NUMBER OF RECORDS IN INPUT BLOCK / OUBLSZ: NUMBER OF RECORDS IN OUTPUT BLOCK / MPCHR: CHARACTER TO BE USED TO DISTINGUISH / 8BAL TEXT. SUGGESTED: @ OR # / TBLSLT: NUMBER OF SYMBOL TABLE SLOTS / HTBLST: HALF OF TBLSLT + 1 / LNKNUM: NUMBER OF LINKS ALLOWED / MCARG: NUMBER OF MACRO ARGUMENTS / INCLUDES 1 FOR POTENTIAL LABEL / SFLD: FIELD FOR STRING STORAGE / PFLD: FIELD FOR PUSH DOWN STORAGE / NOTE!!: OVERFLOW CHECKS IN / 'LNKCHK', 'PUSHA' MUST REFLECT / VALUES OF SFLD, PFLD / / /FOLLOWING FOUR PARAMETERS SET BY TABLE ENTRIES /IN FIELD 1 --TBL12K, TBL16K / INBLSZ= 8K:1; 12K:2; >12K:7 / OUBLSZ= 8K:2; 12K:3; >12K:8 / SFLD= 8K:10; 12K:20; >12K:30 / PFLD= 8K:10; 12K:10; >12K:20 MPCHR="@ LINLIM=200 DECIMAL TBLSLT=91 HTBLST=46 LNKNUM=TBLSLT /NUMBER OF LINKS MCARG=15 /14 MACRO ARGUMENTS PLUS LABEL OCTAL ZZZ=0 /TO INDICATE FILL-INS FIELD 0 *0 4;HLT /FOR SAFETY SAKE *5 /PUT IN START-UP PATCH HERE XSTART, CDF CIF 10 /FIELD 1 JMP I .+1 START /DO REAL START-UP /THIS AREA USED BY CORS AND TEMPORARIES!! /NOTE OVERLAP IN DEFINITIONS, BELOW *10 CORS, .-. /GET CORE SIZE CDF 20 /TRY FOR FIELD 2 CLA STL RTR /2000 DCA I CORLNK CLA TAD I CORLNK NOP CDF 0 TAD (-2000 SZA CLA /IS THERE A FIELD 2? JMP CORE1 /NO CDF 30 /YES. TRY FIELD 3 CLA STL RTR DCA I CORLNK CLA TAD I CORLNK NOP CDF 0 TAD CORLOC TAD (-2000 SNA CLA IAC IAC CORE1, IAC CDF CIF 10 /RETURN TO FIELD 1 JMP I CORS CORLNK, CORLOC CORLOC, 0 /PB /***************************************** *10 /OVERLAPPED USAGE BEGINS HERE XR10, *.+1 XR11, *.+1 XR12, *.+1 XR13, *.+1 XR14, *.+1 CDP, *.+1 /POINTER TO FIELD 1 CD INPUT LIST GATHBF, *.+3 /OUTPUT FROM 'GATHER': UP TO SIX CHAR FIELD SCANP1, *.+1 /POINT TO BEGINNING OF SCAN - 1 SCANP2, *.+1 /POINT TO SEPARATOR THAT ENDS SCAN SCANP3, *.+1 /POINT TO FIRST NON-SPACE IN SCAN (=SCANP1) SEPCOD, *.+1 /SEPARATOR CODE FROM LAST CALL TO 'CCHECK' TBLWD1, *.+1 /POINTER TO 'TYPE' WORD IN SYMBOL TABLE TBLWD2, *.+1 /POINTER TO 'VALUE' WORD IN SYMBOL TABLE TBLFLG, *.+1 /'LOOKUP' 'WRONG TYPE' FLAG: /0 : RIGHT NAME, WRONG TYPE /7777 : ANY OTHER SITUATION MATCP1, *.+1 /POINTER TO LAST MATCHING CHARACTER OF /LAST SUCCESSFUL PATTERN MATFLD, *.+1 /POINTER TO FIELD IN LAST SUCCESSFUL PATTERN MQ, *.+1 /* EAE SIMULATOR LOCATIONS AC, *.+1 /* EAESC, *.+1 /* LINCNT, *.+1 /- COUNT FOR CURRENT LINE IN LINBUF LINBUF, *.+1 /POINTER TO CURRENT LINE BUFFER - 1 MCXALK, *.+1 /MACRO EXPANSION: ARGUMENT LINK # MCXBLK, *.+1 /MACRO EXPANSION: MACRO BODY LINK # LINSV1, *.+1 /SAVE LINE # FOR 'IF', 'RET' LOOPS LINSV2, *.+1 /SAVE LINE # FOR 'IRP' /*********************END OF SHARED AREA *CORLOC+1 /THESE CELLS ARE ALL INITIAL VALUES! LNKEND, 1 /LOWER BOUND FOR LINK STORAGE LNKLIM, ZZZ /8K:0 (USE PUSHP); 12K:7600; >12K:7600 PUSHP, 6177 /8K:6177; 12K:5177; >12K:7577 PUSHST, 6177 /PD INITIAL VALUE (SEE PUSHP) MACON, 0 /MACRO EXPANDER 'ON' SWITCH: 1 = EXPANDING OCTDEC, 0 /OCTAL-DECIMAL CONVERSION SWITCH: / 0 - OCTAL. 1 - DECIMAL DLTESW, 0 /SET TO 1 IF LINK HAS BEEN DELETED /(USED BY 'MACX') PAGES, 1 /NUMBER OF EDITOR PAGES SO FAR. INITIALLY 1 LINES, 0 /NUMBER OF LINES (I.E., CR'S) READ, THIS /PAGE. GETS PUSHED AND CLEARED BY MACX, /RESET BY 'IRP' AND LOOPING 'IF' INHNDL, 0 /ADDRESS OF CURRENT INPUT HANDLER OUHNDL, ODUMMY /ADDRESS OF CURRENT OUTPUT HANDLER /INITIALLY 'ODUMMY' INPUT, RDCHR /ADDRESS OF PRESENT INPUT ROUTINE (CAN ALSO /BE 'MACINP') OUTCD, 0;FILENAME 8BALOU.TM /FILE NAME SET UP /SO 8BALOU.TM WILL BE USED AS /NAME IF CHAINING WITH NO NAME /OCCURS SF, .-. /CHANGE DATA FIELD TO SFLD CDF 10 /8K:10; 12K:20; >12K:30 JMP I SF /RETURN SFLD=JMS SF /DEFINE OPERATION /SWAP ROUTINES FOR LIBRARY SEARCHING SYSHND=7607 /SYSTEM HANDLER SWOUT, .-. /SWAP IN LIBRARY ROUTINES, /SWAP OUT BASIC 8BAL STUFF NOP /CHANGED BY /Y TO ISZ TBLFLG /COMING FROM LOOKUP: UNDEFINED? JMP MPEXPD /NO. OTHER SYMBOL TYPE THAN MACRO JMS I (SYSHND /CALL SYS HANDLER 4400 /WRITE FOUR PAGES RCSET /STARTING AT RCSET 33 /BLOCK 33 (MONITOR FIELD 0 AREA) JMP FNDMER /ERROR JMS I (SYSHND 401 /READ FOUR PAGES FORWARD RCSET 46 /END OF LOADER AREA JMP FNDMER JMP I FNDML FNDML, FNDMAC /GETS INCREMENTED, FIRST CALL SWIN1, TAD (MPEXPD /SWAP IN BASIC 8BAL STUFF DCA SWOUT /DIDN'T FIND MACRO /SET UP TO JUST EXPAND LINE SWIN2, JMS I (SYSHND 400 RCSET 33 /READ GOOD STUFF BACK IN SKP CLA JMP I SWOUT ZSYSHN=[SYSHND /USED BY FNDMAC OVERLAY FNDMER, JMS I [SERROR /SYSTEM TYPE ERROR "M /NO RETURN PUTCS2, .-. /FROM PUTCHR. CHECK CORE OVERFLOW CLL TAD (200 SZL /ADDRESS >=7600?? JMS I [TERROR /YES. HURTING!! TAD (-200 /NO. RESTORE POINTER JMP I PUTCS2 /RETURN XPND, .-. /DO TWO PASS EXPAND JMS XPND1 /FIRST PASS IAC JMS XPND1 /1 INDICATES SECOND PASS JMP I XPND /RETURN /PB /PB PAGE GETCHR=. /GET CHAR BY TWO POINTERS /ALSO, ALTERNATE STARTING POINT OF /PROGRAM, BECAUSE OF ONCE-ONLY CODE /JUMPING TO START-UP JMP XSTART /THIS GETS CLOBBERED WITH FIRST /SUBROUTINE CALL, BUT IT WILL HAVE /SERVED ITS PURPOSE TAD I GETCHR /POINTER TO POINTERS ISZ GETCHR DCA GETCPB TAD I GETCPB /POINTER TO BUFFER ISZ GETCPB /'GETPCB' POINTS NOW TO BYTE DCA GETCPP TAD I GETCHR /FIELD OF BUFFER ISZ GETCHR DCA GETC1 TAD I GETCPB /BYTE INDICATOR GETC1, ZZZ SPA CLA /THIRD BYTE? JMP .+4 /YES TAD I GETCPP /NO. SIMPLE FETCH AND [377 JMP GETC2 TAD I GETCPP AND (7400 CLL RTR RTR DCA GETCT1 /FIRST HALF CMA TAD GETCPP DCA GETCPP TAD I GETCPP AND (7400 TAD GETCT1 CLL RTR RTR GETC2, CDF 0 DCA GETCT1 /SAVE FOR A MOMENT TAD I GETCPB CLL RAL SMA SNL STL RTR DCA I GETCPB /CHANGE BYTE INDICATOR TAD I GETCPB SPA CLA /BECOME -? JMP GETC3 /YES. DON'T CHANGE POINTER CLA CMA TAD GETCPB DCA GETCPP /POINT AT POINTER ISZ I GETCPP /INCREMENT IT GETC3, TAD GETCT1 /RETRIEVE CHAR JMP I GETCHR /AND RETURN GETCT1, 0 /TEMPORARY GETCPP, 0 GETCPB, 0 PUTCHR, .-. /PUT CHARACTER INTO BUFFER BY /POINTER TO POINTERS AND [377 DCA PUTCT1 /SAVE CHARACTER TAD I PUTCHR ISZ PUTCHR DCA PUTCPB /SAVE POINTER TO POINTERS TAD I PUTCPB ISZ PUTCPB JMS PUTCS2 /CHECK FOR OVERFLOW DCA PUTCPP /SAVE POINTER TAD I PUTCHR /FIELD ISZ PUTCHR DCA PUTC1 TAD I PUTCPB /GET BYTE PUTC1, ZZZ SPA CLA /THIRD BYTE? JMP PUTC2 /YES TAD I PUTCPP /GET OLD CONTENTS AND (7400 TAD PUTCT1 DCA I PUTCPP /JUST PUT AWAY JMP PUTC3 PUTC2, TAD PUTCT1 CLL RAR JMS PUTCS1 CMA CML /TO PERMIT LINK TO STAY SAME TAD PUTCPP DCA PUTCPP /BACK UP POINTER TAD PUTCT1 JMS PUTCS1 PUTC3, CDF 0 TAD I PUTCPB CLL RAL SMA SNL STL RTR DCA I PUTCPB /SAVE UPDATED BYTE TAD I PUTCPB SPA CLA /- ? JMP I PUTCHR /YES CMA TAD PUTCPB DCA PUTCPP ISZ I PUTCPP /INCREMENT POINTER JMP I PUTCHR PUTCPB=GETCPB /SHARE FOR SPACE PUTCPP=GETCPP /LIKEWISE PUTCS1, .-. /PUTCHR SUBR. RTR RTR DCA PUTCT1 /SAVE TEMP TAD I PUTCPP /OLD CONTENTS AND [377 DCA I PUTCPP /SAVE BACK TAD PUTCT1 AND (7400 /JUST 4 BITS TAD I PUTCPP DCA I PUTCPP /ALL TOGETHER NOW,... JMP I PUTCS1 PUTCT1, 0 LFSUP, .-. /SUPPRESS MORE THAN 1 CONSECUTIVE /LINE FEED DCA LFSPT1 /SAVE CHAR TAD LFSPT1 TAD (-212 /CHECK FOR LF SZA CLA /IS THIS CHAR A LF? JMP LFSP1 /NO CMA /YES. PREPARE TO SET SWITCH ISZ LFSPI1 /PREVIOUS LF SET LF SWITCH? JMP LFSP1 /NO. OUTPUT LF, SETTING SWITCH DCA LFSPI1 /YES. SET SWITCH, IGNORE CHAR JMP I LFSUP LFSP1, DCA LFSPI1 /SET SWITCH: 0 = ANYTHING BUT LF, / -1 = LF TAD LFSPT1 /PICK UP CHAR AGAIN JMS I [PUTCHR /PUT CHAR IN OUTPUT BUFFER WRTCP1 CDF 10 JMP I LFSUP LFSPT1, 0 LFSPI1, 0 /INITIALLY 0 /PB /PB PAGE / / ELEMENTAL I/O ROUTINES / RDCHR, .-. /READ ONE CHAR FROM INPUT DEVICE ISZ RDCHC1 /COUNT OVERFLOW? JMP RDCH2 /NO RDCH1, JMS I INHNDL /GET NEXT BUFFER LOAD 210 /COMMAND WORD /8K:210; 12K:410; >12K:1610 INBUFP, 7200 /8K:7200; 12K:6600; >12K:4200 INBLK, ZZZ /BLOCK TO READ SMA CLA /FATAL ERROR? JMP .+3 /NO. ASSUME TTY EOF IOERR, JMS I [SERROR /YES. SYSTEM ERROR AND TERM. "I TAD INBLSZ TAD INBLK DCA INBLK /FOR NEXT READ TAD INBUFP DCA RDCHP1 DCA RDCHP1+1 /SET POINTER AND BYTE TAD INBLCT /BUFFER LENGTH (CHARS) DCA RDCHC1 /CHARACTER COUNT RDCH2, JMS I [GETCHR RDCHP1 CDF 10 /FIELD 1 AND (177 TAD [200 /MAKE WELL-BEHAVED CHARS TAD (-232 /^Z SNA JMP RDCH3 /END OF FILE ENCOUNTERED TAD (232-377 /CHECK FOR RUBOUT SNA JMP RDCHR+1 /GET ANOTHER CHARACTER TAD [377 JMP I RDCHR /RETURN FETCHED CHARACTER RDCH3, CDF 10 TAD I CDP /COMMAND DECODER, NEXT FILE CDF 0 SNA /0? JMP INEOF /COMPLETE END OF FILE DCA RDCHT1 /SAVE CDF 10 TAD I CDP DCA INBLK /SAVE STARTING BLOCK CDF 0 TAD (INHNDB /INPUT HANDLER BUFFER (1 PAGE) DCA INHNDP TAD RDCHT1 CIF 10 JMS I [7700 /FETCH HANDLER 1 INHNDP, INHNDB JMP RDCH4 /ERROR TAD INHNDP DCA INHNDL /SAVE ENTRY POINT JMP RDCH1 /TRY AGAIN RDCH4, JMS I [SERROR /ERROR FETCHING HANDLER "H RDCHC1, -1 /COUNT /^ SET AS INITIAL VALUE RDCHT1, 0 RDCHP1, 0;0 /READ POINTERS INBLSZ, 1 /8K:1; 12K:2; >12K:7 INBLCT, -600 /8,12,>12K:-600*INBLSZ WRTCHR, .-. /WRITE CHARACTER TO OUTPUT DEVICE JMS LFSUP /PUT CHAR, SUPPRESS EXTRA LF'S ISZ WRTCC1 /INCREMENT COUNT JMP I WRTCHR /KEEP GOING JMS OUTBUF /OUTPUT BUFFER JMP I WRTCHR WRTCC1, -1400 /ALL: -600*OUBLSZ WRTCP1, 6200;0 /8K,12K,>12K:C(OUTBFP) /ABOVE IS INITIAL VALUE OUTBUF, .-. /FILL BUFFER TO EVEN PAGE, PURGE OUTB1, TAD OUTBFP /GET BUFFER POINTER CIA TAD WRTCP1 /GET OFFSET OF BUFFER PAGE AND (177 /MODULO 200 SNA CLA /EVEN PAGE? JMP .+3 /YES JMS LFSUP /NO. USE LFSUP TO WRITE CHAR JMP OUTB1 /CONTINUE TAD OUTBFP /BUFFER POINTER CIA TAD WRTCP1 /GET OFFSET AGAIN CLL RAR /START # OF PAGES AT BIT 5 (NOT 4) TAD (4010 /MAGIC # TO CREATE CONTROL WORD: /WRITE, FIELD 1 DCA OUTBT1 /SAVE CONTROL WORD TAD OUTBT1 /GET CONTROL WORD BACK TAD (100-4010 /STRIP OFF BITS WE JUST ADDED, CAUSE /ROUND UP TO NEAREST BLOCK CLL RTL RTL RTL /SAME AS R7R DCA OUTBT2 /SAVE # OF BLOCKS WRITTEN TAD OUTBT2 /GET BACK TAD OUTFSZ /PRESENT FILE LENGTH DCA OUTFSZ /SAVE UPDATED LENGTH CLL /FOR TEST TAD OUTFSZ TAD OUTFLM /FILE LENGTH LIMIT SZL /EXCEED LIMIT? JMS I [SERROR /YES. GIVE ERROR 'L' "L /NO. FALL THROUGH HARMLESSLY /NO RETURN FROM SERROR JMS I OUHNDL /OUTPUT GOODIES OUTBT1, ZZZ /COMMAND WORD /8K:4410; 12K:4610; >12K:6010 OUTBFP, 6200 /8K:6200; 12K:5200; >12K:200 OUTBLK, ZZZ /BLOCK NUMBER JMP IOERR /FATAL WRITE ERROR TAD OUTBT2 TAD OUTBLK DCA OUTBLK /UPDATE OUTPUT BLOCK TAD OUTBFP DCA WRTCP1 /SET POINTER DCA WRTCP1+1 /AND BYTE TAD OUBLCT /OUTPUT BUFFER LENGHT (CHARS) DCA WRTCC1 /SAVE COUNT JMP I OUTBUF OUTFLM, 0 /LIMIT OF OUTPUT FILE (FROM CD) OUBLCT, -1400 /8K,12K,>12K: -600*OUBLSZ OUTBT2, 0 /PB /PB PAGE GETLIN, .-. /GET ONE LINE OF INPUT TAD [LNBUF1-1 DCA XR14 TAD XR14 DCA LINBUF /SAVE LINE START TAD LINBUF DCA SCANP2 /AND SCAN POINTER DCA LINCNT /FOR CHECKING O'FLOW GETL1, JMS I INPUT /NO. GET CHAR. MAY BE FROM RDCHR /OR MACINP DCA GETLT1 TAD LINCNT SZA CLA /FIRST CHAR ON LINE? JMP GETL2 /NO TAD GETLT1 /YES TAD (-212 SNA /LF? JMP GETL3 /YES TAD (-214+212 SNA /FF? JMP GETL2A /YES. MARK OFF PAGE TAD (-200+214 SNA CLA /LT CODE? JMP GETL3 /YES TAD (-LINLIM-1 /SET COUNT DCA LINCNT GETL2, ISZ LINCNT /END OF LINE? JMP .+3 /NO DCA I XR14 /YES. MARK FOR ERROR JMS I [TERROR /TABLE OVERFLOW TAD GETLT1 DCA I XR14 /SAVE CHAR TAD GETLT1 TAD [-215 /REACH END OF LINE? SZA CLA JMP GETL1 ISZ LINES /MARK OFF ANOTHER LINE TAD LINCNT CIA TAD (-LINLIM-1 DCA LINCNT /CORRECT COUNT KSF /ANYTHING TYPED? JMP I GETLIN /NO KRS /READ WITHOUT CLEARING FLAG TAD (-203 /-^C SZA CLA /IS THAT WHAT AM? JMP I GETLIN /NO. KEEP GOING JMS ERRLST /YES. LEAVE INDICATION OF PLACE JMP I [7600 /BEFORE RUNNING OFF GETL2A, ISZ PAGES /MARK ANOTHER PAGE DCA LINES /CLEAR LINES COUNTER GETL3, TAD GETLT1 /FETCH CHAR JMS WRTCHR /PASS TO OUTPUT JMP GETL1 /CONTINUE GETLT1, 0 CCHECK, .-. /CHECK CHAR FOR SEPARATOR DCA CCHKT1 /SAVE TAD CCHKT1 TAD (-"0 SPA /LEGAL RANGE JMP CCHK2 /NO TAD ("0-"9 SPA SNA JMP CCHK1 /OKAY FOR NUMERAL TAD ("9-"A SPA /IN RANGE JMP CCHK2 /NO TAD ("A-"Z CCHK1, SPA SNA CLA JMP I CCHECK /LEGAL ALPHA CHAR CCHK2, CLA TAD (CCHKL1-1 DCA XR12 CCHK3, TAD I XR12 SNA JMP CCHK4 /REACHED END OF LIST TAD CCHKT1 SNA CLA /CHAR MATCH TABLE? JMP CCHK4 /YES ISZ XR12 /NO. SKIP SEP. VALUE JMP CCHK3 /KEEP GOING CCHK4, TAD I XR12 /GET SEPCOD VALUE DCA SEPCOD /SAVE SEPARATOR VALUE ISZ CCHECK JMP I CCHECK /RETURN CCHKT1, 0 LNKGET, .-. /GET COUNT AND POINTER FOR /LINK # IN AC TAD (LNKLST-1 DCA LNKGP1 /POINT TO LINK CHAIN TAD I LNKGP1 SNA /NULL LINK?? JMS I [IERROR /INTERNAL ERROR DCA LNKGP1 /POINTER TO SFLD STORAGE SFLD TAD I LNKGP1 /GET CHAR COUNT CDF 0 CIA DCA I LNKGET /SAVE AS ARG 1 ISZ LNKGET IAC TAD LNKGP1 /RETURN POINTER TO GOODIES JMP I LNKGET LNKGP1, 0 PUSHA, .-. /PUSH ONE WORD INTO PD LIST CDF 10 /8K:10; 12K:10; >12K:20 DCA I PUSHP CDF 0 CMA STL TAD PUSHP DCA PUSHP /LINK NOW CLEAR TAD PUSHP /8K:USE INSTEAD OF 'LNKLIM' PUSHA1, CIA CLL /8K; >8K:SZA CLA TAD LNKEND /8K; >8K:JMP I PUSHA SNL CLA /8K; >8K:JMS I [TERROR JMP I PUSHA JMS I [TERROR /PB /PB PAGE LNKCHK, .-. /CHECK LINK FOR STORAGE O'FLOW TAD LNKEND DCA I LNKRP1 /SET LINK POINTER FINALLY TAD I LNKCHK ISZ LNKCHK SFLD DCA I LNKEND /STORE COUNT TAD I LNKEND JMS LNKCNT /FORM COUNT IAC /INCLUDE COUNT IN COUNT TAD LNKEND DCA LNKEND /NEW END POINT OF STORAGE TAD PUSHP /8K; >8K:TAD LNKLIM CIA CLL LCHK1, TAD LNKEND SNL CLA /O'FLOW? JMP I LNKCHK /NO JMS I [TERROR /SPACE EXCEEDED LNKDEL, .-. /DELETE LINK (# IN AC) SNA /LINK ZERO DOESN'T EXIST JMP I LNKDEL TAD (LNKLST-1 DCA LNKDT1 TAD I LNKDT1 DCA LNKDT2 /STARTING POINT OF LINK DCA I LNKDT1 /KILL REFERENCE IN LNKLST SFLD TAD I LNKDT2 /COUNT JMS LNKCNT /FORM COUNT CMA /GIVES -(WORD COUNT + 1) DCA LNKDT3 TAD LNKDT3 CMA TAD LNKDT2 DCA XR10 /'FROM' ADDRESS CMA TAD LNKDT2 DCA XR11 /'TO' ADDRESS TAD (LNKLST DCA LNKDT1 TAD (-LNKNUM DCA LNKDC1 /NUMBER OF LINKS TO CHANGE LNKD1, TAD I LNKDT1 /GET LINK SNA /IGNORE EMPTY LINK JMP LNKD2 CMA STL TAD XR10 /> DELETED LINK? SNL CLA JMP LNKD2 /NO TAD I LNKDT1 /YES TAD LNKDT3 /CREATE 'NEW' ADDRESS DCA I LNKDT1 LNKD2, ISZ LNKDT1 /NEXT LINK ISZ LNKDC1 /DONE? JMP LNKD1 /NO TAD LNKEND TAD LNKDT3 DCA LNKEND /CHANGE END TAD LNKEND CMA TAD XR11 IAC SNA JMP I LNKDEL /DONE IF NOTHING TO MOVE DCA LNKDC1 SFLD TAD I XR10 DCA I XR11 ISZ LNKDC1 JMP .-3 CDF 0 IAC DCA DLTESW /LEAVE INDICATOR FOR MACX JMP I LNKDEL LNKDT1, 0 LNKDT2, 0 LNKDT3, 0 LNKDC1, 0 LNKCRT, .-. /CREATE NEW LINK TAD (-LNKNUM DCA LNKRC1 TAD (LNKLST DCA LNKRP1 LNKR1, TAD I LNKRP1 SNA CLA /FIND EMPTY SLOT? JMP LNKR2 /YES. SET UP LINK ISZ LNKRP1 /NO. POINT AHEAD ISZ LNKRC1 /SEARCH ALL SLOTS? JMP LNKR1 /NO JMS I [TERROR /OUT OF SLOTS LNKR2, TAD LNKEND IAC DCA I LNKCRT /SAVE DATA ADDRESS ISZ LNKCRT /SKIP TAD LNKRP1 TAD (-LNKLST+1 /GENERATE LINK NUMBER JMP I LNKCRT LNKRP1, 0 LNKRC1=. /TO SAVE MORE SPACE LNKCNT, .-. /FORM WORD COUNT FROM CHAR COUNT CDF 0 IAC CLL RAL /MULTIPLY BY 2 DCA MQ RAL /PUT LINK IN LOW ORDER AC JMS I [DVI 3 JMS I [CLAMQA JMP I LNKCNT TRNSFR, .-. /TRANSFER ACCORDING TO SEPCOD TAD TRNSFR DCA TRNSP1 /IF NO MATCH, RETURN HERE TAD SEPCOD CMA STL /WATCH THE LINK! DCA TRNSC1 /SAVE COUNT ISZ TRNSFR TAD I TRNSFR /GET MATCH MASK TRNS1, SZL /BIT SET? ISZ TRNSFR /YES. SKIP CLL RAL ISZ TRNSC1 /REACH PROMISED LAND? JMP TRNS1 /NO SZL CLA /YES. BIT SET? JMP I TRNSFR /YES JMP I TRNSP1 /NO TRNSP1=LNKDT2 /CHEAT AGAIN TRNSC1=LNKDT1 /CHEAT /PB /PB PAGE GATHER, .-. /COLLECT CHARACTERS OF FIELD ISZ SCANP2 TAD SCANP2 DCA SCANP1 /SET POINTER TAD SCANP2 DCA SCANP3 /THIS ONE TOO TAD (GATHBF DCA GATHP1 /FOR COLLECTED FIELD CMA CLL RAL /-2 DCA GATHBT /BYTE DCA GATHBF /CLEAR BUFFER DCA GATHBF+1 DCA GATHBF+2 TAD (-6 DCA GATHC1 /FIELD LENGTH GATH1, TAD I SCANP2 JMS I [CCHECK /CHECK CHAR JMP GATH2 /ALPHA-NU TAD GATHBF /SEP. SZA CLA /ANY FIELD? ISZ GATHER /YES JMP I GATHER /RETURN GATH2, TAD GATHC1 SNA CLA /COUNT ALREADY 0? JMP GATH3 /YES. DON'T BUFFER TAD I SCANP2 /NO. GET CHAR AND [77 /SAVE TRIMMED ONLY DCA GATHT1 TAD I GATHP1 CLL RTL RTL RTL TAD GATHT1 DCA I GATHP1 ISZ GATHBT /DONE WORD? JMP .+4 ISZ GATHP1 /YES CMA CLL RAL /POINT AHEAD, RESET BYTE DCA GATHBT ISZ GATHC1 /INDICATE CHAR SEEN GATHT1, ZZZ /TEMP. GATH3, ISZ SCANP2 JMP GATH1 /PROCEED GATHBT, 0 GATHC1, 0 GATHP1, 0 POP, .-. /POP PARAMS BY LIST CLA CMA /-1 TAD I POP DCA XR12 /USE FOR CHEAPNESS SAKE ISZ POP POP1, TAD I XR12 SNA /0 ADDRESS? JMP POP3 /YES DCA POPP1 CMA CLL RAL /-2 TAD XR12 DCA XR12 /BACK UP TAD I XR12 DCA POPC1 /COUNT TAD POPC1 CMA TAD POPP1 DCA POPP1 /START AT END! CLL CMA RAL /-2 TAD XR12 DCA XR12 POP2, JMS POPA /GET ONE WORD DCA I POPP1 CMA TAD POPP1 DCA POPP1 ISZ POPC1 JMP POP2 JMP POP1 POP3, CLL CMA RAL /-2 TAD XR12 DCA XR12 TAD I XR12 SNA JMP I POP DCA POPP1 JMS POPA DCA I POPP1 JMP POP3 POPC1, 0 POPP1=. /FOR SPACE TYO, .-. /YEA OLDE TELETYPE OUTPUT JMP .+3 /FIRST TIME TSF JMP .-1 TLS CLA TAD MCRT1 /SKP, WHICH DOES NOTHING DCA TYO+1 /SO WE SAVE TIME LATER JMP I TYO MCRET, TAD MACON /FORCED RETURN FROM MACRO, SKIP SNA CLA /PRESENTLY EXPANDING MACRO? JMS I [EERROR /NO. ERROR JMS MACPOP /YES. RESTORE STATUS /FALL THROUGH TO DETERMINE # OF /LINES TO SKIP ISZ MATCP1 /FIRST CHECK FOR MPCHR TAD I MATCP1 TAD [-MPCHR SZA CLA /SEE MPCHR? JMP MPSKIP /NO. TRY FOR EXPR ISZ MATCP1 /YES. CHECK FOR SEPARATOR TAD I MATCP1 JMS I [CCHECK /LOOK FOR ANY SEPARATOR MCRT1, SKP /SAW ALPHA JMP IF7 /SAW SEPARATOR. CAUSE LOOP MPSKIP, JMS EVAL /MATCH HAS SET EVERYTHING UP. /EVALUATE EXPRESSION MPSK1, SPA SNA /=>0? (IF10 JUMPS HERE!) JMP MPSK2 /NO. IGNORE SKIP CIA /YES DCA MPSC1 /SAVE COUNT JMS GETLIN /GET LINE ISZ MPSC1 /IGNORE IT. DONE SKIPPING? JMP .-2 MPSK2, CLA /FOR MPSK1+1 JMP I [INLUP /PROCESS NEXT LINE MPSC1, 0 /COUNT /PB /PB PAGE / / TABLE LOOKUP ROUTINE / TABLE IS HASHED, QUADRATIC (CACM 1/68 - MAURER) / / CALL: JMS I [LOOKUP /LABEL IN GATHBF / IOR OF SYMBOL TYPE BITS (+40 TO CREATE) / ERROR RETURN / NORMAL RETURN / / ADDRESS OF DATA IN TBLWD1, TBLWD2 / / THIS IS TABLE OF RETURNS, DEPENDING ON CALL: / / FOUND WRONG CREATE? / TYPE? / Y Y Y /ERR. RET., TBLFLG=0 / Y Y N /ERR. RET., TBLFLG=0 / Y N Y /NOR. RET., TBLFLG=7777 / Y N N /NOR. RET., TBLFLG=7777 / N Y Y /*****NOT POSSIBLE / N Y N /*****NOT POSSIBLE / N N Y /NOR. RET. (CREATED), /TBLFLG=-1 / N N N /ERR. RET., TBLFLG=7777 LOOKUP, .-. TAD (-HTBLST DCA TBLSC1 /HALF OF TABLE ADEQUATE FOR SEARCH CMA /SET TBLFLG AS DEFAULT CONDITION DCA TBLFLG TAD (10 /ARBITRARY DCA TBLST2 /FIRST INCREMENT TAD GATHBF+2 /START HASH CLL RTR TAD GATHBF CLL RTR TAD GATHBF+1 CLL RTR /DONE HASH JMS I [MQLDVI TBLSK1, TBLSLT /DIVIDE BY TABLE LENGTH TBLS1, DCA TBLST1 /REMAINDER IS SLOT NUMBER TAD TBLST1 CLL RTL TAD TBLST1 /SLOT * 5 (SLOT SIZE) TAD (SYMTBL-1 DCA XR11 /POINT TO SLOT TAD I XR11 SNA JMP TBLS4 /SLOT EMPTY TAD GATHBF SZA CLA /FIRST CHARS MATCH? JMP TBLS2 /NO TAD I XR11 /YES TAD GATHBF+1 SZA CLA /SECOND TWO? JMP TBLS2 TAD I XR11 TAD GATHBF+2 SZA CLA /THIRD TWO? JMP TBLS2 /NO TAD I XR11 AND [7700 /GET 'TYPE BITS' AND I LOOKUP /LOOKING FOR THIS TYPE? SZA CLA JMP TBLS5 /YES. EVERYTHING HUNKY-DOREY DCA TBLFLG /NO. SET WRONG TYPE JMP TBLS6 TBLS2, ISZ TBLSC1 /TRY HALF OF TABLE? JMP TBLS3 /NO TAD (40 /YES AND I LOOKUP /TRYING TO CREATE ENTRY? SNA CLA JMP TBLS7 /NO. JUST RETURN 'NOT FOUND' JMS I [TERROR /YES. TABLE FULL TBLS3, ISZ TBLST2 /INCREMENT THE INCREMENT TAD TBLST2 TAD TBLST1 /FORM NEW SLOT NUMBER TAD (-TBLSLT SPA /EXCEED TABLE SIZE TAD TBLSK1 /NO. RESTORE VALUE JMP TBLS1 /AC HAS SLOT MODULO TABLE SIZE TBLS4, TAD (40 AND I LOOKUP /MASK CREATE BIT IN CALL SNA CLA /CREATE REQUESTED? JMP TBLS7 /NO. ERR. RET. (NOT FOUND) CMA /YES. BACK UP TAD XR11 DCA XR11 /FOR SUBROUTINE JMS TBLSUB /PUT GATHBF IN TABLE IAC /WATCH FALL THROUGH TBLS5, ISZ LOOKUP /SKIP ARG. WORD TBLS6, TAD XR11 /GET 'TYPE' WORD ADDRESS DCA TBLWD1 /SAVE IAC TAD TBLWD1 DCA TBLWD2 /VALUE WORD TBLS7, ISZ LOOKUP /INCREMENT ONE MORE TIME JMP I LOOKUP /RETURN TBLSC1, 0 TBLST1, 0 TBLST2, 0 TBLSUB, .-. /MOVE GATHBF THRU XR11 TAD GATHBF CIA DCA I XR11 TAD GATHBF+1 CIA DCA I XR11 TAD GATHBF+2 CIA DCA I XR11 JMP I TBLSUB PUSH, .-. /PUSH PARAMS BY LIST CLA CMA TAD I PUSH DCA XR12 ISZ PUSH PUSH1, TAD I XR12 SNA /DONE SINGLES? JMP PUSH2 /YES DCA PUSHP1 TAD I PUSHP1 JMS PUSHA DCA I PUSHP1 /CLEAR OLD REGISTER JMP PUSH1 PUSH2, TAD I XR12 SNA JMP I PUSH DCA PUSHC1 CMA TAD I XR12 DCA XR11 TAD I XR11 JMS PUSHA ISZ PUSHC1 JMP .-3 JMP PUSH2 PUSHP1, 0 PUSHC1, 0 IERROR, .-. /INTERNAL JMS I [ERROR "I JMP I [7600 TERROR, .-. /TABLE JMS I [ERROR "T JMP I [7600 /PUNT ON INTERNAL OR TABLE TTERR=[TERROR /FOR FIELD 1 INITIALIZATION /PB /PB PAGE / / PRINCIPLE LOOP OF PROGRAM / INLUP, JMS GETLIN /GET LINE TAD LINCNT /FETCH COUNT DCA INLPC1 /SAVE INLUP0, TAD SCANP2 /POINT TO BEGINNING OF LINE -1 DCA XR10 INLUP1, TAD I XR10 TAD [-MPCHR /MACRO PROCESSOR SIGNAL? SNA CLA JMP MPCHK /YES ISZ INLPC1 JMP INLUP1 INLUP2, JMS PUTLIN /OUTPUT LINE AS IS JMP INLUP /CONTINUE PROCESSING /CONTROL GOES TO 'INEOF' ON ^Z INLPC1, 0 INEOF, TAD (232 /WRITE EOF. GET HERE FROM 'RDCHR' JMS WRTCHR JMS OUTBUF /PURGE BUFFER CIF 10 JMS I [7700 /FETCH USR 10 /USRIN TAD OUTCD /POINTER TO OUTPUT FILE DESCRIPTION SNA /WAS THERE ONE? JMP INEOF2 /NO. AVOID TRYING TO CLOSE FILE CIF 10 JMS I [USR /CLOSE OUTPUT 4 OUTCD+1 /POINTER TO NAME OUTFSZ, ZZZ /OUTPUT FILE SIZE KEPT HERE JMP ENDER1 /CLOSING ERROR INEOF2, TAD GETLIN TAD (-INLUP-1 SZA CLA /GETLIN CALLED FROM INLUP? JMP ENDER2 /NO. MCDF OR IF RAN PAST EOF CMA /YES. TAD CHNDEV /DEVICE #, FIRST INPUT FILE SNA /1? JMP INEOF3 /YES SPA SNA CLA /NULL JMP I [7600 /YES TAD ("D-"R /WRONG DEVICE. (PRINT 'D') ENDER2, TAD ("R-"C /RAN OUT OF INPUT (PRINT 'R') ENDER1, JMS SERROR "C INEOF3, TAD OUTFSZ /WILL CHAIN AND (7400 /CHECK >377 SNA CLA /OUTPUT FILE > 255 BLOCKS? TAD OUTFSZ /NO CIA AND [377 /GET READY TO FORM INPUT CD FORMAT CLL RTL RTL DCA INEOF2 /SAVE MODIFIED FILE LENGTH TAD OUTFSZ CIA TAD OUTBLK /GIVES START BLOCK CDF CIF 10 /CIF FOR LATER DCA I (7620 /BLOCK OF CD FIRST INPUT TAD OUTCD AND (17 /DEVICE PART TAD INEOF2 /FORM CD INPUT WORD ONE, FILE 1 DCA I (7617 /STORE IN POSITION DCA I (7621 /0 TO END LIST CDF 0 /BACK TO THIS FIELD ISZ I (7746 /SET JSW TO FUDGE BUG IN /PAL8, ETC SINCE THEY THINK USR IS /ALWAYS IN CORE ON CHAINING JMS I [USR 6 /CHAIN CHNBLK, ZZZ /FROM START-UP /NO RETURN CHNDEV=. /USE SERROR, SINCE THERE'LL BE NO CHAIN /IF THAT ERROR COMES UP SERROR, .-. /SYSTEM RELATED ERROR TAD I SERROR TAD (-"0 /SINCE MONITOR ROUTINE ADDS /"0 TO WHAT IT THINKS IS A DIGIT DCA .+4 CIF 10 JMS I [7700 7 /SIGNAL USER ERROR /USE PUTLIN, SINCE WE'RE GOING /BYE-BYE PUTLIN, .-. /OUTPUT LINE TAD LINBUF DCA XR10 /POINTER DCA SCANP2 /IN CASE OF /W OPTION PUTL1, TAD I XR10 /GET CHAR TAD [-MPCHR SNA /FIND MPCHR? ISZ SCANP2 /YES. NOTE IT TAD [MPCHR /RESTORE CHAR JMS WRTCHR /WRITE IT ISZ LINCNT /DONE LINE? JMP PUTL1 /NO TAD SCANP2 /YES. FIND MPCHR? SZA CLA PUTL2, JMS ERRS1 /YES. PRINT LINE TAD MACON SNA CLA /MACRO EXPANSION ON? JMP I PUTLIN /NO TAD (212 /YES JMS WRTCHR /OUTPUT LF JMP I PUTLIN MCCRSM, .-. /CREATE AND SAVE MACRO CREATED /SYMBOL TAD ("Z /FIRST CHAR OF CRSM JMS I MCCRP1 /DISPOSE OF IT ISZ MCCRT1 /OBTAIN NEXT CRSM VALUE TAD MCCRT1 JMS DECOUT /PRODUCE DECIMAL MCCRP1, MACXS1 /PUSH DIGITS THRU MACXS1 4000 /PERMIT LEADING 0'S JMP I MCCRSM MCCRT1, 0 /CREATED SYMBOL # /PB /PB PAGE / / PATTERN MATCHING ALGORITHM FOR 8BAL. SEE PROGRAM / WRITE-UP FOR RESTRICTIONS AND DESCRIPTION OF PATTERN / STORAGE / MPCHK, TAD (PATLST-1 /LIST OF POINTERS TO PATTERNS DCA XR10 TAD SCANP2 DCA SCANP1 /PUT SCAN POINTER WHERE IT BELONGS TAD [MPEXPD DCA MPCHP2 /SET UP DEFAULT TRANSFER MPCH1, TAD I XR10 /GET POINTER TO PATTERNS SNA /END OF LIST? JMP MPCH2 /YES TAD (-1 /CORRECT POINTER DCA XR11 /NO. POINT TO CONTROL WORD DCA I XR11 /0 IT DCA I XR11 /AND FIELD POINTER JMP MPCH1 MPCH2, DCA MPCHI1 /0 LIVE INDICATOR TAD (PATLST-1 DCA XR10 /POINT TO POINTERS AGAIN ISZ SCANP1 /POINT TO NEXT CHARACTER IN LINE MPCH3, TAD I XR10 SZA /END OF PATTERN LIST? JMP MPCH4 /NO TAD MPCHI1 /YES. GET 'LIVE' INDICATOR SZA CLA /ANY PATTERN STILL ACTIVE? JMP MPCH2 /YES. CONTINUE TAD MATCP1 /NO. SET UP SCANP2 DCA SCANP2 JMP I MPCHP2 /AND GO WHERE INDICATED MPCH4, DCA MPCHP1 /POINT TO CONTROL WORD TAD I MPCHP1 SPA CLA /PATTERN REJECTED? JMP MPCH3 /YES JMS MATCH /NO. PATTERN MATCH CHARACTER? JMP MPCH5 /NO ISZ MPCHI1 /YES. SET 'LIVE' JMP MPCH3 /CONTINUE MPCH5, STL RAR DCA I MPCHP1 /SET REJECT BIT JMP MPCH3 MPCHP1, 0 MPCHP2, 0 /ADDRESS TO GO WHEN MATCHING /COMPLETE. MPCHI1, 0 /INDICATOR / / MATCH PATTERN CHAR TO LINE BUFFER CHAR / (IN (SCANP1)) / MATCH, .-. MATC1, TAD I MPCHP1 /CHARACTER NUMBER TAD MATCC3 /PATTERN IS AT +3 FROM THIS POINT AND [777 /KILL CONTROL BITS TAD MPCHP1 /FORM POINTER DCA MATCP2 /SAVE TAD I MATCP2 /GET PATTERN WORD SMA /SINGLE CHARACTER MATCH? JMP MATC4 /NO MATC1A, TAD I SCANP1 /YES. GET CHARACTER SZA CLA /MATCH? JMP I MATCH /NO. RETURN 'NO' MATC2, ISZ I MPCHP1 /INCREMENT CHARACTER NUMBER MATC3, ISZ MATCH /RETURN 'YES' JMP I MATCH MATC4, TAD .+3 /FORM JUMP DCA .+1 MATCP2, ZZZ JMP I .+1 MATCX0;MATCX1;MATCX2;MATCX3;MATCX4 MATCX0, IAC TAD MPCHP1 DCA MPCHP2 /POINT AT FIELD POINTER TAD I MPCHP2 DCA MATFLD /SAVE FIELD POINTER FOR LATER ISZ MPCHP2 /POINT AT TRANFER VECTOR TAD I MPCHP2 /GET IT DCA MPCHP2 /SAVE THIS FOR LATER, TOO CMA TAD SCANP1 DCA MATCP1 /KEEP POINTER TO CHAR JMP I MATCH /RETURN FAIL TO INACTIVATE PATTERN MATCX1, TAD I MPCHP1 /GET CONTROL BITS AND [1000 SZA CLA /NAME FIELD IN PROGRESS JMP MATC11 /YES TAD I SCANP1 /NOT YET. JMS I [CCHECK /IS CHARACTER ALPHA OR NUMBER? SKP /YES JMP I MATCH /NO TAD [1000 TAD I MPCHP1 DCA I MPCHP1 /SET FIELD BIT ISZ MPCHP1 CMA TAD SCANP1 DCA I MPCHP1 /SAVE FIELD POINTER JMP MATC3 /RETURN 'YES' MATC11, TAD I SCANP1 JMS I [CCHECK /IS CHARACTER ALPHA OR NUMBER? JMP MATC3 /YES SUCCEED TAD I MPCHP1 AND [777 /CLEAR CONTROL BITS DCA I MPCHP1 /AND SAVE CONTROL WORD ISZ I MPCHP1 /TRY NEXT CHARACTER IN PATTERN JMP MATC1 MATCX2, TAD [-MPCHR JMP MATC1A /SNEAK INTO SINGLE CHAR COMPARE MATCX3=MATC2 /AUTOMATIC 'SUCCEED' MATCX4, ISZ SEPCOD /FORCE NON-ZERO TAD I SCANP1 JMS I [CCHECK /CHECK CHAR (SET SEPCOD) MATCC3, 3 /SERVES AS NOP STL RTR AND I MPCHP1 SNA CLA /SPACE IN PROGRESS? JMP MATC41 /NO TAD SEPCOD /YES SNA CLA /WAS CHAR SPACE OR TAB? JMP MATC3 /YES TAD I MPCHP1 AND [777 DCA I MPCHP1 /REMOVE CONTROL BITS JMP MATCX2 /AND LOOK FOR MPCHR MATC41, TAD SEPCOD SZA CLA /SPACE OR TAB? JMP I MATCH /NO. FAIL STL RTR TAD I MPCHP1 DCA I MPCHP1 /SET SPACES BIT JMP MATC3 /RETURN 'YES' /PB /PB PAGE XPND1, .-. /PERFORM ONE PASS EXPANSION DCA XPNDI2 /SAVE PASS # (0 OR 1 FOR 1 OR 2) TAD SCANP2 DCA XPNDSV /SAVE DCA XPNDI1 /CLEAR INDICATOR XPND2, ISZ SCANP2 /LOOK AT NEXT CHAR XPND3, TAD I SCANP2 /GET CHAR TAD [-MPCHR SNA CLA /MPCHR? JMP XPND6 /YES TAD I SCANP2 /NO TAD [-215 SNA /HOW ABOUT CR? JMP XPND12 /YES TAD (-"'+215 SNA CLA /HOW ABOUT ' ? JMP XPND5 /YES TAD XPNDI1 /NO SNA CLA /MOVED ANY CHARS YET? JMP XPND2 /NO XPND3A, TAD I SCANP2 /YES XPND4, DCA I XR13 /SAVE CHAR JMP XPND2 XPND5, JMS XPNDS1 /MAKE SURE POINTERS ARE SET JMP XPND2 /THEN, DO NEXT CHAR XPND6, JMS XPNDS1 /MAKE SURE POINTERS ARE SET JMS I [GATHER /GET NAME AFTER MPCHR JMP XPND10 /NO FIELD JMS I [LOOKUP 7000 /SET, SSET, CSET JMP XPND7 /NOT FOUND TAD I TBLWD1 /GET SYMBOL TYPE WORD CLL RTL /CSET BIT IN LINK SNL /CSET? JMP XPND20 /NO. SSET OR SET TAD I TBLWD2 /CSET. GET CHAR SZA /NULL? XPND6A, DCA I XR13 /NO. SAVE JMP XPND3 /CONTINUE XPND7, TAD SCANP3 /PICK UP POINTER TO FIRST CHAR IN /NAME DCA SCANP2 /PUT IN SCANP2 FOR RE-SCAN. THEN... XPND8, TAD [MPCHR JMP XPND6A XPND10, TAD I SCANP2 TAD (-"" SZA /IS NEXT CHAR "? JMP XPND14 /NO. CHECK ' ISZ SCANP2 /YES TAD I SCANP2 TAD [-MPCHR SZA CLA /MPCHR FOLLOW MPCHR" ? JMP XPND11 /NO. TAD XPNDI2 /YES. GET PASS SZA CLA /SECOND PASS? JMP XPN11A /YES. TREAT MPCHR LIKE OTHER /CHARS TAD I SCANP2 /NO. COPY MPCHR" DCA I XR13 /THIS GETS MPCHR TAD I SCANP3 /THIS, " JMP XPND6A /SAVE CHAR XPND11, TAD I SCANP2 TAD [-215 /MAKE SURE CHAR IS NOT NULL SNA CLA /NEXT CHAR CR? JMP XPN11Z /YES. ERROR XPN11A, TAD SCANP2 /NO DCA TBLWD2 /LET POINT AT CHAR TO FAKE SET ISZ SCANP2 /SKIP THE CHAR JMP XPND20 /WILL GO TO XSET TO CONVERT CHAR XPN11Z, JMS I [WERROR /NULL CHAR IN MPCHR" CONST. XPND12, TAD XPNDI1 SNA CLA /MOVE ANY CHARS? JMP XPND13 TAD I SCANP2 /YES DCA I XR13 /SAVE CR TAD XR13 TAD (-LINLIM-LNBUF1 SMA SZA CLA /EXCEED END OF LINE BUFFER? JMS I [TERROR /YES TAD XR13 CIA TAD XPNDT2 DCA XPNDC1 /NUMBER OF CHARS TO MOVE BACK TAD XPNDT2 DCA XR13 /WHERE TO MOVE FROM TAD XPNDT1 DCA XR11 /WHERE TO MOVE TO TAD I XR13 DCA I XR11 ISZ XPNDC1 JMP .-3 TAD XR11 CIA TAD LINBUF DCA LINCNT /NEW LINCNT XPND13, TAD XPNDSV DCA SCANP2 /RESTORE SCANP2 JMP I XPND1 XPND14, TAD (""-"' SNA CLA /CHAR '? JMP XPND3A /YES. COPY ' OF MPCHR' JMP XPND8 /NO. COPY MPCHR, RE-DO SEP. XPNDS1, .-. /XPND SUBROUTINE TAD XPNDI1 SZA CLA /MOVING CHARS YET? JMP I XPNDS1 /YES ISZ XPNDI1 /SET INDICATOR CMA TAD SCANP2 DCA XPNDT1 /SAVE FOR LATER TAD LINCNT CIA TAD LINBUF DCA XR13 /POINT TO LAST CHAR IN LINBUF TAD XR13 DCA XPNDT2 /SAVE THIS TOO JMP I XPNDS1 XPNDSV, 0 XPNDI1, 0 XPNDI2, 0 XPNDT1, 0 XPNDT2, 0 XPNDC1, 0 /PB /PB PAGE XPND20, SMA CLA /FROM XPND6. SSET? JMP XSET /NO. MUST BE SET XSSET, TAD I TBLWD2 /GET LINK NUMBER JMS LNKGET /GET GOODIES XCSST1, ZZZ /COUNT GOES HERE DCA XCSSTP /POINTER DCA XCSSTP+1 /BYTE TAD XCSST1 /GET COUNT SNA CLA JMP XPND3 /IF NULL SSET SYMBOL XCSST2, JMS I [GETCHR /GET CHARACTER XCSSTP SFLD DCA I XR13 /SAVE CHAR ISZ XCSST1 /DONE? JMP XCSST2 /NO JMP XPND3 /YES. RESUME EXPANSION XCSSTP, 0;0 /POINTER, BYTE XSET, TAD OCTDEC /EXPAND SET SYMBOL SNA CLA /OCTAL? TAD (3 /YES. USES DIFFERENT CONVERSION /TABLE JMS CONVS1 /INITIALIZE CONVERSION DCA CONVI1 /SUPPRESS LEADING ZEROES TAD I TBLWD2 /GET VALUE JMS CONVS2 /RETURNS ONE DIGIT AT A TIME DCA I XR13 /SAVE JMP .-2 JMP XPND3 /CONVS2 COMES HERE WHEN OUT /OF DIGITS CONVS1, .-. /SET UP NUMBER CONVERSION TAD (TAD CONVL1 /CONSTANTS FETCH DCA CONV4 CMA CLL RTL /ACTUALLY YIELDS 4 DIGITS DCA CONVC1 /SAVE DIGIT COUNT JMP I CONVS1 CONVS2, .-. /CRANK OUT DIGITS IN A SNEAKY WAY JMP I CONVS3 /WHOOPS!! CONVS3, CONV1+1 /INITIAL VALUE JMP I CONVS2 CONV1, JMS CONVS3 /RETURN LAST VALUE, WAIT FOR /NEXT CALL DCA CONVT1 /SAVE INCOMING # CONV2, DCA CONVC2 /0 DIGIT CONV3, CLL /FOR CHECK CONV4, ZZZ /FILLED BY CONVS1 TAD CONVT1 /ADD DATA TO CONSTANT FROM LIST SNL /O'FLOW? JMP CONV5 /YES. FAR ENOUGH DCA CONVT1 /NO. SAVE DATA ISZ CONVC2 /ADD TO DIGIT COUNT JMP CONV3 /CONTINUE CONV5, CLA /DON'T NEED THIS GARBAGE ISZ CONV4 /POINT TO NEXT CONSTANT TAD CONVC2 /GET DIGIT TAD CONVI1 /AND ZERO SUPPRESSION INDICATOR SNA /RETURN THIS DIGIT? JMP CONV6 /NO TAD ("0 /YES. FORM NUMERAL AND [377 /REMOVE ZERO SUPPRESS BIT, IF ANY JMS CONVS3 /CALL SUBR. TO GET OUT STL RAR DCA CONVI1 /SET INDICATOR: PRINT ALL DIGITS CONV6, ISZ CONVC1 /DONE FIRST 3 DIGITS? JMP CONV2 /NO TAD CONVT1 /YES. ALWAYS RETURN LAST DIGIT TAD ("0 JMS CONVS3 /GET RID OF LAST ISZ CONVS2 /SKIP OVER TWO WORDS ISZ CONVS2 /THAT FOLLOW CALL JMP CONV1 /GET OUT THIS WAY CONVT1, 0 CONVI1, 0 /0 ZERO SUPPRESS; 4000 - RETURN ALL CHARS CONVC1, 0 /ITERATION COUNTER CONVC2, 0 /DIGIT VALUE COUNTER CONVL1, -1750;-144;-12;-1000;-100;-10 DECOUT, .-. /PUSH DECIMAL THROUGH ARGUMENT /SUBROUTINE DCA CONVT1 /SAVE AC TAD I DECOUT /SUBR. ADDRESS ISZ DECOUT DCA DECOP1 TAD I DECOUT ISZ DECOUT DCA CONVI1 /LEADING 0 SUPPRESSION JMS CONVS1 /SET UP TAD CONVT1 JMS CONVS2 /LET'S HAVE THE DIGITS JMS I DECOP1 /PUSH DIGITS THROUGH SUBROUTINE JMP .-2 JMP I DECOUT DECOP1, 0 /POINTER TO DIGIT SINK ERRLST, .-. /PRODUCE TRACE BACK ERROR LISTING, /GIVING PAGE AND LINES ON PAGE OF /ERROR SNA CLA /COMING FROM ERRS1: 1 MEANS CALL /FROM 'ERROR', SKIP CRLF JMS CRLF TAD PAGES JMS ERRLS1 /PRINT PAGES# "# TAD PUSHST /START OF PUSH DOWN LIST ERRL1, DCA ERRLP1 /SAVE TAD ERRLP1 CIA STL TAD PUSHP SNL CLA /IS PD LIST THIS FAR DOWN? JMP ERRL3 /NO. GET LAST ACTIVE LINE ERRL2, CDF 10 /8K:10; 12K:10; >12K:20; YES TAD I ERRLP1 /FIRST ENTRY AT EACH PD LEVEL /IS 'LINES' CDF 0 JMS ERRLS1 /PRINT SAVED 'LINES' ". TAD ERRLP1 TAD (-PDLEN /INCREMENT POINTER BY LENGTH OF /STACK GROUP JMP ERRL1 ERRL3, TAD LINES /FOR FINAL PRINT-OUT JMS ERRLS1 /PRINT JMP I ERRLST ERRLP1, 0 /PB /PB PAGE /!!!!NOTE: DO NOT MOVE RCSET FROM TOP OF THIS PAGE... / THAT NAME IS USED TO DETERMINE SWAPPING LOC. / FOR LIBRARY RCSET, JMS CSETS1 /DO COMMON GOODIES DCA I MATCP1 /THIS CLEARS '=' IN INPUT LINE. IF /ONLY CR FOLLOWS '=', THE CSET SYM. /IS NULL, AND THIS INSURES THAT /SUCH IS THE CASE TAD LINCNT CMA TAD LINBUF DCA MATCP1 /POINT AT CHAR BEFORE CR JMP CSET1 /HOP IN FOR COMMON STUFF LCSET, JMS CSETS1 /GET SYMBOL, ETC. ISZ MATCP1 /POINT AT CHAR AFTER '=' CSET1, TAD I MATCP1 /GET CHAR TAD [-215 /POINTING AT LAST CHAR? SZA TAD (215 /NO. RESTORE CHAR DCA I TBLWD2 /YES. SAVE 0 OR CHAR JMP I [INLUP /ONWARD!! GETPNM, .-. /COLLECT PATTERN FIELD VIA GATHER TAD MATFLD /SAVED POINTER FROM MATCH DCA SCANP2 /SAVE FOR COLLECTION JMS I [GATHER /GET THE NAME JMS I [IERROR /UH, OH!!!!! JMP I GETPNM /DONE CSETS1, .-. /COMMON SUBROUTINE FOR LCS, RCS TAD MATCP1 DCA SCANP2 /GET POINTER TO = IN INPUT LINE JMS XPND /EXPAND FROM THERE /THIS MUST PRECEDE LOOKUP, BECAUSE /TBLWD2 GETS CHANGED IN XPND JMS I [GETPNM /GET PARAM. NAME JMS I [LOOKUP /LOOK FOR SET OR CSET, CREATE 6040 JMP CSTS2 /WRONG TYPE FOUND CSTS1, STL RTR /2000 DCA I TBLWD1 /SET CSET TYPE SYMBOL JMP I CSETS1 /RETURN CSTS2, TAD I TBLWD1 /GET TYPE WORD AND [1000 /CHECK FOR SSET SNA CLA /ANYTHING ELSE IS AN ERROR JMS I [EERROR /NOT SSET TAD I TBLWD2 /WAS SSET JMS LNKDEL /DELETE ITS LINK JMP CSTS1 /AND MAKE SYMBOL CSET LDLTE, IAC RDLTE, DCA LDLTI1 /SET INDICATOR JMS I [GETPNM /GET PATTERN FIELD JMS I [LOOKUP 1000 /SSET ONLY JMS I [EERROR /NAME MISSING TAD LINBUF DCA XR12 /STORE CHARS IN LINBUF TAD I TBLWD2 /LINK # JMS LNKGET /GET APPROPRIATE LINK LDLTC1, ZZZ /COUNT GOES HERE DCA LDLTP1 /SAVE POINTER DCA LDLTP1+1 /AND BYTE TAD LDLTC1 SZA CLA /NULL LINK? JMP LDLT1 /NO JMS I [WERROR /YES. GIVE WARNING JMP I [INLUP /PROCEED LDLT1, JMS I [GETCHR /GET CHAR LDLTP1 SFLD DCA I XR12 /SAVE ISZ LDLTC1 /ALL CHARS? JMP LDLT1 /NO TAD I TBLWD2 /YES JMS LNKDEL /DELETE USED LINK JMS LNKCRT /CREATE NEW ONE LDLT2, ZZZ /POINTER HERE DCA I TBLWD2 /SAVE NEW LINK NUMBER TAD LDLT2 DCA LDLTP1 /SAVE POINTER DCA LDLTP1+1 /AND BYTE DCA LDLT5 /INITIALIZE COUNT TAD XR12 CIA TAD LINBUF IAC /ONE LESS CHAR TO MOVE SNA JMP LDLT4 /IF NOW NULL DCA LDLTC1 TAD LINBUF TAD LDLTI1 /0 FOR RDEL, 1 FOR LDEL DCA XR12 /SAVE POINTER LDLT3, TAD I XR12 JMS I [PUTCHR LDLTP1 SFLD ISZ LDLT5 ISZ LDLTC1 JMP LDLT3 LDLT4, JMS LNKCHK /CHECK NEW LINK LDLT5, ZZZ /COUNT JMP I [INLUP LDLTP1, 0;0 LDLTI1, 0 MQLMUY, .-. /EAE MULTIPLY SIMULATOR DCA MQ /PERFORM MQL DCA AC TAD (-15 DCA EAESC JMP MUY2 MUY1, SNL CLA JMP .+3 CLL TAD I MQLMUY TAD AC RAR DCA AC MUY2, TAD MQ RAR DCA MQ ISZ EAESC JMP MUY1 TAD AC ISZ MQLMUY /RETURN, SKIPPING MULTIPLIER JMP I MQLMUY POPA, .-. /POP ONE WORD FROM PUSH-DOWN ISZ PUSHP CDF 10 /8K:10; 12K:10; >12K:20 TAD I PUSHP /PICK UP WORD CDF 0 JMP I POPA /RETURN /PB /PB PAGE SSET, JMS XPND /FROM =. POINTERS SET BY MATCH JMS I [GETPNM /GET PATTERN FIELD JMS I [LOOKUP 1040 /SSET. (CREATE) JMP SSET5 /NOT SSET TAD I TBLWD2 JMS LNKDEL /DELETE OLD LINK, IF ANY SSET1, TAD [1000 DCA I TBLWD1 /SET SYMBOL TYPE JMS LNKCRT SSETT1, ZZZ /CREATE LINK (THIS IS POINTER) DCA I TBLWD2 /SAVE NEW LINK NUMBER TAD SSETT1 DCA SSETP1 /SAVE POINTER DCA SSETP1+1 /CLEAR BYTE DCA SSETC1 /AND COUNTER TAD MATCP1 /END OF PATTERN DCA XR10 SSET2, TAD I XR10 /GET CHAR TAD [-215 /END OF LINE? SNA JMP SSET4 /YES TAD (215 /RESTORE CHAR JMS I [PUTCHR /STORE CHAR SSETP1 SFLD ISZ SSETC1 /INDICATE CHAR JMP SSET2 /(NOT A COUNT LOOP) SSET4, JMS LNKCHK /CHECK FOR O'FLOW SSETC1, ZZZ JMP I [INLUP /ALLES IST IN ORDNUNG SSET5, TAD I TBLWD1 /WRONG TYPE DETECTED AND (6000 /CHECK FOR SET OR CSET SZA CLA /ONE OF THOSE? JMP SSET1 /YES. OKAY JMS I [EERROR /NO. WRONG SYMBOL TYPE SSETP1, 0;0 /MACRO DEFINITION BEGINS HERE: /PHASE 1 - PUT MACRO NAME IN TABLE, GET ARGUMENT / NAMES /PHASE 2 - ENTER MACRO BODY INTO SFLD STORAGE MCDF1, IAC MCDF2, DCA MCDFI1 /SET INDICATOR JMS I [GETPNM /GET PATTERN FIELD (MACRO NAME) JMS I [LOOKUP /LOOKUP NAME 440 /MACRO (CREATE) JMS I [EERROR /SYMBOL USED AS DIFFERENT TYPE MCDF3, TAD [400 /FOR MACRO DCA I TBLWD1 TAD I TBLWD2 /0 IF NEW NAME JMS LNKDEL /GET RID OF LINK DCA I TBLWD2 /PRECLUDE USE, IN CASE OF ERROR: /MACX WILL CHOKE ON 0 LINK # TAD (MCDFL1-1 DCA XR11 /LIST TO STORE ARGUMENTS JMS TBLSUB /STORE GATHBF IN TBL (I.E., /MACRO NAME) TAD MCDFI1 SZA CLA /LABEL PRESENT? JMP MCDF4 /NO TAD LINBUF /YES DCA SCANP2 JMS I [GATHER JMS I [IERROR /INTERNAL JMS TBLSUB /STORE IN TABLE TAD (3 /TO FIX COUNT MCDF4, TAD (-MCARG^3 /THREE SPACES PER ARG DCA MCDFC1 DCA I XR11 /0 TABLE ISZ MCDFC1 JMP .-2 IAC TAD MATCP1 DCA SCANP2 /POINT TO CHAR AFTER NAME TAD (2^3+MCDFL1-1 /POINT TO ENTRY AFTER LABEL DCA XR11 TAD I SCANP2 TAD (-": /ANY ARGS? SZA CLA JMP MCDF6 /NO MCDF5, JMS I [GATHER /YES JMS I [EERROR /SYNTAX ERROR. NO FIELD TAD I TBLWD1 /GET TYPE WORD WITH # OF ARGS TAD (-400-MCARG+1 /GET RID OF 400 BIT, /1 LESS FOR UNCOUNTED LABEL SMA CLA /TOO MANY ARGS? JMS I [EERROR /YES JMS TBLSUB /NO. PUT IN TABLE ISZ I TBLWD1 /MARK OFF ONE MORE ARG. CMA TAD SEPCOD SMA SZA CLA /SEP A CR OR SPC? JMP MCDF5 /NO. LOOPTY-LOOP JMP MCDF7 /YES, AT LAST! ENTER PHASE TWO CSX, JMS EVAL /CHARACTER SET TO EXPRESSION DCA CSXT1 /EVALUATE AND SAVE FROM = JMS CSETS1 /DO NAME LOOKUP, ETC FOR CSET, /PERFORM SUPERFLUOUS XPND TAD CSXT1 /CHECK VALUE SNA /NULL CHAR? JMP CSX1 /YES. OK TAD (-" /CHECK SPACE AT LOW END AND [7700 /LEGAL SIX-BIT CHAR? SZA CLA JMP CSX2 /NO TAD CSXT1 /YES CSX1, DCA I TBLWD2 /STORE CHAR VALUE JMP I [INLUP /AND PROCEED CSX2, JMS I [WERROR /ILLEGAL CODE WARNING JMP CSX1 /SET TO NULL CSXT1, 0 WERROR, .-. /WARNING ERROR JMS I [ERROR "W JMP I WERROR /RETURN TO CALLER /PB /PB PAGE MCDF6, CMA /NO ARGS. CHECK SEPARATOR TAD SEPCOD SMA SZA CLA /CR OR SPC? JMS I [WERROR /NO. NAUGHTY! MCDF7, JMS LNKCRT /SECOND PHASE MACRO DEFINE MCDFI1=. /TIGHT ON SPACE MCDF8, ZZZ /POINTER HERE DCA I TBLWD2 /SAVE LINK # TAD MCDF8 DCA MCDFP1 /SAVE POINTER DCA MCDFP1+1 /INITIALIZE BYTE DCA MCDFC1 /AND CHAR COUNT MCDF9, JMS GETLIN /GET NEXT LINE CMA /SET FIRST SCAN SWITCH MCDF10, DCA MCDFI1 /SET INDICATOR JMS I [GATHER JMP MCDF13 /NO FIELD TAD MCDFI1 SZA CLA /FIRST SCAN? CLA CMA CLL RTL /YES TAD (MCDFL1-1+3 /POINT TO SECOND TABLE ENTRY DCA XR11 TAD (-MCARG TAD MCDFI1 DCA MCDFC2 /SET COUNT DCA MCDFC3 /ARG # MCDF11, TAD I XR11 /GET FIRST WORD SNA /ARG EXIST? JMP MCDF15 /NO TAD GATHBF /YES SZA CLA /COMPARE JMP MCDF15 /NO TAD I XR11 TAD GATHBF+1 SZA CLA JMP MCDF16 TAD I XR11 TAD GATHBF+2 SZA CLA JMP MCDF17 TAD MCDFC3 /ARG NUMBER ISZ MCDFI1 /FIRST SCAN? JMP MCDF12 /NO SNA /YES. ZERO ARG? JMP MCDF14 /YES. CHECK END OF DEFINITION SKP MCDF12, IAC /CORRECT ARG # JMS MCDFS1 /OUTPUT AS 8 BIT CHAR MCDF13, TAD I SCANP2 /GET SEPARATOR JMS MCDFS1 /OUTPUT CMA TAD SEPCOD SZA CLA /CR = 1; REACH END OF LINE? JMP MCDF10 /NO JMP MCDF9 /YES MCDF14, TAD I SCANP2 /FIELD SAME AS MACRO NAME TAD [-MPCHR /SEPARATOR MPCHR? SZA CLA JMP MCDF17 /NO JMS MCDFS1 /YES. CLOSE UP. 0 CHAR ENDS JMS LNKCHK /CHECK DEFINITION LINK MCDFC1, ZZZ /COUNT OF CHARS JMP I [INLUP /BACK TO THE USUAL MCDF15, ISZ XR11 MCDF16, ISZ XR11 MCDF17, ISZ MCDFC3 /ARG NUMBER ISZ MCDFC2 JMP MCDF11 /MORE TO CHECK TAD SCANP2 /DIDN'T FIND AS ARG CIA TAD SCANP3 DCA MCDFC2 /CHARS TO MOVE MCDF18, TAD I SCANP3 ISZ SCANP3 JMS MCDFS1 /MOVE TO LINK ISZ MCDFC2 JMP MCDF18 /MORE JMP MCDF13 /CHECK SEPARATOR MCDFS1, .-. /MOVE ONE CHAR TO LINK, COUNT JMS I [PUTCHR MCDFP1 SFLD ISZ MCDFC1 /INCLUDE IN COUNT JMP I MCDFS1 MCDFP1, 0;0 /POINTER (& BYTE) TO MACRO DEF. MCDFC2, 0 MCDFC3, 0 LNKSKP, .-. /SKIP TO PROPER PLACE IN LINK /LINK # IN AC; PTR IN ARG 1 /CHAR # IN ARG 2 DCA LNKST1 /SAVE LINK # TAD I LNKSKP /GET PTR ISZ LNKSKP IAC /POINT AT BYTE DCA LNKS1 DCA I LNKS1 /ZERO BYTE CMA TAD LNKS1 DCA LNKS1 /RESET TO POINT AT PTR TAD LNKST1 /GET LINK # JMS LNKGET /GET THE LINK LNKST1, ZZZ /LENGTH GOES HERE (DISCARD) DCA I LNKS1 /SAVE PTR TO LINK TAD I LNKSKP /FETCH CHAR # ISZ LNKSKP JMS MCXSKP /SET UP CORRECTED PTRS VIA MCXSKP LNKS1, ZZZ /GETS PTR TO LINK JMP I LNKSKP /RETURN MPEXPD, TAD LINBUF /COME HERE TO... DCA SCANP2 /EXPAND WHOLE LINE JMS XPND JMP INLUP2 /THEN OUTPUT AS IS MQA, .-. /SIMULATED MQA DCA AC TAD MQ /BEGIN 'OR' OF AC, MQ CMA AND AC TAD MQ JMP I MQA /PB /PB PAGE / RECURSIVE MACRO EXPANDER MACX0, CMA TAD MATCP1 /COMING FROM 'IF'. BACK UP DCA MATCP1 /MATCP1 TO POINT AT ':' CMA CLL RAL /-2. BACK UP MATFLD: /'IF' PROCESSOR JUMPS HERE ON /UNRECOGNIZED IF=IFXX. MATFLD /POINTS AT XX. WE WANT TO POINT /AT IFXX AS MACRO NAME MACX1, MACX2, JMS I [GETPNM /BOTH ENTER THIS WAY. LABEL IS /ALWAYS PICKED UP OR CREATED /(BELOW) JMS I [LOOKUP 400 /LOOK UP MACRO JMS SWOUT /NOT FOUND. CHECK FOR LIBRARY JMS PUSH /PUSH ALL THE OLD GOODIES MACXL2 /ACCORDING TO THIS LIST ISZ MACON /SET MACRO ON JMS LNKCRT /LINK FOR ARG. STRING ZZZ /POINTER HERE DCA MCXALK /ARG. LINK # TAD .-2 DCA MACXP1 DCA MACXP1+1 /PUTCHR POINTERS DCA MACXC2 /CHAR LENGTH OF ARG. LINK TAD (MACXL1-1 DCA XR13 /POINT TO FIRST ARG. /ARG 1 ALWAYS AT CHAR 0 DCA I XR13 /ZERO CHAR # TAD LINBUF DCA SCANP2 JMS I [GATHER /FIND OUT IF LABEL EXISTS JMP MACX3 /NO. CREATE ONE TAD SCANP2 CIA TAD SCANP3 /LENGTH DCA MACXC1 /SAVE # OF CHARS TAD I SCANP3 ISZ SCANP3 JMS MACXS1 /SAVE CHARS IN ARG. LINK ISZ MACXC1 /DONE? JMP .-4 /NO SKP /YES MACX3, JMS MCCRSM /CREATE SYMBOL ISZ MATCP1 /POINT TO SEP. AFTER NAME TAD I MATCP1 /GET CHAR JMS I [CCHECK JMS I [IERROR /INTERNAL JMS TRNSFR /BRANCH ON SEP. JMP MACX4 /ILLEGAL SEP. 6400 /SP CR : NOP NOP ISZ MATCP1 /POINT TO NEXT CHAR TAD I TBLWD1 AND (37 /NUMBER OF ARGS DCA .+2 JMS GETARG /GET ALL THE ARGUMENTS STORED ZZZ /INDICATOR JMS LNKCHK /CHECK THE NEW LINK MACXC2, ZZZ /NUMBER OF CHARS USED (FROM MACXS2) TAD I TBLWD2 /GET BODY LINK NUMBER SNA /ILL-DEFINED MACRO? JMP MACX4 /YES JMS LNKGET ZZZ /COUNT (IGNORED) DCA MACIP1 /POINTER TO BODY DCA MACIP1+1 TAD I TBLWD2 DCA MCXBLK /SAVE MACRO BODY LINK DCA DLTESW /DON'T CARE ABOUT PREVIOUS DELETIONS TAD (MACINP DCA INPUT /SET UP INPUT SOURCE JMP I [INLUP /PRETEND NOTHING HAPPENED MACX4, TAD MATCP1 DCA SCANP2 /FOR MESSAGE JMS POP /FOR INLUP CALL TO GETLIN MACXL3 JMS I [EERROR MACXP1, 0;0 /TEXT POINTERS MACXC1, 0 MACIP1, 0;0 MACIP3, 0;0 / SOME AUXILIARY SUBROUTINES MCXSKP, .-. /SKIP OVER CHARS IN LINK JMS I [MQLDVI 3 /DIVIDE NUMBER OF CHARS BY 3 CLL RTR /TAKE REMAINDER (0-2) RAR DCA MCXSP1+1 /GIVES PROPER BYTE (LINK NOW 0) TAD I MCXSKP /POINTER TO POINTERS ISZ MCXSKP DCA MCXSP1 /SAVE TAD MCXSP1+1 SZA CLA /BYTE 0? STL /NO. WILL ADD 1 TO POINTER TAD MQ RAL /GIVES OFFSET FROM VIRGIN POINTER TAD I MCXSP1 DCA I MCXSP1 /SAVE CORRECTED POINTER ISZ MCXSP1 TAD MCXSP1+1 /GET BYTE DCA I MCXSP1 JMP I MCXSKP MCXSP1, 0;0 EERROR, .-. /'E' TYPE ERROR JMS I [ERROR /CALL ERROR ROUTINE "E JMP I [INLUP /RETURN TO 'INLUP' ON EERROR / I HATED LIKE HECK TO PUT THIS HERE, BUT WHAT DO / YOU DO WHEN YOU HAVE GOOD AFTERTHOUGHTS?? PAT19, ZBLOCK 2;CSX /CHARACTER SET TO EXPRESSION 4;-"C;-"S;-"X;4;1;-"=;0 /PB PAGE DEC, IAC OCT, DCA OCTDEC / SET OCTAL-DECIMAL SWITCH JMP I [INLUP /THAT'S ALL! GETARG, .-. /GET ARGUMENTS FOR MACX, IRP DCA GETAI2 TAD I GETARG /INDICATOR SMA CLA /FROM MACX? JMP GETA11 /YES. CLOSE LABEL ARG. GETA2, DCA GETAI1 /CLEAR INDICATOR TAD I MATCP1 /GET CHAR TAD (-"< SZA CLA /START OF NEST? JMP GETA7 /NO ISZ GETAI1 /YES. SET LEVEL GETA3, ISZ MATCP1 TAD I MATCP1 TAD (-"< /NEXT LEVEL? SZA JMP GETA5 /NO ISZ GETAI1 /YES GETA4, TAD I MATCP1 JMS MACXS1 /SAVE CHAR JMP GETA3 GETA5, TAD ("<-"> SZA /UP ONE LEVEL? JMP GETA6 /NO CMA /YES TAD GETAI1 DCA GETAI1 TAD GETAI1 /REACH SURFACE? SZA CLA JMP GETA4 /NO ISZ MATCP1 /NEXT CHAR TAD I MATCP1 DCA SEPCOD /VALUE >2 IN CASE OF ALPHA TAD SEPCOD JMS I [CCHECK JMP GETA10 /ALPHA AFTER <> NEST CMA CLL RAL TAD SEPCOD SMA CLA /CR OR SP ISZ SEPCOD /NO. FORCE TO LOOK LIKE UNKNOWN JMP GETA10 GETA6, TAD (">-215 /CHECK FOR SLOPPY USER SZA CLA JMP GETA4 GETA6A, TAD I GETARG SPA CLA /FOR MACX? JMP .+3 /NO JMS POP /YES. MUST POP HERE MACXL3 TAD MATCP1 DCA SCANP2 /FOR ERROR MESSAGE JMS I [EERROR /UNBALANCED <> NEST GETA7Z, ISZ MATCP1 GETA7, DCA GETAI1 /SET INDICATOR TAD I MATCP1 /GET CHAR JMS I [CCHECK JMP GETA14 /JUST STORE CMA CLL RAL TAD SEPCOD SPA SNA CLA /END OF ARG? JMP GETA8 /YES TAD I MATCP1 TAD (-"< /< IS END ALSO SNA /FIND < ? JMP GETA8 /YES TAD ("<-"> /NO. HOW ABOUT EXTRA < ? SZA CLA JMP GETA14 /NO. INCLUDE IN ARGUMENT JMP GETA6A /YES. ERROR GETA8, TAD GETAI1 SZA CLA /NULL ARG? JMP GETA10 /NO TAD I GETARG /YES SMA CLA /CREATE SYMBOL? GETA9, JMS MCCRSM /YES GETA10, ISZ GETAI2 /CHALK UP ANOTHER ARG. GETA11, JMS MACXS1 /MARK END TAD I GETARG SPA CLA /FOR MACX? JMP GETA12 /NO TAD MACXC2 DCA I XR13 /YES. SAVE ARG CHAR NUMBER GETA12, CMA CLL RAL TAD SEPCOD SNA /, ? JMP GETA7Z /YES SMA CLA /CR SP? JMP GETA2 /NO TAD I GETARG /INDICATOR AGAIN SMA CLA /FOR MACX? JMP GETA13 /YES TAD GETAI2 /GET NUMBER OF ARGS JMP I GETARG /RETURN IT GETA13, TAD I GETARG CIA /- # OF LEGAL ARGS TAD GETAI2 SNA /RIGHT NUMBER? JMP I GETARG /YES SPA CLA /NO JMP GETA9 /TOO FEW. CREATE SOME TAD MATCP1 DCA SCANP2 /FOR ERROR JMS I [WERROR /WARNING. TOO MANY ARGS JMP I GETARG GETA14, TAD I MATCP1 JMS MACXS1 IAC JMP GETA7Z GETAI1, 0 GETAI2, 0 MACXS1, .-. /MOVE CHAR TO ARG. LINK JMS I [PUTCHR MACXP1 SFLD ISZ MACXC2 JMP I MACXS1 /PB /PB PAGE / IRP PROCESSOR / HAS PRIVILEGED ACCESS TO MACXC3, MCXALK, MACIP2 (WHEN / ARGUMENT WAS PICKED UP), MACXL1, MCXBLK / / THE FOLLOWING ARE 'PUSH'-ED: IRPP2, IRPBCH, IRPC1, / 'LINSV2' MCIRP, TAD MACON SNA CLA /MACRO EXPANSION ON? JMS I [EERROR /NO TAD I MATCP1 JMS I [CCHECK /CHECK CHAR AFTER 'P' JMS I [IERROR /ALPHA-NU. /SHOULD HAVE BEEN PICKED UP AS MACRO JMS TRNSFR JMS I [EERROR /ILLEGAL SEP 6400 /SP CR : NOP /SP. TREAT LIKE CR. IAC /CR. NO FIELD CLL RAR / : TAD IRPBCH /GET INDICATOR SNA CLA /IRP ALREADY ON? JMP MCIRP3 /NO SNL /YES. FIELD PRESENT? JMS I [EERROR /YES. ERROR MCIRP1, ISZ IRPC1 /REACH LAST CALL? JMP MCIRP2 /NO DCA IRPBCH /YES. 0 INDICATOR JMP I [INLUP /AND FALL THROUGH MCIRP2, JMS MCIRS1 /GET TO ARG CHAR MCIR2A, ISZ I IRPP2 /INCREMENT POINTER IN MACXL1 JMS I [GETCHR IRPP1 SFLD SZA CLA /REACH END OF THIS PART? JMP MCIR2A /NO TAD IRPBCH /YES. DCA MACXC3 /FORCE LOOP IN MACX TAD LINSV2 /GET LINE # SAVED FROM OPENING 'IRP' DCA LINES /RESET 'LINES' FOR ERRORS ISZ DLTESW JMP I [INLUP MCIRP3, SZL /FIELD PRESENT ON FIRST CALL? JMS I [EERROR /NO. ERROR / THE FOLLOWING IS A DESPERATION CHECK TO BE SURE / AN OPENING IRP IS HAS THE FORM IRP:ARG / IS ARG DOESN'T IMMEDIATELY PRECEDE CR, FIRST TEST WILL / FAIL (SEE 'MACIN2'). THEN CHECK 3 CHARS THAT / PRECEDE THE ARG THAT PRECEDES CR. THEY SHOULD BE / 'RP:'. THIS CHECK IS NOT FOOLPROOF, BUT / IT'S BETTER THAN NOTHING, WHICH IS WHAT THERE WAS / BEFORE. BESIDES, WHO USES 'IRP'S', ANYWAY? TAD IRPI1 /VALUE SET IN MACIN2 TAD (-4 /SINCE WE'RE POINTING 1 PAST, /BACK UP 3+1 SPA /IF -, ARG DOESN'T PRECEDE CR JMS I [EERROR DCA IRPI1 /SAVE CHAR # OF 3 BACK FROM ARG TAD MCXBLK /BODY LINK JMS LNKSKP /SKIP TO 3 CHARS BACK IRPP1 IRPI1, ZZZ /SET ABOVE, AND IN MACIN2 JMS MCIRS2 /CHECK CHARS -"R JMS MCIRS2 -"P JMS MCIRS2 -": /TEST SUCCEEDED TAD MACIP2 /POINTER TO ARG CHAR # /(FROM 'MACIN2') DCA IRPP2 /SAVE JMS MCIRS1 /SKIP TO NEXT ARG CHAR TAD IRPP1 DCA MACXP1 TAD IRPP1+1 DCA MACXP1+1 /SET UP FOR MACXS1 ISZ MATCP1 /POINT AFTER : JMS GETARG /GET ARGUMENTS (STORED BACK) SNA /4000 BIT IS SIGNAL TO 'GETARG' IAC CIA /SAVE COUNTER DCA IRPC1 TAD MACXC3 /BODY CHAR TO LOOP TO DCA IRPBCH /SAVE AS FLAG TAD LINES /GET PRESENT LINE # DCA LINSV2 /SAVE FOR LOOPS, SO 'LINES' /WILL BE RIGHT JMP I [INLUP MCIRS1, .-. /SKIP TO NEXT ARG. CHAR TAD I IRPP2 DCA .+4 TAD MCXALK JMS LNKSKP IRPP1 ZZZ JMP I MCIRS1 MCIRS2, .-. /CHECK CHARS JMS I [GETCHR IRPP1 SFLD TAD I MCIRS2 SZA CLA /CHAR MATCH? JMS I [EERROR ISZ MCIRS2 /YES JMP I MCIRS2 IRPP1, 0;0 IRPP2, 0 IRPBCH, 0 /IRP BODY CHAR TO LOOP WITH IRPC1, 0 /ITERATION COUNT CRLF, .-. TAD (215 JMS I ERRLP2 TAD (212 JMS I ERRLP2 JMP I CRLF CLAMQA, .-. /PUT MQ IN AC CLA TAD MQ JMP I CLAMQA ERRLS1, .-. /SUBROUTINE FOR ERROR LISTING JMS DECOUT /PRINT AC IN DECIMAL ERRLP2, TYO /PUSH DIGITS THROUGH 'TYO' 0 /SUPPRESS LEADING 0'S TAD I ERRLS1 /FIRST ARG. SMA /WAS THERE ONE? JMS I ERRLP2 /YES. PRINT AS CHAR CLA /FALLING THROUGH CHAR WON'T HURT JMP I ERRLS1 /WHEN WE RETURN ERRS2, .-. /LITTLE ERROR SUBROUTINE TAD I ERRS2 /GET ARG. JMS I ERRLP2 /PRINT ISZ ERRC2 /UPDATE CHAR POSITION JMP I ERRS2 /EXIT THRU CHAR /PB /PB PAGE MACINP, .-. /GET CHARS FROM MACRO LIKE INPUT /SOURCE JMP I MACOUT MACOUT, MACIN1 /INITIALIZED TO 'MACIN1' JMP I MACINP /WATCH THESE CO-ROUTINES! MACIN1, JMS MACXS3 /GET CHAR FROM BODY SNA /END OF MACRO? JMP MACIN4 /YES DCA MACOT1 /NO TAD MACOT1 AND [200 SNA CLA /ARG. #? (<200) JMP MACIN2 /YES TAD MACOT1 /NO JMS MACOUT /RETURN DCA IRPI1 /CLEAR INDICATOR ONE CHAR AFTER /ARG IS RETURNED (SEE MCIRP) JMP MACIN1 MACIN2, TAD MACOT1 /ARG NUMBER TAD (MACXL1-1 DCA MACIP2 TAD I MACIP2 DCA MACOT1 TAD MCXALK JMS LNKSKP MACIP3 MACOT1, ZZZ TAD MACXC3 /SAVE INDICATOR FOR MCIRP OF DCA IRPI1 /START OF ARG. MACIN3, JMS I [GETCHR /GET NEXT CHAR MACIP3 SFLD SNA /END OF ARG? JMP MACIN1 /YES. FETCH FROM BODY JMS MACOUT JMP MACIN3 MACIP2, 0 /MUST BE AVAILABLE TO MCIRP /AS POINTER TO MACXL1 (WHICH /GIVES # OF FIRST CHAR OF EACH /ARG.) MACIN4, JMS MACPOP /POP OUT OF MACRO TAD MACINP DCA I INPUT /PROCEED TO FAKE A 'JMS' TAD INPUT IAC DCA MACIP2 /GO WHERE WE WOULD HAVE GONE, BUT /FOR THE LAST CALL TO 'MACINP' JMP I MACIP2 ERRC2=. /SQUEEZE MACPOP, .-. /POP OUT OF MACRO. CALLED BY / 'MCRET', TOO TAD MCXALK JMS LNKDEL /KILL ARGUMENT LINK JMS POP /RETRIEVE FORMER STATUS MACXL3 JMP I MACPOP ERRC1=. /TIGHT! MACXS3, .-. /FETCH CHAR TAD DLTESW SNA CLA /LINK RECENTLY DELETED? JMP MCXS31 /NO TAD MCXBLK /YES JMS LNKSKP MACIP1 MACXC3, ZZZ /# OF PRESENT CHAR IN MACRO DCA DLTESW MCXS31, JMS I [GETCHR /GET NEXT CHAR MACIP1 SFLD ISZ MACXC3 /NEXT CHAR JMP I MACXS3 ERROR, .-. /PRINT ERROR INDICATION CLA JMS CRLF TAD I ERROR /GET ERROR TYPE CHAR JMS TYO TAD ERRSC1 /SPACE JMS TYO IAC /SO ERRS1 WON'T PRINT CRLF JMS ERRS1 JMP .+3 /DON'T PRINT SPACE, IN CASE /FIRST CHAR POSITION IS IN /ERROR ERR1, TAD ERRSC1 /SPACE JMS TYO ISZ ERRC1 /SET IN ERRS1 JMP ERR1 /KEEP SPACING JMS ERRS2 "^ JMS CRLF JMP I ERROR ERRS1, .-. /PRINT LINE JMS ERRLST /GENERATE ERROR LIST FIRST TAD [LNBUF1-1 /PRINT WHOLE LINE BUFFER DCA XR13 JMS CRLF DCA ERRC2 ERRS11, TAD I XR13 /GET CHAR DCA ERRT1 /SAVE TAD ERRT1 TAD (-211 /TAB? SNA CLA JMP ERRS14 /YES JMS ERRS2 /NO, PRINT CHAR ERRT1, ZZZ ERRS12, TAD XR13 /REACH ERROR POSITION? CIA TAD SCANP2 SZA CLA JMP ERRS13 /NO TAD ERRC2 /YES CIA DCA ERRC1 /SAVE FOR ERROR ERRS13, TAD ERRT1 SZA /TREAT 0 LIKE CR TAD [-215 SZA CLA /REACH END OF LINE? JMP ERRS11 /NO JMS ERRS2 /YES. OUTPUT LF AFTER CR 212 JMP I ERRS1 ERRS14, JMS ERRS2 /TAB TO NEXT 8 SPOT ERRSC1, " TAD ERRC2 AND (7 SNA CLA /REACH MULTIPLE OF 8? JMP ERRS12 JMP ERRS14 /NO /PB /PB PAGE / EVALUATE EXPRESSION, STARTING AT (SCANP2)+1 / OPERATOR STACK ('OPSTK') CONSISTS OF PAIRS: / SEPCOD FOR OPERATOR; OPERATOR (EVALP1) / OPERAND STACK ('EVALPD') IS SINGLE WORD / VALUES (EVALP2) EVAL, .-. /ENTRY POINT JMS XPND /EXPAND LINE FIRST TAD (EVALPD DCA EVALP2 /START PUSH-DOWN JMS I [GATHER /START OFF WITH FIELD? SKP /NO JMP EVAL1 /YES JMS TRNSFR /CHECK SEPARATOR JMS EVALER /NOT FOUND. ERROR /MAY SKIP IF MPCHR IS /FOUND, FOLLOWED BY /FIELD (UNEXPANDED SYMBOL /ERROR) 7100 /SP CR , + - JMP EVAL2 JMP EVAL2 JMP EVAL2 SKP EVAL1, JMS GETNUM /PICK UP NUMBER EVAL2, DCA I EVALP2 /PUSH ISZ EVALP2 TAD (OPSTK-1 DCA EVALP1 /START OPERATOR STACK JMS TRNSFR JMP EVAL7 160 /ARITH OPS + - * / \ ! & SKP EVAL2A, CLA EVAL3, TAD I SCANP2 /GET SEPARATOR ISZ EVALP1 DCA I EVALP1 /PUSH IT TAD SEPCOD ISZ EVALP1 DCA I EVALP1 /PUSH HIERARCHY (SEPCOD) EVAL4, JMS I [GATHER /GET NEW FIELD JMS EVALER /FIELD MISSING (SEE EVAL+8) JMS GETNUM /FORM VALUE EVAL5, DCA I EVALP2 /PUSH ON STACK ISZ EVALP2 TAD I EVALP1 /GET OLD HIERARCHY SNA /TOP OF STACK? JMP EVAL7 /YES CIA /NO TAD SEPCOD /GIVES NEW - OLD SMA SZA CLA / NEW > OLD ? JMP EVAL3 /YES. JUST SAVE TAD (EVALL1-1 /NO DCA XR12 /LIST OF OPERATIONS TO PERFORM CMA TAD EVALP1 DCA EVALP1 /POP TO LOOK AT OP. CHAR EVAL6, TAD I XR12 /GET CHAR SNA /END OF LIST? JMS I [IERROR /YES. INTERNAL TAD I EVALP1 /GET SEP SNA CLA /FOUND? JMP .+3 /YES ISZ XR12 /NO JMP EVAL6 CMA TAD EVALP1 DCA EVALP1 /POP AGAIN TAD I XR12 /TRANSFER VECTOR DCA EVALT1 JMP I EVALT1 /PERFORM OP EVAL7, TAD SEPCOD TAD (-5 SMA /ARITH OP? JMP EVAL2A /YES. JUST PUSH ONTO STACKS TAD (3 SMA SZA CLA /SEPCOD 0, 1, 2 (FOR SP CR ,)? JMS I [WERROR /NO JMS POPE /END OF EXPRESSION JMP I EVAL /RETURN VALUE IN AC POPE, .-. /POP FROM VALUE STACK CLA CMA TAD EVALP2 DCA EVALP2 TAD I EVALP2 JMP I POPE EVALP1, 0 EVALP2, 0 EVALRT, JMP I EVAL /RETURN 0 VALUE. ESCAPE /FOR EVALER / / ARITHMETIC OPS ARE PERFORMED BELOW / EVALPL, JMS POPE /+ EVLPL1, DCA EVALT1 JMS POPE TAD EVALT1 JMP EVAL5 EVALMI, JMS POPE CIA JMP EVLPL1 /- EVALTM, JMS POPE /* DCA EVALT1 JMS POPE JMS I (MQLMUY EVALT1, ZZZ JMS I [CLAMQA JMP EVAL5 EVALRM, CMA / \ EVALDV, DCA EVALT1 / / JMS POPE DCA EVALT2 JMS POPE JMS I [MQLDVI EVALT2, ZZZ SZL /DIVIDE CHECK? JMS I [WERROR /YES ISZ EVALT1 JMS I [CLAMQA JMP EVAL5 EVALAN, JMS POPE /& DCA EVALT1 JMS POPE AND EVALT1 JMP EVAL5 EVALOR, JMS POPE /! DCA MQ JMS POPE JMS I (MQA JMP EVAL5 /PB /PB PAGE / / SET INSTRUCTION / SET, JMS EVAL /EXPR AFTER =. GET VALUE DCA SETT1 /SAVE JMS I [GETPNM /GET PATTERN FIELD JMS I [LOOKUP 6040 /CREATE JMP SET2 /NOT FOUND (OR SYM. CREATED) SET1, STL RAR /4000 FOR SET DCA I TBLWD1 TAD SETT1 /RETRIEVE VALUE DCA I TBLWD2 /SAVE IN TABLE JMP I [INLUP SET2, TAD I TBLWD1 /GET TYPE WORD AND [1000 /CHECK SSET BIT SNA CLA /WAS SYMBOL AN SSET? JMS I [EERROR /NO. SOMETHING ELSE TAD I TBLWD2 /YES. PICK UP LINK # JMS LNKDEL /GET RID OF LINK JMP SET1 /THEN CONTINUE SETT1, 0 MCLOOP, TAD MACON /LOOP COMMAND COMES HERE SNA CLA /MACRO EXPANSION ON? JMS I [EERROR /NO. ERROR TAD MACXC3 DCA LUPCHR /SET LOOPING CHARACTER TAD LINES DCA LINSV1 /SAVE PRESENT LINE # FOR MACRO /LOOPING 'IF' RESETS THIS TO GIVE /PROPER LINE IN SOURCE JMP I [INLUP /THAT'S ALL! LUPCHR, 0 /CHAR TO LOOP TO IN MACRO GETNUM, .-. /FETCH VALUE FROM NUMBER. CALLED /AFTER GATHER HAS FOUND NAME TAD SCANP2 CIA TAD SCANP3 DCA GETNC1 /LENGTH OF FIELD GETN1, DCA GETNT1 /SET VALUE TAD OCTDEC /SWITCH CMA DCA GETNI1 /SET INDICATOR ISZ GETNI1 CMA CLL RAL /IF DECIMAL TAD I SCANP1 TAD (-"7 SMA SZA CLA /> 7 (OR 9) JMP GETN2 /YES. ERROR TAD I SCANP1 /NO TAD (-"0 SPA /< 0? JMP GETN2 /YES. ERROR DCA GETNT2 /NO. SAVE DIGIT TAD GETNT1 CLL RAL CLL RAL ISZ GETNI1 SKP TAD GETNT1 /IF DEC CLL RAL TAD GETNT2 /ADD NEW DIGIT ISZ SCANP1 /NEXT CHAR ISZ GETNC1 /DONE? JMP GETN1 JMP I GETNUM GETN2, JMS I [WERROR /RETURN WARNING JMP I GETNUM /AND 0 VALUE FOR PARAM GETNT1, 0 GETNT2, 0 GETNI1, 0 GETNC1, 0 EVALER, .-. /SUBROUTINE TO GET AROUND COMMON /ERROR SITUATION IN EVAL: /UNEXPANDED NAME RESULTS IN /MPCHR FOLLOWED BY FIELD JMS I [WERROR /SIGNAL WARNING TAD I SCANP2 TAD [-MPCHR SZA CLA /WAS OFFENDING SEP. MPCHR? JMP EVALRT /NO. CAN'T DO ANY MORE ISZ EVALER /YES. SKIP RETURN JMS I [GATHER /GET FIELD, SO IT WILL BE SKIPPED JMP EVALRT /NO FIELD. NOTHING TO BE DONE JMP I EVALER /RETURN. WILL ACT LIKE 0 WAS /EVALUATED MCXEC, JMS I [XPND1 /EXPAND AFTER ':' TAD LINBUF CIA TAD MATCP1 /CHARS UP TO : TAD LINCNT SMA JMS I [IERROR /INTERNAL ERROR DCA LINCNT /SAVE CORRECTED COUNT TAD MATCP1 DCA LINBUF /PRETEND TO HAVE SHORTER BUFFER JMP INLUP0 /THEN, PROCESS LINE AS USUAL MQLDVI, .-. /SET MQ, DIVIDE DCA MQ TAD MQLDVI DCA DVI JMP DVI+1 /FAKE JMS, LET DVI GET ARG DVI, .-. /EAE DIVIDE SIMULATOR DCA AC TAD (-15 DCA EAESC /STEP COUNT TAD I DVI CIA CLL TAD AC SZL CLA /DIVIDE CHECK? JMP DVI2 /YES DVI1, TAD I DVI CIA CLL TAD AC SZL DCA AC CLA TAD MQ RAL DCA MQ TAD AC RAL DCA AC ISZ EAESC JMP DVI1 TAD AC RAR /CORRECTION FOR REMAINDER DVI2, ISZ DVI JMP I DVI /PB /PB PAGE /NOTE: 'IF----' MAY IN FACT BE MACRO CALL. / THIS ROUTINE ASSUMES THAT AN UNRECOG- / NIZED 'IF' IS REALLY A MACRO IF, JMS I [GETPNM /'IF' PROCESSOR. GET PATTERN FIELD TAD GATHBF+1 SZA CLA /CHARS 3 AND 4 MUST NOT EXIST JMP MACX0 /ASSUME TO BE MACRO NAME TAD (IFL1-1 DCA XR11 /POINT TO IF-TYPES IF1, TAD I XR11 SNA /END OF LIST? JMP MACX0 /YES. TYPE NOT FOUND. ASSUME MACRO TAD GATHBF SNA CLA /LIST MATCH SOURCE? JMP IF2 /YES ISZ XR11 /NO. SKIP TRANSFER VECTOR JMP IF1 IF2, TAD I XR11 /GET TRANSFER VECTOR STL RAR /PUT SWITCH BIT IN LINK, FORM OPR SZL /SPECIAL? JMP IF8 /YES DCA IFSKP /NO. SAVE SKIP JMS EVAL /THEN EVALUATE EXPRESSION IFSKP, ZZZ /CHECK VALUE JMP I [INLUP /TEST FAILED. IGNORE IF CMA CLL RAL /TEST SUCCEEDED TAD SEPCOD SZA CLA /SEPARATOR A COMMA? JMS I [EERROR /NO. ERROR JMS I [GATHER /YES. PICK UP FOLLOWING FIELD JMP IF6 /NO FIELD TAD I SCANP2 TAD (-"^ SNA CLA /IS THIS A SKIP TYPE? JMP IF10 /YES TAD GATHBF /NO. FIRST TWO CHARS CIA DCA IFT1 /SAVE - JMS IFS1 /FIELD OF PROPER FORM? JMS I [EERROR /NO. ERROR JMP IF4 /YES. CONTINUE IF3, CMA TAD SEPCOD /CHECK SEPARATOR SNA CLA /CR? IF4, JMS GETLIN /YES. GET NEXT LINE IF5, JMS I [GATHER /GET NEXT FIELD JMP IF3 /NO FIELD JMS IFS1 /CHECK FIELD FORM JMP IF3 /WRONG FORM TAD IFT1 /FORM OK TAD GATHBF /CHECK SNA CLA /SAVED TWO CHARS MATCH FIELD? JMP I [INLUP /YES. END OF SOURCE SKIPPING JMP IF5 /NO. CONTINUE THIS LINE / SKIP PROCESSING FOR MACRO LOOP IF6, TAD I SCANP2 /CHECK THE CHAR TAD [-MPCHR /FOR MPCHR SZA CLA /FIND IT? JMS I [EERROR /NO. ERROR IF7, TAD MACON /YES. CHECK MACRO EXPANSION SNA CLA /MACRO EXPANSION ON? JMS I [EERROR /NO. ERROR TAD LUPCHR /YES SNA /WAS THERE A LOOP INSTRUCTION? JMS I [EERROR /NO. ERROR DCA MACXC3 /YES. SAVE CHAR # TAD LINSV1 /GET LINE # SAVED IN 'LOOP' DCA LINES /RESTORE 'LINES' TO GIVE PROPER # ISZ DLTESW /FORCE SKIP TO LOOP CHAR JMP I [INLUP /DISAPPEAR IF8, STL RAR /SPECIAL IF DCA IFSKP /FORM FINAL SKIP SZL /PUTS SWITCH IN LINK JMP IF11 /IFDF TYPE IF JMS IFS2 /IFNL TYPE IF. CLEAR INDICATOR 1000 /SYMBOL TYPE (SSET) JMP IF9 /NOT FOUND TAD I TBLWD2 /GET LINK # JMS LNKGET /TO FIND LENGTH IFT1, ZZZ SKP CLA /DON'T NEED POINTER IF9, JMS I [WERROR /GIVE WARNING TAD IFT1 /PICK UP COUNT SUPPLIED BY LNKGET JMP IFSKP /JUMP BACK IN IF10, JMS GETNUM /NUMBER OF LINES TO SKIP JMP MPSK1 /GO TO SKIP PROCESSOR IF11, IAC /SET TO 1 SO 'ND' IS FORCED IF /NO FIELD 0 FOUND IN IFS2 JMS IFS2 /IFDF TYPE IF 7000 /SET, SSET, CSET SYMBOLS IAC /NOT FOUND JMP IFSKP /FOUND (0) IFS1, .-. /SUBROUTINE TO CHECK FOR MPCHR, /AND ONLY TWO CHAR FIELD TAD GATHBF+1 SZA CLA /LONGER THAN TWO CHARS? JMP I IFS1 /YES TAD I SCANP2 /GET SEPARATOR TAD [-MPCHR SNA CLA ISZ IFS1 /FOUND MPCHR JMP I IFS1 /RETURN IFS2, .-. /SUBR. TO CHECK SYMBOL DEF. / FOR IFNL, IFDF DCA IFT1 /SET INDICATOR ISZ SCANP2 TAD I SCANP2 /NEXT CHAR TAD [-MPCHR SNA CLA /MPCHR? JMS I [GATHER /YES JMP IF9 /NO NAME, OR NO MPCHR. ERROR TAD IFS2 /SET UP FOR FAKE JMS DCA I [LOOKUP /SO LOOKUP PICKS UP ARG. AND /PERFORMS LOOKUP JMP LOOKUP+1 /GO GO GO! ODUMMY, .-. /DUMMY OUTPUT ROUTINE CLA STL RTL /2 STL RAL /5 TOTAL TAD ODUMMY DCA ODUMMY /NO ERRORS JMP I ODUMMY /RETURN /PB /PB PAGE / / TABLES AND BUFFERS FOR MACRO PROCESSOR / / / PATTERN STORAGE / PATLST, PAT13;PAT14;PAT1;PAT2;PAT3;PAT4;PAT5;PAT15 PAT6;PAT7;PAT8;PAT9;PAT10;PAT11;PAT12;PAT16 PAT17;PAT18;PAT19;0 /END PAT1, ZBLOCK 2;MCDF1 /DEFINE MACRO (1) 4;-"D;-"E;-"F;4;1;0 PAT2, ZBLOCK 2;MCDF2 /DEFINE MACRO (2) 1;4;-"D;-"E;-"F;4;1;0 PAT3, ZBLOCK 2;MCIRP /IRP 4;-"I;-"R;-"P;3;0 PAT4, ZBLOCK 2;SET /SET 4;-"S;-"E;-"T;4;1;-"=;0 PAT5, ZBLOCK 2;LCSET /LCS 4;-"L;-"C;-"S;4;1;-"=;0 PAT6, ZBLOCK 2;SSET /STRING SET 4;-"S;-"S;-"E;-"T;4;1;-"=;0 PAT7, ZBLOCK 2;LDLTE /LEFT DELETE 4;-"L;-"D;-"E;-"L;4;1;0 PAT8, ZBLOCK 2;MCLOOP /LOOP 4;-"L;-"O;-"O;-"P;0 PAT9, ZBLOCK 2;IF /GENERALIZED 'IF' 4;-"I;-"F;1;-":;0 PAT10, ZBLOCK 2;MCXEC /EXECUTE 4;-"X;-"E;-"C;-":;0 PAT11, ZBLOCK 2;OCT /SET OCTAL 4;-"O;-"C;-"T;0 PAT12, ZBLOCK 2;DEC /SET DECIMAL 4;-"D;-"E;-"C;0 PAT13, ZBLOCK 2;MACX1 /MACRO EXPAND (1) 4;1;0 PAT14, ZBLOCK 2;MACX2 /MACRO EXPAND (2) 1;4;1;0 PAT15, ZBLOCK 2;RCSET /RCS 4;-"R;-"C;-"S;4;1;-"=;0 PAT16, ZBLOCK 2;RDLTE /RIGHT DELETE 4;-"R;-"D;-"E;-"L;4;1;0 PAT17, ZBLOCK 2;MPSKIP /SKIP LINES 4;-"S;-"K;-"P;-":;0 PAT18, ZBLOCK 2;MCRET /FORCED MACRO RETURN 4;-"R;-"E;-"T;-":;0 /*************************************** / THESE HUMBLE LINES MUST BE AS THEY APPEAR, FUNNY 0 AND / LABELS, AND EVERYTHING / 0 /0 IN PRECEDING PATTERN IS USED AS /TERMINATION FOR THIS SET OF LISTS!!!! /'LINES' MUST BE FIRST ENTRY IN THIS TABLE FOR 'ERRLST' MACXL2, LINES;MACON;INPUT;MACIP1;MACIP1+1;MACXC3;MCXALK MCXBLK;IRPP2;IRPBCH;IRPC1;LUPCHR;LINSV1;LINSV2;0 -MCARG MACXL3, MACXL1;0 PDLEN=16+MCARG /LENGTH OF PD GROUP FOR 'ERRLST' /*************************************** CCHKL1, -" ;0 -211;0 /TAB -215;1 /CR -",;2 -":;3 -"+;5 -"-;5 -"*;6 -"/;6 -"\;6 -"&;7 -"!;7 0;4 /END OF LIST. SECOND # IS DEFAULT SEPCOD /PB /PB EVALL1, -"+;EVALPL -"-;EVALMI -"*;EVALTM -"/;EVALDV -"\;EVALRM -"&;EVALAN -"!;EVALOR;0 /END OF LIST OPSTK, ZBLOCK 4^2 /MAXIMUM DEPTH=4 /USE PRECEDING 0 AS TOP OF STACK /INDICATION EVALPD, ZBLOCK 4 /MAXIMUM PD DEPTH / LIST OF IF-TYPES IFL1, -0521;SZA CLA^2 /EQ -1605;SNA CLA^2 /NE -0705;SPA CLA^2 /GE -0724;SPA SNA CLA^2 /GT -1424;SMA CLA^2 /LT -1405;SMA SZA CLA^2 /LE -1614;SZA CLA^4+1 /NL (SPECIAL) -1616;SNA CLA^4+1 /NN (SPECIAL) -0406;SZA CLA^4+2+1 /DF (SPECIAL') -1604;SNA CLA^4+2+1 /ND (SPECIAL') 0 /END OF LIST /PB /PB /LOTS OF IMPORTANT TABLES AND BUFFERS LNBUF1, *.+LINLIM /ONE LINE BUFFER MACXL1, *.+MCARG /PLACED HERE TO ALLOW OVERRUN INTO... MCDFL1, *3^MCARG+3+3+. /EXTRA 3 FOR MACRO NAME, INSURANCE SYMTBL, *5^TBLSLT+. /MUST BE ADJACENT TO... LNKLST, *.+LNKNUM /FOR TABLE CLEARING IN 'TBLZRO' AAAEND=. /SO WE KNOW WHERE THINGS END PAGE /TO PAGE BOUNDARY INHNDB, *.+200 /ONE PAGE INPUT HANDLER OUHNDB, *.+200 /ONE PAGE OUTPUT HANDLER EJECT *LNBUF1 /INSERT SOME START-UP CODE F0ENTR, .-. /CALLED FORM FIELD 1 TAD (1001 /NON-RUNNABLE, FIELD 1 EXPENDABLE DCA I (7746 /SET JSW TAD OUTCD /GET FIRST WORD OF OUTPUT SPEC. SNA /IS THERE A FILE? JMP F0EN1 /NO. SAVES SOME WORK CIF 10 /YES JMS I (USR /GET HANDLER 1 OUHNDB /FOR OUTPUT JMP F0ENER /ERROR TAD .-2 /ENTRY POINT DCA OUHNDL TAD OUTCD /CONTAINS FILE LENGTH, TOO CIF 10 JMS I (USR 3 /ENTER OUTPUT F0EN0, OUTCD+1 /POINTER TO FILENAME /IF THERE WAS NONE, 8BALOU.TM WILL /BE THERE. OTHERWISE, THE SPECIFIED /ONE IS USED 0 /FILLED IN BY 'ENTER' JMP F0ENER /ERROR OF SOME SORE TAD OUTCD AND (17 DCA OUTCD /JUST SAVE DEVICE # FOR LATER TAD F0EN0 /START BLOCK DCA OUTBLK /SAVE TAD F0EN0+1 /FILE LENGTH FOR REAL F0EN1, DCA OUTFLM /SAVE FILE LIMIT TAD (7617-1 DCA CDP /INITIALIZE REAL 'CDP' IN FIELD 0 CDF 10 /DATA IN FIELD 1 TAD I CDP CDF 0 AND (17 /JUST WANT DEVICE #, IF ANY DCA CHNDEV /SET UP DEVICE FOR CHAINING CDF 10 TAD I CDP CDF 0 DCA CHNBLK /AND START BLOCK CDF 10 TAD I CDP /FIRST REAL INPUT CDF 0 SNA /IS THERE ONE? JMP F0ENER /NO. ERROR CIF 10 /YES JMS I (USR 1 /FETCH HANDLER INHNDB /ONE PAGE JMP F0ENER /ERROR FETCHING TAD .-2 /HANDLER ENTRY POINT DCA INHNDL /SAVE CDF 10 TAD I CDP /START BLOCK CDF 0 DCA INBLK /SAVE CDF CIF 10 /BACK UP-STAIRS JMP I F0ENTR /RETURN F0ENER, JMS I [SERROR /SYSTEM ERROR "S /START-UP /NO RETURN PAGE /FORCE OUT LINKS /PB /PB /*****************PAGE0, FIELD 0 LITERALS***************/ FIELD 1 *RCSET+200 /SHOULD BE AT 3000. WILL BE /IN FIELD 0 AT THAT POINT / OVERLAY SWAPPED IN TO SEEK MACRO IN LIBRARY FNDMAC, SKP /FIRST TIME ONLY JMP FNDM0 /NORMAL PROCESSING HERE ISZ FNDML /CHANGE LINK SO CONTROL GOES /TO FNDMAC+1 AFTER THIS CMA TAD FNDBLK /POINT AT LIBRARY DIRECTORY DCA .+4 FNDMP1, JMS I DSKHND /READ LIBRARY DIRECTORY /THIS USED LATER AS PTR 201 /READ FORWARD FNDB ZZZ JMP FNDMER FNDMP2, JMS I ZSYSHN /SYSTEM HANDLER PAGE 0 LINK /THIS USED LATER AS PTR 4200 FNDB 47 /LOADER AREA JMP FNDMER FNDM0, DCA FNDMT1 /INITIALIZE SLOT # TAD (-63 DCA FNDMC1 /51 SLOTS TOTAL FNDM1, TAD FNDMT1 CLL RTL TAD FNDMT1 /*5 TAD FNDBUF /ALSO WHERE DIRECTORY IS DCA XR13 TAD I XR13 SNA /ENTRY PRESENT? JMP FNDM2 /NO TAD GATHBF /YES. COMPARE WITH GATHBF SZA CLA JMP FNDM2 /NO MATCH TAD I XR13 TAD GATHBF+1 SZA CLA JMP FNDM2 /NO MATCH TAD I XR13 TAD GATHBF+2 SNA CLA JMP FNDM3 /MATCH FNDM2, ISZ FNDMT1 /NEXT ENTRY ISZ FNDMC1 JMP FNDM1 JMP SWIN1 /NOT IN LIBRARY. PROCEED FNDM3, TAD I XR13 /GET QUARTER DCA FNDMT1 CMA CLL RAL AND FNDMT1 /STRIP OFF LOW ORDER BIT CLL RTR /SO ROTATED BIT WON'T GO TO BIT 0 TAD FNDBLK /ADD TO DIRECTORY BLOCK+1 DCA FNDBL /FOR READ TAD FNDMT1 AND (3 CLL RTL RTL RTL /QUARTER * 100 WORDS DCA FNDMT1 /OFFSET IN BLOCK (WDS) TAD FNDMT1 TAD FNDBUF DCA FNDMP1 /INITIAL POINTER DCA FNDMP1+1 /CLEAR BYTE JMS LOOKUP /FORCE CREATED ENTRY 440 /OF MACRO JMS IERROR /CANNOT HAVE ALREADY EXISTED! TAD I TBLWD1 /LOOK AT 'TYPE WORD' SZA CLA /ALREADY DEFINED? JMS IERROR /YES! JMS LNKCRT /CREATE LINK FNDMC1, ZZZ /POINTER DCA I TBLWD2 /SAVE LINK NUMBER TAD .-2 DCA FNDMP2 /SAVE POINTER DCA FNDMP2+1 /CLEAR BYTE DCA FNDMC2 /NUMBER OF CHARS IN LINK TAD FNDMT1 CLL RAR TAD FNDMT1 /1.5 * WD OFFSET = CHARS TAD (-600 DCA FNDMC1 /# OF CHARS IN THIS BLOCK JMP FNDM5 /GET FIRST BLOCK FNDM4, TAD (-600 /BLOCK COUNT DCA FNDMC1 ISZ FNDBL /NEXT BLOCK TAD FNDBUF DCA FNDMP1 /RESET POINTER DCA FNDMP1+1 FNDM5, JMS I DSKHND /CALL DSK: HANDLER 200 /2 PAGE (1BLOCK) READ FNDBUF, FNDB FNDBL, ZZZ JMP FNDMER /ONLY WAY OUT FNDM6, JMS GETCHR /GET CHAR FROM BUFFER FNDMP1 CDF 0 SNA /END OF MACRO? JMP FNDM7 /YES JMS PUTCHR /NO. STORE IN LINK FNDMP2 SFLD ISZ FNDMC2 ISZ FNDMC1 /DONE BUFFER? JMP FNDM6 /NO JMP FNDM4 /YES FNDM7, JMS PUTCHR /PUT 0 CHAR FNDMP2 SFLD ISZ FNDMC2 JMS GETCHR FNDMP1 CDF 0 TAD (400 /CHAR IS # OF ARGS DCA I TBLWD1 /SET TYPE WORD JMS LNKCHK FNDMC2, ZZZ JMP SWIN2 /PROCESS THIS MACRO FNDMT1, 0 DSKHND, 0 /FILLED IN BY /Y PROCESSOR FNDBLK, 0 /FILLED IN BY /Y PROCESSOR /PB /PB PAGE FNDB=. /IN FIELD 0 AT EXECUTION TIME SLASHY, .-. /PROCESS LIBRARY OPTION CLA STL RAR /4000 AND I (7645 /CHECK /Y SNA CLA JMP I SLASHY /NOT THERE. TREAT AS REGULAR CD CIF 0 JMS I (SYSHND /WRITE SCRATCH FIRST 4200 /2 PAGES, FIELD 0 RCSET 33 /MONITOR FIELD 0 AREA JMP SLYER TAD I (7617 /FIRST CD INPUT SZA /PRESENT? JMP SLY4 /YES. USE IT JMS I (USR /NO. GET DSK:8BALIB.ML 1 DEVICE DSK SLY1, RCSET /LOAD THERE JMP SLYER TAD SLY1 /ADDRESS OF HANDLER DCA DSKHND TAD SLY1-1 /DEVICE # SLY1A, JMS I (USR 2 /LOOKUP SLY2, SLYNME /8BALIB.ML 0 JMP GOGO /NOT FOUND SLY2A, TAD SLY2 /START BLOCK SNA /FOR NON-FILE-STRUCTURED? JMP GOGO /YES. SKIP THIS STUFF IAC DCA FNDBLK /SAVE FIRST DATA BLOCK SLY3, CDF 10 TAD I SLYP1 CDF 0 DCA I SLYP1 /MOVE FNDMAC ISZ SLYP1 ISZ SLYC1 JMP SLY3 TAD (ISZ TBLFLG DCA I (SWOUT+1 /REPLACE NOP CDF 10 CIF 0 JMS I (SYSHND 4200 /WRITE GOODIES /(HANDLER AND FNDMAC) RCSET 46 /LOADER AREA JMP SLYER GOGO, CIF 0 JMS I (SYSHND /RETRIEVE BASIC 8BAL 200 RCSET 33 JMP SLYER JMS I (USR 5 /CD 7002 /.8B RECALL CD FOR REAL INPUT JMP I SLASHY SLY4, JMS I (USR /FETCH HANDLER 1 SLY5, RCSET JMP SLYER TAD SLY5 /HANDLER ENTRY DCA DSKHND TAD SLY5 DCA SLY1 /SET FOR LATER TAD I (7620 SNA /FILE SPECIFIED? JMP .+3 /NO. WILL LOOK UP 8BALIB.ML DCA SLY2 /YES. SAVE START BLOCK JMP SLY2A /CONTINUE BY READING DIREC... TAD I (7617 /RETRIEVE DEVICE NUMBER JMP SLY1A /LOOKUP FILE SLYER, JMS I (USR 7 /SIGNAL ERROR "M-"0 /NO RETURN SLYP1, RCSET+200 SLYC1, -200 SLYNME, FILENAME 8BALIB.ML /AT THIS POINT, SYS: HAS: /BLOCK 33: BASIC 8BAL, 2600-3177 /BLOCK 34: WILL GET BASIC 8BAL, 3200-3577 /BUT, THIS AREA IS USED FOR SCRATCH LATER /BLOCK 46: DSK: HANDLER; FNDMAC /BLOCK 47: D WILL GET DIRECTORY FOR LIBRARY /*****************NOTE!!!******************/ / REGULAR CD CALL PERFORMS 'RESET', / WHICH WILL EFFECTIVELY FORGET THE / LIBRARY HANDLER. THEREFORE, / NEITHER INPUT NOR OUTPUT HANDLER WILL / TRY TO USE LIBRARY HANDLER /******************************************/ /PB /PB PAGE USR=200 START, ISZ STARC1 /INDICATE KEYBOARD START CIF 0 /COME HERE ON CHAIN CALL JMS CORS /GET CORE SIZE STARC1, 0 /ALWAYS SKIPPED DCA XCORSZ /SAVE CORE SIZE FOR LATER JMS I (7700 /CALL USR 10 /AND LOCK TAD STARC1 /CHECK FLAG SNA CLA /KEYBOARD CALL? JMP STAR1 /YES. DON'T CALL CD JMS I (USR /NO. GET CD STRING 5 7002 /.8B ASSUMED JMS SLASHY /CHECK POSSIBLE LIBRARY CALL STAR1, JMS I (USR 12 /INQUIRE STAR2=.+1 /GETS DEVICE CODE LATER DEVICE DSK /CHECK DSK 0 JMP STARER /NO DSK!! TAD (7600-1 DCA CDP /POINT AT CD OUTPUT TAD (OUTCD-1 /IN FIELD 0 DCA XR10 /POINT AT PLACE WHERE FIRST /OUTPUT FILE WILL END UP TAD I CDP SZA /IS THERE AN OUTPUT DEVICE? JMP STAR3 /YES TAD I (7617 /NO. FIRST INPUT (CHAIN) SNA CLA /HAS A CHAIN BEEN REQUESTED? JMP STAR5 /NO. NO FURTHER OUTPUT SETUP, /FIELD 0 ALREADY HAS RIGHT GOODIES TAD STAR2 /YES. DEVICE IS DSK: BY DEFAULT STAR3, JMS STARS1 /STORE, GET NEXT SNA /IS THERE A FILENAME? JMP STAR4 /NO. 8BALOU.TM ALREADY SET UP JMS STARS1 /YES. MOVE JMS STARS1 /FILE JMS STARS1 /NAME SNA /IS THERE AN EXTENSION? TAD (2001 /NO. MAKE IT .PA CDF 0 /PICK PROPER FIELD DCA I XR10 /YES. STORE EXTENSION STAR4, CDF 10 /BACK TO THIS FIELD TAD (7600+5-1 /POINT AT SECOND OUTPUT FILE DCA CDP TAD (7600-1 /AND FIRST OUTPUT FILE DCA XR10 TAD (-12 DCA STARC1 TAD I CDP DCA I XR10 /MOVE UP OTHER TWO OUTPUTS ISZ STARC1 JMP .-3 DCA I XR10 /MAKE THIRD OUTPUT DISAPPEAR DCA I XR10 STAR5, CDF CIF 0 JMS F0ENTR /GO TO FIELD 0 TO DO SOME STUFF JMS I (USR /THEN, 11 /KICK OUT USR JMP TBLZRO /AND DO SOME MORE STUFF STARS1, .-. /PULL A QUICKIE CDF 0 DCA I XR10 CDF 10 TAD I CDP JMP I STARS1 STARER, JMS I (USR /START UP ERROR 7 /SIGNAL USER "S-"0 /WITH AN 'S' /NO RETURN /PB /PB PAGE TBLZP1=. /WHEN YOU'RE TIGHT, YOU'RE TIGHT (AND LAZY) TBLZRO, TAD (-5^TBLSLT-LNKNUM /LENGTH OF AREA TO ZERO DCA TBLZC1 TAD (SYMTBL-1 DCA XR10 STL RTL /2 AND I (7644 /SECOND OPTION WORD (/W) CDF 0 SNA CLA /SET? JMP .+3 /NO TAD TBLZGO /YES. 'CLA' TO SUPPRESS /W TYPE-OUTS DCA I (PUTL2 DCA I XR10 ISZ TBLZC1 JMP .-2 CDF 10 /TO GET OPTION IAC AND I (7644 /SECOND OPTION WORD (/X) SZA CLA /SET? JMP TBLZGO /YES. LEAVE WITH 8K VERSION CMA CLL RAL /-2 TAD XCORSZ /FETCH SAVED CORE SIZE SPA />8K AVAILABLE? JMP TBLZGO /NO. USE 8K SZA CLA />12K? TAD (TBL16K-TBL12K /YES TAD (TBL12K-1 DCA 12 TBLZ1, CDF 10 TAD I 12 SNA JMP TBLZGO DCA TBLZP1 TAD I 12 CDF 0 DCA I TBLZP1 JMP TBLZ1 TBLZGO, CLA CDF CIF 0 TAD (1000 DCA I (7746 /SET JSW=1000 JMP INLUP /START PROGRAM TBLZC1, 0 XCORSZ, 0 /FILLED AT 'START' TBL12K, LNKLIM;7600; PUSHP;5177; RDCH1+1;410; INBUFP;6600 PUSHST;5177 /INITIAL VALUE OF PD (FOR 'ERRLST') INBLSZ;2; INBLCT;-1400; OUTBFP;5200 OUBLCT;-2200; PUSHA1;SZA CLA PUSHA1+1;PUSHA&177+5600 /JMP I PUSHA PUSHA1+2; JMS I TTERR; LCHK1;LNKEND+1000 /TAD LNKEND WRTCC1;-2200; WRTCP1;5200 SF+1;CDF 20; 0 TBL16K, LNKLIM;7600; PUSHP;7577; RDCH1+1;1610; INBUFP;4200 PUSHST;7577 /INITIAL VALUE OF PD (FOR 'ERRLST') INBLSZ;7; INBLCT;-5200; OUTBFP;200 OUBLCT;-6000; PUSHA1;SZA CLA PUSHA1+1;PUSHA&177+5600 /JMP I PUSHA PUSHA1+2;JMS I TTERR; PUSHA+1;CDF 20;ERRL2;CDF 20 POPA+2;CDF 20; LCHK1;LNKEND+1000 /TAD LNKEND WRTCC1;-6000; WRTCP1;200 SF+1;CDF 30; 0 $ /PB