TITLE MICRO CODE ASSEMBLER ; TOM EGGERS/JSL 30 APRIL, 75 ; modified for ITS OCTOBER 1975. ;4/21/79 Moon .SEQADR ;CUSTVR==0 ;CUSTOMER VERSION ;DECVER==20 ;MAJOR VERSION ;DECMVR==0 ;MINOR VERSION ;DECEVR==156 ;EDIT NUMBER ;LOC <.JBVER==:137> ; BYTE (3) CUSTVR (9) DECVER (6) DECMVR (18) DECEVR DEFINE SUBTTL A/ TERMIN ;AC DEFINITIONS F==0 ;FLAG REGISTER T1=1 ;GLOBAL TEMP T2=T1+1 ;DITTO T3=T2+1 T4=T3+1 RAM==7 ;CONTAINS RAM NUMBER CURRENTLY BEING ASSEMBLED UCODE==0 DISP==1 ;BITS WITHIN AC RAM FPNT=10 ;POINTS TO CURRENT FIELD NAME IN SYM TABLE SPNT=11 ;POINTS TO CURRENT SYMBOL NAME IN SYM TABLE C=12 ;HOLDS LAST CHARACTER READ FOR INPUT C1=C+1 N=14 ;GLOBAL AC FOR PASSING ARGS N1=N+1 ;DITTO PM=16 ;STACK FOR MACROS AND RESCANS P=17 ;PUSH DOWN POINTER ;IN AC F (RIGHT HALF) REREAD==1 ;REREAD LAST INPUT CHARACTER SUPP==2 ;SUPPRESS ASSEMBLY BINF==200 ;BINARY WORD HAS BEEN STARTED PASS2==400 ;0 FOR PASS1, 1 FOR PASS2 ERROR==1000 ;ERROR FOUND ON LINE NOHDR==2000 ;SUPPRESS PRINTING TOP-OF-PAGE HEADERS DEFINE SWSET VAR,VAL IFNDEF VAR,VAR==VAL IF2,[ IFN VAR,[ PRINTX \SWITCH VAR IS ON \] IFE VAR,[ PRINTX \SWITCH VAR IS OFF \]] TERMIN SWSET FTLOOS,0 ;1 TO DISTINGUISH "LOOSE" MICRO-WORDS SWSET FTCOIN,0 ;1 TO CREF ALL LINES OF ONE WORD TOGETHER SWSET FTMAP,1 ;1 TO PRINT MAP OF LINE #'S BY LOCATION SWSET FTECHR,0 ;1 TO PRINT LAST CHAR ON ERROR SWSET FTIF,1 ;1 TO ENABLE CONDITIONAL ASSEMBLY LOGIC SWSET FTBB,0 ;1 TO ENABLE KL10 BREADBOARD HACK IFN FTBB,[ FTLOOS==1 GDWRDS==2000'/36. BORDER==-1_<35.-<2000'-<<2000'/36.>*36.>-1>> ] ;DEFINE IO CHANNELS OUTCHN==0 INCHN==1 TYIC==2 TYOC==3 ERRC==4 DEFINE MSG [A,B] 1000,,[[ASCIZ @B@],,A] TERMIN OUTSTR=2000,,0 HALT=3000,,0 ;THESE CRETINOUS BAG CHOMPERS STORE DATA IN THE RH OF HALT LPPAG==58. ;LINES PER PAGE EXIT=.BREAK 16,040000 DEFINE PINDEX SIZ,ADR REPEAT 36./, POINT SIZ,ADR,<.RPCNT+1>*-1 TERMIN DEFINE POINT (SIZ,ADR,POS=-1 <<43'-<.RADIX 10.,>>_36'+<.RADIX 10.,>_30'+ADR>TERMIN DEFINE IOWD (A,B) -,,-1 TERMIN ;STRUCTURE DEFINITIONS MICMXB==144. ;MAX NUMBER OF BITS IN A MICRO WORD MICMXW==MICMXB/36. ;MAX NUMBER OF WORDS FOR A MICRO WORD NCHARS==20. ;MAX NUM OF CHARS IN A SYMBOL NWORDS==/5 ;MAX NUMBER OF WORDS TO HOLD A SYMBOL MAXPC==2047. ;MAXIMUM AMOUNT OF MICRO CODE-1 MAXDSP==512. ;MAX SIZE OF DISPATCH ;STRUCTURE OF A SYMBOL TABLE ENTRY OFFSET -. SYMLNK::BLOCK 1 ;LEFT HALF CHAINS SYMBOLS WITHIN A FIELD TOGETHER ;RIGHT HALF CHAINS FIELDS TOGETHER ;POINTER TO 1ST FIELD IS IN FLDPNT SYMMAC==SYMLNK ;FOR MACRO SYMBOLS, RIGHT HALF ;POINTS TO 1ST CHAR OF MACRO EXPANSION SYMPSO==SYMLNK ;FOR PSEUDO OPS, RH IS HANDLER ADDR SYMEQL==SYMLNK ;RH LINKS EQUAL TAGS IN J FIELD SYMTXT::BLOCK NWORDS ;1ST WORD WITH ASCIZ TEXT FOR NAME SYMVAL::BLOCK 1 ;CONTAINS VALUES FOR A SYMBOL SYMCRF::BLOCK 1 ;LEFT IS POINTER TO LAST ITEM IN CREF LIST ;RIGHT IS POINTER TO 1ST ITEM SYMLST==.-1 ;LAST LOCATION IN BLOCK SYMLEN==.-SYMLNK ;# OF WORDS IN A SYMBOL BLOCK OFFSET 0 ;FLAGS IN SYMBOL FLAG FIELD MULF==1 ;TWO-SEGMENT FROBBERY %%HIGH==400000 %%LOW==100 %%PURE==0 DEFINE PURE IFN %%PURE,.ERR TWO `PURE'S IN A ROW .ELSE %%LOW==. %%PURE==1 LOC %%HIGH TERMIN DEFINE IMPURE IFE %%PURE,.ERR TWO `IMPURE'S IN A ROW .ELSE %%HIGH==. %%PURE==0 LOC %%LOW TERMIN SUBTTL INITIALIZATION PURE MICRO: .OPEN TYIC,[.UAI,,'TTY] .VALUE .OPEN TYOC,[%TJDIS+.UAO,,'TTY] .VALUE .SUSET [.RRUNT,,N] ;GET STARTING RUNTIME SETZM GOBLT MOVE T1,[GOBLT,,GOBLT+1] BLT T1,ENDBLT-1 ;ZERO STORAGE AREA MOVEM N,STTIME ;SAVE STARTING TIME .CALL [ SETZ ? 'CNSGET ? MOVEI TYOC ? REPEAT 4,[MOVEM T1 ? ] SETZM T1 ] MOVEI T1,0 SETZM DISTTY TLNE T1,%TOERS SETOM DISTTY MOVEI 17,1 MOVEI 0,0 BLT 17,17 ;ZERO THE AC'S MOVE P,[IOWD PDLEND-PDL-1,PDL] MOVE PM,[IOWD PMEND-PMDL-1,PMDL] MOVE T1,[PUSHJ P,UUOH] MOVEM T1,41 PUSHJ P,FNR. ;READ COMMAND LINE ;SETUP IO SKIPN O.DEV MSG [EXIT], NO OUTPUT FILE SPECIFIED .CALL [ SETZ SIXBIT/OPEN/ [.BAO,,OUTCHN] O.DEV O.NAM O.EXT SETZ O.PPN ] PUSHJ P,OFOPER ;CAN'T OPEN MOVE T1,[OUTCHN,,RCHST] .RCHST T1, MOVE T1,RCHST+1 MOVEM T1,OUTFIL+F.NAM MOVE T1,RCHST+2 MOVEM T1,OUTFIL+F.EXT MOVE T1,RCHST+3 MOVEM T1,OUTFIL+F.PPN MOVE T1,O.DEV ;RCHST SCREWS DEVICE MOVEM T1,OUTFIL+F.DEV .CALL [ SETZ 'RQDATE SETZM OUTFIL+F.TIM ] .VALUE PUSHJ P,PNTINI ;INIT OUTPUT LISTING HRROI T1,1 ;START AT PAGE 1, NEED A HEADER MOVEM T1,PAGNUM BEGPAS: SETZM STATE ;INIT STATE FOR SYNTAX ANALYSIS SETZM PC+UCODE SETZM PC+DISP SETOM PRNTPC+UCODE ;LAST LOC ASSEMBLED WAS -1 SETOM PRNTPC+DISP ; IN BOTH RAMS MOVEI RAM,UCODE ;START WITH UCODE ASSEMBLY MOVEI T1,1 MOVEM T1,LINNUM ;INIT LINE NUMBER TO 1 PUSHJ P,BEGIO ;INIT INPUT IO MSG [EXIT], NO INPUT FILES SETZM USAGE MOVE T1,[USAGE,,USAGE+1] IFN FTBB,[ BLT T1,USAGE+GDWRDS-1 MOVE T1,[252525252525] MOVEM T1,USAGE+GDWRDS+1 TLZ T1,(BORDER) MOVEM T1,USAGE+GDWRDS MOVE T1,[USAGE+GDWRDS+1,,USAGE+GDWRDS+2] ];END FTBB BLT T1,USGEND-1 ;CLEAR USAGE TABLE ANDI F,PASS2 SUBTTL TOP LEVEL ASSEMBLY LOOP STATLP: SKIPE STATE JRST STAT1 TRZ F,BINF\ERROR ;ONLY CLEARED IN STATE 0 SETZM VALUE MOVE T1,[VALUE,,VALUE+1] BLT T1,VALEND-1 MOVE T1,LINNUM HRRZM T1,CRFLIN' ;CREF LINE # CHANGES ONLY ON MICRO WORDS STAT1: PUSHJ P,TOKEN ;SCAN NEXT TOKEN LSH N,.SZTRM ;MOVE TOKEN TYPE OVER LDB T1,STAPNT ;GET TERM CHARACTER TYPE IOR T1,N ;COMBINE STATE, TOKEN TYPE, AND TERM TYPE IOR T1,STATE IDIVI T1,36./<.SZDSP+.SZSTA> LDB T1,STAMTB(T1+1) ;GET DISPATCH AND NEW STATE DPB T1,[POINT .SZSTA,STATE,35.-.SZTOK-.SZTRM] LSH T1,-.SZSTA STAXCT: XCT STDISP(T1) ;DISPATCH TO HANDLE FIELD AND TERM SKIPN STATE PUSHJ P,PNTBIN ;BINARY PRINTED IFF PASS2 & STATE=0 & BINARY ASSEMBLED CAIN C,"; PUSHJ P,SCNEND ;FLUSH A COMMENT CAIE C,12 JRST STATLP ;AND START ALL OVER AGAIN PUSHJ P,PNTLIN ;FINISH END OF LINE SKIPN ENDFIL ;END-OF-FILE? JRST STATLP ;NO TRON F,PASS2 JRST START2 ;GO BEGIN PASS 2 PUSHJ P,FINLST PUSHJ P,OUTCLS .CLOSE OUTCHN, EXIT ;MICRO ASSEMBLY COMPLETELY DONE SCND1: PUSHJ P,GETCHR SCNEND: CAIE C,12 ;SEARCH FOR END OF LINE JRST SCND1 POPJ P, SUBTTL STATE TABLE DISPATCH STDISP: PUSHJ P,ILLFOR ;FOR ANY UNDEFINED FORMAT DLBLK: PUSHJ P,LOCBLK DTAG: PUSHJ P,TAG DLSET: PUSHJ P,LOCSET ;"NUMBER:" DCFLD: PUSHJ P,CFSPC ;COND ASSY OR FIELD DFLD: PUSHJ P,FLDSPC ;FIELD/ DMDEF: PUSHJ P,DEFMAC DSUDO: PUSHJ P,PSEUDO DMAC: PUSHJ P,BEGMAC DNOP: JFCL DDEFF: PUSHJ P,DEFFLD DDEFS: PUSHJ P,DEFSYM DFSYM: PUSHJ P,FLDSYM DFNUM: PUSHJ P,FLDNUM DCMNT: PUSHJ P,SCNEND ILLFOR: MSG SCNEND, ILLEGAL FORMAT SUBTTL START PASS 2 ;HERE TO START PASS 2 BY LISTING TABLE OF CONTENTS, IF ANY START2: SKIPE N,TTLPNT ;IS THERE A TITLE? OUTSTR (N) ;YES, SEND TO TTY OUTSTR [ASCIZ / /] SKIPN TOCPNT ;ANYTHING FOR TABLE OF CONTENTS? JRST TOCEND ;NO MOVEI C,[ASCIZ /TABLE OF CONTENTS/] PUSHJ P,SETHDR ;SETUP SPECIAL HEADER HLRZ N,TOCPNT ;BEGIN SCAN OF TOC LIST TOCLUP: PUSH P,N ;SAVE ADDR OF THIS ENTRY PUSHJ P,PRINT ASCIZ /; / ;OUTPUT AS COMMENT MOVE N,0(P) ;PICK UP ENTRY ADDR HRRZ C,0(N) ;LINE NUMBER OF DEFINITION PUSHJ P,PNTDEC ;IN DECIMAL PUSHJ P,TAB MOVE N,0(P) ;ENTRY ADDR AGAIN MOVEI N,1(N) ;POINT TO TEXT PUSHJ P,PRINT0 ;PRINT IT PUSHJ P,NEWLIN POP P,N ;PICK UP LINK HLRZ N,0(N) ;GET ADDR OF NEXT ENTRY JUMPN N,TOCLUP ;PRINT IT IF IT EXISTS PUSHJ P,PRINT ASCIZ \; CROSS REFERENCE INDEX ; DCODE LOCATION / LINE # INDEX ; UCODE LOCATION / LINE # INDEX \ SETZM HDRPNT ;TURN OFF SPECIAL HEADERS TOCEND: PUSHJ P,FORM ;THROW A PAGE JRST BEGPAS ;AND DO PASS 2 SUBTTL PROCESS "FIELD/" AND CONDITIONALS ;FIELD/ SCANNED. COULD BE CONDITIONAL ASSEMBLY CFSPC: IFN FTIF,[ MOVEI FPNT,PSUDF% ;PSEUDO FIELD TABLE PUSHJ P,SRCSY1 ;IS IT A DEFINED PSEUDO-FIELD? JRST CFSPC1 ;NO, TRY FOR NORMAL FIELD MOVE T1,SYMPSO(SPNT) ;YES, GET HANDLER ADDR JRST 0(T1) ;GO TO IT $DEFLT: MOVEI T1,1 ;SET SWITCH IF NOT DEFINED JRST SWT $SET: TDZA T1,T1 ;ERROR IF SWITCH PREVIOUSLY DEFINED $CHNG: SETO T1, ;ERROR IF SWITCH NOT DEFINED SWT: MOVEM T1,SWTFLG' TRNE F,SUPP ;ALREADY SUPPRESSED? JRST SCNEND ;YES, IGNORE THIS PUSH P,RAM ;SWITCHES ARE NOT RAM-SPECIFIC MOVEI RAM,0 SKIPE FPNT,SWTPNT ;IS THE SWITCH% FIELD DEFINED? JRST SWT1 ;YES, AVOID SEARCH MOVE T1,[SWTCH,,FIELD] BLT T1,FIELD+NWORDS-1 PUSHJ P,MAKFLD ;CREATE INTIAL SWITCH FIELD MSG STOP, !!CAN'T DEFINE "SWITCH%"!! MOVEM FPNT,SWTPNT SWT1: MOVE T1,[NAME,,FIELD] BLT T1,FIELD+NWORDS-1 PUSHJ P,TOKEN ;GO GET SWITCH NAME CAIE N,.TKS ;IT MUST BE SYMBOLIC MSG SWT99, NO SYMBOL IN CONDITIONAL ASSEMBLY DEFINITION PUSHJ P,SRCSYM ;GO LOOK FOR SYMBOL JRST SWT2 ;NOT FOUND SKIPLE SWTFLG ;FOUND. IS THIS A DEFAULT? JRST SWT99 ;YES -- DEFAULT HAS BEEN PREVIOUSLY SET TRNN F,PASS2 ;IS IT PASS1? SKIPE SWTFLG ; AND A SET? JRST SWT3 ;NO, GO CHANGE VALUE MSG SWT3, SWITCH SET TWICE SWT2: SKIPGE SWTFLG ;IS THIS A CHANGE? MSG .+1, SWITCH CHANGED WITHOUT SET OR DEFAULT PUSHJ P,MAKS1 ;FILL IN SYMBOL ENTRY JRST SWT99 ;CAN'T CREATE IT SWT3: CAIE C,"= ;DID SWITCH NAME TERMINATE WITH EQUAL? MSG SWT99, FORMAT ERROR ON SWITCH SPECIFICATION PUSHJ P,TOKEN ;GO GET SWITCH VALUE CAIE N,.TKN MSG SWT99, SWITCH VALUE MUST BE NUMERIC MOVE N,NUMBER ;GET SWITCH VALUE DPB N,DEFVAL ;PUT INTO VALUE OF SYMBOL SWT99: POP P,RAM ;RESTORE CURRENT RAM SETZM STATE SETZM FIELD JRST SCNEND ;IGNORE REST OF LINE ;HERE FOR CONDITIONAL ASSEMBLY TEST PSEUDO-OPS $ENDIF: MOVEI T1,1 JRST AIF1 $IF: TDZA T1,T1 $IFNOT: MOVNI T1,1 AIF1: MOVEM T1,SWTFLG ;FLAG TO INVERT ASSEMBLY SENSE PUSHJ P,TOKEN CAIE N,.TKS ;SWITCH MUST BE SYMBOLIC MSG SCNEND, SWITCH MUST BE SYMBOLIC SKIPE FPNT,SWTPNT PUSHJ P,SRCSYM ;GO LOOK FOR SWITCH SYMBOL MSG SCNEND, SWITCH NOT DEFINED TRNN F,SUPP ;CURRENTLY SUPPRESSED? JRST IF3 ;NO CAME SPNT,SUPSYM ;IS THIS THE SYMBOL WHICH SUPPRESSED? JRST SCNEND ;NO, IGNORE IF3: MOVEM SPNT,SUPSYM ;SAVE SUPPRESSION SYMBOL LDB T1,DEFVAL ;GET SWITCH VALUE SKIPG SWTFLG ;VALUE IRRELEVANT ON ENDIF SKIPE T1 ;SWITCH SET? TRZA F,SUPP TRO F,SUPP ;SUPPRESS ASSY SKIPGE SWTFLG ;INVERT SENSE? TRC F,SUPP MOVEI T1,0 TRNE F,SUPP ;NOW...ARE WE SUPPRESSED? MOVEI T1,4_<.SZTOK+.SZTRM> MOVEM T1,STATE ;STATE 0 IF ASSEMBLING, 4 IF SUPPRESSED JRST SCNEND CFSPC1: TRNE F,SUPP ;IN SUPPRESSED ASSEMBLY? JRST SCNEND ;YES, AND NOT END OF COND. COMMENT ];END IFN FTIF FLDSPC: MOVE T1,[NAME,,FIELD] BLT T1,FIELD+NWORDS-1 ;MOVE NAME TO FIELD POPJ P, ;FIELD/NUMBER SCANNED, INSERT VALUE INTO MICRO WORD FLDNUM: IFE FTBB,[ TRNN F,PASS2 JRST FLDS99 ] PUSHJ P,SRCFLD JRST FLDS1 LDB T2,DEFSIZ ;GET SIZE OF FIELD SETOM T1 ;1S INTO T1 LSH T1,(T2) ;0S ON RIGHT EQUAL TO BYTE LENGTH MOVE N,NUMBER MOVM T2,N ;SAVE POS VAL OF NUMBER TDZ N,T1 ;MASK NUMBER TO CORRECT SIZE TDNE T2,T1 ;WILL NUMBER FIT IN FIELD? MSG FLDN2, NUMBER TOO BIG FOR FIELD PUSHJ P,BITS1 ;NUMBER ALWAYS GOES INTO FIELD FLDN2: PUSHJ P,MAKCRF ;PUT FIELD INTO CREF LISTING JRST FLDS99 ;FIELD/SYMBOL SCANNED, INSERT VALUE INTO MICRO WORD FLDSYM: IFE FTBB,[ TRNN F,PASS2 JRST FLDS99 ] PUSHJ P,SRCFLD FLDS1: MSG FLDS99, FIELD NOT DEFINED PUSHJ P,SRCSYM TRCA RAM,DISP\UCODE ;NOT FOUND, LOOK IN OTHER TABLE JRST FLDS3 ;FOUND PUSH P,FPNT ;SAVE FIELD POINTER PUSHJ P,SRCFLD ;FIND OTHER FIELD, IF ANY JRST FLDLUZ ;NONE PUSHJ P,SRCSYM JRST FLDLUZ ;NO SYMBOL IN OTHER FIELD EITHER POP P,FPNT ;GET CORRECT FIELD BACK TRC RAM,DISP\UCODE ;PUT MODE BACK FLDS3: LDB T1,DEFTM1 ;GET 1ST TIME ADDM T1,TIME1 ;ACCUMULATE SUM LDB T1,DEFTM2 ;SAME FOR 2ND TIME ADDM T1,TIME2 LDB T1,DEFFNC MOVE T1,DEFTAB(T1) PUSHJ P,(T1) ;DISPATCH ON FUNCTION FLDS99: TRO F,BINF ZFPOPJ: SETZM FIELD ;NO CARRY OVER OF FIELD NAMES POPJ P, FLDLUZ: POP P,FPNT ;ADJUST STACK TRC RAM,DISP\UCODE ;PUT MODE BACK IFN FTBB,[ TRNN F,PASS2 JRST FLDS99 ] MSG FLDS99, SYMBOL NOT DEFINED SUBTTL PSEUDO INSTRUCTIONS (INCL MACROS) PSEUDO: MOVEI FPNT,PSUDO% ;PSEUDO SYMBOL TABLE PUSHJ P,SRCSY1 ;IS IT A DEFINED PSEUDO OP? JRST BEGMAC ;NO, SEE IF IT'S A MACRO MOVE T1,SYMPSO(SPNT) ;YES, GET HANDLER ADDR JRST 0(T1) ;GO TO IT $DCODE: MOVEI RAM,DISP POPJ P, $UCODE: MOVEI RAM,UCODE POPJ P, $SEQAD: SETOM SEQADR POPJ P, ; MACRO CALL SCANNED ;COMMENTED LINES BUMMED OUT FOR SPEED BEGMAC: ;OUGHT TO SUPPRESS ON PASS1, CAN'T DUE TO ;STATE PROCESSING TROUBLES ; MOVE T1,[MACRO,,FIELD] ;LOOK FOR MACRO DEF ; BLT T1,FIELD+NWORDS-1 ; PUSHJ P,SRCFLD ; MSG ZFPOPJ, NO MACROS DEFINED SETZM FIELD SKIPE FPNT,MACPNT(RAM) ;AVOID FIELD SEARCH PUSHJ P,SRCSYM ;LOOK FOR DEFINITION MSG MACLUZ, MACRO NAME NOT DEFINED MOVSI N,(POINT 7,0) HRR N,SYMMAC(SPNT) ;GET POINTER TO MACRO PUSHJ P,SAVE MOVEI C,", ;MACRO MUST NOT INVOKE END-OF-LINE ACTIONS JRST ZFPOPJ MACLUZ: LDB T1,STAPNT ;GET CHAR TYPE CAIN T1,EOL ;END OF LINE? SETZM STATE ;YES, RETURN TO STATE ZERO JRST ZFPOPJ SUBTTL "SYMBOL:" DEFINE ADDRESS TAG TAG: MOVE T1,[ASCII /J/] MOVEM T1,FIELD SETZM FIELD+1 MOVE T1,[FIELD+1,,FIELD+2] BLT T1,FIELD+NWORDS-1 SKIPE FPNT,JPNT(RAM) ;DO WE KNOW WHERE J FIELD IS DEFINED? JRST TAG2 ;YES, DO NOT SEARCH PUSHJ P,SRCFLD MSG ZFPOPJ, CAN'T FIND J FIELD MOVEM FPNT,JPNT(RAM) ;REMEMBER FOR FUTURE TAG2: PUSHJ P,MAKSYM JFCL IFN FTBB,[ MOVE T1,JEQL ;ADDR OF LIST OF EQUAL TAGS MOVEM SPNT,JEQL HRRM T1,SYMEQL(SPNT) ;ADD THIS TO LIST TRNE F,PASS2 JRST ZFPOPJ ] HRRZ N,PC(RAM) PUSHJ P,DEFCHK HALT DEFVAL PUSHJ P,DEFSLS JRST ZFPOPJ ;SET LOCATION COUNTER FOR LEADING BIT PATTERN LOCBLK: SETZB N,BLDPAT' ;INIT COUNT, INIT PATTERN FOR 1'S SETZM BLDAST' ;INIT PATTERN FOR *'S LOCB1: PUSHJ P,GETCHR CAIN C,40 JRST LOCB1 CAIN C,"0 SOJA N,LOCB1 ;COUNT DIGITS MOVSI T1,(SETZ) ;GET BIT INTO POSITION FOR PATTERNS LSH T1,(N) CAIN C,"1 JRST [ IORM T1,BLDPAT SOJA N,LOCB1 ] CAIN C,"* JRST [ IORM T1,BLDAST SOJA N,LOCB1 ] MOVNS N ;GET POSITIVE POSITION COUNT CAIE C,12 TRO F,REREAD ;ONLY BACK UP IF NOT END-OF-LINE LOCB2: MOVEI T1,1 ;FIND HOW MANY CONSECUTIVE WORDS LSH T1,(N) ;WORDS=2**NUMBER OF BITS MOVE T2,BLDPAT ;GET BIT PATTERN ROT T2,(N) ;MOVE TO LOW ORDER MOVEM T2,BLDPAT MOVE T4,BLDAST ;GET * PATTERN ROT T4,(N) MOVEM T4,BLDAST JUMPN RAM,[MOVE N,PC(RAM) ;GET CURRENT PC ANDI N,-1(T1) ;MASK PC TO RELEVANT BITS SUB T2,N ;HOW FAR OFF? JUMPE T2,CPOPJ ;XFER IF RIGHT ON SKIPGE T2 ADD T2,T1 ;GET POS VAL, MOD BLOCK SIZE ADD N,T2 ;ADJUST PC JRST LOCB8 ; MSG LOCB8, DISP LOCATION CHECK FAILED ] JUMPE N,PCNXT1 ;IF 0, FIND FIRST FREE WORD SKIPGE N,PC(RAM) ;GET CURRENT PC CAMLE T1,FRECNT ;IS NEW BLOCK LARGER? JRST LOCB6 ;YES, OR PC NOT RESTRICTED MOVEI T3,-1(T1) ;GET 1S FOR BITS SPECIFIED ANDCM T3,BLDAST ;CLEAR * POSITIONS TDNE T3,LOCAST ;CHECK FOR 1S OR 0S WHERE *S GIVEN IN MASTER JRST LOCB5 ;YES, PATTERN IS ILLEGAL LOCB4: MOVE T3,N ANDCM T3,BLDAST ;CLEAR DON'T-CARE BITS ANDI T3,-1(T1) ;MASK PC TO NEW BLOCK SIZE CAMN T3,BLDPAT ;DOES PC MATCH NEW PATTERN? JRST LOCB8 ;YES, USE IT MOVE T3,N ;GET PC AGAIN AND T3,LOCAST ;SAVE STATE OF * BITS IOR N,LOCAST ;THEN FORCE THEM TO CARRY AOBJP N,.+1 ;PICK NEXT PC IN BLOCK IOR N,LOCPAT ;RESET BIT CARRIED OUT OF ANDCM N,LOCAST ;CLEAR OUT DON'T CARE BITS IOR N,T3 ;SET ANY WHICH WERE SET BEFORE JUMPL N,LOCB4 ;LOOP IF ANY MORE IN THIS BLOCK LOCB5: MOVEM T1,FRECNT ;SAVE NEW PARAMETERS MOVEM T2,LOCPAT MOVEM T4,LOCAST MSG LOCB7, NO SUCH MICRO WORD ADR PATTERN IN CURRENT BLOCK LOCB6: MOVEM T1,FRECNT ;STORE NEW BLOCK SIZE AWAY MOVEM T2,LOCPAT ; ALSO BIT PATTERN MOVEM T4,LOCAST ; AND * PATTERN LOCB7: PUSHJ P,FREWRD ;DOESN'T FIT MSG LOCB99, NO SUCH REQUIRED MICRO WORD ADDRESS PATTERN LOCB8: MOVEM N,PC(RAM) ;SET UP FIRST WORD ADDRESS LOCB99: POPJ P, ; NUMBER: SET LOCATION COUNTER LOCSET: SKIPGE N,NUMBER MSG LOCS99, LOCATION NEGATIVE CAMLE N,[MAXPC ? MAXDSP](RAM) MSG LOCS99, LOCATION TOO LARGE HRROM N,PC(RAM) ;STORE AWAY NEW PC VALUE JUMPN RAM,LOCS99 SETZM FRECNT ;END ANY LOCATION DEFAULTING SETZM LOCPAT SETZM LOCAST LOCS99: SETZM FIELD POPJ P, SUBTTL "FIELD/=" ;FIELD/= HAS BEEN SCANNED. SO, A MICRO FIELD DEFINITION IS IN PROGRESS. DEFSYM: PUSHJ P,SRCFLD ;FIND THE FIELD MSG SCNEND, UNDEFINED FIELD IN SYMBOL DEFINITION PUSHJ P,MAKSYM ;GO MAKE THE SYMBOL JFCL ;DO CONSISTENCY CHECK PUSHJ P,TOKEN CAIE N,.TKN ;SKIP IF TOKEN NUMERIC MSG DEFS99, VALUE REQUIRED IN SYMBOL DEFINITION MOVE N,NUMBER PUSHJ P,DEFCHK HALT DEFVAL PUSHJ P,DEFSLS CAIE C,", JRST SCNEND PUSHJ P,TOKN10 MOVE N,NUMBER PUSHJ P,DEFCHK HALT DEFTM1 ;FIRST TIME VALUE CAIE C,", JRST SCNEND PUSHJ P,TOKN10 MOVE N,NUMBER PUSHJ P,DEFCHK HALT DEFTM2 ;SECOND TIME VALUE DEFS99: JRST SCNEND SUBTTL DEFINE A FIELD DEFFLD: PUSHJ P,MAKFLD JRST SCNEND PUSHJ P,GETARG ;SCANNED FIELD/=, GET ARGS MSG CPOPJ, VALUE REQUIRED FOR FIELD DEFINITION MSG CPOPJ, SIZE REQUIRED FOR FIELD DEFINITION MSG CPOPJ, POSITION REQUIRED FOR FIELD DEFINITION JRST CPOPJ PUSHJ P,DEFSLF JRST SCNEND DEFSLF: DEFSLS: LDB T1,DEFPOS CAILE T1,MICMXB MSG .+1, POSITION TOO LARGE FOR MICRO WORD LDB T2,DEFSIZ ADDI T1,1 CAMGE T1,T2 MSG .+1, SIZE TOO LARGE FOR POSITION LDB T1,DEFVAL MOVEI N,1 LSH N,(T2) CAMG N,T1 MSG .+1, VALUE TOO LARGE FOR FIELD POPJ P, SUBTTL DEFINE A MACRO DEFMAC: MOVEI FPNT,PSUDM% ;FIRST CHECK FOR PSEUDO-MACRO PUSHJ P,SRCSY1 ;IS IT ONE OF THOSE NAMES? JRST DEFM0 ;NO, DEFINE A REAL MACRO HRRZ T1,SYMPSO(SPNT) ;YES, GET ADDR OF HANDLER JRST 0(T1) $TITLE: TRNE F,PASS2 JRST SCNEND ;TREAT AS COMMENT ON PASS 2 SKIPE TTLPNT ;DO WE ALREADY HAVE A TITLE MSG SCNEND, TITLE MULTIPLY DEFINED MOVEI N,1 PUSHJ P,GETWRD HRRZM N,TTLPNT ;SAVE ADDRESS INTO WHICH IT IS STORED JRST DEFM2 ;GO COLLECT IT $TOC: TRNE F,PASS2 ;ENTIRELY DIFFERENT FUNCTION ON PASS2 JRST TOC2 MOVEI N,2 ;LINK WORD + ONE FOR STRING PUSHJ P,GETWRD SKIPN T1,TOCPNT ;TOC INITIALIZED? MOVEI T1,TOCPNT ;NO, POINT TO IT HRLM N,0(T1) ;LINK THIS ONE TO LAST ON LIST HRRM N,TOCPNT ;AND NOTE THIS IS NOW LAST MOVE T1,LINNUM HRRZM T1,0(N) ;STUFF LINE # INTO ENTRY AOJA N,DEFM2 ;NOW COLLECT THE STRING TOC2: HLRZ N,TOCPNT ;TRY TO FIND THIS ON LIST TOC3: HRRZ T1,0(N) ;GET LINE # OF DEFINITION CAMLE T1,LINNUM ;IS IT OLD FOR THIS LINE? MSG STOP, !!TOC LST FOULED UP !! CAMN T1,LINNUM ;IS THIS WHERE WE DEFINED IT? JRST SCNEND ;YES, IT WILL PRINT AS SUBTTL HLRZ N,0(N) ;NO, LOOK AT NEXT HRLM N,TOCPNT JRST TOC3 ;DEFINE A MACRO DEFM0: SKIPE FPNT,MACPNT(RAM) ;IS THE "MACRO%" FIELD DEFINED? JRST DEFM1 ;YES, AVOID SEARCH MOVE T1,[MACRO,,FIELD] ;FORCE FIELD NAME BLT T1,FIELD+NWORDS-1 PUSHJ P,MAKFLD ;MAKE INITIAL FIELD FOR MACROS MSG STOP, !!CAN'T DEFINE "MACRO%"!! SETZM FIELD MOVEM FPNT,MACPNT(RAM) ;REMEMBER FOR FUTURE DEFM1: PUSHJ P,MAKSYM JRST SCNEND MOVEI N,1 PUSHJ P,GETWRD ;GET 1 WORD OF SPACE HRRM N,SYMMAC(SPNT) ; AND SAVE AS 1ST WORD OF MACRO DEFM2: PUSHJ P,COPMAC ;COPY TEXT INTO SYMBOL TABLE JRST SCNEND ;SUBR TO COPY QUOTED TEXT INTO SYMBOL TABLE COPMAC: HRLI N,(POINT 7,) ;MAKE ADDR OF SPACE INTO BYTE POINTER PUSH P,N ;CREATE TEMP FOR IT CMAC1: PUSHJ P,GETCHR CAIN C,12 ;EOL? MSG CMAC99, MISSING TERMINAL QUOTE CAIN C,42 ;TERMINAL QUOTE? MOVEI C,0 ;YES, TERMINATE WITH IT MOVE T1,0(P) ;PICK UP POINTER TLNN T1,760000 ;AT END OF WORD? JRST CMAC2 ;NO MOVEI N,1 ;YES, GET ANOTHER PUSHJ P,GETWRD CMAC2: IDPB C,0(P) ;STORE THIS CHAR JUMPN C,CMAC1 ; COLLECT ASCIZ STRING CMAC99: POP P,N ;RESTORE STACK POPJ P, SUBTTL GETARG ;SEARCH ARGUMENT LIST AND RE-CALL CALLING ROUTINE ;FOR MISSING ARGS ;CALLING SEQUENCE: ; PUSHJ P,GETARG ; ;GETARG PUSHJ'S TO HERE IF 1ST ARG IS MISSING ; ;TO HERE IF 2ND ARG IS MISSING ; ;3RD ARG ; ;4TH ARG ; FINAL RETURN GETARG: PUSHJ P,TOKEN ;GET 1ST ARG CAIE N,.TKN PUSHJ P,@(P) ;1ST ARG MISSING, CALL CALL SITE+1 MOVE N,NUMBER PUSHJ P,DEFCHK ;CHECK THAT VALUE FITS FIELD HALT DEFVAL AOS (P) ;1ST ARG SCAN COMPLETED CAIN C,", ;POSSIBLE 2ND ARG? PUSHJ P,TOKN10 ;YES, GO SCAN CAIE N,.TKN PUSHJ P,@(P) ;NO POSSIBLE ARG, OR WASN'T THERE MOVE N,NUMBER PUSHJ P,DEFCHK HALT DEFSIZ AOS (P) ;2ND ARG SCAN COMPLETED CAIN C,", PUSHJ P,TOKN10 CAIE N,.TKN PUSHJ P,@(P) MOVE N,NUMBER PUSHJ P,DEFCHK HALT DEFPOS CAML N,MAXPOS(RAM) MOVEM N,MAXPOS(RAM) ;KEEP TRACK OF MICRO WORD SIZE AOS (P) ;3RD ARG SCAN COMPLETED CAIE C,", JRST GETA4 GETA2: PUSHJ P,GETCHR ;4TH ARG IS SINGLE CHAR CAIN C,40 JRST GETA2 ; BUT FLUSH SPACES MOVSI N,DEFTAB-DEFTND GETA3: HLRZ T1,DEFTAB(N) ;SEARCH TABLE FOR CHARACTER CAMN T1,C JRST GETA5 AOBJN N,GETA3 MSG .+1, UNDEFINED SPECIAL FUNCTION CHARACTER GETA4: PUSHJ P,@(P) JRST GETA6 GETA5: HRRZS N PUSHJ P,DEFCHK HALT DEFFNC GETA6: JRST CPOPJ1 SUBTTL VALUE INSERTION ;CHECK TO SEE THAT VALUE FITS IN THE BYTE FIELD ALLOWED ;AND THEN STUFF IT THERE DEFCHK: LDB T1,DEFFLG ;FIRST CHECK FOR MULTIPLE DEFINITION TRNE T1,MULF ;IF SET, WE'VE ALREADY OBJECTED JRST CPOPJ1 ;CAN'T EXPECT THAT TO BE CONSISTENT HRRZ T1,@(P) TRNN F,PASS2 JRST DEFC2 LDB N1,(T1) ;GET PASS1 DEFINITION CAME N,N1 MSG STOP, PASS1 AND PASS2 DEFINITIONS DIFFER JRST CPOPJ1 DEFC2: DPB N,(T1) LDB N1,(T1) CAME N,N1 MSG .+1, NUMBER TOO BIG FOR FIELD JRST CPOPJ1 TIMSET: MOVE N,TIME1 ;DEFAULT TIME INSERTION CAMGE N,TIME2 ;GET MAX MOVE N,TIME2 LDB T2,DEFVAL ;GET DEFAULT MINIMUM TIME CAMGE N,T2 MOVE N,T2 ;DEFAULT TIME .GT. MAX(T1,T2) JRST BITS1 PCINC: HRRZ N,PC(RAM) ;DEFAULT PC INSERTION SKIPN N,PCTABL(N) ;GET DEFAULT PC MSG CPOPJ, NO DEFAULT PC AVAILABLE TLZA N,-1 ;MASK TO 18 BITS BITSET: LDB N,DEFVAL ;VALUE INSERTION INTO MICRO FIELD BITS1: PUSH P,N ;SAVE VALUE PUSHJ P,FLDTST ;FIELD ALREADY LOADED? JRST BITS3 ;NO MOVE T1,0(P) ;YES...CHECK FOR CONFLICTING OVERLAP MOVEI T2,0 LSHC T1,(N1) SKIPE N XOR T1,VALUE-1(N) XOR T2,VALUE(N) ;GET DIFFERENCE FROM PREVIOUS VALUES SKIPE N AND T1,VALSET-1(N) AND T2,VALSET(N) ;LIMIT DIFF TO FIELDS ALREADY SET TDNN T1,T3 TDNE T2,T4 ;ANY SUCH DIFFERENCES IN THIS FIELD? MSG NPOPJ, MICRO FIELD SET WITH CONFLICTING VALUES ;NO, SET THIS VALUE INTO MICROWORD BITS3: POP P,T1 MOVEI T2,0 LSHC T1,(N1) ;PUSH VALUE INTO PLACE SETCA T3, ;MAKE UNUSED FIELDS BE 1S SETCA T4, TDNN T1,T3 ;IF VALUE EXTENDS OUTSIDE FIELD, TDNE T2,T4 ; THEN THERE IS AN ERROR MSG CPOPJ, VALUE TOO LARGE FOR FIELD SKIPE N IORM T1,VALUE-1(N) IORM T2,VALUE(N) SKIPE N ORCAM T3,VALSET-1(N) ;MARK MICRO WORD FIELD AS USED ORCAM T4,VALSET(N) POPJ P, ;SKIP IF SOME FIELDS MATCH THIS ONE ;NO SKIP IF FIELD VIRGIN ;ON RETURN, LEAVE MASK FOR THIS FIELD IN T3,T4 ;LEAVE SHIFT POSITION AND TABLE INDEX IN N1,N FLDTST: MOVEI T3,0 MOVNI T4,1 LDB T1,DEFSIZ LSHC T3,(T1) MOVEI T4,0 LDB N,DEFPOS ADDI N,1 IDIVI N,36. MOVNS N1 LSHC T3,(N1) SKIPE N TDNN T3,VALSET-1(N) TDNE T4,VALSET(N) AOS (P) POPJ P, ;CODE TO SEARCH FIELD DEFINITION LIST AND INSERT DEFAULTS DEFALT: MOVEI FPNT,FLDPNT ;START OF LIST DFLT2: HRRZ FPNT,SYMLNK(FPNT) JUMPE FPNT,CPOPJ ;STOP AT END OF LIST MOVE SPNT,FPNT LDB T1,DEFTYP ;GET "UCODE" OR "DISP" TYPE CAME T1,RAM ;MATCH CURRENT MODE? JRST DFLT4 ;NO PUSHJ P,FLDTST ;IS FIELD VIRGIN? SKIPA ;YES JRST DFLT4 ;NO LDB T1,DEFFNC JUMPE T1,DFLT4 ;0 FUNCTION MEANS NO DEFAULT MOVE T1,DEFTAB(T1) PUSHJ P,(T1) ;DISPATCH ON FUNCTION DFLT4: JRST DFLT2 PARITY: POP P,T1 ;GET RETURN ADR PUSH P,FPNT ; SAVE FPNT TO PARITY FIELD PUSHJ P,(T1) ; AND MAKE "CALLER" BE "CALLEE" POP P,FPNT ;SET UP PARITY FIELD POINTERS MOVE SPNT,FPNT MOVEI T1,0 ;INIT PARITY MOVSI T2,-MICMXW ;COUNT THRU ALL OF MICRO WORD XOR T1,VALUE(T2) ;COMPUTE TABLE PARITY AOBJN T2,.-1 TSC T1,T1 ;REDUCE TO 18 BITS MOVEI N,0 PARLUP: JUMPN T1,[ANDI T1,-1(T1) ;REMOVE 1 BIT AOJA N,PARLUP ] TRNE N,1 ;IF PARITY ALREADY ODD, POPJ P, ; THEN OK AS IS MOVEI N,1 ;GET A PARITY BIT LDB T2,DEFSIZ ;GET PARITY FIELD SIZE JUMPN T2,BITS1 ;PUT PARITY BIT INTO FIELD MOVSI T1,-MICMXW ;MINUS TABLE LENGTH OF MICRO WORD PAR3: SETCM T2,VALSET(T1) ;GET BIT USAGE JFFO T2,[MOVSI N,(SETZ) ;BIT TO SHIFT MOVNS T3 ;GET RIGHT SHIFT COUNT LSH N,(T3) ; AND SHIFT PARITY BIT TO FREE PLACE IORM N,VALUE(T1) IORM N,VALSET(T1) JRST PAR5 ] AOBJN T1,PAR3 ;CONTINUE LOOKING FOR PLACE FOR BIT PAR5: HLRES T1 ;GET # WORDS REMAINING ADDI T1,MICMXW ;GET WHICH WORD HAD FREE BIT IMULI T1,36. SUB T1,T3 ;CONVERT TO BIT NUMBER CAMLE T1,MAXPOS(RAM) ;WAS THERE ROOM FOR PARITY BIT? MSG .+1, NO ROOM FOR PARITY BIT POPJ P, SUBTTL SYMBOL TABLE ROUTINES ;SUBROUTINE TO FIND A FIELD OR MAKE ONE IF IT DOESN'T EXIST. ; NO SKIP IF IT ALREADY EXISTS. SKIP IF NEWLY MADE. ; RETURNS POINTER TO FIELD BLOCK IN SPNT AND FPNT. MAKFLD: PUSHJ P,SRCFLD JRST MAKF1 ;NOT FOUND TRNN F,PASS2 ;ONLY ONCE PER PASS, PLEASE JRST MULFLD PUSHJ P,BEGCRF ;PUT DEFINITION IN THE CREF LDB T1,DEFFLG ;CHECK FOR MULTIPLY DEFINED TRNE T1,MULF MSG CPOPJ, MULTIPLY DEFINED FIELD POPJ P, ;AND RETURN FOUND MAKF1: SKIPN FIELD MSG CPOPJ, CAN'T DEFINE A NULL FIELD TRNE F,PASS2 ;BETTER BE PASS 1 MSG STOP, !!FIELD UNDEFINED ON PASS 2!! PUSH P,N PUSHJ P,GETROM MOVE FPNT,N ;SAVE POINTER TO NEW FIELD MOVE SPNT,N POP P,N1 ;GET POINTER TO PREVIOUS FIELD HRRZ N,SYMLNK(N1) ;GET POINTER FROM PREVIOUS FIELD HRRZM N,SYMLNK(FPNT) ;AND CONTINUE FROM NEW FIELD HRRM FPNT,SYMLNK(N1) ;LINK LIST STRUCTURE MOVSI T1,FIELD HRRI T1,SYMTXT(FPNT) BLT T1,SYMTXT+NWORDS-1(FPNT) ;COPY NAME TEXT INTO DEFINITION SETZM SYMVAL(FPNT) ;ZERO DEFINITION WORD DPB RAM,DEFTYP SETZM SYMCRF(SPNT) ;INIT CREF LIST STRUCTURE JRST CPOPJ1 MULSYM: MULFLD: LDB T1,DEFFLG ;PICK UP FLAGS IORI T1,MULF ;NOTE MULTIPLE DEFINITION DPB T1,DEFFLG MSG CPOPJ, MULTIPLE DEFINITION ;SUBROUTINE TO MAKE A SYMBOL DEFINITION (IF ONE DOESN' EXIST) ;SIMILAR TO MAKFLD ABOVE ; CALLED WITH POINTER TO FIELD IN FPNT ; SKIPS IF NEWLY MADE. RETURNS POINTER IN SPNT. ; NO SKIP IF ALREADY DEFINED. ; POINTER IN SPNT TO PRESENT DEFINITION. MAKSYM: PUSHJ P,SRCSY1 ;LOOK FOR SYMBOL, BUT DON'T CREF YET JRST MAKS1 ;NOT FOUND TRNN F,PASS2 ;DISALLOW MULTIPLE DEFINITION JRST MULSYM PUSHJ P,BEGCRF ;NOTE DEFINITION IN CREF LDB T1,DEFFLG ;LOOK AT FLAGS TRNE T1,MULF ;IS THIS MULTIPLY DEFINED? MSG CPOPJ, MULTIPLY DEFINED SYMBOL POPJ P, MAKS1: SKIPN NAME ;NO DEFINED YET MSG CPOPJ, CAN'T DEFINE NULL SYMBOL TRNE F,PASS2 MSG STOP, !!SYMBOL UNDEFINED ON PASS2!! PUSH P,N PUSHJ P,GETROM HRRZM N,SPNT POP P,N1 HLRZ N,SYMLNK(N1) HRLZM N,SYMLNK(SPNT) ;LINK TO NEXT SYMBOL HRLM SPNT,SYMLNK(N1) MOVSI T1,NAME HRRI T1,SYMTXT(SPNT) BLT T1,SYMTXT+NWORDS-1(SPNT) SETZM SYMVAL(SPNT) DPB RAM,DEFTYP SETZM SYMCRF(SPNT) ;INIT CREF LIST STRUCTURE JRST CPOPJ1 SRCFLD: MOVEI N,FLDPNT SRCF2: MOVEI N1,(N) ;SAVE POINTER TO LAST LOWER FIELD HRRZ N,SYMLNK(N) JUMPE N,SRCX ;QUIT IF END OF LIST REPEAT NWORDS,[ MOVE T1,FIELD+.RPCNT CAMLE T1,.RPCNT+SYMTXT(N) JRST SRCF2 CAME T1,.RPCNT+SYMTXT(N) JRST SRCX ;NO MATCH, RETURN PTR TO SMALLER FLD ] HRRZ FPNT,N HRRZ SPNT,N LDB T1,DEFTYP CAIE T1,(RAM) ;DOES FIELD TYPE MATCH CURRENT MODE? JRST SRCF2 ;NO, LOOK SOME MORE JRST CPOPJ1 ;YES, SKIP RETURN SRCX: MOVEI N,(N1) ;GET POINTER TO SMALLER FIELD POPJ P, ;RETURN NO MATCH SRCSYM: PUSHJ P,SRCSY1 ;LOOK FOR SYMBOL POPJ P, ;WASN'T THERE PUSHJ P,MAKCRF ;WAS, CREF THE REFERENCE JRST CPOPJ1 SRCSY1: MOVEI N,(FPNT) SRCS2: MOVEI N1,(N) HLRZ N,SYMLNK(N) JUMPE N,SRCX ;END OF LIST, RETURN NO MATCH REPEAT NWORDS,[ MOVE T1,NAME+.RPCNT CAMLE T1,.RPCNT+SYMTXT(N) JRST SRCS2 ;TRY NEXT ENTRY, THIS IS TOO SMALL CAME T1,.RPCNT+SYMTXT(N) JRST SRCX ;NO CAN FIND ] MOVEI SPNT,(N) ;THIS IS THE SYMBOL JRST CPOPJ1 MAKCRF: TRNN F,PASS2 POPJ P, ;BUILD CREF ON PASS2 TDZA N1,N1 ;CLEAR DEFINE FLAG BEGCRF: MOVEI N1,400000 ;FLAG AS DEFINITION MOVEI N,1 ;GET 1 WORD FOR CREF REFERENCE PUSHJ P,GETWRD HLRZ T1,SYMCRF(SPNT) ;GET LAST ADR IN LIST HRLM N,SYMCRF(SPNT) ;MAKE NEW WORD LAST ADR SKIPN T1 ;IF OLD LAST ADR IS ZERO, THEN MOVEI T1,SYMCRF(SPNT) ; LAST ADR IS IN SYMBOL BLOCK HRRM N,(T1) ;PUT THIS WORD ONTO END OF LIST IFN FTCOIN, HRRZ T1,CRFLIN ;GET LINE # AT WHICH THIS WORD STARTED IFE FTCOIN, HRRZ T1,LINNUM ;GET CURRENT LINE NUMBER IOR T1,N1 ;PUT DEFINE FLAG, IF ANY, IN HRLZM T1,(N) ; STUFF INTO WORD NOW ON LIST END ; AND MAKE POINTER TO NEXT BE 0 POPJ P, GETROM: MOVEI N,SYMLEN ;GET ROOM FOR NEW SYM TABLE ENTRY GETWRD: PUSH P,.JBFF ADDB N,.JBFF CAMGE N,.JBREL JRST GETW2 LSH N,-10. .CALL [ SETZ ;GET FRESH PAGE 'CORBLK MOVEI %CBRED+%CBWRT+%CBNDW+%CBNDR MOVEI -1 MOVEI (N) SETZI 400001 ] .VALUE MOVEI N,2000 ADDM N,.JBREL GETW2: NPOPJ: POP P,N POPJ P, SUBTTL LEXICAL ANALYZER ;SUBROUTINE TO BUILD A SYMBOLIC OR NUMERIC TOKEN ; ENTRY TOKEN - BUILD SYMBOL, OCTAL NUMBER, OR DECIMAL NUMBER ; ENTRY TOKN10 - BUILD SYMBOL, OR DECIMAL NUMBER ;OCTAL NUMBERS ARE OF FORM <+,-, > ; AN 8 OR 9 OR A DECIMAL POINT MAKES NUMBER DECIMAL ;DECIMAL NUMBERS ARE OF FORM <+,-, > ; AN 8 OR 9 OR A FINAL DECIMAL POINT IS REQUIRED ;A SYMBOL IS ANYTHING THAT IS NOT A LEGAL NUMBER ; RETURN .TKB - BLANK TOKEN ; RETURN .TKN - SIGNED NUMERIC TOKEN WITH VALUE IN "NUMBER" ; RETURN .TKS - SYMBOL TOKEN WITH ASCIZ TEXT IN "NAME" TABLE .TKB==0 ;BLANK (OR NULL) TOKEN .TKN==1 ;NUMERIC TOKEN .TKS==2 ;SYMBOLIC TOKEN TOKEN: TDZA T1,T1 ;ENTRY FOR SYM,OCT#,DEC# START WITH STATE 0 TOKN10: MOVEI T1,5_3 ;ENTRY FOR SYM,DEC# START WITH STATE 5 MOVEM T1,TOKSTA' ;INIT STATE TABLE SETZM TKZER MOVE T1,[TKZER,,TKZER+1] BLT T1,TKZEND-1 ;INITIALIZE TOKEN VALUES MOVE T1,[POINT 7,NAME] MOVEM T1,TOKPNT' ;INIT SYMBOL BUILD POINTER TOK2: PUSHJ P,GETCHR ;GET NEXT CHARACTER MOVE T1,TOKSTA ;GET OLD STATE ANDI T1,170 ;AND EXTRACT STATE BITS LDB T2,TOKTYP ;GET CHARACTER TYPE IOR T1,T2 ; AND COMBINE WITH OLD STATE IDIVI T1,4 ;GET NEXT STATE, 4 ENTRIES/WORD LDB T1,TOKNXT(T1+1) MOVEM T1,TOKSTA ;SAVE NEW STATE ANDI T1,7 ; AND EXTRACT DISPATCH ADDRESS XCT TOKXCT(T1) ;PROCESS CURRENT CARACTER JRST [ MOVE T1,TOKPNT ;GET SYMBOL BUILD POINTER CAME T1,[POINT 7,NAME+NWORDS-1,34-7] IDPB C,TOKPNT ;ROOM FOR CHAR, STORE AWAY JRST TOK2 ] JRST TOK2 ;GO GET NEXT CHARACTER ; EXECUTE TABLE TOKXCT: SKIPA ; 0 IGNORE CHARACTER JFCL ; 1 INCLUDE IN SYMBOL ONLY SETOM TOKMIN ; 2 SET MINUS FLAG PUSHJ P,TOKDIG ; 3 PROCESS 0-9 JRST TOK5 ; 4 RETURN .TKB - NO TOKEN JRST TOK6 ; 5 RETURN .TKS - SYMBOL JRST TOK7 ; 6 RETURN .TKN - DECIMAL NUMBER JRST TOK8 ; 7 RETURN .TKN - OCTAL NUMBER ;MARGINAL INDEX TABLE INTO TOKTAB TOKNXT: PINDEX 9,TOKTAB(T1) DEFINE BYTE A,B,C,D,E,F,G,H .BYTE 9 A ? B ? C ? D ? E ? F ? G ? H .BYTE TERMIN ;STATE TABLE. THE ROWS ARE INDEXED BY STATE; COLUMNS BY CHAR TYPE. ; EACH ENTRY CONSISTS OF 2 DIGITS- 2ND IS INDEX INTO TOKXCT, 1ST ; IS THE NEW STATE NUMBER. TOKTAB: ;TERM, " ", ".", "+", "-", 0-7, 8-9,OTHER LEGAL SYM CHAR BYTE 04, 00, 11, 21, 22, 23, 33, 11 ;STATE #0 BYTE 05, 61, 11, 11, 11, 11, 11, 11 ;STATE #1 BYTE 07, 71, 41, 11, 11, 23, 33, 11 ;STATE #2 BYTE 06, 101, 41, 11, 11, 33, 33, 11 ;STATE #3 BYTE 06, 111, 11, 11, 11, 11, 11, 11 ;STATE #4 BYTE 54, 50, 11, 31, 32, 33, 33, 11 ;STATE #5 BYTE 05, 60, 11, 11, 11, 11, 11, 11 ;STATE #6 BYTE 07, 70, 41, 11, 11, 23, 33, 11 ;STATE #7 BYTE 06, 100, 41, 11, 11, 33, 33, 11 ;STATE #10 BYTE 06, 110, 11, 11, 11, 11, 11, 11 ;STATE #11 ;STATE #0 - FLUSHES SPACES, ALLOWS + OR - FOR NUMBERS ;STATES #1,6 - BUILDS SYMBOLS, A CHARACTER WAS ILLEGAL FOR A NUMBER ;STATES #2,7 - BUILDS OCTAL NUMBER UNTIL 8,9, OR (.) SEEN ;STATES #3,10 - BUILDS DECIMAL NUMBER ;STATES #4,11 - A (.) SEEN AFTER A NUMBER, GO TO #1 FOR ANYTHING OTHER ; THAN SPACE OR TERM. ;STATE #5 - SAME AS #0 EXCEPT ANY NUMBER IS FORCED DECIMAL ; STATES #6-11 FLUSH MULTIPLE SPACES EXPUNGE BYTE TOKDIG: MOVEI T1,-"0(C) ;EXTRACT DIGIT FORM ASCII CHAR MOVEI T2,8. IMULM T2,TOKOCT ;BUILD OCTAL NUMBER ADDM T1,TOKOCT ; AND ADD IN NEXT DIGIT MOVEI T2,10. IMULM T2,TOKDEC ;BUILD DECIMAL NUMBER ADDM T1,TOKDEC ; AND ADD IN NEXT DIGIT POPJ P, TOK5: MOVEI N,.TKB JRST TOK99 TOK6: MOVEI T1,0 ;TRAILING SPACE FLUSHER FOR SYMBOLS LDB T2,TOKPNT ;GET LAST CHAR IN SYMBOL CAIN T2,40 DPB T1,TOKPNT ;REPLACE A TRAILING SPACE WITH NULL MOVEI N,.TKS JRST TOK99 TOK7: SKIPA N,TOKDEC ;PICK UP DECIMAL NUMBER TOK8: MOVE N,TOKOCT ;PICK UP OCTAL NUMBER SKIPGE TOKMIN MOVNS N ;NEGATE IF MINUS FLAG SET MOVEM N,NUMBER MOVEI N,.TKN TOK99: POPJ P, SUBTTL GETCHR - GET A CHARACTER ;LOWEST LEVEL ROUTINE TO GET A CHARACTER ; IF REREAD FLAG SET, RETURNS LAST CHARACTER READ GETCHR: TRZE F,REREAD JRST [ MOVE C,LASTC POPJ P, ] GETC1: SKIPE CHRPNT ;RESCANNING ANYTHING? JRST [ ILDB C,CHRPNT ;YES, GET CHARACTER JUMPN C,GETC9 POP PM,CHRPNT ;BUT NOTHING LEFT POP PM,C ;GET LAST CHAR FROM STACK JRST GETC9 ] SOSGE INCNT JRST GETC7 ILDB C,INPNT ;GET CHAR FROM INPUT FILE GETC8: LDB C1,GETPNT ;TRANSLATE INPUT CHARACTER JUMPE C1,GETC1 PNTLST: MOVEM C,EOLCHR ;SAVE LAST CHAR TO FIND WHAT ENDED LINE CAIE C1,12 ;DON'T SAVE 12,13, OR 14 SOSG PNTCNT ;ROOM IN LISTING FILE (LEAVE 1 CHAR ROOM) JRST .+2 ;NO IDPB C,PNTPNT ;YES, SAVE INPUT CHAR IN OUTPUT LISTING MOVE C,C1 ;SEND TRANSLATED CHAR TO CALLER GETC9: MOVEM C,LASTC' ;SAVE CHAR FOR POSSIBLE RE-READS POPJ P, GETC7: MOVE C,[440700,,INBUF] ;REFILL BUFFER MOVEM C,INPNT MOVE C,[-BUFL,,INBUF] .IOT INCHN,C MOVEI C,-INBUF(C) IMULI C,5 ;NUMBER OF CHARS READ MOVEM C,INCNT JUMPN C,GETC1 PUSHJ P,NXTFIL SKIPA C,[12] ;END-OF-FILE RETURNS LINE-FEED MOVEI C,14 ;START NEW FILE WITH FORM FEED JRST GETC8 SAVE: PUSH PM,C ;ROUTINE TO START RESCAN PUSH PM,CHRPNT MOVEM N,CHRPNT POPJ P, SUBTTL LISTING GENERATION PNTLIN: PUSH P,C TRNN F,PASS2\ERROR JRST PNTL2 ;NO LIST ON PASS1, RE-INIT LISTING MOVE N,MAXPOS+UCODE ;GET # BITS IN RAM CAMGE N,MAXPOS+DISP MOVE N,MAXPOS+DISP ;FIND LONGEST RAM LENGTH ADDI N,11. ;RAM #S START AT 0, FORCE ROUNDUP IDIVI N,12. ;GET HOW MANY DIGIT GROUPS IMULI N,5 ;5 CHARACTERS PER GROUP ADDI N,7 ;PLUS 7 EXTRA CHARACTERS PUSHJ P,TABTON ;TAB OUT TO THERE PUSHJ P,PRINT ;PRINT SOURCE LINE ASCIZ /; / HRRZ C,LINNUM PUSHJ P,PNTDEC PUSHJ P,TAB MOVEI C,0 IDPB C,PNTPNT MOVEI N,PNTBUF PUSHJ P,PRINT0 MOVEI C,15 PUSHJ P,PUT MOVE C,EOLCHR CAIE C,14 MOVEI C,12 ;END LINE WITH 15,14, OR 15,12 PUSHJ P,PUT PNTL2: AOS LINNUM ;INDEX LINE NUMBER POP P,C PNTINI: MOVE T1,[POINT 7,PNTBUF] ;INIT OUTPUT LIST LINE BUFFER MOVEM T1,PNTPNT ;INIT OUTPUT BUFFER BYTE POINTER MOVEI T1,PNTMAX MOVEM T1,PNTCNT ;INIT OUTPUT BUFFER CHAR COUNT POPJ P, PNTBIN: TRNN F,BINF POPJ P, PUSH P,C IFN FTBB,[ JUMPN RAM,NOMOVE ;NEVER MOVE DISP DATA SKIPGE PC+UCODE ; OR CONSTRAINED ADDRESS DATA JRST NOMOVE MOVSI T1,-MICMXW ;COUNT THRU ALL PIECES OF MICROWORD MOVE T2,MOVMSK(T1) ;BITS WHICH DON'T EXIST ABOVE 2000 TDNN T2,VALUE(T1) ;ANY SET IN THIS MICROWORD? AOBJN T1,.-2 ;LOOK AT ALL PIECES JUMPL T1,NOMOVE ;DON'T MOVE IF ANY NXB SET MOVE T1,[-<1000/36.>,,<2000/36.>] SETCM T2,USAGE(T1) ;LOOK FOR UNSET BITS UP THERE TLZA T2,(BORDER) ;START AT THE BORDER OF 2000 SETCM T2,USAGE(T1) ;TRY NEXT WORD JFFO T2,MOVUP ;IF FOUND ONE, USE IT AOBJN T1,.-2 ;NO, LOOK AT NEXT JRST NOMOVE ;NO FREE BITS, DO NOT MOVE MOVUP: HRRZS T1 ;COMPUTE ADDRESS FOR THIS BIT IMULI T1,36. ADDI T1,(T3) MOVEM T1,PC+UCODE ;STORE NEW PC FOR THIS WORD MOVEI SPNT,JEQL-SYMEQL ADJTAG: HRRZ SPNT,SYMEQL(SPNT) JUMPE SPNT,NODFLT ;NO MORE DPB T1,DEFVAL ;REPLACE VALUE JRST ADJTAG ;ADJUST NEXT TAG NODFLT: MOVSI T1,-MICMXW MOVE T2,MOVMSK(T1) IORM T2,VALSET(T1) ;PREVENT DEFAULT SETTING THESE BITS AOBJN T1,.-2 NOMOVE: ];END FTBB MOVE T1,PRNTPC(RAM) ;GET LAST LOCATION ASSEMBLED MOVE N,PC(RAM) ;GET THIS LOCATION MOVEM N,PRNTPC(RAM) ;SAVE PRESENT PC FOR NEXT WORD DEFAULT HRRZS N ;COMPARE RH ONLY CAMLE N,HIGHPC(RAM) ;IS THIS THE HIGHEST PC USED SO FAR? MOVEM N,HIGHPC(RAM) ;YES, SAVE FOR LOC'N LISTING JUMPN RAM,PNTB0 ;PCTABL RELEVANT ONLY FOR UCODE TRNN F,PASS2 JRST CHNPC ;ON PASS1, CHAIN PC'S TOGETHER HRRZ T2,PCTABL(T1) ;GET ADDR ASSUMED BY LAST UWORD FOR THIS ONE CAIE T2,(N) ;IS IT SAME AS THIS PASS? MSG STOP, !! PHASE ERROR !! HLRZ T2,PCTABL(N) ;GET LINE OF THIS PC LAST PASS CAME T2,LINNUM MSG .+1, LINE NUMBER FOUL UP JRST PNTB0 CHNPC: HRRM N,PCTABL(T1) ;SAVE THIS PC FOR PASS2 DEFAULTS MOVE T1,LINNUM ;GET THIS LINE NUMBER HRLM T1,PCTABL(N) ;ASSOCIATE IT WITH THIS PC PNTB0: TRNE F,PASS2 PUSHJ P,DEFALT ;PUT IN PASS2 DEFAULTS PUSHJ P,USEDPC ;LOOK TO SEE IF THIS PC USED MSG .+1, MICRO WORD USED TWICE PNTB1: PUSHJ P,PCNEXT ;GET NEXT PC SET UP SETZM JEQL TRNN F,PASS2 JRST PNTB99 AOS WRDCNT(RAM) ;COUNT MICRO WORDS USED IFN FTLOOS,[ SKIPL PRNTPC(RAM) AOSA LOOSPC(RAM) ;COUNT PC WORDS THAT CAN GO ANYWHERE ];END IFN FTLOOS SKIPA N,RAM MOVEI N,2(RAM) ADDI N,[ASCII /U / ASCII /D / ASCII /V / ASCII /D / ] PUSHJ P,PRINT0 HRRZ C,PRNTPC(RAM) PUSHJ P,PNTOC4 MOVE T1,[POINT 12,VALUE] MOVEM T1,MICPNT' SETZM MICCNT' PUSHJ P,PRINT ASCIZ /, / JRST PNTB3 PNTB2: MOVEI C,", PUSHJ P,PUT PNTB3: ILDB C,MICPNT PUSHJ P,PNTOC4 MOVEI T1,12. ADDB T1,MICCNT CAMG T1,MAXPOS(RAM) JRST PNTB2 PNTB99: POP P,C POPJ P, FINLST: TRO F,ERROR\NOHDR ;FORCE NEXT MSG TO TTY, SUPPRESS HEADERS PUSHJ P,PRINT ASCIZ / ; Number of Micro Words used: ; D Words= / MOVE C,WRDCNT+DISP PUSHJ P,PNTDEC PUSHJ P,PRINT ASCIZ / ; U Words= / MOVE C,WRDCNT+UCODE PUSHJ P,PNTDEC IFN FTLOOS,[ PUSHJ P,PRINT ASCIZ / ; "Loose" U Words= / MOVE C,LOOSPC+UCODE ;GET # OF U WORDS THAT CAN GO ANYWHERE PUSHJ P,PNTDEC ];END IFN FTLOOS PUSHJ P,CRLF TRZ F,ERROR ;"END" DOESN'T GO TO TTY CONSOLE PUSHJ P,PRINT ASCIZ / END / TRZ F,NOHDR ;DROPS THROUGH ;DROPS IN ;START CREF LISTING MOVEI C,[ASCIZ /CROSS REFERENCE LISTING/] PUSHJ P,SETHDR MOVEI FPNT,FLDPNT ;GET START OF SYM TABLE CRFLUP: HRRZ FPNT,(FPNT) ;GET NEXT FIELD JUMPE FPNT,CRFEND ;STOP AT END MOVE SPNT,FPNT LDB RAM,DEFTYP ;GET "UCODE" OR "DISP" NUMBER MOVEI N,[ASCII /(U) / ASCII /(D) / ] (RAM) PUSHJ P,PRINT0 MOVEI N,SYMTXT(FPNT) ;GET TEXT ADDRESS PUSHJ P,PRINT0 ; AND PRINT FIELD NAME PUSHJ P,CRFLST ;LIST CREF FOR FIELD CRSLUP: HLRZ SPNT,SYMLNK(SPNT) ;GET NEXT JUMPE SPNT,CRFLUP ;GET NEXT FIELD IF NULL MOVE T1,SYMTXT(SPNT) PUSHJ P,TAB MOVEI N,SYMTXT(SPNT) ;GET ADR OF SYMBOL PUSHJ P,PRINT0 PUSHJ P,CRFLST JRST CRSLUP ;HERE TO PRINT CREF FOR ONE SYMBOL CRFLST: HRRZ N,SYMCRF(SPNT) ;GET POINTER TO 1ST ITEM CRILUP: HRRZS N JUMPE N,NEWLIN ;EXITS WITH POPJ PUSH P,(N) ;SAVE LIST ITEM MOVE T1,HORPOS ;GET HORIZONTAL POSITION CAILE T1,120.+1 ;ROOM FOR ANOTHER ITEM? PUSHJ P,NEWLIN ;NO CRILP2: PUSHJ P,TAB ;TAB BEFORE EACH ITEM MOVE T1,HORPOS CAIGE T1,NCHARS+8 ;SPACED OVER SYMBOLS? JRST CRILP2 ;NO, ANOTHER TAB NEEDED HLRZ C,(P) ;GET LINE NUMBER TRZ C,400000 ;CLEAR DEFINITION FLAG PUSHJ P,PNTDEC SKIPL 0(P) ;IS DEFINITION FLAG SET? JRST CRILP3 ;NO PUSHJ P,PRINT ;YES, FLAG IT ASCIZ / #/ CRILP3: POP P,N JRST CRILUP ;START LOCATION/LINE LISTING CRFEND: IFN FTMAP,[ MOVEI C,[ASCIZ \LOCATION / LINE NUMBER INDEX ; DCODE LOC'N 0 1 2 3 4 5 6 7\] PUSHJ P,SETHDR HRLO FPNT,HIGHPC+1 ;GET HIGHEST LOC'N IN DRAM USED SETCA FPNT, ;USE AS LIMIT ON AOBJN POINTER JRST DLOCST DLCLUP: TRNE FPNT,7 ;TIME FOR A NEW LINE? JRST DLOCL1 ;NO PUSHJ P,NEWLIN ;YES TRNN FPNT,70 PUSHJ P,NEWLIN ;DOUBLE SPACE AFTER 100 DLOCST: PUSHJ P,PRINT ASCIZ /D / ;MARK AS DCODE LOC MOVEI C,(FPNT) ;GET LOCATION PUSHJ P,PNTOC4 ;PRINT IN OCTAL, 4 DIGITS PUSHJ P,TAB DLOCL1: PUSHJ P,TAB ;SPACE OVER MOVEI C,(FPNT) ;COPY LOC'N ROT C,-1 ;PREPARE INDEX INTO DTABL SKIPGE C ;RIGHT OR LEFT? SKIPA C,DTABL(C) ;RIGHT MOVS C,DTABL(C) ;LEFT TLZ C,-1 ;CLEAR OTHER HALF SKIPE C ;IF USED, PUSHJ P,PNTDEC ; PRINT IT AOBJN FPNT,DLCLUP ;GO TO NEXT PUSHJ P,CRLF ;RETURN TO LEFT MARGIN MOVEI C,[ASCIZ \LOCATION / LINE NUMBER INDEX ; UCODE LOC'N 0 1 2 3 4 5 6 7\] PUSHJ P,SETHDR HRLO FPNT,HIGHPC ;GET HIGHEST LOC'N USED SETCA FPNT, ;USE AS LIMIT ON AOBJN POINTER JRST LOCST LOCLUP: TRNE FPNT,7 ;TIME FOR A NEW LINE? JRST LOCL1 ;NO PUSHJ P,NEWLIN ;YES TRNN FPNT,70 ;DOUBLE SPACE AFTER 100 LOC'S PUSHJ P,NEWLIN LOCST: PUSHJ P,PRINT ASCIZ /U / ;MARK AS U LOC MOVEI C,(FPNT) ;GET LOCATION PUSHJ P,PNTOC4 ;PRINT IN OCTAL, 4 DIGITS PUSHJ P,TAB LOCL1: PUSHJ P,TAB ;SPACE OVER HLRZ C,PCTABL(FPNT) ;GET LINE # FOR THIS LOCATION SKIPE C ;IF USED, PUSHJ P,PNTDEC ; PRINT IT AOBJN FPNT,LOCLUP ;GO TO NEXT PUSHJ P,CRLF ;RETURN TO LEFT MARGIN ];END IFN FTMAP ;HERE WHEN LISTING FINISHED TRO F,ERROR\NOHDR ;FORCE NEXT MESSAGE TO TTY SKIPN ERRCNT ;ANY ERRORS? SKIPA N,[[ASCIZ / NO/]] MOVEI N,[ASCIZ / ? /] PUSHJ P,PRINT0 SKIPE C,ERRCNT PUSHJ P,PNTDEC ;NUMBER OF ERRORS IF ANY PUSHJ P,PRINT ASCIZ / ERROR/ MOVEI C,"S ;PLURAL MOVE N,ERRCNT CAIE N,1 ;IS IT PLURAL? PUSHJ P,PUT ;YES PUSHJ P,PRINT ASCIZ / DETECTED END OF MICRO CODE ASSEMBLY USED / .SUSET [.RRUNT,,C] ;GET FINAL RUNTIME SUB C,STTIME ;GET USED RUNTIME (MS) IDIVI C,250. ;GET MILLISECONDS ADDI C,5 ;ROUND TO HUNDREDTH OF SEC IDIVI C,10. IDIVI C,100. ;GET HUNDREDTHS OF SEC PUSH P,C+1 ;SAVE FRACTION PUSHJ P,PNTDEC ;PRINT SECONDS MOVEI C,". PUSHJ P,PUT POP P,C ;RECOVER FRACTION PUSHJ P,PNTDC2 PUSHJ P,PRINT ASCIZ / SECONDS / POPJ P, ;LISTING FINISHED PRINT: POP P,N ;PRINT IN-LINE ASCIZ PUSHJ P,PRINT0 JRST 1(N) CRLF: MOVEI N,[ASCIZ / /] PRINT0: HRLI N,440700 ;PRINT ASCIZ N -> PRINT1: ILDB C,N JUMPE C,CPOPJ PUSHJ P,PUT JRST PRINT1 PNTSX0: HRLI N,440600 ;SIXBIT PRINTER PNTSX1: TLNN N,770000 POPJ P, ILDB C,N JUMPE C,CPOPJ ADDI C,40 ;CONVERT TO ASCII PUSHJ P,PUT JRST PNTSX1 PNTOCT: TDZA T1,T1 PNTOC4: MOVEI T1,4 PNTOC2: PUSHJ P,SGNCHK PNTOC3: IDIVI C,8 HRLM C+1,(P) SOSG T1 SKIPE C PUSHJ P,PNTOC3 JRST PNTDC4 PNTDEC: TDZA T1,T1 PNTDC2: MOVEI T1,2 PUSHJ P,SGNCHK PNTDC3: IDIVI C,10. HRLM C+1,(P) SOSG T1 SKIPE C PUSHJ P,PNTDC3 PNTDC4: HLRE C,(P) MOVMS C ADDI C,"0 JRST PUT SGNCHK: JUMPGE C,CPOPJ PUSH P,C MOVEI C,"- PUSHJ P,PUT POP P,C MOVMS C POPJ P, NEWLIN: PUSHJ P,CRLF ;SEND END OF LINE MOVE N,VERPOS ;HOW FAR DOWN PAGE CAIGE N,LPPAG ;COMPARE LINES PER PAGE LIMIT POPJ P, JRST FORM ;EJECT & PRINT NEW HEADER SETHDR: HRRZM C,HDRPNT ;SAVE ADDR OF NEW SUBHEADER FORM: SKIPN VERPOS ;ALREADY AT TOP OF PAGE? POPJ P, ;YES, DON'T BE REDUNDANT SKIPA C,[14] ;AND GET NEW PAGE TAB: MOVEI C,11 ; JRST PUT PUT: SKIPGE PAGNUM ;IS PAGE HEADER FLAG SET? PUSHJ P,HEADER ;NEW HEADER FOR NEW PAGE SOSG OUTCNT PUSHJ P,OUTRFL IDPB C,OUTPNT CAIE C,^L ;DON'T FORMFEED THE TERMINAL JRST [ TRNE F,ERROR .IOT TYOC,C JRST .+1 ] TRNN C,140 ;SPACING CHARACTER? JRST PUT2 ;NO AOS HORPOS ;INDEX HORIZONTAL LINE POSITION POPJ P, PUT2: CAIN C,14 JRST [ AOS PAGNUM HRROS PAGNUM ;SET HEADER FLAG SETZM VERPOS POPJ P, ] CAIN C,15 SETZM HORPOS ;ZERO POSITION FOR CARRIAGE RETURN CAIN C,12 ;LF? AOS VERPOS ;YES, COUNT NEW LINE CAIE C,11 POPJ P, ;NOT HORIZONTAL TAB EXCH C,HORPOS IORI C,7 ADDI C,1 EXCH C,HORPOS POPJ P, TABTON: PUSHJ P,TAB CAMLE N,HORPOS JRST TABTON POPJ P, ;OUTPUT LAST BUFFERFULL OUTCLS: MOVE T1,OUTPNT ;FILL LAST WORD WITH EOF CHRS MOVEI C,^C IDPB C,T1 TLNE T1,760000 JRST .-2 ;THEN FALL INTO OUTRFL ;OUTPUT BUFFER REFILL OUTRFL: PUSH P,C SKIPN C,OUTPNT ;GET NUMBER OF WORDS GENERATED SO FAR JRST OUTRF1 HRLOI C,-OUTBUF(C) ;AND MAKE AOBJN POINTER (ASSUMING NO PARTIAL WORDS) EQVI C,OUTBUF .IOT OUTCHN,C JUMPGE C,OUTRF1 .VALUE ;FAILED TO TRANSMIT ALL THE CRUFT? OUTRF1: MOVE C,[440700,,OUTBUF] MOVEM C,OUTPNT MOVEI C,5*BUFL MOVEM C,OUTCNT POP P,C POPJ P, ;PRINT HEADER ROUTINE HEADER: HRRZS PAGNUM TRNN F,NOHDR ;HEADERS SUPPRESSED? TRNN F,PASS2 POPJ P, PUSH P,16 ;SAVE AC'S 0-16 MOVEI 16,1(P) BLT 16,16(P) ADD P,[16,,16] TRZ F,ERROR ;DON'T SEND HEADER TO TTY ; WILL BE RESTORED WITH AC'S PUSHJ P,PRINT ASCIZ /; / MOVEI N,OUTFIL ;GET ADR OF OUTPUT FILE DESCRIPTOR PUSHJ P,HEDNAM ;AND PRINT THE DESCRIPTOR MOVEI N,32. PUSHJ P,TABTON ;POSITION THE VERSION STUFF PUSHJ P,PRINT ASCIZ /MICRO / MOVEI N,[.FNAM2] PUSHJ P,PNTSX0 MOVEI N,48. ;SPACE OVER TO TITLE PUSHJ P,TABTON SKIPN N,TTLPNT ;IS THERE A TITLE? MOVEI N,[ASCIZ /MICROCODE FILE/] PUSHJ P,PRINT0 ;PRINT A TITLE ;HERE TO DO PAGE # & 2ND LINE OF HEADER PUSHJ P,PRINT ASCIZ / PAGE / HRRZ C,PAGNUM PUSHJ P,PNTDEC ;PRINT PAGE NUMBER PUSHJ P,PRINT ASCIZ / ; / SKIPE N,HDRPNT ;SPECIAL HEADER? JRST HEAD5 ;YES MOVEI N,INFILE ;GET CURRENT INPUT FILE DESCRIPTOR PUSHJ P,HEDNAM MOVEI N,48. PUSHJ P,TABTON ;TAB OVER FOR SUBTITLE HLRZ N,TOCPNT ;GET SUBTTL STRING ADDR JUMPE N,HEAD6 ;MAKE SURE THERE'S SOMETHING TO PRINT MOVEI N,1(N) ;POINT TO TEXT STRING HEAD5: PUSHJ P,PRINT0 ;PRINT SUBTTL OR SPECIAL HEADER HEAD6: PUSHJ P,CRLF PUSHJ P,CRLF SUB P,[16,,16] MOVSI 16,1(P) BLT 16,15 POP P,16 POPJ P, ;SUBR TO PRINT FILENAME, TIME, AND DATE HEDNAM: PUSH P,N ;SAVE DESCRIPTOR POINTER ADDI N,F.DEV PUSHJ P,PNTSX0 MOVEI C,": PUSHJ P,PUT MOVEI C,40 PUSHJ P,PUT MOVE N,(P) ADDI N,F.PPN PUSHJ P,PNTSX0 MOVEI C,"; PUSHJ P,PUT MOVEI C,40 PUSHJ P,PUT MOVE N,(P) ADDI N,F.NAM ;POINT TO FILE NAME PUSHJ P,PNTSX0 MOVEI C,40 PUSHJ P,PUT MOVE N,(P) ADDI N,F.EXT PUSHJ P,PNTSX0 PUSHJ P,TAB POP P,N ;GET POINTER TO BLOCK BACK MOVE C,F.TIM(N) LSH C,-2 ASH C,-2 AOJE C,CPOPJ ;SUPPRESS DATE/TIME IF "-" HRRZ C,F.TIM(N) ;GET 1/2 SECONDS SINCE MIDNIGHT LSH C,-1 IDIVI C,3600. PUSH P,C1 PUSHJ P,PNTDC2 ;HOURS MOVEI C,": PUSHJ P,PUT POP P,C IDIVI C,60. PUSH P,C1 PUSHJ P,PNTDC2 ;MINUTES MOVEI C,": PUSHJ P,PUT POP P,C PUSHJ P,PNTDC2 ;SECONDS MOVEI C,40 PUSHJ P,PUT LDB C,[.BP (37),F.TIM(N)] PUSHJ P,PNTDEC ;DAY LDB C,[.BP (740),F.TIM(N)] PUSH P,N MOVEI N,[SIXBIT /-JAN-/ SIXBIT /-FEB-/ SIXBIT /-MAR-/ SIXBIT /-APR-/ SIXBIT /-MAY-/ SIXBIT /-JUNE-/ SIXBIT /-JULY-/ SIXBIT /-AUG-/ SIXBIT /-SEPT-/ SIXBIT /-OCT-/ SIXBIT /-NOV-/ SIXBIT /-DEC-/ ]-1(C) ;INDEX INTO TABLE BY MONTH PUSHJ P,PNTSX0 POP P,N LDB C,[.BP (177000),F.TIM(N)] PUSHJ P,PNTDEC ;YEAR POPJ P, SUBTTL MICRO-LOCATION ASSIGNMENT ;SEARCH FOR FREE MICRO WORDS. ; LOCPAT CONTAINS THE 1'S PATTERN ; LOCAST CONTAINS THE ASTERISK "DON'T CARE" PATTERN ; FRECNT CONTAINS THE SIZE OF THE BLOCK WITHIN WHICH ; THE PATTERN OF LOCPAT EXISTS. FRECNT IS ALWAYS ; A SINGLE BIT. ;SUBROUTINE RETURNS THE 1ST LOCATION MEETING CRITERIA AND SKIPS. ;IF CRITERIA CANNOT BE MET WITH ANY LOCATION, THEN NO SKIP ;*** TEMPORARY HACK: *** ; IF THE PATTERN IS MORE THAN 5 BITS WIDE, MATCH IT, ; BUT DO NOT LOOK FOR FREE WORDS OUTSIDE A 32-WORD BLOCK, ; AND RESTRICT PC DEFAULT PROGRESSION TO 32-WORD BLOCK. FREWRD: JUMPN RAM,STOP MOVE T1,LOCPAT ;GET PATTERN TO MATCH IOR T1,LOCAST ;COUNT IN THE *'S ANDI T1,FRESIZ-1 ;*** LOOK ONLY AT LOW BITS *** MOVE T1,FRETAB(T1) ;GET LIST OF WORDS FITTING PATTERN MOVEI T2,FRESIZ ;TABLE IS BUILT FOR 32 WORDS SUB T2,FRECNT ;GET # OF WORDS TO THROW AWAY SKIPL T2 ;*** NO SHIFT IF NEGATIVE *** LSH T1,(T2) ; AND THROW THEM AWAY MOVEM T1,FREMSK' ;SAVE PATTERN FOR MATCHING MOVSI N,-MAXPC/36. ;SET UP TABLE LENGTH FREE2: SETCM T1,USAGE(N) ;GET 1'S FOR FREE PC BITS FREE3: JFFO T1,FREE5 ;IF ANY FREE HERE, XFER AOBJN N,FREE2 ;KEEP LOOKING UNTIL ALL GONE POPJ P, ;NO SUCH STRING FREE5: HRRZ N1,T1+1 ;GET LEFT MOST BIT # TO BETTER PLACE SETCM T1+1,USAGE+1(N) ;GET FREE BITS FROM NEXT WORD LSHC T1,(N1) ;PUT 1ST FREE BIT INTO BIT 0 MOVE T2,T1 ;COPY AND T2,FREMSK ;LOOK ONLY FOR REQUIRED STRING HRRZ T3,N ;GET PC FOR THIS BIT IMULI T3,36. ADD T3,N1 MOVE T4,FRECNT ;GET MASK FOR PC ZEROS SUBI T4,1 ;POWER OF 2 CHANGED TO STRING OF 1'S AND T4,T3 ;GET PC BITS TO TEST ANDCM T4,LOCAST ;IGNORE PLACES WHERE *'S ARE IN PATTERN CAMN T2,FREMSK ;PC BITS FREE? CAME T4,LOCPAT ;CORRECT BIT PATTERN? JRST FREE6 ;NO OR NO BLKCNT: MOVN T1,FRECNT ;COUNT WORDS IMPLIED BY FRECNT ORCMI T1,FRESIZ-1 ;*** IF FRECNT .GT. FRESIZ, USE FRESIZ *** ANDCB T1,LOCPAT ; AND LOCPAT ANDCM T1,LOCAST ;*'S DON'T COUNT MOVSI N,-1 BLKC2: JUMPN T1,[ANDI T1,-1(T1) ASH N,1 JRST BLKC2 ] HRR N,T3 ;INSERT PC JRST CPOPJ1 FREE6: MOVEI T4,1 ;THROW AWAY 1 FREE WORD LSH T1,(T4) ; AND WIPE OUT THAT MANY BITS ADD N1,T4 ;CALC TOTAL # OF SHIFT PLACES MOVNS N1 LSH T1,(N1) ; AND SHIFT PC BITS BACK TO PLACE JRST FREE3 ;GO LOOK SOME MORE FRESIZ==32. ;TABLE IS 32 WORDS OF 32 BITS FRETAB: .BYTE 1 REPEAT 32.,[ .WALGN XB==.RPCNT REPEAT 32., IFE .RPCNT&XB,[1]+0 ] .BYTE PCNEXT: MOVE N,PC(RAM) JUMPN RAM,[AOJA N,PCNX2] JUMPGE N,PCNXT1 ;IF NOT IN ADR BLOCK, FIND 1ST FREE WORD MOVE T2,N ;FIND BITS IN PC THAT AND T2,LOCAST ; SHOULD NOT CHANGE IOR N,LOCAST ;INSERT BITS TO PROPOGATE CARRIES AOBJP N,PCNXT1 ;IF .GE. 0, FIND 1ST FREE WORD IOR N,LOCPAT ;RE-INSERT BITS THAT MUST BE 1'S ANDCM N,LOCAST ;MAKE ROOM FOR PC BITS THAT MUST NOT IOR N,T2 ; CHANGE, AND INSERT THEM PCNX2: MOVEM N,PC(RAM) POPJ P, PCNXT1: MOVE N,PC(RAM) SKIPE SEQADR AOJA N,PCNX2 ;DON'T USE FIRST FREE, USE NEXT, IF SEQUENTIAL ADDRESS MODE SETZM LOCPAT ;START ON 000 BOUNDARY SETZM LOCAST ;* PATTERN IS 0'S MOVEI T1,1 ;LOOK FOR 1ST FREE WORD MOVEM T1,FRECNT PUSHJ P,FREWRD MSG CPOPJ, NO MORE MICRO WORDS FREE TLZ N,-1 ;NO ADDRESS RESTRICTIONS JRST PCNX2 ;TEST PC LOCATION FOR PREVIOUS USAGE ; IF USED, NO SKIP ;IF NOT USED, SKIP ; ON RETURN, N,N1 CONTAINS BIT ALIGNED FOR DOING "IORM N1,USAGE(N)" USEDPC: HRRZ N,PC(RAM) JUMPN RAM,USED1 ;DIFFERENT IF DISPATCH IDIVI N,36. MOVN T1,N1 ;NEGATE REMAINDER FOR RIGHT SHIFTS MOVSI N1,(SETZ) LSH N1,(T1) TDNN N1,USAGE(N) AOS (P) IORM N1,USAGE(N) POPJ P, USED1: TRNN F,PASS2 ;COLLECT THIS ON PASS 2 ONLY JRST CPOPJ1 ROT N,-1 ;DIVIDE BY 2 JUMPL N,USED2 ;ODD, USE RH HLRZ N1,DTABL(N) ;PREVIOUS CONTENTS JUMPN N1,CPOPJ ;ERROR IF ALREADY SET MOVE N1,LINNUM ;ELSE GET THIS LINE # HRLM N1,DTABL(N) ;AND RECORD IT JRST CPOPJ1 ;OK RETURN USED2: HRRZ N1,DTABL(N) JUMPN N1,CPOPJ MOVE N1,LINNUM HRRM N1,DTABL(N) JRST CPOPJ1 SUBTTL UUO HANDLER - ERROR MESSAGE PRINTER UUOH: PUSH P,C LDB C,[331100,,40] ;GET OPCODE CAIN C,1 JRST UUOHM ;MSG CAIE C,2 .VALUE ;ILUUO - E.G. HALT MOVE C,40 ;OUTSTR HRLI C,440700 PUSH P,N UUOHOS: ILDB N,C JUMPE N,UUOHSX .IOT TYOC,N JRST UUOHOS UUOHSX: POP P,N POP P,C POPJ P, ;HERE TO PRINT ERROR MESSAGE ;CALLED BY LUUO UUOHM: TRO F,ERROR AOS ERRCNT EXCH N,40 HRRZ T1,(N) MOVEM T1,-1(P) ;SAVE RETURN PUSH P,40 ;SAVE N SKIPN OUTFIL+F.DEV ;IS THERE A FILE ONTO WHICH TO PUT MESSAGE? JRST NOEFIL ;NOPE, JUST TTY ;FIRST LINE -- MESSAGE TEXT AS SPECIFIED BY CALLER .IOT TYOC,[15] ;BLANK LINE ON TTY FOR READABILITY .IOT TYOC,[12] MOVEI C,"; ;PUT ERROR COMMENT PUSHJ P,PUT HLRZ N,(N) ;GET ADR OF MSG PUSHJ P,PRINT0 ;SECOND LINE -- CONTEXT OF ERROR PUSHJ P,PRINT ASCIZ / ; / MOVEI N,[ ASCII /U= / ASCII /D= / ](RAM) PUSHJ P,PRINT0 HRRZ C,PC(RAM) PUSHJ P,PNTOC4 MOVEI N,[ASCIZ /, /] SKIPN NAME SKIPE FIELD PUSHJ P,PRINT0 ;GIVE COMMA SPACE IF FIELD OR NAME TO BE PRINTED MOVEI N,FIELD PUSHJ P,PRINT0 MOVEI C,"/ SKIPE FIELD PUSHJ P,PUT MOVEI N,NAME PUSHJ P,PRINT0 MOVE N,I.MAXC ;# OF SOURCE FILES CAIG N,1 ; MORE THAN ONE? JRST UUOHP ;NO. NO NEED TO IDENTIFY WHICH PUSHJ P,PRINT ;YES. IDENTIFY IT ASCIZ /, FILE= / MOVEI N,INFILE+F.DEV PUSHJ P,PNTSX0 PUSHJ P,PRINT ASCIZ/: / MOVEI N,INFILE+F.PPN PUSHJ P,PNTSX0 PUSHJ P,PRINT ASCIZ/; / MOVEI N,INFILE+F.NAM ;ADDR OF CURRENT INPUT NAME PUSHJ P,PNTSX0 ;PRINT IT MOVEI C,40 PUSHJ P,PUT MOVEI N,INFILE+F.EXT PUSHJ P,PNTSX0 UUOHP: TRNN F,PASS2 JRST UUOHL ;PAGE # MEANINGLESS ON PASS 1 PUSHJ P,PRINT ASCIZ /, PAGE= / HRRZ C,PAGNUM PUSHJ P,PNTDEC UUOHL: PUSHJ P,PRINT ASCIZ /, LINE= / HRRZ C,LINNUM PUSHJ P,PNTDEC IFN FTECHR,[ PUSHJ P,PRINT ASCIZ /, CHAR= / MOVE C,-1(P) ;GET C BACK MOVEI T1,3 ;TYPE 3 OCTAL DIGITS PUSHJ P,PNTOC2 ];END IFN FTECHR PUSHJ P,CRLF MOVEI C,"? PUSHJ P,PNTLST POP P,N POP P,C POPJ P, NOEFIL: HLRZ N,(N) ;ADDR OF MESSAGE .IOT TYOC,["?] ;MAKE IT ERROR-FORM OUTSTR (N) ;TYPE MESSAGE OUTSTR [ASCIZ / /] EXIT STOP: REPEAT 16.,MOVEM .RPCNT,SAVACS+.RPCNT MSG .+1,[ INTERNAL ERROR, "SAVE" CORE IMAGE AND CALL JUD LEONARD, MARLBORO, X6104] .VALUE SUBTTL OPEN INPUT FILE BEGIO: MOVE T1,I.MAXC ;START LOOKING AT 1ST FILE MOVNM T1,I.CNT ;INIT COUNTER TO NUMBER OF FILES NXTFIL: SETOM ENDFIL ;SET END-OF-FILE INDICATOR SKIPL I.CNT POPJ P, ;NO FILES LEFT MOVE C,I.MAXC ;GET NEXT INPUT FILE DESCRIPTOR ADD C,I.CNT ;C HAS FILE NUMBER IMULI C,I.LEN ADDI C,I.STG ;NOW C -> FILE DESC .CALL [ SETZ SIXBIT/OPEN/ [.BAI,,INCHN] I.DEV(C) I.NAM(C) I.EXT(C) SETZ I.PPN(C) ] PUSHJ P,IFOPER MOVE C,I.DEV(C) ;.RCHST SCREWS DEVICE NAME MOVEM C,INFILE+F.DEV MOVE C,[INCHN,,RCHST] .RCHST C, MOVE C,RCHST+1 MOVEM C,INFILE+F.NAM MOVE C,RCHST+2 MOVEM C,INFILE+F.EXT MOVE C,RCHST+3 MOVEM C,INFILE+F.PPN SETO C, .CALL [ SETZ 'RFDATE MOVEI INCHN SETZM INFILE+F.TIM ] PUSHJ P,IFOPER AOS I.CNT ;NEXT FILE SETZM ENDFIL ;CLEAR END-OF-FILE INDICATOR CPOPJ1: AOS (P) ;FILE FOUND, SKIP RETURN CPOPJ: POPJ P, .TNEWL==CPOPJ ;??? ;FILE SYSTEM ERROR HANDLING OFOPER: MOVEI C,O.DEV IFOPER: PUSH P,T1 PUSH P,T2 .IOT TYOC,[^M] .IOT TYOC,["?] .IOT TYOC,[" ] .OPEN ERRC,[.UAI,,'ERR ? 1] .VALUE IFOPE1: .IOT ERRC,T1 CAIGE T1,40 JRST IFOPE2 .IOT TYOC,T1 JRST IFOPE1 IFOPE2: .CLOSE ERRC, SKIPGE C EXIT .IOT TYOC,[40] .IOT TYOC,["-] .IOT TYOC,[40] MOVE T2,I.DEV(C) PUSHJ P,IFOPE3 .IOT TYOC,[":] MOVE T2,I.PPN(C) PUSHJ P,IFOPE3 .IOT TYOC,[";] MOVE T2,I.NAM(C) PUSHJ P,IFOPE3 .IOT TYOC,[40] MOVE T2,I.EXT(C) PUSHJ P,IFOPE3 .IOT TYOC,[15] PUSH P,FPNT PUSH P,SPNT PUSH P,T3 PUSH P,T4 OUTSTR [ASCIZ/USE WHAT FILENAME INSTEAD? /] PUSHJ P,FNR."RLINE SETOM 1FLFLG MOVE FPNT,C PUSHJ P,FNR."FNRAA IRPS R,,T4 T3 SPNT FPNT T2 T1 POP P,R TERMIN SOS (P) SOS (P) POPJ P, ;RETRY THE .CALL IFOPE3: MOVEI T1,0 LSHC T1,6 ADDI T1,40 .IOT TYOC,T1 JUMPN T2,IFOPE3 POPJ P, SUBTTL MOOOOBY TABLES DEFTAB: 0,,BITSET ;TABLE OF SPECIAL DEFINE FUNCTIONS "+,,PCINC ;PUT PC INTO VALUE FIELD "D,,BITSET ;DEFAULT FUNCTION FOR FIELDS "T,,TIMSET ;DEFAULT FUNCTION FOR TIME FIELD "P,,PARITY ;PARITY DEFAULT FUNCTION DEFTND: DEFTYP: POINT 2,SYMVAL(SPNT),1 ;"UCODE" OR "DISP" NUMBER DEFTM1: POINT 4,SYMVAL(SPNT),5 ;TIME VALUE #1 DEFTM2: POINT 3,SYMVAL(SPNT),8 ;TIME VALUE #2 DEFPOS: POINT 7,SYMVAL(FPNT),8 ;MICRO WORD POSITION DEFSIZ: POINT 4,SYMVAL(FPNT),12 ;MICRO WORD FIELD SIZE DEFVAL: POINT 12,SYMVAL(SPNT),24 ;VALUE OF SYMBOL DEFFLG: POINT 7,SYMVAL(SPNT),31 ;FLAGS FOR A SYMBOL DEFFNC: POINT 4,SYMVAL(SPNT),35 ;FUNCTION TO EXECUTE ;FIELD NAME FOR MACRO DEFINITIONS MACRO: ASCIZ /MACRO%/ REPEAT NWORDS-2,0 SWTCH: ASCIZ /SWITCH%/ REPEAT NWORDS-2,0 IFN FTBB,[ MOVMSK: 1_2 ;FMADR SEL 4 1_32.+3_27.+37 ;SCADA DIS, SCADB, SPEC 0 ? 0 ];END FTBB ;CHARACTER TABLES COL==1 COM==2 EOL==3 EQL==4 QOT==5 SLSH==6 TOKTYP: POINT 3,CHRTAB(C),2 ;GET CHARACTER TYPE FOR TOKEN BUILDER STAPNT: POINT .SZTRM,CHRTAB(C),2+.SZTRM ;TERM TYPE FOR TOP LEVEL STATE GETPNT: POINT 7,CHRTAB(C),35 ;CHARACTER TRANSLATION IF2 .SHTRM==41-.SZTRM DEFINE BYTS A,B,C _41+_.SHTRM+ TERMIN CHRTAB: ;CHARACTER LOOK UP TABLE ;FIRST PARAMETER IS CHARACTER TYPE ;SECOND IS TERMINATOR SUB-TYPE ;THIRD IS TRANSLATED VALUE BYTS ,,0 ; NUL BYTS 7,,1 ; DOWN ARROW BYTS 7,,2 ; ALPHA BYTS ,,0 ; EOF CHARACTER (MUST IGNORE) BYTS 7,,4 ; LOGICAL AND BYTS 7,,5 ; LOGICAL NOT BYTS 7,,6 ; EPSILON BYTS 7,,7 ; PI BYTS ,,10 ; BACKSPACE BYTS ,,40 ; TAB BYTS ,EOL,12 ; LF BYTS ,EOL,12 ; VT BYTS ,EOL,12 ; FF BYTS ,,00 ; CR BYTS 7,,16 ; INFINITY BYTS 7,,17 ; PARTIAL DERIVATIVE BYTS 7,,20 ; LEFT LUMP BYTS 7,,21 ; RIGHT LUMP BYTS 7,,22 ; UP LUMP BYTS 7,,23 ; DOWN LUMP BYTS 7,,24 ; FOR ALL BYTS 7,,25 ; THERE EXISTS BYTS 7,,26 ; WHEEL BYTS 7,,27 ; LEFT-RIGHT ARROW BYTS 7,,30 ; LEFT ARROW BYTS 7,,31 ; RIGHT ARROW BYTS 7,,32 ; NOT EQUAL BYTS 7,,33 ; ALTMODE BYTS 7,,34 ; LESS OR EQUAL BYTS 7,,35 ; GREATER OR EQUAL BYTS 7,,36 ; EQUIVALENCE BYTS 7,,37 ; LOGICAL OR BYTS 1,,040 ; SP BYTS 7,,041 ; ! BYTS ,QOT,042 ; " BYTS 7,,"# ; # BYTS ,,"$ ; $ BYTS ,,"% ; % BYTS ,,"& ; & BYTS ,,"' ; ' BYTS 7,,"( ; ( BYTS 7,,") ; ) BYTS 7,,"* ; * BYTS 3,,"+ ; + BYTS ,COM,[",] ; , BYTS 4,,"- ; - BYTS 2,,". ; . BYTS ,SLSH,"/ ; / BYTS 5,,"0 ; 0 BYTS 5,,"1 ; 1 BYTS 5,,"2 ; 2 BYTS 5,,"3 ; 3 BYTS 5,,"4 ; 4 BYTS 5,,"5 ; 5 BYTS 5,,"6 ; 6 BYTS 5,,"7 ; 7 BYTS 6,,"8 ; 8 BYTS 6,,"9 ; 9 BYTS ,COL,": ; : BYTS ,EOL,073 ; ; BYTS ,,074 ; < BYTS ,EQL,"= ; = BYTS ,,076 ; > BYTS ,,"? ; ? BYTS ,,"@ ; @ BYTS 7,,"A ; A BYTS 7,,"B ; B BYTS 7,,"C ; C BYTS 7,,"D ; D BYTS 7,,"E ; E BYTS 7,,"F ; F BYTS 7,,"G ; G BYTS 7,,"H ; H BYTS 7,,"I ; I BYTS 7,,"J ; J BYTS 7,,"K ; K BYTS 7,,"L ; L BYTS 7,,"M ; M BYTS 7,,"N ; N BYTS 7,,"O ; O BYTS 7,,"P ; P BYTS 7,,"Q ; Q BYTS 7,,"R ; R BYTS 7,,"S ; S BYTS 7,,"T ; T BYTS 7,,"U ; U BYTS 7,,"V ; V BYTS 7,,"W ; W BYTS 7,,"X ; X BYTS 7,,"Y ; Y BYTS 7,,"Z ; Z BYTS ,,133 ; [ BYTS ,,"\ ; \ BYTS ,,135 ; ] BYTS ,,"^ ; ^ BYTS 7,,"_ ; _ BYTS ,,140 ; ` BYTS 7,,"A ; A (LOWER CASE) BYTS 7,,"B ; B BYTS 7,,"C ; C BYTS 7,,"D ; D BYTS 7,,"E ; E BYTS 7,,"F ; F BYTS 7,,"G ; G BYTS 7,,"H ; H BYTS 7,,"I ; I BYTS 7,,"J ; J BYTS 7,,"K ; K BYTS 7,,"L ; L BYTS 7,,"M ; M BYTS 7,,"N ; N BYTS 7,,"O ; O BYTS 7,,"P ; P BYTS 7,,"Q ; Q BYTS 7,,"R ; R BYTS 7,,"S ; S BYTS 7,,"T ; T BYTS 7,,"U ; U BYTS 7,,"V ; V BYTS 7,,"W ; W BYTS 7,,"X ; X BYTS 7,,"Y ; Y BYTS 7,,"Z ; Z BYTS ,,173 ; { BYTS ,,174 ; | BYTS ,,175 ; } BYTS ,,176 ; ~ BYTS ,,000 ; DEL IFN .-CHRTAB-128.,.ERR CHARACTER TABLE MESSED UP IF1,[ .MXSTA==0 .MXTOK==0 .MXTRM==0 .MXDSP==0 DEFINE ITEM STATE,.TOKTYP,.TRMTYP,.DISP,.NSTATE IRPS TOKTYP,,[.TOKTYP]TRMTYP,,[.TRMTYP]DISP,,[.DISP]NSTATE,,[.NSTATE] IFG STATE-.MXSTA,.MXSTA==STATE IFG TOKTYP-.MXTOK,.MXTOK==TOKTYP IFG TRMTYP-.MXTRM,.MXTRM==TRMTYP IFG DISP-STDISP-.MXDSP,.MXDSP==DISP-STDISP IFG NSTATE-.MXSTA,.MXSTA==NSTATE .STOP TERMIN TERMIN ;END OF DEFINE ITEM DEFINE EXPAND N BLOCK 1 TERMIN ;END OF DEFINE EXPAND ];END OF IF1 IF2,[ DEFINE ITEM STATE,.TOKTYP,.TRMTYP,.DISP,.NSTATE IRPS TOKTYP,,[.TOKTYP]TRMTYP,,[.TRMTYP]DISP,,[.DISP]NSTATE,,[.NSTATE] .XE==_.SZTRM+TRMTYP .XN==36./<.SZDSP+.SZSTA> .XV==_.SZSTA+NSTATE INSERT \<.XE/.XN>,\<.XE-.XE/.XN*.XN> .STOP TERMIN TERMIN ;END OF DEFINE ITEM DEFINE INSERT Q,R IFNDEF .ENT!Q,.ENT!Q==0 .ENT!Q==.ENT!Q+.XV_<36.-*<.SZDSP+.SZSTA>> TERMIN ;END OF DEFINE INSERT DEFINE EXPAND N IFNDEF .ENT!N,.ENT!N==0 .ENT!N TERMIN ;END OF DEFINE EXPAND ];END OF IF2 ; OLD STATE TOKEN TERM DISP NEW STATE ITEM 0, .TKB, EQL, DLBLK, 0 ITEM 0, .TKS, COL, DTAG, 0 ITEM 0, .TKN, COL, DLSET, 0 ITEM 0, .TKS, EQL, DDEFS, 0 ITEM 0, .TKS, SLSH, DCFLD, 1 ITEM 0, .TKS, QOT, DMDEF, 0 ITEM 0, .TKS, EOL, DSUDO, 0 ITEM 0, .TKS, COM, DMAC, 0 ITEM 0, .TKB, EOL, DNOP, 0 ;?? ITEM 1, .TKS, EQL, DDEFS, 0 ITEM 1, .TKB, EQL, DDEFF, 0 ITEM 1, .TKS, COM, DFSYM, 2 ITEM 1, .TKS, EOL, DFSYM, 0 ITEM 1, .TKN, COM, DFNUM, 2 ITEM 1, .TKN, EOL, DFNUM, 0 ITEM 2, .TKS, SLSH, DFLD, 3 ITEM 2, .TKS, COM, DMAC, 2 ITEM 2, .TKS, EOL, DMAC, 2 ITEM 2, .TKB, EOL, DNOP, 2 ITEM 3, .TKS, COM, DFSYM, 2 ITEM 3, .TKS, EOL, DFSYM, 0 ITEM 3, .TKN, COM, DFNUM, 2 ITEM 3, .TKN, EOL, DFNUM, 0 IFN FTIF,[ ;CONDITIONAL ASSEMBLY STATES ITEM 4, .TKB, EQL, DCMNT, 4 ITEM 4, .TKS, COL, DNOP, 4 ITEM 4, .TKN, COL, DNOP, 4 ITEM 4, .TKS, EQL, DCMNT, 4 ITEM 4, .TKS, SLSH, DCFLD, 4 ITEM 4, .TKS, QOT, DCMNT, 4 ITEM 4, .TKS, EOL, DCMNT, 4 ITEM 4, .TKS, COM, DCMNT, 4 ITEM 4, .TKB, EOL, DCMNT, 4 ];END IFN FTIF ;STATE MEANING ; 0 START OF LINE/MICROWORD ; 1 SYMBOL/ SCANNED AT START OF LINE/MICROWORD ; 2 COMMA SEEN, SO IN MIDDLE OF MICROWORD ; 3 SYMBOL/ SCANNED IN MIDDLE OF MICROWORD ; 4 ASSEMBLY SUPPRESSED DEFINE LOG2 AA,B IRPS A,,[AA] A==0 REPEAT 35.,IFGE B-1_A,A==A+1 TERMIN TERMIN ;END OF DEFINE LOG2 LOG2 .SZTOK=,.MXTOK LOG2 .SZSTA=,.MXSTA LOG2 .SZTRM=,.MXTRM LOG2 .SZDSP=,.MXDSP STAMTB: PINDEX .SZDSP+.SZSTA,STATAB(T1) STATAB: ;EXPANSION OF STATE TABLE REPEAT 1+<1_<.SZSTA+.SZTOK+.SZTRM>/<36./<.SZDSP+.SZSTA>>>,[ EXPAND \.RPCNT ] ;FAKED SYMBOL TABLE ENTRIES FOR PSEUDO OPS PSUDO%: XWD ..DCD,0 ;FIELD NODE ..DCD: XWD ..UCD,$DCODE ;SYMBOL NODE ASCII /DISPATCH/ REPEAT NWORDS-2,0 ..UCD: XWD .DCODE,$UCODE ASCII /UCODE/ REPEAT NWORDS-1,0 .DCODE: XWD .SEQAD,$DCODE ;SYMBOL NODE ASCII /.DCODE/ REPEAT NWORDS-2,0 .SEQAD: XWD .UCODE,$SEQAD ASCII /.SEQADR/ REPEAT NWORDS-2,0 .UCODE: XWD 0,$UCODE ;END OF PSEUDO-OP TABLE ASCII /.UCODE/ REPEAT NWORDS-2,0 PSUDM%: XWD .TITLE,0 ;FIELD NODE FOR PSEUDO-MACROS .TITLE: XWD .TOC,$TITLE ASCII /.TITLE/ REPEAT NWORDS-2,0 .TOC: XWD 0,$TOC ASCII /.TOC/ REPEAT NWORDS-1,0 ;FAKED SYMBOL TABLE ENTRIES FOR CONDITIONAL ASSEMBLY OPERATORS IFN FTIF,[ PSUDF%: XWD .CHNG,0 ;FIELD NODE FOR PSEUDO-FIELDS .CHNG: XWD .DEFLT,$CHNG ASCII /.CHANGE/ REPEAT NWORDS-2,0 .DEFLT: XWD .ENDIF,$DEFLT ASCII /.DEFAULT/ REPEAT NWORDS-2,0 .ENDIF: XWD .IF,$ENDIF ASCII /.ENDIF/ REPEAT NWORDS-2,0 .IF: XWD .IFNOT,$IF ASCII /.IF/ REPEAT NWORDS-1,0 .IFNOT: XWD .SET,$IFNOT ASCII /.IFNOT/ REPEAT NWORDS-2,0 .SET: XWD 0,$SET ASCII /.SET/ REPEAT NWORDS-1,0 ];END IFN FTIF IMPURE .JBFF: HGHIMP ;FIRST FREE LOCATION IN IMPURE .JBREL: &<-2000> ;FIRST LOCATION IN NXM ABOVE IMPURE PAT: PATCH: BLOCK 40 ;PATCH SPACE, INTENTIONALLY NOT ZERO'D GOBLT:: ;START OF BLT TO ZERO MEMORY VARIABLES VERPOS: BLOCK 1 ;LINE NUMBER ON PAGE HORPOS: BLOCK 1 ;COLUMN NEXT OUTPUT CHARACTER WILL GO INTO FLDPNT: BLOCK 1 ;POINTS TO BEGINNING OF SYMBOL TABLE MAXPOS: BLOCK 2 ;LARGEST BIT POSITION DEFINED FOR MICRO CODE VALUE: BLOCK MICMXW ;HOLDS BINARY MICRO CODE UNDER CONSTRUCTION VALSET: BLOCK MICMXW ;1S IN ALL FIELDS WHERE ITEMS INSERTED INTO "VALUE" TIME1: BLOCK 1 ;TIME VALUE #1 MAXIMUM TIME2: BLOCK 1 ;TIME VALUE #2 MAXIMUM VALEND:: ;END OF BLT TO INIT A MICRO WORD TKZER:: ;BLOCK TO ZERO FOR EACH TOKEN SCAN TOKMIN: BLOCK 1 ;FLAG NUMERIC TOKEN IS NEGATIVE TOKOCT: BLOCK 1 ;BUILDING OCTAL VALUE TOKDEC: BLOCK 1 ; DECIMAL TOKEN VALUE NUMBER: BLOCK 1 ;NUMERIC RESULT OF TOKEN SCANNER NAME: BLOCK NWORDS ;ASCII TEXT FOR SYMBOL NAME TKZEND:: ;END OF BLT TO INIT A TOKEN FIELD: BLOCK NWORDS ;ASCII TEXT FOR FIELD NAME PC: BLOCK 2 ;MICRO WORD LOCATION COUNTER SEQADR: 0 ;NON-ZERO MEANS USE SEQUENTIAL ADDRESSES STATE: BLOCK 1 ;SYNTAX SCANNER STATE ENDFIL: BLOCK 1 ;NON-0 INDICATES END OF ALL INPUT DATA CHRPNT: BLOCK 1 ;HOLDS 0, OR BYTE POINTER FOR RESCANS INPNT: BLOCK 1 ;BYTE POINTER FOR INPUT FILE INCNT: BLOCK 1 ;BYTE COUNTER FOR INPUT FILE OUTPNT: BLOCK 1 ;BYTE POINTER FOR OUTPUT FILE OUTCNT: BLOCK 1 ;BYTE COUNTER FOR OUTPUT FILE PDL: BLOCK 100 ;PUSH DOWN LIST PDLEND:: PMDL: BLOCK 100 ;STACK FOR RECURSING ON RESCANS PMEND:: STTIME: BLOCK 1 ;RUNTIME AT START SAVACS: BLOCK 16. ;AC STORAGE DURING FATAL ERRORS PNTBUF: BLOCK 100./5 ;BUFFER FOR HOLDING LISTING TEXT PNTMAX==<.-PNTBUF>*5-1 EOLCHR: BLOCK 1 ;HOLDS LAST CHAR IN PRINT LINE ERRCNT: BLOCK 1 ;COUNTS MSG UUOS FOR ERRORS PAGNUM: BLOCK 1 ;SOURCE PAGE NUMBER IN RIGHT HALF ;-1 IN LEFT IS FLAG TO PRINT HEADER TTLPNT: BLOCK 1 ;ADDRESS OF TITLE TEXT TOCPNT: BLOCK 1 ;LIST POINTER TO TABLE OF CONTENTS HDRPNT: BLOCK 1 ;ADDRESS OF HEADER TEXT LINNUM: BLOCK 1 ;SOURCE LINE NUMBER FRECNT: BLOCK 1 ;COUNT OF REQUIRED CONSECUTIVE MICRO WORDS LOCPAT: BLOCK 1 ;BIT PATTERN FOR LOCATION ASSIGNMENTS LOCAST: BLOCK 1 ;BIT PATTERN FOR *'S IN LOCATION PATTERN PNTCNT: BLOCK 1 ;COUNT OF NUMBER OF CHARS IN PNTBUF PNTPNT: BLOCK 1 ;BYTE POINTER INTO PNTBUF FOR LISTING JEQL: BLOCK 1 ;HOLDS LIST HEADER FOR EQUAL TAGS PRNTPC: BLOCK 2 ;HOLDS PC FOR ASSEMBLY LISTING WRDCNT: BLOCK 2 ;COUNT OF MICRO WORDS USED LOOSPC: BLOCK 2 ;COUNT OF PC WORDS WITH NO ADR RESTRICTIONS HIGHPC: BLOCK 2 ;HIGHEST LOCATION ASSIGNED MACPNT: BLOCK 2 ;ADDRESSES OF "MACRO%" FIELD HEADERS JPNT: BLOCK 2 ;ADDRESSES OF "J" FIELD HEADERS SWTPNT: BLOCK 1 ;ADDRESS OF "SWITCH%" FIELD HEADER SUPSYM: BLOCK 1 ;ADDRESS OF SYMBOL TABLE ENTRY FOR ;SYMBOL WHICH TURNED OFF ASSY USAGE: BLOCK MAXPC/36.+1 ;HOLDS 1S FOR EVERY MICRO WORD USED USGEND:: DTABL: BLOCK MAXDSP/2 ;EACH HALF,LINE # AT WHICH WORD DEFINED BLOCK 1 ;PCTABL-1 FOR CHAINING TO FIRST WORD PCTABL: BLOCK MAXPC ;LH, LINE # AT WHICH THIS MICRO-WORD DEFINED ;RH, NEXT MICRO-WORD ADDR ASSEMBLED AFTER THIS ; IE, DEFAULT VALUE FOR J FIELD ;ZERO IF THIS LOC'N NOT ASSEMBLED INTO PCTEND:: ;TABLE FOR DEFAULT PC'S JCL: BLOCK 100./5 ;JCL BUFFER JCLE: 0 JCLFNC: -1 ;FENCE DISTTY: 0 ;-1 IF %TOERS I.MAXC: BLOCK 1 ;COUNT OF NUMBER OF INPUT FILES I.CNT: BLOCK 1 ;FILE COUNTER USED BY ALLIN 1FLFLG: 0 ;NON-ZERO FNR READING ONLY ONE FILE O.DEV: BLOCK 1 O.NAM: BLOCK 1 O.EXT: BLOCK 1 O.PPN: BLOCK 1 O.LEN==.-O.DEV I.DEV==0 ;INPUT DEVICE I.NAM==1 ;INPUT FILE NAME/MASK I.EXT==2 ;INPUT EXTENSION I.PPN==3 ;INPUT PPN I.LEN==4 ;LENGTH OF INPUT FILE DESCRIPTOR BLOCK I.STG: BLOCK 20.*I.LEN ;INPUT FILE DESCRIPS BUFL==200 INBUF: BLOCK BUFL OUTBUF: BLOCK BUFL OUTFIL: BLOCK 5 ;SAVED STUFF FOR OUTPUT FILE INFILE: BLOCK 5 ;SAVED STUFF FOR CURRENT INPUT FILE F.DEV==0 ;DEVICE NAME F.NAM==1 ;FILE NAME F.EXT==2 ;FILE NAME 2 F.TIM==3 ;FILE DATE ITS FORMAT F.PPN==4 ;FILE DIRECTORY RCHST: BLOCK 10. ;FOR .RCHST ENDBLT: ;END OF BLT TO ZERO MEMORY SUBTTL COMMAND LINE SCANNER PURE FNR.: .BEGIN A=1 B=2 C=3 D=4 SETZM JCL MOVE A,[JCL,,JCL+1] BLT A,JCLE SETOM JCLFNC .SUSET [.ROPTION,,A] TLNE A,OPTCMD .BREAK 12,[5,,JCL] PUSHJ P,FNRLIN ;PROCESS COMMAND LINE SKIPN I.MAXC ;SEE IF GOT ANYTHING SKIPE O.DEV POPJ P, ;YUP, OK .IOT TYOC,["*] PUSHJ P,RLINE ;NO, READ A LINE FROM TTY PUSHJ P,FNRLIN SKIPN I.MAXC SKIPE O.DEV POPJ P, EXIT ;NOTHING FROM TTY, EXIT ; READ A LINE FROM TTY INTO JCL RLINE: MOVE D,[010700,,JCL-1] RLINE0: .IOT TYIC,A CAIE A,177 JRST RLINE1 CAMN D,[010700,,JCL-1] JRST [ .IOT TYOC,[15] ? JRST RLINE0 ] LDB A,D MOVEI B,0 DPB B,D ADD D,[070000,,] SKIPGE D SUB D,[430000,,1] SKIPN DISTTY JRST [ .IOT TYOC,A ? JRST RLINE0 ] .IOT TYOC,[^P] .IOT TYOC,["X] JRST RLINE0 RLINE1: CAIE A,^L JRST RLINE2 .IOT TYOC,[15] MOVE C,[010700,,JCL-1] RLIN1A: CAMN C,D JRST RLINE0 ILDB A,C .IOT TYOC,A JRST RLIN1A RLINE2: CAIE A,^M CAIN A,^C CAIA JUMPN A,RLINE3 MOVEI A,0 IDPB A,D ;END HERE POPJ P, RLINE3: IDPB A,D JRST RLINE0 ;GET OUTPUT AND INPUT FILE SPECS FROM JCL FNRLIN: SETZB FPNT,I.MAXC ;FPNT INDEX INTO I.STG ADDI FPNT,I.STG ;WELL I REALLY WANTED A POINTER I GUESS SETZM O.DEV SETZM O.NAM SETZM O.EXT SETZM O.PPN FNRAA: MOVE SPNT,[000700,,JCL-1] ;SPNT BP TO JCL FNR0: SETZM I.DEV(FPNT) ;HERE FOR NEXT FILE SETZM I.NAM(FPNT) SETZM I.EXT(FPNT) SETZM I.PPN(FPNT) FNR1: SETZM D ;HERE FOR NEXT SYLLABLE MOVE C,[440600,,D] FNR2: ILDB A,SPNT ;HERE FOR NEXT CHARACTER CAIGE A,40 JRST FNREND CAIN A,"; JRST FNRSEM CAIN A,": JRST FNRCOL CAIN A,", JRST FNRSEP CAIN A," JRST FNRSPC CAIE A,"= CAIN A,"_ JRST FNROUT CAIGE A,140 SUBI A,40 TLNE C,770000 IDPB A,C JRST FNR2 FNRSEM: MOVEM D,I.PPN(FPNT) JRST FNR1 FNRCOL: MOVEM D,I.DEV(FPNT) JRST FNR1 FNRSPC: MOVEM D,I.NAM(FPNT) JRST FNR1 FNREND: MOVEI A,400000 JRST FNRSEP FNROUT: SETOM A CAIE FPNT,I.STG MSG [EXIT],OUTPUT FILE MUST COME FIRST FNRSEP: JUMPE D,FNRSP1 SKIPN I.NAM(FPNT) JRST [ MOVEM D,I.NAM(FPNT) JRST FNRSP1 ] MOVEM D,I.EXT(FPNT) FNRSP1: MOVSI D,(SIXBIT/>/) ;APPLY DEFAULTS SKIPGE A MOVSI D,(SIXBIT/MCR/) SKIPN I.EXT(FPNT) MOVEM D,I.EXT(FPNT) MOVSI D,(SIXBIT/DSK/) CAIE FPNT,I.STG MOVE D,I.DEV-I.LEN(FPNT) SKIPN I.DEV(FPNT) MOVEM D,I.DEV(FPNT) CAIE FPNT,I.STG SKIPA D,I.PPN-I.LEN(FPNT) .SUSET [.RSNAM,,D] SKIPN I.PPN(FPNT) MOVEM D,I.PPN(FPNT) SKIPE 1FLFLG POPJ P, JUMPL A,FNROU1 SKIPE I.NAM(FPNT) ;SKIP IF BLANK LINE AOS I.MAXC CAIN A,400000 JRST FNREN1 ;END OF LINE ADDI FPNT,I.LEN CAIGE FPNT,I.STG+20.*I.LEN JRST FNR0 MSG [EXIT],ONLY 20. INPUT FILES ALLOWED FNROU1: IRPS SYL,,[DEV NAM EXT PPN] MOVE D,I.!SYL(FPNT) MOVEM D,O.!SYL TERMIN JRST FNR0 FNREN1: POPJ P, .END FNR. LIT..: CONSTANTS IMPURE VARIABLES PURE IMPURE IF1,[ DEFINE INFORM A,B PRINTX\A=B \ TERMIN INFORM HIGHEST IMPURE USED,\%%LOW INFORM HIGHEST PURE USED,\%%HIGH ] HGHIMP=%%LOW ;PUT PURIFICATION CODE IN LOW IMPURE. WIPED OUT BY SYMBOLS. 0 NPURPG==<%%HIGH-400000+1777>/2000 ;NUMBER OF PURE PAGES IF2, NNXMPG==200-/2000 ;NUMBER OF NXM PAGES BETWEEN LOW AND HIGH PURIFY::MOVE T1,[-NPURPG,,200] .CALL [ SETZ 'CORBLK MOVEI %CBRED+%CBNDR MOVEI -1 MOVE T1 SETZI -1 ] .VALUE MOVE T1,[-NNXMPG,,/2000] .CALL [ SETZ 'CORBLK MOVEI 0 MOVEI -1 SETZ T1 ] .VALUE .VALUE [ASCIZ/:PDUMP TS MICRO/] CONSTANTS PURIFE:: END MICRO