XLIST DEFINE DEFTTL (NAME,MAJOR,MINOR,EDIT,DATE) < LALL TITLE NAME V'MAJOR DATE SUBTTL INITIALIZATION ; COPYRIGHT DIGITAL EQUIPMENT CORPORATION ; 1969,1970,1971,1972,1973,1974 MNNUM= "MINOR"-100 IFIDN <> IFIDN <> DEFINE DEFOUT < OUTSTR [ASCIZ /NAME: /]> IFIDN TWOSEG INTERN .JBVER LOC <.JBVER==137> EXP 0B2!B11!B17!EDIT INTERN .JBREN LOC <.JBREN=124> XWD START RELOC 0 RELOC 400000 SYN RELOC,.LOC SYN RELOC,.RELOC SYSPPN: XWD 1,4 ;SYSTEM PPN SYSDEV: SIXBIT /DSK/ ;SYSTEM DEVICE TITLE: ASCIZ /NAME MAJOR'MINOR(EDIT)/ ENTRY COLD ;[w1] EXTERNAL JOBREL,JOBFF,JOBUUO,JOB41,JOBHRL,.JBREL jobrel=.jbrel## jobff=.jbff## jobuuo=.jbuuo## job41=.jb41## jobhrl=.jbhrl## XALL > LIST DEFTTL MACY11,27,,657,13-NOV-74 DEFINE ASCNAM < EXP "M","A","C","Y","1","1"> SUBTTL CONCISE CHANGE HISTORY COMMENT % Edit # Description ********************************************************************* 626 Prevent Z-errors from being fatal 627 Prevent spurious X-errors on JMPs between CSECTs and to globals. 630 Provide complete Z-error checking. 631 Correct action of .MEXIT within repeat blocks.(IRP,IRPC,REPT). 632 Preclude garbage generation if .IDENT has too many chars. 633 Make .MCALL work right all the time. 634 Make MACY11 accept .PDP10 pseudo-ops. 635 Clean up page 1. *****************release******************* 636 Load .JBREN,fix a spelling error, add debug patch area. 637 Add .PSECT capability. 640 Add Cutler mods. 641 Add disable of default globals, dflt registers 642 Implement /RSX, different default source extension order, improved spacing in symbol table output. 643 Correct minor glitches in CCL -file handling. 644 Fix another .IRP problem;i.e., correct action of macro defs inside .IRPs. 645 Force .IF IDN and .ASCII to accept null strings. 646 Not used. 647 Correct a .PSECT bug. 650 Correct action of default globalization. 651 Take one giant step backward. Skip 650, modify 647 and really correct default globalization. 652 Add SWITCH.INI capability and expand local symbol range. 653 Simplify default global disabilization. 654 Make SWITCH.INI processing take line numbers and upper/lower case. 655 Eliminate form feed before reprint of command line at end of listing. ******************RELEASE****************** 656 ADD "JOB" LOGGING VIA SUBROUTINES IN LOGREC AND LOGAPP. ****** NOW MUST BE LOADED WITH COMMAND STRING ***** .LOAD MACY11.NNN,LOGREC,LOGAPP *************************************************** LOGGING IS DONE IN DSKZ:JOB###.LOG[350,3004] ******************RELEASE****************** 657 FIX "?LOGENT ENTER FAILURE" "[NOT LOGGED]" JUNK FROM JOBLOG ******************RELEASE****************** % SUBTTL VARIABLE PARAMETERS DEFINE GENPAR (NAME,VALUE) < IFNDEF NAME, > GENPAR PAGSIZ,^D54 ; NUMBER OF LINES ON A PAGE GENPAR NUMBUF,2 ; NUMBER OF BUFFERS PER DEVICE GENPAR CORINC,2000 ; CORE INCREMENT GENPAR SPL,4 ; SYMBOLS PER LINE (SYMBOL TABLE LISTING) GENPAR SPLTTY,3 ; SYMBOLS PER LINE (TTY) GENPAR DATLEN,^D350 ; DATA BLOCK LENGTH GENPAR RLDLEN,^D40 GENPAR LSRNGE,^D65534 ;LOCAL SYMBOL RANGE GENPAR WPB,10 ; MACRO BLOCK SIZE GENPAR CPL,^D132 ; CHARACTERS PER LINE GENPAR PDPLEN,100 ; PUSH-DOWN POINTER LENGTH GENPAR COLLPT,^D128 ;CPL LPT GENPAR COLTTY,^D72 ;CPL TTY GENPAR TTLLEN,COLLPT-^D<8*5> ;TITLE AND SUB-TITLE BUFFER SIZE GENPAR LCFDEF,LC.ME!LC.MEB!LC.LD ;DEFAULT LISTING SUPPRESSION BKT1= 1 BKT2= 2 BKT3= 3 BKT4= 4 BKT6= 6 .LOC IFDEF DEBUG < PATCH: BLOCK 100 ;DEBUGGING PATCH AREA > RSXSW: BLOCK 1 ;NON-ZERO IF RSW PSECT DEFAULTS ;ARE ENABLED PDPSTK: BLOCK PDPLEN CCLTOP: BLOCK 1 ;TOP OF CCL STORAGE CCLPNT: BLOCK 1 ;CCL POINTER BZCOR: .RELOC SUBTTL ACCUMULATOR ASSIGNMENTS %00= 0 ; ACCUMULATION OF SIXBIT SYMBOL, SCRATCH %01= 1 ; SYMBOL VALUE AND FLAGS SET BY SRCH. SCRATCH %02= 2 ; SCRATCH %03= 3 ; UNIVERSAL SCRATCH %04= 4 ; UNIVERSAL SCRATCH +1 %05= 5 ; LOCATION COUNTER %06= 6 ; SCRATCH %07= 7 ; SYMBOL TABLE SEARCH INDEX %10= 10 ; EXPRESSION OR TERM VALUE, SCRATCH %11= 11 ; SCRATCH %12= 12 ; %13= 13 ; LINE BUFFER BYTE POINTER %14= 14 ; CURRENT CHARACTER (ASCII) %15= 15 ; LH - ASSEMBLER FLAGS, RH - ERROR FLAGS %16= 16 ; EXEC FLAGS %17= 17 ; PUSH-DOWN POINTER SUBTTL FLAG REGISTERS ; %16 - LH LSTBIT= 000001 ; 1- SUPPRESS LISTING OUTPUT BINBIT= 000002 ; 1- SUPPRESS BINARY OUTPUT CRFBIT= 000004 ; 1- CREF DISABLED ESWBIT= 000010 ; 1- LIST OCTAL SOLBIT= 000020 ; 1- SEQUENCE OUTPUT LINES NSWBIT= 000040 ; 1- SUPPRESS ERRORS ON TTY FMTBIT= 000100 ; 1- GNS MODE TTYBIT= 000200 ; 1- LISTING IS ON TTY ERRBIT= 000400 ; 1- ERROR MESSAGES ENABLED P1LBIT= 001000 ; 1- LIST ON PASS 1 CDRBIT= 002000 ; 1- /CDR MODE LPTBIT= 004000 ; 1- SUPPRESS LISTING TO LPT GBLDIS= 010000 ; 1- DEFAULT GLOBALS DISABLED INFBIT= 020000 ; 1- VALID INFORMATION SEEN HDRBIT= 040000 ; 1- TIME FOR NEW LISTING PAGE REGBIT= 100000 ; 1- REGISTERS SET AT COMMAND LEVEL MODBIT= 200000 ; 1- USER MODE AC'S SET GBLCCL= 400000 ;INDICATES WHETHER GBLDIS WAS SET BEFORE ;SOURCE SCANNING BEGAN ; %16 - RH RSXBIT= 000001 ; 1- RSX defaults freshly enabled ; %15 - LH ASZFLG= 000010 ; 1- ASCIZ MODE NQEFLG= 000020 ; 1- NO "Q" ERRORS AT END OF LINE ENDFLG= 000040 ; 1- END OF SOURCE ENCOUNTERED FFFLG= 000100 ; 1- ISOLATED FORM FEED FMTFLG= 000200 ; 1- OVER-RIDE LC.FMT LSBFLG= 000400 ; 1- NEW LOCAL SYMBOL RANGE DEFFLG= 001000 ; 1- CREF DEFINITION DSTFLG= 002000 ; 1- CREF DESTINATION DS2FLG= 004000 ; 1- DITTO, 2ND FIELD DISBIT= 010000 ; 1- DISABLE CURRENTLY IN EFFECT LHMFLG= 020000 ; 1- MOVE LISTING TO LH MARGIN FLTFLG= 040000 ; 1- ERROR ENCOUNTERED IN FLOATING ROUTINE ISWFLG= 100000 ; 1- /I SEEN P1F= 400000 ; 1- PASS 1 IN PROGRESS SUBTTL ERROR FLAGS ERR.A= 400000 ERR.B= 200000 ERR.D= 100000 ERR.E= 040000 ERR.I= 020000 ERR.L= 010000 ERR.M= 004000 ERR.O= 002000 ERR.P= 001000 ERR.Q= 000400 ERR.R= 000200 ERR.T= 000100 ERR.U= 000040 ERR.N= 000020 ERR.Z= 000010 ;MARGINAL INSTRUCTION ERR.X= 000004 ERR.P1= 000001 ERRMNE: ASCIZ /ABDEILMOPQRTUNZX/ ;DEFINE ERROR TYPES CONSIDERED "FATAL" QMEMSK== ERR.A!ERR.B!ERR.D!ERR.E!ERR.I!ERR.L!ERR.M QMEMSK==QMEMSK! ERR.O!ERR.P!ERR.Q!ERR.R!ERR.T!ERR.U!ERR.N SUBTTL MISCELLANEOUS PARAMETERS TTYDEV= 000010 ; 1- DEVICE IS A TTY PTRDEV= 000200 ; 1- DEVICE IS A PTR LPTDEV= 040000 ; 1- DEVICE IS A LPT CDRDEV= 100000 ; 1- DEVICE IS A CDR IODATA= 200000 ; 1- IO DATA ERROR IODEV= 100000 ; 1- IO PARITY ERROR IOWRLK= 400000 ; 1- IO WRITE LOCK ERROR IOBKTL= 040000 ; 1- IO BLOCK TOO LARGE IOEOF= 020000 ; 1- END OF FILE ON IO DEVICE ; DEVICE PARAMETERS BIN= 1 LST= 2 SRC= 3 CCL= 3 CRF= 4 MAC= 5 SWI= 6 ;CHANNEL NUMBER FOR SWITCH.INI INBIT= 2 ;DEVICE CAN DO INPUT ALMODE= 1 ;ASCII LINE MODE .IOASC= 0 ;ASCII MODE IO.EOF= 1B22 ;EOF BIT IN DEVICE STATUS SUBTTL OPDEFS OPDEF CALL [PUSHJ %17,] OPDEF RETURN [POPJ %17,] OPDEF SPUSH [PUSH %17,] OPDEF SPOP [POP %17,] OPDEF RESET [CALLI 0] OPDEF DEVCHR [CALLI 4] OPDEF CORE [CALLI 11] OPDEF EXIT [CALLI 12] OPDEF DATE [CALLI 14] OPDEF APRENB [CALLI 16] OPDEF MSTIME [CALLI 23] OPDEF RUNTIM [CALLI 27] OPDEF ZBINK [CLOSE BIN,] OPDEF OUTCHR [TTCALL 1,] OPDEF OUTSTR [TTCALL 3,] OPDEF INCHWL [TTCALL 4,] DEFINE GENM40 (A,B,C,D,E,F) ;GEN MOD 40 < XWD $'A*50*50+$'B*50+$'C , $'D*50*50+$'E*50+$'F > SUBTTL UUO HANDLERS DEFINE UUODEF (NAME,SUBR) < XLIST OPDEF NAME [<.-UUOTBL>B8] Z SUBR LIST > UUOTBL: ;UUO TRANSFER TABLE 0 ;ZERO IS ILLEGAL UUODEF DEVSET, DEVSE0 ;DEVICE INITIALIZATION UUODEF FERROR, FERRO0 ;FATAL ERROR UUODEF LSTSTR, LSTST0 ;LIST ASCIZ STRING UUODEF LSTMSG, LSTMS0 ;LIST ASCIZ MESSAGE UUODEF DNC, DNC0 ;DECIMAL NUMBER CONVERSION UUODEF LSTSYM, LSTSY0 ;LIST SYMBOL OPDEF LSTSIX [LSTSYM 2,] UUODEF LSTICH, LSTIC0 ;LIST IMMEDIATE CHARACTER UUODEF SETLCT, SETLC0 ;SET LCTST ; UUODEF TSTLCT, TSTLC0 ;SKIP IF ARG NOT SET IN LCFLGS ; UUODEF TSTEDT, TSTED0 ;SKIP IF NOT SET UUODEF WCIMT, WCIMT0 ;WRITE CHARACTER IN MACRO TREE ; UUODEF ERRSET, ERRSE0 ;SET ERROR FLAG (%15 RH) ; UUODEF ERRSKP, ERRSK0 ;DITTO, AND SKIP UUODEF ERRXIT, ERRXI0 ;DITTO, AND EXIT OPDEF SKPLCR [TLNE %12,] ;REPLACES TSTLCT OPDEF SKPLCS [TLNN %12,] ;SKIP IF LISTING CONTROL SET OPDEF SKPEDR [TRNE %12,] ;REPLACES TSTEDT OPDEF SKPEDS [TRNN %12,] ;SKIP IF ENABLE SET OPDEF ERRSET [TRO %15,] OPDEF ERRSKP [TROA %15,] BLOCK 40+UUOTBL-. ;ZERO REMAINDER OF TABLE UUOPRO: ;UUO PROCESSOR SPUSH %02 ;STACK WORK REGISTER LDB %02,[POINT 9,JOBUUO,8] ;GET INDEX SKIPN %02,UUOTBL(%02) ;FETCH VECTOR, NULL? HALT . ; YES, ERROR EXCH %02,0(%17) ;NO, SET VECTOR AND RESTORE REG RETURN ; "CALL" THE ROUTINE SUBTTL EXEC INITIALIZATION COLD: ;INITIAL ENTRY POINT SETZM RSXSW ;ENABLE RSX DEFAULTS HLLZS %16 ;CLEAR RH %16 START: SETZM CCLTOP ;CLEAR CCL POINTER NXTCCL: RESET SKIPE %03,CCLTOP ;CCL IN PROGRESS? HRRZM %03,JOBFF ; YES MOVE 0,JOBFF ;GET FIRST FREE ADDI 0,200*NUMBUF*2+200+200 ;MAKE ROOM FOR BUFFERS, ETC. CORE 0, ;SET CORE HALT . ; DIDN'T MAKE IT MOVSI %17,-%17 SETZM %00(%17) AOBJN %17,.-1 TLO %12,LCFDEF ;SET DEFAULT LISTING FLAGS IFDEF XREL, HRLI %16,BINBIT!LSTBIT!CRFBIT ;INIT "EXEC" FLAG REGISTER MOVE %17,[IOWD PDPLEN,PDPSTK] ;BASIC PDP MOVSI %03,- SETZM BZCOR(%03) ;CLEAR VARIABLES AOBJN %03,.-1 MOVE 0,[CALL UUOPRO] MOVEM 0,JOB41 ;SET UUO TRAP MOVEI 0,ERR.X MOVEM 0,ERRSUP ;DEFAULT DISABLE OF "X" FLAG CALL SETSYM SETZM 0 RUNTIM 0, ;GET CURRENT RUN TIME, MOVEM 0,RUNTIM DATE 0, ; AND DATE, MOVEM 0,DATE MSTIME 0, ; AND TIME MOVEM 0,MSTIME TLZ %16,GBLDIS SUBTTL SWITCH.INI PROCESSING MOVE %02,[XWD SWIOPN,LSWOPN] BLT %02,LSWOPN+2 MOVE %02,[XWD SWILOO,LSWLOO] BLT %02,LSWLOO+3 OPEN SWI,LSWOPN ;INITIALIZE CHANNEL HALT . LOOKUP SWI,LSWLOO ;OPEN FILE JRST SWIEND ;SWITCH.INI NOT PRESENT INBUF SWI,1 ;SET UP THE RING WITH ONLY ONE BUFFER CALL SWIRD ;GET FIRST BUFFERFUL JRST SWIEND ;...MUST HAVE BEEN EMPTY MOVE %02,SWIBUF+2 ;COLLECT BYTE COUNT SWINB: ;LOOK FOR NON-BLANKS CALL SWICHR ;GET A CHARCTER JRST SWIEND ;ALL DONE CAIE %14,SPACE CAIN %14,TAB JRST SWINB ;BYPASS THIS BLANK-TYPE CHARACTER MOVSI %01,-6 ;SET UP COUNTER JRST .+3 ;BYPASS FIRST COLLECTION SWICMP: ;COMPARE SYMBOL WITH "MACY11" CALL SWICHR JRST SWIEND CAME %14,NMTABL(%01) JRST SWIEOL ;NO GOOD. GO TO END OF LINE. AOBJN %01,SWICMP ;BACK FOR MORE(PERHAPS) ;MATCHED! MOVE %06,[POINT 7,SWIBYT] ;PREPARE TO FILL INTERMED. BUFFER SWIMOV: ;FILL INTERMEDIATE BUFFER CALL SWICHR ;GET ONE JRST SWIGET CAIN %14,CRR ;END OF LINE? JRST SWIGET ;YES CAIN %14,"-" ;HYPHEN? JRST SWICON ;YES...ASSUME CONTINUATION IDPB %14,%06 ;ELSE, PUT THE CHARACTER INTO THE BUFFER JRST SWIMOV ;CONTINUE SWICON: ;PROCESS LINE CONTINUATION CALL SWICHR JRST SWIERR ;PROBLEMS... CAIE %14,CRR ;EOL YET? JRST SWICON ;NO CALL SWICHR ;CHECK FOR PRESENCE OF LINE FEED CAIA ;THIS IS THE ERROR RETURN CAIE %14,LF ;SKIP IF LINE FEED JRST SWIERR ;CRAP OUT JRST SWIMOV ;BACK FOR CONTINUATION LINE SWIGET: SETZ %14, IDPB %14,%06 MOVE %13,[POINT 7,SWIBYT,6] ;FAKE UP AC13 FOR GETNB, ET.AL. CALL SETNB CAIE %14,"/" ;FIRST CHARACTER A SLASH? JRST SWIERR ;NO. CALL SSWPRO ;GO PROCESS SWITCHES SWIEND: CLOSE SWI, OUTSTR [BYTE (7) CRR,LF,0] JRST START0 SWIERR: ;ERROR IN SWITCH.INI OUTSTR [BYTE (7) CRR,LF,0] OUTSTR [ASCIZ /? ERROR IN SWITCH.INI FILE/] OUTSTR [BYTE (7) CRR,LF,0] ;[w1] CALL JOBOFF## EXIT ;SUBROUTINES SWIRD: ;GET A BUFFERFUL OF DATA IN SWI, ;GET IT JRST CPOPJ1 ;GOOD...TAKE SKIP RETURN STATO SWI,IO.EOF ;WAS IT AN END OF FILE? OUTSTR [ASCIZ /ERROR IN READING SWITCH.INI/] RETURN ;TAKE NORMAL RETURN SWICHR: ;GET A SINGLE CHARACTER IN AC14 SOJL %02,SWCHR2 ;JUMP ON END-OF-FILE IBP SWIBUF+1 ;INCREMENT INPUT BYTE POINTER MOVE %14,@SWIBUF+1 ;GET ENTIRE WORD TRNE %14,1 ;LINE NUMBER? JRST SWICH1 ;YES LDB %14,SWIBUF+1 ;GET THE CHARACTER CAIL %14,"A"+40 ;LOWER-CASE? CAILE %14,"Z"+40 ;...? CAIA ;NO SUBI %14,40 ;CONVERT TO UPPER CASE JRST CPOPJ1 ;TAKE SKIP-RETURN SWICH1: ;LINE SEQ NUMBER AOS SWIBUF+1 ;INCREMENT POINTER AROUND LSN SUBI %02,5 ;DECREMENT COUNTER JUMPGE %02,SWICHR ;IF COUNT OK, BACK FOR MORE ;ELSE, FALL INTO COLLECTION OF ANOTHER LOAD SWCHR2: CALL SWIRD ;GET ANOTHER LOAD RETURN ;TERMINAL RETURN MOVE %02,SWIBUF+2 ;GET BYTE COUNT JRST SWICHR ;BACK FOR MORE ;LOOK FOR END OF LINE SWEOL0: CALL SWICHR JRST SWIEND SWIEOL: CAIE %14,LF ;LINE FEED? JRST SWEOL0 ;NO JRST SWINB ;NEW LINE AT LAST ;DATA AREAS NMTABL: ASCNAM ;NAME TO MATCH SWIOPN: EXP .IOASC ;ASCII MODE SIXBIT /DSK/ ;DEVICE XWD 0,SWIBUF SWILOO: SIXBIT /SWITCH/ SIXBIT /INI/ EXP 0 XWD 0,0 ;USE CURRENT PPN .LOC LSWOPN: BLOCK 3 LSWLOO: BLOCK 4 SWIBUF: BLOCK 3 ;BUFFER HEADER SWIBYT: BLOCK ^D29 ;INTERMEDIATE BUFFER FOR MACY11 LINE .RELOC SUBTTL CONTINUATION OF OPENING FESTIVITIES START0: ;[w1] CALL JOBOFF## SKIPN CCLTOP OUTCHR ["*"] ;AWAKEN THE USER ;[w1] CALL JOBON## MOVE %13,JOBFF HLL %13,ASCBYT MOVEM %13,TTIBEG START1: CALL CCLGET ;GET A TTI CHAR CAIE %14,SPACE CAIN %14,TAB JRST START1 ;IGNORE BLANKS CAIL %14,"A"+40 ;UPPER CASE? CAILE %14,"Z"+40 CAIA SUBI %14,40 ; YES, CONVERT TO UPPER CAIN %14,CRR JRST START1 ;DITTO FOR CR'S CAIE %14,LF ;IF LINE FEED CAIN %14,ALTMOD ; OR ALTMODE, MOVEI %14,0 ;SET END OF ENTRY DPB %14,%13 IBP %13 JUMPN %14,START1 ADDI %13,1 HRRZM %13,JOBFF MOVE %13,TTIBEG SETCHR ;SET THE FIRST CHAR JUMPE %14,NXTCCL ;RESTART IF NOTHING TO PROCESS CALL GETBIN ;INIT THE BINARY CAIE %14,"," ;ANOTHER FIELD? JRST START2 ; NO GETCHR ;YES, BYPASS COMMA CALL GETLST ;INIT THE LISTING FILE START2: MOVE %03,SYSDEV MOVEM %03,DEVNAM DEVSET MAC,1 XWD 0,MACBUF MOVE %03,JOBFF MOVEM %03,JOBFFM INBUF MAC,NUMBUF CAIE %14,"_" ;TEST FOR LEGAL SEPARATOR CAIN %14,"<" ;> MOVEI %14,"=" CAIE %14,"=" FERROR [ASCIZ /NO _ SEEN/] ;FATAL ERROR MOVEM %13,TTISAV ;SAVE FOR PASS2 RESCAN HLLZM %12,LCFLGS MOVE %03,[XWD LCBLK,LCSAVE] BLT %03,LCSAVE+LCLEN-1 ;SAVE LISTING FLAGS HRRZM %12,EDFLGS MOVE %03,[XWD EDBLK,EDSAVE] BLT %03,EDSAVE+EDLEN-1 ; AND ENABLE/DISABLE FLAGS MOVE %03,JOBFF MOVEM %03,CRFBAS CALL ACEXCH ;GET USER AC'S SKIPE CCLTOP DEFOUT SKIPN CCLTOP OUTSTR [BYTE (7) CRR,LF,0] ;CONFIRM ALL'S WELL CALL ASSEMB ;CALL THE ASSEMBLER SETZM %03 RUNTIM %03, MOVEM %03,RUNTIM+2 TLNN %16,LSTBIT CALL SYMTB SETZM %03 RUNTIM %03, MOVEM %03,RUNTIM+3 CALL ACEXCH ;GET EXEC AC'S SKPINC ;RESET POSSIBLE ^O JFCL CALL LSTCR ;LIST A CR/LF SPUSH %16 SKIPN ERRCNT SKIPN CCLTOP TLO %16,ERRBIT ;MESSAGE TO LPT AND TTY TLZ %16,NSWBIT ;CLEAR /N CALL LSTCR SKIPE %11,ERRCNT ;ANY ERRORS? LSTICH "?" ; YES, FLAG THE LISTING LSTMSG [ASCIZ / ERRORS DETECTED: 5/] SKIPE %11,ERRCNT+1 ;ANY NON-FATAL ERRORS? LSTMSG [ASCIZ -/5-] ; YES SKIPE %11,DGCNT ;ANY DEFAULT GLOBALS? LSTMSG [ASCIZ / DEFAULT GLOBALS GENERATED: 5/];GUESS SO LSTMSG [ASCIZ /00/] SPOP %00 TLNE %00,NSWBIT ;WAS /N SET? TLO %16,NSWBIT ; YES, RE-SET IT SETZM STLBUF LSTICH SPACE LSTICH "*" LSTSTR @TTIBEG LSTMSG [ASCIZ /0 RUN-TIME: /] MOVSI %01,-3 START4: MOVE %03,RUNTIM+1(%01) SUB %03,RUNTIM(%01) IDIVI %03,^D1000 DNC %03 LSTICH SPACE AOBJN %01,START4 SKIPN %11,TIMCNT JRST START5 LSTMSG [ASCIZ /(5-/] MOVE %03,TIMTIM IDIVI %03,^D1000 MOVE %11,%03 LSTMSG [ASCIZ /5) /] START5: LSTMSG [ASCIZ /SECONDS0/] HRRZ %11,JOBREL ;GET TOP OF COR ASH %11,-^D10 ;CONVERT TO "K" ADDI %11,1 ;BE HONEST ABOUT IT LSTMSG [ASCIZ / CORE USED: 5K0/] SKPEDS ED.WRP JRST START6 MOVE %03,WRPCNT+1 IMULI %03,^D100 IDIV %03,WRPCNT MOVE %11,%03 LSTMSG [ASCIZ / WRAP-AROUND: 5%0/] START6: CALL LSTCR ;FALL INTO THE NEXT PAGE... EXIT: TLNE %16,MODBIT ;EXEC MODE? CALL ACEXCH ; NO, GET AC'S CLOSE LST, ;CLOSE THE LISTING FILE CLOSE BIN, ;CLOSE THE BINARY FILE TLON %16,LSTBIT ;WAS THERE A LISTING FILE? CALL LSTTST ;YES, TEST FOR FINAL ERROR TLON %16,BINBIT ;IS THERE A BINARY FILE? CALL BINTST ;YES, TEST FOR FINAL ERROR TDZE %14,%14 ;END OF COMMAND STRING? FERROR [ASCIZ /NOT ALL INPUT FILES PROCESSED/] ; NO JRST NXTCCL ;RESTART FERRO0: ; "FERROR" UUO TRZE %16,RSXBIT ;NON-RSX DEFAULTS FRESHLY ENABLED? JRST START ;YES. IT'S OK... PUSH %17,JOBUUO ;SAVE ARG TLNE %16,MODBIT CALL ACEXCH ;SET EXEC AC'S HRLI %16,ERRBIT!LSTBIT!BINBIT!CRFBIT ;FUDGE FLAGS LSTMSG [ASCIZ /0? /] LSTMSG @0(%17) ;OUTPUT BASIC MESSAGE LSTMSG [ASCIZ /00*/] MOVEI %03,0 DPB %03,%13 LSTSTR @TTIBEG LSTICH "?" LSTMSG [ASCIZ /00/] ;TWO CR/LF'S JRST START .LOC RUNTIM: BLOCK 4 DATE: BLOCK 1 MSTIME: BLOCK 1 ERRCNT: BLOCK 2 DGCNT: BLOCK 1 ;NUMBER OF DEFAULT GLOBALS GENERATED .RELOC TIMTST: JFCL CAIA AOS 0(%17) SPOP TIMTMP SPUSH %02 SETZM %02 RUNTIM %02, EXCH %02,0(%17) CALL @TIMTMP CAIA AOS -1(%17) EXCH %02,-1(%17) MOVEM %02,TIMTMP SETZM %02 RUNTIM %02, SUB %02,0(%17) ADDM %02,TIMTIM AOS TIMCNT SPOP %02 SPOP %02 JRST @TIMTMP .LOC TIMTIM: BLOCK 1 TIMCNT: BLOCK 1 TIMTMP: BLOCK 1 .RELOC SUBTTL FILE INITIALIZATION GETBIN: ;GET BINARY FILE MOVE %03,SYSDEV MOVEM %03,DEVNAM ;SET DEFAULT DEVICE CALL CSIFLD ;GET THIS FIELD RETURN ; NO, EXIT CAIN %14,"@" ;CCL? JRST CCLSET ; YES DEVSET BIN,10 ;INIT IMAGE MODE XWD BINBUF,0 ;ARG OUTBUF BIN,NUMBUF ;BUMP JOBFF MOVE %03,[XWD DEVNAM,BINBLK] BLT %03,BINBLK+4 ;SAVE NAME FOR LATER ENTER TLZ %16,BINBIT ;INDICATE GOOD BINARY FILE RETURN SETBIN: ;SET BIN (END OF PASS 1) TLNE %16,BINBIT ;ANY BINARY? RETURN ; NO, EXIT CALL ACEXCH ;YES, GET EXEC AC'S MOVS %03,[XWD DEVNAM,BINBLK] BLT %03,DEVNAM+4 ;SET UP BLOCK SKIPE %03,FILEXT ;EXPLICIT EXTENSION? JRST SETBI1 ; YES MOVSI %03,(SIXBIT /OBJ/) SKPEDR ED.ABS ;ABS MODE? MOVSI %03,(SIXBIT /BIN/) ; YES SETBI1: HLLZM %03,FILEXT ;SET IN LOOKUP BLOCK ENTER BIN,FILNAM ;ENTER FILE NAME IN DIRECTORY FERROR [ASCIZ /NO ROOM FOR 3/] ; FULL JRST ACEXCH ;TOGGLE AC'S AND EXIT GETLST: ;GET LISTING FILE MOVE %03,SYSDEV MOVEM %03,DEVNAM ;SET DEFAULT DEVICE CALL CSIFLD ;GET THIS FIELD RETURN ; NO, EXIT DEVSET LST,1 ;INIT ASCII MODE XWD LSTBUF,0 OUTBUF LST,NUMBUF SKIPN %03,FILEXT ;EXPLICIT EXTENSION? MOVSI %03,(SIXBIT /LST/) ; NO, SUPPLY ONE HLLZM %03,FILEXT ENTER LST,FILNAM FERROR [ASCIZ /NO ROOM FOR 3/] ; FULL MOVE %00,DEVNAM DEVCHR %00, ;GET DEVICE CHARACTERISTICS MOVEI %03,LC.TTM TLNE %00,TTYDEV ;IS DEVICE TELETYPE? TLOA %16,TTYBIT ; YES, FLAG AND SKIP TDNE %03,LCMSK ;NO, TTM SEEN? CAIA TLO %12,0(%03) ;NO, SUPPRESS TELETYPE MODE TLZ %16,LSTBIT ;INDICATE A GOOD LISTING FILE JRST LPTINI ;INIT LINE OUTPUT AND EXIT SETCRF: TLNE %16,LSTBIT!CRFBIT RETURN CALL ACEXCH CALL GETCOR MOVE %03,SYSDEV MOVEM %03,DEVNAM DEVSET CRF,10 XWD CRFBUF,0 OUTBUF CRF, MOVEI %00,3 PJOB %02, SETCR1: IDIVI %02,^D10 ADDI %03,"0"-40 LSHC %03,-6 SOJG %00,SETCR1 HRRI %04,(SIXBIT /CRF/) MOVEM %04,CRFNAM MOVEM %04,FILNAM MOVSI %03,(SIXBIT /TMP/) MOVEM %03,FILEXT SETZM FILPPN ENTER CRF,FILNAM FERROR [ASCIZ /NO ROOM FOR 3/] JRST ACEXCH SETSRC: ;SET FOR SOURCE SCAN (EACH PASS) CALL ACEXCH ;GET EXEC AC'S SETZM %03 RUNTIM %03, MOVEM %03,RUNTIM+1 MOVE %13,TTISAV ;SET CHAR POINTER SETCHR ;SET THE FIRST CHARACTER MOVE %03,SYSDEV MOVEM %03,DEVNAM ;SET DEFAULT DEVICE NAME SETZM PPNSAV ;CLEAR PROJECT-PROGRAMMER NUMBER SETZM LINNUM ;CLEAR SEQUENCE NUMBER SETZM LINNUB ; AND ITS BACKUP TLNE %16,SOLBIT ;SEQUENCE OUTPUT LINES? AOS LINNUM ; YES, PRESET MOVS %03,[XWD LCBLK,LCSAVE] BLT %03,LCBLK+LCLEN-1 ;RESTORE LC FLAGS HLL %12,LCFLGS MOVS %03,[XWD EDBLK,EDSAVE] BLT %03,EDBLK+EDLEN-1 ; AND ENABLE/DISABLE FLAGS HRR %12,EDFLGS CALL GETSRC ;PROCESS FIRST FIELD JRST ACEXCH ;EXCHANGE AC'S AND EXIT GETSRC: ;GET A SOURCE FILE GETCHR ;BYPASS DELIMITER CALL CSIFLD ;GET THE FIELD FERROR [ASCIZ /NULL SOURCE FIELD/] ; NO DEVSET SRC,1 ;INIT DEVICE XWD 0,SRCBUF MOVEI %03,JOBFFS EXCH %03,JOBFF ;SET TO TOP OF INPUT BUFFER INBUF SRC,NUMBUF MOVEM %03,JOBFF ;RESTORE JOBFF MOVE %00,DEVNAM DEVCHR %00, TLNN %00,TTYDEV JRST GETSR3 OUTSTR [BYTE (7) 15,12] SKPINC ;TYPED AHEAD? CAIA ; NO JRST GETSR3 ;YES, NO MESSAGE OUTSTR [ASCIZ /READY/] OUTSTR [BYTE (7) 15,12] GETSR3: SKIPE %03,FILEXT ;EXPLICIT EXTENSION? JRST GETSR1 ; YES MOVSI %03,(SIXBIT /P11/) CALL GETSR2 ; NO, TRY .P11 FIRST RETURN ; MADE IT MOVSI %03,(SIXBIT /PAL/) CALL GETSR2 ; NO, TRY .PAL NEXT RETURN ; MADE IT SETZM %03 CALL GETSR2 ;TRY NULL EXTENSION RETURN ; OK, EXIT MOVSI %03,(SIXBIT /MAC/) CALL GETSR2 ;TRY .MAC NEXT RETURN MOVSI %03,(SIXBIT /M11/) GETSR1: CALL GETSR2 ; NO, TRY .M11 NEXT RETURN ; MADE IT ;NO DICE FERROR [ASCIZ /CANNOT FIND 3/] GETSR2: HLLZM %03,FILEXT ;SAVE EXTENSION IN LOOKUP BLOCK LOOKUP SRC,FILNAM ;LOOKUP FILE NAME JRST CPOPJ1 ; NOT FOUND, SKIP-RETURN MOVE %03,[XWD FILNAM,SRCSAV] BLT %03,SRCSAV+1 RETURN ;EXIT CCLSET: ;SET CCL INPUT SKIPE CCLTOP FERROR [ASCIZ /NESTED CCL'S/] MOVE %00,DEVNAM DEVCHR %00, TDC %00,[XWD 2,2] TDNE %00,[XWD 2,2] ;LEGIT FILE? FERROR [ASCIZ /DEVICE INPUT ERROR FOR COMMAND STRING/] DEVSET CCL,1 ;YES, INIT XWD 0,SRCBUF ;BORROW SOURCE BUFFER SKIPE %03,FILEXT ;EXPLICIT EXTENSION? JRST CCLSE1 ; YES MOVSI %03,(SIXBIT /CCL/) ;TRY THE DEFAULT HLLZM %03,FILEXT LOOKUP CCL,FILNAM TDZA %03,%03 ; MISSED JRST CCLSE2 ;OK CCLSE1: HLLZM %03,FILEXT LOOKUP CCL,FILNAM FERROR [ASCIZ /CANNOT FIND 3/] ;MISSED COMPLETELY CCLSE2: MOVE %01,JOBFF ;GET CURRENT FIRST FREE HRLI %01,(POINT 7,,) ;FORM BYTE POINTER MOVEM %01,CCLPNT ;SAVE IT MOVEI %03,JOBFFS ;SET TO READ INTO SOURCE BUFFER MOVEM %03,JOBFF INBUF CCL,NUMBUF SETZM %15 ;CLEAR ERROR FLAG CCLSE3: CALL CHAR ;GET A CHARACTER TLZE %15,ENDFLG ;END? JRST CCLSE4 ; YES TRZE %15,-1 ;NO, GOOD CHARACTER? JRST CCLSE3 ;NO, GET ANOTHER HRRZ %06,%01 ;COLLECT RIGHT HALF OF BYTE POINTER CAML %06,.JBREL ;COMPARE IT TO LAST FREE CORE ADDR FERROR [ASCIZ /CCL FILE TOO LARGE/]; IDPB %14,%01 ;STORE THE CHAR JRST CCLSE3 ;BACK FOR MORE CCLSE4: SETZM %14 IDPB %14,%01 ;STORE TERMINATOR AOS %01 HRRZM %01,CCLTOP ;SET TOP POINTER JRST NXTCCL CCLGET: ;GET A CCL CHAR SKIPN CCLTOP ;ANY CCL? JRST CCLGE1 ; NO ILDB %14,CCLPNT ;YES, GET A CHAR JUMPN %14,CPOPJ ;EXIT IF NON-NULL EXIT ; FINIS CCLGE1: INCHWL %14 ;GET A TTY CHAR RETURN DEVSE0: ; "DEVSET" UUO MOVE %03,JOBUUO HRRZM %03,DEVBLK ;SET MODE MOVE %04,DEVNAM MOVEM %04,DEVBLK+1 ;XFER NAME MOVE %04,@0(%17) ;FETCH ARG (BUFFER ADDRESS) MOVEM %04,DEVBLK+2 AND %03,[Z 17,] ;MASK TO AC FIELD IOR %03,[OPEN DEVBLK] ;FORM UUO XCT %03 FERROR [ASCIZ /CANNOT ENTER 3/] ;MISSED CALL SWPRO ;PROCESS SWITCHES CPOPJ1: AOS 0(%17) ;BYPASS ARG CPOPJ: RETURN .LOC ;FILE INITIALIZATION VARIABLES DEVBLK: BLOCK 3 ;"OPEN" BLOCK ;FOLLOWING 5 MUST BE KEPT TOGETHEI DEVNAM: BLOCK 1 ;DEVICE NAME FILNAM: BLOCK 1 ;FILE NAME FILEXT: BLOCK 1 ;EXTENSION BLOCK 1 FILPPN: BLOCK 1 ;PROJECT-PROGRAMMER NUMBER BINBLK: BLOCK 5 ;STORAGE FOR ABOVE BINBUF: BLOCK 1 ;BINARY BLOCK HEADER BINPNT: BLOCK 1 BINCNT: BLOCK 1 BINPCT: BLOCK 1 LSTBUF: BLOCK 1 LSTPNT: BLOCK 1 LSTCNT: BLOCK 1 CRFBUF: BLOCK 1 CRFPNT: BLOCK 1 CRFCNT: BLOCK 1 SRCBUF: BLOCK 1 SRCPNT: BLOCK 1 SRCCNT: BLOCK 1 SRCSAV: BLOCK 2 TTIBEG: BLOCK 1 ;BEGINNING OF TTY BUFFER TTISAV: BLOCK 1 ;TELETYPE POINTER SAVE PPNSAV: BLOCK 1 ;PPN STORAGE CRFBAS: BLOCK 1 JOBFFS: BLOCK 204*NUMBUF ;SOURCE BUFFER .RELOC SUBTTL COMMAND STRING FIELD SCANNER CSIFLD: ;PROCESS CLMMAND SCANNER FIELD TLZ %16,INFBIT ;CLEAR INFO BIT CALL CSISYM ;TRY FOR A SYMBOL CAIE %14,":" ;DEVICE? JRST CSIFL1 ; NO MOVEM %00,DEVNAM ;YES, STORE IT GETCHR ;BYPASS COLON CALL CSISYM ;GET ANOTHER SYMBOL CSIFL1: MOVEM %00,FILNAM ;ASSUME FILE NAME SETZM FILEXT ;CLEAR EXTENSION CAIE %14,"." ;EXPLICIT ONE? JRST CSIFL2 ; YES GETCHR ;BYPASS PERIOD CALL CSISYM ;GET EXTENSION HLLOM %00,FILEXT ;STUFF IT CSIFL2: CAIE %14,"[" ;PPN? JRST CSIFL6 ; NO SETZM PPNSAV ;CLEAR CELL CSIFL3: HRLZS PPNSAV ;MOVE RH TO LH CSIFL4: GETCHR ;GET THE NEXT CHAR CAIN %14,"]" ;FINISHED? JRST CSIFL5 ; YES CAIN %14,"," ;SEPARATOR? JRST CSIFL3 ; YES CAIL %14,"0" ;TEST FOR OCTAL NUMBER CAILE %14,"7" FERROR [ASCIZ /ILLEGAL PPN/] HRRZ %03,PPNSAV ;MERGE NEW CHAR IMULI %03,8 ADDI %03,-"0"(%14) HRRM %03,PPNSAV JRST CSIFL4 ;LOOP CSIFL5: GETCHR CSIFL6: MOVE %03,PPNSAV MOVEM %03,FILPPN ;SAVE BACKGROUND PPN TLNE %16,INFBIT ;ANYTHING PROCESSED? JRST CPOPJ1 ; YES, SKIP-EXIT JRST SWPRO ;NO, BE SURE TO PROCESS SWITCHES CSISYM: ;COMMAND SCANNER SYMBOL CALL GETSYM ;GET ONE IN RAD50 JUMPE %00,CPOPJ ;EXIT IF NULL TLO %16,INFBIT ;OK, SET INFO BIT JRST M40SIX ;CONVERT TO SIXBIT SSWPRO: ;SPECIAL ENTRY POINT FOR SWITCH.INI PROCESSING SETOM SWPENT ;SIGNAL SOURCE OF CALL CAIA SWPRO: ;SWITCH PROCESSOR SETZM SWPENT ;SIGNAL NORMAL ENTRY CAIE %14,"/" ;SWITCH? RETURN ; NO, EXIT CALL GETNB ;YES, BYPASS SLASH CALL CSISYM ;GET THE SYMBOL MOVSI %03,- ;SET FOR TABLE SCAN AOBJN %03,.+1 CAME %00,SWPRT-1(%03) ;COMPARE AOBJN %03,.-2 ; NO JUMPG %03,SWPRO1 ;MISSED, ERROR SETZM ARGCNT ;CLEAR ARGUMENT COUNT XCT SWPRT(%03) TRZN %15,-1 ;SKIP IF ERRORS ENCOUNTERED JRST SWPRO ;TRY FOR MORE SWPRO1: SKIPN SWPENT ;SWITCH.INI? FERROR [ASCIZ /BAD SWITCH/] ;NO. ABORT NORMALLY JRST SWIERR DEFINE GENSWT (MNE,ACTION) ;GENERATE SWITCH TABLE < XLIST SIXBIT /MNE/ ACTION LIST > SWPRT: ;SWITCH PROCESSOR TABLE GENSWT LI, GENSWT NL, GENSWT EN, GENSWT DS, GENSWT CRF, GENSWT N, GENSWT I, GENSWT P, GENSWT GNS, GENSWT SOL, GENSWT CDR, GENSWT EQ, GENSWT NSQ, GENSWT RSX, SWPRTE: RSX: ;ACTIVATE RSX OPTIONS SETOM RSXSW ;SET RSX SWITCH NON-ZERO TRO %16,RSXBIT RETURN SWPGNS: TLO %16,FMTBIT ;SET FLAG MOVEI %03,LC.SEQ!LC.LOC!LC.BIN!LC.BEX!LC.ME!LC.TOC TLO %12,0(%03) ;SUPPRESS SELECTED FLAGS IORM %03,LCMSK ;ALSO RESTRICT SOURCE OVER-RIDES RETURN PROEQ: CALL GSARG RETURN CALL SSRCH JFCL TLON %01,DEFSYM TRZ %01,177777 CALL INSRT JRST PROEQ PRONSQ: SETZM P10SEQ SETOM P10SEQ+1 RETURN .LOC SWPENT: BLOCK 1 ;NON-ZERO IN SWPRO IF ENTERED FROM ;SWITCH.INI PROCESSING .RELOC SUBTTL HEADER ROUTINE HEADER: CALL ACEXCH ;YES, SAVE THE ACCUMULATORS SPUSH %16 ;SAVE CURRENT FLAGS TLO %16,NSWBIT ;DON'T OUTPUT TO TTY MOVEI %02,FF ;GET A FORM FEED CALL LSTDMP ;OUTPUT IT MOVEI %03,PAGSIZ+3 ;RESET LINE COUNTER REGISTER MOVEM %03,LPPCNT MOVN %11,COLCNT ;GET COLUMNS PER LINE SUBI %11,8*5+3 ;LEAVE ROOM FOR DATE, ETC. MOVE %01,[POINT 7,TTLBUF] TDZA %10,%10 ;ZERO COUNT HEADE3: CALL LSTOUT ILDB %02,%01 ;FETCH CHAR FROM BUFFER CAIN %02,TAB ;TAB? IORI %10,7 ; YES, FUDGE ADDI %10,1 CAMGE %10,%11 JUMPN %02,HEADE3 CALL LSTTAB LSTSTR TITLE CALL LST2SP ;THE FOLLOWING SECTION PRINTS THE DATE, WHICH IS FOUND IN ;REGISTER XDATE IN THE FORM ; ((Y-1964)*12 + (M-1))*31 + (D-1) MOVE %10,DATE ;GET THE DATE IN %10 IDIVI %10,^D31 ;DIVIDE BY 31 DECIMIAL ADDI %11,1 DNC %11 ;OUTPUT DAY IDIVI %10,^D12 ;DIVIDE BY 12 DECIMAL LSTSIX MONTH(%11) MOVEI %11,^D64(%10) ;GET THE YEAR DNC %11 CALL LST2SP ;OUTPUT TAB MOVE %03,MSTIME ;GET THE CURRENT TIME IDIVI %03,^D60*^D1000 ;NUMBER OF MIN. SINCE MIDNITE IDIVI %03,^D60 ;NUMBER OF HOURS SPUSH %04 ;SAVE MINUTES CAIG %03,9 LSTICH "0" DNC %03 ;OUTPUT THE HOURS LSTICH ":" ;OUTPUT A COLON AFTER THE HOURS SPOP %11 ;PUT MINUTES IN OUTPUT AC CAIG %11,^D9 ;IS IT A ONE-DIGIT NUMBER? LSTICH "0" ;YES, OUTPUT A ZERO DNC %11 ;OUTPUT THE MINUTES TLNE %15,P1F JRST HEADE1 MOVE %11,PAGNUM ;GET PAGE NUMBER LSTMSG [ASCIZ / PAGE 5/] AOSE %11,PAGEXT ;INCREMENT, PICK UP, AND TEST LSTMSG [ASCIZ /-5/] HEADE1: CALL LSTCR TLNN %16,SOLBIT ;SEQUENCE OUTPUT? JRST HEADE2 AOS PAGNUM ; YES, BUMP COUNT SETOM PAGEXT HEADE2: LSTSIX SRCSAV HLLZ %00,SRCSAV+1 JUMPE %00,.+3 LSTICH "." LSTSIX %00 CALL LSTTAB LSTSTR STLBUF ;LIST SUB-TITLE CALL LSTCR CALL LSTCR SPOP %02 ;RESTORE FLAGS TLNN %02,NSWBIT TLZ %16,NSWBIT JRST ACEXCH ;RESTORE F4 REGS AND EXIT MONTH: SIXBIT /-JAN-/ SIXBIT /-FEB-/ SIXBIT /-MAR-/ SIXBIT /-APR-/ SIXBIT /-MAY-/ SIXBIT /-JUN-/ SIXBIT /-JUL-/ SIXBIT /-AUG-/ SIXBIT /-SEP-/ SIXBIT /-OCT-/ SIXBIT /-NOV-/ SIXBIT /-DEC-/ .LOC PAGNUM: BLOCK 1 ;PAGE NUMBER PAGEXT: BLOCK 1 ;PAGE EXTENSION .RELOC SUBTTL AC EXCHANGE LOOP ACEXCH: ;SWAP AC'S TLC %16,MODBIT ;TOGGLE MODE BIT EXCH %00,AC00 EXCH %01,AC01 EXCH %02,AC02 EXCH %03,AC03 EXCH %04,AC04 EXCH %05,AC05 EXCH %06,AC06 EXCH %07,AC07 EXCH %10,AC10 EXCH %11,AC11 ; EXCH %12,AC12 EXCH %13,AC13 EXCH %14,AC14 RETURN .LOC AC00: BLOCK 1 AC01: BLOCK 1 AC02: BLOCK 1 AC03: BLOCK 1 AC04: BLOCK 1 AC05: BLOCK 1 AC06: BLOCK 1 AC07: BLOCK 1 AC10: BLOCK 1 AC11: BLOCK 1 AC12: BLOCK 1 AC13: BLOCK 1 AC14: BLOCK 1 .RELOC SUBTTL BINARY OUTPUT ROUTINE BINOUT: ;BINARY OUTPUT SPUSH %02 ANDI %02,377 ;MASK TO 8 BITS ADDM %02,CHKSUM ;UPDATE CHECKSUM TLNN %16,ESWBIT ;EXPANDED LISTING (OCTAL) REQUESTED? JRST BINOU2 ; NO SPUSH %01 ; YES, STACK WORKING REGISTERS SPUSH %02 MOVSI %01,(POINT 3,0(%17),26) ;POINT TO STACKED CODE BINOU1: ILDB %02,%01 ;GET THE NEXT BYTE ADDI %02,"0" ;CONVERT TO ASCII CALL LSTOUT ;LIST IT TLNE %01,770000 ;END? JRST BINOU1 ; NO CALL LSTCR ;YES, LIST CR/LF SPOP %02 ;RESTORE REGISTERS SPOP %01 BINOU2: TLNE %16,BINBIT ;BINARY REQUESTED? JRST BINOU6 ; NO, EXIT TLNN %15,ISWFLG ;PACKED MODE? JRST BINOU3 ; YES SOSG BINCNT CALL BINDMP IDPB %02,BINPNT JRST BINOU6 BINOU3: SOSLE BINPCT JRST BINOU4 CALL BINDMP MOVE %03,BINCNT IMULI %03,4 MOVEM %03,BINPCT BINOU4: MOVN %03,BINPCT ANDI %03,3 JUMPN %03,BINOU5 SOS BINCNT IBP BINPNT BINOU5: DPB %02,BINTBL(%03) BINOU6: SPOP %02 RETURN BINDMP: OUTPUT BIN, BINTST: STATO BIN,IODATA!IODEV!IOWRLK!IOBKTL RETURN FERROR [ASCIZ /BINARY OUTPUT ERROR/] BINTBL: POINT 8,@BINPNT,17 POINT 8,@BINPNT, 9 POINT 8,@BINPNT,35 POINT 8,@BINPNT,27 SUBTTL LISTING OUTPUT LSTST0: TDZA %03,%03 ; "LSTSTR" UUO LSTMS0: SETOM %03 ; "LSTMSG" UUO HLLM %03,0(%17) ;SAVE FLAG MOVEI %10,@JOBUUO ;FETCH ARG TLOA %10,(POINT 7,,) ;SET BYTE POINTER AND SKIP LSTMS1: CALL LSTOUT ;TYPE CHARACTER LSTMS2: ILDB %02,%10 ;GET CHARACTER JUMPE %02,CPOPJ ;TEST FOR END CAIL %02,"0" ;TEST FOR SWITCH CAILE %02,"5" JRST LSTMS1 ;NO, TYPE THE CHARACTER SKIPL 0(%17) ;STRING? JRST LSTMS1 ; YES, PRINT NUMERICS XCT LMT-"0"(%02) ;EXECUTE TABLE JRST LSTMS2 ;GET NEXT CHARACTER LMT: CALL LSTCR ; 0 - CR/LF LSTICH 0(%14) ; 1 - CHARACTER CALL LM2 ; 2 - DEV: CALL LM3 ; 3 - DEV:FILNAM.EXT HALT . DNC %11 ; 5 - DECIMAL NUMBER LM2: LSTSIX DEVNAM LSTICH ":" RETURN LM3: CALL LM2 LSTSIX FILNAM LSTICH "." HLLZ %00,FILEXT LSTSIX %00 RETURN DNC0: ; "DNC" UUO MOVE %03,@JOBUUO ;FETCH ARG LDB %04,[POINT 4,JOBUUO,12] DNC1: SPUSH %04 IDIVI %03,^D10 HRLM %04,-1(%17) SPOP %04 SOS %04 SKIPE %03 CALL DNC1 DNC2: HLRZ %02,0(%17) SOJL %04,LSTNUM LSTICH SPACE JRST DNC2 LSTSY0: ;"LSTSYM" UUO SPUSH %00 ;STACK A COUPLE REGISTERS SPUSH %01 LDB %02,[POINT 4,JOBUUO,12] ;FETCH FLAG DPB %02,[POINT 1,-2(%17),0] MOVE %00,@JOBUUO ;FETCH WORD TRNN %02,2 ;SIXBIT? CALL M40SIX ; NO, CONVERT TO IT MOVSI %01,(POINT 6,%00) LSTSY1: ILDB %02,%01 ;GET THE NEXT CHAR SKIPL -2(%17) ;IF NO FLAG, JUMPE %02,LSTSY2 ; BRANCH ON BLANK ADDI %02,40 ;CONVERT TO ASCII CALL LSTOUT ;LIST IT TLNE %01,770000 JRST LSTSY1 LSTSY2: SPOP %01 SPOP %00 RETURN LSTIC0: ; "LSTICH" UUO MOVEI %02,@JOBUUO JRST LSTOUT LSTFLD: ;LIST FIELD JUMPE %10,LSTFL1 ;EXIT IF NULL CALL LSTWB ;LIST WORD/BYTE MOVEI %02,"'" TLNE %10,GLBSYM MOVEI %02,"G" TDNE %10,[PFMASK] ;RELOCATABLE? CALL LSTOUT LSTFL1: JRST LSTTAB LSTWB: ;LIST WORD OR BYTE LDB %03,[POINT 2,%10,17] CAIE %03,1 JRST LSTWRD ;WORD LSTBYT: ;LIST BYTE CALL LSTSP ;LIST THREE SPACES... LSTBY1: CALL LST2SP ;...(SORT OF DEVIOUSLY) ;THIS DEVIOUSNESS IS A KLUDGE WHICH PERMITS A NEATLY ALIGNED ;SYMBOL TABLE TRZ %10,177400 ;CLEAR HIGH BITS SKIPA %03,[POINT 3,%10,35-9] LSTWRD: MOVE %03,[POINT 3,%10,35-18] LSTWR1: ILDB %02,%03 SPUSH %03 CALL LSTNUM ;LIST NUMBER SPOP %03 TLNE %03,770000 JRST LSTWR1 RETURN LST3SP: ;LIST SPACES CALL LSTSP LST2SP: CALL LSTSP LSTSP: MOVEI %02,SPACE JRST LSTOUT LSTNUM: TROA %02,"0" ;LIST NUMERIC LSTASC: ADDI %02,40 ;CONVERT SIXBIT TO ASCII JRST LSTOUT LSTCR: TDZA %02,%02 ;LIST CR-LF LSTTAB: MOVEI %02,TAB ;LIST A TAB LSTOUT: ;LISTING ROUTINE TLNN %16,LSTBIT!LPTBIT ;LISTING REQUESTED? CALL LPTOUT ; YES TLNE %16,ERRBIT ;ERROR LISTING? TLNE %16,NSWBIT!TTYBIT ; YES, TO TTY? RETURN ; NO JUMPE %02,LSTOU1 ;BRANCH IF CR-LF OUTCHR %02 ;LIST CHARACTER RETURN ;EXIT LSTOU1: OUTSTR [BYTE (7) CRR, LF, 0] RETURN ;CR-LF TO TTY LPTOUT: ;OUTPUT TO LISTING DEVICE TLNN %16,FMTBIT ;FMT MODE? JRST LPTOU1 ;NO, NORMAL TLNN %15,FMTFLG ;YES, IN OVER-RIDE? RETURN ; NO JUMPN %02,LSTDMP ;YES JRST LPTOU5 LPTOU1: TLZE %16,HDRBIT ;TIME FOR A HEADING? CALL HEADER ; YES JUMPE %02,LPTOU5 ;BRANCH IF CR-LF CAIN %02,TAB JRST LPTOU4 ;DON'T LIST TABS IMMEDIATELY AOSLE COLCNT ;OFF LINE? JRST LPTOU2 SKIPE TABCNT ;ANY IMBEDDED TABS? CALL PROTAB ; YES, PROCESS THEM JRST LSTDMP ;LIST THE CHARACTER LPTOU2: SKIPN WRPSAV MOVEM %13,WRPSAV RETURN LPTOU4: AOS TABCNT ;TAB, BUMP COUNT SPUSH %02 MOVEI %02,7 IORM %02,COLCNT AOS COLCNT SPOP %02 RETURN LPTOU5: MOVEI %02,CRR ;CR-LF CALL LSTDMP MOVEI %02,LF LPTOU6: CALL LSTDMP SOSG LPPCNT ;END OF PAGE? LPTINI: TLO %16,HDRBIT ; YES, SET FLAG LPTINF: MOVNI %02,COLTTY ;SET FOR COLUMN COUNT SKPLCR LC.TTM MOVNI %02,COLLPT MOVEM %02,COLCNT SETZB %02,TABCNT ;ZERO TAB COUNT AND REGISTER SETZM WRPSAV RETURN PROTAB: ;PROCESS IMBEDDED TABS SKIPG TABCNT ;ANY LEFT? RETURN ; NO SOS TABCNT ;YES, DECREMENT COUNT SPUSH %02 MOVEI %02,TAB CALL LSTDMP ;LIST ONE SPOP %02 JRST PROTAB ;TEST FOR MORE LSTDMP: SOSG LSTCNT ;DECREMENT ITEM COUNT CALL LSTDM1 ;EMPTY ENTIRE BUFFER IDPB %02,LSTPNT ;STORE THE CHARACTER CAIN %02,LF ;IF LINE FEED, TLNN %16,TTYBIT ; AND LISTING IS ON TTY, DUMP BUFFER RETURN ;DUMP THE BUFFER LSTDM1: OUTPUT LST, ;EMPTY A BUFFER LSTTST: STATO LST,IODATA!IODEV!IOWRLK!IOBKTL ;CHECK FOR ERRORS RETURN ;NO, EXIT FERROR [ASCIZ /LISTING OUTPUT ERROR/] .LOC COLCNT: BLOCK 1 ;COLUMN COUNT TABCNT: BLOCK 1 ;TAB COUNT LPPCNT: BLOCK 1 ;LINES/PAGE COUNT WRPSAV: BLOCK 1 WRPCNT: BLOCK 2 .RELOC SUBTTL SOURCE INPUT CHAR: CALL CHARLC CAIN %02,QJLC SUBI %14,40 RETURN CHARLC: CHAR0: SKIPE MCACNT JRST CHAR10 SKIPE MSBMRP JRST CHAR2 ;BRANCH IF IN MACRO SOSGE SRCCNT ;DECREMENT ITEM COUNT JRST CHAR4 ;GET ANOTHER BUFFER IF NECESSARY IBP SRCPNT ;INCREMENT THE BYTE POINTER MOVE %14,@SRCPNT ;PICK UP AN ENTIRE WORD FROM BUFFER TRZE %14,1 ;IS THE SEQUENCE NUMBER BIT ON? JRST CHAR8 ;YES, SKIP AROUND IT LDB %14,SRCPNT ;NO, PICK UP A GOOD CHARACTER CHAR1: LDB %02,C7PNTR ;MAP XCT CHARTB(%02) ;DECIDE WHAT TO DO RETURN ;ACCEPT IT CHAR2: CALL READMC ;GET A CHARACTER FROM MACRO TREE JRST CHAR0 ; NULL, TRY AGAIN JRST CHAR1 ;TEST IT CHAR4: INPUT SRC, ;CALL MONITIOR FOR A BUFFER STATZ SRC, IODATA+IODEV+IOBKTL+IOWRLK CHAR4A: FERROR [ASCIZ /INPUT DATA ERROR/] STATO SRC, IOEOF ;WAS AN END OF FILE REACHED? JRST CHAR0 ;GET NEXT CHAR CHAR5: CLOSE SRC, SKIPE AC14 ;CRR SEEN BY COMMAND SCANNER? TLNN %16,MODBIT JRST CHAR6 CALL ACEXCH ;GET EXEC AC'S CALL GETSRC ;GET THE NEXT SOURCE FILE CALL ACEXCH ;SAVE EXEC AC'S AND RETURN JRST CHAR0 CHAR6: TLO %15,ENDFLG ;YES, FLAG END MOVEI %14,LF ;MAKE IT A LINE JRST CHAR1 CHAR8: SKIPL P10SEQ+1 MOVEM %14,P10SEQ MOVSI %14,(B6) IORM %14,P10SEQ+1 AOS SRCPNT ;INCREMENT POINTER PAST WORD MOVNI %14,5 ;GET -5 ADDM %14,SRCCNT ;SUBTRACT 5 FROM WORD COUNT JRST CHAR0 CHAR10: SOSGE MACBUF+2 ;MORE CHARS TO GET W/OUT INPUT? JRST CHAR11 ;NO IBP MACPNT ;INCREMENT MACRO POINTER MOVE %14,@MACPNT ;GET A WHOLE WORD FROM SOURCE BUFFER TRZE %14,1 ;SEQUENCE NUMBER? JRST CHAR12 ;YES. LDB %14,MACPNT JRST CHAR1 CHAR11: INPUT MAC, STATZ MAC,740000 JRST CHAR4A STATO MAC,IOEOF JRST CHAR JRST CHAR6 CHAR12: SKIPL P10SEQ+1 ;SOMETHING THERE ALREADY? MOVEM %14,P10SEQ ;NO MOVSI %14,(B6) IORM %14,P10SEQ+1 AOS MACPNT ;BOOST POINTER AROUND SEQ NR & TAB MOVNI %14,5 ;SET UP -5 ADDM %14,MACBUF+2 ;DECREMENT THE WORD COUNT JRST CHAR10 ;GO BACK AND TRY AGAIN CHARTB: ;CHARACTER JUMP TABLE PHASE 0 MOVEI %14,RUBOUT ;ILLEGAL CHARACTER QJNU: JRST CHAR0 ;NULL, TRY AGAIN QJCR: JFCL ;END OF STATEMENT QJVT: MOVEI %14,LF ;VERTICAL TAB QJTB: JFCL ;TAB QJSP: JFCL ;SPACE QJPC: JFCL ;PRINTING CHARACTER QJLC: JFCL DEPHASE SUBTTL BASIC ASSEMBLY LOOP ASSEMB: ;ASSEMBLER PROPER TLO %15,P1F ;SET FOR PASS 1 MOVE %03,.MAIN. MOVEM %03,PRGTTL ;INIT TITLE MOVE %03,.ABS. MOVEM %03,SECNAM ;INIT ABSOLUTE SECTOR MOVE %03,[XWD [ASCIZ /.MAIN./],TTLBUF] BLT %03,TTLBUF+2 MOVE %03,[XWD [ASCIZ /TABLE OF CONTENTS/],STLBUF] BLT %03,STLBUF+4 ;PRESET SUBTTL BUFFER TLNN %16,REGBIT ;WERE REGS EN-DISABLED AT COMMAND LEVEL? CALL .ENABA ;NO..SET UP DEFAULT REGISTER DEFS CALL INIPAS ;INITIALIZE PASS ONE CALL BLKINI ;INITIALIZE BINARY OUTPUT TLNE %16,GBLDIS ;HAVE DFLT GLOBALS BEEN DISABLED? TLOA %16,GBLCCL ;YES. SAVE SETTING TLZ %16,GBLCCL ;RESET CCL-LEVEL DLFT GLOBAL SW CALL LINE ;GO DO PASS ONE. TLZ %15,P1F ;RESET TO PASS 2 TLNE %16,GBLCCL ;SHLD GBLDIS REMAIN SET? TLOA %16,GBLDIS ;YES TLZ %16,GBLDIS ;... CALL SETCRF ;SET CREF OUTPUT FILE SKIPN CCLTOP JRST ASSEM1 TLO %16,LPTBIT!ERRBIT ;LIST TO TTY LSTSYM PRGTTL CALL LSTCR TLZ %16,LPTBIT!ERRBIT ASSEM1: TLNN %16,REGBIT ;WERE REGS EN-DISABLED AT COMMAND LEVEL? CALL .ENABA ;NO..SET UP DEFLT REG DEFS CALL INIPAS SETZM STLBUF CALL LINE ;CALL THE ASSEMBLER (PASS TWO) TLZ %16,REGBIT ;CLEAR THIS BIT RETURN LINE: ;PROCESS ONE LINE CALL GETLIN ;GET A SOURCE LINE CALL STMNT ;PROCESS ONE STATEMENT CALL ENDL ;PROCESS END OF LINE TLZN %15,ENDFLG ;TEST FOR END STATEMENT JRST LINE ;GET THE NEXT LINE JRST ENDP ;END OF PASS INIPAS: CALL SETSRC ;RESET INPUT COMMAND STRING SKPEDR ED.ABS ;ABSOLUTE? TDZA %05,%05 ; YES, SET PC TO ZERO MOVSI %05,(1B) ; NO, SET TO RELOCATABLE MOVSI %03,-^D256 SETZM SECBAS(%03) ;INIT SECTOR BASES AOBJN %03,.-1 SETZM MSBMRP SETZM LSBNUM CALL LSBINC ;INIT LOCAL SYMBOLS MOVEI %03,^D8 MOVEM %03,CRADIX MOVEI %00,1 MOVEM %00,PAGNUM ;INITIALIZE PAGE NUMBER MOVEM %00,ERPNUM ; AND ERROR PAGE NUMBER SETOM ERPBAK ;BE SURE TO PRINT FIRST TIME SETOM PAGEXT ; AND EXTENSION TLO %16,HDRBIT SETZM CNDMSK ;CLEAR CONDITIONAL MASK SETZM CNDWRD ; AND TEST WORD SETZM CNDLVL SETZM CNDMEX MOVEM %12,TIMBLK ;PRESERVE R12 SETZM REPSW ;CLEAR REPEAT SWITCH SETZM REPBLK ;;AND FIRST WORD OF BLOCK MOVEI %12,REPBLK-1 ;INITIALIZE 'STACK' POINTER MOVEM %12,REPCT ;..... MOVE %12,[REPBLK,,REPBLK+1];PREPARE FOR AND.... BLT %12,REPBLK+^D127 ;...EXECUTE THE BLT TO CLEAR THE STACK SETZ %12, ;CLEAR THE REGISTER EXCH %12,TIMBLK ;AND THEN TIMBLK W/ REG RESTORE SETZM TIMBLK+1 SETZM PHAOFF SETZM WRPCNT SETZM WRPCNT+1 JRST ENDLI ;EXIT THROUGH END OF LINE ROUTINE .MAIN.: GENM40 .,M,A,I,N,. .ABS.: GENM40 ., ,A,B,S,. SUBTTL STATEMENT EVALUATOR STMNT: ;STATEMENT PROCESSOR SETZM ARGCNT SKIPN CNDWRD ;UNSATISIFIED CONDITIONAL? SKIPE CNDMEX ;OR PERHAPS AN .MEXIT? JRST STMNT5 ;YES... STMNTF: SETZM ARGCNT ;CLEAR ARGUMENT COUNT CALL GETSYM ;TRY FOR SYMBOL JUMPE %00,STMNT3 ;BRANCH IF NULL CAIN %14,":" ;LABEL? JRST LABEL ; YES CAIN %14,"=" ;ASSIGNMENT? JRST ASGMT ; YES CALL OSRCH ;NO, TRY MACROS OR OPS JRST STMNT2 ;TREAT AS EXPRESSION STMNT1: CALL CRFOPR ;CREF OPERATOR REFERENCE LDB %02,TYPPNT ;RESTORE TYPE XCT STMNJT(%02) ;EXECUTE TABLE STMNJT: ;STATEMENT JUMP TABLE PHASE 0 JRST STMNT2 ;BASIC SYMBOL MAOP: JRST MACROC ;MACRO OCOP: JRST PROPC ;OP CODE DIOP: JRST 0(%01) ;PSEUDO-OP DEPHASE STMNT2: MOVE %13,SYMBEG ;NON-OP SYMBOL, RESET CHAR POINTER CALL SETNB ;SET CURRENT CHAR CAIE %14,";" ;IF SEMI-COLON CAIN %14,0 ; OR LINE TERMINATOR, RETURN ; NULL LINE JRST .WORD ;NEITHER, TREAT AS ".WORD" STMNT3: CALL GETLSB ;IT'S A LOCAL SYMBOL, RIGHT? JUMPE %00,STMNT2 ;WRONG. CAIE %14,":" ;THEN IT'S A LABEL, RIGHT? JRST STMNT2 ;SORRY, WRONG AGAIN. IT'S AN EXPRESSION CAMLE %05,LSBMAX ;WITHIN RANGE? ERRSET ERR.A ; NO, ERROR JRST LABELF STMNT4: CALL GETNB CAIN %14,":" ;ANOTHER COLON? CALL GETNB ;YES...BYPASS IT. STMNT5: ;TRAP FOR .MEXIT OR UNSATISIFED CONDITIONALS CALL GETSYM CAIN %14,":" JRST STMNT4 CAIN %14,"=" JRST STMNT6 CALL TSTMLI ;CONDITIONED OUT CAIE %03,DCCND ;TEST FOR CONDITIONAL OP CODE CAIN %03,DCCNDE JRST STMNT1 ; YES, PROCESS IT STMNT6: SETLCT LC.CND ;NO, SET LISTING FLAG TLO %15,NQEFLG RETURN LABEL: ;LABEL PROCESSOR CALL LSBTST ;TEST FOR NEW LOCAL SYM RANGE LABELF: MOVSI %04,0 ;ASSUME NO GLOBAL DEFINITION CALL GETNB ;BYPASS COLON CAIE %14,":" ;ANOTHER COLON? JRST .+3 ;NO MOVSI %04,GLBSYM ;GET GLOBAL FLAG CALL GETNB ;BYPASS SECOND COLON SPUSH %04 ;STACK GLOBAL FLAG CALL SSRCH ;SEARCH SYMBOL TABLE JRST LABEL0 ;NOT THERE. TLNE %01,REGSYM ;REGISTER? JRST LABEL2 ;YES, ERROR LABEL0: TLNE %01,DEFSYM ;SYMBOL DEFINED? JRST LABEL1 ;YES TLNE %01,FLTSYM ;DEFAULTED GLOBAL SYMBOL? TLZ %01,FLTSYM!GLBSYM ;YES-CLEAR FLAGS. TDO %01,0(%17) ;INSERT GLOBAL BIT TDO %01,%05 ;SET CURRENT PC VALUE LABEL1: MOVE %03,%01 ;COPY VALUE REGISTER TDC %03,%05 ;COMPARE WITH PC TDNN %03,[PCMASK] ;EQUAL ON MEANINGFUL BITS JRST LABEL3 ; YES LABEL2: TLNN %15,P1F ;NO, PASS 1? TLNE %01,MDFSYM ;NO, MULTIPLY DEFINED ALREADY? TLOA %01,MDFSYM ; YES, FLAG SYMBOL ERRSET ERR.P ;NO, PHASE ERROR CAIA LABEL3: TLO %01,LBLSYM!DEFSYM ;OK, FLAG AS LABEL CAMN %00,M40DOT ;PERCHANCE PC? ERRSKP ERR.M ; YES, FLAG ERROR AND SKIP CALL INSRT ;INSERT/UPDATE TLNE %01,MDFSYM ;MULTIPLY DEFINED? ERRSET ERR.M ; YES SPOP %04 ;CLEAN STACK CALL SETNB ; MOVEM %13,CLILBL CALL CRFDEF CALL SETPF0 JRST STMNTF ;RETURN TO STATEMENT EVALUATOR ASGMT: ;ASSIGNMENT PROCESSOR MOVSI %04,0 ;ASSUME NO GLOBAL DEFINITION CALL GETNB ;GET NEXT NON-BLANK CAIE %14,"=" ;ANOTHER EQUALS? JRST .+3 ;NO MOVSI %04,GLBSYM ;SET GLOBAL SYMBOL FLAG CALL GETNB ;GET NEXT NON-BLANK SPUSH %04 ;STACK FLAG SPUSH %00 ;STACK SYMBOL CALL RELEXP CALL SETPF1 JRST ASGMT0 ASGMTF: CALL SETPF1 ASGMTX: MOVSI %04,0 ;SET ZERO FLAG EXCH %04,0(%17) ;EXCHANGE WITH SYMBOL SPUSH %04 ;STACK SYMBOL AGAIN ASGMT0: SPOP %00 ;RETRIEVE SYMBOL CALL SSRCH ;SEARCH TABLE JFCL ;NOT THERE YET CALL CRFDEF TLNE %01,LBLSYM ;LABEL? JRST ASGMT1 ; YES, ERROR TLNE %01,FLTSYM ;DEFAULTED GLOBAL SYMBOL? TLZ %01,FLTSYM!GLBSYM ;YES-CLEAR DEFAULT FLAGS AND %01,[XWD GLBSYM!MDFSYM,0] ;MASK TRNN %15,ERR.U!ERR.A ;ANY UNDEFINED SYMBOLS OR ADDRSNG ERRS? TLO %01,DEFSYM ; NO, FLAG AS DEFINED TDOA %01,%10 ;MERGE NEW VALUE ASGMT1: TLO %01,MDFSYM ; ERROR, FLAG AS MULTIPLY DEFINED TLNE %01,MDFSYM ;EVER MULTIPLY DEFINED? ERRSET ERR.M ; YES CAME %00,M40DOT ;LOCATION COUNTER? TDO %01,0(%17) ;NO - MERGE GLOBAL DEFINITION BIT SPOP %04 ;CLEAN STACK CAME %00,M40DOT ;SKIP IF LOCATION COUNTER JRST INSRT ;INSERT AND EXIT CALL TSTMAX ;TEST FOR NEW HIGH LDB %02,SUBPNT LDB %03,CCSPNT CAME %02,%03 ;CURRENT SECTOR? ASGMT2: ERRXIT ERR.A!ERR.P1 ; ERROR, DON'T STORE CALL INSRT JRST SETRLD SUBTTL END OF LINE PROCESSOR ENDL: ;END OF LINE PROCESSOR SKIPE MCACNT JRST ENDLI SKIPE ARGPNT HALT . SETCHR CAIA ENDL01: CALL GETNB ;SET NON-BLANK CHARACTER CAIE %14,0 ;IF CR/LF CAIN %14,";" ; OR COMMENT, JRST ENDL02 ; BRANCH TLNE %15,NQEFLG ;NO, OK? JRST ENDL01 ; YES, TRY AGAIN ERRSET ERR.Q ; NO, FLAG ERROR ENDL02: SKPLCR LC.COM ;COMMENT SUPPRESSION? MOVEM %13,CLIPNT+1 ; YES, MARK IT MOVE %01,CLIPNT SKPLCR LC.SRC ;SOURCE SUPPRESSION? MOVEM %01,CLIPNT+1 ; YES SETZM CODPNT ;INITIALIZE FOR CODE OUTPUT CALL PROCOD ;PROCESS CODE JFCL ; NO CODE, IGNORE THIS TIME ENDL10: TDZ %15,ERRSUP TRNE %15,-1-ERR.P1 TRZ %15,ERR.P1 TRZN %15,ERR.P1 ;PASS 1 ERROR? TLNN %15,P1F ; NO, ARE WE IN PASS2? CAIA ; YES, LIST THIS LINE TRZ %15,-1 ;PASS 1, CLEAR ANY ERROR FLAGS TRNE %15,-1 ;ANY ERRORS? TLO %16,ERRBIT ; YES, SET BIT TLNE %16,ERRBIT!P1LBIT ;ERRORS OR PASS1 LISTING? JRST ENDL11 ; YES TLNN %16,LSTBIT TLNE %15,FFFLG ;NO, PASS ONE? JRST ENDL41 ; YES, DON'T LIST SKIPL LCLVLB ;IF LISTING DIRECTIVE SKIPGE %02,LCLVL ; OR LISTING SUPPRESSED, JRST ENDL41 ; BYPASS SKPLCR @LCTST ; AND SUPPRESSION BITS JUMPLE %02,ENDL41 ; YES TLNE %15,P1F JRST ENDL42 JRST ENDL20 ;NO, LIST THIS LINE ENDL11: TRNN %15,-1 ;ARE WE HERE DUE TO ERRORS? JRST ENDL20 ; NO TRNE %15,-1-ERR.Q ;ERRORS OTHER THAN "Q"? TRZ %15,ERR.Q ; YES, DON'T LIST IT TRNE %15,QMEMSK ;ANY FATAL TYPES? AOSA ERRCNT ; YES AOS ERRCNT+1 ;NO, TALLY SECONDARY MOVE %03,LINPNT MOVEM %03,CLIPNT ;LIST ENTIRE LINE SETZM CLIPNT+1 TLO %16,LPTBIT MOVE %11,ERPNUM CAME %11,ERPBAK LSTMSG [ASCIZ /**PAGE 50/] MOVEM %11,ERPBAK TLZ %16,LPTBIT HRLZ %00,%15 ;PUT FLAGS IN AC0 LEFT MOVE %01,[POINT 7,ERRMNE,] ENDL12: ILDB %02,%01 ;FETCH CHARACTER SKIPGE %00 ;THIS CHARACTER? CALL LSTOUT ; YES LSH %00,1 JUMPN %00,ENDL12 ;TEST FOR END ENDL20: SKPLCR LC.SEQ JRST ENDL22 TLO %15,FMTFLG MOVE %01,LINNUM EXCH %01,LINNUB CAME %01,LINNUB JRST ENDL21 SKIPLE %11,MSBLVL LSTMSG [ASCIZ / (5)/] JRST ENDL22 ENDL21: HRRZ %00,COLCNT IDIVI %00,8 MOVE %03,LINNUM IDIVI %03,^D10 ADDI %01,1 JUMPN %03,.-2 CALL LSTSP CAIGE %01,5 AOJA %01,.-2 DNC LINNUM ENDL22: CALL LSTTAB TLO %15,FMTFLG TLNE %15,LHMFLG ;TO BE LEFT-JUSTIFIED? JRST ENDL30 ; YES SKPLCR LC.LOC JRST ENDL23 ;SKIP MOVE %10,PF0 ;FIRST FIELD TO BE PRINTED? CALL LSTFLD ; YES ENDL23: SKPLCR LC.BIN JRST ENDL30 MOVE %10,PF1 ;PRINT PF1 CALL LSTFLD SKPLCS LC.TTM JRST ENDL30 ; YES, THROUGH FOR NOW MOVE %10,PF2 CALL LSTFLD ; NO, LIST MOVE %10,PF3 CALL LSTFLD ENDL30: SKIPE P10SEQ LSTSTR P10SEQ TLNN %15,P1F SKPEDS ED.TIM ;TIMING REQUESTED? JRST ENDL77 ; NO SKIPN %01,TIMBLK+1 ;YES, ANY INCREMENT? JRST ENDL76 ; NO, JUST A TAB ADDM %01,TIMBLK ;YES, UPDATE MASTER IDIVI %01,^D10 SPUSH %02 DNC 4,%01 LSTICH "." SPOP %02 LSTICH "0"(%02) SETZM TIMBLK+1 ;CLEAR INCREMENT ENDL76: CALL LSTTAB ENDL77: SKIPN %13,CLIPNT ;ANY LINE TO LIST? JRST ENDL40 ; NO SKIPE %03,CDRCHR ;CDR CHAR TO STUFF? DPB %03,CDRPNT ; YES, DO SO MOVEI %03,0 DPB %03,CLIPNT+1 ;MARK END OF PRINTING LINE ENDL78: LDB %02,%13 ;SET FIRST CHARACTER ILDB %01,ILCPNT SKIPE ILCPNT TLO %01,(1B0) DPB %03,ILCPNT JUMPE %02,ENDL33 ENDL31: CALL LSTOUT ;LIST THIS CHARACTER ILDB %02,%13 ;GET THE NEXT ENDL32: JUMPN %02,ENDL31 ;LOOP IF NOT END ENDL33: JUMPE %01,ENDL40 ;BRANCH IF NO ILLEGAL CHARS STORED MOVEI %02,"?" ;YES, MARK THE LISTING CALL LSTOUT HRRZ %02,%01 ;GET SAVED CHARACTER MOVEI %01,0 ;RESET ILLEGAL CHARACTER JRST ENDL32 ENDL40: SKPEDR ED.WRP SKIPN %13,WRPSAV JRST ENDL44 AOS WRPCNT+1 SPUSH COLCNT CALL LSTCR SPOP %03 ADD %03,COLCNT MOVNS %03 IDIVI %03,^D8 MOVEM %03,TABCNT JRST ENDL78 ENDL44: AOS WRPCNT CALL LSTCR ;LIST CR/LF ENDL42: TLNE %16,SOLBIT ;SEQUENCE OUTPUT? SKPLCR LC.BEX ; YES, EXTENSION LINE? CAIA ; YES, IGNORE AOS LINNUM ;NO, BUMP LINE NUMBER ENDL41: CALL ENDLIF ;SEMI-INIT LINE CALL PROCOD ;PROCESS ADDITIONAL CODE, IF ANY JRST ENDL50 SETLCT LC.BEX JRST ENDL10 ;MORE CODE, LOOP ENDL50: SKIPN %03,FFCNT ;FORM FEED ENCOUNTERED? JRST ENDLI ; NO SETZM TIMBLK ;RESET TIMING AT END OF LINE HRRZS %03 TLNN %15,P1F ;SKIP IF PASS 1 SKIPGE LCLVL CAIA TLO %16,HDRBIT ;SET HEADER BIT JUMPE %03,ENDLI TLNN %16,SOLBIT ADDM %03,PAGNUM ;YES, BUMP PAGE NUMBER SETOM PAGEXT TLNE %16,FMTBIT TLNE %15,P1F JRST ENDLI TLO %15,FMTFLG LSTICH CRR LSTICH FF SOJG %03,.-2 ENDLI: SETZM CODPNT SETZM LCTST SETZM GLBPNT SETZM FFCNT TLZ %15,FMTFLG SETZM LINPNT SETZM CLIPNT+1 ENDLIF: AND %05,[PCMASK] ;CLEAN UP PC SETZM PF0 ;CLEAR PRINT WORDS SETZM PF1 SETZM PF2 SETZM PF3 SETZM CLIPNT SETZM CLILBL SETZM LCLVLB SKIPL %03,P10SEQ+1 MOVEM %03,P10SEQ SETZM CDRCHR SETZM ILCPNT TRZ %15,-1 TLZ %15,NQEFLG!FFFLG!DSTFLG!DS2FLG!LHMFLG TLZ %16,ERRBIT!P1LBIT RETURN .LOC PF0: BLOCK 1 ;PRINT FIELD STORAGE PF1: BLOCK 1 PF2: BLOCK 1 PF3: BLOCK 1 PFT0: BLOCK 1 ;TEMPS FOR ABOVE PFT1: BLOCK 1 LINNUM: BLOCK 1 ;SEQUENCE NUMBER LINNUB: BLOCK 1 P10SEQ: BLOCK 2 .RELOC SUBTTL ERROR FLAGGING ERRSK0: AOSA 0(%17) ;FLAG ERROR AND SKIP ERRXI0: SPOP 0(%17) ;FLAG ERROR AND EXIT ERRSE0: TRO %15,@JOBUUO ;FLAG ERROR RETURN SUBTTL OP CODE HANDLERS PROPC: ;PROCESS OP CODES CALL TSTEVN ;MAKE SURE WE'RE EVEN LDB %02,SUBPNT ;GET CLASS HRLI %01,BC2 MOVEM %01,OPCODE ;STORE OP SETZM OFFSET ;CLEAN UP FOR AEXP SETZM ADREXT SETZM ADREXT+1 MOVE %03,PROPCT(%02) ;FETCH PROPER TABLE ENTRY LDB %04,[POINT 9,%03,35] ADDM %04,TIMBLK+1 ;UPDATE TIMING TRZ %03,777 TLO %15,0(%03) ;SET PROPER CREF FLAGS HLRZS %03 ;SET INDEX CALL 0(%03) ;CALL PROPER HANDLER SKIPE %01,OPCODE ;FETCH OP-CODE CALL STCODE ;STOW CODE SKIPE %01,ADREXT ;EXTENSION? CALL STCODE ; YES, STORE IT SKIPE %01,ADREXT+1 CALL STCODE ;DITTO LDB %01,[POINT 16,OPCODE,35];GET ALL OF 1ST WORD OF INSTRUCTION CAIN %01,167 ;X-ERROR SUSCEPTIBLE JMP? JRST PROPC5 ;YES. GO CHECK LSH %01,-6 CAIN %01,0001 ;JMP? JRST PROPC2 ;YES. GO TO Z-ERROR CHECKING LSH %01,-3 CAIN %01,004 ;JSR? JRST PROPC2 ;YES. GO TO Z-ERROR CHECKING TRC %01,170 ;PREPARE TO CHECK FOR... TRCN %01,170 ;EAE INSTRUCTION? RETURN ;YES. GO HOME. TRNN %01,070 ;DOUBLE OPERAND INSTRUCTION OR XOR?? RETURN ;NO. HOME FREE. CAIE %01,074 ;XOR? JRST PROPC1 ;NO. GO TO NORMAL DOUBLE OPERAND CHECKING. LDB %01,[POINT 12,OPCODE,35];GET SRCE MODE,REG, DEST MODE,REG TRZA %01,7000 ;GENERATE LITERAL SOURCE MODE OF 0 COMMENT % THERE ARE FOUR GENERAL CASES WHERE INSTRUCTIONS WILL NOT FUNCTION IDENTICALLY FROM ONE MODEL OF PDP-11 TO ANOTHER. THESE CASES ARE AS FOLLOWS: 1. JMP OR JSR TO A MODE 0 DESTINATION. 2. JMP OR JSR TO A MODE 2 DESTINATION. 3. DOUBLE OPERAND INSTRUCTION OR XOR WITH A SOURCE MODE OF 0 (WHICH IS IMPLIED IN AN XOR) AND A DESTINATION MODE BETWEEN 2 AND 5 INCLUSIVE, WITH THE SAME REGISTER USED IN BOTH SOURCE AND DESTINATION. 4. DOUBLE OPERAND INSTRUCTION WITH A SOURCE MODE OF ZERO (INCL XOR) AND A SOURCE REGISTER OF 7 AND A DESTINATION MODE OF SIX OR SEVEN. % ; THE FOLLOWING BLOCK OF CODE CHECKS FOR Z-ERROR CONDITIONS IN DOUBLE OPERAND INSTRUCTIONS, INCLUDING XOR PROPC1: LDB %01,[POINT 12,OPCODE,35];GET SRC,DST MODE&RG TRNE %01,7000 ;SOURCE MODE=0? RETURN ;NO. GO HOME TRC %01,0760 ;PREPARE TO CHECK FOR.... TRCN %01,0760 ;CASE 4? ERRSET ERR.Z ;YES. FLAG IT ; NOW CHECK FOR CASE THREE TRZ %01,0700 ;CLEAR SOURCE REGISTER CAIL %01,20 ;DEST MODE <2 *OR* CAILE %01,57 ; >5 ? RETURN ;YES. NO PROBLEM. LSH %01,6 ;ALIGN DEST REG W/ SOURCE REG FIELD XOR %01,OPCODE ;COMPARE SOURCE AND DEST REGS TRNN %01,0700 ;ARE THE TWO EQUAL? ERRSET ERR.Z ;SURE ARE. FLAG THE STATEMENT. RETURN ;END OF CASE 3 AND 4 CHECKING. ; THE FOLLOWING BLOCK OF CODE CHECKS FOR Z-ERROR CONDITIONS IN JMP AND JSR COMMANDS. PROPC2: LDB %01,[POINT 3,OPCODE,35-3];PICK UP DEST MODE TRNE %01,5 ;MODE 0 OR 2? CAIA ;NO. SKIP AROUND FLAGGING... ERRSET ERR.Z ;YES. FLAG THE STMNT. RETURN ;GO BACK PROPC5: LDB %02,[POINT 16,ADREXT,35] MOVE %11,%05 ;POSITION CURRENT CSECT VALUE XORM %11,%10 ;COMPARE IT TO DESTINATION CSECT TRNE %11,(B17!377B);JMP TO DIFFERENT CSECT, OR GLOBAL VARIABLE? RETURN ;YES. BYPASS X-ERROR CHECKING CAILE %02,000374 ;IS THE JMP SHORT ENOUGH TO BE A BRANCH? CAIL %02,177376 ERRSET ERR.X ;YES RETURN OPCERR: ERRSET ERR.O RETURN PROPCT: ;BITS 27-35 CONTAIN INSTRUCTION EXECUTION TIME IN .1USECS PHASE 0 HALT OPCL0: XWD POPCL0, +^D15 OPCL1: XWD POPCL1, DSTFLG +^D23 OPCL1A: XWD POPCL1, +^D23 OPCL2: XWD POPCL2, DS2FLG +^D23 OPCL2A: XWD POPCL2, +^D23 OPCL3: XWD POPCL3, DSTFLG +^D35 OPCL4: XWD POPCL4, +^D26 OPCL5: XWD POPCL5, DS2FLG OPCL5A: XWD POPCL5, DSTFLG +^D44 OPCL6: XWD POPCL6, +^D93 OPCL7: XWD POPCL7, DS2FLG OPCL8: XWD POPCL8, DSTFLG OPCL9: XWD POPCL9, DS2FLG OPCL10: XWD POPC10, OPCL11: XWD POPC11, DS2FLG OPCL12: XWD POPC12, DS2FLG OPCL13: XWD POPC13, OPCL14: XWD POPC14, DS2FLG OPCL15: XWD POPC11, DEPHASE IFN &777, .LOC OPCODE: BLOCK 1 OFFSET: BLOCK 1 ADREXT: BLOCK 2 TIMBLK: BLOCK 2 ;TIMING INFO .RELOC POPCL0: LDB %03,[POINT 16,OPCODE,35] CAILE %03,000004 ;ONE OF THE COMMON ONES? RETURN ; NO, USE DEFAULT TIME MOVE %04,[DEC 18,18,48,93,93](%03) MOVEM %04,TIMBLK+1 RETURN POPCL1: CALL AEXP ;PROCESS ADDRESS EXPRESSION DPB %00,[POINT 6,OPCODE,35] LDB %03,[POINT 9,OPCODE,35-6] CAIN %03,057 ;TEST INSTRUCTION? SKIPN %04 ; YES, NON-REGISTER MODE? CAIA ; NO SUBI %04,^D5 ;YES, GET A REFUND ADDM %04,TIMBLK+1 RETURN POPCL2: ;DOUBLE OPERAND INSTRUCTION HANDLING CALL AEXP DPB %00,[POINT 6,OPCODE,35-6] SKIPE %04 ;REGISTER MODE? ADDI %04,1 ; NO, ADD (WE'RE IN SRC) LDB %03,[POINT 3,OPCODE,35-12] CAIE %03,3 ;IF BIT CAIN %03,4 ; OR BIC, ADDI %04,^D6 ; ADD SURCHARGE ADDM %04,TIMBLK+1 POP2ND: CALL TSTCOM CALL AEXP DPB %00,[POINT 6,OPCODE,35] JUMPE %04,CPOPJ ;EXIT IF NO TIMING LDB %03,[POINT 3,OPCODE,35-12] CAIE %03,2 ;IF CMP CAIN %03,3 ; OR BIT, SUBI %04,^D5 ; GET REFUND ADDM %04,TIMBLK+1 RETURN POPCL3: CALL REGEXP DPB %10,[POINT 3,OPCODE,35] RETURN POPCL4: ;PROCESS BRANCH ON CONDITION CALL RELADR ;CALL RELATIVE ADDRESS EVALUATOR MOVNS %10 TRNE %10,000200 ;NEGATIVE? TRC %10,077400 ; YES, TOGGLE HIGH BITS TRNE %10,077400 ;ANY OVERFLOW? ERRSET ERR.A ; YES, FLAG IT TRNE %15,ERR.A ;ANY ADDRESS ERRORS? MOVNI %10,1 ; YES, MAKE EFFECTIVE HALT DPB %10,[POINT 8,OPCODE,35] RETURN POPCL5: CALL REGEXP DPB %10,[POINT 3,OPCODE,35-6] JRST POP2ND POPCL6: CALL EXPR ;EVALUATE THE EXPRESSION JFCL ; NULL, TREAT AS ZERO CALL TSTARB ;TEST ARITHMETIC BYTE DPB %01,[POINT 8,OPCODE,35] ;STUFF INTO BASIC RETURN POPCL9: ;OLD ASH/ASHC MODES POPCL7: CALL AEXP DPB %00,[POINT 6,OPCODE,35] CALL TSTCOM CALL REGEXP DPB %10,[POINT 3,OPCODE,35-6] RETURN POPCL8: CALL REGEXP DPB %10,[POINT 3,OPCODE,35-6] CALL TSTCOM CALL RELADR ;EVALUATE RELATIVE ADDRESS TRNE %10,177700 ;INBOUNDS? ERRSET ERR.A ; NO, FLAG ERROR TRNE %15,ERR.A ;ANY ERRORS? MOVEI %10,1 ; YES, BRANCH TO SELF DPB %10,[POINT 6,OPCODE,35] RETURN POPC10: CALL ABSEXP TRNE %10,177700 ERRSET ERR.T DPB %10,[POINT 6,OPCODE,35] RETURN RELADR: ;RELATIVE ADDRESS EVALUATOR CALL EXPR ERRSET ERR.A ; NULL, ERROR SETZB %04,RELLVL CALL EXPRPX MOVE %01,%05 ADDI %01,2 CALL EXPRMI ERRSET ERR.A CALL ABSTST TRNE %10,1 ;EVEN? ERRSET ERR.A ; NO, FLAG ERROR LSH %10,-1 ;/2 RETURN POPC11: CAIE %14,"#" JRST POPC1B SPUSH %13 CALL GETNB MOVEI %03,1 MOVEM %03,FLTLEN ;SET LENGTH FOR ROUNDING CALL FLTG SPOP %00 TLNE %15,FLTFLG JRST POPC1A HRRZ %10,FLTNUM TLO %10,BC2 AOS %02,OFFSET MOVEM %10,ADREXT-1(%02) MOVEI %00,27 JRST POPC1C POPC1A: MOVE %13,%00 SETCHR POPC14: ;NEW CLASS 14 POPC1B: CALL AEXP POPC1C: DPB %00,[POINT 6,OPCODE,35] CALL TSTCOM CALL REGEXP TRNE %10,177774 ERRSET ERR.A DPB %10,[POINT 2,OPCODE,35-6] RETURN POPC12: CALL REGEXP TRNE %10,177774 ERRSET ERR.A DPB %10,[POINT 2,OPCODE,35-6] JRST POP2ND POPC13: CALL ABSEXP TRNE %10,177770 ERRSET ERR.A DPB %10,[POINT 3,OPCODE,35] RETURN TSTCOM: TLNN %15,DS2FLG TLZA %15,DSTFLG TLO %15,DSTFLG CAIN %14,"," JRST GETNB ERRSET ERR.A POP %17,0(%17) RETURN SUBTTL DIRECTIVES .ABS: MOVEI %03,ED.ABS TDNE %03,EDMSK ;MASKED OUT? RETURN ; YES TRO %12,0(%03) ;NO, SET IT HRRM %12,EDFLGS TLZ %05,(PFMASK) ;CLEAR RELOCATION RETURN IFDEF XREL, < .ASECT= OPCERR .CSECT= OPCERR .GLOBL= OPCERR .LOCAL= OPCERR .LIMIT= OPCERR > IFNDEF XREL < .ASECT: HRRZS 0(%17) ;NOT LOCAL MOVE %00,.ABS. ;FUDGE FOR ABS JRST CSECTF ;BRANCH AROUND TEST .PSECT: SETOM PSCTSW ;SIGNAL PSECT PROCESSING .CSECT: TDZA %03,%03 .LOCAL: MOVSI %03,1 HLLM %03,0(%17) ;FLAG LOCAL SKPEDR ED.ABS ;ABS MODE? JRST OPCERR ; YES, ERROR CALL GETSYM ;TRY FOR A SYMBOL CSECTF: CALL TSTMAX ;TEST MAX PC MOVSI %10,-^D256 ;INIT FOR SEARCH CSECT2: CAMN %00,SECNAM(%10) ;MATCH? JRST CSECT3 ; YES TRNE %10,-2 ;IF POINTING AT ONE SKIPE SECNAM(%10) ;OR SLOT IS FULL, AOBJN %10,CSECT2 ;LOOP JUMPL %10,CSECT3 ;BRANCH IF GOOD ERRSET ERR.A ;END, ERROR RETURN CSECT3: SKIPN PSCTSW ;PROCESSING PSECT? JRST CSECT4 ;NO. BR AROUND PROCESSING. SETZM PSCTSW ;CLEAR THE SWITCH. ; PSECT PROCESSING SPUSH %00 ;SAVE THE SECTION NAME ;USE AC2 & AC6 FOR SCRATCH SKIPE %02,PSCFLG(%10) ;HAS THIS PSECT BEEN PROCESSED ALREADY? JRST PSECT1 ;YES. HRROI %02,2410!LOW!CON!RW!REL!LCL!I ;ASSUME NAMED PSECT SKIPN %10 ;ASECT? HRROI %02,2410!LOW!OVR!RW!ABS!GBL!I ;YES PSECT1: SPUSH %02 ;SAVE THE REGISTER ;DON'T SAVE AC6 SINCE IT GETS SET AFRESH ;AFTER THESE CALLS. CALL SETNB ;PICK UP THE CURRENT CHAR IN AC14 SKIPN %14 ;IS THIS THE END OF THE LINE? JRST PSECT5 ;YES. CAIN %14,";" ;IS THIS THE BEGINNING OF A COMMENT? JRST PSECT5 ;YES. CAIE %14,"," ;IS IT A COMMA? JRST PSECT4 ;NO. TERMINATE PROCESSING CALL GETNB ;SPACE AROUND THE COMMA, AND CALL GSARG ;GO GET A SYMBOLIC ATTRIBUTE JRST PSECT4 ;ERROR OUT IF THERE AIN'T NOTHIN' ;AFTER THE COMMA SPOP %02 ;RETRIEVE THE REGISTER MOVEI %06,ATRARG ;GET ADDRESS OF TABLE PSECT2: CAMN %00,@%06 ;COMPARE ARG TO TBL ENTRY.SAME? JRST PSECT3 ;YES...GO AND PROCESS IT. ADDI %06,2 ;INCREMENT THE POINTER CAIE %06,ATREND ;TABLE EXHAUSTED? JRST PSECT2 ;NO. CAIA ;YES. PSECT4: SPOP %02 ;RESTORE AC2 SPOP %00 ;AND AC0 ERRSET ERR.A ;FLAG THE STATEMENT, RETURN ;AND IGNORE THE WHOLE PSECT PSECT3: AOS %06 ;INCREMENT THE POINTER TO THE BIT SETTING HRRZ %00,@%06 ;GET BIT POSITION INDR SKIPL @%06 ;SHLD THE BIT BE SET TO ONE? TDZA %02,%00 ;NO. CLEAR THE BIT. TDO %02,%00 ;YES. SET IT. JRST PSECT1 ;GO BACK FOR MORE. PSECT5: SPOP %02 ;RETRIEVE THE REGISTER MOVEM %02,PSCFLG(%10) ;SAVE THE ATTRIBUTE FLAGS SPOP %00 ;RECOVER THE SECTION NAME... ;...AND FALL INTO CSECT PROCESSING CSECT4: MOVEM %00,SECNAM(%10) ;SAVE NAME MOVE %01,%05 ;GET CURRENT PC LDB %02,SUBPNT ;CURRENT RELOCATION HRRM %01,SECBAS(%02) ;STORE CURRENT HRRZ %05,SECBAS(%10) ;GET NEW ONE DPB %10,CCSPNT ;MAKE SURE RELOCATION IS SET HRRZ %03,%10 IDIVI %03,^D36 MOVNS %04 HLRZ %01,0(%17) ;GET LOCAL FLAG ROT %01,-1(%04) ;MOVE INTO POSITION IORM %01,SECLCF(%03) ;MERGE BIT MOVE %01,%05 AOS %02,GLBPNT MOVEM %00,GLBBUF(%02) ;STORE NAME ANDI %01,177777 DPB %02,SUBPNT ;STORE POINTER MOVEI %03,RLDT7 DPB %03,MODPNT ;SET CLASS 7 CALL STCODE MOVE %10,%05 CALL LSBTST JRST SETPF1 > TSTMAX: LDB %03,CCSPNT ;GET CURRENT SEC HLRZ %04,SECBAS(%03) ;MAX FOR THIS ONE CAIGE %04,0(%05) ;NEW MAX? HRLM %05,SECBAS(%03) ; YES RETURN .LOC SECNAM: BLOCK ^D256 ;SECTOR NAMES SECBAS: BLOCK ^D256 ;SECTOR BASES SECLCF: BLOCK ^D<256/36>+1 ;SECTOR LOCAL FLAGS SECLCP: BLOCK 1 ;SECTOR LOCAL POINTER PSCFLG: BLOCK ^D256 ;PSECT ATTRIBUTE FLAGS ;THOSE SLOTS WHICH CORRESPOND TO PSECTS HAVE ALL ONES IN THE LH ;OF THE WORD PSCTSW: BLOCK 1 ;SET TO ONES DURING PSECT PROCESSING .RELOC DEFINE ATARG (C1,C2,C3,BIT,SET) < XLIST C1'C2'C3=SET'B<35-BIT> GENM40 C1,C2,C3,,, EXP SET'B0!1B<35-BIT> LIST > ATRARG: ;ATTRIBUTE ARGUMENT TABLE ATARG H,G,H,0,1 ATARG L,O,W,0,0 ATARG C,O,N,2,0 ATARG O,V,R,2,1 ATARG R,W,,4,0 ATARG R,O,,4,1 ATARG A,B,S,5,0 ATARG R,E,L,5,1 ATARG L,C,L,6,0 ATARG G,B,L,6,1 ATARG I,,,7,0 ATARG D,,,7,1 ATREND: ;END OF TABLE IFNDEF XREL < .GLOBL: ;.GLOBL PSEUDO-OP SKPEDR ED.ABS JRST OPCERR .GLOB1: CALL GSARG ;GET AN ARGUMENT JRST .GLOB2 ;BRANCH IF NULL CAMN %00,M40DOT ;MESSING WITH PC? JRST .GLOB2 ; YES, ERROR CALL SSRCH ;OK, SEARCH TABLE JFCL TLZ %01,FLTSYM ;CLEAR DEFAULTED GLOBAL SYMBOL FLAG TLNE %01,REGSYM ;REGISTER SYMBOL? TLOA %01,MDFSYM ; YES, ERROR TLOA %01,GLBSYM ;NO, FLAG GLOBAL ERRSET ERR.R ; YES, FLAG REGISTER ERROR CALL INSRT ;INSERT IN TABLE CALL CRFDEF JRST .GLOB1 ;TRY FOR MORE .GLOB2: SKIPN ARGCNT ;ANY ARGUMENTS PROCESSED? ERRSET ERR.A ; NO RETURN > TSTEVN: ;TEST FOR EVEN TRNN %05,1 ;ARE WE EVEN? RETURN ; YES, JUST EXIT ERRSET ERR.B ;NO, FLAG ERROR AND EVEN THINGS UP SPUSH %01 CALL .EVEN SPOP %01 RETURN IFNDEF XREL < .LIMIT: ; ".LIMIT" PSEUDO-OP SKPEDR ED.ABS ;ABS MODE? POPJ %17, ; YES, IGNORE IT CALL TSTEVN ;NO, MAKE SURE WE'RE EVEN MOVSI %01,BC2(B) CALL STCODE MOVSI %01,BC2 JRST STCODE ;GENERATE TWO WORDS > .ODD: ; ".ODD" DIRECTIVE TRNE %05,1 RETURN JRST .EVENX .EVEN: TRNN %05,1 RETURN .EVENX: MOVEI %10,1 JRST .DEPHX .PHASE: CALL RELEXP MOVE %03,%05 TRO %03,600000 SUB %03,%10 TLNE %03,(PFMASK) ERRXIT ERR.A!ERR.P1 ANDI %03,177777 MOVEM %03,PHAOFF .PHASX: TRZ %10,600000 SPUSH M40DOT JRST ASGMTF .DEPHA: SETZM %10 EXCH %10,PHAOFF .DEPHX: ADD %10,%05 JRST .PHASX .LOC PHAOFF: BLOCK 1 .RELOC .BLKB: TDZA %03,%03 .BLKW: SETOM %03 HLLM %03,0(%17) CALL SETPF0 ;LIST LOCATION CALL EXPR MOVEI %10,1 CALL ABSTST CALL SETPF1 SKIPGE 0(%17) ASH %10,1 ADD %10,%05 TRZ %10,600000 SPUSH M40DOT JRST ASGMTX .EQUIV: ;.EQUIV DEFSYM,ANYSYM CALL GSARG ;GET SYMBOLIC ARG JRST OPCERR ; ERROR MOVEM %00,.EQUI9 ;OK, SAVE IT CALL GSARG ;GET SECOND ARG JRST OPCERR ; MISSING EXCH %00,.EQUI9 ;GET FIRST MNEMONIC CALL OSRCH ;TEST FOR MACRO/OP CODE JRST .EQUI1 ; NO CALL CRFOPR JRST .EQUI2 .EQUI1: CALL SSRCH ;NO, TRY USER SYMBOL JRST OPCERR ; MISSING CALL CRFREF .EQUI2: CAIN %02,MAOP ;FOUND, MACRO? CALL INCMAC ;YES, INCREMENT USE LEVEL MOVE %00,.EQUI9 ;GET SECOND MNEMONIC MOVEM %01,.EQUI9 ;SAVE VALUE CAIE %02,0 ;USER SYMBOL? MOVEI %02,1 ;NO NO, TREAT AS OP SPUSH %02 CALL @[EXP SSRCH,MSRCH](%02) ;CALL PROPER SEARCH JFCL CAIN %02,MAOP ;MACRO? TRNE %02,-1 CAIA CALL DECMAC ; YES, DECREMENT REFERENCE MOVE %01,.EQUI9 ;GET NEW VALUE SPOP %02 CALL @[EXP CRFDEF,CRFOPD](%02) JRST INSRT ;INSERT AND EXIT .LOC .EQUI9: BLOCK 1 .RELOC .PDP10: RETURN ;NO-OP, FOR COMPATIBILITY W/ MACX11 .TITLE: ;TITLE PSEUDO-OP SPUSH SYMEND ;SAVE START CALL GETSYM ;GET THE SYMBOL SPOP %13 SKIPN %00 ;ONE FOUND? ERRXIT ERR.A ; NO, FLAG ERROR AND EXIT MOVEM %00,PRGTTL ;YES, STORE TITLE MOVEI %01,TTLBUF ;POINT TO TITLE BUFFER JRST .SBTT1 ;EXIT THROUGH SUB-TITLE .SBTTL: ;SUB-TITLE PROCESSOR MOVE %13,SYMEND TLNN %15,P1F ;PASS ONE? JRST .SBTT3 ; NO MOVEM %13,CLIPNT ;YES, FUDGE FOR TABLE OF CONTENTS SKPLCS LC.TOC TLO %16,P1LBIT TLO %15,NQEFLG!LHMFLG RETURN .SBTT3: MOVEI %01,STLBUF ;POINT TO PROPER BUFFER .SBTT1: HRLI %01,(POINT 7,) ;COMPLETE BYTE POINTER MOVEI %02,TTLLEN ;SET COUNT .SBTT2: GETCHR ;GET THE NEXT CHARACTER SOSL %02 IDPB %14,%01 ;STORE IN BUFFER JUMPN %14,.SBTT2 IDPB %14,%01 ;BE SURE TO STORE TERMINATOR RETURN .IDENT: ; ".IDENT" SPUSH %05 ;SAVE PC SETZM %05 ;NO EVEN TEST CALL .RAD50 ;PROCESS AS RAD50 SETZM CODPNT ;SET FOR SCAN CALL FETCOD ;FETCH NEXT ENTRY JFCL HRLZM %01,PRGIDN CALL FETCOD JFCL HRRM %01,PRGIDN SPUSH %04 ;CLEAR A REGISTER MOVEI %05,1 ;THE FOLLOWING CODE CLEARS POSSIBLE TRASH IN THE CODE BUFFER .IDNT1: AOS %05 ;INCREMENT POINTER INTO BUFFER SKIPE %04,CODBUF(%05) ;WORD CLEAR? SETZM CODBUF(%05) ;CLEAR IT JUMPN %04,.IDNT1 ;BACK IF IT WASN'T CLEAR SPOP %04 ;IF IT WAS, SET UP FOR A RETURN.... SPOP %05 ;.... RETURN ;..AND DO IT .LOC TTLBUF: BLOCK /5+1 ;TITLE BUFFER STLBUF: BLOCK /5+1 ;SUB-TITLE BUFFER PRGTTL: BLOCK 1 ;PROGRAM TITLE PRGIDN: BLOCK 1 ;PROGRAM IDENT .RELOC .REM: ;REMARK JUMPE %14,OPCERR ;ERROR IF EOL SPUSH %14 .REM1: GETCHR .REM2: CAMN %14,0(%17) JRST .REM3 JUMPN %14,.REM1 CALL ENDL TLNE %15,ENDFLG JRST .REM4 CALL GETLIN SKPLCS LC.TTM TLO %15,LHMFLG ;LEFT JUSTIFY IF IN TTM MODE JRST .REM2 .REM3: CALL GETNB .REM4: SPOP 0(%17) RETURN .ERROR: TLNE %15,P1F ; ".ERROR", PASS ONE? RETURN ; YES, IGNORE AOS ERRCNT .PRINT: ; ".PRINT" DIRECTIVE TLO %16,ERRBIT ;FORCE TTY LISTING CALL SETPF0 CALL EXPR ;ANY EXPRESSION? RETURN ; NO JRST SETPF1 .EOT: RETURN .ROUND: TDZA %03,%03 .TRUNC: MOVEI %03,1 MOVEI %01,ED.FPT TDNN %01,EDMSK XCT [EXP , ](%03) HRRM %12,EDFLGS RETURN .RADIX: MOVEI %03,^D10 EXCH %03,CRADIX SPUSH %03 CALL ABSEXP CAIL %10,^D2 CAILE %10,^D10 ERRSKP ERR.N MOVEM %10,0(%17) POP %17,CRADIX RETURN .LOC CRADIX: BLOCK 1 ;CURRENT RADIX .RELOC .END: ;"END" PSEUDO-OP SKIPE CNDLVL ;IF IN CONDITIONAL ERRSET ERR.E ; FLAG ERROR TLO %15,ENDFLG ;FLAG "END SEEN" CALL EXPR ;EVALUATE THE ADDRESS END2: MOVEI %10,1 ; NULL, FORCE ODD VECTOR MOVEM %10,ENDVEC TRNE %15,ERR.U ;ANY UNDEFINED SYMBOLS? ERRSET ERR.P1 ; YES, PASS ONE ERROR JRST SETPF1 .LOC ENDVEC: BLOCK 1 ;END VECTOR .RELOC SUBTTL DATA-GENERATING DIRECTIVES .ASCII: TLZA %15,ASZFLG ; ".ASCII" DIRECTIVE .ASCIZ: TLO %15,ASZFLG ; ".ASCIZ" DIRECTIVE SPUSH %05 ;STACK LOCATION COUNTER .ASCI1: SETZM %01 ;CLEAR AC .ASCI2: CALL GTCHR ;GET A TEXT CHARACTER JRST .ASCI6 ; NO TRZE %10,177400 ;OVERFLOW? ERRSET ERR.T ; YES .ASCI3: JUMPN %01,.ASCI4 ;BRANCH IF SECOND BYTE OF WORD DPB %10,[POINT 8,%01,35] ;HIGH ORDER, STORE HRLI %01,BC1 ;FLAG AS SINGLE BYTE TRNN %05,1 ;ODD LOCATION? AOJA %05,.ASCI2 ; NO, GET ANOTHER ARG JRST .ASCI5 ;YES, DUMP IT OUT .ASCI4: DPB %10,[POINT 8,%01,35-8] ;STORE ODD BYTE HRLI %01,BC2 ;FLAG AS DOUBLE .ASCI5: CALL STCODE ;STORE IT AOJA %05,.ASCI1 ;TRY FOR MORE .ASCI6: MOVEI %10,0 TLZE %15,ASZFLG ;ASCIZ MODE? JRST .ASCI3 ; YES SKIPE %01 ;NO, ANY CODE ACCUMULATED? CALL STCODE ; YES, DUMP IT JRST .WORDX ;RESTORE PC AND EXIT .RAD50: ; ".RAD50" DIRECTIVE CALL TSTEVN ;BE SURE ITS AN EVEN LOCATION SPUSH %05 ;STACK PC .RAD51: SETZM %00 ;CLEAR AC MOVSI %01,(POINT 6,%00) ;SET POINTER .RAD52: CALL GTCHR ;GET A TEXT ARGUMENT JRST .RAD54 ; FINISHED TRZE %10,177600 ;OVERFLOW? ERRSET ERR.T ; YES CAIL %10,"A"+40 CAILE %10,"Z"+40 CAIA SUBI %10,40 EXCH %14,%10 LDB %02,ANPNTR ;MAP EXCH %14,%10 SUBI %10,40 ;CONVERT TO SIXBIT JUMPE %10,.RAD53 ;ACCEPT BLANKS CAIN %02,0 ;SKIP IF ALPHA/NUMERIC ERRSKP ERR.A ;ELSE ERROR .RAD53: IDPB %10,%01 ;STORE CHARACTER CAME %01,[POINT 6,%00,17] ;3 CHARS ACCUMULATED? JRST .RAD52 ; NO CALL .RAD55 ;YES, STORE THIS WORD JRST .RAD51 ;LOOP .RAD54: CAME %05,0(%17) ;STORE ZERO IF EMPTY TLNN %01,(1B0) ;YES, CURRENT WORD EMPTY? CALL .RAD55 ; NO, DUMP IT JRST .WORDX ;RESTORE PC AND EXIT .RAD55: CALL SIXM40 ;CONVERT TO RAD50 HLRZ %01,%00 ;ARG TO AC HRLI %01,BC2 ;FLAG AS WORD CALL STCODE ;STORE IT ADDI %05,2 ;UPDATE PC RETURN .BYTE: ;"BYT" PSEUDO-OP SPUSH %05 ;STACK PC .BYTE1: CALL EXPR ;EVALUATE EXPRESSION JFCL ; ACCEPT NULLS TRNE %10,177400 ;ANY HIGH ORDER BITS SET? TRC %10,177400 ; YES, TOGGLE FOR TEST CALL TSTARB ;TEST ARITHMETIC BYTE TLC %01,BC1!BC2 ;RESET TO ONE BYTE CALL STCODE HRROS ARGCNT CALL TGARG ;ANY MORE? JRST .WORDX ; NO AOJA %05,.BYTE1 ;INCREMENT PC AND LOOP .WORD: ;"WORD" PSEUDO-OP CALL TSTEVN SPUSH %05 ;STACK PC .WORD1: CALL EXPR ;EVALUATE EXPRESSION JFCL ; ACCEPT NULLS CALL TSTAR CALL STCODE HRROS ARGCNT CALL TGARG ;END OF STRING? JRST .WORDX ; YES, EXIT ADDI %05,2 ;INCREMENT PC JRST .WORD1 ;GO FOR MORE .WORDX: SPOP %05 ;RESTORE ORIGIONAL PC RETURN .FLT2: SKIPA %03,[2] ;TWO WORD FLOATING .FLT4: MOVEI %03,4 ;FOUR WORD FLOATING MOVEM %03,FLTLEN ;SET LENGTH FOR ROUNDING .FLT2A: CALL FLTG ;PROCESS FLOATING POINT TLNE %15,FLTFLG ;ANY ERRORS? ERRSET ERR.A ; YES MOVN %06,FLTLEN ;SET NEGATIVE OF LENGTH HRLZS %06 ;SET INDEX .FLT2B: MOVE %01,FLTNUM(%06) ;GET A VALUE HRLI %01,BC2 CALL STCODE ;STORE IT AOBJN %06,.FLT2B ;LOOP IF MORE HRROS ARGCNT CALL TGARG ;MORE? RETURN ; NO JRST .FLT2A ;GET ANOTHER SUBTTL "A" EXPRESSION EVALUATOR AEXP: ;"A" EXPRESSION EVALUATOR CALL AEXP0A LDB %03,[POINT 3,%00,35-3] ;GET MODE MOVE %04,[DEC 0,14,14,26,14,26,26,38](%03) RETURN AEXP0A: PUSH %17,[0] ;STACK INITIAL VALUE AEXP01: CAIN %14,"#" JRST AEXP02 CAIN %14,"%" JRST AEXP04 CAIN %14,"(" JRST AEXP06 CAIN %14,"-" JRST AEXP07 CAIN %14,"@" JRST AEXP08 JRST AEXP10 ;NO UNARIES, PROCESS BASIC EXPRESSION AEXP02: ; # CALL GETNB ;BYPASS UNARY OP CALL EXPR ;EVALUATE EXPRESSION ERRSET ERR.Q ; NULL, ERROR AEXP03: CALL TSTAR ;TEST ARITHMETIC SPOP %00 ;RETRIEVE PRESET VALUE TRO %00,27 ;SET BITS AOS %02,OFFSET ;GET OFFSET MOVEM %01,ADREXT-1(%02) ;STORE ADDRESS RETURN ;EXIT AEXP04: ; % CALL REGEXP ;EVALUATE REG EXPRESSION SPOP %00 ;RETRIEVE CODE AEXP05: TRZE %10,-10 ;ANY OVERFLOW? ERRSKP ERR.R ; YES, FLAG ERROR AND SKIP TRO %00,00(%10) ;SET BITS RETURN ;EXIT AEXP06: ; ( CALL AEXP20 ;EVALUATE PARENTHESES SETZ %01, ;ZERO IN CASE OF INDEX CAIE %14,"+" ;FINAL "+" SEEN? JRST AEXP13 ; NO, GO SEE IF (R) OR @(R)? SPOP %00 ;YES, RETRIEVE CODE TRO %00,20(%10) ;SET BITS JRST GETNB ;BYPASS DELIMITER AND EXIT AEXP13: SPOP %00 ;GET CODE TRON %00,10 ;IS "@" SET? JRST AEXP05 ;NO-REGISTER MODE SPUSH %00 ;YES-INDEX MODE JRST AEXP12 AEXP07: ; -( MOVEM %13,SYMBEG ;SAVE POINTER IN CASE OF FAILURE CALL GETNB ;GET THE NEXT NON-BLANK CAIE %14,"(" ;PARENTHESIS? JRST AEXP09 ; NO, TREAT AS EXPRESSION CALL AEXP20 ;YES, EVALUATE SPOP %00 ;RETRIEVE CODE TRO %00,40(%10) ;SET BITS RETURN ;EXIT AEXP08: ; @ SPOP %00 ;RETRIEVE BASIC CODE TROE %00,10 ;SET INDIRECT BIT, WAS IT BEFORE? ERRSET ERR.Q ; YES, FLAG ERROR SPUSH %00 ;RE-STACK CODE CALL GETNB ;BYPASS CHARACTER JRST AEXP01 ;GO BACK TO BEGINNING AEXP09: ; -( FAILURE MOVE %13,SYMBEG ;GET POINTER TO "-" CALL SETNB ;RESTORE CHARACTER AEXP10: ; NO UNARIES CALL EXPR ;EVALUATE EXPRESSION ERRSET ERR.Q ; NULL, ERROR CAIN %14,"(" ;ANOTHER EXPRESSION? JRST AEXP11 ; YES, BRANCH SPOP %00 ;RETRIEVE CODE TLNE %10,REGSYM ;REGISTER EXPRESSION? JRST AEXP05 ; YES, TREAT AS % MOVE %01,%10 ;GET VALUE LDB %02,SUBPNT ; RELOCATION LDB %04,CCSPNT ; CURRENT SECTOR SKIPN %00 ;ANY INDIRECTION? SKPEDS ED.AMA!ED.PIC ; NO, ABSOLUTE MODE REQUESTED? JRST AEXP1R ; NO, PROCESS RELATIVE SKPEDS ED.PIC ;PIC? JRST AEXP1Q ; NO, JUST AMA TLNN %10,GLBSYM ;YES, IF GLOBAL CAME %02,%04 ; OR OTHER SECTOR, CAIA ; TREAT AS AMA JRST AEXP1R ;ELSE RELATIVE AEXP1Q: TRO %00,10 ;SET INDIRECT BIT SPUSH %00 JRST AEXP03 ;FINISH WITH 37 AEXP1R: TRO %00,67 ;SET BITS FOR INDEXED BY PC. HRLI %01,BC2 ;TWO DATA BYTES MOVEI %03,RLDT6 ;ASSUME EXTERNAL TLNE %10,GLBSYM JRST AEXP1B ; TRUE, OK AS IS CAME %02,%04 ;SAME SEG? JRST AEXP1A ; NO, FURTHER TESTING REQUIRED SUBI %10,4(%05) ;YES, COMPUTE OFFSET SKIPE OFFSET ;THIRD WORD? SUBI %10,2 ; YES, TWO MORE FOR GOOD MEASURE DPB %10,[POINT 16,%01,35] ;STORE RESULT JRST AEXP1D ;BRANCH TO EXIT AEXP1A: MOVEI %03,RLDT3 ;OK FOR QUICKIE? JUMPE %02,AEXP1C ; YES, IF TO ABS SEG MOVE %04,SECNAM(%02) AOS %02,GLBPNT MOVEM %04,GLBBUF(%02) ;STORE IN GLOBAL TEMP MOVEI %03,RLDT16 ;TYPE #16 AEXP1B: DPB %02,SUBPNT ;STORE GLOBAL BUFFER POINTER AEXP1C: SKPEDR ED.PIC ;PIC ENABLED? ERRSET ERR.R ; YES, NO REL TO OTHER SECTOR DPB %03,MODPNT ;STORE MODE AEXP1D: AOS %02,OFFSET MOVEM %01,ADREXT-1(%02) RETURN AEXP11: ; E1(E2) TLNE %10,REGSYM ;REGISTER EXPRESSION? ERRSET ERR.R ; YES, ERROR SPUSH %10 ;STACK E1 CALL AEXP20 ;PROCESS EXPRESSION SPOP %01 ;RETRIEVE E1 AEXP12: DPB %10,[POINT 3,0(%17),35] ;STORE REG MOVE %10,%01 CALL TSTAR ;TEST MODE AOS %02,OFFSET MOVEM %01,ADREXT-1(%02) ;STORE ADDRESS SPOP %00 ;RETRIEVE CODE BITS TRO %00,60 ;COMPLETE CODE RETURN ;EXIT AEXP20: ;() CALL GETNB ;BYPASS PAREN CALL REGEXP ;EVALUATE REGISTER EXPRESSION CAIE %14,")" ;PROPER DELIMITER ERRSKP ERR.Q ; NO, FLAG ERROR AND SKIP CALL GETNB ; YES, BYPASS CHARACTER JRST SETNB ;RETURN WITH NON-BLANK DELIMITER TSTARB: ;TEST ARITHMETIC BYTE CALL TSTAR ;TEST ARITHMETIC TRZE %01,177400 ;OVERFLOW? ERRSET ERR.A ; YES LDB %02,MODPNT ;FETCH CLASS CAIE %02,RLDT1 ;IF ONE CAIN %02,RLDT15 ; OR FIFTEEN, ERRSET ERR.A ;RELOCATION ERROR SKIPE %02 ;ABSOLUTE? TRO %02,200 ; NO, MAKE BIT MODIFICATION DPB %02,MODPNT RETURN TSTAR: ;TEST ADDITIVE RELOCATION (0,1,5,15) MOVE %01,%10 ;COPY TO FINAL AC LDB %02,SUBPNT ;GET RELOCATION HRLI %01,BC2 ;SET FOR TWO BYTES JUMPE %02,CPOPJ ;EXIT IF ABS MOVEI %03,RLDT5 ;ASSUME EXTERNAL TLNE %10,GLBSYM ;GLOBAL? JRST TSTAR1 ; YES MOVEI %03,RLDT1 LDB %04,CCSPNT CAMN %02,%04 ;CURRENT SECTOR? JRST TSTAR3 ; YES MOVE %04,SECNAM(%02) AOS %02,GLBPNT MOVEM %04,GLBBUF(%02) ;STORE SECTOR NAME MOVEI %03,RLDT15 ;TYPE 15 TSTAR1: DPB %02,SUBPNT TSTAR2: DPB %03,MODPNT RETURN TSTAR3: SKPEDR ED.PIC ;PIC ENABLED? ERRSET ERR.R ; YES, NO DIRECT REFS TO CURRENT JRST TSTAR2 .LOC GLBPNT: BLOCK 1 GLBBUF: BLOCK 40 .RELOC SUBTTL EXPRESSION EVALUATOR REGEXP: ;REGISTER EXPRESSION CALL EXPR ERRSET ERR.A ; NULL, ERROR REGTST: TDZE %10,[B17!377B!177770] ERRSET ERR.R ; ERROR RETURN ABSEXP: ;ABSOLUTE EXPRESSION CALL EXPR ERRSET ERR.A ABSTST: TLZE %10,(B17!377B) ERRSET ERR.A ;ERROR IF GLOBAL OR RELOCATABLE ANDI %10,177777 RETURN RELEXP: ;RELOCATABLE EXPRESSION CALL EXPR ERRSET ERR.A RELTST: TLNE %10,GLBSYM ;NO GLOBALS ALLOWED JRST ABSTST ;LET ABS FLAG IT RETURN EXPR: ;EXPRESSION PROCESSOR, REGISTER ALLOWED CALL TERM ;GET THE FIRST TERM POPJ %17, ; NULL, EXIT SETZB %04,RELLVL ;CLEAR RELOCATION LEVEL COPNT CALL EXPRPX ;SET, IF NECESSARY EXPR1: LDB %03,C4PNTR ;MAP CHARACTER USING COLUMN 4 JUMPE %03,EXPR3 ;BRANCH IF NULL SPUSH EXPRJT(%03) ;STACK ENTRY SPUSH %10 ;STACK CURRENT VALUE CALL GETNB ;BYPASS OP CALL TERM ;GET THE NEXT EXPRESSION TERM ERRSET ERR.Q ; NULL, FLAG ERROR SPOP %01 ;GET PREVIOUS VALUE SPOP %02 CALL 0(%02) ;CALL ROUTINE ERRSET ERR.A ; ERROR TRZ %10,600000 ;CLEAR ANY OVERFLOW JRST EXPR1 ;TEST FOR MORE EXPR3: SOSLE RELLVL ;RELOCATION LEVEL .GT. 1? ERRSET ERR.A ; YES JRST CPOPJ1 ;EXIT GOOD EXPRJT: ;EXPRESSION JUMP TABLE PHASE 0 0 EXPL: MOVEI %02,EXPRPL ; + EXMI: MOVEI %02,EXPRMI ; - EXOR: IOR %10,EXPXCT ; ! EXAN: AND %10,EXPXCT ; & EXMU: IMUL %10,EXPXCT ; * EXDV: IDIV %10,EXPXCT ; / DEPHASE EXPRPL: ; + TDZA %04,%04 ;ZERO FOR ADD EXPRMI: ; - HRROI %04,1 ;ONE FOR SUBTRACT CALL EXPRPX ;UPDATE RELOCATION COUNT EXPRP1: LDB %02,SUBPNT ;GET RELOCATION EXCH %10,%01 LDB %03,SUBPNT TLNE %01,REGSYM TLO %10,REGSYM ;TRANSFER REGISTER FLAG JUMPE %03,EXPRM1 ;BRANCH IF SUBTRACTING ABS TLON %04,-1 ;NOT ABS, FIRST-TIME ADDITION? JRST EXPRP1 ; YES, REVERSE TLNN %01,GLBSYM ;IF EITHER IS GLOBAL, TLNE %10,GLBSYM JRST EXPRM2 ; ERROR CAME %02,%03 ;LAST CHANCE, BOTH SAME RELOCATION JRST EXPRM2 ; FORGET IT SKIPN RELLVL ;IF BACK TO ZERO, TLZ %10,(PFMASK) ;MAKE ABSOLUTE EXPRM1: AOS 0(%17) ;INDICATE GOOD RESULT EXPRM2: XCT [EXP ,](%04) ;PERFORM OP DPB %01,[POINT 16,%10,35] ;STORE TRIMMED RESULT RETURN ;EXIT EXPRPX: ;UPDATE RELOCATION LEVEL TLNE %10,(PFMASK) ;IF ABS, TLNE %10,GLBSYM ; OR GLOBAL, RETURN ; NO ACTION XCT [EXP ,](%04) ERRSET ERR.A ; NEGATIVE COUNT, ERROR RETURN EXPXCT: HRRI %02,%01 ;COMPLETE INSTRUCTION SPUSH %02 ;STACK INSTRUCTION CALL EXPXC1 ;TEST FOR ABSOLUTE EXCH %10,%01 CALL EXPXC1 ;DITTO FOR OTHER SPOP %02 ;FETCH INSTRUCTION XCT %02 ;EXECUTE IT ANDI %10,177777 ;MAKE ABSOLUTE JRST CPOPJ1 ;GOOD EXIT EXPXC1: CALL ABSTST ;TEST FOR ABSOLUTE LSH %10,^D<36-16> ASH %10,-^D<36-16> ;EXTEND SIGN RETURN .LOC RELLVL: BLOCK 1 ;RELOCATION LEVEL .RELOC SUBTTL TERM EVALUATOR TERM: ;TERM PROCESSOR SETZB %10,%01 ;RETURN VALUE IN %10 CALL GETSYM ;TRY FOR SYMBOL JUMPE %00,TERM4 ; NOT A SYMBOL CALL SSRCH ;SEARCH TABLE JRST TERM2 ; NOT THERE TERM0: CALL CRFREF ; TLNE %01,MDFSYM ;MULTIPLY DEFINED? ERRSET ERR.D ;YES TLNN %01,DEFSYM!GLBSYM ;UNDEFINED? ERRSET ERR.U ;YES. NOTE THAT THIS TRAP CAN BE ;ENTERED ONLY WHEN THE DEFAULT GLOBALS ARE DISABLED. MOVE %03,%01 ;GET EXTRA COPY TLZ %01,776000-REGSYM ;CLEAR ALL BUT REGISTER BIT TLNN %03,DEFSYM ;DEFINED? TLNN %03,GLBSYM ; NO, GLOBAL? JRST TERM1 ; LOCAL TLO %01,GLBSYM ;JUST GLOBAL AOS %04,GLBPNT ;GLOBAL MOVEM %00,GLBBUF(%04) ;SAVE NAME DPB %04,SUBPNT ;SAVE NUMBER IN RELOCATION TERM1: MOVE %10,%01 ;RESULT TO %10 JRST CPOPJ1 ;GOOD EXIT TERM2: CALL OSRCH ;TRY OP CODES JRST TERM3 ; NO CAIE %02,OCOP ;PSEUDO-OP? JRST TERM3 ; YES CALL CRFOPR HRRZ %10,%01 ;YES, TREAT AS NUMERIC JRST CPOPJ1 ;GOOD EXIT TERM3: CALL SSRCH ;NOT YET DEFINED SKPEDS ED.ABS ;SKIP IF ABSOLUTE ASSEMBLY TLNE %16,GBLDIS ;ARE DEFAULT GLOBALS ENABLED? JRST TERM5 ;NO. TLO %01,FLTSYM!GLBSYM ;DEFAULT GLOBAL SYMBOL CALL INSRT JRST TERM0 TERM4: LDB %02,C5PNTR ;NON-SYMBOLIC XCT TERMJT(%02) ;EXECUTE TABLE JRST CPOPJ1 ;GOOD EXIT TERM5: ;DEFAULT GLOBALS DISALLOWED CALL INSRT CALL CRFREF ERRSET ERR.U ;FLAG THE STATEMENT JRST CPOPJ1 ;TAKE THE SKIP RETURN TERMJT: ;TERM JUMP TABLE PHASE 0 RETURN ;NULL RETURN TEPL: CALL TERMPL ; + TEMI: CALL TERMMI ; - TEUA: CALL TERMUA ; ^ TEAB: CALL TERMAB ; <> TESQ: CALL TERMSQ ; ' TEDQ: CALL TERMDQ ; " TEPC: CALL TERMPC ; % TENM: CALL TERMNM ; 0-9 DEPHASE TERMPL: ; + CALL GETNB CALL TERM ERRSET ERR.A RETURN TERMMI: ; - CALL TERMUC ADDI %10,1 TRZ %10,600000 RETURN TERMUA: ; ^ CALL GETNB CAIN %14,"F" JRST TERMUF CAIN %14,"C" JRST TERMUC SETZ %03, CAIN %14,"D" MOVEI %03,^D10 CAIN %14,"O" MOVEI %03,^D8 CAIN %14,"B" MOVEI %03,^D2 SKIPN %03 ERRXIT ERR.A SPUSH CRADIX MOVEM %03,CRADIX CALL TERMPL SPOP CRADIX RETURN TERMUC: CALL TERMPL CALL ABSTST TRC %10,177777 RETURN TERMUF: CALL GETNB MOVEI %03,1 MOVEM %03,FLTLEN CALL FLTG TLNE %15,FLTFLG ERRSET ERR.A LDB %10,[POINT 16,FLTNUM,35] RETURN TERMAB: ; <> CALL GETNB SPUSH RELLVL CALL EXPR ERRSET ERR.A CAIE %14,">" ;"<" ERRSKP ERR.A CALL GETNB SPOP RELLVL RETURN TERMNM: ;NUMERIC TERM SETZB %00,%01 ;CLEAR ACS TERMN1: IMULI %10,^D10 ;DECIMAL ACCUMULATOR ADDI %10,-"0"(%14) IMUL %01,CRADIX ADDI %01,-"0"(%14) CAIGE %00,-"0"(%14) ;HIGHEST NUMBER SO FAR? MOVEI %00,-"0"(%14) ; YES, SAVE IT GETCHR ;GET THE NEXT CHARACTER CAIL %14,"0" ;TEST NUMERIC CAILE %14,"9" CAIA ; NO JRST TERMN1 ;YES, PROCESS IT CAIE %14,"." ;DECIMAL POINT? JRST TERMN2 ; NO CALL GETNB ;YES, BYPASS IT JRST TERMN3 ;SKIP AROUND TEST TERMN2: CAIN %14,"$" JRST TERMN4 CAML %00,CRADIX ;IN BOUNDS? ERRSKP ERR.N ; YES, FLAG ERROR AND LEAVE DECIMAL MOVE %10,%01 ;NO, MOVE OCTAL IN TERMN3: TDZE %10,[-1B19] ;OVERFLOW? ERRSET ERR.T ; YES, FLAG TRUNCATION ERROR JRST SETNB TERMN4: MOVE %00,%10 HRL %00,LSBNUM TLO %00,ST.LSB TLO %15,LSBFLG CALL SSRCH ERRSET ERR.U MOVE %10,%01 JRST GETNB TERMPC: ; % CALL GETNB ;BYPASS PERCENT CALL TERM ;GET A TERM ERRSET ERR.R ; ERROR CALL REGTST ;TEST VALID REGISTER TERM TLO %10,REGSYM ;FLAG IT RETURN ;EXIT TERMDQ: ; """ GETCHR ;GET THE NEXT NON-TERMINATOR JUMPE %14,TERMQE ; END OF LINE, ERROR LDB %10,%13 ;LOAD UN-MAPPED CHARACTER GETCHR ;TRY ONE MORE JUMPE %14,TERMQE ; ERROR LDB %14,%13 DPB %14,[POINT 8,%10,35-8] ;STORE IN UPPER JRST GETNB ;RETURN WITH NEXT NON-BLANK TERMSQ: ; "'" GETCHR ;GET NON-TERMINATOR JUMPE %14,TERMQE ; TERMINATOR, ERROR LDB %10,%13 ;LOAD UN-MAPPED CHARACTER JRST GETNB ;RETURN NON-BLANK TERMQE: ERRSET ERR.Q ;RAN OUT OF CHARACTERS RETURN SUBTTL SYMBOL/CHARACTER HANDLERS GETSYM: ;GET A SYMBOL MOVEM %13,SYMBEG ;SAVE START FOR RESCAN SETZB %00,%01 ;CLEAR AC AND COUNT GETSY1: MOVEM %13,SYMEND ;SAVE END LDB %02,ANPNTR ;MAP CHARACTER TYPE XCT GETSYT(%02) ;EXECUTE TABLE JRST SETNB ; FINISHED, RETURN NEXT NON-BLANK CAIL %01,6 ;OVERFLOW? JRST GETSY2 ; YES, DON'T STORE HLRZ %03,RADTBL-40(%14) ;MAP CHAR IMUL %03,RAD50M(%01) ;SKIFT IT ADD %00,%03 ;ACCUMULATE GETSY2: GETCHR ;GET THE NEXT CHAR AOJA %01,GETSY1 ;TRY FOR MORE GETSYT: ;GETSYM TABLE PHASE 0 JFCL ;NON-ALPHA/NUMBERIC .DOL:! TLNN %16,MODBIT ;INVALID IN COMMAND STRING .DOT:! TLNN %16,MODBIT ;DITTO .ALP:! CAIA .NUM:! CALL GETSY3 ;NUMERIC, DOUBLE TEST DEPHASE GETSY3: TLNE %16,MODBIT ;ACCEPT IF IN COMMAND STRING JUMPE %00,CPOPJ ; NO, NULL IF FIRST JRST CPOPJ1 RAD50M: ;RAD50 MULTIPLIERS XWD 50*50, XWD 50, XWD 1, XWD ,50*50 XWD ,50 XWD ,1 GETLSB: ;GET LOCAL SYMBOL SETZM %00 GETLS1: CAIL %14,"0" ;TEST RANGE CAILE %14,"9" JRST GETLS2 ; OUTSIDE IMULI %00,^D10 ;OK, ACCUMULATE NUMBER ADDI %00,-"0"(%14) GETCHR JRST GETLS1 GETLS2: JUMPE %00,GETLS3 CAIE %14,"$" JRST GETLS3 CAILE %00,^D127 ;NUMBER TOO LARGE? ERRSET ERR.T ; YES, ERROR HRL %00,LSBNUM ;STUFF IN BLOCK NUMBER TLO %00,ST.LSB ;FLAG IT TLO %15,LSBFLG JRST GETNB GETLS3: MOVE %13,SYMBEG ;MISSED, RESTORE POINTER SETZM %00 JRST SETNB OPDEF GETNB [CALL .] GETNB: ;GET NON-BLANK CHARACTER IBP %13 ;INDEX BYTE POINTER OPDEF SETNB [CALL .] SETNB: ;SET TO NON-BLANK CHARACTER SETCHR ;SET CHARACTER IN %14 CAIE %14,SPACE ;IF SPACE CAIN %14,TAB ; OR TAB; JRST GETNB ; BYPASS RETURN ;OTHERWISE EXIT ; OPDEF GETCHR [ILDB %14,%13] OPDEF GETCHR [CALL .] GETCHR: ;GET THE NEXT CHARACTER IBP %13 ;INDEX BYTE POINTER ; OPDEF SETCHR [LDB %14,%13] OPDEF SETCHR [CALL .] SETCHR: ;SET THE CURRENT CHAR IN %14 LDB %14,%13 CAIL %14,"A"+40 CAILE %14,"Z"+40 RETURN SUBI %14,40 RETURN .LOC SYMBEG: BLOCK 1 ;SYMBOL START SYMEND: BLOCK 1 ;SYMBOL END .RELOC SUBTTL ARGUMENT HANDLERS TGARG: ;TEST FOR GENERAL ARGUMENT SETZM GTCDEL ;CLEAR DELIMITER TLNN %16,MODBIT ;EXEC MODE? JRST TGARG1 ; YES CAIE %14,";" ;EOL? CAIN %14,0 RETURN ; YES SKIPL ARGCNT ;END OF EXPRESSION? JRST TGARG5 ; NO HRRZS ARGCNT ;YES, CLEAR FLAG CAIN %14,"," ;REQUIRED COMMA SEEN? JRST TGARG2 ; YES RETURN ;NO, CONSIDER NULL TGARG5: SKIPE ARGCNT ;NO, FIRST ARGUMENT? CAIE %14,"," ; NO, COMMA TO BYPASS? JRST TGARG3 ; NO JRST TGARG2 ;YES TGARG1: CAIE %14,":" ;EXEC MODE, ARGUMENT? RETURN ; NO TGARG2: CALL GETNB ;YES, BYPASS TERMINATOR TGARG3: AOS ARGCNT ;INCREMENT ARG COUNT JRST CPOPJ1 ;GOOD EXIT GSARG: ;GET SYMBOLIC ARGUMENT CALL TGARG ;TEST FOR EXISTENCE RETURN ; NO GSARGF: CALL GETSYM ;YES, GET SYMBOL JUMPN %00,CPOPJ1 ;GOOD EXIT ERRSET ERR.A ; ERROR RETURN ;ERROR, BAD EXIT .LOC ARGBLK: ;GENERAL ARGUMENT BLOCK ARGPNT: BLOCK 1 ;POINTER TO PREVIOUS ARGBEG: BLOCK 1 ;START OF ARG ARGEND: BLOCK 1 ;END OF ARG ARGCHC: BLOCK 1 ;CHARACTER COUNT ARGTXP: BLOCK 1 ;TEXT POINTER ARGCNT: BLOCK 1 ;ARGUMENT NUMBER COUNT ARGLEN= .-ARGBLK .RELOC GTCHR: ;GET TEXT CHARACTER SKIPE GTCDEL ;DELIMITER IN PROGRESS? JRST GTCHR3 ; YES SKIPE ARGCNT ;NO, FIRST ARG? CAIE %14,";" ;NO, EOL? CAIN %14,0 RETURN ; YES, TAKE NULL EXIT CAIE %14,"<" ;EXPRESSION MODE? JRST GTCHR2 ; NO CALL GETNB ;YES, BYPASS CHARACTER SPUSH %00 ;STACK REGISTERS SPUSH %01 CALL ABSEXP ;EVALUATE EXPRESSION SPOP %01 SPOP %00 CAIE %14,">" ;GOOD TERMINATION? ERRSKP ERR.A ; NO CALL GETNB ;YES, BYPASS IT GTCHR1: AOS ARGCNT ;BUMP ARG COUNT JRST CPOPJ1 ;GOOD EXIT GTCHR2: MOVEM %14,GTCDEL ;SET DELIMITER GTCHR3: GETCHR ;GET THE NEXT CHARACTER CAME %14,GTCDEL ;TERMINATOR? JRST GTCHR4 ; NO SETZM GTCDEL ;YES, CLEAR DELIMITEP CALL GETNB ;BYPASS DELIMITER ;BLOWUP IF THE LINE IS HENCEFORTH EMPTY JRST GTCHR ;TRY AGAIN GTCHR4: LDB %10,%13 ;GET UN-MAPPED COPY JUMPN %10,GTCHR1 ;BRANCH IF NOT EOL MOVEI 6,";" ;SEE IF LAST DELIMITER WAS A SEMICOLON CAME %06,GTCDEL ;WAS IT? ERRSET ERR.A ;NO, FLAG ERROR SETZM GTCDEL RETURN ;NULL EXIT .LOC ;ARGUMENT STORAGE WORDS GTCDEL: BLOCK 1 ;ARGUMENT DELIMITER .RELOC SUBTTL END OF PASS ROUTINES ENDP: ;END OF PASS ROUTINES CALL TSTMAX ;BE SURE TO TRAP MAX PC LDB %02,CCSPNT HRRM %05,SECBAS(%02) ;SET HIGH LOCATION TLNN %15,P1F ;PASS 1? JRST ENDP20 ; NO CALL SETBIN ;SET BINARY (OBJ OR BIN) IFNDEF XREL, < SKPEDR ED.ABS > ;YES, ABSOLUTE? POPJ %17, ; YES, NO ACTION IFNDEF XREL < MOVE %00,PRGTTL ;GET PROGRAM TITLE SETZ %01, CALL HDROUD ;OUTPUT DOUBLE WORD MOVE %00,PRGIDN MOVSI %01,3000 SKIPE %00 ;ANY IDENT? CALL HDROUD ; YES, DUMP IT MOVE %06,[POINT 1,SECLCF,0] MOVEM %06,SECLCP ;SET LOCAL POINTER SETZB %06,DGCNT ;INIT SECTOR COUNT AND DFLT GLBL COUNT ENDP11: SETZ %07, ;INIT FOR TABLE SEARCH MOVE %00,SECNAM(%06) ;GET SECTOR NAME HLRZ %01,SECBAS(%06) ;GET ITS LENGTH SKIPN RSXSW ;RSX DEFAULTS IN EFFECT? JRST ENDP01 ;NO ;ASSUME RSX DEFAULTS HRLI %01,2514 ;ASSUME ASECT DEFAULT SKIPE %06 ;WERE WE JUSTIFIED? HRLI %01,2450 ;NO, SO ASSUME UNNAMED CSECT CAILE %06,1 ;WAS IT MAYBE A NAMED CSECT? HRLI %01,2554 ;YES JRST ENDP02 ;BRANCH AROUND NON-RSX DEFAULTS ;NON-RSX PSECT DEFAULTS ENDP01: HRLI %01,450 ;ASSUME RELOCATABLE SKIPN %06 ;YES? HRLI %01,410 ; NO, ABS ENDP02: EXCH %07,PSCFLG(%06) ;CHECK FOR POSSIBLE PSECT SKIPGE %07 ;IS THIS SECTION A PSECT? HRL %01,%07 ;WHY,YES. STORE THE ATTRIBUTE FLAGS AND ;RLD TYPE 5 EXCH %07,PSCFLG(%06) ;RESTORE THINGS LDB %03,SECLCP ;LOCAL? SKIPE %03 TLO %01,2000 ; YES CALL HDROUD ;OUTPUT IT ENDP12: CALL GETSTE ;GET THE NEXT SYMBOL TABLE ENTRY JRST ENDP15 ; END, BRANCH TLNN %00,ST.MAC!ST.LSB TLNN %01,GLBSYM ;GLOBAL? JRST ENDP12 ; NO, FORGET IT LDB %02,SUBPNT ;GET RELOCATION MOVSI %03,2150 ;ASSUME REL JUMPN %06,ENDP13 ;BRANCH IF TRUE MOVSI %03,2100 ;NO, ASSUME EXTERNAL TLNN %01,DEFSYM ;TRUE? JRST ENDP14 ; YES TLO %03,10 ;INTERNAL ENDP13: TLNE %01,DEFSYM ;IF EXTERNAL CAME %02,%06 ; OR NON-MATCH JRST ENDP12 ENDP14: TLNE %01,FLTSYM ;WAS THIS TUSKER DEFAULTED? AOS DGCNT ;YUP. HLL %01,%03 CALL HDROUD ;OUTPUT IT JRST ENDP12 ;TRY FOR MORE ENDP15: ADDI %06,1 ;MOVE TO NEXT SECTOR IBP SECLCP ;BUMP LOCAL POINTER SKIPN SECNAM(%06) ;IF NON-NULL CAIN %06,1 ; OR SECTOR 1, JRST ENDP11 ;PROCESS MOVE %01,ENDVEC ;GET END VECTOR LDB %02,SUBPNT ;ISOLATE ITS RELOCATION MOVE %00,SECNAM(%02) ;GET THE NAME HRLI %01,1410 ;ASSUME ABSOLUTE SKIPE %02 TLO %01,40 ;NO, RELOCATABLE CALL HDROUD ;OUTPUT IT CALL BLKDMP ;DUMP THE BLOCK MOVEI %02,BKT2 CALL BSWORD ;SET BLOCK TYPE CALL BLKDMP ;DUMP THE BUFFER MOVEI %02,BKT4 ;OUTPUT A DUMMY CSECT CALL BSWORD MOVEI %02,RLDT7 CALL BSWORD SETZ %02, CALL BSWORD CALL BSWORD CALL BSWORD JRST BLKDMP ;DUMP THE BUFFER AND EXIT > ENDP20: CALL BLKDMP ;END OF PASS 2 MOVEI %02,BKT6 ;ASSUME RELOCATABLE SKPEDR ED.ABS ;ABSOLUTE? MOVE %02,ENDVEC ; YES, SET XFER VECTOR CALL BSWORD ;STORE IT JRST BLKDMP ;DUMP THE BUFFER AND EXIT IFNDEF XREL < HDROUD: ;OUTPUT DOUBLE WORD MOVE %02,BYTCNT CAILE %02,RLDLEN-^D8+2 ;ROOM? CALL BLKDMP ; NO MOVEI %02,BKT1 SKIPN BYTCNT ;BUFFER INITIALIZED? CALL BSWORD ; NO, DO SO MOVE %02,%00 ;FIRST WORD CALL .+2 MOVE %02,%01 SPUSH %02 HLRZ %02,0(%17) ;LEFT HALF CALL BSWORD SPOP %02 JRST BSWORD > SUBTTL CODE ROLL HANDLERS SETRLD: ;SET RLD HEADER MOVE %01,%05 ADD %01,PHAOFF ANDI %01,177777 HRLI %01,(B) STCODE: ;STOW CODE SPUSH %03 AOS %03,CODPNT ;INCREMENT INDEX MOVEM %01,CODBUF-1(%03) ;STORE SPOP %03 RETURN PROCOD: ;PROCESS CODE CALL PROCO1 ;PROCESS ONE WORD RETURN ; NULL, EXIT MOVEM %00,PF0 ;OK, SET PRINT FIELDS MOVEM %01,PF1 SKPLCR LC.TTM ;EXIT IF TTY CALL PROCO1 JRST CPOPJ1 ; NULL, BUT GOOD EXIT MOVEM %01,PF2 CALL PROCO1 JRST CPOPJ1 MOVEM %01,PF3 JRST CPOPJ1 PROCO1: CALL FETCOD ;FETCH AN ENTRY RETURN ; END CALL PROWRD ;PROCESS WORD MOVE %00,PFT0 ;TRANSFER PRINT STUFF MOVE %01,PFT1 JRST CPOPJ1 SETPF0: ;SET PRINT FIELD 0 MOVE %03,%05 TLO %03,DEFSYM MOVEM %03,PF0 RETURN SETPF1: ;SET PRINT FIELD 1 MOVE %03,%10 TLO %03,DEFSYM MOVEM %03,PF1 RETURN FETCOD: MOVE %03,CODPNT ;FETCH INDEX SKIPN %01,CODBUF(%03) ;NULL? RETURN ; YES, EXIT NULL SETZM CODBUF(%03) AOS CODPNT ;BUMP POINTER JRST CPOPJ1 PROWRD: ;PROCESS WORD LDB %02,MODPNT ;GET CLASS ANDI %02,177 ;MASK OUT BYTE BIT MOVE %10,RLDTBL(%02) ;GET PROPER TABLE ENTRY MOVE %03,PF0 MOVE %04,PF1 CAIE %02,RLDT7 CAIN %02,RLDT10 JRST PROWR6 MOVE %03,%05 ;GET A COPY OF THE PC TLO %03,DEFSYM ;WITH DEFINED BIT SET TLNN %01,BC1!BC2 ;CODE TO BE GENNED? SETZM %03 ; NO, DON'T PRINT LOCATION MOVE %04,%10 ;FLAGS TO %04 DPB %01,[POINT 36-8,%04,35] ;REMAINDER FROM %01 CAIN %02,RLDT1 ;SPECIAL IF CLASS 1 TLO %04,(1B) PROWR6: MOVEM %03,PFT0 MOVEM %04,PFT1 ;SET TEMP PRINT FIELD 1 IFNDEF XREL < TLNN %15,P1F ;IF PASS ONE SKPEDR ED.ABS ; OR ABSOLUTE? JRST PROWR3 ; YES, BRANCH LDB %03,TYPPNT ;GET BYTE COUNT CAIN %02,RLDT11 ;TYPE 11? MOVEI %03,4 ; YES, ALL IN ONE BUFFER ADD %03,BYTCNT HRRZ %04,%10 ADD %04,RLDCNT CAIG %03,RLDLEN CAILE %04,RLDLEN ;ROOM TO STORE? CALL BLKDMP ; NO, DUP CURRENT BUFFER SKIPN BYTCNT ;BUFFER EMPTY? TLNN %01,BC1!BC2 ; YES, ANY CODE? JRST PROWR1 ;OK, BYPASS MOVEI %02,BKT3 CALL BSWORD ; NO, STORE BLOCK TYPE MOVE %02,%05 CALL BSWORD ;STORE CURRENT ADDRESS PROWR1: LDB %02,MODPNT ;GET THE TYPE JUMPE %02,PROWR3 ;BRANCH IF ABSOLUTE CALL RLDSTB ;STORE IT TLNN %01,BC1!BC2 ;CODE? TDZA %02,%02 ; NO, SET ZERO MOVE %02,BYTCNT ;YES, SET BYTE POINT FOR REFERENCE CALL RLDSTB LDB %02,SUBPNT JUMPE %02,PROWR2 ;BRANCH IF NOT EXTERNAL/REL MOVS %02,GLBBUF(%02) ;GET GLOBAL NAME CALL RLDSTW HLRZS %02 CALL RLDSTW ; AND LEFT HALF PROWR2: MOVE %02,%01 ;GET VALUE TLNE %10,1 ;SHOULD WE STORE? CALL RLDSTW ; YES > PROWR3: MOVE %02,%01 ;GET BASIC VALUE TLNE %02,BC1!BC2 ;CODE? CALL BYTOUT ; YES LSH %02,-^D8 ;SHIFT HIGH ORDER BYTE DOWN TLNE %01,BC2 ;WORD? CALL BYTOUT ; YES, OUTPUT HIGH BYTE TLNN %01,BC1!BC2 ;CODE? CALL BLKDMP ; NO, SPECIAL. DUMP THE BUFFER RETURN IFNDEF XREL < RLDSTW: SPUSH %02 CALL RLDSTB LSH %02,-^D8 CALL RLDSTB SPOP %02 RETURN RLDSTB: AOS %03,RLDCNT MOVEM %02,RLDBLK-1(%03) RETURN > RLDTBL: PHASE 0 RLDT0: XWD DEFSYM! 0, 0 RLDT1: XWD DEFSYM! 1, 4 RLDT2: XWD 0! 0, 6 RLDT3: XWD DEFSYM! 1, 4 RLDT4: XWD 0! 0, 6 RLDT5: XWD GLBSYM! 1, 10 RLDT6: XWD GLBSYM! 1, 10 RLDT7: XWD 0! 1, 10 RLDT10: XWD DEFSYM! 1, 4 RLDT11: XWD DEFSYM! 0, 2 RLDT12: XWD 0! 0, 0 RLDT13: XWD 0! 0, 0 RLDT14: XWD 0! 0, 0 RLDT15: XWD DEFSYM! 1, 10 RLDT16: XWD DEFSYM! 1, 10 RLDT17: XWD 0! 0, 0 DEPHASE .LOC CODPNT: BLOCK 1 ;CODE ROLL POINTER CODBUF: BLOCK ^D100 ;CODE ROLL BUFFER .RELOC SUBTTL OCTAL OUTPUT ROUTINES BYTOUT: ;OUTPUT A BYTE OF CODE TLNN %15,P1F ;PASS 1 SKPEDR ED.NPP JRST BYTOU2 ; YES, JUST INCREMENT AND EXIT SKPEDS ED.ABS JRST BYTOU1 ; NO MOVE %03,BYTCNT ;YES GET BYTE COUNT CAIGE %03,DATLEN+2 ;OUT OF ROOM? CAME %05,CURADR ; OR A SEQUENCE BREAK? CALL BLKDMP ; YES, DUMP THE BUFFER SKIPE BYTCNT ;DO WE NEED INITIALIZATION? JRST BYTOU1 ; NO, STORE IT SPUSH %02 ;STACK CURRENT CHARACTER MOVE %02,%05 ;GET PC CALL BSWORD ;STORE IT MOVEM %05,CURADR ;NEW SEQUENCE BREAK TEST SPOP %02 ;RETRIEVE BYTE BYTOU1: CALL BSBYTE ;STORE THE BYTE AOS CURADR ;UPDATE CURRENT ADDRESS BYTOU2: MOVEI %03,LC.ME SKPLCS LC.MEB ;MACRO EXPANSION OF BINARY? ANDCAM %03,LCTST ; YES, DISABLE LC.ME AOJA %05,CPOPJ ;INCREMENT CLC AND EXIT BSWORD: ;BINARY STORAGE OF WORD SPUSH %02 CALL BSBYTE ;STORE LOW ORDER LDB %02,[POINT 8,0(%17),35-8] ;FETCH HIGH BYTE CALL BSBYTE ;STORE IT SPOP %02 ;RESTORE WORD RETURN ; AND EXIT BSBYTE: ;BINARY STORAGE OF BYTE AOS %03,BYTCNT ;INCREMENT AND FETCH THE BYTE COUNT MOVEM %02,DATBLK-1(%03) ;STORE CURRENT BYTE IN BUFFER RETURN BLKDMP: ;DUMP THE CURRENT BLOCK SKIPN BYTCNT ;IS IT EMPTY? JRST RLDDMP ; YES, TEST FOR REL BLOCK SPUSH %01 ;GET A COUPLE OF SCRATCH REGISTERS SPUSH %02 BLKDM1: MOVEI %02,01 ;BLOCK TYPE ONE CALL BINOUT ;OUTPUT FLAG WORD LSH %02,-8 CALL BINOUT MOVE %02,BYTCNT ;FETCH BYTE COUNT ADDI %02,4 ;FUDGE FOR HEADER CALL BINOUT ;OUTPUT IT LSH %02,-8 CALL BINOUT HRLZ %01,BYTCNT ;GET BYTE COUNT MOVNS %01 ;NEGATE BYTE CT MOVE %02,DATBLK(%01) ;GET AN ITEM FROM THE DATA BLOCK CALL BINOUT ;DUMP IT AOBJN %01,.-2 ;RECYCLE IF NOT DONE MOVN %02,CHKSUM ;GET NEG OF CHECKSUM. CALL BINOUT ;DUMP IT SETZ %02, ;FINISHED WITH BLOCK MOVEI %01,^D6 CALL BINOUT ;DUMP SOME BLANK TAPE SOJG %01,.-1 SPOP %02 ;RESTORE REGISTERS SPOP %01 RLDDMP: IFNDEF XREL < SKIPN RLDCNT JRST BLKINI SPUSH %01 SPUSH %02 HRLZ %01,RLDCNT CALL BLKINI MOVEI %02,BKT4 CALL BSWORD MOVNS %01 MOVE %02,RLDBLK(%01) CALL BSBYTE AOBJN %01,.-2 CALL BLKDMP SPOP %02 SPOP %01 > BLKINI: ;CODE BLOCK INITIALIZATION SETZM BYTCNT ;CLEAR BYTE COUNT IFNDEF XREL, RETURN ;EXIT .LOC CURADR: BLOCK 1 ;SEQUENCE BREAK TEST CHKSUM: BLOCK 1 ;CHECK SUM BYTCNT: BLOCK 1 ;BYTE COUNT DATBLK: BLOCK DATLEN+10 ;ABS BUFFER IFNDEF XREL < RLDCNT: BLOCK 1 ;RLD COUNT RLDBLK: BLOCK RLDLEN+10 ;RLD BUFFER > .RELOC SUBTTL INPUT LINE ACCUMULATORS GETLIN: ;GET THE NEXT SOURCE LINE SETZM CRRCNT SETZM LINCHC SETZM LINTBC ;TAB ORIENTED CHAR COUNT MOVE %13,[POINT 7,LINBUF] GETLI1: CALL CHARLC ;GET AN INPUT CHARACTER LDB %02,C7PNTR ;GET CHARCTERISTICS XCT GETLIT(%02) ;EXECUTE TABLE SKIPE CRRCNT ;OK, ANY IMBEDDED CR'S? CALL ILCPRO ; YES, ERROR AOS %03,LINCHC CAIL %03,CPL ERRSKP ERR.L IDPB %14,%13 AOS LINTBC ;UPDATE TAB COUNT JRST GETLI1 ; OK, STORE IT GETLI2: MOVEI %03,7 IORM %03,LINTBC ;FUDGE TAB COUNT RETURN GETLI3: CAIE %14,CRR ;TERMINATOR, CR? JRST GETLI5 ; NO, A REAL ONE SKIPN CRRCNT ;YES, FIRST? AOSA CRRCNT ; YES, FLAG IT GETLI4: CALL ILCPRO ; NO, ERROR JRST GETLI1 GETLI5: CAIN %14,FF ;FORM FEED? SKIPE MCACNT JRST GETLI6 ; NO SKIPN LINCHC TLO %15,FFFLG AOS FFCNT AOS ERPNUM ;BUMP ERROR PAGE COUNT GETLI6: MOVEI %14,0 IDPB %14,%13 MOVEI %13,LINBUF HLL %13,ASCBYT MOVEM %13,LINPNT MOVEM %13,CLIPNT SKIPE MCACNT JRST SETNB SKIPN MSBMRP ;MACRO EXPANSION? AOSA %14 ; NO, INCREMENT LINE COUNT SETLCT LC.ME ; IGNORE MEB FOR NOW TLNN %16,SOLBIT ;SEQUENCE OUTPUT LINES? ADDM %14,LINNUM ; NO, BUMP TLNE %15,ENDFLG ;PERCHANCE END OF FILE? ERRSET ERR.E ; YES, FLAG "NO END STATEMENT" LDB %03,CDRPNT MOVEM %03,CDRCHR MOVEI %03,0 TLNE %16,CDRBIT ;/CDR MODE? DPB %03,CDRPNT ; YES, STUFF A NULL JRST SETNB ;RETURN WITH FIRST NON-BLANK GETLC: SKPEDS ED.LC SUBI %14,40 RETURN ILCPRO: ;ILLEGAL CHARACTER PROCESSOR ERRSET ERR.I ;FLAG ERROR SKIPN ILCPNT ;FIRST IN THIS LINE? MOVEM %13,ILCPNT ; YES RETURN GETLIT: ;GETLIN MAP TABLE PHASE 0 JRST GETLI4 QJNU: JRST GETLI4 ;ILLEGAL CHARACTER QJCR: JRST GETLI3 QJVT: JRST GETLI3 QJTB: CALL GETLI2 QJSP: JFCL QJPC: JFCL QJLC: CALL GETLC DEPHASE GETMLI: ;GET MACRO-TYPE LINE CALL GETLIN ;GET A STANDARD LINE CALL GETSYM TSTMLI: SKIPE %00 CALL OSRCH SETZB %01,%02 ; NO CAIE %02,DIOP ;DIRECTIVE? TDZA %03,%03 ; NO LDB %03,SUBPNT ;YES, RETURN WITH FLAGS RETURN CDRPNT: POINT 7,LINBUF+^D14,6+7+7 ;POINTER TO COLUMN 73 .LOC CDRCHR: BLOCK 1 ;/CDR SAVE CHARACTER LINPNT: BLOCK 1 ;POINTER TO START OF LINE CLIPNT: BLOCK 2 CLILBL: BLOCK 1 ILCPNT: BLOCK 1 ;ILLEGAL CHARACTER POINTER FFCNT: BLOCK 1 ;TERMINATION CHARACTER ERPNUM: BLOCK 1 ;ERROR PAGE NUMBER ERPBAK: BLOCK 1 ;ONE MESSAGE PER PAGE CRRCNT: BLOCK 1 LINCHC: BLOCK 1 LINTBC: BLOCK 1 LINBUF: BLOCK CPL/5+2 .RELOC SUBTTL SYMBOL TABLE LISTING SYMTB: ;LIST THE SYMBOL TABLE TLNN %16,CRFBIT ;CREF SUPPRESSED? JRST CRFLST ; NO, DO IT SKPLCR LC.SYM ;HOW ABOUT SYMBOL TABLE? RETURN ; NO, EXIT SETZ %07, ;INITIALIZE POINTER TLO %16,HDRBIT ;FLAG NEW PAGE MOVE %03,[XWD [ASCIZ /SYMBOL TABLE/],STLBUF] BLT %03,STLBUF+4 SYMTB1: MOVEI %06,SPLTTY ;SET "SYMBOLS PER LINE" SKPLCR LC.TTM ;TELETYPE? MOVEI %06,SPL ; NO SYMTB2: CALL GETSTE ;GET THE NEXT SYMBOL TABLE ENTRY JRST SYMTB3 ; END TLNE %00,ST.MAC!ST.LSB JRST SYMTB2 CALL LSTSTE ;LIST SYMBOL TABLE ENTRY SOJG %06,SYMTB2 ;TEST FOR MORE ITEMS ON LINE CALL LSTCR JRST SYMTB1 ;START NEW LINE SYMTB3: MOVE %00,M40DOT MOVE %01,%05 ;PRINT PC TLO %01,DEFSYM CALL LSTSTE SYMTBF: CALL LSTCR CALL LSTCR IFNDEF XREL < SKPEDR ED.ABS ;ABS MODE? RETURN ; YES, EXIT MOVE %07,[XWD -^D<256-1>,1] SYMTB4: MOVE %00,SECNAM(%07) HLRZ %01,SECBAS(%07) DPB %07,SUBPNT ;SET SECTOR TLO %01,LBLSYM!DEFSYM ;SUPPRESS "=" CALL LSTSTE CALL LSTCR SKIPE SECNAM+1(%07) AOBJN %07,SYMTB4 > RETURN CRFLST: MOVE %00,M40DOT CALL SRCHF JFCL MOVE %01,%05 TLO %01,DEFSYM CALL INSRTF SETZB %00,%07 CALL CRFPUT ;OUTPUT A NULL CRFL01: CALL GETSTE JRST CRFL10 TLNE %00,ST.MAC!ST.LSB JRST CRFL01 CALL CRFPUT MOVE %00,%01 CALL CRFPUT JRST CRFL01 CRFL10: RELEAS SRC, MOVE %03,[XWD [ASCIZ /CROSS REFERENCE TABLE/],STLBUF] BLT %03,STLBUF+6 MOVSI %00,(1B0) MOVEM %00,CRFMIN SETCAM %00,CRFMAX SETOM CRFTMP CRFL20: CLOSE CRF, MOVE %03,SYSDEV MOVEM %03,DEVNAM DEVSET CRF,10 XWD 0,CRFBUF MOVEI %03,JOBFFS MOVEM %03,JOBFF INBUF CRF,NUMBUF MOVE %03,CRFBAS MOVEM %03,JOBFF MOVE %03,CRFNAM MOVEM %03,FILNAM MOVSI %03,(SIXBIT /TMP/) MOVEM %03,FILEXT SETZM FILPPN LOOKUP CRF,FILNAM HALT . SETZM LINNUM SETZM NEXT CALL SETSYM CRFL30: CALL CRFGET JRST CRFL50 JUMPE %00,CRFL50 TLNE %00,-1 ;SYMBOL? JRST CRFL31 ; YES CAMGE %00,LINNUM ;NO, VALID LINE NUMBER? HALT . ; NO MOVEM %00,LINNUM ;YES, SET IT JRST CRFL30 CRFL31: TLC %00,(1B0) MOVEM %00,CRFSAV TRZ %00,600000 ;CLEAR FLAGS CRFL32: CAML %00,CRFMIN CAML %00,CRFMAX JRST CRFL30 HRRZ %03,JOBFF ADDI %03,WPB+10 CAMGE %03,SYMBOT JRST CRFL40 MOVE %03,JOBREL CORE %03, HALT . HLRZ %04,JOBHRL ADD %04,JOBREL ASH %04,-^D10 CAILE %03,1(%04) JRST CRFL40 MOVNI %07,2 ADD %07,SYMLEN CAIG %07,4 HALT . MOVE %01,@SYMPNT MOVEM %01,CRFMAX MOVE %01,@VALPNT CALL REMMAC HRRZ %02,JOBREL CRFL33: MOVE %03,-4(%02) MOVEM %03,-2(%02) SUBI %02,1 SOJGE %07,CRFL33 MOVEI %02,2 ADDM %02,SYMBOT CALL SRCHI CAML %00,CRFMAX JRST CRFL30 CRFL40: CALL SRCHF ;SEARCH SYMBOL TABLE CAIA JRST CRFL41 CALL GETBLK ;GET A STORAGE BLOCK HRLI %01,(POINT 18,,35) MOVEM %01,0(%01) ;STORE TERMINAL CALL INSRTF SPUSH %01 JRST CRFL4X CRFL41: SPUSH %01 MOVE %01,0(%01) ;GET CURRENT POINTER LDB %02,%01 ;PEEK AT LAST LDB %03,[POINT 16,%02,35] CAMN %03,LINNUM ;NEW LINE? JRST CRFL43 ; YES CRFL4X: IBP %01 ;NO, BUMP POINTER SKIPE 0(%01) ;END OF BLOCK? JRST CRFL42 ; NO MOVE %02,%01 ;YES, SAVE CURRENT POINTER CALL GETBLK ;GET ANOTHER BLOCK HRLI %01,(POINT 18,,17) HRRZM %01,0(%02) ;SET LINK CRFL42: MOVE %02,LINNUM ;SET LINE NUMBER CRFL43: SPOP %03 ;RESTORE VALUE MOVE %00,CRFSAV ANDI %00,600000 ;ISOLATE FLAGS IOR %02,%00 ;MERGE INTO VALUE DPB %02,%01 ;SET IT MOVEM %01,0(%03) ;STORE NEW POINTER JRST CRFL30 CRFL50: MOVSI %03,(1B0) MOVEM %03,CRFSAV MOVEI %07,0 CRFL51: CALL GETSTE JRST CRFL60 SPUSH %01 LDB %02,[POINT 2,%00,1] CAME %02,CRFTMP TLO %16,HDRBIT MOVEM %02,CRFTMP CAIN %02,2 CRFL52: CAMG %00,CRFSAV JRST CRFL53 MOVEM %00,CRFSAV+1 CALL CRFGET SETOM %00 TLC %00,(1B0) MOVEM %00,CRFSAV CALL CRFGET JFCL EXCH %00,CRFSAV+1 JRST CRFL52 CRFL53: CAME %00,CRFSAV TDZA %01,%01 MOVE %01,CRFSAV+1 CALL LSTSTQ SPOP %01 SPUSH 0(%01) CRFL54: MOVN %03,COLCNT CAIL %03,8 JRST CRFL55 CALL LSTCR CALL LSTTAB MOVE %02,CRFTMP CAIN %02,2 SKPLCR LC.SYM JRST CRFL55 CALL LSTTAB CALL LSTTAB CRFL55: ILDB %11,%01 JUMPN %11,CRFL56 MOVE %01,0(%01) HRLI %01,(POINT 18,) JRST CRFL55 CRFL56: ANDI %11,177777 DNC 5,%11 LDB %11,%01 TRNE %11,400000 LSTICH "#" TRNE %11,200000 LSTICH "*" CALL LSTTAB CAME %01,0(%17) JRST CRFL54 SPOP 0(%17) CALL LSTCR JRST CRFL51 CRFL60: HRLOI %03,377777 EXCH %03,CRFMAX MOVEM %03,CRFMIN CAME %03,CRFMAX JRST CRFL20 SETZM FILNAM RENAME CRF,FILNAM JFCL JRST SYMTBF CRFGET: SOSLE CRFCNT JRST CRFGE1 INPUT CRF, STATZ CRF,IOEOF RETURN CRFGE1: ILDB %00,CRFPNT JRST CPOPJ1 .LOC CRFNAM: BLOCK 1 CRFTMP: BLOCK 1 CRFMAX: BLOCK 1 CRFMIN: BLOCK 1 CRFSAV: BLOCK 2 .RELOC LSTSTQ: LDB %02,[POINT 2,%00,1] TRC %02,2 SKPLCS LC.SYM JUMPE %02,LSTSTE LSTSYM %00 JRST LSTTAB LSTSTE: ;LIST SYMBOL TABLE ENTRY LSTSYM 1,%00 ;LIST IT MOVEI %02,"=" TLNE %01,LBLSYM MOVEI %02,SPACE CALL LSTOUT MOVEI %02,"%" TLNN %01,REGSYM ;REGISTER? MOVEI %02,SPACE ; NO CALL LSTOUT LDB %10,[POINT 16,%01,35] TLNE %01,DEFSYM JRST LSTST1 LSTSTR [ASCIZ /******/] CAIA LSTST1: CALL LSTWRD LDB %10,SUBPNT MOVEI %02,SPACE JUMPL %07,LSTST2 SKIPE %10 MOVEI %02,"R" LSTST2: CALL LSTOUT MOVEI %02,SPACE JUMPL %07,LSTST3 TLNN %01,DEFSYM!GLBSYM ;DEFINED SYMBOL? MOVEI %02,"U" ;NO. NOTE THAT THIS TRAP WILL ;BE ENTERED ONLY WHEN THE DEFAULT ;GLOBALS ARE DISABLED. CALL LSTOUT MOVEI %02,SPACE TLNE %01,GLBSYM MOVEI %02,"G" LSTST3: CALL LSTOUT MOVEI %02,SPACE ;ASSUME NOT DEFAULTED GLOBAL JUMPL %07,LSTST4 ;IF LT DON'T CHECK TLNE %01,FLTSYM ;DEFAULTED GLOBAL? MOVEI %02,"X" ;YES LSTST4: CALL LSTOUT ;OUTPUT CHARACTER CAILE %10,1 CALL LSTBY1 ;OUTPUT SECTION NR WITH 2 LEADING SPACES JRST LSTTAB SUBTTL USER SYMBOL TABLE HANDLERS MSRCH: TLOA %00,ST.MAC SSRCH: ;SYMBOL SEARCH TLZ %00,ST.MAC CAMN %00,M40DOT ;PC? JRST SSRCH3 ; YES SRCHF: MOVE %07,DELTA ;SET OFFSET FOR INDEX MOVE %02,%07 ASH %02,-1 ;SET INCREMENT SSRCH1: CAMGE %00,@SYMPNT ;ARE WE LOOKING ABOVE SYMBOL? JRST SSRCH2 ; YES, MOVE DOWN CAMG %00,@SYMPNT ;NO, POSSIBLY AT IT? JRST SSRCH4 ; YES TDOA %07,%02 ; NO, INCREMENT INDEX SSRCH2: SUB %07,%02 ;DECREMENT INDEX ASH %02,-1 ;DECREMENT DELTA CAMG %07,SYMLEN ;ARE WE OUT OF BOUNDS? JUMPN %02,SSRCH1 ; NO, BRANCH IF NOT THROUGH JUMPN %02,SSRCH2 ; YES, MOVE DOWN IF NOT THROUGH SETZB %01,%02 SOJA %07,CPOPJ ;NOT FOUND, SET INDEX AND EXIT NORMAL SSRCH3: MOVE %01,%05 TLOA %01,DEFSYM ;SET PC AS DEFINED SSRCH4: MOVE %01,@VALPNT ;FOUND, FETCH VALUE LDB %02,TYPPNT ;SET TYPE POINTER JRST CPOPJ1 ;EXIT +1 INSRT: ;INSERT ITEM IN SYMBOL TABLE CAMN %00,M40DOT ;PC? JRST INSRT2 ; YES INSRTF: CAMN %00,@SYMPNT ;IS IT HERE ALREADY? JRST INSRT1 ; YES MOVNI %06,2 ;NO, PREPARE TI INSERT ADDB %06,SYMBOT ;DECREMENT POINTER TO BOTTOM OF TABLE CAMG %06,JOBFF ;ARE WE INTRUDING ON THE MACROS? CALL GETCOR ; YES, GET MORE CORE MOVE %06,SYMBOT HRLI %06,2(%06) ;SET UP BLT BLT %06,@SYMPNT ;MOVE LOWER SYMBOLS DOWN CALL SRCHI ;RE-INITIALIZE THE POINTERS ADDI %07,2 ;COMPENSATE FOR SHIFT MOVEM %00,@SYMPNT ;STORE SYMBOL INSRT1: MOVEM %01,@VALPNT ;STORE VALUE RETURN INSRT2: MOVE %05,%01 ;".", SET PC AND %05,[PCMASK] ;MAKE SURE ITS CLEAN RETURN SRCHI: ;INITIALIZE FOR SEARCH SPUSH %01 ;STACK WORKING REGISTERS SPUSH %02 MOVE %01,SYMTOP ;GET THE TOP LOCATION SUB %01,SYMBOT ;COMPUTE THE DIFFERENCE MOVEM %01,SYMLEN ;SAVE IT MOVEI %02,1 ;SET LOW BIT LSH %02,1 ;SHIFT OVER ONE TDZ %01,%02 ;CLEAR CORRESPONDING ONE JUMPN %01,.-2 ;TEST FOR ALL BITS CLEARED MOVEM %02,DELTA ;END, SAVE LEADING BIT FOR SEARCH OFFSET MOVE %01,SYMBOT ;GET THE BASE HRLI %01,(Z (%07)) ;SET INDEX MOVEM %01,SYMPNT ;SET SYMBOL POINTER SUBI %01,1 MOVEM %01,VALPNT ;SET VALUE POINTER SPOP %02 ;RESTORE REGISTERS SPOP %01 RETURN ;EXIT GETSTE: ;GET SYMBOL TABLE ENTRY ADDI %07,2 ;MOVE UP TWO CAML %07,SYMLEN ;TEST FOR END RETURN ; YES, EXIT MOVE %00,@SYMPNT MOVE %01,@VALPNT LDB %02,TYPPNT JRST CPOPJ1 ;OK, PERFORM SKIP-RETURN .LOC SYMPNT: BLOCK 1 ;POINTER TO SYMBOL TABLE MNEMONIC VALPNT: BLOCK 1 ;POINTER TO SYMBOL TABLE VALUE SYMLEN: BLOCK 1 ;SYMBOL TABLE LENGTH DELTA: BLOCK 1 ;BINARY SEARCH OFFSET .RELOC SUBTTL CREF HANDLERS CRFOPD: TLOA %15,DEFFLG ;CREF OP DEFINITION CRFOPR: TLZ %15,DEFFLG ;CREF OP REFERENCE TLNN %16,LSTBIT!CRFBIT TLNE %15,P1F RETURN SPUSH %00 TLNN %00,ST.MAC TLO %00,ST.MAC!ST.LSB CALL CRFREX SPOP %00 RETURN CRFDEF: TLOA %15,DEFFLG CRFREF: TLZ %15,DEFFLG TLNN %16,LSTBIT!CRFBIT TLNE %15,P1F RETURN TLNE %00,ST.MAC!ST.LSB RETURN CRFREX: SPUSH %00 TLNE %15,DEFFLG TRO %00,400000 TLNE %15,DSTFLG TRO %00,200000 EXCH %00,LINNUM CAME %00,CRFSAV CALL CRFPUT MOVEM %00,CRFSAV EXCH %00,LINNUM CALL CRFPUT SPOP %00 RETURN CRFPUT: SOSG CRFCNT CALL CRFDMP IDPB %00,CRFPNT RETURN CRFDMP: OUTPUT CRF, CRFTST: STATZ CRF,IODATA!IODEV!IOWRLK!IOBKTL FERROR [ASCIZ /CREF OUTPUT ERROR/] RETURN SUBTTL MEMORY MANAGEMENT GETCOR: ;GET CORE SPUSH %00 ;GET A COULPLE OF WORKING REGISTERS SPUSH %01 HRRO %01,JOBREL ;GET TOP OF CURRENT CORE MOVEI %00,CORINC(%01) ;COMPUTE NEXT K CORE %00, ;MAKE A REQUEST FERROR [ASCIZ /INSUFFICIENT CORE/] MOVEI %00,1(%01) SUB %00,SYMBOT ;COMPUTE NUMBER OF ITEMS TO BE MOVED POP %01,CORINC(%01) ;POP ITEM UP ONE K SOJG %00,.-1 ;TEST FOR COMPLETION MOVEI %01,CORINC ;UPDATE POINTERS ADDM %01,SYMBOT ADDM %01,SYMPNT ADDM %01,VALPNT ADDM %01,SYMTOP SPOP %01 ;RESTORE REGISTERS SPOP %00 RETURN ;EXIT .LOC SYMBOT: BLOCK 1 ;SYMBOL TABLE BBASE SYMTOP: BLOCK 1 ;SYMBOL TABLE TOP .RELOC SETSYM: ;SET SYMBOL TABLE HRRZ %03,JOBREL MOVEM %03,SYMTOP ;SET TOP OF SYMBOL TABLE SUBI %03,2 MOVEM %03,SYMBOT ; AND BOTTOM MOVSI %03,(1B0) MOVEM %03,@SYMBOT ;SET BOTTOM AND SETCAM %03,@SYMTOP ; TOP BUMPERS JRST SRCHI SUBTTL ENABLE/DISABLE HANDLERS .ENABL: ; ".ENABL" DIRECTIVE TLZ %15,DISBIT ;SET THIS INDICATOR BIT TDZA %03,%03 ;CLEAR AC3 AND SKIP .DSABL: MOVEI %03,1 ; ".DSABL" DIRECTIVE HRLM %03,0(%17) ;SAVE FLAG SKIPE %03 ;WAS IT A DISABLE? TLO %15,DISBIT ;YEAH, KLUDGE IT UP SOME MORE .ENAB1: CALL GETEDT ;ARGS, GET ONE JRST .ENAB2 ; BRANCH IF NULL HLRZ %02,0(%17) ;GET INDEX MOVE %03,EDMSK ;SET REGS TLNN %16,MODBIT ;COMMAND STRING? TDOA %03,%01 ; YES, SET MASK AND SKIP TDNN %03,%01 ;NO, SUPPRESSED? XCT [EXP ,](%02) SETZM %01 IFDEF XREL, MOVEM %03,EDMSK SKPEDR ED.ABS ;ABS? TLZ %05,(PFMASK) ; YES, JUST IN CASE TRNE %01,ED.LSB CALL .ENAB3 TRNE %01,ED.GBL ;DEALING WITH DEFAULT GLOBALS? CALL .ENAB4 ;YES TRNE %01,ED.REG ;DEALING WITH DEFAULT REGISTER DEFNS? CALL .ENAB9 ;YES TLNE %16,MODBIT TRNN %01,ED.NPP CAIA CALL SETRLD TRNN %01,ED.ERF JRST .ENAB1 MOVE %13,SYMBEG GETCHR GETCHR .ENAB5: GETCHR MOVSI %03,1 MOVE %04,[POINT 7,ERRMNE] .ENAB6: LSH %03,-1 ILDB %00,%04 JUMPE %00,.ENAB7 CAME %00,%14 JRST .ENAB6 XCT [EXP , ](%02) TLO %02,(1B0) JRST .ENAB5 .ENAB7: CAMN %13,SYMEND JRST .ENAB8 ERRSET ERR.A ANDCAM %15,ERRSUP TLO %02,(1B0) .ENAB8: MOVEI %03,-1-ERR.P1 TLZN %02,(1B0) XCT [EXP , ](%02) MOVE %13,SYMEND CALL SETNB JRST .ENAB1 .ENAB2: HRRM %12,EDFLGS SKIPN ARGCNT ;END, ANY ARGS? ERRSET ERR.A ; NO, ERROR RETURN .ENAB3: ;LSB TEST TLNN %16,MODBIT ;COMMAND STRING? ERRSKP ERR.A ; YES, ERROR JUMPE %02,LSBINC ;NO, NEW BLOCK IF .ENABL RETURN .ENAB4: ;DEFAULT GLOBALS TLNE %15,DISBIT ;ENABLE DEFAULT GLOBALS? TLOA %16,GBLDIS ;NO. TLZ %16,GBLDIS ;YES RETURN .ENAB9: ;DEFAULT REGISTER STUFF TLO %16,REGBIT ;TELL THE WORLD THAT WE WERE HERE. TLNE %15,DISBIT ;ENABLE? JRST .ENABB ;NO. PARDON THE HEX... .ENABA: ;SET UP DEFAULT REGISTER DEFINITIONS SPUSH %05 ;SAVE AC5 FOR SCRATCH MOVEI %05,0 ;INITIALIZE TABLE POINTER .ENABC: MOVE %00,REGTBL(%05) ;GET REGISTER SYMBOL CALL SSRCH ;SRCH FOR IT TO SET UP SYMPNT,VALPNT JFCL ;IT DOESN'T REALLY MATTER IF IT'S HERE OR NOT TLNE %01,DFLSYM ;WAS IT ALREADY A DEFAULT SYMBOL? JRST .ENABE ;YES. DON'T CHANGE THEM MOVEM %01,REGSAV(%05) ;SAVE AWAY THE OLD VALUE SETZM %01 ;CLEAR WHATEVER WAS THERE BEFORE TLO %01,REGSYM!DEFSYM!DFLSYM ;SET DEFINITION, REGISTER AND ;DEFAULT BITS ADDI %01,0(%05) ;GENERATE VALUE CALL INSRT ;AND PUT IT INTO THE TABLE CAIGE %05,7 ;AT THE END YET? AOJA %05,.ENABC ;NO, GO BACK FOR MORE. .ENABE: SPOP %05 ;RESTORE AC5. RETURN ;RETURN .ENABB: ;DISABLE THE DEFAULT VALUES SPUSH %05 ;GENERATE A SCRATCH REGISTER SETZM %05 ;IT'LL BE A POINTER, STARTING AT ZERO .ENABD: MOVE %00,REGTBL(%05) ;GET A REGISTER SYMBOL CALL SSRCH ;FIND IT JFCL ;DOESN'T MATTER... TLNN %01,DFLSYM ;IS IT ALREADY A NON-DEFAULT? JRST .ENABF ;YES. DON'T FUTZ AROUND. MOVE %01,REGSAV(%05) ;RESTORE THE OLD VALUE CALL INSRT ;AND STUFF IT BACK IN CAIE %05,7 ;END OF TABLE? AOJA %05,.ENABD ;NO, GO BACK FOR MORE .ENABF: SPOP %05 ;RESTORE AC5 RETURN ;AND RETURN .LOC REGSAV: BLOCK ^D8 ;AREA TO STORE REGISTER DEFINITIONS ;WHILE DEFAULTS ARE ENABLED .RELOC GETEDT: ;GET ED TYPE CALL GSARG ;TRY FOR ARGUMENT RETURN ; MISSED HLLZS %00 MOVSI %03,- ;SET FOR SEARCH CAME %00,EDTBL(%03) ;MATCH? AOBJN %03,.-1 ; NO SETZM %01 SKIPL %03 ;FOUND? ERRSKP ERR.A ; NO, ERROR MOVEI %01,1 ;YES, SET FLAG LSH %01,0(%03) ;COMPUTE BIT POSITION JRST CPOPJ1 DEFINE EDTGEN (M,N,E) < XLIST ED.'M'N'E= 1_. GENM40 M,N,E LIST > EDTBL: PHASE 0 EDTGEN L,S,B EDTGEN F,P,T EDTGEN A,B,S EDTGEN C,O,M EDTGEN N,P,P EDTGEN E,R,F EDTGEN A,M,A EDTGEN P,I,C EDTGEN T,I,M EDTGEN L,C EDTGEN W,R,P EDTGEN G,B,L EDTGEN R,E,G DEPHASE EDTBLE: .LOC EDBLK: EDFLGS: BLOCK 1 ;FLAGS EDMSK: BLOCK 1 ;MASK EDLVL: BLOCK 1 ;LISTING LEVEL ERRSUP: BLOCK 1 EDLEN= .-EDBLK EDSAVE: BLOCK EDLEN ;STORAGE FOR ABOVE .RELOC SUBTTL LOCAL SYMBOL HANDLERS LSBTST: SKPEDR ED.LSB RETURN TLNE %15,LSBFLG LSBINC: ;LOCAL SYMBOL BLOCK INCREMENT AOS LSBNUM ;INCREMENT BLOCK NUMBER MOVEI %03,LSRNGE-1 ADD %03,%05 MOVEM %03,LSBMAX ;SET MAX RANGE MOVEI %03,^D64-1 MOVEM %03,LSBGEN ;PRESET GENERATED SYMBOL NUMBER TLZ %15,LSBFLG RETURN .LOC LSBNUM: BLOCK 1 LSBGEN: BLOCK 1 LSBMAX: BLOCK 1 ;MAX RANGE .RELOC SUBTTL LISTING CONTROL .LIST: TDZA %03,%03 ; ".LIST" DIRECTIVE .NLIST: MOVEI %03,1 ; ".NLIST" DIRECTIVE HRLM %03,0(%17) ;SAVE FLAG .LIST1: CALL GETLCT ;ARGS, GET ONE JRST .LIST2 ; BRANCH IF NULL HLRZ %02,0(%17) ;GET INDEX MOVE %03,LCMSK ;SET REGS TLNN %16,MODBIT ;COMMAND STRING? TDOA %03,%01 ; YES, SET MASK AND SKIP TDNN %03,%01 ;NO, SUPPRESSED? XCT [EXP ,](%02) SETZM %01 MOVEM %03,LCMSK JRST .LIST1 .LIST2: SKIPE ARGCNT ;END, ANY ARGS? JRST LPTINF HLRZ %02,0(%17) ;SET INDEX TLNE %16,MODBIT ;COMMAND STRING? JRST .LIST3 ; NO SETOM %03 XCT [EXP , ](%02) RETURN .LIST3: XCT [EXP ,](%02) .LIST4: SKPLCR LC.LD ;LISTING DIRECTIVE SUPPRESSED? SETOM LCLVLB ; YES, FLAG IT RETURN SETLC0: ;"SETLCT" OPDEF EXCH %03,LCTST ;FETCH TEST WORD TRO %03,@JOBUUO ;SET BIT(S) EXCH %03,LCTST ;RESTORE RETURN .PAGE: HRROS FFCNT JRST .LIST4 GETLCT: ;GET LC TYPE CALL GSARG ;TRY FOR ARGUMENT RETURN ; MISSED MOVSI %03,- ;SET FOR SEARCH CAME %00,LCTBL(%03) ;MATCH? AOBJN %03,.-1 ; NO SETZM %01 SKIPL %03 ;FOUND? ERRSKP ERR.A ; NO, ERROR MOVEI %01,1 ;YES, SET FLAG LSH %01,0(%03) ;COMPUTE BIT POSITION JRST CPOPJ1 DEFINE LCTGEN (M,N,E) < XLIST LC.'M'N'E= 1_. GENM40 M,N,E LIST > LCTBL: PHASE 0 LCTGEN S,E,Q LCTGEN L,O,C LCTGEN B,I,N LCTGEN S,R,C LCTGEN C,O,M LCTGEN B,E,X LCTGEN M,D, LCTGEN M,C, LCTGEN M,E, LCTGEN M,E,B LCTGEN C,N,D LCTGEN L,D, LCTGEN T,T,M LCTGEN T,O,C LCTGEN S,Y,M DEPHASE LCTBLE: .LOC LCBLK: LCFLGS: BLOCK 1 ;FLAGS LCMSK: BLOCK 1 ;MASK LCLVL: BLOCK 1 ;LISTING LEVEL LCLEN= .-LCBLK LCSAVE: BLOCK LCLEN ;STORAGE FOR ABOVE LCTST: BLOCK 1 ;TEST WORD LCLVLB: BLOCK 1 .RELOC SUBTTL CONDITIONALS .IIF: ;IMMEDIATE IF CALL CNDSET CALL TCON ;TEST ARGS JRST .IIF1 ;FALSE MOVE %02,%13 ;FETCH CHARACACTER POINTER CAIN %14,"," ;SITTING ON COMMA? IBP %02 ; YES, MOVE ONE CHAR PAST CALL TGARG ;TEST FOR ARG JRST OPCERR ; MISSING, ERROR SKIPE %03,CLILBL ERRSET ERR.Q SKPLCR LC.CND MOVEM %02,CLIPNT ;SAVE NEW START JRST STMNT .IIF1: TLO %15,NQEFLG ;UNSAT, IGNORE REST OF LINE JRST .ENDCX .IFZ: .IFEQ: .IFNZ: .IFNE: .IFG: .IFGT: .IFL: .IFLT: .IFGE: .IFLE: .IFDF: .IFNDF: CALL CNDSET ;TEST LABEL HRLZS %00 ;LEFT JUSTIFY ARGUMENT SKIPE CNDWRD ;SUPPRESSED? TLOA %15,NQEFLG ; YES, BUMP LEVEL BUT IGNORE CALL TCONF ;NO, PROCESS ARGUMENT JRST CNDXF ; FALSE JRST CNDXT ;TRUE .IF: ;".IF" DIRECTIVE CALL CNDSET SKIPE CNDWRD ;SUPPRESSED? TLOA %15,NQEFLG ; YES, BUMP LEVEL BUT IGNORE CALL TCON ;TEST CNDXF: SKIPA %03,[-1] ;FALSE CNDXT: SETZM %03 MOVE %04,CNDMSK LSHC %03,-1 ;SET HIGH ORDER BIT OF MASK MOVEM %04,CNDMSK MOVE %04,CNDWRD LSHC %03,-1 ;DITTO FOR TEST WORD MOVEM %04,CNDWRD AOS %10,CNDLVL ;BUMP LEVEL JRST .ENDCF .IFT: SKIPA %03,CNDMSK ;".IFT" .IFF: SETCM %03,CNDMSK ;".IFF" CAIA .IFTF: SETZM %03 HLLM %03,0(%17) ;PROTECT IT CALL CNDSET ;TEST FOR LABEL LDB %03,[POINT 1,0(%17),0] ;GET SIGN BIT DPB %03,[POINT 1,CNDWRD,0] JRST .ENDCX .ENDC: ;".ENDC" DIRECTIVE SKIPG CNDLVL ;IN CONDITIONAL? JRST OPCERR ; NO MOVE %03,CNDMSK LSH %03,1 ;MOVE MASK BITS DOWN MOVEM %03,CNDMSK MOVE %03,CNDWRD LSH %03,1 ;DITTO FOR TEST WORD MOVEM %03,CNDWRD SOS %10,CNDLVL .ENDCF: HRLI %10,1 ;PRINT BYTE CALL SETPF1 .ENDCX: SKIPG LCLVL SKPLCS LC.CND RETURN SKIPN %03,CLILBL SETLCT LC.CND MOVEM %03,CLIPNT+1 RETURN CNDSET: ;SET PRIOR CONDITIONS SKPLCR LC.CND ;CONDITIONAL SUPPRESSION? SKIPE CNDWRD ;SKIP IF IN SAT MODE SETZM CLILBL RETURN ;NO TCON: ;TEST CONDITIONAL CALL GSARG ;TEST FOR ARGUMENTS JRST TCON2 ; NO, ERROR TCONF: SETZM CNDREQ ;CLEAR "REQUEST" SETZM CNDRES ; AND RESULT MOVSI %01,- ;SET FOR SCAN TCON1: HLLZ %02,TCONT(%01) ;TRY LEFT HALF CAMN %00,%02 ;MAKE IT? JRST TCON4 ; YES HRLZ %02,TCONT(%01) ;NO, TRY RIGHT HALF CAMN %00,%02 JRST TCON3 AOBJN %01,.+1 AOBJN %01,TCON1 ;LOOP IF NOT END TCON2: ERRSET ERR.A ;NO MATCH, ERROR RETURN TCON3: SETOM CNDREQ ;RIGHT HALF, "FALSE" TCON4: MOVE %02,TCONT+1(%01) ;FOUND, GET ADDRESS HLLZM %02,CNDINS ;SAVE POSSIBLE INSTRUCTION CALL 0(%02) ;CALL HANDLER MOVE %03,CNDREQ ;GET REQUEST CAMN %03,CNDRES ;MATCH? AOS 0(%17) ; YES, SKIP-RETURN RETURN DEFINE GTCON (A,B,C,D,E,F,ADDR) < XLIST GENM40 A,B,C,D,E,F ADDR LIST > TCONT: GTCON E,Q, ,N,E, , GTCON Z, , ,N,Z, , GTCON G,T, ,L,E, , GTCON G, , ,L,E, , GTCON L,T, ,G,E, , GTCON L, , ,G,E, , GTCON D,F, ,N,D,F, GTCON B, , ,N,B, , GTCON I,D,N,D,I,F, GTCON L,I, ,N,L, , GTCON E,N, ,D,S, , TCONTE: TCONA: ;ARITHMETIC CONDITIONALS CALL TGARG ;TEST FOR ARGUMENT ERRSET ERR.A ; NULL, ERROR CALL ABSEXP ;EVALUATE THE EXPRESSION HRROS ARGCNT LSH %10,+^D<36-16> ASH %10,-^D<36-16> ;EXTEND SIGN XCT CNDINS ;EXECUTE INSTRUCTION SETOM CNDRES ; FALSE RETURN TCONS: ;TEST SYMBOLIC CONDITIONALS CALL TGARG ;TEST FOR ANOTHER ARG ERRSET ERR.A ; NO, ERROR MOVE %01,CNDREQ MOVEM %01,CNDRES SPUSH CNDREQ TCONS1: CALL GETSYM SKIPN %00 ERRSKP ERR.A CALL SSRCH ;SEARCH THE SYMBOL TABLE SETZ %01, ; NOT THERE OR GETSYM ERROR SKIPE %00 CALL CRFREF TLNE %01,MDFSYM ERRSET ERR.D ;FLAG IF MULTI-DEFINED SYM TLNE %01,DEFSYM ;FLAGGED AS DEFINED? TDZA %01,%01 SETOM %01 SPOP %00 CAME %01,CNDRES SETCAM %00,CNDRES MOVE %01,CNDREQ CAIN %14,"&" JRST TCONS2 CAIE %14,"!" RETURN SETCA %01, TCONS2: SPUSH %01 CALL GETNB JRST TCONS1 TCONB: ;.IFB, .IFNB CALL TGARG RETURN ; NO ARG, OK CALL GGARG CALL SETNB ;BYPASS ALL BLANKS CAIE %14,0 SETOM CNDRES JRST PGARG TCOND: CALL TGARG ERRSET ERR.A CALL GGARG SPUSH ARGBEG HRRZ %06,ARGCHC ;PICK UP CHARACTER COUNT JUMPE %06,TCOND2 ;JUMP IF ARGUMENT IS NON-NULL MOVE %00,%14 GETCHR JUMPN %14,.-2 TCOND2: GETNB CALL TGARG ERRSET ERR.A CALL GGARG SPOP %00 TCOND1: SETCHR IBP %13 MOVE %02,%14 EXCH %00,%13 SETCHR IBP %13 EXCH %00,%13 CAME %02,%14 SOSA CNDRES ;MISSED JUMPN %14,TCOND1 CALL PGARG SPUSH %13 ;END OF SECOND ARGUMENT CALL PGARG ;RESTORE FIRST ARGUMENT SPOP %13 JRST SETCHR ;SET FINAL CHARACTER TCONL: CALL GETLCT JRST TCONL1 SKPLCR 0(%01) SETOM CNDRES RETURN TCONL1: SKIPGE LCLVL SETOM CNDRES RETURN TCONED: CALL GETEDT JFCL SKPEDS 0(%01) SETOM CNDRES RETURN .LOC CNDMSK: BLOCK 1 ;MASK BITS SET BY .IF CNDWRD: BLOCK 1 ;CNDMSK, ADJUSTED FOR .IFT, ETC. CNDLVL: BLOCK 1 ;CONDITIONAL LEVEL COUNT CNDREQ: BLOCK 1 ;CONDITIONAL "REQUEST" TYPE CNDRES: BLOCK 1 ;RESULT CNDINS: BLOCK 1 ;STORAGE FOR INSTRUCTION CNDMEX: BLOCK 1 ;MEXIT IN PROGRESS .RELOC SUBTTL MACRO STORAGE HANDLERS GETBLK: ;GET A BLOCK FOR MACRO STORAGE SKIPE %01,NEXT ;ANY REMNANTS OF GARBAGE COLLECTION? JRST GETBL1 ; YES, RE-USE MOVEI %01,WPB ADDB %01,JOBFF ;UPDATE FREE LOCATION POINTER CAML %01,SYMBOT ;ANY ROOM? CALL GETCOR ; NO, GET MORE CORE SUBI %01,WPB ;POINT TO START OF BLOCK SETZM WPB-1(%01) ;CLEAR VECTOR GETBL1: HLL %01,TXTBYT ;FORM BYTE POINTER MOVEM %01,MWPNTR ;SET NEW BYTE POINTER HRLI %01,- ;GET SET TO INITIALIZE BLOCK SETOM 0(%01) ;CLEAR ENTRY AOBJN %01,.-1 ;SET ALL EXCEPT LAST TO -1 PUSH %17,0(%01) ;GET TOP POP %17,NEXT ;SET FOR NEXT BLOCK SETZM 0(%01) ;CLEAR LAST WORD MOVE %01,MWPNTR ;RETURN POINTER IN %01 RETURN ;EXIT TXTBYT: POINT 8,,7 ASCBYT: POINT 7,,6 INCMAC: ;INCREMENT MACRO STORAGE AOSA 0(%01) DECMAC: ;DECREMENT MACRO STORAGE SOSL 0(%01) ;TEST FOR END RETURN ; NO, EXIT REMMAC: ;REMOVE MACRO STORAGE SPUSH %01 ;SAVE POINTER REMMA1: HRLS %01 ;SAVE CURRENT POINTER HRR %01,WPB-1(%01) ;GET NEXT LINK TRNE %01,-1 ;TEST FOR END (NULL) JRST REMMA1 ; NO HLRZS %01 ;YES, GET RETURN POINTER HRL %01,NEXT ;GET CURRENT START OF CHAIN HLRM %01,WPB-1(%01) ;STORE AT TOP SPOP %01 ;RESTORE BORROWED REGISTER HRRZM %01,NEXT ;SET NEW START RETURN ;EXIT .LOC NEXT: BLOCK 1 ;BLOCK CHAIN POINTER MWPNTR: BLOCK 1 ;MACRO WRITE POINTER .RELOC SUBTTL REPEAT/MACRO ROUTINES CF.SPC= 200 ;HIGH ORDER BIT INVOKES SPECIAL MODE CF.DSY= 100 ;DUMMY SYMBOL CF.TRP= 040 ;FLAGS END OF PROTOTYPE CF.ARG= 020 ;TRAPPED AT READMC/SETASC CH.MAC= CF.SPC!CF.TRP!T.MACR ;END OF MACRO CH.RPT= CF.SPC!CF.TRP!T.REPT ;END OF REPEAT CH.IRP= CF.SPC!CF.TRP!T.IRP ;END OF IRP CH.EOE= CF.SPC!CF.ARG!1 ;END OF ENTRY CH.FIN= CF.SPC!CF.ARG!2 ;IRP ARG DELIMITER ; THIS MACRO PUSHES THE ITERATION COUNT FOR REPEAT BLOCKS ONTO A PSEUDO-STACK CALLED REPBLK. ;THE POINTER IS CALLED REPCT. THE COUNT IS ASSUMED TO BE IN REGISTER 'REG'. DEFINE RCTPSH (REG) < XLIST AOS REPCT ;PUSH THE POINTER MOVEM REG,@REPCT ;STACK THE COUNT AOS @REPCT ;COMPENSATE FOR THE XTRA ENDM THAT WILL BE SEEN SETOM REPSW ;TELL EVERYBODY WE'RE IN A REPEAT BLOCK LIST > .REPT: ;.REPT DIRECTIVE CALL ABSEXP ;EVALUATE ABSOLUTE EXPRESSION TRNE %10,1B20 ;NEGATIVE? SETZM %10 ; YES, SET TO ZERO RCTPSH %10 ;PUSH THE COUNT SPUSH %10 ;SAVE PUSH %17,[0] ;TO KEEP .RIF HAPPY .REPTF: CALL GETBLK ;GET STORAGE PUSH %17,MWPNTR ;SAVE STARTING LOCATION SETZM @MWPNTR ;CLEAR LEVEL COUNT AOS MWPNTR ;START IN NEXT WORD SETZM @MWPNTR ;CLEAR SECOND WORD AOS MWPNTR CALL TMCLBL SETLCT LC.MD!LC.MC ;FLAG AS CALL SETZM MACCNT ;INIT ARG COUNT .REPT1: CALL ENDL CALL GETMLI ;GET A LINE SETLCT LC.MD!LC.MC ;FLAG FOR LISTING CAIN %03,DCRPT AOS MACCNT CAIN %03,DCRPTE SOSL MACCNT ;TEST FOR END TLNE %15,ENDFLG ;OR END OF INPUT JRST .REPT2 ; YES MOVE %13,LINPNT SETCHR CAIA GETCHR ;STORE LINE WCIMT 0(%14) JUMPN %14,.-2 ;TEST FOR EOL JRST .REPT1 .REPT2: MOVEI %14,CH.RPT .REPTX: WCIMT 0(%14) ;MARK END OF STORAGE CALL MPUSH ;STACK POP %17,MSBTXP ;SET TEXT POINTER POP %17,MSBAUX ; AND .RIF EXPRESSION POP %17,MSBCNT ; AND COUNT HRLZS MSBCNT ;MOVE COUNT TO LEFT HALF JRST MPOP ;TEST FOR END ENDRPT: ;END OF REPEAT ENDIRP: AOS %03,MSBCNT ;BUMP COUNT, PLACE IN REG HLRZ %04,%03 ;GET END VALUE CAIGE %04,0(%03) ;FINISHED? JRST CPOPJ1 ; YES MOVE %03,MSBTXP ;NO, SET READ POINTER ADDI %03,2 MOVEM %03,MSBMRP RETURN .ENDM: .ENDR: JRST OPCERR ;CAN'T OCCUR OUTSIDE OF DEFINITION .IRP: TDZA %03,%03 ;".IRP", CLEAR FLAG .IRPC: MOVEI %03,1 ;".IRPC", SET FLAG ADDI %03,1 MOVEM %03,IRPTYP ;STORE IT CALL TGARG ;TEST FOR GENERAL ARGUMENT JRST OPCERR ; MISSING, ERROR CALL GGARG ;PROCESS THE ARGUMENT SETZM ARGCNT CALL PROMA ;PROCESS DUMMY ARGS CALL PGARG SETZM IRPCNT SETZM IRPMAX CALL GETBLK MOVEM %01,IRPBEG ;SAVE START .IRP1: AOS %03,IRPCNT ;BUMP COUNT HRRZ %04,MACCNT ;GET ARGUMENT COUNT CAMLE %03,%04 ;THROUGH? JRST .IRP2 ; YES CALL TGARG JFCL CALL GGARG CALL MCFINF WCIMT CH.FIN HRRZ %03,ARGCNT CAMLE %03,IRPMAX MOVEM %03,IRPMAX CALL PGARG JRST .IRP1 .IRP2: WCIMT CH.FIN EXCH %12,IRPMAX ;GET THE ITERATION COUNT WHERE WE CAN USE IT AND..... RCTPSH %12 ;PUSH IT ONTO THE 'STACK' EXCH %12,IRPMAX ;NOW PUT THINGS BACK WHERE THEY BELONG. SPUSH IRPMAX SPUSH IRPBEG CALL TMCLBL SETLCT LC.MD!LC.MC CALL ENDL ;POLISH OFF LINE CALL GETBLK SPUSH MWPNTR CALL PROMT ;PROCESS TEXT SETLCT LC.MD!LC.MC ;ARGUMENT MOVEI %14,CH.IRP ;MARK AS .IRP JRST .REPTX ;EXIT THROUGH .REPT .MACR: ;.MACR DIRECTIVE .MACRO: CALL GSARG ;GET THE NAME JRST OPCERR MACROF: MOVEM %00,MACNAM ;SAVE NAME CALL MSRCH MOVSI %01,MAOP ;RETURN POINT IF NAME NOT FOUND LDB %02,TYPPNT ;ISOLATE TYPE CAIE %02,MAOP ;MACRO? JRST OPCERR ; NO, ERROR TRNE %01,-1 CALL DECMAC HLLM %01,0(%17) ;SAVE FLAGS, ETC. CALL GETBLK HLL %01,0(%17) ;RESTORE FLAGS CALL INSRT CALL CRFOPD CALL PROMA ;PROCESS MACRO ARGUMENTS CALL TMCLBL SETLCT LC.MD CALL ENDL ;WRITE OUT THE LINE CALL PROMT ;PROCESS MACRO TEXT SETLCT LC.MD ; ARGUMENT WCIMT CH.MAC ;FLAG END CALL GSARG ;ARGUMENT? RETURN ; NO CAME %00,MACNAM ;YES, DOES IT MATCH NAME? ERRSET ERR.A ; NO, ERROR RETURN PROMA: ;PROCESS MACRO ARGUMENTS SETZM DSYLST ;MARK END OF LIST SETZM MACCNT ;ZERO NUMBER PROMA1: CALL TGARG ;TEST FOR ARGUMENT RETURN ; NO CAIE %14,"?" ;YES, PERHAPS GENERATION? JRST PROMA2 ;NO MOVN %03,MACCNT ;YES, GET COUNT MOVSI %04,(1B0) LSH %04,0(%03) ;SHIFT BIT IORM %04,MACCNT ;SAVE IT CALL GETNB ;BYPASS UNARY PROMA2: CALL GSARGF ;GET THE ARGUMENT RETURN ; ERROR AOS %03,MACCNT ;OK, BUMP COUNT MOVEM %00,DSYLST-1(%03) ;STORE MNEMONIC SETZM DSYLST(%03) JRST PROMA1 ;TRY FOR MORE TMCLBL: MOVE %03,@0(%17) SKPLCR (%03) SKIPN %03,CLILBL RETURN MOVEM %03,CLIPNT+1 JRST CPOPJ1 PROMT: ;PROCESS MACRO TEXT SETZB %03,@MWPNTR ;CLEAR LEVEL COUNT AOS MWPNTR EXCH %03,MACCNT ;SET AND CLEAR COUNT MOVEM %03,@MWPNTR AOS MWPNTR PROMT1: CALL GETMLI ;PUTS THE TYPE BITS IN AC3 XCT @0(%17) ;EXECUTE ARGUMENT CAIN %03,DCMAC ;MACRO/RPT TYPE INSTRUCTION? AOS MACCNT ;YES CAIN %03,DCMACE ;END? SOSL MACCNT ;YES TLNE %15,ENDFLG ;END ENCOUNTERED? JRST CPOPJ1 ;YES. RETURN AND BYPASS ARGUMENT CAIN %03,DCMCAL ;".MCALL"? SKIPN MCACNT ; YES, NESTED? CAIA ; NO CALL MCALLT ;YES, TEST FOR ADDITIONS MOVE %13,LINPNT SETCHR PROMT2: CALL GETSYM JUMPE %00,PROMT4 SETZM %02 PROMT3: SKIPN %03,DSYLST(%02) JRST PROMT4 CAME %03,%00 AOJA %02,PROMT3 SOS CONCNT WCIMT CF.SPC!CF.DSY+1(%02) SOS CONCNT SKIPA %13,SYMEND PROMT4: MOVE %13,SYMBEG SETCHR PROMT5: CAMN %13,SYMEND JRST PROMT6 WCIMT 0(%14) GETCHR JRST PROMT5 PROMT6: JUMPE %14,PROMT8 SKPEDR ED.COM CAIE %14,";" JRST PROMT7 GETCHR CAIN %14,";" JRST PROMT8 WCIMT ";" JRST PROMT2 PROMT7: CAIN %14,"'" AOSA CONCNT WCIMT 0(%14) GETCHR JRST PROMT2 PROMT8: WCIMT 0 SKIPE ARGEND HALT . SETCHR SKIPGE MACCNT JRST GETSYM CALL ENDL JRST PROMT1 MACROC: ;MACRO CALL CALL SETPF0 TRNN %01,-1 ;EMPTY? JRST OPCERR ;OP VALUE = 0? SPUSH %01 ;STACK ADDRESS MOVE %03,1(%01) MOVEM %03,MACCNT ;SET COUNT CALL INCMAC CALL GETBLK SPUSH MWPNTR ;STACK START ADDRESS CALL MCFIN WCIMT CH.FIN ;PAD ANY MISSING ARGUMENTS MOVEI %14,CH.MAC CALL MPUSH POP %17,MSBAUX SPOP %01 HLL %01,TXTBYT MOVEM %01,MSBTXP ADDI %01,2 MOVEM %01,MSBMRP MOVE %03,ARGCNT HRLZM %03,MSBCNT ;SET FOR ".NARG" CALL TMCLBL SETLCT LC.MC RETURN MCFIN: SETZM IRPTYP MCFINF: SETZM ARGCNT SETZM ARGINC MCFIN1: MOVE %03,IRPTYP CALL @[EXP MCFMAC, MCFIRP, MCFIRC](%03) RETURN WCIMT CH.EOE JRST MCFIN1 MCFIRC: JUMPE %14,MCFIRX WCIMT 0(%14) AOS ARGCNT GETCHR JRST CPOPJ1 MCFMAC: MOVE %03,ARGCNT ADD %03,ARGINC SUB %03,MACCNT TRNN %03,(1B0) RETURN MCFIRP: CALL TGARG MCFIRX: AOSA ARGINC JRST MCFOK CALL MCFGEN SKIPN IRPTYP JRST CPOPJ1 RETURN MCFOK: AOS 0(%17) ;ALL GOOD EXITS NOW CAIN %14,"\" ;TEST UNARIES JRST MCFOK2 CALL GGARG JUMPE %14,MCFOK1 WCIMT 0(%14) GETCHR JUMPN %14,.-2 JRST PGARG MCFOK1: CALL MCFGEN JFCL JRST PGARG MCFOK2: CALL GETNB ;"\", BYPASS CAIN %14,"\" ;DOPBLE? JRST MCFOK3 ; YES CALL ABSEXP ;NO, EVALUATE EXPRESSION HRROS ARGCNT MOVE %03,%10 ;SET MOVE %01,CRADIX ;SET CHARACTERISTICS HRLI %01,"0" JRST MCFDIV MCFOK3: CALL GETNB ;BYPASS SECOND "\" CALL ABSEXP HRROS ARGCNT MOVE %00,%10 ;GET VALUE CALL M40SIX ;CONVERT TO SIXBIT MOVE %03,%00 MOVE %01,[XWD 40,100] JRST MCFDIV MCFDIV: IDIVI %03,0(%01) ;DIVIDE NUMBER HRLM %04,0(%17) ;STACK REMAINDER SKIPE %03 ;ANY MORE? CALL MCFDIV ; YES HLRZ %03,0(%17) ;NO,RETRIEVE NUMBER HLRZ %04,%01 ;GET CONSTANT ADD %03,%04 ;ADD IT IN WCIMT 0(%03) ;STORE IT RETURN MCFGEN: ;GENERAT SYMBOL HLLZ %03,MACCNT MOVE %04,ARGCNT ADD %04,ARGINC LSH %03,-1(%04) JUMPE %03,CPOPJ JUMPG %03,CPOPJ1 AOS %03,LSBGEN ;BUMP GENERATED SYMBOL NUMBER MOVE %01,[XWD "0",^D10] ;SET CHARACTERISTICS CALL MCFDIV ;OUTPUT WCIMT "$" ;COMPLETE GENED SYMBOL JRST CPOPJ1 .NARG: CALL GSARG ;FETCH SYMBOL JRST OPCERR ; MISSING, ERROR SPUSH %00 ;STACK THE SYMBOL HLRZ %10,MSBCNT ;GET COUNT JRST ASGMTF ;EXIT THROUGH "=" .NCHR: CALL GSARG ;GET THE SYMBOL JRST OPCERR ; MISSING, ERROR SPUSH %00 ;OK, STACK IT CALL TGARG ;TEST FOR SECOND ARG JFCL ; EH? CALL GGARG ;FETCH THE ARG SPUSH ARGCHC ;SAVE COUNT CALL PGARG ;FLUSH STORAGE SPOP %10 ;COUNT TO %10 HRRZS %10 JRST ASGMTF ;EXIT THROUGH "=" .NTYPE: CALL GSARG ;GET THE SYMBOL JRST OPCERR ; MISSING, ERROR SPUSH %00 ;OK, STACK IT CALL TGARG ;TEST FOR SECOND ARG JFCL ; EH? CALL AEXP ;PROCESS ADDRESS EXPRESSION MOVE %10,%00 SETZM CODPNT ;CLEAR CODE ROLL SETZM CODBUF JRST ASGMTF ;EXIT THROUGH "=" .MCALL: CALL MCALLT ;TEST ARGUMENTS SKIPN MCACNT RETURN TLNE %15,P1F SKIPN %03,JOBFFM JRST MCALL6 EXCH %03,JOBFF INBUF MAC,NUMBUF MOVEM %03,JOBFF MOVE %03,[XWD MACLUP,MACFIL] BLT %03,MACPPN LOOKUP MAC,MACFIL ;TRY FOR SYSMAC IN USER UFD. PRESENT? CAIA ;NO JRST MCALL3 ;YES MOVE %03,SYSPPN ;NOT FOUND. SET UP FOR SEARCH IN SYS: MOVEM %03,MACPPN ;* LOOKUP MAC,MACFIL ;TRY AGAIN. GOOD? JRST MCALL6 ;NOPE. MCALL3: SETZM MCATMP MCALL4: CALL GETMLI TLNE %15,ENDFLG JRST MCALL6 CAIN %03,DCMACE SOS MCATMP CAIE %03,DCMAC JRST MCALL4 AOS %03,MCATMP CAIE %03,1 JRST MCALL4 CALL GSARG JRST MCALL3 CALL MSRCH CAIA TRNE %01,-1 JRST MCALL4 CALL MACROF TLNE %15,ENDFLG JRST MCALL6 SOSLE MCACNT JRST MCALL3 JRST MCALL7 MCALL6: ERRSET ERR.A MCALL7: SETZM MCACNT TLZ %15,ENDFLG RETURN MCALLT: CALL GSARG ;GET NEXT ARGUMENT RETURN ; END, EXIT CALL MSRCH ;FOUND, ALREADY PROCESSED? AOSA MCACNT ; NO, INCREMENT COUNT AND SKIP JRST MCALLU ; YES, IGNORE MOVSI %01,MAOP ;FLAG AS MACRO CALL INSRT ;INSERT MCALLU: CALL CRFOPD JRST MCALLT MACLUP: SIXBIT /SYSMAC/ SIXBIT /SML/ EXP 0 XWD 0,0 .LOC MACFIL: BLOCK 1 MACEXT: BLOCK 1 BLOCK 1 MACPPN: BLOCK 1 JOBFFM: BLOCK 1 MCACNT: BLOCK 1 ;MACRO CALL COUNT MCATMP: BLOCK 1 MACBUF: BLOCK 1 MACPNT: BLOCK 1 BLOCK 1 .RELOC SUBTTL MACRO STORAGE HANDLERS WCIMT0: ;WRITE CHARACTER IN MACRO TREE SPUSH %02 ;STACK WORK REGISTER MOVEI %02,@JOBUUO ;FETCH ARG SOSL CONCNT ;ANY CONCATENATION CHARS? WCIMT "'" ;YES, WRITE THEM SETZM CONCNT ;CLEAR COUNT JUMPN %02,WCIMT1 ;BRANCH IF NON-DELIMITER MOVEI %02,LF WCIMT1: CALL WCIMT2 ;WRITE IT SPOP %02 RETURN WCIMT2: TRNN %02,177 ;ATTEMPT TO WRITE A NULL? HALT . ; YES, NASTY SKIPN @MWPNTR ;END OF BLOCK? JRST WCIMT3 ; YES, GET ANOTHER DPB %02,MWPNTR ;NO, STORE BYTE IBP MWPNTR ;POINT TO NEXT BYTE RETURN ;EXIT WCIMT3: SPUSH %01 PUSH %17,MWPNTR ;NEAD A NEW BLOCK, SAVE CURRENT POINTER CALL GETBLK ;GET IT HRRZS %01 ;GET START OF NEW BLOCK EXCH %01,0(%17) ;EXCHANGE WITH POINTER TO LAST POP %17,0(%01) ;STORE VECTOR SPOP %01 JRST WCIMT2 ;TRY AGAIN READMC: ;READ MACRO CHARACTER CALL READMB ;GET A MACRO BYTE READMF: TRNN %14,CF.SPC ;SPECIAL? JRST CPOPJ1 ; NO TRNE %14,CF.DSY ;YES, DUMMY SYMBOL? JRST READM1 ; YES TRNE %14,CF.TRP ;END OF SOMETHIN? JRST MPOP ; YES TRNE %14,CF.ARG ;NO, CHAR TRAP AT THIS LEVEL? SKIPN %03,CALSAV JRST CPOPJ1 MOVEM %03,MSBMRP SETZM CALSAV JRST READMC READM1: TRZ %14,CF.SPC!CF.DSY MOVE %03,MSBAUX EXCH %03,MSBMRP MOVEM %03,CALSAV MOVE %04,MSBTYP CAIE %04,CH.IRP ;IRP? JRST READM5 ; NO MOVEI %04,0(%14) READM2: SOJLE %04,READM4 READM3: CALL READMB CAIE %14,CH.FIN JRST READM3 JRST READM2 READM4: HRRZ %14,MSBCNT READM5: MOVEI %04,0(%14) ;GET COUNT READM6: SOJLE %04,READMC READM7: CALL READMB CAIN %14,CH.FIN JRST READMF CAIE %14,CH.EOE JRST READM7 JRST READM6 READMB: ;READ MACRO BYTE LDB %14,MSBMRP ;GET CHARACTER IBP MSBMRP JUMPN %14,CPOPJ ;EXIT IF NON-NULL MOVE %14,MSBMRP MOVE %14,0(%14) ;END OF BLOCK, GET LINK HLL %14,TXTBYT ;FORM BYTE POINTER MOVEM %14,MSBMRP JRST READMB ;TRY AGAIN .MEXIT: SKIPN MSBTYP ;IN MACRO? JRST OPCERR ; NO, ERROR SETOM CNDMEX ;SET FLAG RETURN MPUSH: CALL GETBLK MOVSI %03,- PUSH %17,MWPNTR MPUSH1: SETZM %04 EXCH %04,MSBTYP(%03) MOVEM %04,@MWPNTR AOS MWPNTR AOBJN %03,MPUSH1 MOVEM %14,MSBTYP POP %17,MSBPBP AOS MSBLVL RETURN MPOP: SKIPN MSBLVL HALT . CAMN %14,MSBTYP JRST MPOP1 CALL MPOP1 ERRSET ERR.A JRST MPOP MPOP1: TRC %14,CF.SPC!CF.TRP CAIL %14,T.MIN CAILE %14,T.MAX HALT . SKIPN REPSW ;ARE WE INSIDE A REPEAT BLOCK? JRST MPOP3 ;NO, SO DON'T MESS AROUND SOSLE @REPCT ;DECREMENT THE TOP LEVEL OF THE STACK JRST MPOP4 ;IF WE'RE STILL IN THE TOP LEVEL, SPLIT. SETZM CNDMEX ;OTHERWISE, ENABLE CODE GENERATION AGAIN, SOS REPCT ;POP THE STACK, EXCH %12,REPCT ;, CAIN %12,REPBLK-1 ;AND SEE IF IT'S EMPTY. IS IT? SETZM REPSW ;YES, SO TELL FOLKS WE'RE NOT IN A REPEAT ANY MORE. EXCH %12,REPCT ;NOW PUT THINGS BACK WHERE THEY BELONG CAIA MPOP3: SETZM CNDMEX MPOP4: SPUSH %13 XCT MPOPT(%14) JRST MPOP2 SKIPE %01,MSBTXP CALL DECMAC SKIPE %01,MSBAUX CALL REMMAC SKIPN %01,MSBPBP HALT . MOVSI %03,0(%01) HRRI %03,MSBTYP BLT %03,MSBTYP+MSBLEN-1 CALL REMMAC SOS MSBLVL MPOP2: SPOP %13 RETURN MPOPT: PHASE 0 HALT . T.MIN= . T.MACR: CAIA T.REPT: CALL ENDRPT T.IRP: CALL ENDIRP T.MAX= .-1 DEPHASE .LOC MSBTYP: BLOCK 1 MSBPBP: BLOCK 1 MSBTXP: BLOCK 1 MSBAUX: BLOCK 1 MSBMRP: BLOCK 1 MSBCNT: BLOCK 1 MSBLEN= .-MSBTYP CALSAV: BLOCK 1 MACCNT: BLOCK 1 MSBLVL: BLOCK 1 MACNAM: BLOCK 1 CONCNT: BLOCK 1 DSYLST: BLOCK ^D65 ;MACRO ARGUMENT STORAGE IRPTYP: BLOCK 1 ;1=IRP,2=IRPC IRPBEG: BLOCK 1 IRPCNT: BLOCK 1 IRPMAX: BLOCK 1 ARGINC: BLOCK 1 REPSW: BLOCK 1 ;SET NON-ZERO WHILE INSIDE IRP,IRPC,REPT REPCT: BLOCK 1 ;POINTER TO 'STACK' IN REPBLK. REPBLK: BLOCK ^D128 ;'STACK' FOR REPEAT ITERATION COUNTS .RELOC GGARG: SPUSH %13 ;SAVE START OF FIELD MOVEM %13,%00 ;AND END MOVEI %01,0 ;ZERO CHARACTER COUNT CAIE %14,"<" JRST GGARG2 SETZM %02 GETCHR MOVEM %13,0(%17) ;SAVE NEW START MOVEM %13,%00 ; AND END GGARG1: JUMPE %14,GGARG6 CAIN %14,"<" AOS %02 CAIN %14,">" SOJL %02,GGARG7 CALL GGARG9 JRST GGARG1 GGARG2: CAIE %14,"^" JRST GGARG5 CALL GETNB CAILE %14,40 CAILE %14,137 JRST GGARG6 MOVE %02,%14 GETCHR MOVEM %13,0(%17) ;SAVE NEW START MOVEM %13,%00 ; AND END GGARG3: JUMPE %14,GGARG6 CAMN %14,%02 JRST GGARG7 CALL GGARG9 JRST GGARG3 GGARG5: CAIE %14,";" CAIN %14,"," JRST GGARG8 CAIE %14,SPACE CAIN %14,TAB JRST GGARG8 JUMPE %14,GGARG8 CALL GGARG9 JRST GGARG5 GGARG6: ERRSKP ERR.A GGARG7: GETCHR GGARG8: SPUSH %00 ;STACK END SPUSH %01 ; ANC COUNT SPUSH MWPNTR ;PROTECT POINTER CALL GETBLK ;GET STORAGE SPOP MWPNTR MOVE %02,%01 ;GET COPY OF STORAGE POINTER HRLI %02,ARGBLK BLT %02,ARGLEN-1(%01) ;ZIP CUREENT MOVEM %01,ARGPNT ;SET NEW POINTER SPOP ARGCHC ;SET COUNT SPOP ARGEND SPOP ARGBEG LDB %03,ARGEND HRLM %03,ARGCHC MOVEI %03,0 DPB %03,ARGEND MOVEM %13,ARGTXP ;SAVE END OF FIELD MOVE %13,ARGBEG ;SET TO START OF ARG JRST SETCHR ;SET IT GGARG9: GETCHR ;GET THE NEXT CHARACTER MOVEM %13,%00 ;SET NEW END AOJA %01,CPOPJ ;INCREMENT COUNT AND EXIT PGARG: ;POP GENARAL ARGUMENT SKIPN %13,ARGTXP ;SET TEXT POINTER HALT . SKIPN %01,ARGPNT ;GET POINTER TO PREVIOUS HALT . SKIPN ARGEND HALT . HLRZ %03,ARGCHC DPB %03,ARGEND HRLZ %03,%01 HRRI %03,ARGBLK BLT %03,ARGBLK+ARGLEN-1 ;XFER DATA CALL REMMAC ;RETURN BLOCK FOR DEPOSIT JRST SETNB ;SET NON-BLANK AND EXIT SUBTTL FLOATING POINT EVALUATOR FLTG: TLZ %15,FLTFLG ;CLEAR ERROR FLAG SETZB %00,FLTNUM SETZB %01,FLTNUM+1 SETZB %02,FLTNUM+2 SETZB %03,FLTNUM+3 CAIN %14,"-" TLO %00,(1B0) EXCH %00,FLTNUM SKIPL FLTNUM CAIN %14,"+" FLTG2: GETCHR CAIL %14,"0" CAILE %14,"9" JRST FLTG3 TLNE %00,760000 AOJA %03,FLTG2 ASHC %00,1 MOVEM %00,FLTTMP MOVEM %01,FLTTMP+1 ASHC %00,2 ADD %00,FLTTMP ADD %01,FLTTMP+1 ADDI %01,-"0"(%14) TLZE %01,(1B0) ADDI %00,1 AOBJP %03,FLTG2 FLTG3: CAIE %14,"." JRST FLTG4 TRNE %02,400000 TLO %15,FLTFLG MOVEI %02,400000(%03) JRST FLTG2 FLTG4: SKIPN %03 TLO %15,FLTFLG TRZN %02,400000 HRRZ %02,%03 HLRZS %03 SUB %02,%03 CAIE %14,"E" JRST FLTG6 GETCHR SPUSH %00 SPUSH %01 SETZB %00,%01 CAIN %14,"-" TLOA %01,(1B0) CAIN %14,"+" FLTG5: GETCHR CAIL %14,"0" CAILE %14,"9" JRST FLTG5A IMULI %00,^D10 ADDI %00,-"0"(%14) AOJA %01,FLTG5 FLTG5A: TLZE %01,(1B0) MOVNS %00 SKIPN %01 TLO %15,FLTFLG ADD %02,%00 SPOP %01 SPOP %00 FLTG6: CAIN %01,0 JUMPE %00,FLTG12 TDZA %03,%03 FLTG7: ASHC %00,1 TLNN %00,200000 SOJA %03,FLTG7 JUMPL %02,FLTG9 FLTG8: SOJL %02,FLTG10 MOVEM %00,FLTTMP MOVEM %01,FLTTMP+1 ASHC %00,-2 ADD %00,FLTTMP ADD %01,FLTTMP+1 TLZE %01,(1B0) ADDI %00,1 TLNE %00,(1B0) CALL FLTG20 ADDI %03,3 JRST FLTG8 FLTG9: CAML %00,[^D10B4] CALL FLTG20 SPUSH %01+1 DIV %00,[^D10B4] DIV %01,[^D10B4] SPOP %01+1 SUBI %03,4 AOJL %02,FLTG9 FLTG10: SPUSH %03 ;STACK EXPONENT MOVSI %02,(1B<16-7>) ;SET ONE WORD ROUNDING BIT SETZ %03, ;CLEAR LOW ORDER SKIPA %04,FLTLEN ;GET LENGTH AND SKIP ASHC %02,-^D16 ;MOVE ROUNDING MASK SOJG %04,.-1 TDNN %00,%02 ;TEST FOR ROUNDING REQUIRED TDNE %01,%03 SKPEDR ED.FPT ;YES, ".ROUND" MODE? JRST FLTG11 ; NO, FORGET ROUNDING ASHC %02,1 ;SHIFT BIT UP ONE ADD %00,%02 ADD %01,%03 ;ADD IN BIT FLTG11: SPOP %03 ;RESTORE EXPONENT TLZE %01,(1B0) ;OVERFLOW, LOW ORDER? ADDI %00,1 ; YES, ADD TO UPPER TLNE %00,(1B0) ;OVERFLOW, HIGH ORDER? CALL FLTG20 ; YES, CORRECT LSH %01,1 ;MOVE OVER SIGN BIT LSHC %00,-7 ;MAKE ROOM FOR EXPONENT ADDI %03,^D<35+35+128> DPB %03,[POINT 8,%00,8] LDB %02,[POINT 8,%00,8] CAME %02,%03 ;OVER/UNDER FLOW? ERRSET ERR.T ; YES FLTG12: IOR %00,FLTNUM MOVSI %02,-4 FLTG13: LDB %03,[POINT 16,%00,15] MOVEM %03,FLTNUM(%02) LSHC %00,^D16 AOBJN %02,FLTG13 JRST SETNB FLTG20: LSH %01,1 LSHC %00,-1 LSH %01,-1 AOJA %03,CPOPJ .LOC FLTNUM: BLOCK 4 ;FLOATING POINT NUMBER FLTLEN: BLOCK 1 ;LENGTH FLTTMP: BLOCK 2 .RELOC SUBTTL SIXBIT/RAD50 CONVERSION ROUTINES SIXM40: ;SIXBIT TO RAD50 SPUSH %01 SPUSH %02 SPUSH %03 ;STACK REGISTERS SETZ %01, MOVSI %03,(POINT 6,%00) SIXM41: ILDB %02,%03 ;GET A CHARACTER HLRZ %02,RADTBL(%02) ;MAP IMULI %01,50 ADD %01,%02 TLNE %03,770000 ;FINISHED? JRST SIXM41 ; NO IDIVI %01,50*50*50 ;YES, SPLIT INTO HALVES HRLZ %00,%01 ;HIGH ORDER HRR %00,%02 ; AND LOW ORDER SPOP %03 ;RESTORE REGISTERS SPOP %02 SPOP %01 RETURN M40SIX: ;RAD50 TO SIXBIT SPUSH %01 SPUSH %02 SPUSH %03 LDB %01,[POINT 16,%00,17] IMULI %01,50*50*50 ;MERGE ANDI %00,177777 ADD %00,%01 SETZ %02, ;ACCUMULATOR MOVSI %03,-6 M40SI1: IDIVI %00,50 HRRZ %01,RADTBL(%01) ;MAP LSHC %01,-6 ;MOVE INTO COLLECTOR AOBJN %03,M40SI1 ;TEST FOR END MOVE %00,%02 SPOP %03 SPOP %02 SPOP %01 RETURN RADTBL: XWD <$=0>, 0 XWD 0, "A"-40 XWD 0, "B"-40 XWD 0, "C"-40 XWD <$$=33>, "D"-40 XWD 0, "E"-40 XWD 0, "F"-40 XWD 0, "G"-40 XWD 0, "H"-40 XWD 0, "I"-40 XWD 0, "J"-40 XWD 0, "K"-40 XWD 0, "L"-40 XWD 0, "M"-40 XWD <$.=34>, "N"-40 XWD 0, "O"-40 XWD <$0=36>, "P"-40 XWD <$1=37>, "Q"-40 XWD <$2=40>, "R"-40 XWD <$3=41>, "S"-40 XWD <$4=42>, "T"-40 XWD <$5=43>, "U"-40 XWD <$6=44>, "V"-40 XWD <$7=45>, "W"-40 XWD <$8=46>, "X"-40 XWD <$9=47>, "Y"-40 XWD 0, "Z"-40 XWD 0, "$"-40 XWD 0, "."-40 XWD 0, 0 XWD 0, "0"-40 XWD 0, "1"-40 XWD 0, "2"-40 XWD <$A=1>, "3"-40 XWD <$B=2>, "4"-40 XWD <$C=3>, "5"-40 XWD <$D=4>, "6"-40 XWD <$E=5>, "7"-40 XWD <$F=6>, "8"-40 XWD <$G=7>, "9"-40 XWD <$H=10>, 0 XWD <$I=11>, 0 XWD <$J=12>, 0 XWD <$K=13>, 0 XWD <$L=14>, 0 XWD <$M=15>, 0 XWD <$N=16>, 0 XWD <$O=17>, 0 XWD <$P=20>, 0 XWD <$Q=21>, 0 XWD <$R=22>, 0 XWD <$S=23>, 0 XWD <$T=24>, 0 XWD <$U=25>, 0 XWD <$V=26>, 0 XWD <$W=27>, 0 XWD <$X=30>, 0 XWD <$Y=31>, 0 XWD <$Z=32>, 0 XWD 0, 0 XWD 0, 0 XWD 0, 0 XWD 0, 0 XWD 0, 0 SUBTTL PERMANENT SYMBOL TABLE ROUTINES OSRCH: ;OP TABLE SEARCH CALL MSRCH ;TRY FOR USER-DEFINED OPS FIRST TLZA %00,ST.MAC ; NO, CLEAR FLAG AND SKIP JRST CPOPJ1 ;YES, GOOD EXIT MOVEI %02,1B^L ;SET UP OFFSET AND DELTA MOVEI %01,1B^L/2 OSRCH1: CAMN %00,OPTBOT-2(%02) ;ARE WE LOOKING AT IT? JRST OSRCH3 ; YES CAML %00,OPTBOT-2(%02) ;TEST FOR DIRECTION OF NEXT MOVE TDOA %02,%01 ;ADD OSRCH2: SUB %02,%01 ;SUBTRACT ASH %01,-1 ;HALVE DELTA JUMPE %01,OSRCH4 ;EXIT IF END CAILE %02,OPTTOP-OPTBOT ;YES, ARE WE OUTOF BOUNDS? JRST OSRCH2 ;YES, MOVE DOWN JRST OSRCH1 ;NO, TRY AGAIN OSRCH3: MOVE %01,OPTBOT-1(%02) ;FOUND, PLACE VALUE IN %01 LDB %02,TYPPNT JRST CPOPJ1 OSRCH4: SETZB %01,%02 RETURN SUBTTL SYMBOL TABLE FLAGS TYPOFF= ^D17 ;PACKING PARAMETERS SUBOFF= ^D15 MODOFF= ^D7 BC1= 1 BC2= 2 DEFSYM= 400000 ;DEFINED SYMBOL LBLSYM= 200000 ;LABEL REGSYM= 100000 ;REGISTER GLBSYM= 040000 ;GLOBAL MDFSYM= 020000 ;MULTIPLY-DEFINED FLAG FLTSYM= 010000 ;DEFAULTED GLOBAL SYMBOL DFLSYM= 004000 ;DEFAULT SYMBOL DEFINITION TYPPNT: POINT 2,%01,TYPOFF ;TYPE POINTER SUBPNT: POINT 8,%01,SUBOFF ;SUB-TYPE POINTER CCSPNT: POINT 8,%05,SUBOFF ;CURRENT CSECT POINTER MODPNT: POINT 8,%01,MODOFF MOD20= 400000 MOD45= 200000 ST.MAC= 200000 ST.LSB= 400000 MDMASK= 377B PFMASK= 377B ADMASK= 177777 PCMASK= PFMASK!ADMASK DCCND= 1 DCCNDE= 2 DCMAC= 3 DCMACE= 4 DCRPT= DCMAC DCRPTE= DCMACE DCMCAL= 7 M40DOT: GENM40 . SUBTTL PERMANENT SYMBOL TABLE REGTBL: GENM40 R,0, , , , GENM40 R,1, , , , GENM40 R,2, , , , GENM40 R,3, , , , GENM40 R,4, , , , GENM40 R,5, , , , GENM40 S,P, , , , GENM40 P,C, , , , DEFINE OPCDEF (A,B,C,D,E,F,CLASS,VALUE,MOD) < XLIST GENM40 A,B,C,D,E,F XWD MOD!B33!OCOP,VALUE LIST > DEFINE DIRDEF (A,B,C,D,E,F,TYPE) < XLIST IFDEF A'B'C'D'E'F, < GENM40 A,B,C,D,E,F XWD B33!DIOP,A'B'C'D'E'F > LIST > OPTBOT: ;OP TABLE BOTTOM ;OPCLASS 2 - DOUBLE OPERAND INSTRUCTIONS ;OPCLASS 5 - XOR ;OPCLASS 5A - JSR OPCDEF A,B,S,D, , , OPCL1, 170600, MOD45 OPCDEF A,B,S,F, , , OPCL1, 170600, MOD45 OPCDEF A,D,C, , , , OPCL1, 005500, MOD20!MOD45 OPCDEF A,D,C,B, , , OPCL1, 105500, MOD20!MOD45 OPCDEF A,D,D, , , , OPCL2, 060000, MOD20!MOD45 OPCDEF A,D,D,D, , , OPCL11, 172000, MOD45 OPCDEF A,D,D,F, , , OPCL11, 172000, MOD45 OPCDEF A,S,H, , , , OPCL9, 072000, MOD45 OPCDEF A,S,H,C, , , OPCL9, 073000, MOD45 OPCDEF A,S,L, , , , OPCL1, 006300, MOD20!MOD45 OPCDEF A,S,L,B, , , OPCL1, 106300, MOD20!MOD45 OPCDEF A,S,R, , , , OPCL1, 006200, MOD20!MOD45 OPCDEF A,S,R,B, , , OPCL1, 106200, MOD20!MOD45 OPCDEF B,C,C, , , , OPCL4, 103000, MOD20!MOD45 OPCDEF B,C,S, , , , OPCL4, 103400, MOD20!MOD45 OPCDEF B,E,Q, , , , OPCL4, 001400, MOD20!MOD45 OPCDEF B,G,E, , , , OPCL4, 002000, MOD20!MOD45 OPCDEF B,G,T, , , , OPCL4, 003000, MOD20!MOD45 OPCDEF B,H,I, , , , OPCL4, 101000, MOD20!MOD45 OPCDEF B,H,I,S, , , OPCL4, 103000, MOD20!MOD45 OPCDEF B,I,C, , , , OPCL2, 040000, MOD20!MOD45 OPCDEF B,I,C,B, , , OPCL2, 140000, MOD20!MOD45 OPCDEF B,I,S, , , , OPCL2, 050000, MOD20!MOD45 OPCDEF B,I,S,B, , , OPCL2, 150000, MOD20!MOD45 OPCDEF B,I,T, , , , OPCL2A, 030000, MOD20!MOD45 OPCDEF B,I,T,B, , , OPCL2A, 130000, MOD20!MOD45 OPCDEF B,L,E, , , , OPCL4, 003400, MOD20!MOD45 OPCDEF B,L,O, , , , OPCL4, 103400, MOD20!MOD45 OPCDEF B,L,O,S, , , OPCL4, 101400, MOD20!MOD45 OPCDEF B,L,T, , , , OPCL4, 002400, MOD20!MOD45 OPCDEF B,M,I, , , , OPCL4, 100400, MOD20!MOD45 OPCDEF B,N,E, , , , OPCL4, 001000, MOD20!MOD45 OPCDEF B,P,L, , , , OPCL4, 100000, MOD20!MOD45 OPCDEF B,P,T, , , , OPCL0, 000003, MOD45 OPCDEF B,R, , , , , OPCL4, 000400, MOD20!MOD45 OPCDEF B,V,C, , , , OPCL4, 102000, MOD20!MOD45 OPCDEF B,V,S, , , , OPCL4, 102400, MOD20!MOD45 OPCDEF C,C,C, , , , OPCL0, 000257, MOD20!MOD45 OPCDEF C,F,C,C, , , OPCL0, 170000, MOD45 OPCDEF C,L,C, , , , OPCL0, 000241, MOD20!MOD45 OPCDEF C,L,N, , , , OPCL0, 000250, MOD20!MOD45 OPCDEF C,L,R, , , , OPCL1, 005000, MOD20!MOD45 OPCDEF C,L,R,B, , , OPCL1, 105000, MOD20!MOD45 OPCDEF C,L,R,D, , , OPCL1, 170400, MOD45 OPCDEF C,L,R,F, , , OPCL1, 170400, MOD45 OPCDEF C,L,V, , , , OPCL0, 000242, MOD20!MOD45 OPCDEF C,L,Z, , , , OPCL0, 000244, MOD20!MOD45 OPCDEF C,M,P, , , , OPCL2A, 020000, MOD20!MOD45 OPCDEF C,M,P,B, , , OPCL2A, 120000, MOD20!MOD45 OPCDEF C,M,P,D, , , OPCL15, 173400, MOD45 OPCDEF C,M,P,F, , , OPCL15, 173400, MOD45 OPCDEF C,N,Z, , , , OPCL0, 000254, MOD20!MOD45 OPCDEF C,O,M, , , , OPCL1, 005100, MOD20!MOD45 OPCDEF C,O,M,B, , , OPCL1, 105100, MOD20!MOD45 OPCDEF D,E,C, , , , OPCL1, 005300, MOD20!MOD45 OPCDEF D,E,C,B, , , OPCL1, 105300, MOD20!MOD45 OPCDEF D,I,V, , , , OPCL7, 071000, MOD45 OPCDEF D,I,V,D, , , OPCL11, 174400, MOD45 OPCDEF D,I,V,F, , , OPCL11, 174400, MOD45 OPCDEF E,M,T, , , , OPCL6, 104000, MOD20!MOD45 OPCDEF F,A,D,D, , , OPCL3, 075000, MOD20 OPCDEF F,D,I,V, , , OPCL3, 075030, MOD20 OPCDEF F,M,U,L, , , OPCL3, 075020, MOD20 OPCDEF F,S,U,B, , , OPCL3, 075010, MOD20 OPCDEF H,A,L,T, , , OPCL0, 000000, MOD20!MOD45 OPCDEF I,N,C, , , , OPCL1, 005200, MOD20!MOD45 OPCDEF I,N,C,B, , , OPCL1, 105200, MOD20!MOD45 OPCDEF I,O,T, , , , OPCL0, 000004, MOD20!MOD45 OPCDEF J,M,P, , , , OPCL1A, 000100, MOD20!MOD45 OPCDEF J,S,R, , , , OPCL5A, 004000, MOD20!MOD45 OPCDEF L,D,C,D,F, , OPCL11, 177400, MOD45 OPCDEF L,D,C,F,D, , OPCL11, 177400, MOD45 OPCDEF L,D,C,I,D, , OPCL14, 177000, MOD45 OPCDEF L,D,C,I,F, , OPCL14, 177000, MOD45 OPCDEF L,D,C,L,D, , OPCL14, 177000, MOD45 OPCDEF L,D,C,L,F, , OPCL14, 177000, MOD45 OPCDEF L,D,D, , , , OPCL11, 172400, MOD45 OPCDEF L,D,E,X,P, , OPCL14, 176400, MOD45 OPCDEF L,D,F, , , , OPCL11, 172400, MOD45 OPCDEF L,D,F,P,S, , OPCL1A, 170100, MOD45 OPCDEF L,D,S,C, , , OPCL0, 170004, MOD45 OPCDEF L,D,U,B, , , OPCL0, 170003, MOD45 OPCDEF M,A,R,K, , , OPCL10, 006400, MOD45 OPCDEF M,F,P,D, , , OPCL1A, 106500, MOD45 OPCDEF M,F,P,I, , , OPCL1A, 006500, MOD45 OPCDEF M,O,D,D, , , OPCL11, 171400, MOD45 OPCDEF M,O,D,F, , , OPCL11, 171400, MOD45 OPCDEF M,O,V, , , , OPCL2, 010000, MOD20!MOD45 OPCDEF M,O,V,B, , , OPCL2, 110000, MOD20!MOD45 OPCDEF M,T,P,D, , , OPCL1, 106600, MOD45 OPCDEF M,T,P,I, , , OPCL1, 006600, MOD45 OPCDEF M,U,L, , , , OPCL7, 070000, MOD45 OPCDEF M,U,L,D, , , OPCL11, 171000, MOD45 OPCDEF M,U,L,F, , , OPCL11, 171000, MOD45 OPCDEF N,E,G, , , , OPCL1, 005400, MOD20!MOD45 OPCDEF N,E,G,B, , , OPCL1, 105400, MOD20!MOD45 OPCDEF N,E,G,D, , , OPCL1, 170700, MOD45 OPCDEF N,E,G,F, , , OPCL1, 170700, MOD45 OPCDEF N,O,P, , , , OPCL0, 000240, MOD20!MOD45 OPCDEF R,E,S,E,T, , OPCL0, 000005, MOD20!MOD45 OPCDEF R,O,L, , , , OPCL1, 006100, MOD20!MOD45 OPCDEF R,O,L,B, , , OPCL1, 106100, MOD20!MOD45 OPCDEF R,O,R, , , , OPCL1, 006000, MOD20!MOD45 OPCDEF R,O,R,B, , , OPCL1, 106000, MOD20!MOD45 OPCDEF R,T,I, , , , OPCL0, 000002, MOD20!MOD45 OPCDEF R,T,S, , , , OPCL3, 000200, MOD20!MOD45 OPCDEF R,T,T, , , , OPCL0, 000006, MOD45 OPCDEF S,B,C, , , , OPCL1, 005600, MOD20!MOD45 OPCDEF S,B,C,B, , , OPCL1, 105600, MOD20!MOD45 OPCDEF S,C,C, , , , OPCL0, 000277, MOD20!MOD45 OPCDEF S,E,C, , , , OPCL0, 000261, MOD20!MOD45 OPCDEF S,E,N, , , , OPCL0, 000270, MOD20!MOD45 OPCDEF S,E,T,D, , , OPCL0, 170011, MOD45 OPCDEF S,E,T,F, , , OPCL0, 170001, MOD45 OPCDEF S,E,T,I, , , OPCL0, 170002, MOD45 OPCDEF S,E,T,L, , , OPCL0, 170012, MOD45 OPCDEF S,E,V, , , , OPCL0, 000262, MOD20!MOD45 OPCDEF S,E,Z, , , , OPCL0, 000264, MOD20!MOD45 OPCDEF S,O,B, , , , OPCL8, 077000, MOD45 OPCDEF S,P,L, , , , OPCL13, 000230, MOD45 OPCDEF S,T,A,0, , , OPCL0, 170005, MOD45 OPCDEF S,T,B,0, , , OPCL0, 170006, MOD45 OPCDEF S,T,C,D,F, , OPCL12, 176000, MOD45 OPCDEF S,T,C,D,I, , OPCL12, 175400, MOD45 OPCDEF S,T,C,D,L, , OPCL12, 175400, MOD45 OPCDEF S,T,C,F,D, , OPCL12, 176000, MOD45 OPCDEF S,T,C,F,I, , OPCL12, 175400, MOD45 OPCDEF S,T,C,F,L, , OPCL12, 175400, MOD45 OPCDEF S,T,D, , , , OPCL12, 174000, MOD45 OPCDEF S,T,E,X,P, , OPCL12, 175000, MOD45 OPCDEF S,T,F, , , , OPCL12, 174000, MOD45 OPCDEF S,T,F,P,S, , OPCL1, 170200, MOD45 OPCDEF S,T,Q,0, , , OPCL0, 170007, MOD45 OPCDEF S,T,S,T, , , OPCL1, 170300, MOD45 OPCDEF S,U,B, , , , OPCL2, 160000, MOD20!MOD45 OPCDEF S,U,B,D, , , OPCL11, 173000, MOD45 OPCDEF S,U,B,F, , , OPCL11, 173000, MOD45 OPCDEF S,W,A,B, , , OPCL1, 000300, MOD20!MOD45 OPCDEF S,X,T, , , , OPCL1, 006700, MOD45 OPCDEF T,R,A,P, , , OPCL6, 104400, MOD20!MOD45 OPCDEF T,S,T, , , , OPCL1A, 005700, MOD20!MOD45 OPCDEF T,S,T,B, , , OPCL1A, 105700, MOD20!MOD45 OPCDEF T,S,T,D, , , OPCL1A, 170500, MOD45 OPCDEF T,S,T,F, , , OPCL1A, 170500, MOD45 OPCDEF W,A,I,T, , , OPCL0, 000001, MOD20!MOD45 OPCDEF X,O,R, , , , OPCL5, 074000, MOD45 DIRDEF .,A,B,S, , DIRDEF .,A,S,C,I,I DIRDEF .,A,S,C,I,Z DIRDEF .,A,S,E,C,T DIRDEF .,B,L,K,B, DIRDEF .,B,L,K,W, DIRDEF .,B,Y,T,E, DIRDEF .,C,S,E,C,T DIRDEF .,D,E,P,H,A DIRDEF .,D,S,A,B,L DIRDEF .,E,N,A,B,L DIRDEF .,E,N,D, , DIRDEF .,E,N,D,C, , DCCNDE DIRDEF .,E,N,D,M, , DCMACE DIRDEF .,E,N,D,R, , DCRPTE DIRDEF .,E,O,T, , DIRDEF .,E,Q,U,I,V DIRDEF .,E,R,R,O,R DIRDEF .,E,V,E,N, DIRDEF .,F,L,T,2, DIRDEF .,F,L,T,4, DIRDEF .,G,L,O,B,L DIRDEF .,I,D,E,N,T DIRDEF .,I,F, , , , DCCND DIRDEF .,I,F,D,F, , DCCND DIRDEF .,I,F,E,Q, , DCCND DIRDEF .,I,F,F, , , DCCND DIRDEF .,I,F,G, , , DCCND DIRDEF .,I,F,G,E, , DCCND DIRDEF .,I,F,G,T, , DCCND DIRDEF .,I,F,L, , , DCCND DIRDEF .,I,F,L,E, , DCCND DIRDEF .,I,F,L,T, , DCCND DIRDEF .,I,F,N,D,F, DCCND DIRDEF .,I,F,N,E, , DCCND DIRDEF .,I,F,N,Z, , DCCND DIRDEF .,I,F,T, , , DCCND DIRDEF .,I,F,T,F, , DCCND DIRDEF .,I,F,Z, , , DCCND DIRDEF .,I,I,F, , DIRDEF .,I,R,P, , , DCMAC DIRDEF .,I,R,P,C, , DCMAC DIRDEF .,L,I,M,I,T DIRDEF .,L,I,S,T, DIRDEF .,L,O,C,A,L DIRDEF .,M,A,C,R, , DCMAC DIRDEF .,M,A,C,R,O, DCMAC DIRDEF .,M,C,A,L,L, DCMCAL DIRDEF .,M,E,X,I,T DIRDEF .,N,A,R,G, DIRDEF .,N,C,H,R, DIRDEF .,N,L,I,S,T DIRDEF .,N,T,Y,P,E DIRDEF .,O,D,D, , DIRDEF .,P,A,G,E, DIRDEF .,P,D,P,1,0 DIRDEF .,P,H,A,S,E DIRDEF .,P,R,I,N,T DIRDEF .,P,S,E,C,T DIRDEF .,R,A,D,I,X DIRDEF .,R,A,D,5,0 DIRDEF .,R,E,M, , DIRDEF .,R,E,P,T, , DCRPT DIRDEF .,R,O,U,N,D DIRDEF .,S,B,T,T,L DIRDEF .,T,I,T,L,E DIRDEF .,T,R,U,N,C DIRDEF .,W,O,R,D, OPTTOP: -1B36 ;OP TABLE TOP SUBTTL CHARACTER DISPATCH ROUTINES C1PNTR: POINT 4,CHJTBL(%14), 3 C2PNTR: POINT 4,CHJTBL(%14), 7 C3PNTR: POINT 4,CHJTBL(%14),11 C4PNTR: POINT 4,CHJTBL(%14),15 C5PNTR: POINT 4,CHJTBL(%14),19 C6PNTR: POINT 4,CHJTBL(%14),23 C7PNTR: POINT 4,CHJTBL(%14),27 C8PNTR: POINT 4,CHJTBL(%14),31 C9PNTR: POINT 4,CHJTBL(%14),35 ANPNTR= C8PNTR CHJTBL: ;CHARACTER JUMP TABLE PHASE 0 BYTE (4) , , , , , ,QJNU, , ; BYTE (4) , , , , , , , , ; BYTE (4) , , , , , , , , ; BYTE (4) , , , , , , , , ; BYTE (4) , , , , , , , , ; BYTE (4) , , , , , , , , ; BYTE (4) , , , , , , , , ; BYTE (4) , , , , , , , , ; BYTE (4) , , , , , , , , ; TAB: BYTE (4) , , , , , ,QJTB, , ; TAB LF: BYTE (4) , , , , , ,QJCR, , ; LF BYTE (4) , , , , , ,QJVT, , ; FF: BYTE (4) , , , , , ,QJCR, , ; FF CRR: BYTE (4) , , , , , ,QJCR, , ; CR BYTE (4) , , , , , , , , ; BYTE (4) , , , , , , , , ; BYTE (4) , , , , , , , , ; BYTE (4) , , , , , , , , ; BYTE (4) , , , , , , , , ; BYTE (4) , , , , , , , , ; BYTE (4) , , , , , , , , ; BYTE (4) , , , , , , , , ; BYTE (4) , , , , , , , , ; BYTE (4) , , , , , , , , ; BYTE (4) , , , , , , , , ; BYTE (4) , , , , , , , , ; BYTE (4) , , , , , ,QJNU, , ; EOF BYTE (4) , , , , , , , , ; BYTE (4) , , , , , , , , ; BYTE (4) , , , , , , , , ; BYTE (4) , , , , , , , , ; BYTE (4) , , , , , , , , ; SPACE: BYTE (4) , , , , , ,QJSP, , ; SPACE BYTE (4) , , ,EXOR, , ,QJPC, , ; ! BYTE (4) , , , ,TEDQ, ,QJPC, , ; " BYTE (4) , , , , , ,QJPC, , ; # BYTE (4) , , , , , ,QJPC,.DOL, ; $ BYTE (4) , , , ,TEPC, ,QJPC, , ; % BYTE (4) , , ,EXAN, , ,QJPC, , ; & BYTE (4) , , , ,TESQ, ,QJPC, , ; ' BYTE (4) , , , , , ,QJPC, , ; ( BYTE (4) , , , , , ,QJPC, , ; ) BYTE (4) , , ,EXMU, , ,QJPC, , ; * BYTE (4) , , ,EXPL,TEPL, ,QJPC, , ; + BYTE (4) , , , , , ,QJPC, , ; , BYTE (4) , , ,EXMI,TEMI, ,QJPC, , ; - BYTE (4) , , , , , ,QJPC,.DOT, ; . BYTE (4) , , ,EXDV, , ,QJPC, , ; / BYTE (4) , , , ,TENM, ,QJPC,.NUM, ; 0 BYTE (4) , , , ,TENM, ,QJPC,.NUM, ; 1 BYTE (4) , , , ,TENM, ,QJPC,.NUM, ; 2 BYTE (4) , , , ,TENM, ,QJPC,.NUM, ; 3 BYTE (4) , , , ,TENM, ,QJPC,.NUM, ; 4 BYTE (4) , , , ,TENM, ,QJPC,.NUM, ; 5 BYTE (4) , , , ,TENM, ,QJPC,.NUM, ; 6 BYTE (4) , , , ,TENM, ,QJPC,.NUM, ; 7 BYTE (4) , , , ,TENM, ,QJPC,.NUM, ; 8 BYTE (4) , , , ,TENM, ,QJPC,.NUM, ; 9 BYTE (4) , , , , , ,QJPC, , ; : BYTE (4) , , , , , ,QJPC, , ; ; BYTE (4) , , , ,TEAB, ,QJPC, , ; < BYTE (4) , , , , , ,QJPC, , ; = BYTE (4) , , , , , ,QJPC, , ; > BYTE (4) , , , , , ,QJPC, , ; ? BYTE (4) , , , , , ,QJPC, , ; @ BYTE (4) , , , , , ,QJPC,.ALP, ; A BYTE (4) , , , , , ,QJPC,.ALP, ; B BYTE (4) , , , , , ,QJPC,.ALP, ; C BYTE (4) , , , , , ,QJPC,.ALP, ; D BYTE (4) , , , , , ,QJPC,.ALP, ; E BYTE (4) , , , , , ,QJPC,.ALP, ; F BYTE (4) , , , , , ,QJPC,.ALP, ; G BYTE (4) , , , , , ,QJPC,.ALP, ; H BYTE (4) , , , , , ,QJPC,.ALP, ; I BYTE (4) , , , , , ,QJPC,.ALP, ; J BYTE (4) , , , , , ,QJPC,.ALP, ; K BYTE (4) , , , , , ,QJPC,.ALP, ; L BYTE (4) , , , , , ,QJPC,.ALP, ; M BYTE (4) , , , , , ,QJPC,.ALP, ; N BYTE (4) , , , , , ,QJPC,.ALP, ; O BYTE (4) , , , , , ,QJPC,.ALP, ; P BYTE (4) , , , , , ,QJPC,.ALP, ; Q BYTE (4) , , , , , ,QJPC,.ALP, ; R BYTE (4) , , , , , ,QJPC,.ALP, ; S BYTE (4) , , , , , ,QJPC,.ALP, ; T BYTE (4) , , , , , ,QJPC,.ALP, ; U BYTE (4) , , , , , ,QJPC,.ALP, ; V BYTE (4) , , , , , ,QJPC,.ALP, ; W BYTE (4) , , , , , ,QJPC,.ALP, ; X BYTE (4) , , , , , ,QJPC,.ALP, ; Y BYTE (4) , , , , , ,QJPC,.ALP, ; Z BYTE (4) , , , , , ,QJPC, , ; [ BYTE (4) , , , , , ,QJPC, , ; \ BYTE (4) , , , , , ,QJPC, , ; ] BYTE (4) , , , ,TEUA, ,QJPC, , ; ^ BYTE (4) , , , , , ,QJPC, , ; _ BYTE (4) , , , , , , , , ; BYTE (4) , , , , , ,QJLC, , ; BYTE (4) , , , , , ,QJLC, , ; BYTE (4) , , , , , ,QJLC, , ; BYTE (4) , , , , , ,QJLC, , ; BYTE (4) , , , , , ,QJLC, , ; BYTE (4) , , , , , ,QJLC, , ; BYTE (4) , , , , , ,QJLC, , ; BYTE (4) , , , , , ,QJLC, , ; BYTE (4) , , , , , ,QJLC, , ; BYTE (4) , , , , , ,QJLC, , ; BYTE (4) , , , , , ,QJLC, , ; BYTE (4) , , , , , ,QJLC, , ; BYTE (4) , , , , , ,QJLC, , ; BYTE (4) , , , , , ,QJLC, , ; BYTE (4) , , , , , ,QJLC, , ; BYTE (4) , , , , , ,QJLC, , ; BYTE (4) , , , , , ,QJLC, , ; BYTE (4) , , , , , ,QJLC, , ; BYTE (4) , , , , , ,QJLC, , ; BYTE (4) , , , , , ,QJLC, , ; BYTE (4) , , , , , ,QJLC, , ; BYTE (4) , , , , , ,QJLC, , ; BYTE (4) , , , , , ,QJLC, , ; BYTE (4) , , , , , ,QJLC, , ; BYTE (4) , , , , , ,QJLC, , ; BYTE (4) , , , , , ,QJLC, , ; BYTE (4) , , , , , , , , ; BYTE (4) , , , , , , , , ; ALTMOD: BYTE (4) , , , , , , , , ; BYTE (4) , , , , , , , , ; RUBOUT: BYTE (4) , , , , , ,QJNU, , ; DEPHASE SUBTTL IMPURE AREA AND DEBUG PATCH AREA .LOC ;IMPURE STORAGE EZCOR: ;END OF ZERO'D CORE .RELOC ;BACK TO CODE SEGMENT IFDEF DEBUG, < ZZZ000: BLOCK 100 ;DEBUG PATCH AREA> END START ;....MACY11