Trailing-Edge
-
PDP-10 Archives
-
BB-JF16A-SB_1986
-
micro.mac
There are 5 other files named micro.mac in the archive. Click here to see a list.
TITLE MICRO CODE ASSEMBLER
SUBTTL TOM EGGERS/JSL/AF/DAL/TWE 10 NOV 77
;ASSEMBLY INSTRUCTIONS:
; LOAD MICRO
; SSAV MICRO
.TEXT "/SYMSEG:HI/LOCALS"
.REQUE SYS:SCAN
.REQUE SYS:HELPER
CUSTVR==0 ;CUSTOMER VERSION
DECVER==31 ;MAJOR VERSION
DECMVR==0 ;MINOR VERSION
DECEVR==254 ;EDIT NUMBER
LOC <.JBVER==:137>
BYTE (3) CUSTVR (9) DECVER (6) DECMVR (18) DECEVR
;NEW FEATURES NEEDED:
; 1) SCAN SWITCHES TO SET OR CLEAR CONDITIONAL ASSEMBLY VARIABLES
; AND TO TURN ON OR OFF LISTING ON A PER-FILE BASIS
DEFINE SWSET (VAR,VAL),<
IFNDEF VAR,<VAR==VAL>
IF2,< IFN VAR,<
PRINTX SWITCH VAR IS ON
> IFE VAR,<
PRINTX SWITCH VAR IS OFF
>> >
SWSET FTULD,1 ;1 TO OUTPUT "ULD" FILE
SWSET FTCOIN,0 ;1 TO CREF ALL LINES OF ONE WORD TOGETHER
SWSET FTMAP,1 ;1 TO PRINT MAP OF LINE #'S BY LOCATION
SWSET FTECHR,0 ;1 TO PRINT LAST CHAR ON ERROR
SWSET (FTIF,1) ;1 TO ENABLE CONDITIONAL ASSEMBLY LOGIC
SWSET (FTHASH,1) ;1 TO HASH SYMBOL TABLE
NINBUF==2 ;NUMBER OF INPUT BUFFERS REQUESTED
NOUBUF==2 ;NUMBER OF OUTPUT BUFFERS
;AC DEFINITIONS
F==0 ;FLAG REGISTER
T1=1 ;GLOBAL TEMP
T2=T1+1 ;DITTO
T3=T2+1
T4=T3+1
RAM==7 ;CONTAINS RAM NUMBER CURRENTLY BEING ASSEMBLED
UCODE==0
DISP==1 ;BITS WITHIN AC RAM
FPNT=10 ;POINTS TO CURRENT FIELD NAME IN SYM TABLE
SPNT=11 ;POINTS TO CURRENT SYMBOL NAME IN SYM TABLE
C=12 ;HOLDS LAST CHARACTER READ FOR INPUT
C1=C+1
N=14 ;GLOBAL AC FOR PASSING ARGS
N1=N+1 ;DITTO
PM=16 ;STACK FOR MACROS AND RESCANS
P=17 ;PUSH DOWN POINTER
;IN AC F (RIGHT HALF)
REREAD==1 ;REREAD LAST INPUT CHARACTER
SUPP==2 ;SUPPRESS ASSEMBLY
SEQUEN==4 ;FORCE SEQUENTIAL LOCATION ASSIGNMENT
NOXLAT==10 ;PREVENT CHARACTER TRANSLATION WHILE STORING MACRO TEXT
LALF==20 ;ENABLE CONSTRAINT/TAG PROCESSING THIS WORD
BINF==200 ;BINARY WORD HAS BEEN STARTED
PASS2==400 ;0 FOR PASS1, 1 FOR PASS2
ERROR==1000 ;ERROR FOUND ON LINE
NOHDR==2000 ;SUPPRESS PRINTING TOP-OF-PAGE HEADERS
RTOL==4000 ;RIGHT TO LEFT BIT NUMBERING
DOLST==10000 ;OUTPUT LISTING FILE
DOULD==20000 ;OUTPUT .ULD FILE
HEXF==40000 ;RADIX 16 FLAG
DRAMF==100000 ;.DCODE SEEN
UPCF==200000 ;USED BY "ALLOC" TO FLAG "USED PC"
OPDEF UUO1 [1B8]
DEFINE MSG (A,B)
<XLIST
UUO1 [XWD [ASCIZ @B@],A]
LIST>
;DEFINE IO CHANNELS
IFN FTULD,<OUTCH2==2>;END FTULD
OUTCHN==0
INCHN==1
LPPAG==^D58 ;LINES PER PAGE
PNTMAX==^D127 ;LENGTH OF SRC LINE BUFFER
; MUST BE MULTIPLE OF 8, MINUS 1
DEFINE PINDEX (SIZ,ADR)
<XX==-1
REPEAT ^D36/<SIZ>,< POINT SIZ,ADR,<XX==XX+SIZ>
> >
;STRUCTURE DEFINITIONS
MICMXB==^D144 ;MAX NUMBER OF BITS IN A MICRO WORD
MICMXW==MICMXB/^D36 ;MAX NUMBER OF WORDS FOR A MICRO WORD
NWORDS==4 ;MAX NUMBER OF WORDS TO HOLD A SYMBOL
NCHARS==NWORDS*5-1 ;MAX NUM OF CHARS IN A SYMBOL
MACMAX==30 ;MAX NUMBER OF WORDS FOR MACRO WITH ARGUMENTS
MAXPC==17777 ;MAXIMUM ADDRESS OF MICRO CODE
MAXDSP==777 ;MAX ADDRESS OF DISPATCH
PRFMAX==^D16 ;MAX NUMBER OF PREFERENCE REGIONS IN CONTROL STORE
;STRUCTURE OF A SYMBOL TABLE ENTRY
LOC 0
SYMLNK: BLOCK 1 ;LEFT HALF CHAINS SYMBOLS WITHIN A FIELD TOGETHER
;RIGHT HALF CHAINS FIELDS TOGETHER
;POINTER TO 1ST FIELD IS IN FLDPNT
SYMTXT: BLOCK NWORDS ;1ST WORD WITH ASCIZ TEXT FOR NAME
SYMVAL: BLOCK 1 ;CONTAINS VALUES FOR A SYMBOL
;FOR MACRO SYMS, RH POINTS TO 1ST CHAR OF MACRO EXPANSION
;FOR PSEUDO OPS, RH IS HANDLER ADDRESS
SYMFLG: BLOCK 1 ;CONTAINS FLAGS FOR SYMBOL
SYMCRF: BLOCK 1 ;LEFT IS POINTER TO LAST ITEM IN CREF LIST
;RIGHT IS POINTER TO 1ST ITEM
IFN FTHASH,<
SYMHSH: BLOCK 1 ;LH: FLDPNT IN FIELD NAME BLOCKS
; POINTER TO FIELD IN SYMBOL
;RH: LINK TO NEXT SYMBOL WITH
; SAME HASH CODE
HSHLEN==^D503 ;NUMBER OF ENTRIES IN HSHTAB
>
SYMLEN==.-SYMLNK ;# OF WORDS IN A SYMBOL BLOCK
;FLAGS IN SYMBOL FLAG FIELD
MULF==1
DEFF==2 ;DEFINED FLAG (1 IF DEFINED)
NCRFF==4 ;SUPPRESS CREF OF THIS SYMBOL
;MACHINE-SPECIFIC FEATURE CODES
M$KL10==1
M$STAR==2
;STRUCTURE OF LOCATION ASSIGNMENT LIST (LAL)
;"LALHED" IS IN XWD FORMAT:
;LH POINTS TO HEAD OF LIST
;RH POINTS TO LAST ITEM (FOOT) OF LIST
LOC 0
LALPNT: BLOCK 1 ;LH IS POINTER TO 2-WORD-BLOCK LIST OF TAGS,
; = ASSIGNMENTS, & ABS ASSIGNMENTS
;RH IS POINTER TO NEXT 3-WORD-BLOCK
LALLOC: BLOCK 1 ;U-WORD LOCATION
LALLIN: BLOCK 1 ;BYTE (1)ASSIGNED(10)UNUSED(7)PCTYPE(18)LINE#
LALSZ==. ;LENGTH OF THIS BLOCK
;THE CODE AND VALUE BLOCK LIST IS POINTED TO BY LALPNT(LEFT HALF)
LOC 0
LALCD: BLOCK 1 ;LH IS POINTER TO NEXT BLOCK
;RH IS CODE TYPE (LISTED NEXT)
.LLNUM==1 ;THIS BLOCK ENTRY IS "NUMBER:"
.LLTAG==2 ;ENTRY IS "TAG:"
.LLEQL==3 ;ENTRY IS FOR "=", WITH/WITHOUT BINARY NUMBER
.LLFIL==4 ;ENTRY SELECTS NEW INDEX IN FILE LIST
.LLRGN==5 ;ENTRY SELECTS A NEW LIST OF REGION SPEC'S
LALVL: BLOCK 1 ;CODE TYPE LH RH
;.LLNUM UNUSED NUMBER
;.LLTAG FIELD ENTRY POINTER TO SYM TAB ENTRY
;.LLEQL BITS 0-5: NUMBER OF BITS
; BITS6-20: * POSITIONS
; BITS 21-35: "1" POSITIONS
;.LLFIL UNUSED INDEX INTO FILE LIST
;.LLRGN START ADDR END ADDR OF REGION
LLCDSZ==.
TWOSEG
RELOC 400000
MICRO:: RESET
MOVEI 17,1
MOVEI 0,0
BLT 17,17 ;ZERO THE AC'S
MOVE P,[IOWD PDLEND-PDL-1,PDL]
MOVEI C,0
RUNTIM C, ;GET STARTING RUNTIME
; PUSHJ P,ADJT20 ;ADJUST FOR TOPS-20
SETZM GOBLT
MOVE T1,[GOBLT,,GOBLT+1]
BLT T1,ENDBLT-1 ;ZERO STORAGE AREA
MOVEM C,STTIME ;SAVE STARTING TIME
MOVE PM,[IOWD PMEND-PMDL-1,PMDL]
PUSH PM,[0] ;THERE ARE NO FORMALS TO THE TOP-LEVEL MACRO
MOVE T1,[PUSHJ P, UUOH]
MOVEM T1,41
MOVEI T1,PUTL ;INIT OUTPUT TO LISTING
MOVEM T1,PUTP
MOVE T1,0
PUSHJ P,.ISCAN##
MOVE T1,[10,,[0
0
0
-1 ;FLAG SAYING MICRO.HLP IS ON SYS:
0
ALLIN,,ALLOUT
0
EXP 1B18]]
PUSHJ P,.TSCAN##
;SETUP IO
INIMCR: MOVEI T1,0
SKIPN T2,O.DEV
MOVSI T2,'DSK'
MOVEM T2,OUTDEV
MOVSI T3,OUTBLK
OPEN OUTCHN,T1
MSG [EXIT], CAN NOT OPEN LISTING DEVICE
OUTBUF OUTCHN,NOUBUF
MOVEI T1,.RBPRV ;MAX EXTENDED ENTER ENTRY NEEDED
MOVEM T1,OUTFIL+.RBCNT
SKIPE T1,I.FILE ;GET INDEX TO 1ST INPUT FILE
MOVE T1,I.NAM(T1) ;GET NAME (OR LEAVE NAME 0)
SKIPE O.NAM+1 ;IS THERE AN OUTPUT NAME?
MOVE T1,O.NAM ;YES, SO USE IT AND NOT DEFAULT
MOVEM T1,OUTFIL+.RBNAM
HLLZ T2,O.EXT
SKIPN O.EXT
MOVSI T2,'MCR'
MOVEM T2,OUTFIL+.RBEXT
SETZB T3,OUTFIL+.RBPRV
MOVE T4,O.PPN
MOVEM T4,OUTFIL+.RBPPN
ENTER OUTCHN,OUTFIL
MSG [EXIT], CAN NOT ENTER LISTING FILE
SETOM OUTENA ;ENABLE OUTPUT
;HERE TO INITIALIZE ULD OUTPUT
IFN FTULD,<
INIULD: TRNN F,DOULD ;.ULD FILE SPECIFIED
JRST NOULD ;NO--SKIP ALL THIS STUFF
;DEFAULT .ULD DEVICE, FILE AND PPN TO MATCH OUTPUT FILE
MOVE T1,O.DEV
SKIPN U.DEV
MOVEM T1,U.DEV
MOVE T1,O.NAM
SKIPN U.NAM+1
MOVEM T1,U.NAM
MOVSI T1,'ULD' ;DEFAULT EXT IS .ULD
SKIPN U.EXT
MOVEM T1,U.EXT
MOVE T1,O.PPN
SKIPN U.PPN
MOVEM T1,U.PPN
MOVEI T1,0
MOVE T2,U.DEV
MOVSI T3,BUFOUT
OPEN OUTCH2,T1
MSG [EXIT], CAN NOT OPEN ULD DEVICE
OUTBUF OUTCH2,0
MOVE T1,U.NAM
HLLZ T2,U.EXT
MOVEI T3,0
MOVE T4,U.PPN
ENTER OUTCH2,T1
MSG [EXIT], CAN NOT ENTER ULD FILE
NOULD:
>;END FTULD
;INITIALIZE TO BEGIN ASSEMBLY
MOVE T1,I.CNT
MOVEM T1,I.MAXC
PUSHJ P,PNTINI ;INIT OUTPUT LISTING
HRROI T1,1 ;START AT PAGE 1, NEED A HEADER
MOVEM T1,PAGNUM
MOVEI N,LALSZ ;INIT 1ST LOCATION ASSIGNMENT BLOCK
MOVEM N,LALCOR
PUSHJ P,GETWRD
HRLS N
MOVEM N,LALHED ;AT BEGINNING, HEAD AND FOOT ARE EQUAL
;INITIALIZE PREFERENCE PARAMETERS
SETZM PRFTB1 ;START AT ZERO
MOVEI T1,MAXPC ;END AT HIGHEST PC ASSEMBLED FOR
MOVEM T1,PRFTB2
MOVSI T1,-<<MAXPC+^D35>/^D36>
MOVEM T1,PRFTB3 ;AOBJN PTR FOR SCAN THROUGH USAGE
SETZM PRFTB3+1 ;FLAG END OF PREFRENCE TABLE
SETOM PRFTB4 ;FULL MASK FOR FIRST WORD OF USAGE
;BEGIN ASSEMBLY BY READING 1ST INPUT FILE FOR PASS 1
PUSHJ P,BEGPAS ;START PASS 1
SETZM INFILE+.RBNAM ;FILE NAME IS MEANINGLESS BETWEEN PASSES
PUSHJ P,ALLOC ;DEFINE TAGS AND ALLOCATE U-INSTRUCTIONS
HLRS LALHED ;RESET FOOT TO POINT TO HEAD OF
; LOCATION ASSIGNMENT LIST
TRO F,PASS2
PUSHJ P,START2 ;LIST TABLE OF CONTENTS
MOVE T1,.JBFF## ;GET FIRST FREE LOC BEFORE BUILDING CREF
MOVEM T1,P2JFF ;SAVE TO RE-USE AFTER CREF PRINTED
PUSHJ P,BEGPAS ;START PASS 2
PUSHJ P,FINLST
IFN FTULD,<
PUSH P,PUTP ;SAVE CURRENT OUTPUT ROUTINE
MOVEI T1,PUTU ;SETUP FOR ULD OUTPUT
MOVEM T1,PUTP
PUSHJ P,PRINT ;LAST STATEMENT IN "ULD" FILE
ASCIZ /
END
/
POP P,PUTP ;RESTORE OUTPUT POINTER
CLOSE OUTCH2,
RELEAS OUTCH2,
>;END FTULD
CLOSE OUTCHN,
RELEAS OUTCHN,
RESET
EXIT 1, ;MICRO ASSEMBLY COMPLETLY DONE
JRST MICRO ;DO ANOTHER
;SUBROUTINE FOR DOING EACH PASS
BEGPAS: SETZM STATE ;INIT STATE FOR SYNTAX ANALYSIS
HLRZ T1,LALHED ;GET ADDRESS OF FIRST LAL ITEM
SKIPE T1
MOVE T1,LALLOC(T1) ;GET LOCATION ALLOCATED TO IT
MOVEM T1,PC+UCODE ;INITIAL PC INTO WHICH TO ASSEMBLE
SETZM PC+DISP
SETOM HIGHPC+UCODE ;INITIAL HIGH PC IS -1
SETOM HIGHPC+DISP
MOVEI RAM,UCODE ;START WITH UCODE ASSEMBLY
MOVEI T1,1
MOVEM T1,LINNUM ;INIT LINE NUMBER TO 1
MOVEI T1,^D8 ;START RADIX AT OCTAL
MOVEM T1,RADIX
PUSHJ P,BEGIO ;INIT INPUT IO
MSG [EXIT], NO INPUT FILES
SETZM USAGE
MOVE T1,[USAGE,,USAGE+1]
BLT T1,USGEND-1 ;CLEAR USAGE TABLE
ANDI F,PASS2!DOULD!DRAMF
;TOP LEVEL ASSEMBLY LOOP
STATLP: SKIPE STATE
JRST STAT1
TRZ F,BINF ;ONLY CLEARED IN STATE 0
SETZM VALUE
MOVE T1,[VALUE,,VALUE+1]
BLT T1,VALEND-1
MOVE T1,LINNUM
HRRZM T1,CRFLIN# ;CREF LINE # CHANGES ONLY ON MICRO WORDS
STAT1: PUSHJ P,TOKEN ;SCAN NEXT TOKEN
LSH N,.SZTRM ;MOVE TOKEN TYPE OVER
LDB T1,STAPNT ;GET TERM CHARACTER TYPE
IOR T1,N ;COMBINE STATE, TOKEN TYPE, AND TERM TYPE
IOR T1,STATE
IDIVI T1,^D36/<.SZDSP+.SZSTA>
LDB T1,STAMTB(T1+1) ;GET DISPATCH AND NEW STATE
DPB T1,[POINT .SZSTA,STATE,^D35-.SZTOK-.SZTRM]
LSH T1,-.SZSTA
LSH T1,+1 ;MAKE ROOM FOR PASS 1 OR 2 BIT
TRNE F,PASS2
TRO T1,1 ;ON PASS 2, EXECUTE 2ND ENTRY
STAXCT: ;TAG NOT USED, FOR DDT REFERENCE ONLY
XCT STDISP(T1) ;DISPATCH TO HANDLE FIELD AND TERM
;FALL THROUGH TO HERE AFTER STATE EXECUTE
SKIPN STATE
TRNN F,BINF
JRST STAX2 ;NO BINARY ASSEMBLED YET
TRNN F,PASS2
JRST STAX1 ;DEFAULTS INSERTED AND BIN PRINTED ONLY ON PASS2
PUSHJ P,DEFALT ;INSERT FIELD DEFAULTS
PUSHJ P,PNTBIN ;PRINT BINARY IN OUTPUT FILE(S)
PUSHJ P,USEDPC ;CHECK AND MARK USED MICRO WORD
STAX1: PUSHJ P,GETPC ;SETUP FOR NEXT MICRO WORD ADDRESS
STAX2: CAIN C,";"
PUSHJ P,SCNEND ;FLUSH A COMMENT
CAIE C,12
JRST STATLP ;AND START ALL OVER AGAIN
PUSHJ P,PNTLIN ;FINISH END OF LINE
SKIPN STATE ;DID LINE RETURN US TO STATE ZERO?
TRZ F,ERROR ;YES, RESET SWITCH TO PRINT ERRONEOUS LINE
AOS LINNUM ;INCREMENT LINE NUMBER
SKIPN ENDFIL ;END-OF-FILE?
JRST STATLP ;NO
POPJ P, ;END OF PASS
;STATE TABLE DISPATCH TABLE
; THE 1ST ENTRY FOR ANY PAIR IS THE PASS 1 DISPATCH
; THE 2ND ENTRY IS THE PASS 2 DISPATCH
STDISP: PUSHJ P,ILLFOR ;FOR ANY UNDEFINED FORMAT
PUSHJ P,ILLFOR ;FOR ANY UNDEFINED FORMAT
DLBLK: PUSHJ P,LOCBLK ;"=" SCANNED AT BEGINNING OF LINE
PUSHJ P,LOCBLK
DTAG: PUSHJ P,TAG ;"SYMBOL:" SCANNED
JFCL
DLSET: PUSHJ P,LOCSET ;"NUMBER:"
PUSHJ P,LOCSET
DCFLD: PUSHJ P,CFSPC ;COND ASSY OR FIELD
PUSHJ P,CFSPC ;COND ASSY OR FIELD
DFLD: PUSHJ P,FLDSPC ;FIELD/
PUSHJ P,FLDSPC
DMDEF: PUSHJ P,DEFMAC
PUSHJ P,DEFMAC
DSUDO: PUSHJ P,PSEUDO
PUSHJ P,PSEUDO
DMAC: PUSHJ P,BEGMAC
PUSHJ P,BEGMAC
DNOP: JFCL
JFCL
DDEFF: PUSHJ P,DEFFLD
PUSHJ P,DEFFLD
DDEFS: PUSHJ P,DEFSYM
PUSHJ P,DEFSYM
DFSYM: TRO F,BINF ;"FIELD/SYMBOL" SCANNED
PUSHJ P,FLDSYM
DFNUM: TRO F,BINF ;"FIELD/NUMBER" SCANNED
PUSHJ P,FLDNUM
DCMNT: PUSHJ P,SCNEND
PUSHJ P,SCNEND
DCSUP: PUSHJ P,CFSUP ;SUPPRESSED ASSEMBLY, ACCEPT IF OR IFNOT
PUSHJ P,CFSUP ; OR ENDIF, ONLY.
;THE "ILLFOR" SUBROUTINE USES "SCNEND"S POPJ TO RETURN
ILLFOR: MSG SCNEND, ILLEGAL FORMAT
;SEARCH FOR END OF LINE (ALWAYS A LINE-FEED = 12)
PUSHJ P,GETCHR
SCNEND: CAIE C,12 ;SEARCH FOR END OF LINE
JRST .-2
POPJ P,
;ASSIGN ABSOLUTE LOCATIONS, PROCESS "=" CONSTRAINTS, ASSIGN
; "LOOSE" MICRO WORDS REMAINING, AND DEFINE ADDRESS TAGS
ALLOC: MOVEI RAM,UCODE ;THIS PROCESS FOR "U WORDS" ONLY
SETZM HGHEQL# ;ZERO LARGEST = BIT STRING SEEN
MOVEI N,":"
PUSHJ P,LALSRC ;START SEARCH TO PROCESS "NUM:"
JFCL ;NOT ASSIGNED
PUSHJ P,ALLOC9
PUSHJ P,[ MOVE T1,N ;"NUMBER:"
HRRZ N,LALVL(N+1)
JRST LLEQ99 ]
PUSHJ P,LLTAG ;"TAG:"
PUSHJ P,[ PUSHJ P,LENCAL ;GET LENGTH OF 1'S & 0'S
CAMLE T1,HGHEQL#
MOVEM T1,HGHEQL ;SAVE LARGEST SO FAR
JRST LLZERO ]
ALLOC1: MOVEI N,"="
PUSHJ P,LALSRC ;THIS PROCESS FOR "=" CONSTRAINTS ONLY
PUSHJ P,[ PUSH P,N ;NOT ASSIGNED
PUSHJ P,PCNEXT
POP P,T1
JUMPGE N,LLXIT
JRST LLEQ99 ]
PUSHJ P,LLZSKP ;ALREADY ASSIGNED BY "NUM:" OR "="
PUSHJ P,LLZERO ;"NUM:" TURNS OFF FURTHER = BLOCKS
PUSHJ P,LLTAG ;"TAG:"
PUSHJ P,LLEQL ;"="
SOSLE HGHEQL ;ASSIGN MOST "HIGHLY CONSTRAINED"
JRST ALLOC1 ; WORDS FIRST
ALLOC2: MOVEI N," "
PUSHJ P,LALSRC ;ASSIGN REMAINING LOCS AND DEFINE TAGS
PUSHJ P,[ PUSH P,N ;NOT ASSIGNED
PUSHJ P,PCNXT1
JRST LLEQL9 ]
SKIPA ;ALREADY ASSIGNED
JFCL ;"NUMBER:"
PUSHJ P,LLTAG ;"TAG:"
JFCL ;"="
POPJ P, ;RETURN FROM ALLOC SUBROUTINE
ALLOC9: MSG CPOPJ1, ALLOC INTERNAL ERROR
LLTAG: TRNN F,UPCF ;IS THE LOCATION DEFINED?
POPJ P, ;NO, THEN DON'T DEFINE SYMBOL
HRRZ N,PC(RAM) ;YES, GO DEFINE IT
HRRZ SPNT,LALVL(N+1)
HLRZ FPNT,LALVL(N+1)
PUSHJ P,DEFCHK
HALT DEFVAL
PUSHJ P,DEFSLS
POPJ P,
LLEQL: PUSH P,N
LDB T2,PATPNT ;GET 1'S AND 0'S PATTERN
MOVEM T2,BLDPAT
LDB T4,ASTPNT ;GET * PATTERN
MOVEM T4,BLDAST
LDB N,EQLSIZ ;GET LENGTH OF = BIT STRING
JUMPE N,LLXP ;IF 0, DON'T ASSIGN NOW
MOVEI T1,1 ;FIND HOW MANY CONSECUTIVE WORDS
LSH T1,(N) ; WORDS=2**NUMBER OF BITS
SKIPGE N,PC(RAM) ;GET CURRENT PC
CAMLE T1,FRECNT ;IS NEW BLOCK LARGER?
JRST LOCB6 ;YES, OR PC NOT RESTRICTED
MOVEI T3,-1(T1) ;GET 1S FOR BITS SPECIFIED
ANDCM T3,BLDAST ;CLEAR * POSITIONS
TDNE T3,LOCAST ;CHECK FOR 1S OR 0S WHERE *S GIVEN IN MASTER
JRST LOCB5 ;YES, PATTERN IS ILLEGAL
LOCB4: MOVE T3,N
ANDCM T3,BLDAST ;CLEAR DON'T-CARE BITS
ANDI T3,-1(T1) ;MASK PC TO NEW BLOCK SIZE
CAMN T3,BLDPAT ;DOES PC MATCH NEW PATTERN?
JRST LLEQL9 ;YES, USE IT
MOVE T3,N ;GET PC AGAIN
AND T3,LOCAST ;SAVE STATE OF * BITS
IOR N,LOCAST ;THEN FORCE THEM TO CARRY
AOBJP N,.+1 ;PICK NEXT PC IN BLOCK
IOR N,LOCPAT ;RESET BIT CARRIED OUT OF
ANDCM N,LOCAST ;CLEAR OUT DON'T CARE BITS
IOR N,T3 ;SET ANY WHICH WERE SET BEFORE
JUMPL N,LOCB4 ;LOOP IF ANY MORE IN THIS BLOCK
LOCB5: MOVEM T1,FRECNT ;SAVE NEW PARAMETERS
MOVEM T2,LOCPAT
MOVEM T4,LOCAST
MSG LOCB7, NO SUCH MICRO WORD ADR PATTERN IN CURRENT BLOCK
LOCB6: MOVEM T1,FRECNT ;YES, STORE NEW BLOCK SIZE AWAY
MOVEM T2,LOCPAT ; ALSO BIT PATTERN
MOVEM T4,LOCAST ; AND * PATTERN
PUSHJ P,LENCAL ;GET LENGTH OF 1'S & 0'S
CAMGE T1,HGHEQL ;START NEW EQUAL PATTERN?
JRST LLXP ; NO, WAIT TILL A LATER PASS
LOCB7: PUSHJ P,FREWRD ;DOESN'T FIT
MSG LLXP, NO SUCH REQUIRED MICRO WORD ADDRESS PATTERN
LLEQL9: POP P,T1
LLEQ99: MOVEM N,PC(RAM) ;SAVE NEXT PC LOCATION
TRO F,UPCF ;SET USED PC FLAG
LLXIT: POPJ P,
LLZSKP: AOSA (P) ;RETURN WILL ADVANCE TO NEXT U-WORD
LLXP: POP P,N
LLZERO: SETZM PC(RAM) ;DON'T ASSIGN LOC NOW
TRZ F,UPCF ; AND DEASSIGN IF ASSIGNED
JRST LLXIT
;SUBROUTINE TO CALCULATE LENGTH OF CONSTRAINT STRING
; ONES AND ZEROS ONLY
LENCAL: LDB T2,ASTPNT ;GET ASTERISK PATTERN
LDB T1,EQLSIZ ;GET LENGTH OF ENTIRE STRING
MOVE T3,MACHT ;GET MACHINE-SPECIFIC FEATURE CONTROL
CAIN T3,M$KL10
JRST [CAIL T1,^D9 ;IF A LONG CONSTRAINT,
ADDI T1,5 ; INCREASE LENGTH IN ORDER TO GET
JRST .+1] ; IT PROCESSED EARLIER
CAIN T3,M$STAR
JRST [CAIGE T1,4 ;IF LOW FOUR BITS CONSTRAINED
JRST .+1
CAIGE T1,^D12 ; OR LONG CONSTRAINT
TRNN T2,17 ;REALLY CONSTRAINED, THAT IS
ADDI T1,3 ;GIVE EXTRA WEIGHT TO REQUEST
JRST .+1]
JUMPN T2,[ ANDI T2,-1(T2)
SOJA T1,.]
POPJ P, ;RETURN WITH LENGTH IN T1
;SEARCH PASS 1 LIST STRUCTURE TO FIND ALL ENTRIES
;SUBR CALL IF LOCATION NOT ASSIGNED
;SUBR CALL IF LOCATION IS ASSIGNED
;SUBR CALL FOR "NUMBER:"
;SUBR CALL FOR "TAG:"
;SUBR CALL FOR "="
;RETURN
LALSRC: MOVEM N,PCTYPE# ;SAVE CHAR FOR "LOCATION/LINE" INDEX
HLRZ N,LALHED
LALS1: JUMPE N,[ POP P,T1
JRST 5(T1) ]
PUSH P,N
HRRZ T2,LALLIN(N) ;COPY LINE# INTO STANDARD PLACE SO
MOVEM T2,LINNUM ; ERROR MSG'S WILL BE REASONABLE
TRZ F,UPCF ;CLEAR "USED PC" FLAG
LDB T1,LALUSD ;GET "ASSIGNED" FLAG
ADD T1,-1(P) ;CALC CO-ROUTINE CALL ADR
XCT (T1) ; AND CALL FOR ASSIGNED OR NOT
TROA F,LALF ;SET FLAG FOR PROCESSING CONSTRAINTS
TRZ F,LALF ;CLEAR IT
MOVE N,(P) ;RECOVER ADDRESS OF LAL ENTRY
HLRZ N+1,LALPNT(N) ;GET ADDRESS OF CODE/VALUE LIST, IF ANY
LALS2: JUMPE N+1,LALS5
LDB T1,[POINT 4,LALCD(N+1),35] ;GET CODE TYPE
PUSH P,N+1
CAIG T1,3
CAIGE T1,1
JRST [CAIN T1,.LLFIL ;IS THIS A NEW-FILE ENTRY?
JRST LALFIL ;YES, SPECIAL PROCESSING
CAIN T1,.LLRGN ;IS IT A REGION ENTRY?
JRST LALRGN ;YES.
MSG LALS3, ILL CODE TYPE IN "ALLOC"
]
ADD T1,-2(P) ;CONSTRUCT CALL ADR
TRNE F,LALF ;SHOULD CO-ROUTINE BE INVOKED?
XCT 1(T1) ;YES, CALL IT
LALS3: POP P,N+1
HLRZ N+1,LALCD(N+1)
MOVE N,(P)
JRST LALS2
;HERE AFTER PROCESSING ALL CONSTRAINTS AND TAGS FOR THIS MICROINSTR
LALS5: TRNN F,UPCF ;WAS A LOCATION ASSIGNED?
JRST LALS6 ;NO
MOVE T1,PC(RAM)
MOVEM T1,LALLOC(N) ;GET U-WORD LOCATION BACK
MOVE T1,PCTYPE#
IORI T1,1B18 ;SET "ASSIGNED" FLAG
HRLM T1,LALLIN(N) ;STORE ASSIGNED, AND HOW INDICATOR
PUSHJ P,USEDPC ;MARK IT AS USED
LALS6: POP P,N
HRRZ N,LALPNT(N)
HRRM N,LALHED ;UPDATE ONLY FOR DEBUGGING EASE
JRST LALS1
LALUSD: POINT 1,LALLIN(N),0 ;"ASSIGNED" FLAG
; 1 IFF LOCATION ALREADY ASSIGNED
; 0 IF NO LOCATION ASSIGNED YET
EQLSIZ: POINT 6,LALVL(N+1),5 ;LENGTH OF = BIT STRING
PATPNT: POINT 15,LALVL(N+1),35 ;POINTS TO 1 0 PATTERN
ASTPNT: POINT 15,LALVL(N+1),20 ;POINTS TO * PATTERN
;HERE TO CHANGE THE FILE SPEC REPORTED BY ERROR MESSAGES
LALFIL: HRRZ T1,LALVL(N+1) ;GET FILE SPEC ADDRESS
MOVEM T1,I.SPEC ;SETUP FILE DESCRIPTOR ADDRESS
PUSHJ P,GETFIL ;GET NAME OUT OF DESCRIPTOR
JRST LALS3
;HERE TO CHANGE THE REGION LIST
LALRGN: MOVSI N,-PRFMAX ;PREPARE TO SETUP REGION TABLES
LALR1: MOVE T2,LALVL(N+1) ;GET A PREFERENCE REGION ENTRY
HRRZM T2,PRFTB2(N) ;SETUP UPPER BOUND
HLRZM T2,PRFTB1(N) ;SETUP LOWER BOUND
JUMPE T2,LALS3 ;QUIT IF END
PUSHJ P,REGN5 ;GO CALCULATE PCNXT CONTROLS
ADDI N+1,1
AOBJN N,LALR1 ;LOOP OVER ALL REGION ENTRIES
JRST LALS3 ;RESUME SEARCH FOR LOCATION ASSIGNMENTS
IFN FTULD,<
;OUTPUT "ULD" FILE IN ASCII TEXT
;FIRST SET RADIX TO BE OCTAL
;THEN OUTPUT FIELD DEFINITIONS AND THEIR SYMBOLS, ADDRESS FIELD
;AND ITS LABELS, AND MACRO DEFINITIONS
ULDOUT: TRNN F,DOULD ;DO WE WANT A .ULD FILE?
POPJ P,0 ;NO--DO NOT DUMP TABLES
PUSH P,PUTP ;SAVE CURRENT OUTPUT ROUTINE
MOVEI T1,PUTU
MOVEM T1,PUTP ;SETUP OUTPUT TO ULD FILE
PUSHJ P,PRINT
ASCIZ /RADIX /
MOVE C,RADIX ;GET RADIX FOR OUTPUT
PUSHJ P,PNTDEC ;PUT IT INTO ULD FILE
PUSHJ P,ULDFLD ;OUTPUT ALL FIELDS AND THEIR SYMBOLS
; PUSHJ P,ULDMAC ;OUTPUT ALL MACROS
POP P,PUTP ;RESTORE OUTPUT
POPJ P,
REPEAT 0,<
;OUTPUT ALL MACROS AND THEIR RESPECTIVE DEFINITIONS FOR
;"ULD" FILE
ULDMAC: MOVE FPNT,MACPNT(RAM) ;GET INITIAL MACRO PTR
HLRZ FPNT,SYMLNK(FPNT) ;BYPASS 1ST ITEM -- "MACRO%"
MOVE SPNT,FPNT
ULDM1: JUMPE FPNT,CRLF ;RETURN IF DONE
PUSHJ P,PRINT
ASCIZ /
MACRO /
MOVEI N,SYMTXT(FPNT) ;OUPUT MACRO NAME
PUSHJ P,PRINT0
PUSHJ P,PRINT
ASCIZ /="/
LDB N,DEFVAL ;GET PTR TO MACRO EXPANSION
PUSHJ P,PRINT0
PUSHJ P,PRINT
ASCIZ /"/
HLRZ FPNT,SYMLNK(FPNT)
JRST ULDM1
>;END REPEAT 0
;OUTPUT FIELD DEFINITIONS AND THEIR RESPECTIVE SYMBOLS
ULDFLD: MOVEI FPNT,FLDPNT ;GET PTR TO FIELDS
ULDF2: HRRZ FPNT,SYMLNK(FPNT) ;SAVE FIELD PTR
JUMPE FPNT,CRLF ;RETURN IF DONE
MOVE SPNT,FPNT ;COPY POINTER
LDB T1,DEFTYP ;GET RAM NUMBER
JUMPN T1,ULDF2 ;SKIP DRAM DEFS
CAMN FPNT,SWTPNT ;IS THIS CONDITIONAL ASSEMBLY FIELD?
JRST ULDF2 ;SKIP FIELD
CAME FPNT,MACPNT+UCODE
CAMN FPNT,MACPNT+DISP ;IS IT EITHER MACRO FIELD?
JRST ULDF2 ;SKIP FIELD
MOVEI N,[ASCIZ /
FIELD /]
CAME FPNT,JPNT+UCODE
CAMN FPNT,JPNT+DISP ;IS IT A JUMP ADDRESS FIELD?
MOVEI N,[ASCIZ /
ADDRESS /] ;YES, USE SPECIAL NAME
PUSHJ P,PRINT0 ;PUT THAT OUT
ULDF3: MOVEI N,SYMTXT(FPNT) ;YES (OR NO), OUTPUT THE FIELD NAME
PUSHJ P,PRINT0
PUSHJ P,PRINT
ASCIZ /=</
LDB T3,DEFPOS ;GET FIELD POSITION
LDB C,DEFSIZ ;GET FIELD SIZE
TRNN F,RTOL ;LEFT TO RIGHT ASSIGNMENT
JRST RL ;NO
ADDM T3,C
SUBI C,1
JRST ULDF4
RL: SUBM T3,C
ADDI C,1 ;GET LEFTBIT POSITION
ULDF4: PUSHJ P,PNTDEC ;OUTPUT LEFTBIT POSITION IN DECIMAL
PUSHJ P,PRINT
ASCIZ /:/
MOVE C,T3 ;GET RIGHTBIT POSITION
PUSHJ P,PNTDEC ;OUTPUT RIGHTBIT POSITION
PUSHJ P,PRINT
ASCIZ />/
HLRZ SPNT,SYMLNK(FPNT) ;GET SYMBOL PTR
ULDSYM: JUMPE SPNT,ULDF2 ;END OF SYMBOLS OF CURRENT FIELD
PUSHJ P,PRINT
ASCIZ /
/
MOVEI N,SYMTXT(SPNT) ;OUTPUT SYMBOL
PUSHJ P,PRINT0
PUSHJ P,PRINT
ASCIZ /=/
LDB C,DEFVAL ;GET SYMBOL VALUE
PUSHJ P,PNTOCT ;OUTPUT SYMBOL VALUE
HLRZ SPNT,SYMLNK(SPNT) ;GET NEXT SYMBOL
JRST ULDSYM
>;END FTULD
;HERE TO START PASS 2 BY LISTING TABLE OF CONTENTS, IF ANY
START2: TRZ F,ERROR ;INHIBIT TTY OUTPUT
SETZM LISTSW ;START WITH LISTING ENABLED
IFN FTULD,<
PUSHJ P,ULDOUT ;START PASS2 BY OUTPUTING FIELDS,
>;END FTULD ;ADDRESSES AND MACROS OF "ULD" FILE
TRNN F,HEXF ;RADIX 8 OR 16?
TDZA N,N ;8. CLEAR N
MOVEI N,1 ;16. SET 1 AS INDEX
MOVE T1,[EXP ^D12,^D16](N) ;GET OUTPUT GROUP SIZE (BITS)
MOVEM T1,GRPSIZ
MOVE T1,HIGHPC+UCODE ;GET HIGHEST LOC'N USED
CAMGE T1,HIGHPC+DISP ; IN EITHER RAM
MOVE T1,HIGHPC+DISP
JFFO T1,.+1 ;FIND MSB OF HIGHEST PC
MOVEI T1,^D36+2(N) ;ADD 2 BITS IF OCTAL, 3 IF HEX
SUBI T1,(T2) ;GET # OF BITS+(2 OR 3) IN HIGH PC
IDIV T1,[EXP 3,4](N) ;COMPUTE NO OF DIGITS REQ'D FOR ADDR
MOVEM T1,ADRCOL ;SAVE # OF COLUMNS FOR ADDRESS
SKIPN T1,WIDTH+DISP ;USE SPECIFIED WIDTH IF SPECIFIED
MOVE T1,MAXPOS+DISP ;GET # BITS-1 IN RAM
IDIV T1,GRPSIZ
ADDI T1,1 ;GET NUMBER OF GROUPS FOR DRAM
MOVEM T1,GRPCNT+DISP
SKIPN T1,WIDTH+UCODE ;USE SPECIFIED WIDTH IF SPECIFIED
MOVE T1,MAXPOS+UCODE ;# OF BITS-1 IN URAM
IDIV T1,GRPSIZ
ADDI T1,1 ;GET NUMBER OF GROUPS FOR CRAM
MOVEM T1,GRPCNT+UCODE
CAMGE T1,GRPCNT+DISP
MOVE T1,GRPCNT+DISP ;GET MAX OF THE TWO
IMULI T1,5 ;5 CHARACTERS PER GROUP
ADDI T1,3 ;PLUS U & 2 SPACES (EXTRA CHARACTERS)
ADD T1,ADRCOL ;PLUS COLUMNS FOR ADDRESS
MOVEM T1,SRCCOL ;GIVES SOURCE COLUMN NO
;HERE TO LIST TABLE OF CONTENTS, IF ANY
SKIPE N,TTLPNT ;IS THERE A TITLE?
OUTSTR (N) ;YES, SEND TO TTY
OUTSTR [ASCIZ /
/]
SKIPN TOCPNT ;ANYTHING FOR TABLE OF CONTENTS?
JRST TOCEND ;NO
MOVEI C,[ASCIZ /Table of Contents/]
PUSHJ P,SETHDR ;SETUP SPECIAL HEADER
HLRZ N,TOCPNT ;BEGIN SCAN OF TOC LIST
TOCLUP: PUSH P,N ;SAVE ADDR OF THIS ENTRY
PUSHJ P,PRINT
ASCIZ /; / ;OUTPUT AS COMMENT
MOVE N,0(P) ;PICK UP ENTRY ADDR
HRRZ C,0(N) ;LINE NUMBER OF DEFINITION
PUSHJ P,PNTDEC ;IN DECIMAL
PUSHJ P,TAB
MOVE N,0(P) ;ENTRY ADDR AGAIN
MOVEI N,1(N) ;POINT TO TEXT
PUSHJ P,PRINT0 ;PRINT IT
PUSHJ P,NEWLIN
POP P,N ;PICK UP LINK
HLRZ N,0(N) ;GET ADDR OF NEXT ENTRY
JUMPN N,TOCLUP ;PRINT IT IF IT EXISTS
;ALSO NOTE ASSEMBLER-GENERATED STUFF
PUSHJ P,PRINT
ASCIZ \; Cross Reference Index
\
TRNN F,DRAMF ;ANY DRAM STUFF?
JRST TOCLOC ;NO
PUSHJ P,PRINT ;YES, MENTION IT HERE
ASCIZ \; DCODE Location / Line Number Index
\
TOCLOC: PUSHJ P,PRINT
ASCIZ \; UCODE Location / Line Number Index
\
SETZM HDRPNT ;TURN OFF SPECIAL HEADERS
TOCEND: PUSHJ P,FORM ;THROW A PAGE
POPJ P, ;AND RETURN FOR PASS 2
;FIELD/ SCANNED. COULD BE CONDITIONAL ASSEMBLY
CFSPC: IFN FTIF,<
LDB T1,[POINT 7,NAME,6]
CAIE T1,"." ;ALL PSEUDO OPS BEGIN .
JRST CFSPC1 ;AVOID FUTILE SCAN
MOVEI FPNT,PSUDF% ;PSEUDO FIELD TABLE
PUSHJ P,SRCSY1 ;IS IT A DEFINED PSEUDO-FIELD?
JRST CFSPC1 ;NO, TRY FOR NORMAL FIELD
LDB T1,DEFVAL ;YES, GET HANDLER ADDRESS
JRST 0(T1) ;GO TO IT
;HERE FOR FIELD SCANNED WHILE ASSEMBLY IS SUPPRESSED.
; LOOK FOR .IF, .IFNOT, OR .ENDIF ONLY
CFSUP: LDB T1,[POINT 7,NAME,6]
CAIE T1,"." ;ALL PSEUDO OPS BEGIN .
JRST SCNEND ;NO, IGNORE THE FIELD
MOVEI FPNT,PSUDS% ;PSEUDO FIELD TABLE
PUSHJ P,SRCSY1 ;IS IT A DEFINED PSEUDO-FIELD?
JRST SCNEND ;NO, IGNORE THE FIELD
LDB T1,DEFVAL ;YES, GET HANDLER ADDRESS
JRST 0(T1) ;GO TO IT
;STILL IN FTIF
$DEFLT: MOVEI T1,1 ;SET SWITCH IF NOT DEFINED
JRST SWT
$SET: TDZA T1,T1 ;ERROR IF SWITCH PREVIOUSLY DEFINED
$CHNG: SETO T1, ;ERROR IF SWITCH NOT DEFINED
SWT: MOVEM T1,SWTFLG#
PUSH P,RAM ;SWITCHES ARE NOT RAM-SPECIFIC
MOVEI RAM,0
SKIPE FPNT,SWTPNT ;IS THE SWITCH% FIELD DEFINED?
JRST SWT1 ;YES, AVOID SEARCH
MOVE T1,[SWTCH,,FIELD]
BLT T1,FIELD+NWORDS-1
PUSHJ P,MAKFLD ;CREATE INTIAL SWITCH FIELD
MSG STOP, !!CAN'T DEFINE "SWITCH%"!!
MOVEM FPNT,SWTPNT
SWT1: MOVE T1,[NAME,,FIELD]
BLT T1,FIELD+NWORDS-1
PUSHJ P,TOKEN ;GO GET SWITCH NAME
CAIE N,.TKS ;IT MUST BE SYMBOLIC
MSG SWT99, NO SYMBOL IN CONDITIONAL ASSEMBLY DEFINITION
PUSHJ P,SRCSYM ;GO LOOK FOR SYMBOL
JRST SWT2 ;NOT FOUND
SKIPLE SWTFLG ;FOUND. IS THIS A DEFAULT?
JRST SWT99 ;YES -- DEFAULT HAS BEEN PREVIOUSLY SET
TRNN F,PASS2 ;IS IT PASS1?
SKIPE SWTFLG ; AND A SET?
JRST SWT3 ;NO, GO CHANGE VALUE
MSG SWT3, SWITCH SET TWICE
SWT2: SKIPGE SWTFLG ;IS THIS A CHANGE?
MSG .+1, SWITCH CHANGED WITHOUT SET OR DEFAULT
PUSHJ P,MAKS1 ;FILL IN SYMBOL ENTRY
JRST SWT99 ;CAN'T CREATE IT
SWT3: CAIE C,"=" ;DID SWITCH NAME TERMINATE WITH EQUAL?
MSG SWT99, FORMAT ERROR ON SWITCH SPECIFICATION
PUSHJ P,TOKEN ;GO GET SWITCH VALUE
CAIE N,.TKN
MSG SWT99, SWITCH VALUE MUST BE NUMERIC
MOVE N,NUMBER ;GET SWITCH VALUE
PUSHJ P,DEFCHK ;CHECK VALUE, SET DEFINE BIT
HALT DEFVAL ;PUT INTO VALUE OF SYMBOL
SWT99: POP P,RAM ;RESTORE CURRENT RAM
SETZM STATE
SETZM FIELD
JRST SCNEND ;IGNORE REST OF LINE
;HERE FOR REGION PSEUDO-OP
$REGN: SETZM PREFX# ;INDEX INTO PREFERENCE TABLES
CAIE RAM,UCODE
MSG REGN99, REGIONS ALLOWED IN UCODE ONLY
REGN1: PUSHJ P,TOKEN ;GET BEGINNING OF REGION
CAIE N,.TKN ;MUST BE NUMERIC
MSG REGN3, REGION LOWER BOUND MUST BE NUMERIC
HRRZ T1,NUMBER ;GET LOWER BOUND
MOVE N,PREFX ;GET INDEX INTO TABLE
MOVEM T1,PRFTB1(N) ;STORE LOWER BOUND
CAIE C,"," ;COMMA SEPARATES LOWER FROM UPPER BOUND
MSG REGN3, REGION BOUNDS MUST BE SEPARATED BY COMMA
PUSHJ P,TOKEN ;GO GET UPPER BOUND
CAIE N,.TKN
MSG REGN3, REGION UPPER BOUND MUST BE NUMERIC
HRRZ T1,NUMBER ;GET UPPER BOUND
MOVE N,PREFX ;GET INDEX INTO TABLE
MOVEM T1,PRFTB2(N) ;STORE UPPER BOUND
CAILE T1,MAXPC ;IS IT REASONABLE?
MSG REGN2, REGION LIMIT TOO LARGE FOR MAXPC
CAMG T1,PRFTB1(N) ;UPPER LIMIT MUST BE GREATER THAN LOWER
MSG REGN2, REGION UPPER BOUND MUST BE GREATER THAN LOWER BOUND
PUSHJ P,REGN5 ;CONVERT TO MORE CONVENIENT FORM FOR FREE SRCH
CAIE C,"/" ;ARE THERE MORE REGIONS TO BE DESCRIBED?
JRST REGN3 ;NO
AOS T1,PREFX ;YES. COUNT NUMBER OF REGIONS
CAILE T1,PRFMAX ;DO WE HAVE ROOM FOR MORE?
MSG REGN3, TOO MANY REGIONS
JRST REGN1
;HERE AFTER PROCESSING REGION STATEMENT
REGN2: CAIN C,"/" ;FOUND A BAD REGION DEF. ARE THERE MORE?
JRST REGN1 ;YES, TRY TO PROCESS THEM
REGN3: TRNE F,PASS2 ;STORE INTO LAL ON PASS1 ONLY
JRST REGN99
MOVE N,PREFX
ADDI N,2 ;ALLOW 1 FOR LINK/CODE, 1 FOR STOPPER WORD
ADDM N,LALCOR
PUSHJ P,GETWRD ;OBTAIN CORE FOR REGION SPEC ON LAL
PUSHJ P,LALLNK ;LINK IT TO LAST ITEM ON LAL
MOVEI T1,.LLRGN ;TYPE CODE FOR LAL CODE/VALUE LIST
MOVEM T1,0(N)
ADDI N,1 ;POINT TO FIRST REGION ENTRY
HRLI N,T2 ;MAKE ADDRESS INTO INDIRECT (INDEXED) POINTER
MOVEI T2,0
REGN4: HRLZ T1,PRFTB1(T2)
HRR T1,PRFTB2(T2)
MOVEM T1,@N ;COPY REGION DESCRIPTOR TO LAL ENTRY
JUMPE T1,REGN99 ;STOP AFTER ALL REGIONS IN LAL ENTRY
AOJA T2,REGN4 ;GO TO NEXT
REGN99: SETZM STATE ;DO NOT EXPECT SYMBOL HERE
JRST SCNEND
;HERE IS SUBROUTINE TO CONVERT REGION SPEC TO FORM SUITABLE FOR PCNXT1
REGN5: MOVE T1,PRFTB1(N) ;BEGIN TO BUILD AOBJN POINTER
IDIVI T1,^D36 ;GET LOC IN USAGE OF FIRST WORD OF REGION
MOVNI T2,(T2) ;GET ADDITIONAL BIT POSITION
MOVEI T3,1 ;SETUP TO BUILD MASK
LSH T3,^D36(T2) ;BIT IN LAST POSITION TO BE IGNORED
SUBI T3,1 ;GET ONES IN BITS TO BE CONSIDERED
MOVEM T3,PRFTB4(N) ;SAVE MASK FOR FREE SEARCHES
ADD T2,PRFTB1(N) ;GET ADDR OF FIRST BIT IN THIS WORD OF USAGE
SUB T2,PRFTB2(N) ;GET DIFFERENCE OF ADDRESSES
SUBI T2,^D35 ;ENSURE ROUNDING UP
IDIVI T2,^D36 ;GET NEGATIVE # OF WORDS TO SCAN IN USAGE
HRL T1,T2 ;COMBINE WITH INDEX INTO USAGE
MOVEM T1,PRFTB3(N) ;STORE AS AOBJN POINTER
SETZM PRFTB3+1(N) ;END TABLE THEREAFTER
POPJ P,
;HERE TO SPECIFY CONTROL STORE WIDTH
$WIDTH: PUSHJ P,TOKN10 ;GET DECIMAL ARGUMENT
CAIE N,.TKN ;IS IT NUMERIC?
MSG WID99, WIDTH ARGUMENT MUST BE DECIMAL NUMBER
SOS T1,NUMBER ;GET THE MAX BIT # OF THE WORD
MOVEM T1,WIDTH(RAM) ;SETUP WIDTH OF THIS RAM
WID99: SETZM STATE
JRST SCNEND
;HERE FOR MACHINE SELECTION PSEUDO OP
$MACH: MOVE T1,[NAME,,FIELD]
BLT T1,FIELD+NWORDS-1
PUSHJ P,TOKEN ;COLLECT SELECTION SYMBOL
CAIE N,.TKS
MSG MACH99, NO SYMBOL IN MACHINE OPERATOR
MOVEI FPNT,MACHL
PUSHJ P,SRCSY1 ;MATCH A SYMBOL
MSG MACH99, UNKNOWN MACHINE TYPE
LDB T1,DEFVAL
MOVEM T1,MACHT ;SELECT MACHINE TYPE
MACH99: SETZM STATE
JRST SCNEND
;HERE FOR CONDITIONAL ASSEMBLY TEST PSEUDO-OPS
; ** NOTE-- WE GET HERE EVEN WITH ASSEMBLY SUPPRESSED **
$ENDIF: MOVEI T1,1
JRST IF1
$IF: TDZA T1,T1
$IFNOT: MOVNI T1,1
IF1: MOVEM T1,SWTFLG ;FLAG TO INVERT ASSEMBLY SENSE
PUSHJ P,TOKEN
CAIE N,.TKS ;SWITCH MUST BE SYMBOLIC
MSG IF99, SWITCH MUST BE SYMBOLIC
SKIPE FPNT,SWTPNT
PUSHJ P,SRCSYM ;GO LOOK FOR SWITCH SYMBOL
MSG IF99, SWITCH NOT DEFINED
TRNN F,SUPP ;CURRENTLY SUPPRESSED?
JRST IF3 ;NO
CAME SPNT,SUPSYM ;IS THIS THE SYMBOL WHICH SUPPRESSED?
JRST SCNEND ;NO, IGNORE
IF3: MOVEM SPNT,SUPSYM ;SAVE SUPPRESSION SYMBOL
LDB T1,DEFVAL ;GET SWITCH VALUE
SKIPG SWTFLG ;VALUE IRRELEVANT ON ENDIF
SKIPE T1 ;SWITCH SET?
TRZA F,SUPP
TRO F,SUPP ;SUPPRESS ASSY
SKIPGE SWTFLG ;INVERT SENSE?
TRC F,SUPP
IF99: MOVEI T1,0
TRNE F,SUPP ;NOW...ARE WE SUPPRESSED?
MOVEI T1,4_<.SZTOK+.SZTRM>
MOVEM T1,STATE ;STATE 0 IF ASSEMBLING, 4 IF SUPPRESSED
JRST SCNEND
CFSPC1:
>;END IFN FTIF
FLDSPC: MOVE T1,[NAME,,FIELD]
BLT T1,FIELD+NWORDS-1 ;MOVE NAME TO FIELD
POPJ P,
;FIELD/NUMBER SCANNED, INSERT VALUE INTO MICRO WORD
FLDNUM: PUSHJ P,SRCFLD
JRST FLDS1
LDB T2,DEFSIZ ;GET SIZE OF FIELD
SETOM T1 ;1S INTO T1
LSH T1,(T2) ;0S ON RIGHT EQUAL TO BYTE LENGTH
MOVE N,NUMBER
MOVM T2,N ;SAVE POS VAL OF NUMBER
TDZ N,T1 ;MASK NUMBER TO CORRECT SIZE
TDNE T2,T1 ;WILL NUMBER FIT IN FIELD?
MSG FLDN2, NUMBER TOO BIG FOR FIELD
PUSHJ P,BITS1 ;NUMBER ALWAYS GOES INTO FIELD
FLDN2: PUSHJ P,MAKCRF ;PUT FIELD INTO CREF LISTING
JRST FLDS99
;FIELD/SYMBOL SCANNED, INSERT VALUE INTO MICRO WORD
FLDSYM: PUSHJ P,SRCFLD
FLDS1: MSG FLDS99, FIELD NOT DEFINED
PUSHJ P,SRCSYM
TRCA RAM,DISP!UCODE ;NOT FOUND, LOOK IN OTHER TABLE
JRST FLDS3 ;FOUND
PUSH P,FPNT ;SAVE FIELD POINTER
PUSHJ P,SRCFLD ;FIND OTHER FIELD, IF ANY
JRST FLDLUZ ;NONE
PUSHJ P,SRCSYM
JRST FLDLUZ ;NO SYMBOL IN OTHER FIELD EITHER
POP P,FPNT ;GET CORRECT FIELD BACK
TRC RAM,DISP!UCODE ;PUT MODE BACK
FLDS3: LDB T1,DEFTM1 ;GET 1ST TIME
ADDM T1,TIME1 ;ACCUMULATE SUM
LDB T1,DEFTM2 ;SAME FOR 2ND TIME
ADDM T1,TIME2
LDB T1,DEFFNC
MOVE T1,DEFTAB(T1)
PUSHJ P,(T1) ;DISPATCH ON FUNCTION
FLDS99: TRO F,BINF
ZFPOPJ: SETZM FIELD ;NO CARRY OVER OF FIELD NAMES
POPJ P,
FLDLUZ: POP P,FPNT ;ADJUST STACK
TRC RAM,DISP!UCODE ;PUT MODE BACK
MSG FLDS99, SYMBOL NOT DEFINED
; PSEUDO INSTRUCTION SCANNED, (MAY BE MACRO NAME)
PSEUDO: MOVEI FPNT,PSUDO% ;PSEUDO SYMBOL TABLE
PUSHJ P,SRCSY1 ;IS IT A DEFINED PSEUDO OP?
JRST BEGMAC ;NO, SEE IF IT'S A MACRO
LDB T1,DEFVAL ;YES, GET HANDLER ADDRESS
JRST 0(T1) ;GO TO IT
$DCODE: MOVEI RAM,DISP
TRO F,DRAMF ;WE'RE USING DRAM FEATURE
POPJ P,
$UCODE: MOVEI RAM,UCODE
POPJ P,
$RTOL: TRO F,RTOL ;SET RIGHT TO LEFT BIT ASSIGNMENT
POPJ P,
$BIN: AOSA DOBIN
$NOBIN: SOS DOBIN
POPJ P,0
$CREF: AOSA DOCREF ;ENABLE CREF
$NOCRF: SOS DOCREF
POPJ P,
$SEQU: TROA F,SEQUEN
$RAND: TRZ F,SEQUEN
POPJ P,
$HEX: TRO F,HEXF
MOVEI T1,^D16
MOVEM T1,RADIX
POPJ P,
$OCTAL: TRZ F,HEXF
MOVEI T1,^D8
MOVEM T1,RADIX
POPJ P,
$PAGE: TRNN F,PASS2 ;IGNORE ON PASS1
POPJ P,
PUSH P,C
PUSHJ P,FORM
POP P,C
POPJ P,
$LIST: AOSA LISTSW
$NOLIS: SOS LISTSW
POPJ P,
; MACRO CALL SCANNED
;COMMENTED LINES BUMMED OUT FOR SPEED
BEGMAC: CAML PM,[-4,,0] ;IS THERE SPACE FOR A MACRO ON STACK?
MSG MACX, EXCESSIVE MACRO NESTING
;OUGHT TO SUPPRESS ON PASS1, CAN'T DUE TO
;STATE PROCESSING TROUBLES
PUSH PM,C ;SAVE CURRENT CHARACTER
PUSH PM,CHRPNT ;AND INPUT POINTER
PUSH PM,[0] ;AND COUNT OF ACTUALS
MOVE T1,[POINT 7,NAME] ;RESCAN MACRO
MOVE T2,T1
MAC1: ILDB C,T1 ;LOOK AT NEXT CHAR OF MACRO NAME
JUMPE C,MAC5 ;STOP IF LAST ONE
CAIN C,135 ;IS THIS UNMATCHED CLOSE BRACKET?
MSG MACLUZ, UNMATCHED CLOSE BRACKET IN MACRO INVOCATION
MAC2: IDPB C,T2 ;PUT IT INTO MACRO NAME
CAIE C,133 ;DOES IT SIGNAL BEGINNING OF ACTUAL?
JRST MAC1 ;NO, KEEP LOOKING
;HERE WHEN OPEN BRACKET FOUND. SCAN OFF THE ACTUAL, SAVING ON PM
CAML PM,[-NWORDS-1,,0] ;IS THERE SPACE FOR MORE ON MACRO STACK?
MSG MACLUZ, EXCESSIVE MACRO NESTING
AOS T3,0(PM) ;GET COUNT OF ACTUALS INCREMENTED
ADD PM,[NWORDS,,NWORDS] ;MAKE SPACE FOR ANOTHER
MOVEM T3,0(PM) ;STORE UPDATED ACTUALS COUNT
..N==0
REPEAT NWORDS,<..N==..N-1
SETZM ..N(PM) >
MOVE T3,[POINT 7,-NWORDS(PM)]
MOVEI T4,0 ;COUNT OF NESTED BRACKET PAIRS
MAC3: ILDB C,T1 ;GET CHARACTER OF ACTUAL
CAIN C,133 ;ANOTHER OPEN BRACKET?
ADDI T4,1 ;YES, COUNT THE NESTING LEVEL
CAIN C,135 ;A CLOSE BRACKET?
SOJL T4,MAC2 ;YES, IF MATCHED, END OF ACTUAL
IDPB C,T3 ;NO, STORE CHAR IN ACTUAL
CAMN T3,[POINT 7,-1(PM),27] ;ARE WE OUT OF SPACE FOR ACTUAL?
SETZ T3, ;YES, STOP STORING IT
JUMPN C,MAC3 ;KEEP COLLECTING UNLESS TEXT STOPS
MSG MACLUZ, UNMATCHED OPEN BRACKETS IN MACRO INVOCATION
;HERE AFTER REMOVING ACTUALS FROM MACRO INVOCATION, LEAVING NAME IN "NAME"
MAC5: IDPB C,T2 ;CLEAR REST OF "NAME"
TLNE T2,(76B5)
JRST MAC5 ;STORE BYTES TO END OF WORD
MOVEI T2,1(T2) ;ADDRESS OF NEXT WORD
MAC6: SETZM 0(T2) ;CLEAR IT
CAIGE T2,NAME+NWORDS ;IS THAT ENOUGH TO GET GOOD SYMBOL MATCH?
AOJA T2,MAC6 ;NO, GO CLEAR MORE
; MOVE T1,[MACRO,,FIELD] ;LOOK FOR MACRO DEF
; BLT T1,FIELD+NWORDS-1
; PUSHJ P,SRCFLD
; MSG ZFPOPJ, NO MACROS DEFINED
SETZM FIELD
SKIPE FPNT,MACPNT(RAM) ;AVOID FIELD SEARCH
PUSHJ P,SRCSYM ;LOOK FOR DEFINITION
MSG MACLUZ, MACRO NAME NOT DEFINED
LDB N,DEFVAL ;GET POINTER TO MACRO
HRLI N,(POINT 7,0)
MOVEM N,CHRPNT ;SET IT UP FOR INPUT PROCESSING
MOVEI C,"," ;MACRO MUST NOT INVOKE END-OF-LINE ACTIONS
JRST ZFPOPJ
MACLUZ: PUSHJ P,POPMAC ;UN-NEST THIS MACRO
MACX: LDB T1,STAPNT ;GET CHAR TYPE
CAIN T1,EOL ;END OF LINE?
SETZM STATE ;YES, RETURN TO STATE ZERO
JRST ZFPOPJ
;HERE TO REMOVE A MACRO INVOCATION FROM THE PARSING STACK
POPMAC: POP PM,C ;GET COUNT OF ACTUALS
HRRZS C ;IGNORE GARBAGE ON LH
IMULI C,NWORDS ;GET AMOUNT OF SPACE USED FOR ACTUALS
HRLI C,(C) ;COPY TO BOTH HALVES
SUB PM,C ;DROP ACTUALS FROM STACK
POP PM,CHRPNT ;NOW RESTORE INPUT POINTER
POP PM,C ;AND CHARACTER
POPJ P,
; SYMBOL: SCANNED, DEFINE ADDRESS TAG
TAG: SKIPE FPNT,JPNT(RAM) ;DO WE KNOW WHERE J FIELD IS DEFINED?
JRST TAG1 ;YES, DO NOT SEARCH
MOVE T1,[ASCII /J/] ;NO KNOWN JUMP ADDRESS FIELD, MAKE ONE UP
MOVEM T1,FIELD
SETZM FIELD+1
MOVE T1,[FIELD+1,,FIELD+2]
BLT T1,FIELD+NWORDS-1
PUSHJ P,SRCFLD
MSG TAG99, CAN'T FIND J FIELD
MOVEM FPNT,JPNT(RAM) ;REMEMBER FOR FUTURE
JRST TAG2 ;NOW GO PUT A SYMBOL INTO THE FIELD
TAG1: HRLZI T1,SYMTXT(FPNT) ;ADDRESS OF NAME OF FIELD
HRRI T1,FIELD
BLT T1,FIELD+NWORDS-1 ;COPY JUMP FIELD NAME TO FIELD
; SO ERROR MESSAGES COME OUT RIGHT
TAG2: PUSHJ P,MAKSYM
JFCL
;ORIGINALLY, TAG WAS CALLED ON BOTH PASSES, AND HERE SHOULD BE:
; TRNE F,PASS2
; JRST TAG99
; ALSO, THE FOLLOWING CALL TO BEGCRF WOULD BE UNNECESSARY
PUSHJ P,BEGCRF ;PUT DEFINE LINE INTO CREF
PUSH P,[.LLTAG] ;FLAG FOR "TAG:"
HRL SPNT,FPNT ;POINTER TO SYMBOL'S FIELD
PUSH P,SPNT ;POINTER TO SYMBOL TABLE ENTRY
PUSHJ P,LALSTO ;PUT 1ST PASS ENTRY INTO LIST
; HRRZ N,PC(RAM)
; PUSHJ P,DEFCHK
; HALT DEFVAL
; PUSHJ P,DEFSLS
TAG99: JRST ZFPOPJ
;SUBROUTINE TO ADD ONE ENTRY TO LIST OF "CODE AND
;VALUE LIST" OF LOCATION AND ASSIGNMENT LIST
; -1(P) NEW CONTENTS OF LALVL
; -2(P) NEW CONTENTS OF LALCD
;CALLED BY "PUSHJ P,LALSTO", DESTROYES T1-T4, AND N
LALSTO: MOVEI N,LLCDSZ ;GET 2 FREE WORDS FROM STORAGE
ADDM N,LALCOR ;TALLY CORE USED FOR LAL
PUSHJ P,GETWRD
PUSHJ P,LALLNK ;LINK ONTO EXISTING LIST
POP P,T1 ;GET RETURN OFF STACK
POP P,LALVL(N) ;PUT 1ST WORD IN
POP P,LALCD(N) ;PUT 2ND WORD INTO ITEM
LALS99: JRST (T1) ;RETURN
LALLNK: HRRZ T2,LALHED ;GET POINTER TO FOOT OF LIST
MOVE T1,T2 ;FIND LIST END, APPEND NEXT ITEM
HLRZ T2,LALCD(T1)
JUMPN T2,.-2
HRLM N,LALCD(T1)
POPJ P,
;SET LOCATION COUNTER FOR LEADING BIT PATTERN
LOCBLK: SETZB N,BLDPAT# ;INIT COUNT, INIT PATTERN FOR 1'S
SETZM BLDAST# ;INIT PATTERN FOR *'S
LOCB1: PUSHJ P,GETCHR
CAIN C," "
JRST LOCB1
CAIN C,"0"
SOJA N,LOCB1 ;COUNT DIGITS
MOVSI T1,(1B0) ;GET BIT INTO POSITION FOR PATTERNS
LSH T1,(N)
CAIN C,"1"
JRST [IORM T1,BLDPAT
SOJA N,LOCB1 ]
CAIN C,"*"
JRST [IORM T1,BLDAST
SOJA N,LOCB1 ]
MOVNS N ;GET POSITIVE POSITION COUNT
MOVEM C,RRDC ;SAVE CHAR FOR REREAD
CAIE C,12
TRO F,REREAD ;ONLY BACK UP IF NOT END-OF-LINE
TRNE F,SEQUEN ;ARE WE IN FORCED SEQUENTIAL MODE?
MSG LOCB99, ADDRESS CONSTRAINT ILLEGAL IN SEQUENTIAL MODE
;LOCB2:
MOVEI T1,1 ;FIND HOW MANY CONSECUTIVE WORDS
LSH T1,(N) ;WORDS=2**NUMBER OF BITS
MOVE T2,BLDPAT ;GET BIT PATTERN
ROT T2,(N) ;MOVE TO LOW ORDER
; MOVEM T2,BLDPAT
MOVE T4,BLDAST ;GET * PATTERN
ROT T4,(N)
; MOVEM T4,BLDAST
JUMPN RAM,[MOVE N,PC(RAM) ;GET CURRENT PC
ANDI N,-1(T1) ;MASK PC TO RELEVANT BITS
SUB T2,N ;HOW FAR OFF?
JUMPE T2,CPOPJ ;XFER IF RIGHT ON
SKIPGE T2
ADD T2,T1 ;GET POS VAL, MOD BLOCK SIZE
ADD N,T2 ;ADJUST PC
JRST LOCB8
; MSG LOCB8, DISP LOCATION CHECK FAILED
]
TRNE F,PASS2
JRST LOCB99 ;ALL U-WORD CONSTRAINTS DONE IN PASS 1
PUSH P,[.LLEQL]
DPB N,[POINT 6,T2,5]
DPB T4,[POINT 15,T2,20]
PUSH P,T2
PUSHJ P,LALSTO
JRST LOCB99
LOCB8: MOVEM N,PC(RAM) ;SET UP FIRST WORD ADDRESS
LOCB99: POPJ P,
; NUMBER: SET LOCATION COUNTER
LOCSET: SKIPGE N,NUMBER
MSG LOCS99, LOCATION NEGATIVE
CAMLE N,[EXP MAXPC,MAXDSP](RAM)
MSG LOCS99, LOCATION TOO LARGE
JUMPN RAM,[ HRROM N,PC(RAM)
JRST LOCS99 ]
TRNE F,PASS2
JRST LOCS99
PUSH P,[.LLNUM] ;"NUMBER:" IS CODE 1
PUSH P,N ;SAVE "NUMBER"
PUSHJ P,LALSTO ;PUT THESE 2 ENTRIES INTO
;TABLE FOR PROCESSING ON PASS 1.5
LOCS99: SETZM FIELD
POPJ P,
;FIELD/= HAS BEEN SCANNED. SO, A MICRO FIELD DEFINITION IS IN PROGRESS.
DEFSYM: PUSHJ P,SRCFLD ;FIND THE FIELD
MSG DEFS99, UNDEFINED FIELD IN SYMBOL DEFINITION
PUSHJ P,MAKSYM ;GO MAKE THE SYMBOL
JFCL ;DO CONSISTENCY CHECK
PUSHJ P,TOKEN
CAIE N,.TKN ;SKIP IF TOKEN NUMERIC
MSG DEFS99, VALUE REQUIRED IN SYMBOL DEFINITION
MOVE N,NUMBER
PUSHJ P,DEFCHK
HALT DEFVAL
PUSHJ P,DEFSLS
CAIE C,","
JRST DEFS99
PUSHJ P,TOKN10
MOVE N,NUMBER
PUSHJ P,DEFCHK
HALT DEFTM1 ;1ST TIME VALUE
CAIE C,","
JRST DEFS99
PUSHJ P,TOKN10
MOVE N,NUMBER
PUSHJ P,DEFCHK
HALT DEFTM2 ;2ND TIME VALUE
DEFS99: JRST SCNEND
DEFSLS: LDB T1,DEFPOS
CAILE T1,MICMXB
MSG .+1, POSITION TOO LARGE FOR MICRO WORD
LDB T2,DEFSIZ
TRNN F,RTOL ;BYPASS IF LEFT TO RIGHT
JRST DEFLR
ADD T1,T2 ;GET LEFTBIT POSITION + 1
CAILE T1,MICMXB ;IS LEFTBIT .LE. MAX BIT POSITION?
MSG .+1, SIZE TOO LARGE FOR POSITION
JRST DEFS2
DEFLR: ADDI T1,1
CAMGE T1,T2
MSG .+1, SIZE TOO LARGE FOR POSITION
DEFS2: LDB T1,DEFVAL
MOVEI N,1
LSH N,(T2)
CAMG N,T1
MSG .+1, VALUE TOO LARGE FOR FIELD
POPJ P,
;HERE WHEN MACRO DEFINITION SCANNED
DEFMAC: MOVEI FPNT,PSUDM% ;FIRST CHECK FOR PSEUDO-MACRO
PUSHJ P,SRCSY1 ;IS IT ONE OF THOSE NAMES?
JRST DEFM0 ;NO, DEFINE A REAL MACRO
LDB T1,DEFVAL ;YES, GET ADDR OF HANDLER
JRST 0(T1)
$TITLE: TRNE F,PASS2
JRST SCNEND ;TREAT AS COMMENT ON PASS 2
SKIPE TTLPNT ;DO WE ALREADY HAVE A TITLE
MSG SCNEND, TITLE MULTIPLY DEFINED
MOVE N,.JBFF
HRRZM N,TTLPNT ;SAVE ADDRESS INTO WHICH IT IS STORED
JRST DEFT2 ;GO COLLECT IT
$PAGET: PUSHJ P,$PAGE ;.PAGE WITH .TOC STRING
$TOC: TRNE F,PASS2 ;ENTIRELY DIFFERENT FUNCTION ON PASS2
JRST TOC2
PUSHJ P,MAKTOC ;CREATE TABLE OF CONTENTS ENTRY
JRST DEFT2 ;GO COLLECT TEXT FOR IT
TOC2: HLRZ N,TOCPNT ;TRY TO FIND THIS ON LIST
TOC3: HRRZ T1,0(N) ;GET LINE # OF DEFINITION
CAMLE T1,LINNUM ;IS IT OLD FOR THIS LINE?
MSG STOP, !!TOC LST FOULED UP !!
CAMN T1,LINNUM ;IS THIS WHERE WE DEFINED IT?
JRST SCNEND ;YES, IT WILL PRINT AS SUBTTL
HLRZ N,0(N) ;NO, LOOK AT NEXT
HRLM N,TOCPNT
JRST TOC3
MAKTOC: MOVEI N,1 ;LINK WORD
PUSHJ P,GETWRD
SKIPN T1,TOCPNT ;TOC INITIALIZED?
MOVEI T1,TOCPNT ;NO, POINT TO IT
HRLM N,0(T1) ;LINK THIS ONE TO LAST ON LIST
HRRM N,TOCPNT ;AND NOTE THIS IS NOW LAST
MOVE T1,LINNUM
HRRZM T1,0(N) ;STUFF LINE # INTO ENTRY
POPJ P,
;DEFINE A MACRO
DEFM0: SKIPE FPNT,MACPNT(RAM) ;IS THE "MACRO%" FIELD DEFINED?
JRST DEFM1 ;YES, AVOID SEARCH
MOVE T1,[MACRO,,FIELD] ;FORCE FIELD NAME
BLT T1,FIELD+NWORDS-1
PUSHJ P,MAKFLD ;MAKE INITIAL FIELD FOR MACROS
MSG STOP, !!CAN'T DEFINE "MACRO%"!!
MOVEM FPNT,MACPNT(RAM) ;REMEMBER FOR FUTURE
DEFM1: SETZM FIELD
PUSHJ P,MAKSYM
JRST SCNEND
MOVE N,.JBFF ;GET ADDRESS FOR STRING
DPB N,DEFVAL ; AND SAVE AS VALUE OF MACRO
PUSHJ P,DEFSET ;SET DEFINED FLAG
JFCL
TRZA F,NOXLAT ;ENABLE TRANSLATION FOR MACRO TEXT
DEFT2: TRO F,NOXLAT ;DISABLE TRANSLATION FOR .TOC, .TITLE TEXT
PUSHJ P,COPMAC ;COPY TEXT INTO SYMBOL TABLE
JRST SCNEND
;SUBR TO COPY QUOTED TEXT INTO SYMBOL TABLE
COPMAC: SETZM PCORC ;FORCE GETTING NEW CORE IN PUTCOR
CMAC1: PUSHJ P,GETCHR
CAIN C,12 ;EOL?
MSG CMAC99, MISSING TERMINAL QUOTE
CAIN C,42 ;TERMINAL QUOTE?
SETZB C,C1 ;YES, TERMINATE
TRNE F,NOXLAT ;INHIBIT TRANSLATION?
MOVE C,C1 ;YES, GET UNTRANSLATED CHAR BACK
PUSHJ P,PUTCOR ;STORE CHAR IN CORE
JUMPN C,CMAC1 ; COLLECT ASCIZ STRING
CMAC99: POPJ P,
;DEFINE A FIELD
DEFFLD: PUSHJ P,MAKFLD
JFCL ;DO CHECKS ON PASS2 AND PROCESS SYMBOLIC DEFAULTS
PUSHJ P,TOKEN ;GET 1ST ARG
CAIE N,.TKN
JRST DFANG ;FORMAT MAY BE <LPOS:RPOS>
MOVE N,NUMBER
PUSHJ P,DEFCHK ;CHECK THAT VALUE FITS FIELD
HALT DEFVAL
DEFFL2: CAIN C,"," ;POSSIBLE 2ND ARG?
PUSHJ P,TOKN10 ;YES, GO SCAN
CAIE N,.TKN
MSG .+1, SIZE REQUIRED FOR FIELD DEFINITION
MOVE N,NUMBER
PUSHJ P,DEFCHK
HALT DEFSIZ
CAIN C,","
PUSHJ P,TOKN10
CAIE N,.TKN
MSG .+1, POSITION REQUIRED FOR FIELD DEFINITION
MOVE N,NUMBER
PUSHJ P,DEFCHK
HALT DEFPOS
TRNN F,RTOL ;RIGHT TO LEFT NUMBERING?
JRST GETA1 ;NO
LDB T1,DEFSIZ ;GET FIELD SIZE AGAIN
SOJLE T1,GETA1
ADD N,T1 ;YES, GET HIGHEST BIT POSITION
GETA1: CAML N,MAXPOS(RAM)
MOVEM N,MAXPOS(RAM) ;KEEP TRACK OF MICRO WORD SIZE
;CONTINUATION OF GETARG -- LOOK AT FOURTH ARGUMENT, IF ANY
CAIE C,","
JRST GETA6
GETA2: PUSHJ P,GETCHR ;4TH ARG IS SINGLE CHAR
CAIN C," "
JRST GETA2 ; BUT FLUSH SPACES
MOVSI N,DEFTAB-DEFTND
GETA3: HLRZ T1,DEFTAB(N) ;SEARCH TABLE FOR CHARACTER
CAMN T1,C
JRST GETA5
AOBJN N,GETA3
MSG GETA6, UNDEFINED SPECIAL FUNCTION CHARACTER
GETA5: HRRZS N
PUSHJ P,DEFCHK
HALT DEFFNC
HRRZ T1,DEFTB2(N) ;GET DEFINITION-TIME ACTION
CAIN T1,DEFJ
PUSHJ P,DEFJ ;CHECK FOR JUMP ADR FIELD
GETA6: PUSHJ P,DEFSLS
JRST SCNEND
;HERE WHEN THIS FIELD DEFINITION CLAIMS TO BE THE JUMP ADDRESS
DEFJ: TRNE F,PASS2
POPJ P, ;"J" DEFINITION FOR PASS 1 ONLY
SKIPE JPNT(RAM) ;HAS ANY OTHER MADE THIS CLAIM?
MSG CPOPJ, MORE THAN ONE ADDRESS FIELD DEFINED
HRRZM FPNT,JPNT(RAM) ;ESTABLISH THE SYMBOL POINTER
POPJ P,
;PROCESS FIELD DEFINITION FOR FORMAT "FIELD/=<LPOS:RPOS>SYMBOL,DEFAULT"
;THE 1ST "LESS THAN" IS USED TO RECOGNIZE THE FORMAT
;"LPOS" IS THE DECIMAL LEFTMOST BIT POSITION IN THE FIELD.
;"RPOS" IS THE DECIMAL RIGHTMOST BIT POSITION IN THE FIELD.
;THE DEFAULT, WHEN PRESENT, DEPENDS ON "SYMBOL"
DFANG: CAIN N,.TKB ;TOKEN MUST BE NULL AND BREAK CHAR
CAIE C,"<" ; "LESS THAN" OR FORMAT ERROR
DFANG1: MSG SCNEND, FIELD DEFINITION FORMAT ERROR
PUSHJ P,TOKN10 ;GET 1ST REAL TOKEN
CAIE N,.TKN ;MUST BE REAL AND NUMERIC
MSG SCNEND, LEFT BIT POSITION NOT NUMERIC
MOVE T1,NUMBER ;SAVE LEFT BIT POSITION
MOVEM T1,LFTPOS#
CAIN C,">" ;IS ONLY ONE NUMBER GIVEN?
JRST DFANG6 ;YES, ASSUME 1-BIT FIELD
CAIE C,":" ;BIT POSITION SEPARATOR SHOULD BE COLON
MSG .+1, COLON MUST SEPARATE BIT POSITIONS
PUSHJ P,TOKN10
CAIE N,.TKN
MSG SCNEND, RIGHT BIT POSITION NOT NUMERIC
DFANG6: MOVE N,NUMBER ;PICK UP RIGHT BIT POSITION
CAMGE N,LFTPOS# ; AND GET LARGER IN "NUMBER",
EXCH N,LFTPOS# ; AND SMALLER IN "LFTPOS"
MOVEM N,NUMBER
CAML N,MAXPOS(RAM)
MOVEM N,MAXPOS(RAM) ;KEEP TRACK OF MICRO WORD SIZE
SUB N,LFTPOS# ;CALCULATE FIELD SIZE
ADDI N,1 ; ...
PUSHJ P,DEFCHK
HALT DEFSIZ ;AND STORE IN FIELD DEFINTION
MOVE N,NUMBER
TRNE F,RTOL
MOVE N,LFTPOS ;IF R TO L, POS IS SMALLER NUMBER
PUSHJ P,DEFCHK
HALT DEFPOS ;STORE POSITION IN FIELD DEF
CAIE C,">"
JRST DFANG1 ;FORMAT ERROR
DFANG2: PUSHJ P,TOKEN ;GET DEFAULT FUNCTION, IF ANY
CAIN N,.TKB
JRST DFANG5 ;NO DEFAULT FUNCTION. WE'RE DONE.
CAIE N,.TKS
MSG SCNEND, FIELD DEFAULT FUNCTION MUST BE SYMBOLIC
MOVSI N,DEFTAB-DEFTND
MOVE T2,NAME ;GET 1ST CHARS OF SYMBOL AND
ROT T2,7 ; ROTATE 1ST CHAR TO RIGHTMOST POS.
DFANG3: HLRZ T1,DEFTAB(N) ;SEARCH FOR DEFAULT FUNCTION CHARACTER
CAMN T1,T2 ;DO TOKEN AND DEFAULT FUNCTION MATCH?
JRST DFANG4 ;YES, FOUND
AOBJN N,DFANG3 ;NO, KEEP LOOKING
MSG DFANG5, UNDEFINED DEFAULT FUNCTION CHARACTER
DFANG4: HRRZS N
PUSHJ P,DEFCHK ;INSERT FUNCTION# INTO FIELD
HALT DEFFNC
HRRZ T1,DEFTB2(N) ;GET DEFINITION-TIME ACTION
PUSHJ P,0(T1) ;DO THE ACTION
DFANG5: PUSHJ P,DEFSLS ;CHECK FIELD DEFINITION FOR RATIONALITY
LDB T1,STAPNT ;GET CHARACTER TYPE
CAIE T1,EOL ;SHOULD BE END-OF-LINE CHARACTER
JRST DFANG1 ;FORMAT ERROR
JRST SCNEND ;DONE AT LAST, FINAL RETURN
;ON PASS2 WHEN FIELD IS DEFINED BUT IN ADR OF DEFAULT FIELD
; PROCESS SYMBOL FIELD DEFAULT
DEFF80: CAIE C,","
MSG CPOPJ, MISSING COMMA BEFORE DEFAULT FIELD NAME
PUSHJ P,TOKEN
CAIE N,.TKS
DEFF81: MSG CPOPJ, MISSING DEFAULT FIELD NAME
TRNN F,PASS2
POPJ P,
PUSH P,FPNT
PUSHJ P,FLDSPC ;MOVE SYMBOL TEXT TO FIELD STORAGE
PUSHJ P,SRCFLD ;SEARCH FOR FIELD
MSG DEFF85, SYMBOLIC FIELD DEFAULT NOT DEFINED
POP P,SPNT
DPB FPNT,DEFPNT ;STORE ADR OF DEFAULT FIELD
DEFF84: MOVE FPNT,SPNT
MOVSI T1,SYMTXT(FPNT) ;MOVE SYMBOL TEXT BACK TO "FIELD"
HRRI T1,FIELD ; SO OTHER DEFINITIONS CAN USE IT!
BLT T1,FIELD+NWORDS-1
POPJ P,
DEFF85: POP P,SPNT
JRST DEFF84
;PROCESS NUMERIC DEFAULTS
DEFF90: CAIE C,","
MSG CPOPJ, MISSING COMMA BEFORE NUMERIC FIELD DEFAULT
PUSHJ P,TOKEN
CAIE N,.TKN
DEFF91: MSG CPOPJ, MISSING NUMERIC FIELD DEFAULT
MOVE N,NUMBER
PUSHJ P,DEFCHK ;CHECK THAT VALUE FITS FIELD
HALT DEFVAL
POPJ P,
;CHECK TO SEE THAT VALUE FITS IN THE BYTE FIELD ALLOWED
;AND THEN STUFF IT THERE
DEFCHK: LDB T1,DEFFLG ;FIRST CHECK FOR MULTIPLE DEFINITION
TRNE T1,MULF ;IF SET, WE'VE ALREADY OBJECTED
JRST CPOPJ1 ;CAN'T EXPECT THAT TO BE CONSISTENT
HRRZ T1,@(P)
TRNN F,PASS2
JRST DEFC2
LDB N1,(T1) ;GET PASS1 DEFINITION
CAME N,N1
MSG STOP, PASS1 AND PASS2 DEFINITIONS DIFFER
JRST CPOPJ1
DEFC2: DPB N,(T1)
LDB N1,(T1)
CAME N,N1
MSG .+1, NUMBER TOO BIG FOR FIELD
DEFSET: LDB T4,DEFFLG ;PUT DEFINE FLAG ON
IORI T4,DEFF
DPB T4,DEFFLG
JRST CPOPJ1
;SUBROUTINE FOR A DEFAULT FROM ANOTHER FIELD- ALLOWS RECURSION
;CALLED WITH FPNT/ FIELD POINTER TO WHERE DATA ULTIMATELY GOES
; SPNT/ FIELD POINTER TO WHERE DATA COMES FROM (SO FAR)
FLDSET: PUSH P,FPNT ;SAVE THIS FIELD'S POINTER
PUSH P,SPNT
LDB SPNT,DEFPNT ;GET POINTER TO DEFAULT SOURCE FIELD
EXCH SPNT,FPNT ;"FLDTST" NEEDS "FPNT" POINTING TO SOURCE
PUSHJ P,FLDTST ;HAS DEFAULT FIELD HAD VALUE SET?
JRST FLDS2 ;NO,IT'S VIRGIN
EXCH SPNT,FPNT ;PUT POINTERS BACK IN NORMAL ORDER
AND T3,VALUE-1(N) ;YES,EXTRACT VALUE FROM OTHER FIELD
AND T4,VALUE(N)
MOVNS N1 ; AND GET IT RIGHT JUSTIFIED IN T3
LSHC T3,(N1)
MOVE N,T3 ;"BITSET" WANTS IT IN "N"
PUSHJ P,BITS1 ;PUT DATA IN "FPNT" (DESTINATION) FIELD
JRST FLDXIT
FLDS2: EXCH SPNT,FPNT ;MAKE FPNT POINT TO THIS FIELD
; AND SPNT POINT TO DEFAULT FIELD
LDB T1,DEFFNC ;GET DEFAULT FUNCTION FOR DEFAULT FIELD
JUMPE T1,FLDXIT ;IGNORE IF DEFAULT FIELD HAS NO DEFAULT
HRRZ T1,DEFTAB(T1) ;GET DISPATCH ADDRESS
PUSHJ P,(T1) ; AND GO DO IT, PUTTING VALUE IN THIS FIELD
FLDXIT: POP P,SPNT ;RESTORE SPNT FOR THIS FIELD
POP P,FPNT ;RESTORE FPNT FOR THIS FIELD
POPJ P, ;DONE WITH DEFAULT FIELD FUNCTION
TIMSET: MOVE N,TIME1 ;DEFAULT TIME INSERTION
CAMGE N,TIME2 ;GET MAX
MOVE N,TIME2
LDB T2,DEFVAL ;GET DEFAULT MINIMUM TIME
CAMGE N,T2
MOVE N,T2 ;DEFAULT TIME .GT. MAX(T1,T2)
JRST BITS1
PCINC: JUMPN RAM,PCMSG ;DISPATCH RAM HAS NO DEFAULT PC'S
MOVE T1,LALHED ;POINTER TO FOOT OF LIST
HRRZ T1,LALPNT(T1) ;GET POINTER TO NEXT WORD
HRRZ N,LALLOC(T1) ;GET NEXT LOCATION ASSIGNMENT
HRRZ T1,LALLIN(T1) ;GET LINE # OF NEXT U-WORD
JUMPN T1,BITS1 ;XFER IF ONE EXISTS
PCMSG: MSG CPOPJ, NO DEFAULT PC AVAILABLE
;SUBROUTINE TO DEPOSIT DATA IN A FIELD
;DESTINATION FIELD POINTED TO BY "FPNT"
;SOURCE POINTED TO BY "SPNT" (WHEN ENTERED AT "BITSET")
BITSET: LDB N,DEFVAL ;VALUE INSERTION INTO MICRO FIELD
BITS1: PUSH P,N ;SAVE VALUE
PUSHJ P,FLDTST ;FIELD ALREADY LOADED?
JRST BITS3 ;NO
MOVE T1,0(P) ;YES...CHECK FOR CONFLICTING OVERLAP
MOVEI T2,0
LSHC T1,(N1)
SKIPE N
XOR T1,VALUE-1(N)
XOR T2,VALUE(N) ;GET DIFFERENCE FROM PREVIOUS VALUES
SKIPE N
AND T1,VALSET-1(N)
AND T2,VALSET(N) ;LIMIT DIFF TO FIELDS ALREADY SET
TDNN T1,T3
TDNE T2,T4 ;ANY SUCH DIFFERENCES IN THIS FIELD?
MSG NPOPJ, MICRO FIELD SET WITH CONFLICTING VALUES
;NO, SET THIS VALUE INTO MICROWORD
BITS3: POP P,T1
MOVEI T2,0
LSHC T1,(N1) ;PUSH VALUE INTO PLACE
SETCA T3, ;MAKE UNUSED FIELDS BE 1S
SETCA T4,
TDNN T1,T3 ;IF VALUE EXTENDS OUTSIDE FIELD,
TDNE T2,T4 ; THEN THERE IS AN ERROR
MSG CPOPJ, VALUE TOO LARGE FOR FIELD
SKIPE N
IORM T1,VALUE-1(N)
IORM T2,VALUE(N)
SKIPE N
ORCAM T3,VALSET-1(N) ;MARK MICRO WORD FIELD AS USED
ORCAM T4,VALSET(N)
POPJ P,
;SKIP IF SOME FIELDS MATCH THIS ONE
;NO SKIP IF FIELD VIRGIN
;ON RETURN, LEAVE MASK FOR THIS FIELD IN T3,T4
;LEAVE SHIFT POSITION AND TABLE INDEX IN N1,N
FLDTST: MOVEI T3,0
MOVNI T4,1
LDB T1,DEFSIZ
LSHC T3,(T1) ;CREATE MASK OF CORRECT SIZE IN T3
LDB N,DEFPOS
;THE FOLLOWING 4 LINES OF CODES ARE FOR .RTOL
TRNN F,RTOL
JRST FLDT2
SUBI N,MICMXB
SETCA N,
FLDT2: ADDI N,1
IDIVI N,^D36
MOVNS N1
MOVEI T4,0
LSHC T3,(N1) ;MOVE T3,T4 MASK INTO POSITION
SKIPE N
TDNN T3,VALSET-1(N)
TDNE T4,VALSET(N)
AOS (P)
POPJ P,
;CODE TO SEARCH FIELD DEFINITION LIST AND INSERT DEFAULTS
DEFALT: MOVEI FPNT,FLDPNT ;START OF LIST
DFLT2: HRRZ FPNT,SYMLNK(FPNT)
JUMPE FPNT,CPOPJ ;STOP AT END OF LIST
MOVE SPNT,FPNT
LDB T1,DEFTYP ;GET "UCODE" OR "DISP" TYPE
CAME T1,RAM ;MATCH CURRENT MODE?
JRST DFLT4 ;NO
PUSHJ P,FLDTST ;IS FIELD VIRGIN?
SKIPA ;YES
JRST DFLT4 ;NO
LDB T1,DEFFNC
JUMPE T1,DFLT4 ;0 FUNCTION MEANS NO DEFAULT
MOVE T1,DEFTAB(T1)
PUSHJ P,(T1) ;DISPATCH ON FUNCTION
DFLT4: JRST DFLT2
PARITY: POP P,T1 ;GET RETURN ADR
PUSH P,FPNT ; SAVE FPNT TO PARITY FIELD
PUSHJ P,(T1) ; AND MAKE "CALLER" BE "CALLEE"
POP P,FPNT ;SET UP PARITY FIELD POINTERS
MOVE SPNT,FPNT
MOVEI T1,0 ;INIT PARITY
MOVSI T2,-MICMXW ;COUNT THRU ALL OF MICRO WORD
XOR T1,VALUE(T2) ;COMPUTE TABLE PARITY
AOBJN T2,.-1
TSC T1,T1 ;REDUCE TO 18 BITS
MOVEI N,0
PARLUP: JUMPN T1,[ANDI T1,-1(T1) ;REMOVE 1 BIT
AOJA N,PARLUP ]
TRNE N,1 ;IF PARITY ALREADY ODD,
POPJ P, ; THEN OK AS IS
MOVEI N,1 ;GET A PARITY BIT
LDB T2,DEFSIZ ;GET PARITY FIELD SIZE
JUMPN T2,BITS1 ;PUT PARITY BIT INTO FIELD
TRNE F,RTOL ;CAN'T DO FREE PARITY YET IN RTOL MODE
MSG STOP, NO CODE FOR FREE PARITY IN RTOL MODE
MOVSI T1,-MICMXW ;MINUS TABLE LENGTH OF MICRO WORD
PAR3: SETCM T2,VALSET(T1) ;GET BIT USAGE
JFFO T2,[MOVSI N,(1B0) ;BIT TO SHIFT
MOVNS T3 ;GET RIGHT SHIFT COUNT
LSH N,(T3) ; AND SHIFT PARITY BIT TO FREE PLACE
IORM N,VALUE(T1)
IORM N,VALSET(T1)
JRST PAR5 ]
AOBJN T1,PAR3 ;CONTINUE LOOKING FOR PLACE FOR BIT
PAR5: HLRES T1 ;GET # WORDS REMAINING
ADDI T1,MICMXW ;GET WHICH WORD HAD FREE BIT
IMULI T1,^D36
SUB T1,T3 ;CONVERT TO BIT NUMBER
CAMLE T1,MAXPOS(RAM) ;WAS THERE ROOM FOR PARITY BIT?
MSG .+1, NO ROOM FOR PARITY BIT
POPJ P,
;SUBROUTINE TO FIND A FIELD OR MAKE ONE IF IT DOESN'T EXIST.
; NO SKIP IF IT ALREADY EXISTS. SKIP IF NEWLY MADE.
; RETURNS POINTER TO FIELD BLOCK IN SPNT AND FPNT.
MAKFLD: PUSHJ P,SRCF1
JRST MAKF1 ;NOT FOUND
TRNN F,PASS2 ;ONLY ONCE PER PASS, PLEASE
JRST MULFLD
PUSHJ P,BEGCRF ;PUT DEFINITION IN THE CREF
LDB T1,DEFFLG ;CHECK FOR MULTIPLY DEFINED
TRNE T1,MULF
MSG CPOPJ, MULTIPLY DEFINED FIELD
POPJ P, ;AND RETURN FOUND
MAKF1: SKIPN FIELD
MSG CPOPJ, CAN'T DEFINE A NULL FIELD
TRNE F,PASS2 ;BETTER BE PASS 1
MSG STOP, !!FIELD UNDEFINED ON PASS 2!!
PUSH P,N
PUSHJ P,GETROM
MOVE FPNT,N ;SAVE POINTER TO NEW FIELD
MOVE SPNT,N
POP P,N1 ;GET POINTER TO PREVIOUS FIELD
HRRZ N,SYMLNK(N1) ;GET POINTER FROM PREVIOUS FIELD
HRRZM N,SYMLNK(FPNT) ;AND CONTINUE FROM NEW FIELD
HRRM FPNT,SYMLNK(N1) ;LINK LIST STRUCTURE
MOVSI T1,FIELD
HRRI T1,SYMTXT(FPNT)
BLT T1,SYMTXT+NWORDS-1(FPNT) ;COPY NAME TEXT INTO DEFINITION
DPB RAM,DEFTYP
IFN FTHASH,<
MOVEI T1,FLDPNT ;THIS IS A FIELD DEF
PUSHJ P,STHASH ;STORE HASH CODE
>
JRST CPOPJ1
MULSYM:
MULFLD: LDB T1,DEFFLG ;PICK UP FLAGS
IORI T1,MULF ;NOTE MULTIPLE DEFINITION
DPB T1,DEFFLG
MSG CPOPJ, MULTIPLE DEFINITION
;SUBROUTINE TO MAKE A SYMBOL DEFINITION (IF ONE DOESN' EXIST)
;SIMILAR TO MAKFLD ABOVE
; CALLED WITH POINTER TO FIELD IN FPNT
; SKIPS IF NEWLY MADE. RETURNS POINTER IN SPNT.
; NO SKIP IF ALREADY DEFINED.
; POINTER IN SPNT TO PRESENT DEFINITION.
MAKSYM: PUSHJ P,SRCSY1 ;LOOK FOR SYMBOL, BUT DON'T CREF YET
JRST MAKS1 ;NOT FOUND
TRNN F,PASS2 ;DISALLOW MULTIPLE DEFINITION
JRST MULSYM
PUSHJ P,BEGCRF ;NOTE DEFINITION IN CREF
LDB T1,DEFFLG ;LOOK AT FLAGS
TRNE T1,MULF ;IS THIS MULTIPLY DEFINED?
MSG CPOPJ, MULTIPLY DEFINED SYMBOL
POPJ P,
MAKS1: SKIPN NAME ;NO DEFINED YET
MSG CPOPJ, CAN'T DEFINE NULL SYMBOL
TRNE F,PASS2
MSG STOP, !!SYMBOL UNDEFINED ON PASS2!!
PUSH P,N
PUSHJ P,GETROM
HRRZM N,SPNT
POP P,N1
HLRZ N,SYMLNK(N1)
HRLZM N,SYMLNK(SPNT) ;LINK TO NEXT SYMBOL
HRLM SPNT,SYMLNK(N1)
MOVSI T1,NAME
HRRI T1,SYMTXT(SPNT)
BLT T1,SYMTXT+NWORDS-1(SPNT)
DPB RAM,DEFTYP
SKIPL DOCREF
TDZA T1,T1 ;NO FLAGS IF CREF ENABLED
MOVEI T1,NCRFF ;INHIBIT CREF ON THIS SYMBOL
DPB T1,DEFFLG
IFN FTHASH,<
MOVEI T1,(FPNT) ;FIELD FOR THIS SYMBOL
PUSHJ P,STHASH ;PLACE IN HASH LIST
>
JRST CPOPJ1
SRCFLD:
IFN FTHASH,<
MOVEI N,FLDPNT
MOVEI N1,FIELD ;LOCATION OF SYMBOL
PUSHJ P,FIND ;FIND IN TABLE
JRST SRCF2 ;NOT FOUND--TRY SLOW WAY
JRST SCRF3 ;FOUND
>
SRCF1: MOVEI N,FLDPNT ;ENTER HERE FROM MAKFLD
SRCF2: MOVEI N1,(N) ;SAVE POINTER TO LAST LOWER FIELD
HRRZ N,SYMLNK(N)
JUMPE N,SRCX ;QUIT IF END OF LIST
XX=0
REPEAT NWORDS,< MOVE T1,FIELD+XX
CAMLE T1,XX+SYMTXT(N)
JRST SRCF2
CAME T1,XX+SYMTXT(N)
JRST SRCX ;NO MATCH, RETURN PTR TO SMALLER FLD
XX=XX+1>
SCRF3: HRRZ FPNT,N
HRRZ SPNT,N
LDB T1,DEFTYP
CAIE T1,(RAM) ;DOES FIELD TYPE MATCH CURRENT MODE?
JRST SRCF2 ;NO, LOOK SOME MORE
JRST CPOPJ1 ;YES, SKIP RETURN
SRCX: MOVEI N,(N1) ;GET POINTER TO SMALLER FIELD
POPJ P, ;RETURN NO MATCH
SRCSYM:
IFN FTHASH,<
MOVEI N,(FPNT)
MOVEI N1,NAME ;ADDRESS OF TEXT
PUSHJ P,FIND ;GO FIND SYMBOL
JRST SRCSA ;NOT FOUND--TRY SLOW WAY
MOVEI SPNT,(N) ;FOUND. SET ADDRESS
JRST SRCSB ;FOUND
>
SRCSA: PUSHJ P,SRCS1 ;LOOK FOR SYMBOL
POPJ P, ;WASN'T THERE
SRCSB: LDB T1,DEFFLG ;GET SYMBOL FLAGS
TRNN T1,NCRFF ;DOES THIS ONE INHIBIT CREF?
PUSHJ P,MAKCRF ; CREF THE REFERENCE
LDB T4,DEFFLG
TRNN T4,DEFF ;IS SYMBOL DEFINED?
POPJ P, ;NO
JRST CPOPJ1
;HERE IS BASIC SEARCH ROUTINE
SRCSY1: ;HERE TO SEARCH FOR PSEUDO-OP
SRCS1: MOVEI N,(FPNT)
SRCS2: MOVEI N1,(N)
HLRZ N,SYMLNK(N)
JUMPE N,SRCX ;END OF LIST, RETURN NO MATCH
XX=0
REPEAT NWORDS,< MOVE T1,NAME+XX
CAMLE T1,XX+SYMTXT(N)
JRST SRCS2 ;TRY NEXT ENTRY, THIS IS TOO SMALL
CAME T1,XX+SYMTXT(N)
JRST SRCX ;NO CAN FIND
XX=XX+1 >
SRCS3: MOVEI SPNT,(N) ;THIS IS THE SYMBOL
JRST CPOPJ1
IFN FTHASH,<
;HERE IS THE STUFF FOR HASHED SYMBOL TABLE
;SUBROUTINE TO PUT A SYMBOL INTO HASH LIST
;CALL WITH:
; T1 = POINTER TO FIELD NAME (OR FLDPNT IF FIELD)
; SPNT = POINTER TO SYMBOL
; PUSHJ P,STHASH
; RETURN HERE ALWAYS
STHASH: HRLZM T1,SYMHSH(SPNT) ;STORE POINTER
MOVEI N1,SYMTXT(SPNT) ;POINTER TO TEXT
PUSHJ P,HASHNO ;COMPUTE HASH NUMBER
SKIPE T1,HSHTAB(T2) ;ANYTHING THERE YET?
HRRM T1,SYMHSH(SPNT) ;YES--POINT THIS TO THAT
HRRZM SPNT,HSHTAB(T2) ;MAKE THIS START OF LIST
POPJ P,0 ;RETURN
;SUBROUTINE TO FIND A SYMBOL OR FIELD NAME
;CALL WITH:
; N = ADDRESS OF FIELD BLOCK (OR FLDPNT)
; N1 = ADDRESS OF ASCII STRING
; PUSHJ P,FIND
; HERE IF NOT FOUND
; HERE WITH N POINTING TO BLOCK IF FOUND
FIND: PUSH P,T2 ;PRESERVE ACS
PUSHJ P,HASHNO ;COMPUTE HASH NUMBER
SKIPN T1,HSHTAB(T2) ;GET HASH TABLE INDEX
JRST FINDX ;NOT IN TABLE
FIND1: HLRZ T2,SYMHSH(T1) ;GET POINTER
CAIN T2,(N) ;RIGHT LIST?
JRST FIND3 ;YES--SEE IF MATCH
FIND2: HRRZ T1,SYMHSH(T1) ;NEXT FIELD IN LIST
JUMPN T1,FIND1 ;LOOP IF MORE ENTRIES
FINDX: POP P,T2 ;RESTORE T2
POPJ P,0 ;NOT THERE
FIND3: CAIE N,FLDPNT ;FIELD DEF?
JRST FIND4 ;NO--IGNORE RAM TYPE
LDB T2,[POINT 6,SYMFLG(T1),11]
CAIE T2,(RAM) ;DOES FIELD MATCH CURENT MODE?
JRST FIND2 ;NO--KEEP LOOKING
FIND4:
XX==0
REPEAT NWORDS,< MOVE T2,SYMTXT+XX(T1)
CAME T2,XX(N1)
JRST FIND2
XX==XX+1 >
MOVE N,T1 ;FOUND
POP P,T2 ;RESTORE T2
JRST CPOPJ1 ;EXIT
;SUBROUTINE TO COMPUTE A HASH NUMBER
;CALL WITH:
; N1 = ADDRESS OF ASCII STRING
; PUSHJ P,HASHNO
; HERE WITH NUMBER IN T2
;
HASHNO: MOVE T1,(N1) ;GET FIRST WORD
XX==1
REPEAT NWORDS-1,<
ADD T1,XX(N1)
XX==XX+1
>
LSH T1,-1 ;MAKE POSITIVE
IDIVI T1,HSHLEN ;PUT IN RANGE
POPJ P,0 ;RETURN
> ;ENF FTHASH
MAKCRF: SKIPL DOCREF ;IS CREF ENABLED?
TRNN F,PASS2
POPJ P, ;BUILD CREF ON PASS2
TDZA N1,N1 ;CLEAR DEFINE FLAG
BEGCRF: MOVEI N1,1B18 ;FLAG AS DEFINITION
MOVEI N,1 ;GET 1 WORD FOR CREF REFERENCE
AOS CRFCOR ;TALLY CORE USED FOR CREF
PUSHJ P,GETWRD
HLRZ T1,SYMCRF(SPNT) ;GET LAST ADR IN LIST
HRLM N,SYMCRF(SPNT) ;MAKE NEW WORD LAST ADR
SKIPN T1 ;IF OLD LAST ADR IS ZERO, THEN
MOVEI T1,SYMCRF(SPNT) ; LAST ADR IS IN SYMBOL BLOCK
HRRM N,(T1) ;PUT THIS WORD ONTO END OF LIST
IFN FTCOIN,< HRRZ T1,CRFLIN> ;GET LINE # AT WHICH THIS WORD STARTED
IFE FTCOIN,< HRRZ T1,LINNUM> ;GET CURRENT LINE NUMBER
IOR T1,N1 ;PUT DEFINE FLAG, IF ANY, IN
HRLZM T1,(N) ; STUFF INTO WORD NOW ON LIST END
; AND MAKE POINTER TO NEXT BE 0
POPJ P,
GETROM: MOVEI N,SYMLEN ;GET ROOM FOR NEW SYM TABLE ENTRY
ADDM N,SYMCOR ;TALLY SYMBOL TABLE CORE USAGE
GETWRD: PUSH P,.JBFF##
ADDB N,.JBFF##
CAMG N,.JBREL##
JRST GETW2
CORE N,
MSG [EXIT], NOT ENOUGH MEMORY TO EXPAND
GETW2: HRRZ T1,(P) ;GET ADR OF 1ST NEW WORD
SETZM (T1) ;ZERO THAT 1ST WORD
HRLS T1 ;SET UP BLT AC
ADDI T1,1 ; ...
HRRZ T2,.JBFF## ;GET LAST WORD+1
CAILE T2,+1(T1) ;ONLY DO BLT IF 2 OR MORE WORDS
BLT T1,-1(T2) ;ZERO NEW WORDS
NPOPJ: POP P,N
POPJ P,
;SUBROUTINE TO BUILD A SYMBOLIC OR NUMERIC TOKEN
; ENTRY TOKEN - BUILD SYMBOL, OCTAL NUMBER, OR DECIMAL NUMBER
; ENTRY TOKN10 - BUILD SYMBOL, OR DECIMAL NUMBER
;OCTAL NUMBERS ARE OF FORM <+,-, ><DIGITS 0-7>
; AN 8 OR 9 OR A DECIMAL POINT MAKES NUMBER DECIMAL
;DECIMAL NUMBERS ARE OF FORM <+,-, ><DIGITS 0-9><POINT, >
; AN 8 OR 9 OR A FINAL DECIMAL POINT IS REQUIRED
;A SYMBOL IS ANYTHING THAT IS NOT A LEGAL NUMBER
; RETURN .TKB - BLANK TOKEN
; RETURN .TKN - SIGNED NUMERIC TOKEN WITH VALUE IN "NUMBER"
; RETURN .TKS - SYMBOL TOKEN WITH ASCIZ TEXT IN "NAME" TABLE
.TKB==0 ;BLANK (OR NULL) TOKEN
.TKN==1 ;NUMERIC TOKEN
.TKS==2 ;SYMBOLIC TOKEN
TOKEN: TDZA T1,T1 ;ENTRY FOR SYM,OCT#,DEC# START WITH STATE 0
TOKN10: MOVEI T1,5_.SZTX ;ENTRY FOR SYM,DEC# START WITH STATE 5
TRNE F,HEXF ;USE ALT STATE TABLE IF HEX
ADDI T1,20_.SZTX
MOVEM T1,TOKSTA# ;INIT STATE TABLE
SETZM TKZER
MOVE T1,[TKZER,,TKZER+1]
BLT T1,TKZEND-1 ;INITIALIZE TOKEN VALUES
MOVE T1,[POINT 7,NAME]
MOVEM T1,TOKPNT# ;INIT SYMBOL BUILD POINTER
MOVE T1,PNTCNT ;WHERE ON PRINT LINE TOKEN STARTS
SKIPN CHRPNT ; ARE WE ON PRINT LINE (NOT MACRO)?
MOVEM T1,PNTTOK ;YES. SAVE START OF TOKEN
TOK2: PUSHJ P,GETCHR ;GET NEXT CHARACTER
MOVE T1,TOKSTA ;GET OLD STATE
LSH T1,-.SZTX ;DROP XCT INDEX
IMULI T1,3*4 ;SELECT LINE IN TOKTAB
LDB T2,TOKTYP ;GET CHARACTER TYPE
ADDI T1,(T2) ; AND COMBINE WITH OLD STATE
IDIVI T1,4 ;GET NEXT STATE, 4 ENTRIES/WORD
LDB T1,TOKNXT(T1+1)
MOVEM T1,TOKSTA ;SAVE NEW STATE
ANDI T1,<1_.SZTX>-1 ; AND EXTRACT DISPATCH ADDRESS
XCT TOKXCT(T1) ;PROCESS CURRENT CARACTER
JRST TOK1 ;PUT IT INTO SYMBOL NAME
JRST TOK2 ;GO GET NEXT CHARACTER
; EXECUTE TABLE
TOKXCT: SKIPA ; 0 IGNORE CHARACTER
JFCL ; 1 INCLUDE IN SYMBOL ONLY
SETOM TOKMIN ; 2 SET MINUS FLAG
PUSHJ P,TOKDIG ; 3 PROCESS 0-9
JRST TOK5 ; 4 RETURN .TKB - NO TOKEN
JRST TOK6 ; 5 RETURN .TKS - SYMBOL
JRST TOK7 ; 6 RETURN .TKN - DECIMAL NUMBER
JRST TOK8 ; 7 RETURN .TKN - OCTAL NUMBER
JRST TOKF ; 8 CONVERT FORMAL TO ACTUAL
.SZTX==4 ;NUMBER OF BITS REQUIRED TO REPRESENT INDEX
;MARGINAL INDEX TABLE INTO TOKTAB
TOKNXT: PINDEX 9,TOKTAB(T1)
DEFINE TOKT(A1,B1,A2,B2,A3,B3,A4,B4,A5,B5,A6,B6,A7,B7,A8,B8,A9,B9,A10,B10),<
XLIST
BYTE (9) A1_4+B1, A2_4+B2, A3_4+B3, A4_4+B4
BYTE (9) A5_4+B5, A6_4+B6, A7_4+B7, A8_4+B8
BYTE (9) A9_4+B9, A10_4+B10
LIST >
;STATE TABLE. THE ROWS ARE INDEXED BY STATE; COLUMNS BY CHAR TYPE.
; EACH ENTRY IS A NINE-BIT BYTE CONSISTING OF TWO PARTS:
; THE HIGH ORDER 5 BITS IDENTIFY THE NEW STATE,
; THE LOW ORDER 4 BITS IDENTIFY THE CHARACTER PROCESSING FUNCTION.
TOKTAB:;TERM, " ", ".", "+", "-", 0-7, 8-9, OTHER, A-F, "@"
TOKT 0,4, 0,0, 1,1, 14,1, 14,2, 2,3, 3,3, 1,1, 1,1, 12,1 ;STATE #0
TOKT 0,5, 6,1, 1,1, 1,1, 1,1, 1,1, 1,1, 1,1, 1,1, 1,1 ;STATE #1
TOKT 0,7, 7,1, 4,1, 1,1, 1,1, 2,3, 3,3, 1,1, 1,1, 1,1 ;STATE #2
TOKT 0,6, 10,1, 4,1, 1,1, 1,1, 3,3, 3,3, 1,1, 1,1, 1,1 ;STATE #3
TOKT 0,6, 11,1, 1,1, 1,1, 1,1, 1,1, 1,1, 1,1, 1,1, 1,1 ;STATE #4
TOKT 5,4, 5,0, 1,1, 3,1, 3,2, 3,3, 3,3, 1,1, 1,1, 12,1 ;STATE #5
TOKT 0,5, 6,0, 1,1, 1,1, 1,1, 1,1, 1,1, 1,1, 1,1, 1,1 ;STATE #6
TOKT 0,7, 7,0, 4,1, 1,1, 1,1, 2,3, 3,3, 1,1, 1,1, 1,1 ;STATE #7
TOKT 0,6, 10,0, 4,1, 1,1, 1,1, 3,3, 3,3, 1,1, 1,1, 1,1 ;STATE #10
TOKT 0,6, 11,0, 1,1, 1,1, 1,1, 1,1, 1,1, 1,1, 1,1, 1,1 ;STATE #11
TOKT 0,10, 13,0, 1,1, 1,1, 1,1, 12,3, 12,3, 1,1, 1,1, 1,1 ;STATE #12
TOKT 0,10, 13,0, 1,1, 1,1, 1,1, 1,1, 1,1, 1,1, 1,1, 1,1 ;STATE #13
TOKT 0,5, 15,1, 1,1, 1,1, 1,1, 2,3, 3,3, 1,1, 1,1, 1,1 ;STATE #14
TOKT 0,5, 15,0, 1,1, 1,1, 1,1, 2,3, 3,3, 1,1, 1,1, 1,1 ;STATE #15
;STATE #0 - FLUSHES SPACES, ALLOWS + OR - FOR NUMBERS
;STATES #1,6 - BUILDS SYMBOLS, A CHARACTER WAS ILLEGAL FOR A NUMBER
;STATES #2,7 - BUILDS OCTAL NUMBER UNTIL 8,9, OR (.) SEEN
;STATES #3,10 - BUILDS DECIMAL NUMBER
;STATES #4,11 - A (.) SEEN AFTER A NUMBER, GO TO #1 FOR ANYTHING OTHER
; THAN SPACE OR TERM.
;STATE #5 - SAME AS #0 EXCEPT ANY NUMBER IS FORCED DECIMAL
; STATES #6-11 AND #15 FLUSH MULTIPLE SPACES
;STATE #12 - COLLECT MACRO FORMAL ARGUMENT
;STATE #13 - DROP TRAILING SPACES FROM FORMAL
;STATES #14,15 - INITIAL PLUS OR MINUS. ANYTHING OTHER THAN DIGIT MAKES SYMBOL
; STATES 20-35, SAME AS 0-15 BUT FOR HEX MODE
BLOCK 2*3 ;LEAVE SPACE FOR EXPANSION OF OCTAL TABLE
; TERM, " ", ".", "+", "-", 0-7, 8-9, OTHER, A-F, "@"
TOKT 20,4, 20,0, 21,1, 34,1, 34,2, 22,3, 22,3, 21,1, 21,1, 32,0 ;STATE #20
TOKT 20,5, 26,1, 21,1, 21,1, 21,1, 21,1, 21,1, 21,1, 21,1, 21,1 ;STATE #21
TOKT 20,7, 27,1, 24,1, 21,1, 21,1, 22,3, 22,3, 21,1, 22,3, 21,1 ;STATE #22 (NUMBER)
TOKT 20,6, 30,1, 24,1, 21,1, 21,1, 23,3, 23,3, 21,1, 21,1, 21,1 ;STATE #23 (DECIMAL)
TOKT 20,6, 31,1, 21,1, 21,1, 21,1, 21,1, 21,1, 21,1, 21,1, 21,1 ;STATE #24
TOKT 25,4, 25,0, 21,1, 23,1, 23,2, 23,3, 23,3, 21,1, 21,1, 21,1 ;STATE #25
TOKT 20,5, 26,0, 21,1, 21,1, 21,1, 21,1, 21,1, 21,1, 21,1, 21,1 ;STATE #26
TOKT 20,7, 27,0, 24,1, 21,1, 21,1, 22,3, 22,3, 21,1, 22,3, 21,1 ;STATE #27
TOKT 20,6, 30,0, 24,1, 21,1, 21,1, 23,3, 23,3, 21,1, 21,1, 21,1 ;STATE #30
TOKT 20,6, 31,0, 21,1, 21,1, 21,1, 21,1, 21,1, 21,1, 21,1, 21,1 ;STATE #31
TOKT 20,10, 33,0, 21,1, 21,1, 21,1, 32,3, 32,3, 21,1, 21,1, 21,1 ;STATE #32
TOKT 20,10, 33,0, 21,1, 21,1, 21,1, 21,1, 21,1, 21,1, 21,1, 21,1 ;STATE #33
TOKT 20,5, 35,1, 21,1, 21,1, 21,1, 22,3, 22,3, 21,1, 22,3, 21,1 ;STATE #34 (LEADING PLUS OR MINUS)
TOKT 20,5, 35,0, 21,1, 21,1, 21,1, 22,3, 22,3, 21,1, 22,3, 21,1 ;STATE #35
TOK1: MOVE T1,TOKPNT ;GET SYMBOL BUILD POINTER
CAME T1,[POINT 7,NAME+MACMAX-1,34-7]
IDPB C,TOKPNT ;ROOM FOR CHAR, STORE AWAY
JRST TOK2
TOKDIG: LDB T1,DIGPNT ;GET DIGIT VALUE OF CHARACTER
MOVE T2,RADIX ;8 OR 16
IMULM T2,TOKOCT ;BUILD OCTAL NUMBER
ADDM T1,TOKOCT ; AND ADD IN NEXT DIGIT
MOVEI T2,^D10
IMULM T2,TOKDEC ;BUILD DECIMAL NUMBER
ADDM T1,TOKDEC ; AND ADD IN NEXT DIGIT
POPJ P,
;HERE WHEN TOKEN COLLECTED WAS A FORMAL --
; REPLACE IT WITH THE ACTUAL, AND SCAN OFF THE ACTUAL
TOKF: HLRZ T2,0(PM) ;IS THE ACTUAL A FORMAL OF PREVIOUS INVOKATION
SKIPN T2 ;SKIP IF SO
MOVEI T2,0(PM) ;NO, USE MACRO
HRRZ T3,0(T2) ;GET NUMBER OF ARGS IN CONTAINING MACRO
SKIPLE T1,TOKDEC ;GET DECIMAL ARGUMENT NUMBER
CAMLE T1,T3 ;IT MUST BE LE NUMBER OF ARGS
JRST TOK5 ;ELSE RETURN NOTHING
SUB T1,T3 ;NUMBER OF ADDITIONAL ACTUALS ON STACK ABOVE
; THE ONE WE WANT
IMULI T1,NWORDS ;CONVERT TO NUMBER OF WORDS ON STACK
ADDI T1,-NWORDS(T2) ;OFFSET FROM CURRENT STACK
HRLI T1,(POINT 7,) ;MAKE INTO BYTE POINTER
IMULI T3,NWORDS ;CALCULATE LENGTH OF MACRO INVOCATION
SUBI T2,3(T3) ;GET ADDRESS OF PREVIOUS MACRO
HRLZS T2
CAML PM,[-4,,0] ;IS THERE ROOM ON STACK FOR ANOTHER NESTING?
MSG TOK5, EXCESSIVE MACRO NESTING
PUSH PM,C ;SAVE CURRENT SCAN PARAMETERS
PUSH PM,CHRPNT
PUSH PM,T2 ;SAVE BASE OF MASTER MACRO
MOVEM T1,CHRPNT ;FOR RENEWED SCANNING
JRST TOKEN ;GO EAT THE ACTUAL AS A TOKEN.
TOK5: MOVEI N,.TKB
JRST TOK99
TOK6: MOVEI T1,0 ;TRAILING SPACE FLUSHER FOR SYMBOLS
LDB T2,TOKPNT ;GET LAST CHAR IN SYMBOL
CAIN T2," "
DPB T1,TOKPNT ;REPLACE A TRAILING SPACE WITH NULL
MOVEI N,.TKS
JRST TOK99
TOK7: SKIPA N,TOKDEC ;PICK UP DECIMAL NUMBER
TOK8: MOVE N,TOKOCT ;PICK UP OCTAL NUMBER
SKIPGE TOKMIN
MOVNS N ;NEGATE IF MINUS FLAG SET
MOVEM N,NUMBER
MOVEI N,.TKN
TOK99: POPJ P,
;LOWEST LEVEL ROUTINE TO GET A CHARACTER
; IF REREAD FLAG SET, RETURNS LAST CHARACTER READ
GETCP: PUSHJ P,POPMAC ;POP OFF MACRO PARAMETERS
; NOW THAT IT HAS BEEN PROCESSED
MOVE C,PNTCNT ;GET POSITION ON PRINT LINE
SKIPN CHRPNT ;ARE WE BACK TO SOURCE?
MOVEM C,PNTTOK ;YES. NOTE BEGINNING OF TOKEN
GETCHR: TRZE F,REREAD
JRST [MOVE C,RRDC
POPJ P, ]
SKIPN C,CHRPNT ;RESCANNING ANYTHING?
JRST GETC5 ;NO, GET NEXT CHAR FROM FILE BUFFER
;HERE TO GET A CHARACTER FROM A TEXT STRING STORED INTERNALLY, NOTABLY EITHER
; A MACRO OR ONE OF ITS ACTUALS. IF THE ENTIRE STRING HAS BEEN PROCESSED,
; THE LEFT HALF OF CHRPNT IS ZERO, AND THE NEXT CALL WILL UN-DO THE NESTING
; AND GET A CHARACTER FROM THE NEXT LOWER LEVEL. THE NESTING CANNOT BE
; UNDONE WHEN THE END OF THE STRING IS FOUND, BECAUSE THE NEST MAY INCLUDE
; MACRO ACTUALS WHICH MIGHT NOT BE EVALUATED UNTIL THE ENTIRE MACRO, INCLUDING
; ITS TERMINATOR, HAD BEEN PROCESSED.
TLNN C,-1 ;DID WE FINISH THE RESCAN?
JRST GETCP ;YES, RETURN TO PREVIOUS LEVEL
ILDB C,CHRPNT ;NO, GET ANOTHER CHAR FROM SYMBOL TABLE
JUMPN C,GETC9 ;GO PROCESS WITH IT UNLESS END OF TEXT
;HERE WHEN AN INTERNAL TEXT STRING HAS RUN OUT. RETURN THE TERMINATOR THAT
; CAUSED US TO USE IT, AND SETUP TO UN-NEST IT ON THE NEXT CALL TO GETCHR
HRRZS CHRPNT ;SO WE GO TO GETCP NEXT CALL
HRRZ C,0(PM) ;GET NUMBER OF ACTUALS STORED ON STACK
IMUL C,[-NWORDS] ; COMPUTE SPACE USED BY ACTUALS
SUBI C,2 ;ALLOW MORE SPACE FOR ACTUAL COUNT AND CHRPNT
HRLI C,PM ;STICK AN INDEX REGISTER IN THAT ADDRESS
MOVE C,@C ;GET THE TERMINATOR THAT GOT US HERE
JRST GETC9 ;GO PROCESS IT AGAIN
;HERE WHEN ALL NESTED STRINGS ARE EXHAUSTED, TO GET MORE FROM INPUT FILE
GETC5: SOSGE INBLK+2
JRST GETC7
ILDB C1,INBLK+1 ;GET CHAR FROM INPUT FILE
MOVE C,@INBLK+1 ;GET WORD WITH BYTE
TRNE C,1 ;LINE NUMBER?
JRST GETC5 ;YES--SKIP IT
GETC8: MOVEI C,7
CAIN C1,11 ;IS IT TAB INPUT?
ANDCAM C,PNTCNT ;YES. COUNT LISTING COLUMNS
LDB C,GETPNT ;TRANSLATE INPUT CHARACTER
JUMPE C,GETC5
MOVEM C1,EOLCHR ;SAVE LAST CHAR TO FIND WHAT ENDED LINE
CAIE C,12 ;DON'T SAVE 12,13, OR 14
SOSG PNTCNT ;ROOM IN LISTING FILE (LEAVE 1 CHAR ROOM)
JRST .+2 ;NO
IDPB C1,PNTPNT ;YES, SAVE INPUT CHAR IN OUTPUT LISTING
GETC9: POPJ P,
GETC7: IN INCHN,
JRST GETC5
GETSTS INCHN,C
TRZE C,740000
MSG .+1, INPUT FILE ERROR
SETSTS INCHN,(C)
TRNN C,1B22
JRST GETC5
PUSHJ P,NXTFIL
SKIPA C1,[12] ;END-OF-FILE RETURNS LINE-FEED
MOVEI C1,14 ;START WITH FORM FEED
JRST GETC8
;PRINT SOURCE LINE IN OUTPUT LISTING
PNTLIN: PUSH P,C
TRNN F,PASS2!ERROR
JRST PNTL2 ;NO LIST ON PASS1, RE-INIT LISTING
MOVE N,SRCCOL ;GET COLUMN NO TO PRINT SOURCE
SKIPL DOBIN ;IF LEAVING SPACE FOR BINARY,
PUSHJ P,TABTON ;TAB OUT TO THERE
MOVEI C,";" ;PRINT SOURCE AS COMMENT
PUSHJ P,PUTL
TRNN F,SUPP ;SUPPRESSED ASSEMBLY?
MOVEI C," " ;NO, JUST ONE SEMICOLON
PUSHJ P,PUTL
HRRZ C,LINNUM
PUSHJ P,PNTDEC
PUSHJ P,TAB
MOVEI C,0
IDPB C,PNTPNT
MOVEI N,PNTBUF
PUSHJ P,PRINT0
MOVEI C,15
PUSHJ P,PUTL
MOVE C,EOLCHR
CAIE C,14
MOVEI C,12 ;END LINE WITH 15,14, OR 15,12
PUSHJ P,PUTL
PNTL2: POP P,C
PNTINI: MOVE T1,[POINT 7,PNTBUF] ;INIT OUTPUT LIST LINE BUFFER
MOVEM T1,PNTPNT ;INIT OUTPUT BUFFER BYTE POINTER
MOVEI T1,PNTMAX
MOVEM T1,PNTCNT ;INIT OUTPUT BUFFER CHAR COUNT
POPJ P,
;SUBROUTINE TO PRINT BINARY IN OUTPUT FILE(S)
PNTBIN: SKIPGE DOBIN ;IS .NOBIN IN FORCE?
JRST PNTXIT ;YES--SKIP BINARY
AOS WRDCNT(RAM) ;COUNT MICRO WORDS
PUSH P,C
PUSH P,PUTP
MOVEI N,[ASCII /U /
ASCII /D / ](RAM)
PUSHJ P,PRINT0
IFN FTULD,<
MOVEI T1,PUTU ;OUTPUT ADDRESS IN BRACKETS TO ULD
MOVEM T1,PUTP
PUSHJ P,PRINT
ASCIZ /
[/
MOVEI T1,PUTLU
MOVEM T1,PUTP ;OUTPUT ADDRESS TO BOTH FILES
>;END FTULD
HRRZ C,PC(RAM) ;GET ADDRESS OF WORD
MOVE T1,ADRCOL ;GET # OF COL'S FOR ADDRESS
PUSHJ P,PNTOC3
MOVEI C,"," ;SEND COMMA TO LISTING ONLY
PUSHJ P,PUTL
MOVEI C," " ;SPACE TO LISTING
PUSHJ P,PUTL
IFN FTULD,<
MOVEI C,"]" ;CLOSE BRACKET TO ULD
PUSHJ P,PUTU
MOVEI C,"=" ;FOLLOWED BY EQUAL
PUSHJ P,PUTU
>;END FTULD
MOVE T1,GRPCNT(RAM) ;HOW MANY GROUPS TO PRINT?
MOVEM T1,MICCNT# ;SET COUNTER
MOVEI T2,0 ;START AT ZERO
TRNN F,RTOL ;UNLESS RIGHT TO LEFT NUMBERING
JRST PNTB1A
IMUL T1,GRPSIZ ;GET # OF BITS REPRESENTED BY GROUPS
MOVEI T2,MICMXB ;TOTAL # OF BITS STORED
SUBI T2,(T1) ;GET # STORED NOT TO PRINT
PNTB1A: MOVEM T2,MICPOS ;SET STARTING BIT POSITION FOR OUTPUT
JRST PNTB3
;LOOP TO OUTPUT MICROWORD
PNTB2: MOVEI C,","
PUSHJ P,PUTL ;TO LISTING FILE ONLY
; PUSHJ P,PUT
PNTB3: MOVE T1,GRPSIZ ;# OF BITS TO PUT OUT TOGETHER
ADDB T1,MICPOS ;BIT # AFTER LAST ONE THIS GROUP
IDIVI T1,^D36 ;CONVERT TO WORD AND POSITION
CAILE T1,0
SKIPA C,VALUE-1(T1) ;GET PREVIOUS BITS
MOVEI C,0 ; UNLESS THERE AREN'T ANY
CAIG T1,MICMXW
SKIPA C+1,VALUE(T1) ;GET NEXT BITS
MOVEI C+1,0
LSHC C,(T2) ;MOVE GROUP INTO LOW BITS OF C
MOVEI C+1,1 ;A MASK
LSH C+1,@GRPSIZ ;POSITION NEXT BEYOND GROUP
ANDI C,-1(C+1) ;SAVE GROUP BITS ONLY
PUSHJ P,PNTOC4
SOSLE MICCNT ;DONE ENOUGH GROUPS?
JRST PNTB2
PNTB99: POP P,PUTP ;RESTORE NORMAL OUTPUT ROUTINE
POP P,C
PNTXIT: POPJ P,
FINLST: SKPINC
JFCL ;CLEAR ^O FLAG
TRO F,ERROR!NOHDR ;FORCE NEXT MSG TO TTY, SUPPRESS HEADERS
SETZM LISTSW ;UNSUPPRESS LISTING
PUSHJ P,PRINT
ASCIZ /
; Number of microwords used: /
TRNN F,DRAMF
JRST FINCNT
PUSHJ P,PRINT
ASCIZ /
; D words= /
MOVE C,WRDCNT+DISP
PUSHJ P,PNTDEC
PUSHJ P,PRINT
ASCIZ /
; U words= /
FINCNT: MOVE C,WRDCNT+UCODE
PUSHJ P,PNTDEC
PUSHJ P,PRINT
ASCIZ /, Highest= /
MOVE C,HIGHPC+UCODE
PUSHJ P,PNTDEC
PUSHJ P,CRLF
TRZ F,ERROR ;"END" DOESN'T GO TO TTY CONSOLE
PUSHJ P,PRINT
ASCIZ /
END
/
TRZ F,NOHDR
;START CREF LISTING
MOVEI C,[ASCIZ /Cross Reference Listing/]
PUSHJ P,SETHDR
MOVEI FPNT,FLDPNT ;GET START OF SYM TABLE
CRFLUP: HRRZ FPNT,(FPNT) ;GET NEXT FIELD
JUMPE FPNT,CRFEND ;STOP AT END
MOVE SPNT,FPNT
LDB RAM,DEFTYP ;GET "UCODE" OR "DISP" NUMBER
MOVEI N,[ASCII /(U) /
ASCII /(D) / ] (RAM)
TRNE F,DRAMF ;IF NO DRAM, NO NEED TO DISTINGUISH
PUSHJ P,PRINT0
MOVEI N,SYMTXT(FPNT) ;GET TEXT ADDRESS
PUSHJ P,PRINT0 ; AND PRINT FIELD NAME
PUSHJ P,CRFLST ;LIST CREF FOR FIELD
CRSLUP: HLRZ SPNT,SYMLNK(SPNT) ;GET NEXT
JUMPE SPNT,CRFLUP ;GET NEXT FIELD IF NULL
MOVE T1,SYMTXT(SPNT)
PUSHJ P,TAB
MOVEI N,SYMTXT(SPNT) ;GET ADR OF SYMBOL
PUSHJ P,PRINT0
PUSHJ P,CRFLST
JRST CRSLUP
;HERE TO PRINT CREF FOR ONE SYMBOL
CRFLST: HRRZ N,SYMCRF(SPNT) ;GET POINTER TO 1ST ITEM
CRILUP: HRRZS N
JUMPE N,NEWLIN ;EXITS WITH POPJ
PUSH P,(N) ;SAVE LIST ITEM
MOVE T1,HORPOS ;GET HORIZONTAL POSITION
CAILE T1,^D120+1 ;ROOM FOR ANOTHER ITEM?
PUSHJ P,NEWLIN ;NO
CRILP2: PUSHJ P,TAB ;TAB BEFORE EACH ITEM
MOVE T1,HORPOS
CAIGE T1,NCHARS+8 ;SPACED OVER SYMBOLS?
JRST CRILP2 ;NO, ANOTHER TAB NEEDED
HLRZ C,(P) ;GET LINE NUMBER
TRZ C,1B18 ;CLEAR DEFINITION FLAG
PUSHJ P,PNTDEC
SKIPL 0(P) ;IS DEFINITION FLAG SET?
JRST CRILP3 ;NO
PUSHJ P,PRINT ;YES, FLAG IT
ASCIZ / #/
CRILP3: POP P,N
JRST CRILUP
;START LOCATION/LINE LISTING
CRFEND: MOVE T1,P2JFF ;RECLAIM SPACE
MOVEM T1,.JBFF ; USED FOR CREF
IFN FTMAP,<
MOVEI RAM,DISP
MOVEI C,[ASCIZ \Location / Line Number Index
; Dcode Loc'n 0 1 2 3 4 5 6 7\]
TRNE F,DRAMF ;ANY DRAM STUFF THIS ASSY?
PUSHJ P,UMAP ;YES, GO MAP DRAM
;NOW BUILD UCODE LOC/LINE TABLE
MOVE N,HIGHPC+UCODE ;HIGHEST ADDRESS ASSIGNED FOR UCODE
ADDI N,1 ;ADD 1 TO INCLUDE LOC 0
LSH N,-1 ;ALLOCATE 1/2 WORD FOR EACH LOC
PUSHJ P,GETWRD ;GET SPACE FOR TABLE
HRLI N,C ;MAKE INDIRECT POINTER INDEXED BY C
MOVEM N,GUPNT# ;SAVE FOR ACCESSING TABLE
HLRZ N,LALHED ;GET BEGINNING OF LOC'N ASSIGNMENT LIST
MAPLLP: HRRZ C,LALLOC(N) ;GET ADDRESS ASSIGNED TO THIS WORD
ROT C,-1 ;INDEX INTO TABLE OF HALFWORDS
JUMPL C,MAPL2 ;ODD ADDRESS STORED IN RH
HRLM N,@GUPNT ;SAVE ADDR OF LAL ENTRY FOR THIS LOC'N
JRST MAPL3
MAPL2: HRRM N,@GUPNT
MAPL3: HRRZ N,LALPNT(N) ;GET ADDR OF NEXT LAL ENTRY
JUMPN N,MAPLLP ;LOOP UNTIL NO MORE
MOVEI RAM,UCODE
MOVEI C,[ASCIZ \Location / Line Number Index
; Ucode Loc'n 0 1 2 3 4 5 6 7\]
PUSHJ P,UMAP ;THEN MAP UCODE
JRST SUMARY ;FOLLOWED BY RUNNING STATISTICS
;GENERATE LOC/LINE LISTING
UMAP: PUSHJ P,SETHDR
HRLO FPNT,HIGHPC(RAM) ;GET HIGHEST LOC'N USED
SETCA FPNT, ;USE AS LIMIT ON AOBJN POINTER
JRST LOCST
LOCLUP: TRNE FPNT,7 ;TIME FOR A NEW LINE?
JRST LOCL1 ;NO
PUSHJ P,NEWLIN ;YES
TRNN FPNT,70 ;DOUBLE SPACE AFTER 100 LOC'S
PUSHJ P,NEWLIN
LOCST: MOVEI N,[ASCIZ /U /
ASCIZ /D /](RAM)
PUSHJ P,PRINT0 ;MARK U/D
MOVEI C,(FPNT) ;GET LOCATION
PUSHJ P,PNTOC4 ;PRINT IN OCTAL, 4 DIGITS
;HERE AT BEGINNING OF LINE TO SEE WHETHER THERE IS A LARGE UNUSED
; SPACE, AND IF SO, TO SUMMARIZE IT IN A SINGLE LINE.
MOVE SPNT,FPNT ;COPY BASE ADDR OF THIS LINE
LOCS1: PUSHJ P,@GLINE(RAM) ;GET LINE NUMBER, IF ANY
JUMPN C,LOCS2 ;IS THIS LOC USED?
AOBJN FPNT,LOCS1 ;NO, SCAN UNTIL USED LOC'N FOUND
LOCS2: SUB FPNT,SPNT ;RH BECOMES # OF UNUSED LOCATIONS
TRNN FPNT,-20 ;IS IT MORE THAN 2 LINE'S WORTH?
JRST LOCS3 ;NO, JUST PRINT BLANKS IN UNUSED LOC'S
PUSHJ P,PRINT ;YES, USE ONE LINE TO COVER THE GROUP
ASCIZ / - /
MOVEI C,(FPNT) ;GET NUMBER OF UNUSED ADDRESSES
ANDI C,7 ;GET PARTIAL LINE USAGE
HRLI C,(C) ;REPLICATE BOTH HALVES
SUB FPNT,C ;REDUCE UNUSED PART TO EVEN MULTIPLE OF LINE
ADD FPNT,SPNT ;ADJUST LINE BASE FOR AREA SKIPPED
MOVEI C,-1(FPNT) ;GET LAST ADDRESS SKIPPED
PUSHJ P,PNTOC4
PUSHJ P,PRINT
ASCIZ / Unused/
JRST LOCLUP ;GO START A LINE OF USED LOCATIONS
LOCS3: MOVE FPNT,SPNT ;RESTORE BASE OF LINE
PUSHJ P,TAB
LOCL1: PUSHJ P,TAB ;SPACE OVER
PUSHJ P,@GLINE(RAM)
JUMPE C,LOCL2 ;DON'T PRINT IF NOT USED
PUSHJ P,PNTDEC ;PRINT LINE NUMBER
SKIPE C,PCTYPE ;GET "HOW ASSIGNED" FLAG, IF ANY
PUSHJ P,PUTL
LOCL2: AOBJN FPNT,LOCLUP ;GO TO NEXT
JRST CRLF ;RETURN PRINT TO LEFT MARGIN, PC TO CALLER
;SUBROUTINES USED BY LOC/LINE LISTER TO FIND LINE #
GLINE: Z GULINE ;GET UCODE LINE # FOR LOC IN FPNT
Z GDLINE ;SAME FOR DISP LINE #
GULINE: MOVEI C,(FPNT) ;COPY ADDRESS
ROT C,-1 ;DIVIDE BY 2, REMAINDER TO SIGN
SKIPGE C ;EVEN ADDRESS?
SKIPA C,@GUPNT ;GET ADDR OF LAL ENTRY FOR THIS WORD
MOVS C,@GUPNT
TRNN C,-1 ;IS THERE A LAL ENTRY FOR THIS WORD?
JRST GULIN2 ;NO, RETURN 0
LDB T1,[POINT 7,LALLIN(C),17]
MOVEM T1,PCTYPE ;SET "HOW ASSIGNED" CODE
HRRZ C,LALLIN(C) ;GET LINE NUMBER AT WHICH LOC'N ASSIGNED
POPJ P,
GULIN2: SETZB C,PCTYPE ;NO LINE NUMBER, NO ASSIGNMENT
POPJ P,
GDLINE: MOVEI C,(FPNT) ;COPY LOC'N
ROT C,-1 ;PREPARE INDEX INTO DTABL
SKIPGE C ;RIGHT OR LEFT?
SKIPA C,DTABL(C) ;RIGHT
MOVS C,DTABL(C) ;LEFT
TLZ C,-1 ;CLEAR OTHER HALF
SETZM PCTYPE ;PREVENT "HOW ASSIGNED" FLAG FROM PRINTING
POPJ P,
>;END IFN FTMAP
;HERE WHEN LISTING FINISHED
SUMARY: TRO F,ERROR!NOHDR ;FORCE NEXT MESSAGE TO TTY
SKIPN ERRCNT ;ANY ERRORS?
SKIPA N,[Z [ASCIZ /
No/]]
MOVEI N,[ASCIZ /
? /]
PUSHJ P,PRINT0
SKIPE C,ERRCNT
PUSHJ P,PNTDEC ;NUMBER OF ERRORS IF ANY
PUSHJ P,PRINT
ASCIZ / error/
MOVEI C,"s" ;PLURAL
MOVE N,ERRCNT
CAIE N,1 ;IS IT PLURAL?
PUSHJ P,PUTL ;YES
PUSHJ P,PRINT
ASCIZ / detected
End of microcode assembly
/
HRRZ C,PAGCNT
PUSHJ P,PNTDEC
PUSHJ P,PRINT
ASCIZ / pages of listing
Used /
MOVEI C,0
RUNTIM C, ;GET FINAL RUNTIME
; PUSHJ P,ADJT20 ;ADJUST FOR TOPS-20
SUB C,STTIME ;GET USED RUNTIME (MS)
ADDI C,5 ;ROUND TO HUNDREDTH OF SEC
IDIVI C,^D10
IDIVI C,^D100 ;GET HUNDREDTHS OF SEC
PUSH P,C+1 ;SAVE FRACTION
PUSHJ P,PNTDEC ;PRINT SECONDS
MOVEI C,"."
PUSHJ P,PUTL
POP P,C ;RECOVER FRACTION
PUSHJ P,PNTDC2
PUSHJ P,PRINT
ASCIZ / seconds, /
LDB C,[POINT 9,.JBREL,26] ;GET PAGES USED
ADDI C,1 ;PAGE 0 COUNTS AS A PAGE
PUSHJ P,PNTDEC
PUSHJ P,PRINT
ASCIZ / pages of core
Symbol table: /
MOVE C,SYMCOR
PUSHJ P,PNTCOR
ASCIZ /P
Text strings: /
MOVE C,TXTCOR
PUSHJ P,PNTCOR
ASCIZ /P
Loc'n assignment: /
MOVE C,LALCOR
PUSHJ P,PNTCOR
ASCIZ /P
Cross reference: /
MOVE C,CRFCOR
PUSHJ P,PNTCOR
ASCIZ /P
/
POPJ P, ;LISTING FINISHED
PNTCOR: ADDI C,400 ;ROUND CORE TO NEAREST PAGE
LSH C,-^D9 ;GET PAGE COUNT
PUSHJ P,PNTDEC
JRST PRINT ;THEN PRINT ASCIZ WHICH FOLLOWS CALL
;SEARCH FOR FREE MICRO WORDS.
; LOCPAT CONTAINS THE 1'S PATTERN
; LOCAST CONTAINS THE ASTERISK "DON'T CARE" PATTERN
; FRECNT CONTAINS THE SIZE OF THE BLOCK WITHIN WHICH
; THE PATTERN OF LOCPAT EXISTS. FRECNT IS ALWAYS
; A SINGLE BIT.
;SUBROUTINE RETURNS THE 1ST LOCATION MEETING CRITERIA AND SKIPS.
;IF CRITERIA CANNOT BE MET WITH ANY LOCATION, THEN NO SKIP
FREWRD: JUMPN RAM,STOP
TRNE F,SEQUEN
JRST STOP ;SHOULDN'T GET HERE IN SEQUENTIAL MODE
MOVE T1,LOCPAT ;GET PATTERN TO MATCH
IOR T1,LOCAST ;COUNT IN THE *'S
ANDI T1,FRESIZ-1 ;*** LOOK ONLY AT LOW BITS ***
MOVE T1,FRETAB(T1) ;GET LIST OF WORDS FITTING PATTERN
MOVEI T2,FRESIZ ;TABLE IS BUILT FOR 32 WORDS
SUB T2,FRECNT ;GET # OF WORDS TO THROW AWAY
SKIPL T2 ;*** NO SHIFT IF NEGATIVE ***
LSH T1,(T2) ; AND THROW THEM AWAY
MOVEM T1,FREMSK# ;SAVE PATTERN FOR MATCHING
;HERE BEGINS THE SEARCH, STARTING WITH THE FIRST REGION IN THE
; PREFERENCE TABLES (PRFTB), AND ADVANCING TO OTHERS AS NECESSARY
MOVEI N1,0 ;ESTABLISH INDEX INTO REGION TABLES
FNDL1: SKIPN PRFTB3(N1) ;IS THERE ANOTHER REGION?
MSG PCNXT1, NO ADDRESS MEETS CONSTRAINTS
SKIPA N,PRFTB1(N1) ;GET A START OF REGION ADDRESS
FNDL2: AOS N,FNDPC# ;TRY A LARGER ADDRESS
;HERE WE HAVE A TENTATIVE ADDRESS IN N.
; CHECK TO SEE WHETHER IT MATCHES THE CONSTRAINT
FNDL3: MOVN T1,FRECNT ;UNSPECIFIED BITS =1
ANDCB T1,LOCAST ;1S IN BITS SPECIFIED AS 0 OR 1
AND T1,N ;SELECT CONSTRAINED BITS OF ADDRESS
CAMLE T1,LOCPAT ;WILL FORCING THEM DECREASE THE ADDR?
AOJA N,FNDL3 ;YES, DON'T DO THAT
ANDCM N,T1 ;NO. CLEAR OUT CONSTRAINED BIT POSITIONS
IOR N,LOCPAT ; AND SET IN THE CONSTRAINT
CAML N,PRFTB2(N1) ;IS THIS WITHIN REGION STILL?
AOJA N1,FNDL1 ;NO, LOOK IN NEXT REGION
;HERE WE HAVE AN ADDRESS MEETING THE CONSTRAINT.
; CHECK TO SEE WHETHER THE REQUIRED LOCATIONS ARE FREE AT THIS ADDRESS
MOVEM N,FNDPC ;SAVE AS BASIS FOR SEARCH
FNDL4: MOVEI T3,(N) ;GET A COPY OF ADDRESS
IDIVI T3,^D36 ;FORM AN INDEX INTO USAGE
MOVE T1,USAGE(T3)
MOVE T2,USAGE+1(T3)
LSHC T1,(T4) ;GET 32 USAGE BITS INTO T1 BITS 0-31
TDNE T1,FREMSK ;ARE ALL REQUIRED BITS AVAILABLE?
JRST FNDL2 ;NO, GO TRY ANOTHER ADDRESS
;WITHIN A 32-WORD BLOCK, THE REQUIRED WORDS ARE FREE AT THIS
; ADDRESS. ARE THERE MORE LOCATIONS THAT NEED TO BE CHECKED?
MOVN T1,FRECNT ;ONES IN BIT POSITIONS LEFT OF PATTERN
ANDCB T1,LOCPAT ; NOW 1S WHERE PATTERN HAD 0 OR *
ANDCM T1,LOCAST ; 1S WHERE PATTERN HAD 0S
ANDI T1,-FRESIZ ;LOOK AT BITS BEYOND 32-BIT RANGE
MOVEI T2,(T1) ;MAKE A COPY OF TEST BITS
ANDCMI T2,(N) ;ANY ZEROS IN THAT PART OF ADDR?
JUMPE T2,FNDL6 ;NO, THIS ADDRESS MATCHES CONSTRAINT
;HERE WE HAVE TO LOOK AT ANOTHER 32-WORD BLOCK
MOVEI T2,(N) ;GET A COPY OF CURRENT ADDRESS
ANDCMI T2,(T1) ;SAVE BITS NOT ZERO IN PATTERN
ORCMI N,(T1) ;MAKE ONES OF ALL NON-ZEROS AFTER RIGHT 5
ADDI N,FRESIZ ;CHANGE SOME ZEROS
ANDI N,(T1) ;DISCARD NON-ZERO POSITIONS
IORI N,(T2) ;RESTORE UNCHANGING BITS
JRST FNDL4 ;GO LOOK AT ANOTHER BLOCK OF 32 WORDS
;HERE WE HAVE FOUND THE LOCATION WE WANT
FNDL6: MOVN T1,FRECNT ;GET 1'S LEFT OF CONSTRAINT
ANDCB T1,LOCPAT ;MAKE THAT 1'S IN 0 AND * POSITIONS
ANDCM T1,LOCAST ;LEAVE 1'S IN 0 POSITIONS ONLY
MOVSI N,-1 ;SETUP COUNT FOR PROGRESSION THROUGH BLOCK
JUMPE T1,FNDL8 ;WERE THERE ANY ZEROS IN PATTERN?
FNDL7: ANDI T1,-1(T1) ;CLEAR A BIT FROM ZERO MASK
ASH N,1 ;DOUBLE NUMBER OF LOC'NS ALLOCATED
JUMPN T1,FNDL7 ;LOOK FOR MORE
FNDL8: HRR N,FNDPC ;INSERT STARTING ADDR OF BLOCK
JRST CPOPJ1
RADIX 10
FRESIZ==32 ;TABLE SIZE IS 32
FRETAB: DEFINE FOOMAC (N)< XN=N
REPEAT N,< XBIT==XN
XB==0
REPEAT 2*N-XN,<XB==XB+<XN&XBIT/XN>B<<XBIT==XBIT+1>-N-1>
>
EXP XB_<<XN==XN+1>-N-1>
> >
IF1,< BLOCK FRESIZ >
IF2,< FOOMAC \FRESIZ
SUPPRESS XN,XBIT,XB >
RADIX 8
;SETUP A NEW LOCATION ADDRESS FOR STARTING NEXT MICRO WORD ASSEMBLY
GETPC: JUMPN RAM,PCNEXT ;
TRNE F,PASS2
JRST GETPC2
GETPC1: MOVEI N,LALSZ ;ON PASS1, SETUP A NEW LAL BLOCK
ADDM N,LALCOR ;TALLY CORE USED FOR LAL
PUSHJ P,GETWRD
MOVE T1,LALHED
HRRM N,LALPNT(T1) ;ADD NEW BLOCK TO END OF LAL LIST
HRRM N,LALHED ;UPDATE FOOT POINTER
HRRZ T2,LINNUM ;PUT CURRENT LINE NUMBER INTO BLOCK
HRRM T2,LALLIN(T1) ; AND SAVE IN JUST COMPLETED MICRO WORD
JRST GETPC9 ;EXIT
GETPC2: MOVE N,PC(RAM) ;GET PC FOR LAST U-WORD
HRRZ T1,LALHED ;GET LINE# FOR LAST U-WORD
HRRZ T2,LALLIN(T1) ; ...
CAME T2,LINNUM ;SAME LINE# AS FOR PASS 1?
MSG .+1, LINE NUMBER DIFFERENT ON PASSES 1 AND 2
HRRZ T1,LALHED ;GET FOOT POINTER
HRRZ T1,LALPNT(T1) ;GET POINTER TO NEXT WORD
HRRM T1,LALHED ; AND MAKE THAT NEW FOOT POINTER
MOVE N,LALLOC(T1) ;GET LOCATION ASSIGNMENT
MOVEM N,PC(RAM) ;AND SAVE IN NORMAL PLACE
GETPC9: POPJ P,
PCNEXT: MOVE N,PC(RAM)
SKIPN RAM ;IF DISPATCH RAM,
TRNE F,SEQUEN ; OR SEQUENTIAL MODE
AOJA N,PCNXT2 ;PC MERELY COUNTS
JUMPGE N,PCNXT1 ;IF NOT IN ADR BLOCK, FIND 1ST FREE WORD
MOVE T2,N ;FIND BITS IN PC THAT
AND T2,LOCAST ; SHOULD NOT CHANGE
IOR N,LOCAST ;INSERT BITS TO PROPOGATE CARRIES
AOBJP N,PCNXT1 ;IF .GE. 0, FIND 1ST FREE WORD
IOR N,LOCPAT ;RE-INSERT BITS THAT MUST BE 1'S
ANDCM N,LOCAST ;MAKE ROOM FOR PC BITS THAT MUST NOT
IOR N,T2 ; CHANGE, AND INSERT THEM
PCNXT2: MOVEM N,PC(RAM)
POPJ P,
PCNXT1: MOVEI N,0 ;START AT BEGINNING OF PREFERENCE LIST
PCNXT3: SKIPN T3,PRFTB3(N) ;GET NEXT AOBJN POINTER FOR PREF LIST
MSG CPOPJ, NO MORE MICROWORDS AVAILABLE
MOVE T1,PRFTB4(N) ;GET MASK FOR FIRST WORD OF USAGE TABLE
TDZA T1,USAGE(T3) ;CLEAR THE BIT IF ALREADY USED
PCNXT4: SETCM T1,USAGE(T3) ;LOOK FOR ZEROS IN USAGE
JFFO T1,PCNXT6 ;JUMP IF ANY UNUSED WORDS HERE
AOBJN T3,PCNXT4 ;ELSE LOOK AT NEXT WORD
PCNXT5: HRRZM T3,PRFTB3(N) ;MARK THIS REGION AS FULL
AOJA N,PCNXT3 ;GO LOOK IN NEXT PREFERENCE BLOCK
;HERE WHEN A ZERO FOUND IN USAGE
PCNXT6: MOVEM T3,PRFTB3(N) ;NOTE WHERE WE FOUND A SPACE
MOVEM T1,PRFTB4(N) ;AND UPDATE MASK
MOVEI T1,(T3) ;GET LOCN IN USAGE
IMULI T1,^D36 ;CONVERT TO ADDRESS
ADDI T1,(T2) ;GET ADDR FOR THIS BIT
CAML T1,PRFTB2(N) ;IS IT WITHIN PREFERENCE RANGE?
JRST PCNXT5 ;NO, GO TO NEXT RANGE
MOVEI N,(T1) ;YES. RETURN IT
JRST PCNXT2
;TEST PC LOCATION FOR PREVIOUS USAGE AND SET USAGE BITS
USEDPC: HRRZ N,PC(RAM)
CAMLE N,HIGHPC(RAM)
MOVEM N,HIGHPC(RAM) ;SAVE HIGHEST PC SO FAR
JUMPN RAM,USED1 ;DIFFERENT IF DISPATCH
IDIVI N,^D36
MOVN T1,N1 ;NEGATE REMAINDER FOR RIGHT SHIFTS
MOVSI N1,(1B0)
LSH N1,(T1)
TDNE N1,USAGE(N)
USDMSG: MSG USDXIT, MICRO WORD USED TWICE
IORM N1,USAGE(N)
JRST USDXIT
USED1: TRNN F,PASS2 ;COLLECT THIS ON PASS 2 ONLY
JRST USDXIT
ROT N,-1 ;DIVIDE BY 2
JUMPL N,USED2 ;ODD, USE RH
HLRZ N1,DTABL(N) ;PREVIOUS CONTENTS
JUMPN N1,USDMSG ;ERROR IF ALREADY SET
MOVE N1,LINNUM ;ELSE GET THIS LINE #
HRLM N1,DTABL(N) ;AND RECORD IT
JRST USDXIT ;OK RETURN
USED2: HRRZ N1,DTABL(N)
JUMPN N1,USDMSG
MOVE N1,LINNUM
HRRM N1,DTABL(N)
USDXIT: POPJ P,
PRINT: POP P,N
PUSHJ P,PRINT0
JRST 1(N)
CRLF: MOVEI N,[ASCIZ /
/]
PRINT0: HRLI N,440700
PRINT1: ILDB C,N
JUMPE C,CPOPJ
PUSHJ P,@PUTP
JRST PRINT1
PNTSX0: HRLI N,440600 ;SIXBIT PRINTER
PNTSX1: TLNN N,770000
POPJ P,
ILDB C,N
JUMPE C,CPOPJ
ADDI C,40 ;CONVERT TO ASCII
PUSHJ P,@PUTP
JRST PNTSX1
PNTOCT: TDZA T1,T1
PNTOC4: MOVEI T1,4
PNTOC2: PUSHJ P,SGNCHK
PNTOC3: IDIV C,RADIX
HRLM C+1,(P)
SOSG T1
SKIPE C
PUSHJ P,PNTOC3
JRST PNTDC4
PNTDEC: TDZA T1,T1
PNTDC2: MOVEI T1,2
PUSHJ P,SGNCHK
PNTDC3: IDIVI C,^D10
HRLM C+1,(P)
SOSG T1
SKIPE C
PUSHJ P,PNTDC3
PNTDC4: HLRE C,(P)
MOVMS C
CAILE C,^D9
ADDI C,"A"-"9"-1 ;10-15 BECOME A-F
ADDI C,"0" ;0-9 BECOME SAME CHARACTERS
JRST @PUTP
SGNCHK: JUMPGE C,CPOPJ
PUSH P,C
MOVEI C,"-"
PUSHJ P,@PUTP
POP P,C
MOVMS C
POPJ P,
TABTON: PUSHJ P,TAB
CAMLE N,HORPOS
JRST TABTON
POPJ P,
NEWLIN: PUSHJ P,CRLF ;SEND END OF LINE
MOVE N,VERPOS ;HOW FAR DOWN PAGE
CAIGE N,LPPAG ;COMPARE LINES PER PAGE LIMIT
POPJ P,
JRST FORM ;EJECT & PRINT NEW HEADER
SETHDR: HRRZM C,HDRPNT ;SAVE ADDR OF NEW SUBHEADER
FORM: SKIPN VERPOS ;ALREADY AT TOP OF PAGE?
POPJ P, ;YES, DON'T BE REDUNDANT
SKIPA C,[14] ;AND GET NEW PAGE
TAB: MOVEI C,11
JRST @PUTP
;HERE IS SINGLE-CHARACTER OUTPUT ROUTINE
PUTL: SKIPGE LISTSW ;IS LISTING ENABLED?
JRST [TRNN F,ERROR ;NO. SHOULD WE OUTPUT AN ERROR?
JRST PUTCHK ;NO, JUST GO COUNT THE PAGES
JRST PUT1] ;YES, CONSIDER LISTING ENABLED
PUT1: SKIPGE PAGNUM ;IS PAGE HEADER FLAG SET?
JRST HEADER ;NEW HEADER FOR NEW PAGE
PUT2: PUSHJ P,PUTCHK ;TAKE ANY SPECIAL ACTION REQUIRED FOR CHAR
PUT3: SKIPN OUTENA ;IS OUTPUT POSSIBLE?
JRST PUT5 ;NO, DON'T TRY
SOSG OUTBLK+2 ;IS BUFFER FULL?
OUT OUTCHN, ;YES, DO IT
JRST PUT4 ;ALL OK
SETZM OUTENA ;DISABLE OUTPUT. AN ERROR OCCURED
MSG CPOPJ, OUTPUT ERROR ON .MCR FILE
PUT4: IDPB C,OUTBLK+1
PUT5: TRNE F,ERROR
OUTCHR C
POPJ P,
;SUBROUTINE TO TRACK CHARACTER POSITION ON LINE AND PAGE
PUTCHK: TRNN C,140 ;SPACING CHARACTER?
JRST PUTC2 ;NO
AOS HORPOS ;INDEX HORIZONTAL LINE POSITION
POPJ P,
PUTC2: CAIN C,14
JRST [AOS PAGNUM
HRROS PAGNUM ;SET HEADER FLAG
SETZM SUBPAG
SETZM VERPOS
POPJ P, ]
CAIN C,15
SETZM HORPOS ;ZERO POSITION FOR CARRIAGE RETURN
CAIN C,12 ;LF?
JRST PUTC3 ;YES, COUNT NEW LINE
CAIE C,11
POPJ P, ;NOT HORIZONTAL TAB
EXCH C,HORPOS
IORI C,7
ADDI C,1
EXCH C,HORPOS
POPJ P,
;HERE ON LINE FEED. CHECK TO SEE WHETHER PAGE IS OVERFLOWED
PUTC3: AOS C,VERPOS
CAIG C,LPPAG ;TOO MANY LINES ON PAGE?
JRST [MOVEI C,12 ;NO, RESTORE LF
POPJ P,]
HRROS PAGNUM ;REQUEST A NEW PAGE HEADER
SOS SUBPAG ;COUNT SUBPAGES
SETZM VERPOS ;RESET PAGE POSITION TO TOP
MOVEI C,14 ;SUBSTITUTE FF FOR LF
POPJ P,
;PUT A CHARACTER INTO THE OUTPUT ULD ASCIZ FILE
IFN FTULD,<
PUTLU: PUSHJ P,PUTL ;PUT CHAR INTO LISTING
PUTU: TRNN F,DOULD ;WANT .ULD FILE?
POPJ P,0 ;NO--DO NOT DO IT THEN
JUMPE C,PUTPOP ;SUPRESS NULL CHARACTER
JUMPG RAM,PUTPOP ;BYPASS IF DRAM
SOSG BUFOUT+2 ;ADVANCE BYTE PTR
PUSHJ P,PUTU3 ;OUTPUT BUFFERFULL
IDPB C,BUFOUT+1 ;PUT BYTE INTO BUFFER
PUTPOP: POPJ P,
PUTU3: OUT OUTCH2, ;OUTPUT THE BUFFER
POPJ P, ;NO ERROR
TRZ F,DOULD ;SUPPRESS FURTHER OUTPUT
MSG CPOPJ1, OUTPUT ERROR ON .ULD FILE
>;END FTULD
;HERE TO PUT A CHARACTER INTO CORE STRING
PUTCOR: SOSLE PCORC ;CHECK COUNT
JRST PUTCR1 ;MORE ROOM IN PRESENT SPACE
PUSH P,N ;DESTROY NOTHING FOR THIS
MOVEI N,1
AOS TXTCOR
PUSHJ P,GETWRD ;GRAB MORE CORE
HRLI N,(POINT 7,) ;CONVERT ADDRESS TO BYTE POINTER
MOVEM N,PCORP ;SETUP POINTER
MOVEI N,5 ;NUMBER OF CHARACTERS THAT WILL GO IN WORD
MOVEM N,PCORC ;SET COUNT
POP P,N ;RESTORE N
PUTCR1: IDPB C,PCORP ;STORE CHAR INTO CORE STRING
POPJ P,
;PRINT HEADER ROUTINE
HEADER: CAIN C,14 ;IS THIS DOUBLE FORM FEED?
JRST HEADFF ;YES, DON'T CREATE BLANK PAGE
HRRZS PAGNUM
TRNN F,NOHDR ;HEADERS SUPPRESSED?
TRNN F,PASS2 ; OR PASS 1?
JRST PUT2 ;YES, DO NOT GENERATE HEADER
PUSH P,16 ;SAVE AC'S 0-16
MOVEI 16,1(P)
BLT 16,16(P)
ADD P,[16,,16]
TRZ F,ERROR ;DON'T SEND HEADER TO TTY
; WILL BE RESTORED WITH AC'S
PUSHJ P,PRINT
ASCIZ /; /
MOVEI N,OUTFIL ;GET ADR OF OUTPUT FILE DESCRIPTOR
PUSHJ P,HEDNAM ;AND PRINT THE DESCRIPTOR
MOVEI N,^D32
PUSHJ P,TABTON ;POSITION THE VERSION STUFF
PUSHJ P,PRINT
ASCIZ /MICRO /
PUSH P,RADIX ;SAVE RADIX
MOVEI C,^D8 ;AND FORCE OCTAL FOR VERSION OUTPUT
MOVEM C,RADIX
LDB C,[POINT 9,.JBVER,11] ;GET MAJOR VERSION #
PUSHJ P,PNTOCT
LDB N,[POINT 6,.JBVER,17]
SOJL N,HEAD2
IDIVI N,^D26
JUMPE N,HEAD3
MOVEI C,"A"-1(N)
PUSHJ P,PUTL
HEAD3: MOVEI C,"A"(N+1)
PUSHJ P,PUTL
HEAD2: MOVEI C,"("
PUSHJ P,PUTL
HRRZ C,.JBVER
PUSHJ P,PNTOCT
MOVEI C,")"
PUSHJ P,PUTL
LDB N,[POINT 3,.JBVER,2] ;GET CUSTOMER VERSION
JUMPE N,HEAD4
MOVEI C,"-"
PUSHJ P,PUTL
MOVE C,N
PUSHJ P,PNTOCT
HEAD4: POP P,RADIX ;RESTORE PREVAILING RADIX
MOVE N,SRCCOL ;SPACE OVER TO TITLE
PUSHJ P,TABTON
SKIPN N,TTLPNT ;IS THERE A TITLE?
MOVEI N,[ASCIZ /Microcode file/]
PUSHJ P,PRINT0 ;PRINT A TITLE
;HERE TO DO PAGE # & 2ND LINE OF HEADER
PUSHJ P,PRINT
ASCIZ / Page /
HRRZ C,PAGNUM
PUSHJ P,PNTDEC ;PRINT PAGE NUMBER
SKIPE C,SUBPAG ;IS THERE A SUBPAGE NUMBER?
PUSHJ P,PNTDEC ;YES. PRINT IT. NEGATIVE, SO GETS LEADING -
PUSHJ P,PRINT
ASCIZ /
; /
SKIPE N,HDRPNT ;SPECIAL HEADER?
JRST HEAD5 ;YES
MOVEI N,INFILE ;GET CURRENT INPUT FILE DESCRIPTOR
PUSHJ P,HEDNAM
HLRZ N,TOCPNT ;GET SUBTTL STRING ADDR
JUMPE N,HEAD6 ;MAKE SURE THERE'S SOMETHING TO PRINT
MOVEI N,1(N) ;POINT TO TEXT STRING
HEAD5: PUSH P,N ;SAVE SUBTITLE STRING ADDR
MOVE N,SRCCOL
ADDI N,^D8
PUSHJ P,TABTON ;TAB OVER FOR SUBTITLE
POP P,N ;GET BACK SUBTITLE STRING
PUSHJ P,PRINT0 ;PRINT SUBTTL OR SPECIAL HEADER
HEAD6:
;***************
; THIS CODE FILLS OUT BLANKS IF SUBTITLE IS SHORTER THAN
; 64 CHARACTERS SO THAT THE STUPID COM MACHINE WON'T GET
; GARBAGE FROM THE TITLE LINE INCLUDED IN ITS INDEX ENTRIES.
MOVE N,SRCCOL ;GET COLUMN WHERE SUBTITLE GOES
ADDI N,^D64 ;FIND POSITION 64 LATER
CAMLE N,HORPOS ;ARE WE THERE YET?
PUSHJ P,TABTON ;NO, GET THERE
;***************
PUSHJ P,CRLF
PUSHJ P,CRLF
AOS PAGCNT ;COUNT TOTAL PAGES OUTPUT
SUB P,[16,,16]
MOVSI 16,1(P)
BLT 16,15
POP P,16
JRST PUT2 ;RESUME WHERE WE LEFT OFF
;HERE WHEN ABOUT TO THROW A PAGE AND PRINT THE HEADER, AND WE
;DISCOVER THAT NEXT CHARACTER IS A FORM FEED
HEADFF: SKIPN SUBPAG ;WERE WE ABOUT TO PRINT A SUBPAGE HEADING?
POPJ P, ;NO, THIS IS DOUBLE FORM FEED IN INPUT. IGNORE
SETZM SUBPAG ;YES, TREAT AS A NEW PAGE
AOS PAGNUM
POPJ P, ;IGNORE THIS FF. WE PUT ONE IN FOR SUBPAGE
;SUBR TO PRINT FILENAME, TIME, AND DATE
HEDNAM: PUSH P,N ;SAVE DESCRIPTOR POINTER
ADDI N,.RBNAM ;POINT TO FILE NAME
PUSHJ P,PNTSX0
MOVEI C,"."
PUSHJ P,@PUTP
MOVE N,(P)
PUSH P,.RBEXT(N)
HLLZS (P) ;GUARANTEE EXTENSION IS ONLY 3 CHARS
MOVEI N,0(P)
PUSHJ P,PNTSX0
POP P,N ;RESTORE STACK
MOVE N,(P)
SKIPN .RBPPN(N)
JRST HEDNM2
PUSH P,RADIX ;PPN IS ALWAYS OCTAL
MOVEI C,^D8
MOVEM C,RADIX ;FORCE IT
MOVEI C,"[" ;OUTPUT PROJ,PROG
PUSHJ P,@PUTP
HLRZ C,.RBPPN(N)
PUSHJ P,PNTOCT
MOVEI C,","
PUSHJ P,@PUTP
HRRZ C,.RBPPN(N)
PUSHJ P,PNTOCT
MOVEI C,"]"
PUSHJ P,@PUTP
POP P,RADIX ;RESTORE PREVAILING RADIX
;HERE TO PRINT DATE AND TIME OF FILE
HEDNM2: PUSHJ P,TAB
POP P,N ;GET POINTER TO BLOCK BACK
LDB C,[POINT 12,.RBPRV(N),35] ;GET LOW PART OF DATE
LDB C1,[POINT 3,.RBEXT(N),20] ;GET HIGH PART OF DATE
DPB C1,[POINT 3,C,23] ;AND STICK ONTO LOW PART
JUMPE C,CPOPJ ;IF 1-JAN-1964, SUPPRESS DATE AND TIME
PUSH P,C ;SAVE DATE
LDB C,[POINT 11,.RBPRV(N),23]
IDIVI C,^D60 ;GET MINUTES INTO C+1
PUSH P,C+1
PUSHJ P,PNTDC2 ;PRINT HOURS
MOVEI C,":"
PUSHJ P,@PUTP
POP P,C ;GET MINUTES BACK
PUSHJ P,PNTDC2 ; AND PRINT
MOVEI C," "
PUSHJ P,@PUTP
POP P,C ;GET DATE BACK
IDIVI C,^D31
PUSH P,C ;SAVE MONTH AND YEAR
MOVEI C,1(C+1) ;GET DAY
PUSHJ P,PNTDEC ; AND PRINT
POP P,C ;GET MONTH AND YEAR BACK
IDIVI C,^D12
PUSH P,C ;SAVE YEAR
MOVEI N,[SIXBIT /-JAN-/
SIXBIT /-FEB-/
SIXBIT /-MAR-/
SIXBIT /-APR-/
SIXBIT /-MAY-/
SIXBIT /-JUNE-/
SIXBIT /-JULY-/
SIXBIT /-AUG-/
SIXBIT /-SEPT-/
SIXBIT /-OCT-/
SIXBIT /-NOV-/
SIXBIT /-DEC-/ ] (C+1) ;INDEX INTO TABLE BY MONTH
PUSHJ P,PNTSX0
POP P,C ;GET YEAR BACK
ADDI C,^D1964 ;ADD IN BASE YEAR
PUSHJ P,PNTDEC
POPJ P,
;HERE TO PRINT ERROR MESSAGE
;CALLED BY LUUO
UUOH: TRO F,ERROR
AOS ERRCNT
PUSH P,C ;SAVE REGS
PUSH P,N
PUSH P,T1
PUSH P,PUTP ;SAVE PREVAILING OUTPUT ROUTINE
MOVEI T1,PUTL ;MAKE IT LISTING
MOVEM T1,PUTP
MOVE N,40 ;GET ERROR LUUO
HRRZ T1,(N)
MOVEM T1,-4(P) ;SAVE RETURN
;FIRST LINE -- MESSAGE TEXT AS SPECIFIED BY CALLER
MOVEI C,";"
PUSHJ P,PUTL
HLRZ N,(N) ;GET ADR OF MSG
PUSHJ P,PRINT0
;SECOND LINE -- CONTEXT OF ERROR
PUSHJ P,PRINT
ASCIZ /
; /
MOVEI N,[ASCII /U= /
ASCII /D= / ](RAM)
PUSHJ P,PRINT0
HRRZ C,PC(RAM)
PUSHJ P,PNTOC4
MOVEI N,[ASCIZ /, /]
SKIPN NAME
SKIPE FIELD
PUSHJ P,PRINT0 ;GIVE COMMA SPACE IF FIELD OR NAME TO BE PRINTED
MOVEI N,FIELD
PUSHJ P,PRINT0
MOVEI C,"/"
SKIPE FIELD
PUSHJ P,PUTL
MOVEI N,NAME
PUSHJ P,PRINT0
;ERROR MESSAGE OUTPUT, CONTINUED
MOVE N,I.MAXC ;# OF SOURCE FILES
CAIG N,1 ; MORE THAN ONE?
JRST UUOHP ;NO. NO NEED TO IDENTIFY WHICH
PUSHJ P,PRINT ;YES. IDENTIFY IT
ASCIZ /, FILE= /
MOVEI N,INFILE+.RBNAM ;ADDR OF CURRENT INPUT NAME
PUSHJ P,PNTSX0 ;PRINT IT
MOVEI C,"."
PUSHJ P,PUTL ;MARK EXTENSION
PUSH P,INFILE+.RBEXT ;PUT EXT ONTO STACK
HLLZS 0(P) ;STRIP IT TO 3 CHARS
MOVEI N,0(P) ;GET ITS ADDRESS
PUSHJ P,PNTSX0 ;NOW PRINT EXTENSION
POP P,N ; RESTORE P
UUOHP: TRNN F,PASS2
JRST UUOHL ;PAGE # MEANINGLESS ON PASS 1
PUSHJ P,PRINT
ASCIZ /, PAGE= /
HRRZ C,PAGNUM
PUSHJ P,PNTDEC
UUOHL: PUSHJ P,PRINT
ASCIZ /, LINE= /
HRRZ C,LINNUM
PUSHJ P,PNTDEC
IFN FTECHR,<
PUSHJ P,PRINT
ASCIZ /, CHAR= /
MOVE C,-2(P) ;GET C BACK
MOVEI T1,3 ;TYPE 3 OCTAL DIGITS
PUSHJ P,PNTOC2
>;END IFN FTECHR
; NOW PRINT STARS OVER BAD TOKEN
SKIPGE DOBIN
TDZA T1,T1 ;IF NO BINARY, SOURCE STARTS AT FIRST TAB
MOVE T1,SRCCOL ;SPACE TAKEN BY BINARY OUTPUT
IORI T1,7 ;ROUNDED TO NEXT TAB
ADDI T1,^D9+PNTMAX ; ANOTHER TAB, THEN LENGTH OF SRC BUFFER
SUB T1,PNTTOK ;MINUS AMOUNT LEFT IN SRC BUFFER
SUB T1,HORPOS ;MINUS AMOUNT ALREADY USED
; IS DISTANCE FROM HERE TO THERE
JUMPG T1,UUOHM
ADD T1,HORPOS ;IF NEG, GO BACK TO BEGINNING OF LINE
SUBI T1,1 ; (ALLOW FOR SEMICOLON AT BEGIN OF LINE)
PUSHJ P,PRINT
ASCIZ /
;/
UUOHM: MOVEI C," "
PUSHJ P,PUTL ;SPACE OVER TO BEGINNING OF BAD TOKEN
SOJG T1,.-1
MOVE T1,PNTTOK ;THERE'S BEGINNING OF TOKEN
SUB T1,PNTCNT ; HERE'S END. DIFFERENCE IS LENGTH
MOVEI C,"*"
PUSHJ P,PUTL ;MARK BAD TOKEN WITH STARS
SOJG T1,.-1
PUSHJ P,CRLF
POP P,PUTP ;RESTORE OUTPUT ROUTINE
POP P,T1 ;RESTORE REGS
POP P,N
POP P,C
POPJ P,
STOP: SKPINC ;TURN OFF ^O
JFCL
XX=-1
REPEAT ^D16,< MOVEM <XX=XX+1>,SAVACS+XX >
MSG .+1,< INTERNAL ERROR, "SAVE" CORE IMAGE
AND CALL JUD LEONARD, MAYNARD, X6819>
EXIT
BEGIO: SETZM I.SPEC ;START LOOKING AT 1ST FILE
MOVE T1,I.MAXC
MOVNM T1,I.CNT ;INIT COUNTER TO NUMBER OF FILES
NXTFIL: SETOM ENDFIL ;SET END-OF-FILE INDICATOR
SKIPL I.CNT
POPJ P, ;NO FILES LEFT
PUSHJ P,ALLIN ;GET NEXT INPUT FILE DESCRIPTOR
PUSHJ P,GETFIL
TRNE F,PASS2
JRST NXTF1 ;ON PASS 2, DON'T NEED TO CREATE FILE LIST
PUSH P,[.LLFIL] ;BUILD ENTRY FOR LALLST
PUSH P,I.SPEC
PUSHJ P,LALSTO
NXTF1: SETZM T1
SKIPN T2,I.DEV(C)
MOVSI T2,'DSK'
MOVEM T2,INDEV ;SAVE INPUT DEVICE
MOVEI T3,INBLK
OPEN INCHN,T1
MSG CPOPJ, CAN NOT OPEN INPUT DEVICE
SKIPN T1,BUFADR ;GET SAVED .JBFF FOR BUFFER AREA
JRST [MOVE T1,.JBFF##
MOVEM T1,BUFADR
ADDI T1,203*NINBUF ;ALLOW FOR N DISK BUFFERS, AT LEAST
JRST .+2]
EXCH T1,.JBFF## ;AND RECLAIM BUFFER SPACE
INBUF INCHN,NINBUF ;ALLOCATE N INPUT BUFFERS
CAML T1,.JBFF
MOVEM T1,.JBFF ;SAVE LARGEST .JBFF
MOVEI T1,.RBPRV ;SIZE OF LOOKUP BLOCK
MOVEM T1,INFILE+.RBCNT
LOOKUP INCHN,INFILE
MSG CPOPJ, CAN NOT LOOKUP INPUT FILE
SETZM ENDFIL ;CLEAR END-OF-FILE INDICATOR
TRNE F,PASS2 ;PASS1?
JRST CPOPJ1 ;NO, DON'T BOTHER
PUSHJ P,MAKTOC ;ENTER NEW SOURCE INTO TABLE OF CONTENTS
PUSH P,PUTP ;SAVE CURRENT OUTPUT ROUTINE
MOVEI T1,PUTCOR ;OUTPUT TO CORE
MOVEM T1,PUTP
SETZM PCORC ;FORCE IT TO GET MORE CORE
PUSHJ P,TAB
MOVEI N,INFILE
PUSHJ P,HEDNAM ;ADD FILE NAME
MOVEI C,0
PUSHJ P,PUTCOR ;TERMINATE CORE STRING AS ASCIZ
POP P,PUTP ;RESTORE OUTPUT ROUTINE
CPOPJ1: AOS (P) ;FILE FOUND, SKIP RETURN
CPOPJ: POPJ P,
;HERE TO GET A FILE SPEC READY FOR INPUT
GETFIL: MOVE C,I.SPEC ;ADDRESS AT WHICH SPECIFIER DATA IS STORED
MOVE T1,I.NAM(C)
SKIPN I.NAM+1(C)
MOVE T1,[SIXBIT /MICRO/]
MOVEM T1,INFILE+.RBNAM
HLLZ T2,I.EXT(C)
SKIPN I.EXT(C)
MOVSI T2,'MIC'
MOVEM T2,INFILE+.RBEXT
SETZB T3,INFILE+.RBPRV
MOVE T4,I.PPN(C)
MOVEM T4,INFILE+.RBPPN ;SAVE PROJ,PROG
POPJ P,
ALLIN: HRRZ T1,.JBFF## ;GET DEFAULT INPUT SPEC LOCATION
SKIPN I.FILE
MOVEM T1,I.FILE ;SET DEFAULT INPUT SPEC LOC
SKIPN T1,I.SPEC ;LOOKING FOR 1ST SPEC?
SKIPA T1,I.FILE ;YES, START AT BEGINNING
ADDI T1,I.LEN ;GET ADR OF NEXT SPEC
MOVEM T1,I.SPEC ; AND SAVE
ADDI T1,I.LEN+1 ;ALLOW ROOM FOR WHOLE SPEC
CAML T1,.JBFF##
HRRZM T1,.JBFF ;PROTECT THIS FILE SPEC
CAMG T1,.JBREL##
JRST ALLIN2 ;THERE IS ENOUGH CORE
CORE T1,
MSG [EXIT], NOT ENOUGH CORE FOR COMMAND SCANNER
ALLIN2: AOS I.CNT
MOVE T1,I.SPEC ;POINT TO THIS DESCRIPTOR
MOVEI T2,I.LEN
POPJ P,
ALLOUT: TROE F,DOLST ;LIST FILE GIVEN?
JRST ALOUT1 ;YES--THIS IS .ULD FILE
MOVEI T1,O.DEV
MOVEI T2,O.LEN
POPJ P,
ALOUT1: TROE F,DOULD
MSG [EXIT],TOO MANY OUTPUT FILES GIVEN
MOVEI T1,U.DEV
MOVEI T2,U.LEN
POPJ P,0
.TNEWL::
POPJ P,
REPEAT 0,<
;GENERATE CONSISTENT RUN TIME UNDER TOPS-20
ADJT20: MOVE T1,[112,,11] ;IS THIS TOPS-20
GETTAB T1, ; ..
POPJ P,0 ;OLD TOPS-10
CAIE T1,40000 ;MAGIC NUMBER
POPJ P,0 ;TOPS-10
MOVEI T1,400000 ;THIS FORK
JSYS 172 ;GTRPI
SUB C,T3 ;DISCOUNT PAGER TIME
POPJ P,0 ;RETURN
> ;END REPEAT 0
DEFINE DEFLST,< ;TABLE OF SPECIAL DEFINE FUNCTIONS
DEF 0,,BITSET
DEF "+",DEFJ,PCINC
DEF "D",DEFF90,BITSET
DEF "T",,TIMSET
DEF "P",,PARITY
DEF "J",DEFJ,BITSET
DEF "F",DEFF80,FLDSET
>;END DEFLST DEFINITION
DEFINE DEF(A,B,C),< XWD A,C >
DEFTAB: DEFLST
DEFTND:
DEFINE DEF(A,B,C),<
IFB <B>,< Z CPOPJ >
IFNB <B>,< Z B >
>
DEFTB2: DEFLST
DEFTM1: POINT 6,SYMVAL(SPNT),5 ;TIME VALUE #1 (SYMBOL ONLY)
DEFTM2: POINT 6,SYMVAL(SPNT),11 ;TIME VALUE #2 (SYMBOL ONLY)
DEFPOS: POINT 9,SYMVAL(FPNT),8 ;MICRO WORD POSITION (FIELD ONLY)
DEFSIZ: POINT 6,SYMVAL(FPNT),17 ;MICRO WORD FIELD SIZE (FIELD ONLY)
DEFVAL: POINT 18,SYMVAL(SPNT),35 ;VALUE OF SYMBOL
; OR POINTS TO 1ST CHAR OF MACRO EXPANSION
; OR HANDLER ADR OF PSEUDO OP
; OR ANOTHER FIELD FOR A DEFAULT
DEFFLG: POINT 6,SYMFLG(SPNT),5 ;FLAGS FOR A SYMBOL
DEFTYP: POINT 6,SYMFLG(SPNT),11 ;"UCODE" OR "DISP" NUMBER
DEFFNC: POINT 6,SYMFLG(SPNT),17 ;FUNCTION TO EXECUTE
DEFPNT: POINT 18,SYMFLG(SPNT),35 ;SYMBOLIC FIELD DEFAULT POINTER
;FIELD NAME FOR MACRO DEFINITIONS
MACRO: ASCIZ /MACRO%/
REPEAT NWORDS-2,< 0>
SWTCH: ASCIZ /SWITCH%/
REPEAT NWORDS-2,< 0>
;CHARACTER TABLES
COL==1
COM==2
EOL==3
EQL==4
QOT==5
SLSH==6
TOKTYP: POINT 4,CHRTAB(C),3 ;GET CHARACTER TYPE FOR TOKEN BUILDER
STAPNT: POINT .SZTRM,CHRTAB(C),3+.SZTRM ;TERM TYPE FOR TOP LEVEL STATE
GETPNT: POINT 7,CHRTAB(C1),35 ;CHARACTER TRANSLATION
DIGPNT: POINT 4,CHRTAB(C),28 ;DIGIT VALUE OF CHARACTER
DEFINE BYTS (TYP,TERM,TRAN),<
XLIST
..X==.-CHRTAB
..N==0 ;"NUMERIC VALUE" OF CHAR
IFGE <..X-"0">,< IFLE <..X-"9">,< ..N==..X-"0" >>
IFGE <..X-"A">,< IFLE <..X-"F">,< ..N==..X-"A"+^D10 >>
IFGE <..X-"a">,< IFLE <..X-"f">,< ..N==..X-"a"+^D10 >>
BYTE (4)TYP(.SZTRM)TERM(^D21-.SZTRM)0(4)..N(7)TRAN
LIST >
CHRTAB: ;CHARACTER LOOK UP TABLE
;FIRST PARAMETER IS CHARACTER TYPE
;SECOND IS TERMINATOR SUB-TYPE
;THIRD IS TRANSLATED VALUE
BYTS ,,0 ; NUL
BYTS ,,1 ; SOH
BYTS ,,2 ; STX
BYTS ,,3 ; ETX
BYTS ,,4 ; EOT
BYTS ,,5 ; ENQ
BYTS ,,6 ; ACK
BYTS ,,7 ; BEL
BYTS ,,10 ; BS
BYTS ,,40 ; HT
BYTS ,EOL,12 ; LF
BYTS ,EOL,12 ; VT
BYTS ,EOL,12 ; FF
BYTS ,,00 ; CR
BYTS ,,16 ; SO
BYTS ,,17 ; SI
BYTS ,,20 ; DLE
BYTS ,,21 ; DC1
BYTS ,,22 ; DC2
BYTS ,,23 ; DC3
BYTS ,,24 ; DC4
BYTS ,,25 ; NAK
BYTS ,,26 ; SYN
BYTS ,,27 ; ETB
BYTS ,,30 ; CAN
BYTS ,,31 ; EM
BYTS ,,32 ; SUB
BYTS ,,33 ; ESC
BYTS ,,34 ; FS
BYTS ,,35 ; GS
BYTS ,,36 ; RS
BYTS ,,37 ; US
BYTS 1,," " ; SP=40
BYTS 7,,"!" ; !
BYTS ,QOT,042 ; "
BYTS 7,,"#" ; #
BYTS ,,"$" ; $
BYTS ,,"%" ; %
BYTS 7,,"&" ; &
BYTS ,,"'" ; '
BYTS 7,,<"("> ; (
BYTS 7,,<")"> ; )
BYTS 7,,"*" ; *
BYTS 3,,"+" ; +
BYTS ,COM,<","> ; ,
BYTS 4,,"-" ; -
BYTS 2,,"." ; .
BYTS ,SLSH,"/" ; /
BYTS 5,,"0" ; 0
BYTS 5,,"1" ; 1
BYTS 5,,"2" ; 2
BYTS 5,,"3" ; 3
BYTS 5,,"4" ; 4
BYTS 5,,"5" ; 5
BYTS 5,,"6" ; 6
BYTS 5,,"7" ; 7
BYTS 6,,"8" ; 8
BYTS 6,,"9" ; 9
BYTS ,COL,":" ; :
BYTS ,EOL,073 ; ;
BYTS ,,074 ; <
BYTS ,EQL,"=" ; =
BYTS ,,076 ; >
BYTS 7,,"?" ; ?
BYTS 11,,"@" ; @
BYTS 10,,"A" ; A
BYTS 10,,"B" ; B
BYTS 10,,"C" ; C
BYTS 10,,"D" ; D
BYTS 10,,"E" ; E
BYTS 10,,"F" ; F
BYTS 7,,"G" ; G
BYTS 7,,"H" ; H
BYTS 7,,"I" ; I
BYTS 7,,"J" ; J
BYTS 7,,"K" ; K
BYTS 7,,"L" ; L
BYTS 7,,"M" ; M
BYTS 7,,"N" ; N
BYTS 7,,"O" ; O
BYTS 7,,"P" ; P
BYTS 7,,"Q" ; Q
BYTS 7,,"R" ; R
BYTS 7,,"S" ; S
BYTS 7,,"T" ; T
BYTS 7,,"U" ; U
BYTS 7,,"V" ; V
BYTS 7,,"W" ; W
BYTS 7,,"X" ; X
BYTS 7,,"Y" ; Y
BYTS 7,,"Z" ; Z
BYTS 7,,133 ; [ (RESERVED FOR USE AS MACRO ARGUMENT DELIMITER)
BYTS ,,"\" ; \
BYTS 7,,135 ; ] (RESERVED FOR USE AS MACRO ARGUMENT DELIMITER)
BYTS ,,"^" ; ^
BYTS 7,,"_" ; _
BYTS ,,140 ; `
BYTS 10,,"A" ; A (LOWER CASE)
BYTS 10,,"B" ; B
BYTS 10,,"C" ; C
BYTS 10,,"D" ; D
BYTS 10,,"E" ; E
BYTS 10,,"F" ; F
BYTS 7,,"G" ; G
BYTS 7,,"H" ; H
BYTS 7,,"I" ; I
BYTS 7,,"J" ; J
BYTS 7,,"K" ; K
BYTS 7,,"L" ; L
BYTS 7,,"M" ; M
BYTS 7,,"N" ; N
BYTS 7,,"O" ; O
BYTS 7,,"P" ; P
BYTS 7,,"Q" ; Q
BYTS 7,,"R" ; R
BYTS 7,,"S" ; S
BYTS 7,,"T" ; T
BYTS 7,,"U" ; U
BYTS 7,,"V" ; V
BYTS 7,,"W" ; W
BYTS 7,,"X" ; X
BYTS 7,,"Y" ; Y
BYTS 7,,"Z" ; Z
BYTS ,,173 ; {
BYTS ,,174 ; |
BYTS ,,175 ; }
BYTS ,,176 ; ~
BYTS ,,000 ; DEL
IFN .-CHRTAB-^D128,<PRINTX CHARACTER TABLE MESSED UP>
IF1,
< .MXSTA==0
.MXTOK==0
.MXTRM==0
.MXDSP==0
DEFINE ITEM (STATE,TOKTYP,TRMTYP,DISP,NSTATE)<
IFG STATE-.MXSTA,<.MXSTA==STATE>
IFG TOKTYP-.MXTOK,<.MXTOK==TOKTYP>
IFG TRMTYP-.MXTRM,<.MXTRM==TRMTYP>
IFG <DISP-STDISP>/2-.MXDSP,<.MXDSP==<DISP-STDISP>/2>
IFG NSTATE-.MXSTA,<.MXSTA==NSTATE>
> ;END OF DEFINE ITEM
DEFINE EXPAND (N)
< BLOCK 1
> ;END OF DEFINE EXPAND
> ;END OF IF1
IF2,< DEFINE ITEM (STATE,TOKTYP,TRMTYP,DISP,NSTATE)<
.XE==<STATE_.SZTOK+TOKTYP>_.SZTRM+TRMTYP
.XN==^D36/<.SZDSP+.SZSTA>
.XV==<<DISP-STDISP>/2>_.SZSTA+NSTATE
INSERT \<.XE/.XN>,\<.XE-.XE/.XN*.XN>
> ;END OF DEFINE ITEM
DEFINE INSERT (Q,R)<
IFNDEF .ENT'Q,<.ENT'Q==0>
.ENT'Q==.ENT'Q+.XV_<^D36-<R+1>*<.SZDSP+.SZSTA>>
> ;END OF DEFINE INSERT
DEFINE EXPAND (N)<
IFNDEF .ENT'N,<.ENT'N==0>
EXP .ENT'N
> ;END OF DEFINE EXPAND
> ;END OF IF2
; OLD STATE TOKEN TERM DISP NEW STATE
ITEM 0, .TKB, EQL, DLBLK, 0
ITEM 0, .TKS, COL, DTAG, 0
ITEM 0, .TKN, COL, DLSET, 0
ITEM 0, .TKS, EQL, DDEFS, 0
ITEM 0, .TKS, SLSH, DCFLD, 1
ITEM 0, .TKS, QOT, DMDEF, 0
ITEM 0, .TKS, EOL, DSUDO, 0
ITEM 0, .TKS, COM, DMAC, 0
ITEM 0, .TKB, EOL, DNOP, 0
;?? ITEM 1, .TKS, EQL, DDEFS, 0
ITEM 1, .TKB, EQL, DDEFF, 0
ITEM 1, .TKS, COM, DFSYM, 2
ITEM 1, .TKS, EOL, DFSYM, 0
ITEM 1, .TKN, COM, DFNUM, 2
ITEM 1, .TKN, EOL, DFNUM, 0
ITEM 2, .TKS, SLSH, DFLD, 3
ITEM 2, .TKS, COM, DMAC, 2
ITEM 2, .TKS, EOL, DMAC, 2
ITEM 2, .TKB, EOL, DNOP, 2
ITEM 3, .TKS, COM, DFSYM, 2
ITEM 3, .TKS, EOL, DFSYM, 0
ITEM 3, .TKN, COM, DFNUM, 2
ITEM 3, .TKN, EOL, DFNUM, 0
IFN FTIF,< ;CONDITIONAL ASSEMBLY STATES
ITEM 4, .TKB, EQL, DCMNT, 4
ITEM 4, .TKS, COL, DNOP, 4
ITEM 4, .TKN, COL, DNOP, 4
ITEM 4, .TKS, EQL, DCMNT, 4
ITEM 4, .TKS, SLSH, DCSUP, 4
ITEM 4, .TKS, QOT, DCMNT, 4
ITEM 4, .TKS, EOL, DCMNT, 4
ITEM 4, .TKS, COM, DCMNT, 4
ITEM 4, .TKB, EOL, DCMNT, 4
>;END IFN FTIF
;STATE MEANING
; 0 START OF LINE/MICROWORD
; 1 SYMBOL/ SCANNED AT START OF LINE/MICROWORD
; 2 COMMA SEEN, SO IN MIDDLE OF MICROWORD
; 3 SYMBOL/ SCANNED IN MIDDLE OF MICROWORD
; 4 ASSEMBLY SUPPRESSED
DEFINE LOG2 (A,B)
< A==0
REPEAT ^D35,<IFGE B-1_A,<A==A+1>
> > ;END OF DEFINE LOG2
LOG2 .SZTOK,.MXTOK
LOG2 .SZSTA,.MXSTA
LOG2 .SZTRM,.MXTRM
LOG2 .SZDSP,.MXDSP
;POINTERS FOR ADDRESSING STATE TABLE AS BYTE ARRAY
STAMTB: PINDEX .SZDSP+.SZSTA,STATAB(T1)
STATAB: XLIST ;EXPANSION OF STATE TABLE
XX=-1
REPEAT 1+<1_<.SZSTA+.SZTOK+.SZTRM>/<^D36/<.SZDSP+.SZSTA>>>,
< EXPAND \<XX==XX+1>
>
LIST
;FAKED SYMBOL TABLE ENTRIES FOR PSEUDO OPS
DEFINE STE (TEXT,DISP,%NEXT,%A),<
XLIST
XWD %NEXT,0
%A: ASCII "TEXT"
REPEAT NWORDS-<.-%A>,< 0>
XWD 0,DISP
EXP DEFF_^D30
EXP 0
%%TAG==1
IFIDN <%NEXT><0>,<%%TAG==0>
IFN %%TAG,< %NEXT:>
LIST >
;PSEUDO SYMBOL TABLE FOR PSEUDO-OPS
PSUDO%: XWD .+1,0 ;FIELD NODE
STE .BIN,$BIN
STE .CREF,$CREF
STE .DCODE,$DCODE
STE .HEXADECIMAL,$HEX
STE .LIST,$LIST
STE .NOBIN,$NOBIN
STE .NOCREF,$NOCRF
STE .NOLIST,$NOLIS
STE .OCTAL,$OCTAL
STE .PAGE,$PAGE
STE .RANDOM,$RAND
STE .RTOL,$RTOL
STE .SEQUENTIAL,$SEQU
STE .UCODE,$UCODE,0
PSUDM%: XWD .+1,0 ;FIELD NODE FOR PSEUDO-MACROS
STE .PAGE,$PAGET
STE .TITLE,$TITLE
STE .TOC,$TOC,0
;FAKED SYMBOL TABLE ENTRIES FOR CONDITIONAL ASSEMBLY OPERATORS
IFN FTIF,<
PSUDF%: XWD .+1,0 ;FIELD NODE FOR PSEUDO-FIELDS
STE .CHANGE,$CHNG
STE .DEFAULT,$DEFLT
STE .ENDIF,$ENDIF
STE .IF,$IF
STE .IFNOT,$IFNOT
STE .MACHINE,$MACH
STE .REGION,$REGN
STE .SET,$SET
STE .WIDTH,$WIDTH,0
;SYMBOL TABLE ENTRIES USED WHILE ASSEMBLY IS SUPPRESSED
PSUDS%: XWD .+1,0 ;FIELD NODE
STE .ENDIF,$ENDIF
STE .IF,$IF
STE .IFNOT,$IFNOT,0
;SYMBOLS FOR .MACHINE PSEUDO-OP
MACHL: XWD .+1,0
STE KL10,M$KL10
STE STAR,M$STAR,0
>;END IFN FTIF
XLIST ;LITERALS
LIT
LIST
RELOC 0
PAT==.
PATCH: BLOCK 40 ;PATCH SPACE, INTENTIONALLY NOT ZERO'D
SAVACS: BLOCK ^D16 ;AC STORAGE DURING FATAL ERRORS
GOBLT: ;START OF BLT TO ZERO MEMORY
VAR
VERPOS: BLOCK 1 ;LINE NUMBER ON PAGE
HORPOS: BLOCK 1 ;COLUMN NEXT OUTPUT CHARACTER WILL GO INTO
FLDPNT: BLOCK 1 ;POINTS TO BEGINNING OF SYMBOL TABLE
MAXPOS: BLOCK 2 ;LARGEST BIT POSITION DEFINED FOR MICRO CODE
VALUE: BLOCK MICMXW ;HOLDS BINARY MICRO CODE UNDER CONSTRUCTION
VALSET: BLOCK MICMXW ;1S IN ALL FIELDS WHERE ITEMS INSERTED INTO "VALUE"
TIME1: BLOCK 1 ;TIME VALUE #1 MAXIMUM
TIME2: BLOCK 1 ;TIME VALUE #2 MAXIMUM
VALEND: ;END OF BLT TO INIT A MICRO WORD
TKZER: ;BLOCK TO ZERO FOR EACH TOKEN SCAN
TOKMIN: BLOCK 1 ;FLAG NUMERIC TOKEN IS NEGATIVE
TOKOCT: BLOCK 1 ;BUILDING OCTAL VALUE
TOKDEC: BLOCK 1 ; DECIMAL TOKEN VALUE
NUMBER: BLOCK 1 ;NUMERIC RESULT OF TOKEN SCANNER
NAME: BLOCK MACMAX ;ASCII TEXT FOR SYMBOL NAME
TKZEND: ;END OF BLT TO INIT A TOKEN
FIELD: BLOCK NWORDS ;ASCII TEXT FOR FIELD NAME
PC: BLOCK 2 ;MICRO WORD LOCATION COUNTER
STATE: BLOCK 1 ;SYNTAX SCANNER STATE
ENDFIL: BLOCK 1 ;NON-0 INDICATES END OF ALL INPUT DATA
CHRPNT: BLOCK 1 ;HOLDS 0, OR BYTE POINTER FOR RESCANS
INBLK: BLOCK 3 ;BLOCK FOR DOING INPUT FILE IO
OUTBLK: BLOCK 3 ;OUTPUT FILE BYTE POINTER, BYTE COUNT, ETC.
PDL: BLOCK 100 ;PUSH DOWN LIST
PDLEND:
PMDL: BLOCK 400 ;STACK FOR RECURSING ON MACROS
PMEND:
STTIME: BLOCK 1 ;RUNTIME AT START
PNTBUF: BLOCK <PNTMAX/5>+1 ;BUFFER FOR HOLDING LISTING TEXT
EOLCHR: BLOCK 1 ;HOLDS LAST CHAR IN PRINT LINE
RRDC: BLOCK 1 ;IF REREAD SET, THIS IS CHAR TO USE
PCORC: BLOCK 1 ;SPACE REMAINING IN CORE WORD FOR PUTCOR
PCORP: BLOCK 1 ;BYTE POINTER FOR PUTCOR
PUTP: BLOCK 1 ;ADDRESS OF CHARACTER OUTPUT ROUTINE
OUTENA: BLOCK 1 ;-1 IF OUTPUT FILE OPEN AND NO ERRORS
LISTSW: BLOCK 1 ;NEGATIVE TO INHIBIT LISTING
ERRCNT: BLOCK 1 ;COUNTS MSG UUOS FOR ERRORS
PAGNUM: BLOCK 1 ;SOURCE PAGE NUMBER IN RIGHT HALF
;-1 IN LEFT IS FLAG TO PRINT HEADER
SUBPAG: BLOCK 1 ;AUTOMATIC NUMBERING FOR PAGES NOT
; BROKEN UP BY USER. ZERO OR NEGATIVE
PAGCNT: BLOCK 1 ;COUNT OF PAGES OUTPUT
TTLPNT: BLOCK 1 ;ADDRESS OF TITLE TEXT
TOCPNT: BLOCK 1 ;LIST POINTER TO TABLE OF CONTENTS
HDRPNT: BLOCK 1 ;ADDRESS OF HEADER TEXT
LINNUM: BLOCK 1 ;SOURCE LINE NUMBER
RADIX: BLOCK 1 ;8 IF OCTAL, 16 IF HEX
GRPSIZ: BLOCK 1 ;NUMBER OF BITS (12 OR 16) IN LISTING GROUP
GRPCNT: BLOCK 2 ;NUMBER OF GROUPS TO PRINT FOR EACH RAM
WIDTH: BLOCK 2 ;CONTROL STORE WIDTH FOR EACH RAM
MICPOS: BLOCK 1 ;CURRENT BITPOSITION IN VALUE FOR LISTING
ADRCOL: BLOCK 1 ;COLUMNS ALLOWED FOR ADDRESS OUTPUT
SRCCOL: BLOCK 1 ;COLUMNS ALLOWED FOR BINARY OUT
FRECNT: BLOCK 1 ;COUNT OF REQUIRED CONSECUTIVE MICRO WORDS
LOCPAT: BLOCK 1 ;BIT PATTERN FOR LOCATION ASSIGNMENTS
LOCAST: BLOCK 1 ;BIT PATTERN FOR *'S IN LOCATION PATTERN
LALHED: BLOCK 1 ; XWD (POINTER TO HEAD OF ADDRESS
; ASSIGNMENT LIST), FOOT POINTER
PNTCNT: BLOCK 1 ;COUNT OF REMAINING SPACE IN PNTBUF
PNTPNT: BLOCK 1 ;BYTE POINTER INTO PNTBUF FOR LISTING
PNTTOK: BLOCK 1 ;PNTCNT AT START OF LAST TOP-LEVEL TOKEN
DOBIN: BLOCK 1 ;.BIN/NOBIN LEVEL
DOCREF: BLOCK 1 ;.CREF/NOCREF LEVEL
MACHT: BLOCK 1 ;SELECTOR FOR MACHINE-SPECIFIC FEATURES
WRDCNT: BLOCK 2 ;COUNT OF MICRO WORDS USED
HIGHPC: BLOCK 2 ;HIGHEST LOCATION ASSIGNED
MACPNT: BLOCK 2 ;ADDRESSES OF "MACRO%" FIELD HEADERS
JPNT: BLOCK 2 ;ADDRESSES OF "J" FIELD HEADERS
SWTPNT: BLOCK 1 ;ADDRESS OF "SWITCH%" FIELD HEADER
SUPSYM: BLOCK 1 ;ADDRESS OF SYMBOL TABLE ENTRY FOR
;SYMBOL WHICH TURNED OFF ASSY
PRFTB1: BLOCK PRFMAX ;START OF EACH PREFERENCE REGION
PRFTB2: BLOCK PRFMAX ;END OF EACH PREFERENCE REGION
PRFTB3: BLOCK PRFMAX+1 ;AOBJN POINTERS FOR PREF REGIONS IN USAGE
PRFTB4: BLOCK PRFMAX ;MASKS FOR STARTING WORD OF USAGE
LALCOR: BLOCK 1 ;CORE USED FOR LOCN ASSIGNMENT LIST
CRFCOR: BLOCK 1 ;CORE USED FOR CROSS REFERENCE LIST
SYMCOR: BLOCK 1 ;CORE USED FOR SYMBOL TABLE
TXTCOR: BLOCK 1 ;CORE USED FOR TEXT STRINGS
USAGE: BLOCK <MAXPC+1>/^D36+1 ;HOLDS 1S FOR EVERY MICRO WORD USED
USGEND:
DTABL: BLOCK <MAXDSP+1>/2 ;EACH HALF,LINE # AT WHICH WORD DEFINED
;IN DISPATCH TABLE (DCODE)
BUFADR: BLOCK 1 ;SAVE .JBFF FOR INPUT FILE BUFFERS
P2JFF: BLOCK 1 ;SAVE .JBFF AT START OF PASS2, TO BE RECLAIMED
; FOR BUILDING LOC/LINE INDEX
I.MAXC: BLOCK 1 ;COUNT OF NUMBER OF INPUT FILES
I.CNT: BLOCK 1 ;FILE COUNTER USED BY ALLIN
I.FILE: BLOCK 1 ;POINTER TO 1ST INPUT FILE SPEC
I.SPEC: BLOCK 1 ;POINTER TO INPUT FILE SPEC AREA
O.DEV: BLOCK 1
O.NAM: BLOCK 2
O.EXT: BLOCK 1
O.MOD: BLOCK 2
O.PPN: BLOCK 2
O.LEN==.-O.DEV
IFN FTULD,<
U.DEV: BLOCK 1 ;"ULD" FILE MISC
U.NAM: BLOCK 2
U.EXT: BLOCK 1
U.MOD: BLOCK 2
U.PPN: BLOCK 2
U.LEN==.-U.DEV
OUTFI2: BLOCK 5 ;OUTPUT FILE "ENTER" BLOCK FOR "ULD"
BUFOUT: BLOCK 3 ;"ULD" FILE BYTE PTR, CT, ETC.
>;END FTULD
I.DEV==0 ;INPUT DEVICE
I.NAM==1 ;INPUT FILE NAME/MASK
I.EXT==3 ;INPUT EXTENSION
I.MOD==4 ;STANDARD SWITCHES
I.PPN==6 ;INPUT PPN
I.LEN==10 ;LENGTH OF INPUT FILE DESCRIPTOR BLOCK
OUTDEV: BLOCK 1 ;OUTPUT DEVICE NAME
OUTFIL: BLOCK 5 ;OUTPUT FILE "ENTER" BLOCK
INDEV: BLOCK 1 ;INPUT DEVICE NAME
INFILE: BLOCK 5 ;INPUT FILE "LOOKUP" BLOCK
.RBCNT=0 ;NUMBER OF ADDITIONAL WORDS IN LOOKUP/ENTER BLOCK
.RBPPN=1 ;PROJECT, PROGRAMMER NUMBER
.RBNAM=2 ;FILE NAME
.RBEXT=3 ;EXTENSION, DATE1
.RBPRV=4 ;PROTECTION, CREATION TIME-DATE
IFN FTHASH,<
HSHTAB: BLOCK HSHLEN ;HASH TABLE
>
ENDBLT: ;END OF BLT TO ZERO MEMORY
END MICRO