github.com/PDP-10.its
1
0
Fork 0
mirror of https://github.com/PDP-10/its.git synced 2026-02-27 09:18:58 +00:00
Code Issues Releases Wiki Activity
Files
ebc307ff96b0e5f0539f53cdadf9c743d7372f46
PDP-10.its/src/kshack/micro.117
Lars Brinkhoff 79d0540360 Fix Y2K bug in microcode assemblers.
2018-06-12 07:58:19 +02:00

3532 lines
85 KiB
Plaintext
Executable File
Raw Blame History

This file contains invisible Unicode characters
This file contains invisible Unicode characters that are indistinguishable to humans but may be processed differently by a computer. If you think that this is intentional, you can safely ignore this warning. Use the Escape button to reveal them.
TITLE MICRO CODE ASSEMBLER
; TOM EGGERS/JSL 30 APRIL, 75
; modified for ITS OCTOBER 1975.
;4/21/79 Moon .SEQADR
;June 1984 Moon KS10 support:
; New format field descriptions
; Macros with arguments
; .BIN, .NOBIN, .WIDTH, .PAGELENGTH
; New multipass PC assignment
; .RAMFILE pseudo-op writes RAM file for KS10
;--------------------------------------------------
;Remaining to be done:
; Test whether .SEQADR still works
; Test whether KL10 microcode still assembles
;--------------------------------------------------
;CUSTVR==0 ;CUSTOMER VERSION
;DECVER==20 ;MAJOR VERSION
;DECMVR==0 ;MINOR VERSION
;DECEVR==156 ;EDIT NUMBER
;LOC <.JBVER==:137>
; BYTE (3) CUSTVR (9) DECVER (6) DECMVR (18) DECEVR
DEFINE SUBTTL A/
TERMIN
;AC DEFINITIONS
F==0 ;FLAG REGISTER
T1=1 ;GLOBAL TEMP
T2=T1+1 ;DITTO
T3=T2+1
T4=T3+1
RAM=7 ;CONTAINS RAM NUMBER CURRENTLY BEING ASSEMBLED
UCODE==0
DISP==1 ;BITS WITHIN AC RAM
FPNT=10 ;POINTS TO CURRENT FIELD NAME IN SYM TABLE
SPNT=11 ;POINTS TO CURRENT SYMBOL NAME IN SYM TABLE
C=12 ;HOLDS LAST CHARACTER READ FOR INPUT
C1=C+1
N=14 ;GLOBAL AC FOR PASSING ARGS
N1=N+1 ;DITTO
PM=16 ;STACK FOR MACROS AND RESCANS
P=17 ;PUSH DOWN POINTER
;IN AC F (RIGHT HALF)
REREAD==1 ;REREAD LAST INPUT CHARACTER
SUPP==2 ;SUPPRESS ASSEMBLY
BINF==200 ;BINARY WORD HAS BEEN STARTED
PASS2==400 ;0 FOR PASS1, 1 FOR PASS2
ERROR==1000 ;ERROR FOUND ON LINE
NOHDR==2000 ;SUPPRESS PRINTING TOP-OF-PAGE HEADERS
NOBINF==4000 ;.NOBIN FLAG
BLKF==10000 ;ASSIGNING LOCATION BLOCKS
LOOSF==20000 ;ASSIGNING UNCONSTRAINED LOCATIONS
LOCF==40000 ;PC KNOWN FLAG
DEFINE SWSET VAR,VAL
IFNDEF VAR,VAR==VAL
IF2,[ IFN VAR,[
PRINTX \SWITCH VAR IS ON
\] IFE VAR,[
PRINTX \SWITCH VAR IS OFF
\]]
TERMIN
SWSET 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
;DEFINE IO CHANNELS
OUTCHN==0
INCHN==1
TYIC==2
TYOC==3
ERRC==4
DEFINE MSG [A,B]
1000,,[[ASCIZ @B@],,A]
TERMIN
OUTSTR=2000,,0
HALT=3000,,0 ;THESE CRETINOUS BAG CHOMPERS STORE DATA IN THE RH OF HALT
EXIT=.BREAK 16,040000
DEFINE PINDEX SIZ,ADR
REPEAT 36./<SIZ>, POINT SIZ,ADR,<.RPCNT+1>*<SIZ>-1
TERMIN
DEFINE POINT (SIZ,ADR,POS=-1
<<43'-<.RADIX 10.,<POS>>>_36'+<.RADIX 10.,<SIZ>>_30'+ADR>TERMIN
DEFINE IOWD (A,B)
-<A>,,<B>-1 TERMIN
;STRUCTURE DEFINITIONS
MICMXB==144. ;MAX NUMBER OF BITS IN A MICRO WORD
MICMXW==MICMXB/36. ;MAX NUMBER OF WORDS FOR A MICRO WORD
NCHARS==20. ;MAX NUM OF CHARS IN A SYMBOL
NWORDS==<NCHARS+4>/5 ;MAX NUMBER OF WORDS TO HOLD A SYMBOL
NARGWD==16. ;UP TO 80 CHARACTERS OF MACRO ARGUMENTS
MAXPC==2047. ;MAXIMUM AMOUNT OF MICRO CODE-1
MAXDSP==512. ;MAX SIZE OF DISPATCH
LLOCTB==MAXPC*3 ;NUMBER OF LOCTAB ENTRIES
;STRUCTURE OF A SYMBOL TABLE ENTRY
OFFSET -.
SYMLNK::BLOCK 1 ;LEFT HALF CHAINS SYMBOLS WITHIN A FIELD TOGETHER
;RIGHT HALF CHAINS FIELDS TOGETHER
;POINTER TO 1ST FIELD IS IN FLDPNT
SYMMAC==SYMLNK ;FOR MACRO SYMBOLS, RIGHT HALF
;POINTS TO 1ST CHAR OF MACRO EXPANSION
SYMPSO==SYMLNK ;FOR PSEUDO OPS, RH IS HANDLER ADDR
SYMEQL==SYMLNK ;RH LINKS EQUAL TAGS IN J FIELD
SYMTXT::BLOCK NWORDS ;1ST WORD WITH ASCIZ TEXT FOR NAME
SYMVAL::BLOCK 1 ;CONTAINS VALUES FOR A SYMBOL
SYMCRF::BLOCK 1 ;LEFT IS POINTER TO LAST ITEM IN CREF LIST
;RIGHT IS POINTER TO 1ST ITEM
SYMLST==.-1 ;LAST LOCATION IN BLOCK
SYMLEN==.-SYMLNK ;# OF WORDS IN A SYMBOL BLOCK
OFFSET 0
;FLAGS IN SYMBOL FLAG FIELD
MULF==1
;TWO-SEGMENT FROBBERY
HGHSEG==700000 ;HIGH SEG STARTS HERE
%%HIGH==HGHSEG
%%LOW==100
%%PURE==0
DEFINE PURE
IFN %%PURE,.ERR TWO `PURE'S IN A ROW
.ELSE %%LOW==.
%%PURE==1
LOC %%HIGH
TERMIN
DEFINE IMPURE
IFE %%PURE,.ERR TWO `IMPURE'S IN A ROW
.ELSE %%HIGH==.
%%PURE==0
LOC %%LOW
TERMIN
SUBTTL INITIALIZATION
PURE
MICRO: .OPEN TYIC,[.UAI,,'TTY]
.LOSE %LSFIL
.OPEN TYOC,[%TJDIS+.UAO,,'TTY]
.LOSE %LSFIL
.SUSET [.RRUNT,,N] ;GET STARTING RUNTIME
MOVE T1,[-NZERPG,,<GOBLT+1777>/2000]
.CALL [ SETZ
'CORBLK
MOVEI %CBRED+%CBNDR+%CBWRT+%CBNDW
MOVEI %JSELF
MOVE T1
SETZI %JSNEW ]
.LOSE %LSSYS
SETZM GOBLT
MOVE T1,[GOBLT,,GOBLT+1]
BLT T1,ENDBLT-1 ;ZERO STORAGE AREA
MOVEM N,STTIME ;SAVE STARTING TIME
.CALL [ SETZ ? 'CNSGET ? MOVEI TYOC ? REPEAT 4,[MOVEM T1 ? ] SETZM T1 ]
MOVEI T1,0
SETZM DISTTY
TLNE T1,%TOERS
SETOM DISTTY
MOVEI 17,1
MOVEI 0,0
BLT 17,17 ;ZERO THE AC'S
MOVE P,[IOWD PDLEND-PDL-1,PDL]
MOVE PM,[IOWD PMEND-PMDL-1,PMDL]
.SUSET [.SMASK,,[%PIPDL]] ;DIE IF PDL OVERFLOW
.SUSET [.SDF1,,[%PIPDL]]
MOVE T1,[PUSHJ P,UUOH]
MOVEM T1,41
PUSHJ P,FNR. ;READ COMMAND LINE
;SETUP IO
SKIPN O.DEV
MSG [EXIT], NO OUTPUT FILE SPECIFIED
.CALL [ SETZ
SIXBIT/OPEN/
[.BAO,,OUTCHN]
O.DEV
O.NAM
O.EXT
SETZ O.PPN ]
PUSHJ P,OFOPER ;CAN'T OPEN
MOVE T1,[OUTCHN,,RCHST]
.RCHST T1,
MOVE T1,RCHST+1
MOVEM T1,OUTFIL+F.NAM
MOVE T1,RCHST+2
MOVEM T1,OUTFIL+F.EXT
MOVE T1,RCHST+3
MOVEM T1,OUTFIL+F.PPN
MOVE T1,O.DEV ;RCHST SCREWS DEVICE
MOVEM T1,OUTFIL+F.DEV
.CALL [ SETZ
'RQDATE
SETZM OUTFIL+F.TIM ]
.LOSE %LSFIL
PUSHJ P,PNTINI ;INIT OUTPUT LISTING
HRROI T1,1 ;START AT PAGE 1, NEED A HEADER
MOVEM T1,PAGNUM
MOVSI T1,-LLOCTB
MOVEM T1,LOCAOB
BEGPAS: SETZM STATE ;INIT STATE FOR SYNTAX ANALYSIS
SETZM PC+UCODE
SETZM PC+DISP
MOVE T1,LOCAOB
MOVEM T1,LOCPNT
MOVE T1,MAXPS1 ;INIT MAXPOS TO MAXPOS SEEN ON PREVIOUS PASS
MOVEM T1,MAXPOS
MOVE T1,MAXPS1+1
MOVEM T1,MAXPOS+1
MOVEI RAM,UCODE ;START WITH UCODE ASSEMBLY
MOVEI T1,1
MOVEM T1,LINNUM ;INIT LINE NUMBER TO 1
PUSHJ P,BEGIO ;INIT INPUT IO
MSG [EXIT], NO INPUT FILES
SETZM USAGE
MOVE T1,[USAGE,,USAGE+1]
BLT T1,USGEND-1 ;CLEAR USAGE TABLE
ANDI F,PASS2
SUBTTL TOP LEVEL ASSEMBLY LOOP
STATLP: SKIPE STATE
JRST STAT1
TRZ F,BINF\ERROR ;ONLY CLEARED IN STATE 0
SETZM VALUE
MOVE T1,[VALUE,,VALUE+1]
BLT T1,VALEND-1
MOVE T1,LINNUM
HRRZM T1,CRFLIN' ;CREF LINE # CHANGES ONLY ON MICRO WORDS
STAT1: PUSHJ P,TOKEN ;SCAN NEXT TOKEN
LSH N,.SZTRM ;MOVE TOKEN TYPE OVER
LDB T1,STAPNT ;GET TERM CHARACTER TYPE
IOR T1,N ;COMBINE STATE, TOKEN TYPE, AND TERM TYPE
IOR T1,STATE
IDIVI T1,36./<.SZDSP+.SZSTA>
LDB T1,STAMTB(T1+1) ;GET DISPATCH AND NEW STATE
DPB T1,[POINT .SZSTA,STATE,35.-.SZTOK-.SZTRM]
LSH T1,-.SZSTA
STAXCT: XCT STDISP(T1) ;DISPATCH TO HANDLE FIELD AND TERM
SKIPN STATE
PUSHJ P,PNTBIN ;BINARY PRINTED IFF PASS2 & STATE=0 & BINARY ASSEMBLED
CAIN C,";
PUSHJ P,SCNEND ;FLUSH A COMMENT
CAIE C,12
JRST STATLP ;AND START ALL OVER AGAIN
PUSHJ P,PNTLIN ;FINISH END OF LINE
SKIPN ENDFIL ;END-OF-FILE?
JRST STATLP ;NO
TRON F,PASS2
JRST START2 ;GO BEGIN PASS 2
SKIPGE LOCPNT
MSG STOP,!! PASS 2 DIDN'T READ ALL OF LOCTAB !!
DONE: PUSHJ P,FINLST
PUSHJ P,OUTCLS
.CLOSE OUTCHN,
SKIPE RAMFIL
PUSHJ P,WRAMFL
EXIT ;MICRO ASSEMBLY COMPLETELY DONE
SCND1: PUSHJ P,GETCHR
SCNEND: CAIE C,12 ;SEARCH FOR END OF LINE
JRST SCND1
POPJ P,
SUBTTL STATE TABLE DISPATCH
STDISP:
PUSHJ P,ILLFOR ;FOR ANY UNDEFINED FORMAT
DLBLK: PUSHJ P,LOCBLK
DTAG: PUSHJ P,TAG
DLSET: PUSHJ P,LOCSET ;"NUMBER:"
DCFLD: PUSHJ P,CFSPC ;COND ASSY OR FIELD
DFLD: PUSHJ P,FLDSPC ;FIELD/
DMDEF: PUSHJ P,DEFMAC
DSUDO: PUSHJ P,PSEUDO
DMAC: PUSHJ P,BEGMAC
DNOP: JFCL
DDEFF: PUSHJ P,DEFFLD
DDEFS: PUSHJ P,DEFSYM
DFSYM: PUSHJ P,FLDSYM
DFNUM: PUSHJ P,FLDNUM
DCMNT: PUSHJ P,SCNEND
ILLFOR: MSG SCNEND, ILLEGAL FORMAT
SUBTTL START PASS 2
;HERE TO START PASS 2 BY LISTING TABLE OF CONTENTS, IF ANY
START2: SKIPE N,TTLPNT ;IS THERE A TITLE?
OUTSTR (N) ;YES, SEND TO TTY
OUTSTR [ASCIZ /
/]
SKIPN TOCPNT ;ANYTHING FOR TABLE OF CONTENTS?
JRST TOCEND ;NO
MOVEI C,[ASCIZ /TABLE OF CONTENTS/]
PUSHJ P,SETHDR ;SETUP SPECIAL HEADER
HLRZ N,TOCPNT ;BEGIN SCAN OF TOC LIST
TOCLUP: PUSH P,N ;SAVE ADDR OF THIS ENTRY
PUSHJ P,PRINT
ASCIZ /; / ;OUTPUT AS COMMENT
MOVE N,0(P) ;PICK UP ENTRY ADDR
HRRZ C,0(N) ;LINE NUMBER OF DEFINITION
PUSHJ P,PNTDEC ;IN DECIMAL
PUSHJ P,TAB
MOVE N,0(P) ;ENTRY ADDR AGAIN
MOVEI N,1(N) ;POINT TO TEXT
PUSHJ P,PRINT0 ;PRINT IT
PUSHJ P,NEWLIN
POP P,N ;PICK UP LINK
HLRZ N,0(N) ;GET ADDR OF NEXT ENTRY
JUMPN N,TOCLUP ;PRINT IT IF IT EXISTS
PUSHJ P,PRINT
ASCIZ \; CROSS REFERENCE INDEX
; DCODE LOCATION / LINE # INDEX
; UCODE LOCATION / LINE # INDEX
\
SETZM HDRPNT ;TURN OFF SPECIAL HEADERS
TOCEND: PUSHJ P,FORM ;THROW A PAGE
;SET SIZE OF LOCTAB
MOVN T1,LOCPNT ;NUMBER OF WORDS USED, NEGATIVE
HRLZM T1,LOCAOB ;SET UP AOBJN POINTER TO THEM
JUMPE T1,BEGPAS ;NO INSTRUCTIONS GENERATED
MOVEI RAM,UCODE
TRZ F,BLKF+LOOSF ;ASSIGN INSTRUCTIONS WITH ABSOLUTE LOCATIONS
PUSHJ P,ASGPCS
TRO F,BLKF ;ASSIGN INSTRUCTIONS IN LOCATION BLOCKS
PUSHJ P,ASGPCS
TRC F,BLKF+LOOSF ;ASSIGN UNCONSTRAINED INSTRUCTIONS
PUSHJ P,ASGPCS
;DROPS THROUGH
;DROPS IN
;FINALLY, FILL IN UTABL
MOVEI C,40
MOVE N,LOCAOB
FUTAB1: LDB T1,[%%LCOP,,LOCTAB(N)]
XCT FUTAB2(T1)
AOBJN N,FUTAB1
JRST BEGPAS
FUTAB2: PUSHJ P,FUTAB7 ;%LCTAG
MOVEI C,": ;%LCABS
PUSHJ P,FUTAB3 ;%LCUCD
PUSHJ P,FUTAB4 ;%LCEQL
JFCL ;%LCERR
MSG STOP,BAD VALUE IN LOCTAB ;5
MSG STOP,BAD VALUE IN LOCTAB ;6
MSG STOP,BAD VALUE IN LOCTAB ;7
FUTAB3: MOVSI T1,%LCLOC
TDNN T1,LOCTAB(N)
MSG STOP, !! INSTRUCTION FAILED TO GET LOCATED !!
LDB T1,[%%LCPC,,LOCTAB(N)]
MOVE T2,LOCTAB(N) ;LINE NUMBER
HRL T2,C ;CHARACTER
MOVEM T2,UTABL(T1)
CAIN C,"=
JRST FUTAB6
FUTB3A: MOVEI C,40
POPJ P,
FUTAB4: LDB T1,[%%LCPT,,LOCTAB(N)]
LDB T2,[%%LCAS,,LOCTAB(N)]
LDB T3,[%%LCNB,,LOCTAB(N)]
JUMPE T3,FUTB3A ;PC UNRESTRICTED
MOVEI T4,1
LSH T4,(T3)
CAIN C,"=
CAMLE T4,FRECNT
JRST FUTAB5
MOVE T3,FRECNT
SUB T3,LOCCNT ;CURRENT RELATIVE PC
ANDCM T3,T2 ;MASK OUT DON'T CARE BITS
ANDI T3,-1(T4) ;MASK OUT BITS OFF LEFT END OF PATTERN
SUB T3,T1 ;NEGATIVE AMOUNT PC HAS TO ADVANCE
ADDM T3,LOCCNT ;ADVANCE IT
POPJ P,
FUTAB5: MOVEM T1,LOCPAT
MOVEM T2,LOCAST
MOVEM T4,FRECNT
SUB T4,T1
MOVEM T4,LOCCNT
MOVEI C,"=
POPJ P,
FUTAB6: MOVE T2,T1 ;SAVE CURRENT PC
IOR T1,LOCAST ;PROPAGATE CARRIES THROUGH * BITS
ADDI T1,1 ;NEXT PC IN BLOCK
SUB T2,T1
ADDB T2,LOCCNT ;NUMBER OF LOCS REMAINING IN BLOCK
SKIPG T2
MOVEI C,40 ;SWITCH BACK TO UNCONSTRAINED
POPJ P,
FUTAB7: MOVSI T1,%LCLOC
TDNN T1,LOCTAB(N)
MSG STOP, !! TAG FAILED TO GET LOCATED !!
POPJ P,
;ITERATE THROUGH LOCTAB ASSIGNING LOCATIONS TO MICROCODE, TAGS
ASGPCS: TRZ F,LOCF ;PC NOT KNOWN YET
SETZM LOCCNT
MOVE C,LOCAOB ;C AOBJN POINTER TO LOCTAB
MOVSI C1,-MAXPC/36.-1 ;C1 AOBJN POINTER TO USAGE TABLE
ASGPC1: MOVE SPNT,LOCTAB(C)
LDB T1,[%%LCOP,,SPNT]
XCT ASGPCT(T1)
AOBJN C,ASGPC1
POPJ P,
ASGPCT: PUSHJ P,ASGPC3 ;%LCTAG
PUSHJ P,ASGPC2 ;%LCABS
PUSHJ P,ASGPC4 ;%LCUCD
PUSHJ P,ASGPC6 ;%LCEQL
JFCL ;%LCERR
MSG STOP,BAD VALUE IN LOCTAB ;5
MSG STOP,BAD VALUE IN LOCTAB ;6
MSG STOP,BAD VALUE IN LOCTAB ;7
ASGPC2: HRRZ N,SPNT ;SET PC TO ABS LOCATION
TRO F,LOCF
SETZM LOCCNT ;NOT IN A BLOCK, THOUGH
POPJ P,
ASGPC3: PUSHJ P,ASGPC ;GET PC FOR TAG IN N
POPJ P,
DPB N,DEFVAL ;LOCATE TAG
ASGPC9: DPB N,[%%LCPC,,SPNT] ;AND REMEMBER LOCATION IN LOCTAB
TLO SPNT,%LCLOC
MOVEM SPNT,LOCTAB(C)
POPJ P,
ASGPC4: PUSHJ P,ASGPC ;GET PC FOR INSTRUCTION IN N
JRST ASGP4A ;DON'T ALLOCATE THIS INST THIS TIME
PUSHJ P,ASGPC9 ;SAVE THIS PC
MOVE T1,N ;FIND BIT IN USAGE TABLE
IDIVI T1,36.
MOVNS T2 ;NEGATE REMAINDER FOR RIGHT SHIFTS
MOVSI T3,(SETZ)
LSH T3,(T2)
;NEXT TWO LINES ARE A TEMPORARY DEBUG CHECK
TDNE T3,USAGE(T1)
.VALUE [ASCIZ/: MICRO WORD USED TWICE AT ASGPC4 /]
IORM T3,USAGE(T1)
;INCREMENT PC FOR NEXT INSTRUCTION
ASGP4A: SKIPG T4,LOCCNT ;IN LOCATION BLOCK?
JRST ASGPC5 ;NO, FORGET PC
ADD T4,N ;END OF BLOCK
MOVE T2,N ;FIND BITS IN PC THAT
AND T2,LOCAST ; SHOULD NOT CHANGE
IOR N,LOCAST ;INSERT BITS TO PROPOGATE CARRIES
ADDI N,1 ;NEXT PATTERN VALUE
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
SUB T4,N ;SPACE REMAINING IN BLOCK
MOVEM T4,LOCCNT
SKIPG T4 ;BLOCK EXHAUSTED?
ASGPC5: TRZ F,LOCF ;PC NOT KNOWN ANYMORE
POPJ P,
ASGPC6: LDB T1,[%%LCPT,,SPNT] ;LOCATION BLOCK SPECIFIED
LDB T2,[%%LCAS,,SPNT]
LDB T3,[%%LCNB,,SPNT]
JUMPE T3,ASGP6A ;PC UNRESTRICTED
MOVEI T4,1
LSH T4,(T3) ;SIZE OF THIS BLOCK
SKIPLE LOCCNT ;IF CURRENTLY IN A BLOCK
CAMLE T4,FRECNT ;AND IT'S BIGGER
JRST ASGPC7 ;THEN DON'T MAKE A NEW BLOCK
MOVE T3,FRECNT
SUB T3,LOCCNT ;CURRENT RELATIVE PC
ANDCM T3,T2 ;MASK OUT DON'T CARE BITS
ANDI T3,-1(T4) ;MASK OUT BITS OFF LEFT END OF PATTERN
SUB T3,T1 ;NEGATIVE AMOUNT PC HAS TO ADVANCE
ADDM T3,LOCCNT ;ADVANCE IT
SUB N,T3
POPJ P,
ASGP6A: SETZM LOCCNT ;PC BECOMES UNRESTRICTED
JRST ASGPC5
ASGPC7: MOVEM T1,LOCPAT ;FIND A NEW BLOCK WITH THESE PARAMETERS
MOVEM T2,LOCAST
MOVEM T4,FRECNT
SUB T4,T1
MOVEM T4,LOCCNT
TRNN F,BLKF
JRST ASGPC5 ;DON'T DO BLOCKS THIS TIME
PUSHJ P,FREWRD
JRST ASGPC8 ;CAN'T ALLOCATE
HRRZS N ;DON'T WANT COUNT IN LH
TRO F,LOCF
POPJ P,
;--- DOES THIS ACTUALLY WORK, OR DOES IT BARF AND DIE
;--- BEFORE THE USER SEES THE ERROR MESSAGE?
ASGPC8: MOVE T1,[%LCERR_15.,,[ASCIZ/NO SUCH REQUIRED MICRO WORD ADDRESS PATTERN/]]
MOVEM T1,LOCTAB(C) ;SAVE ERROR MESSAGE FOR PASS 2
JRST ASGPC5
;GET PC FOR TAG OR INSTRUCTION INTO N
;SKIP IF SUPPOSED TO DO THIS GUY THIS TIME
ASGPC: TLNE SPNT,%LCLOC ;TAG/INST ALREADY LOCATED?
POPJ P, ;YES, SKIP WHOLE THING
TRNE F,LOCF ;CURRENT PC KNOWN?
JRST CPOPJ1 ;YES, OKAY
TRNN F,LOOSF ;SUPPOSED TO ASSIGN?
POPJ P, ;NO, SKIP WHOLE THING THIS TIME
;YES, SEARCH FOR NEXT FREE WORD
ASGFR0: SETCM T1,USAGE(C1) ;GET 1'S FOR FREE PC BITS
JFFO T1,ASGFR1 ;IF ANY FREE HERE, XFER
AOBJN C1,ASGFR0 ;KEEP LOOKING UNTIL ALL GONE
MSG STOP,CRAM FULL--CANNOT ASSIGN UNCONSTRAINED PCS
ASGFR1: HRRZ N,C1 ;N GETS PC FOR THIS BIT
IMULI N,36.
ADD N,T2
TRO F,LOCF ;PC IS KNOWN NOW
SETZM LOCCNT ;NOT IN A BLOCK, THOUGH
JRST CPOPJ1
SUBTTL PROCESS "FIELD/" AND CONDITIONALS
;FIELD/ SCANNED. COULD BE CONDITIONAL ASSEMBLY
CFSPC: IFN FTIF,[
MOVEI FPNT,PSUDF% ;PSEUDO FIELD TABLE
PUSHJ P,SRCSY1 ;IS IT A DEFINED PSEUDO-FIELD?
JRST CFSPC1 ;NO, TRY FOR NORMAL FIELD
MOVE T1,SYMPSO(SPNT) ;YES, GET HANDLER ADDR
JRST 0(T1) ;GO TO IT
$DEFLT: MOVEI T1,1 ;SET SWITCH IF NOT DEFINED
JRST SWT
$SET: TDZA T1,T1 ;ERROR IF SWITCH PREVIOUSLY DEFINED
$CHNG: SETO T1, ;ERROR IF SWITCH NOT DEFINED
SWT: MOVEM T1,SWTFLG'
TRNE F,SUPP ;ALREADY SUPPRESSED?
JRST SCNEND ;YES, IGNORE THIS
PUSH P,RAM ;SWITCHES ARE NOT RAM-SPECIFIC
MOVEI RAM,0
SKIPE FPNT,SWTPNT ;IS THE SWITCH% FIELD DEFINED?
JRST SWT1 ;YES, AVOID SEARCH
MOVE T1,[SWTCH,,FIELD]
BLT T1,FIELD+NWORDS-1
PUSHJ P,MAKFLD ;CREATE INTIAL SWITCH FIELD
MSG STOP, !!CAN'T DEFINE "SWITCH%"!!
MOVEM FPNT,SWTPNT
SWT1: MOVE T1,[NAME,,FIELD]
BLT T1,FIELD+NWORDS-1
PUSHJ P,TOKEN ;GO GET SWITCH NAME
CAIE N,.TKS ;IT MUST BE SYMBOLIC
MSG SWT99, NO SYMBOL IN CONDITIONAL ASSEMBLY DEFINITION
PUSHJ P,SRCSYM ;GO LOOK FOR SYMBOL
JRST SWT2 ;NOT FOUND
SKIPLE SWTFLG ;FOUND. IS THIS A DEFAULT?
JRST SWT99 ;YES -- DEFAULT HAS BEEN PREVIOUSLY SET
TRNN F,PASS2 ;IS IT PASS1?
SKIPE SWTFLG ; AND A SET?
JRST SWT3 ;NO, GO CHANGE VALUE
MSG SWT3, SWITCH SET TWICE
SWT2: SKIPGE SWTFLG ;IS THIS A CHANGE?
MSG .+1, SWITCH CHANGED WITHOUT SET OR DEFAULT
PUSHJ P,MAKS1 ;FILL IN SYMBOL ENTRY
JRST SWT99 ;CAN'T CREATE IT
SWT3: CAIE C,"= ;DID SWITCH NAME TERMINATE WITH EQUAL?
MSG SWT99, FORMAT ERROR ON SWITCH SPECIFICATION
PUSHJ P,TOKEN ;GO GET SWITCH VALUE
CAIE N,.TKN
MSG SWT99, SWITCH VALUE MUST BE NUMERIC
MOVE N,NUMBER ;GET SWITCH VALUE
DPB N,DEFVAL ;PUT INTO VALUE OF SYMBOL
SWT99: POP P,RAM ;RESTORE CURRENT RAM
SWT100: SETZM STATE
SETZM FIELD
JRST SCNEND ;IGNORE REST OF LINE
;HERE FOR CONDITIONAL ASSEMBLY TEST PSEUDO-OPS
$ENDIF: MOVEI T1,1
JRST AIF1
$IF: TDZA T1,T1
$IFNOT: MOVNI T1,1
AIF1: MOVEM T1,SWTFLG ;FLAG TO INVERT ASSEMBLY SENSE
PUSHJ P,TOKEN
CAIE N,.TKS ;SWITCH MUST BE SYMBOLIC
MSG SCNEND, SWITCH MUST BE SYMBOLIC
SKIPE FPNT,SWTPNT
PUSHJ P,SRCSYM ;GO LOOK FOR SWITCH SYMBOL
MSG SCNEND, SWITCH NOT DEFINED
TRNN F,SUPP ;CURRENTLY SUPPRESSED?
JRST IF3 ;NO
CAME SPNT,SUPSYM ;IS THIS THE SYMBOL WHICH SUPPRESSED?
JRST SCNEND ;NO, IGNORE
IF3: MOVEM SPNT,SUPSYM ;SAVE SUPPRESSION SYMBOL
LDB T1,DEFVAL ;GET SWITCH VALUE
SKIPG SWTFLG ;VALUE IRRELEVANT ON ENDIF
SKIPE T1 ;SWITCH SET?
TRZA F,SUPP
TRO F,SUPP ;SUPPRESS ASSY
SKIPGE SWTFLG ;INVERT SENSE?
TRC F,SUPP
MOVEI T1,0
TRNE F,SUPP ;NOW...ARE WE SUPPRESSED?
MOVEI T1,4_<.SZTOK+.SZTRM>
MOVEM T1,STATE ;STATE 0 IF ASSEMBLING, 4 IF SUPPRESSED
JRST SCNEND
CFSPC1: TRNE F,SUPP ;IN SUPPRESSED ASSEMBLY?
JRST SCNEND ;YES, AND NOT END OF COND. COMMENT
];END IFN FTIF
FLDSPC: MOVE T1,[NAME,,FIELD]
BLT T1,FIELD+NWORDS-1 ;MOVE NAME TO FIELD
POPJ P,
$WIDTH: PUSHJ P,TOKN10 ;GET WIDTH OF MICROWORD
CAIE N,.TKN ;MUST BE NUMERIC AND DECIMAL
MSG SWT100,.WIDTH IS SUPPOSED TO BE FOLLOWED BY A DECIMAL NUMBER
SOS N,NUMBER ;HIGHEST BIT NUMBER TO PRINT
MOVEM N,MAXPOS(RAM)
JRST SWT100
$PAGEL: PUSHJ P,TOKN10 ;GET LISTING LINES PER PAGE
CAIE N,.TKN ;MUST BE NUMERIC AND DECIMAL
MSG SWT100,.PAGELENGTH IS SUPPOSED TO BE FOLLOWED BY A DECIMAL NUMBER
MOVE N,NUMBER
MOVEM N,LPPAG
JRST SWT100
;FIELD/NUMBER SCANNED, INSERT VALUE INTO MICRO WORD
FLDNUM: PUSHJ P,STRTWD
TRNN F,PASS2
JRST ZFPOPJ
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 ZFPOPJ
;FIELD/SYMBOL SCANNED, INSERT VALUE INTO MICRO WORD
FLDSYM: PUSHJ P,STRTWD
TRNN F,PASS2
JRST ZFPOPJ
PUSHJ P,SRCFLD
FLDS1: MSG ZFPOPJ, 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
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 ZFPOPJ, SYMBOL NOT DEFINED
STRTWD: TROE F,BINF ;START BUILDING BINARY WORD?
POPJ P, ;ALREADY STARTED
TRNE F,NOBINF ;YES
MSG .+1,BINARY WORD GENERATED WHILE IN .NOBIN MODE
JUMPN RAM,CPOPJ
MOVE N,LINNUM ;PUT INSTRUCTION INTO LOCTAB
MOVEI T1,%LCUCD
PUSHJ P,ADDLOC
TRNE F,PASS2
MOVEM N,PC(RAM)
POPJ P,
SUBTTL .RAMFILE PSEUDO-OP
$RAMFL: SKIPE RAM
MSG STOP,[.RAMFILE ONLY WORKS FOR UCODE, FOR NOW]
;PARSE FIELDS
SETZM BITNO' ;NO BITS SEEN YET
RAMFL1: PUSHJ P,TOKN10 ;PARSE FIELD NAME, 0, OR NBITS/0
CAIN N,.TKN
JRST RAMFL2 ;NUMBER IS PADDING
CAIE N,.TKS ;SYMBOL IS FIELD NAME
JRST RAMFL7 ;SKIP COMMENT
CAIN C,"<
JRST RAMFP1 ;PARITY SPEC
TRNN F,PASS2
JRST RAMFL8 ;IGNORE ON PASS 1
PUSHJ P,FLDSPC
PUSHJ P,SRCFLD
MSG RAMFL8,FIELD NOT DEFINED
LDB T1,DEFPOS
IDIVI T1,36.
ADDI T1,VALUE
LDB T4,DEFSIZ
CAIG T4,1(T2) ;SKIP IF CROSSES WORD BOUNDARY
JRST RAMFL5
SUBI T1,1 ;HANDLE FIRST WORD FIRST
SUBI T4,1(T2) ;NUMBER OF BITS IN FIRST WORD
DPB T4,[300600,,T1]
PUSHJ P,RAMFL4
LDB T1,DEFPOS ;NOW HANDLE SECOND WORD
IDIVI T1,36.
ADDI T1,VALUE
MOVEI T4,1(T2) ;NUMBER OF BITS IN SECOND WORD
RAMFL5: MOVEI T3,35.
SUB T3,T2
DPB T3,[360600,,T1] ;BYTE POSITION
DPB T4,[300600,,T1]
PUSHJ P,RAMFL4
JRST RAMFL8
RAMFL2: MOVEI N,1
CAIE C,"/ ;MULTIPLE BIT FIELD?
JRST RAMFL3
PUSH P,NUMBER
PUSHJ P,TOKEN
CAIE N,.TKN
JRST ILLFOR
POP P,N ;NUMBER OF BITS OF PADDING
RAMFL3: SKIPE NUMBER
MSG .+1, YOU CAN ONLY PAD WITH ZERO
MOVEI T1,[0]
DPB N,[300600,,T1] ;SET BYTE SIZE
TRNE F,PASS2 ;IGNORE ON PASS 1
PUSHJ P,RAMFL4 ;SAVE THAT FIELD
RAMFL8: CAIN C,",
JRST RAMFL1 ;JUMP IF MORE FIELDS
CAIE C,"; ;MAKE SURE TERMINATION IS LEGAL
CAIN C,12
JRST RAMFL9
MSG RAMFL9,ILLEGAL CHARACTER IN .RAMFILE
RAMFL9: TRNN F,PASS2
JRST SWT100
MOVE N,BITNO
IDIVI N,36.
SKIPE N1
MSG .+1,BITS PER LOCATION IN RAM FILE MUST BE A MULTIPLE OF 36
MOVEM N,RFLNWD
IMULI N,MAXPC+1 ;NUMBER OF WORDS IN RAMFILE BUFFER
PUSHJ P,GETWRD ;ALLOCATE STORAGE
MOVEM N,RAMFIL
MOVN T1,RFLDPT ;NUMBER OF FIELDS
HRLZM T1,RFLDPT ;CONVERT TO AOBJN POINTER
JRST SWT100
;SAVE FIELD IN T1
RAMFL4: MOVE T3,BITNO
IDIVI T3,36.
MOVEI T3,36.
SUB T3,T4 ;NUMBER OF BITS LEFT IN WORD
LDB N,[300600,,T1] ;BYTE SIZE OF SOURCE
CAMLE N,T3 ;SKIP IF NOT ENOUGH BITS
MSG .+1,DESTINATION BYTE CROSSES WORD BOUNDARY--WON'T WORK
AOS T2,RFLDPT ;FIELD NUMBER+1
MOVEM T1,RFLDS-1(T2) ;SAVE SOURCE BYTE POINTER
MOVSI T1,C ;COMPUTE DESTINATION BITS
DPB N,[300600,,T1]
ADDB N,BITNO
SUBI N,1 ;ENDING BIT POSITION
IDIVI N,36.
HRR T1,N ;WORD OFFSET
MOVEI T3,35.
SUB T3,N1
DPB T3,[360600,,T1] ;BIT POSITION
MOVEM T1,RFLDD-1(T2)
POPJ P,
;PARSE RAMFILE PARITY SPECIFICATION
RAMFP1: MOVE T1,NAME
MOVE T2,NAME+1
CAMN T1,[ASCII/ODD P/]
CAME T2,[ASCII/ARITY/]
JRST RAMFP3
PUSH P,[0]
RAMFP2: PUSHJ P,TOKN10 ;FIRST BIT
CAIN N,.TKN
CAIE C,":
MSG .+1,ILLEGAL FORMAT IN FIRST BIT OF PARITY COMPUTATION
PUSH P,NUMBER
PUSHJ P,TOKN10 ;LAST BIT
CAIE N,.TKN
MSG .+1,ILLEGAL FORMAT IN LAST BIT OF PARITY COMPUTATION
POP P,T2
AOS T1,NUMBER
SUB T1,T2 ;NUMBER OF BITS
DPB T2,[POINT 9,T1,26] ;FIRST BIT
HRL T1,BITNO ;WHERE TO STORE THE PARITY BIT
IOR T1,(P) ;COMPLEMENT FOR EVEN PARITY
SETZM (P) ;IN CASE OF MULTIPLE FIELDS
MOVEI T2,RFLPAR ;FILL IN NEXT PARITY SPEC
SKIPE (T2)
AOJA T2,.-1
CAIL T2,RAMFIL
MSG STOP,TOO MANY PARITY SPECIFICATIONS
TRNE F,PASS2 ;DON'T STORE UNTIL PASS 2
MOVEM T1,(T2)
CAIN C,",
JRST RAMFP2 ;GO BACK FOR MORE FIELDS
SUB P,[1,,1] ;FLUSH EVEN/ODD
CAIE C,">
MSG .+1,MISSING RIGHT ANGLE BRACKET AFTER PARITY SPEC
AOS BITNO
PUSHJ P,GETCHR ;PRESUMED COMMA
JRST RAMFL8
RAMFP3: CAMN T1,[ASCII/EVEN /]
CAME T2,[ASCII/PARIT/]
MSG .+1,UNRECOGNIZED PARITY SPECIFICATION
PUSH P,[SETZ] ;COMPLEMENT PARITY BIT
JRST RAMFP2
;WRITE OUT THE RAM FILE
WRAMFL: .CALL [ SETZ
SIXBIT/OPEN/
[.BIO,,OUTCHN]
O.DEV
O.NAM
[SIXBIT/RAM/]
SETZ O.PPN ]
PUSHJ P,OFOPER ;CAN'T OPEN
MOVN N,RFLNWD
IMULI N,MAXPC+1 ;-NUMBER OF WORDS IN RAMFILE BUFFER
HRLZ N,N
HRR N,RAMFIL
.IOT OUTCHN,N
.CLOSE OUTCHN,
POPJ P,
RAMFL7: CAIN C,12 ;CONTINUATION LINE
JRST RAMF7B
CAIE C,"; ;COMMENT FOLLOWED BY CONTINUATION LINE
JRST ILLFOR
RAMF7A: PUSHJ P,GETCHR
CAIE C,12
JRST RAMF7A
RAMF7B: PUSHJ P,GETCHR
CAIN C,40
JRST RAMF7B
TRO F,REREAD
JRST RAMFL1
SUBTTL PSEUDO INSTRUCTIONS (INCL MACROS)
PSEUDO: MOVEI FPNT,PSUDO% ;PSEUDO SYMBOL TABLE
PUSHJ P,SRCSY1 ;IS IT A DEFINED PSEUDO OP?
JRST BEGMAC ;NO, SEE IF IT'S A MACRO
MOVE T1,SYMPSO(SPNT) ;YES, GET HANDLER ADDR
JRST 0(T1) ;GO TO IT
$DCODE: MOVEI RAM,DISP
POPJ P,
$UCODE: MOVEI RAM,UCODE
POPJ P,
$SEQAD: SETOM SEQADR
POPJ P,
$BIN: TRZ F,NOBINF
POPJ P,
$NOBIN: TRO F,NOBINF
POPJ P,
; MACRO CALL SCANNED
;COMMENTED LINES BUMMED OUT FOR SPEED
BEGMAC: ;OUGHT TO SUPPRESS ON PASS1, CAN'T DUE TO
;STATE PROCESSING TROUBLES
; MOVE T1,[MACRO,,FIELD] ;LOOK FOR MACRO DEF
; BLT T1,FIELD+NWORDS-1
; PUSHJ P,SRCFLD
; MSG ZFPOPJ, NO MACROS DEFINED
SETZM FIELD
SKIPE FPNT,MACPNT(RAM) ;AVOID FIELD SEARCH
PUSHJ P,SRCSYM ;LOOK FOR DEFINITION
MSG MACLUZ, MACRO NAME NOT DEFINED
MOVSI N,(POINT 7,0)
HRR N,SYMMAC(SPNT) ;GET POINTER TO MACRO
PUSHJ P,SAVE
MOVEI C,", ;MACRO MUST NOT INVOKE END-OF-LINE ACTIONS
JRST ZFPOPJ
MACLUZ: LDB T1,STAPNT ;GET CHAR TYPE
CAIN T1,EOL ;END OF LINE?
SETZM STATE ;YES, RETURN TO STATE ZERO
JRST ZFPOPJ
SUBTTL "SYMBOL:" DEFINE ADDRESS TAG
TAG: SKIPE FPNT,JPNT(RAM) ;DO WE KNOW WHERE J FIELD IS DEFINED?
JRST TAG2 ;YES, DO NOT SEARCH
MOVSI T1,(ASCII /J/)
MOVEM T1,FIELD
SETZM FIELD+1
MOVE T1,[FIELD+1,,FIELD+2]
BLT T1,FIELD+NWORDS-1
PUSHJ P,SRCFLD
MSG ZFPOPJ, CAN'T FIND J FIELD
MOVEM FPNT,JPNT(RAM) ;REMEMBER FOR FUTURE
TAG2: PUSHJ P,MAKSYM
JFCL
HRRZ N,PC(RAM)
JUMPN RAM,TAG3 ;DCODE ASSIGNS LOCATIONS RIGHT AWAY
MOVE N,SPNT ;PUT TAG IN LOCTAB
MOVEI T1,%LCTAG
PUSHJ P,ADDLOC
TRNN F,PASS2
JRST ZFPOPJ ;PASS 1 - LOCATION NOT KNOWN YET
TAG3: PUSHJ P,DEFCHK
HALT DEFVAL
JRST ZFPOPJ
; NUMBER: SET LOCATION COUNTER
LOCSET: SKIPGE N,NUMBER
MSG ZFPOPJ, LOCATION NEGATIVE
CAMLE N,[MAXPC ? MAXDSP](RAM)
MSG ZFPOPJ, LOCATION TOO LARGE
HRROM N,PC(RAM) ;STORE AWAY NEW PC VALUE
JUMPN RAM,ZFPOPJ
SETZM FRECNT ;END ANY LOCATION DEFAULTING
SETZM LOCPAT
SETZM LOCAST
MOVEI T1,%LCABS ;SAVE IN LOCTAB
PUSHJ P,ADDLOC
JRST ZFPOPJ
SUBTTL EQUAL SIGN - SET LOCATION COUNTER FOR LEADING BIT PATTERN
LOCBLK: SETZB N,BLDPAT' ;INIT COUNT, INIT PATTERN FOR 1'S
SETZM BLDAST' ;INIT PATTERN FOR *'S
LOCB1: PUSHJ P,GETCHR
CAIN C,40
JRST LOCB1
CAIN C,"0
SOJA N,LOCB1 ;COUNT DIGITS
MOVSI T1,(SETZ) ;GET BIT INTO POSITION FOR PATTERNS
LSH T1,(N)
CAIN C,"1
JRST [ IORM T1,BLDPAT
SOJA N,LOCB1 ]
CAIN C,"*
JRST [ IORM T1,BLDAST
SOJA N,LOCB1 ]
MOVNS N ;GET POSITIVE POSITION COUNT
CAIE C,12
TRO F,REREAD ;ONLY BACK UP IF NOT END-OF-LINE
LOCB2: MOVEI T1,1 ;FIND HOW MANY CONSECUTIVE WORDS
LSH T1,(N) ;WORDS=2**NUMBER OF BITS
MOVE T2,BLDPAT ;GET BIT PATTERN
ROT T2,(N) ;MOVE TO LOW ORDER
MOVEM T2,BLDPAT
MOVE T4,BLDAST ;GET * PATTERN
ROT T4,(N)
MOVEM T4,BLDAST
JUMPN RAM,LOCB3
MOVEM N,BLDNB' ;SAVE NUMBER OF BITS
JUMPE N,LOCB6 ;IF NO BITS, PC IS UNRESTRICTED
SKIPGE N,PC(RAM) ;GET CURRENT PC
CAMLE T1,FRECNT ;IS NEW BLOCK LARGER?
JRST LOCB6 ;YES, OR PC NOT RESTRICTED
;MERGE WITH PREVIOUS BLOCK
MOVEI T3,-1(T1) ;GET 1S FOR BITS SPECIFIED
ANDCM T3,BLDAST ;CLEAR * POSITIONS
TDNE T3,LOCAST ;CHECK FOR 1S OR 0S WHERE *S GIVEN IN MASTER
JRST LOCB5 ;YES, PATTERN IS ILLEGAL
LOCB4: MOVE T3,N
ANDCM T3,BLDAST ;CLEAR DON'T-CARE BITS
ANDI T3,-1(T1) ;MASK PC TO NEW BLOCK SIZE
CAMN T3,BLDPAT ;DOES PC MATCH NEW PATTERN?
JRST LOCB8 ;YES, USE IT
MOVE T3,N ;GET PC AGAIN
AND T3,LOCAST ;SAVE STATE OF * BITS
IOR N,LOCAST ;THEN FORCE THEM TO CARRY
AOBJP N,.+1 ;PICK NEXT PC IN BLOCK
IOR N,LOCPAT ;RESET BIT CARRIED OUT OF
ANDCM N,LOCAST ;CLEAR OUT DON'T CARE BITS
IOR N,T3 ;SET ANY WHICH WERE SET BEFORE
JUMPL N,LOCB4 ;LOOP IF ANY MORE IN THIS BLOCK
LOCB5: MOVEM T1,FRECNT ;SAVE NEW PARAMETERS
MOVEM T2,LOCPAT
MOVEM T4,LOCAST
MSG LOCB7, NO SUCH MICRO WORD ADR PATTERN IN CURRENT BLOCK
LOCB6: MOVEM T1,FRECNT ;STORE NEW BLOCK SIZE AWAY
MOVEM T2,LOCPAT ; ALSO BIT PATTERN
MOVEM T4,LOCAST ; AND * PATTERN
LOCB7: MOVE T3,LOCPAT ;FAKE FIRST PC IN BLOCK
PUSHJ P,BLKCNT ;GET RIGHT VALUE IN LH(N)
HALT
LOCB8: MOVEM N,PC(RAM) ;SET UP FAKE FIRST WORD ADDRESS
MOVE N,BLDPAT ;SAVE = COMMAND AWAY IN LOCTAB
MOVE T1,BLDAST
DPB T1,[%%LCAS,,N]
MOVE T1,BLDNB
DPB T1,[%%LCNB,,N]
MOVEI T1,%LCEQL
JRST ADDLOC
LOCB3: 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
MOVEM N,PC(RAM)
POPJ P,
SUBTTL "FIELD/="
;FIELD/= HAS BEEN SCANNED. SO, A MICRO FIELD DEFINITION IS IN PROGRESS.
DEFSYM: PUSHJ P,SRCFLD ;FIND THE FIELD
MSG SCNEND, UNDEFINED FIELD IN SYMBOL DEFINITION
PUSHJ P,MAKSYM ;GO MAKE THE SYMBOL
JFCL ;DO CONSISTENCY CHECK
PUSHJ P,TOKEN
CAIE N,.TKN ;SKIP IF TOKEN NUMERIC
MSG DEFS99, VALUE REQUIRED IN SYMBOL DEFINITION
MOVE N,NUMBER
PUSHJ P,DEFCHK
HALT DEFVAL
PUSHJ P,DEFSLS
CAIE C,",
JRST SCNEND
PUSHJ P,TOKN10
MOVE N,NUMBER
PUSHJ P,DEFCHK
HALT DEFTM1 ;FIRST TIME VALUE
CAIE C,",
JRST SCNEND
PUSHJ P,TOKN10
MOVE N,NUMBER
PUSHJ P,DEFCHK
HALT DEFTM2 ;SECOND TIME VALUE
DEFS99: JRST SCNEND
SUBTTL DEFINE A FIELD
DEFFLD: PUSHJ P,MAKFLD
JRST SCNEND
PUSHJ P,GETARG ;SCANNED FIELD/=, GET ARGS
MSG CPOPJ, VALUE REQUIRED FOR FIELD DEFINITION
MSG CPOPJ, SIZE REQUIRED FOR FIELD DEFINITION
MSG CPOPJ, POSITION REQUIRED FOR FIELD DEFINITION
JRST CPOPJ
PUSHJ P,DEFSLF
JRST SCNEND
DEFSLF:
DEFSLS: LDB T1,DEFPOS
CAILE T1,MICMXB
MSG .+1, POSITION TOO LARGE FOR MICRO WORD
LDB T2,DEFSIZ
ADDI T1,1
CAMGE T1,T2
MSG .+1, SIZE TOO LARGE FOR POSITION
LDB T1,DEFVAL
MOVEI N,1
LSH N,(T2)
LDB T2,DEFFNC
HRRZ T2,DEFTAB(T2)
CAMG N,T1
CAIN T2,DFLOTH
POPJ P,
MSG CPOPJ,DEFAULT VALUE TOO LARGE FOR FIELD
SUBTTL DEFINE A MACRO
DEFMAC: MOVEI FPNT,PSUDM% ;FIRST CHECK FOR PSEUDO-MACRO
PUSHJ P,SRCSY1 ;IS IT ONE OF THOSE NAMES?
JRST DEFM0 ;NO, DEFINE A REAL MACRO
HRRZ T1,SYMPSO(SPNT) ;YES, GET ADDR OF HANDLER
JRST 0(T1)
$TITLE: TRNE F,PASS2
JRST SCNEND ;TREAT AS COMMENT ON PASS 2
SKIPE TTLPNT ;DO WE ALREADY HAVE A TITLE
MSG SCNEND, TITLE MULTIPLY DEFINED
MOVEI N,1
PUSHJ P,GETWRD
HRRZM N,TTLPNT ;SAVE ADDRESS INTO WHICH IT IS STORED
JRST DEFM2 ;GO COLLECT IT
$TOC: TRNE F,PASS2 ;ENTIRELY DIFFERENT FUNCTION ON PASS2
JRST TOC2
MOVEI N,2 ;LINK WORD + ONE FOR STRING
PUSHJ P,GETWRD
SKIPN T1,TOCPNT ;TOC INITIALIZED?
MOVEI T1,TOCPNT ;NO, POINT TO IT
HRLM N,0(T1) ;LINK THIS ONE TO LAST ON LIST
HRRM N,TOCPNT ;AND NOTE THIS IS NOW LAST
MOVE T1,LINNUM
HRRZM T1,0(N) ;STUFF LINE # INTO ENTRY
AOJA N,DEFM2 ;NOW COLLECT THE STRING
TOC2: HLRZ N,TOCPNT ;TRY TO FIND THIS ON LIST
TOC3: HRRZ T1,0(N) ;GET LINE # OF DEFINITION
CAMLE T1,LINNUM ;IS IT OLD FOR THIS LINE?
MSG STOP, !!TOC LST FOULED UP !!
CAMN T1,LINNUM ;IS THIS WHERE WE DEFINED IT?
JRST SCNEND ;YES, IT WILL PRINT AS SUBTTL
HLRZ N,0(N) ;NO, LOOK AT NEXT
HRLM N,TOCPNT
JRST TOC3
;DEFINE A MACRO
DEFM0: SKIPE FPNT,MACPNT(RAM) ;IS THE "MACRO%" FIELD DEFINED?
JRST DEFM1 ;YES, AVOID SEARCH
MOVE T1,[MACRO,,FIELD] ;FORCE FIELD NAME
BLT T1,FIELD+NWORDS-1
PUSHJ P,MAKFLD ;MAKE INITIAL FIELD FOR MACROS
MSG STOP, !!CAN'T DEFINE "MACRO%"!!
SETZM FIELD
MOVEM FPNT,MACPNT(RAM) ;REMEMBER FOR FUTURE
DEFM1: PUSHJ P,MAKSYM
JRST SCNEND
MOVEI N,1
PUSHJ P,GETWRD ;GET 1 WORD OF SPACE
HRRM N,SYMMAC(SPNT) ; AND SAVE AS 1ST WORD OF MACRO
DEFM2: PUSHJ P,COPMAC ;COPY TEXT INTO SYMBOL TABLE
JRST SCNEND
;SUBR TO COPY QUOTED TEXT INTO SYMBOL TABLE
COPMAC: HRLI N,(POINT 7,) ;MAKE ADDR OF SPACE INTO BYTE POINTER
PUSH P,N ;CREATE TEMP FOR IT
CMAC1: PUSHJ P,GETCHR
CAIN C,12 ;EOL?
MSG CMAC99, MISSING TERMINAL QUOTE
CAIN C,42 ;TERMINAL QUOTE?
MOVEI C,0 ;YES, TERMINATE WITH IT
MOVE T1,0(P) ;PICK UP POINTER
TLNN T1,760000 ;AT END OF WORD?
JRST CMAC2 ;NO
MOVEI N,1 ;YES, GET ANOTHER
PUSHJ P,GETWRD
CMAC2: IDPB C,0(P) ;STORE THIS CHAR
JUMPN C,CMAC1 ; COLLECT ASCIZ STRING
CMAC99: POP P,N ;RESTORE STACK
POPJ P,
SUBTTL GETARG
;SEARCH ARGUMENT LIST AND RE-CALL CALLING ROUTINE
;FOR MISSING ARGS
;CALLING SEQUENCE:
; PUSHJ P,GETARG
; ;GETARG PUSHJ'S TO HERE IF 1ST ARG IS MISSING
; ;TO HERE IF 2ND ARG IS MISSING
; ;3RD ARG
; ;4TH ARG
; FINAL RETURN
GETARG: PUSHJ P,TOKEN ;GET 1ST ARG
CAIN N,.TKB
CAIE C,"< ;LEADING LESS-THAN FOR BYTE SPEC
CAIA
JRST NGETA1 ;NEW-STYLE FIELD DEFINITION HANDLED DIFFERENTLY
CAIE N,.TKN
PUSHJ P,@(P) ;1ST ARG MISSING, CALL CALL SITE+1
MOVE N,NUMBER
PUSHJ P,DEFCHK ;CHECK THAT VALUE FITS FIELD
HALT DEFVAL
AOS (P) ;1ST ARG SCAN COMPLETED
CAIN C,", ;POSSIBLE 2ND ARG?
PUSHJ P,TOKN10 ;YES, GO SCAN
CAIE N,.TKN
PUSHJ P,@(P) ;NO POSSIBLE ARG, OR WASN'T THERE
MOVE N,NUMBER
PUSHJ P,DEFCHK
HALT DEFSIZ
AOS (P) ;2ND ARG SCAN COMPLETED
CAIN C,", ;CHECK FOR POSSIBLE THIRD ARG
PUSHJ P,TOKN10
CAIE N,.TKN
PUSHJ P,@(P)
MOVE N,NUMBER
PUSHJ P,DEFCHK
HALT DEFPOS
CAML N,MAXPS1(RAM)
MOVEM N,MAXPS1(RAM) ;KEEP TRACK OF MICRO WORD SIZE
AOS (P) ;3RD ARG SCAN COMPLETED
CAIE C,",
JRST GETA4
GETA2: PUSHJ P,GETCHR ;4TH ARG IS SINGLE CHAR
CAIN C,40
JRST GETA2 ; BUT FLUSH SPACES
MOVSI N,DEFTAB-DEFTND
GETA3: HLRZ T1,DEFTAB(N) ;SEARCH TABLE FOR CHARACTER
CAMN T1,C
JRST GETA5
AOBJN N,GETA3
MSG .+1, UNDEFINED SPECIAL FUNCTION CHARACTER
GETA4: PUSHJ P,@(P)
JRST GETA6
GETA5: HRRZS N
PUSHJ P,DEFCHK
HALT DEFFNC
GETA6: JRST CPOPJ1
;LESS-THAN THAT INTRODUCES NEW-STYLE FIELD DEFINITION HAS BEEN READ
NGETA1: PUSHJ P,TOKN10 ;GET LEFT BIT POSITION
CAIE N,.TKN
MSG .+1,LEFT BIT POSITION MISSING IN FIELD DEFINITION
PUSH P,NUMBER ;SAVE IT FOR THE MOMENT
CAIN C,"> ;SINGLE BIT FIELD?
JRST NGETA4
CAIE C,":
MSG .+1,COLON MISSING BETWEEN LEFT AND RIGHT BIT POSITIONS
PUSHJ P,TOKN10 ;GET RIGHT BIT POSITION
CAIE N,.TKN
MSG .+1,LEFT BIT POSITION MISSING IN FIELD DEFINITION
CAIE C,">
MSG .+1,RIGHT ANGLE-BRACKET MISSING AFTER FIELD BYTE SPEC
NGETA4: MOVE N,NUMBER ;RIGHT BIT POSITION
CAML N,MAXPS1(RAM)
MOVEM N,MAXPS1(RAM) ;KEEP TRACK OF MICRO WORD SIZE
PUSHJ P,DEFCHK ;STORE BYTE POSITION
HALT DEFPOS
POP P,T1
SUB N,T1
AOS N ;BIT POSITIONS ARE INCLUSIVE
PUSHJ P,DEFCHK ;STORE BYTE SIZE
HALT DEFSIZ
PUSHJ P,GETCHR ;MODE ARG IS SINGLE CHAR
MOVSI N,DEFTAB-DEFTND
NGETA3: HLRZ T1,DEFTAB(N) ;SEARCH TABLE FOR CHARACTER
CAMN T1,C
JRST NGETA5
AOBJN N,NGETA3
TRO F,REREAD ;IGNORE IF UNRECOGNIZED CHARACTER
SETZ C, ;NO, PINHEAD, I DIDN'T READ THIS CHAR YET
NGETA6: POP P,T1 ;AND RETURN SKIPPING 4 GUBBISH RETURNS
JRST 4(T1)
NGETA5: HRRZS N ;SAVE SPECIAL FUNCTION CHARACTER
PUSHJ P,DEFCHK
HALT DEFFNC
JRST @NDFTAB(N) ;GET ANY ADDITIONAL ARGUMENTS
;D SPEC
NGETA7: PUSHJ P,NGETAT
CAIE N,.TKN
PUSHJ P,@(P) ;FIELD VALUE MISSING
MOVE N,NUMBER
NGETA9: PUSHJ P,DEFCHK ;SAVE DEFAULT
HALT DEFVAL
JRST NGETA6
;F SPEC
NGETA8: PUSHJ P,NGETAT
CAIE N,.TKS
MSG NGETA6,FIELD NAME MISSING AFTER F MODE CHAR
PUSH P,FPNT ;SAVE FIELD BEING DEFINED
REPEAT NWORDS,PUSH P,FIELD+.RPCNT
PUSHJ P,FLDSPC ;COPY NAME INTO FIELD
PUSHJ P,SRCFLD ;FIND OTHER FIELD
MSG .+1,FIELD TO DEFAULT TO NOT DEFINED YET
REPEAT NWORDS,POP P,FIELD+NWORDS-.RPCNT-1
POP P,FPNT
MOVE SPNT,FPNT
JRST NGETA9
NGETAT: PUSHJ P,GETCHR ;SKIP COMMA
CAIE C,",
MSG .+1,COMMA MISSING BETWEEN MODE CHAR AND ITS ARGUMENT
JRST TOKEN ;GET DEFAULT FIELD VALUE
SUBTTL VALUE INSERTION
;CHECK TO SEE THAT VALUE FITS IN THE BYTE FIELD ALLOWED
;AND THEN STUFF IT THERE
DEFCHK: LDB T1,DEFFLG ;FIRST CHECK FOR MULTIPLE DEFINITION
TRNE T1,MULF ;IF SET, WE'VE ALREADY OBJECTED
JRST CPOPJ1 ;CAN'T EXPECT THAT TO BE CONSISTENT
HRRZ T1,@(P)
TRNN F,PASS2
JRST DEFC2
LDB N1,(T1) ;GET PASS1 DEFINITION
CAME N,N1
MSG STOP, PASS1 AND PASS2 DEFINITIONS DIFFER
JRST CPOPJ1
DEFC2: DPB N,(T1)
LDB N1,(T1)
CAME N,N1
MSG .+1, NUMBER TOO BIG FOR FIELD
JRST CPOPJ1
TIMSET: MOVE N,TIME1 ;DEFAULT TIME INSERTION
CAMGE N,TIME2 ;GET MAX
MOVE N,TIME2
LDB T2,DEFVAL ;GET DEFAULT MINIMUM TIME
CAMGE N,T2
MOVE N,T2 ;DEFAULT TIME .GT. MAX(T1,T2)
JRST BITS1
PCINC: SKIPE RAM
MSG STOP, NOT SUPPOSED TO GET TO PCINC FOR DCODE
MOVE N,LOCPNT ;FIND NEXT LOCATED INSTRUCTION
PCINC1: LDB T1,[%%LCOP,,LOCTAB(N)]
CAIE T1,%LCUCD
AOBJN N,PCINC1
SKIPL N
MSG .+1, NO SUCCESSOR INSTRUCTION TO THIS ONE FOUND
LDB N,[%%LCPC,,LOCTAB(N)]
JRST BITS1
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,
DFLOTH: LDB FPNT,DEFVAL ;POINTER TO FIELD TO DEFAULT TO
LDB T4,DEFSIZ ;FIND THAT FIELD
LDB T2,DEFPOS
MOVE FPNT,SPNT ;RESTORE TO CURRENT FIELD
ADDI T2,1 ;FIND DEFAULT IN VALUE WORD
IDIVI T2,36.
SKIPN T2
TDZA N,N
MOVE N,VALUE-1(T2)
MOVE N1,VALUE(T2)
LSHC N,(T3) ;RIGHT-JUSTIFY FIELD IN N
SETZ T1,
SETO T2,
LSHC T1,(T4) ;MASK FOR FIELD IN T1
AND N,T1
JRST BITS1 ;GO STORE VALUE
;SKIP IF SOME FIELDS MATCH THIS ONE
;NO SKIP IF FIELD VIRGIN
;ON RETURN, LEAVE MASK FOR THIS FIELD IN T3,T4
;LEAVE SHIFT POSITION AND TABLE INDEX IN N1,N
FLDTST: MOVEI T3,0
MOVNI T4,1
LDB T1,DEFSIZ
LSHC T3,(T1)
MOVEI T4,0
LDB N,DEFPOS
ADDI N,1
IDIVI N,36.
MOVNS N1
LSHC T3,(N1)
SKIPE N
TDNN T3,VALSET-1(N)
TDNE T4,VALSET(N)
AOS (P)
POPJ P,
;CODE TO SEARCH FIELD DEFINITION LIST AND INSERT DEFAULTS
DEFALT: MOVEI FPNT,FLDPNT ;START OF LIST
DFLT2: HRRZ FPNT,SYMLNK(FPNT)
JUMPE FPNT,CPOPJ ;STOP AT END OF LIST
MOVE SPNT,FPNT
LDB T1,DEFTYP ;GET "UCODE" OR "DISP" TYPE
CAME T1,RAM ;MATCH CURRENT MODE?
JRST DFLT4 ;NO
PUSHJ P,FLDTST ;IS FIELD VIRGIN?
SKIPA ;YES
JRST DFLT4 ;NO
LDB T1,DEFFNC
JUMPE T1,DFLT4 ;0 FUNCTION MEANS NO DEFAULT
MOVE T1,DEFTAB(T1)
PUSHJ P,(T1) ;DISPATCH ON FUNCTION
DFLT4: JRST DFLT2
PARITY: POP P,T1 ;GET RETURN ADR
PUSH P,FPNT ; SAVE FPNT TO PARITY FIELD
PUSHJ P,(T1) ; AND MAKE "CALLER" BE "CALLEE"
POP P,FPNT ;SET UP PARITY FIELD POINTERS
MOVE SPNT,FPNT
MOVEI T1,0 ;INIT PARITY
MOVSI T2,-MICMXW ;COUNT THRU ALL OF MICRO WORD
XOR T1,VALUE(T2) ;COMPUTE TABLE PARITY
AOBJN T2,.-1
TSC T1,T1 ;REDUCE TO 18 BITS
MOVEI N,0
PARLUP: JUMPN T1,[ANDI T1,-1(T1) ;REMOVE 1 BIT
AOJA N,PARLUP ]
TRNE N,1 ;IF PARITY ALREADY ODD,
POPJ P, ; THEN OK AS IS
MOVEI N,1 ;GET A PARITY BIT
LDB T2,DEFSIZ ;GET PARITY FIELD SIZE
JUMPN T2,BITS1 ;PUT PARITY BIT INTO FIELD
MOVSI T1,-MICMXW ;MINUS TABLE LENGTH OF MICRO WORD
PAR3: SETCM T2,VALSET(T1) ;GET BIT USAGE
JFFO T2,[MOVSI N,(SETZ) ;BIT TO SHIFT
MOVNS T3 ;GET RIGHT SHIFT COUNT
LSH N,(T3) ; AND SHIFT PARITY BIT TO FREE PLACE
IORM N,VALUE(T1)
IORM N,VALSET(T1)
JRST PAR5 ]
AOBJN T1,PAR3 ;CONTINUE LOOKING FOR PLACE FOR BIT
PAR5: HLRES T1 ;GET # WORDS REMAINING
ADDI T1,MICMXW ;GET WHICH WORD HAD FREE BIT
IMULI T1,36.
SUB T1,T3 ;CONVERT TO BIT NUMBER
CAMLE T1,MAXPOS(RAM) ;WAS THERE ROOM FOR PARITY BIT?
MSG .+1, NO ROOM FOR PARITY BIT
POPJ P,
SUBTTL SYMBOL TABLE ROUTINES
;SUBROUTINE TO FIND A FIELD OR MAKE ONE IF IT DOESN'T EXIST.
; NO SKIP IF IT ALREADY EXISTS. SKIP IF NEWLY MADE.
; RETURNS POINTER TO FIELD BLOCK IN SPNT AND FPNT.
MAKFLD: PUSHJ P,SRCFLD
JRST MAKF1 ;NOT FOUND
TRNN F,PASS2 ;ONLY ONCE PER PASS, PLEASE
JRST MULFLD
PUSHJ P,BEGCRF ;PUT DEFINITION IN THE CREF
LDB T1,DEFFLG ;CHECK FOR MULTIPLY DEFINED
TRNE T1,MULF
MSG CPOPJ, MULTIPLY DEFINED FIELD
POPJ P, ;AND RETURN FOUND
MAKF1: SKIPN FIELD
MSG CPOPJ, CAN'T DEFINE A NULL FIELD
TRNE F,PASS2 ;BETTER BE PASS 1
MSG STOP, !!FIELD UNDEFINED ON PASS 2!!
PUSH P,N
PUSHJ P,GETROM
MOVE FPNT,N ;SAVE POINTER TO NEW FIELD
MOVE SPNT,N
POP P,N1 ;GET POINTER TO PREVIOUS FIELD
HRRZ N,SYMLNK(N1) ;GET POINTER FROM PREVIOUS FIELD
HRRZM N,SYMLNK(FPNT) ;AND CONTINUE FROM NEW FIELD
HRRM FPNT,SYMLNK(N1) ;LINK LIST STRUCTURE
MOVSI T1,FIELD
HRRI T1,SYMTXT(FPNT)
BLT T1,SYMTXT+NWORDS-1(FPNT) ;COPY NAME TEXT INTO DEFINITION
SETZM SYMVAL(FPNT) ;ZERO DEFINITION WORD
SETZM SYMVAL+1(FPNT)
DPB RAM,DEFTYP
SETZM SYMCRF(SPNT) ;INIT CREF LIST STRUCTURE
JRST CPOPJ1
MULSYM:
MULFLD: LDB T1,DEFFLG ;PICK UP FLAGS
IORI T1,MULF ;NOTE MULTIPLE DEFINITION
DPB T1,DEFFLG
MSG CPOPJ, MULTIPLE DEFINITION
;SUBROUTINE TO MAKE A SYMBOL DEFINITION (IF ONE DOESN' EXIST)
;SIMILAR TO MAKFLD ABOVE
; CALLED WITH POINTER TO FIELD IN FPNT
; SKIPS IF NEWLY MADE. RETURNS POINTER IN SPNT.
; NO SKIP IF ALREADY DEFINED.
; POINTER IN SPNT TO PRESENT DEFINITION.
MAKSYM: PUSHJ P,SRCSY1 ;LOOK FOR SYMBOL, BUT DON'T CREF YET
JRST MAKS1 ;NOT FOUND
TRNN F,PASS2 ;DISALLOW MULTIPLE DEFINITION
JRST MULSYM
PUSHJ P,BEGCRF ;NOTE DEFINITION IN CREF
LDB T1,DEFFLG ;LOOK AT FLAGS
TRNE T1,MULF ;IS THIS MULTIPLY DEFINED?
MSG CPOPJ, MULTIPLY DEFINED SYMBOL
POPJ P,
MAKS1: SKIPN NAME ;NO DEFINED YET
MSG CPOPJ, CAN'T DEFINE NULL SYMBOL
TRNE F,PASS2
MSG STOP, !!SYMBOL UNDEFINED ON PASS2!!
PUSH P,N
PUSHJ P,GETROM
HRRZM N,SPNT
POP P,N1
HLRZ N,SYMLNK(N1)
HRLZM N,SYMLNK(SPNT) ;LINK TO NEXT SYMBOL
HRLM SPNT,SYMLNK(N1)
MOVSI T1,NAME
HRRI T1,SYMTXT(SPNT)
BLT T1,SYMTXT+NWORDS-1(SPNT)
SETZM SYMVAL(SPNT)
SETZM SYMVAL+1(SPNT)
DPB RAM,DEFTYP
SETZM SYMCRF(SPNT) ;INIT CREF LIST STRUCTURE
JRST CPOPJ1
SRCFLD: MOVEI N,FLDPNT
SRCF2: MOVEI N1,(N) ;SAVE POINTER TO LAST LOWER FIELD
HRRZ N,SYMLNK(N)
JUMPE N,SRCX ;QUIT IF END OF LIST
REPEAT NWORDS,[
MOVE T1,FIELD+.RPCNT
CAMLE T1,.RPCNT+SYMTXT(N)
JRST SRCF2
CAME T1,.RPCNT+SYMTXT(N)
JRST SRCX ;NO MATCH, RETURN PTR TO SMALLER FLD
]
HRRZ FPNT,N
HRRZ SPNT,N
LDB T1,DEFTYP
CAIE T1,(RAM) ;DOES FIELD TYPE MATCH CURRENT MODE?
JRST SRCF2 ;NO, LOOK SOME MORE
JRST CPOPJ1 ;YES, SKIP RETURN
SRCX: MOVEI N,(N1) ;GET POINTER TO SMALLER FIELD
POPJ P, ;RETURN NO MATCH
SRCSYM: PUSHJ P,SRCSY1 ;LOOK FOR SYMBOL
POPJ P, ;WASN'T THERE
PUSHJ P,MAKCRF ;WAS, CREF THE REFERENCE
JRST CPOPJ1
SRCSY1: MOVEI N,(FPNT)
SRCS2: MOVEI N1,(N)
HLRZ N,SYMLNK(N)
JUMPE N,SRCX ;END OF LIST, RETURN NO MATCH
REPEAT NWORDS,[
MOVE T1,NAME+.RPCNT
CAMLE T1,.RPCNT+SYMTXT(N)
JRST SRCS2 ;TRY NEXT ENTRY, THIS IS TOO SMALL
CAME T1,.RPCNT+SYMTXT(N)
JRST SRCX ;NO CAN FIND
]
MOVEI SPNT,(N) ;THIS IS THE SYMBOL
JRST CPOPJ1
MAKCRF: TRNN F,PASS2
POPJ P, ;BUILD CREF ON PASS2
TDZA N1,N1 ;CLEAR DEFINE FLAG
BEGCRF: MOVEI N1,400000 ;FLAG AS DEFINITION
MOVEI N,1 ;GET 1 WORD FOR CREF REFERENCE
PUSHJ P,GETWRD
HLRZ T1,SYMCRF(SPNT) ;GET LAST ADR IN LIST
HRLM N,SYMCRF(SPNT) ;MAKE NEW WORD LAST ADR
SKIPN T1 ;IF OLD LAST ADR IS ZERO, THEN
MOVEI T1,SYMCRF(SPNT) ; LAST ADR IS IN SYMBOL BLOCK
HRRM N,(T1) ;PUT THIS WORD ONTO END OF LIST
IFN FTCOIN, HRRZ T1,CRFLIN ;GET LINE # AT WHICH THIS WORD STARTED
IFE FTCOIN, HRRZ T1,LINNUM ;GET CURRENT LINE NUMBER
IOR T1,N1 ;PUT DEFINE FLAG, IF ANY, IN
HRLZM T1,(N) ; STUFF INTO WORD NOW ON LIST END
; AND MAKE POINTER TO NEXT BE 0
POPJ P,
GETROM: MOVEI N,SYMLEN ;GET ROOM FOR NEW SYM TABLE ENTRY
GETWRD: PUSH P,.JBFF
ADDB N,.JBFF
CAMGE N,.JBREL
JRST GETW2
CAIL N,HGHSEG
MSG STOP,VIRTUAL MEMORY FULL
LSH N,-10.
.CALL [ SETZ ;GET FRESH PAGE
'CORBLK
MOVEI %CBRED+%CBWRT+%CBNDW+%CBNDR
MOVEI %JSELF
MOVEI (N)
SETZI %JSNEW ]
.LOSE %LSSYS
MOVEI N,2000
ADDM N,.JBREL
GETW2:
NPOPJ: POP P,N
POPJ P,
SUBTTL LEXICAL ANALYZER
;SUBROUTINE TO BUILD A SYMBOLIC OR NUMERIC TOKEN
; ENTRY TOKEN - BUILD SYMBOL, OCTAL NUMBER, OR DECIMAL NUMBER
; ENTRY TOKN10 - BUILD SYMBOL, OR DECIMAL NUMBER
;OCTAL NUMBERS ARE OF FORM <+,-, ><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_3 ;ENTRY FOR SYM,DEC# START WITH STATE 5
MOVEM T1,TOKSTA' ;INIT STATE TABLE
SETZM TKZER
MOVE T1,[TKZER,,TKZER+1]
BLT T1,TKZEND-1 ;INITIALIZE TOKEN VALUES
MOVE T1,[POINT 7,NAME]
MOVEM T1,TOKPNT' ;INIT SYMBOL BUILD POINTER
MOVE T1,[POINT 7,TKARGB-1,35]
MOVEM T1,TKAPNT' ;INITIALIZE ARGUMENT BUFFER POINTER
TOK2: PUSHJ P,GETCHM ;GET NEXT CHARACTER
MOVE T1,TOKSTA ;GET OLD STATE
ANDI T1,170 ;AND EXTRACT STATE BITS
LDB T2,TOKTYP ;GET CHARACTER TYPE
IOR T1,T2 ; AND COMBINE WITH OLD STATE
IDIVI T1,4 ;GET NEXT STATE, 4 ENTRIES/WORD
LDB T1,TOKNXT(T1+1)
MOVEM T1,TOKSTA ;SAVE NEW STATE
ANDI T1,7 ; AND EXTRACT DISPATCH ADDRESS
XCT TOKXCT(T1) ;PROCESS CURRENT CARACTER
JRST TOK3 ;INCLUDE IN SYMBOL
JRST TOK2 ;GO GET NEXT CHARACTER
TOK3: MOVE T1,TOKPNT ;GET SYMBOL BUILD POINTER
CAME T1,[POINT 7,NAME+NWORDS-1,34-7]
IDPB C,TOKPNT ;ROOM FOR CHAR, STORE AWAY
CAIE C,"[ ;IF MACRO CALL, STASH ARGUMENT
JRST TOK2 ;OTHERWISE GO GET NEXT CHARACTER
TKA1: PUSHJ P,GETCHM ;LOOP STASHING MACRO ARGUMENT CHARACTERS
CAIN C,"]
JRST TKA2 ;END OF ARGUMENT
MOVE T1,TKAPNT
CAMN T1,[POINT 7,TKARGB+NARGWD-1,34-7]
MSG TKA1,MACRO ARGUMENTS TOO LONG
IDPB C,TKAPNT
JRST TKA1
TKA2: MOVE T1,TKAPNT ;TERMINATE ARGUMENT
CAMN T1,[POINT 7,TKARGB+NARGWD-1,34-7]
MSG TKA1,MACRO ARGUMENTS TOO LONG
MOVEI T1,0
IDPB T1,TKAPNT
JRST TOK3 ;CLOSE BRACKET IS PART OF ARGUMENT
; EXECUTE TABLE
TOKXCT: SKIPA ; 0 IGNORE CHARACTER
JFCL ; 1 INCLUDE IN SYMBOL ONLY
SETOM TOKMIN ; 2 SET MINUS FLAG
PUSHJ P,TOKDIG ; 3 PROCESS 0-9
JRST TOK5 ; 4 RETURN .TKB - NO TOKEN
JRST TOK6 ; 5 RETURN .TKS - SYMBOL
JRST TOK7 ; 6 RETURN .TKN - DECIMAL NUMBER
JRST TOK8 ; 7 RETURN .TKN - OCTAL NUMBER
;MARGINAL INDEX TABLE INTO TOKTAB
TOKNXT: PINDEX 9,TOKTAB(T1)
DEFINE BYTE A,B,C,D,E,F,G,H
.BYTE 9
A ? B ? C ? D ? E ? F ? G ? H
.BYTE
TERMIN
;STATE TABLE. THE ROWS ARE INDEXED BY STATE; COLUMNS BY CHAR TYPE.
; EACH ENTRY CONSISTS OF 2 DIGITS- 2ND IS INDEX INTO TOKXCT, 1ST
; IS THE NEW STATE NUMBER.
TOKTAB: ;TERM, " ", ".", "+", "-", 0-7, 8-9,OTHER LEGAL SYM CHAR
BYTE 04, 00, 11, 21, 22, 23, 33, 11 ;STATE #0
BYTE 05, 61, 11, 11, 11, 11, 11, 11 ;STATE #1
BYTE 07, 71, 41, 11, 11, 23, 33, 11 ;STATE #2
BYTE 06, 101, 41, 11, 11, 33, 33, 11 ;STATE #3
BYTE 06, 111, 11, 11, 11, 11, 11, 11 ;STATE #4
BYTE 54, 50, 11, 31, 32, 33, 33, 11 ;STATE #5
BYTE 05, 60, 11, 11, 11, 11, 11, 11 ;STATE #6
BYTE 07, 70, 41, 11, 11, 23, 33, 11 ;STATE #7
BYTE 06, 100, 41, 11, 11, 33, 33, 11 ;STATE #10
BYTE 06, 110, 11, 11, 11, 11, 11, 11 ;STATE #11
;STATE #0 - FLUSHES SPACES, ALLOWS + OR - FOR NUMBERS
;STATES #1,6 - BUILDS SYMBOLS, A CHARACTER WAS ILLEGAL FOR A NUMBER
;STATES #2,7 - BUILDS OCTAL NUMBER UNTIL 8,9, OR (.) SEEN
;STATES #3,10 - BUILDS DECIMAL NUMBER
;STATES #4,11 - A (.) SEEN AFTER A NUMBER, GO TO #1 FOR ANYTHING OTHER
; THAN SPACE OR TERM.
;STATE #5 - SAME AS #0 EXCEPT ANY NUMBER IS FORCED DECIMAL
; STATES #6-11 FLUSH MULTIPLE SPACES
EXPUNGE BYTE
TOKDIG: MOVEI T1,-"0(C) ;EXTRACT DIGIT FORM ASCII CHAR
MOVEI T2,8.
IMULM T2,TOKOCT ;BUILD OCTAL NUMBER
ADDM T1,TOKOCT ; AND ADD IN NEXT DIGIT
MOVEI T2,10.
IMULM T2,TOKDEC ;BUILD DECIMAL NUMBER
ADDM T1,TOKDEC ; AND ADD IN NEXT DIGIT
POPJ P,
TOK5: MOVEI N,.TKB
JRST TOK99
TOK6: MOVEI T1,0 ;TRAILING SPACE FLUSHER FOR SYMBOLS
LDB T2,TOKPNT ;GET LAST CHAR IN SYMBOL
CAIN T2,40
DPB T1,TOKPNT ;REPLACE A TRAILING SPACE WITH NULL
MOVEI N,.TKS
JRST TOK99
TOK7: SKIPA N,TOKDEC ;PICK UP DECIMAL NUMBER
TOK8: MOVE N,TOKOCT ;PICK UP OCTAL NUMBER
SKIPGE TOKMIN
MOVNS N ;NEGATE IF MINUS FLAG SET
MOVEM N,NUMBER
MOVEI N,.TKN
TOK99: POPJ P,
SUBTTL GETCHR - GET A CHARACTER
;LOWEST LEVEL ROUTINE TO GET A CHARACTER
; IF REREAD FLAG SET, RETURNS LAST CHARACTER READ
GETCHR: TRZE F,REREAD
JRST [ MOVE C,LASTC
POPJ P, ]
GETC1: SKIPE CHRPNT ;RESCANNING ANYTHING?
JRST [ ILDB C,CHRPNT ;YES, GET CHARACTER
JUMPN C,GETC9
PUSHJ P,RESTOR ;BUT NOTHING LEFT, POP MACRO STACK
JUMPN C,GETC9 ;TAKE SAVED CHARACTER IF ANY
JRST GETC1 ] ;NO SAVED CHARACTER, READ AGAIN
SOSGE INCNT
JRST GETC7
ILDB C,INPNT ;GET CHAR FROM INPUT FILE
GETC8: LDB C1,GETPNT ;TRANSLATE INPUT CHARACTER
JUMPE C1,GETC1
PNTLST: MOVEM C,EOLCHR ;SAVE LAST CHAR TO FIND WHAT ENDED LINE
CAIE C1,12 ;DON'T SAVE 12,13, OR 14
SOSG PNTCNT ;ROOM IN LISTING FILE (LEAVE 1 CHAR ROOM)
JRST .+2 ;NO
IDPB C,PNTPNT ;YES, SAVE INPUT CHAR IN OUTPUT LISTING
MOVE C,C1 ;SEND TRANSLATED CHAR TO CALLER
GETC9: MOVEM C,LASTC' ;SAVE CHAR FOR POSSIBLE RE-READS
POPJ P,
GETC7: MOVE C,[440700,,INBUF] ;REFILL BUFFER
MOVEM C,INPNT
MOVE C,[-BUFL,,INBUF]
.IOT INCHN,C
MOVEI C,-INBUF(C)
IMULI C,5 ;NUMBER OF CHARS READ
MOVEM C,INCNT
JUMPN C,GETC1
PUSHJ P,NXTFIL
SKIPA C,[12] ;END-OF-FILE RETURNS LINE-FEED
MOVEI C,14 ;START NEW FILE WITH FORM FEED
JRST GETC8
;BEGIN EXPANDING A MACRO
SAVE: PUSH PM,C ;SAVE DELIMITER AFTER MACRO NAME
PUSH PM,CHRPNT ;SAVE INPUT POINTER
MOVEM N,CHRPNT ;SET NEW INPUT POINTER
MOVN C,MARGSZ ;SAVE MACRO ARGUMENTS IF ANY
JUMPE C,SAVE2
HRLZ C,C
SAVE1: PUSH PM,MARGPT(C)
AOBJN C,SAVE1
SAVE2: PUSH PM,MARGSZ ;SAVE MACRO ARGUMENT BLOCK'S SIZE
MOVE C,TKAPNT ;SET UP NEW MACRO ARGUMENTS
SUBI C,TKARGB-1
HRRZM C,MARGSZ ;SIZE OF ARGS NOT INCLUDING POINTER
TRNN C,-1
POPJ P, ;NO ARGUMENTS
AOS MARGSZ
MOVE C,[POINT 7,MARGBF]
MOVEM C,MARGPT
MOVE C,[TKARGB,,MARGBF]
BLT C,MARGBF+NARGWD-1
POPJ P,
;FINISH EXPANDING A MACRO
RESTOR: POP PM,MARGSZ ;RESTORE MACRO ARGUMENTS
SKIPN C,MARGSZ
JRST RESTO2
RESTO1: POP PM,MARGPT-1(C)
SOJG C,RESTO1
RESTO2: POP PM,CHRPNT ;RESTORE INPUT POINTER
POP PM,C ;RESTORE LAST CHARACTER READ
POPJ P,
;GETCHR HACKING MACRO ARGUMENTS
GETCHM: PUSHJ P,GETCHR
CAIN C,"@
SKIPN CHRPNT
POPJ P,
PUSHJ P,GETCHR ;SEEN @ WHILE EXPANDING A MACRO
CAIL C,"1
CAILE C,"9
MSG CPOPJ,MACRO ARGUMENT NUMBER OUT OF RANGE
SUBI C,"1
PUSH P,N
MOVE N,MARGPT ;DEVELOP POINTER TO ARG
JUMPE C,GETCM2
GETCM1: ILDB C1,N
JUMPN C1,GETCM1
SOJG C,GETCM1
GETCM2: PUSHJ P,SAVE ;START READING FROM ARG
POP P,N
JRST GETCHM
SUBTTL LISTING GENERATION
PNTLIN: PUSH P,C
TRNN F,PASS2\ERROR
JRST PNTL2 ;NO LIST ON PASS1, RE-INIT LISTING
TRNE F,NOBINF
JRST PNTLN0
MOVE N,MAXPOS+UCODE ;GET # BITS IN RAM
CAMGE N,MAXPOS+DISP
MOVE N,MAXPOS+DISP ;FIND LONGEST RAM LENGTH
ADDI N,11. ;RAM #S START AT 0, FORCE ROUNDUP
IDIVI N,12. ;GET HOW MANY DIGIT GROUPS
IMULI N,5 ;5 CHARACTERS PER GROUP
ADDI N,7 ;PLUS 7 EXTRA CHARACTERS
PUSHJ P,TABTON ;TAB OUT TO THERE
PNTLN0: PUSHJ P,PRINT ;PRINT SOURCE LINE
ASCIZ /; /
HRRZ C,LINNUM
PUSHJ P,PNTDEC
PUSHJ P,TAB
MOVEI C,0
IDPB C,PNTPNT
MOVEI N,PNTBUF
PUSHJ P,PRINT0
MOVE C,EOLCHR
CAIN C,14
JRST PNTL3
PUSHJ P,NEWLIN ;END LINE WITH 15,14
JRST PNTL2
PNTL3: MOVEI C,15
PUSHJ P,PUT
MOVEI C,14 ;END LINE WITH 15,14
PUSHJ P,PUT
PNTL2: AOS LINNUM ;INDEX LINE NUMBER
POP P,C
PNTINI: MOVE T1,[POINT 7,PNTBUF] ;INIT OUTPUT LIST LINE BUFFER
MOVEM T1,PNTPNT ;INIT OUTPUT BUFFER BYTE POINTER
MOVEI T1,PNTMAX
MOVEM T1,PNTCNT ;INIT OUTPUT BUFFER CHAR COUNT
POPJ P,
PNTBIN: TRNN F,BINF ;SKIP IF THERE IS A BINARY WORD ON THIS LINE
POPJ P,
PUSH P,C
HRRZ N,PC(RAM)
CAMLE N,HIGHPC(RAM) ;IS THIS THE HIGHEST PC USED SO FAR?
MOVEM N,HIGHPC(RAM) ;YES, SAVE FOR LOC'N LISTING
TRNE F,PASS2
PUSHJ P,DEFALT ;PUT IN PASS2 DEFAULTS
TRNN F,PASS2
JUMPE RAM,PNTB1 ;UCODE LOCATIONS NOT KNOWN ON PASS 1
PUSHJ P,USEDPC ;LOOK TO SEE IF THIS PC USED
MSG .+1, MICRO WORD USED TWICE
PNTB1: TRNN F,PASS2
JRST PNTB99
AOS WRDCNT(RAM) ;COUNT MICRO WORDS USED
MOVEI N,[ASCII /U /
ASCII /D /](RAM)
PUSHJ P,PRINT0
HRRZ C,PC(RAM)
PUSHJ P,PNTOC4
MOVE T1,[POINT 12,VALUE]
MOVEM T1,MICPNT'
SETZM MICCNT'
PUSHJ P,PRINT
ASCIZ /, /
JRST PNTB3
PNTB2: MOVEI C,",
PUSHJ P,PUT
PNTB3: ILDB C,MICPNT
PUSHJ P,PNTOC4
MOVEI T1,12.
ADDB T1,MICCNT
CAMG T1,MAXPOS(RAM)
JRST PNTB2
JUMPN RAM,PNTB99
SKIPN C,RAMFIL ;MOVE THIS WORD INTO RAMFILE BUFFER
JRST PNTB99 ;NO RAMFILE
HRRZ T1,PC(RAM)
IMUL T1,RFLNWD
ADD C,T1 ;C IS DESIRED WORD IN BUFFER
MOVE T2,RFLDPT ;T2 IS AOBJN POINTER TO FIELD BYTE POINTERS
PNTB90: LDB T1,RFLDS(T2) ;GET A FIELD
DPB T1,RFLDD(T2) ;DEPOSIT INTO RAMFILE BUFFER
AOBJN T2,PNTB90
MOVEI N,RFLPAR ;PARITY COMPUTATIONS
PNTB91: SKIPN T1,(N)
JRST PNTB99
LDB T2,[POINT 9,T1,26] ;FIRST BIT
IDIVI T2,36.
MOVEI T4,36.
SUB T4,T3
HRLI T2,000100+C
DPB T4,[POINT 6,T2,5] ;ILDB POINTER TO FIRST BIT IN PARITY COMP
ANDI T1,777 ;NUMBER OF BITS
LDB T3,[POINT 1,(N),0] ;INITIALIZE PARITY ACCUMULATOR
PNTB92: ILDB T4,T2
XOR T3,T4
SOJG T1,PNTB92
LDB T1,[POINT 9,(N),17] ;BIT POSITION TO STORE RESULT INTO
IDIVI T1,36.
ADD T1,C
MOVNS T2 ;RIGHT ROTATION
ROT T3,-1(T2) ;ALIGN PARITY BIT
XORM T3,(T1) ;STORE IT
CAIGE N,RAMFIL-1
AOJA N,PNTB91
PNTB99: PUSHJ P,PCNEXT ;GET NEXT PC SET UP
POP P,C
POPJ P,
FINLST: TRO F,ERROR\NOHDR ;FORCE NEXT MSG TO TTY, SUPPRESS HEADERS
PUSHJ P,PRINT
ASCIZ /
; Number of Micro Words used:
; D Words= /
MOVE C,WRDCNT+DISP
PUSHJ P,PNTDEC
PUSHJ P,PRINT
ASCIZ /
; U Words= /
MOVE C,WRDCNT+UCODE
PUSHJ P,PNTDEC
PUSHJ P,CRLF
TRZ F,ERROR ;"END" DOESN'T GO TO TTY CONSOLE
PUSHJ P,PRINT
ASCIZ /
END
/
TRZ F,NOHDR
;DROPS THROUGH
;DROPS IN
;START CREF LISTING
MOVEI C,[ASCIZ /CROSS REFERENCE LISTING/]
PUSHJ P,SETHDR
MOVEI FPNT,FLDPNT ;GET START OF SYM TABLE
CRFLUP: HRRZ FPNT,(FPNT) ;GET NEXT FIELD
JUMPE FPNT,CRFEND ;STOP AT END
MOVE SPNT,FPNT
LDB RAM,DEFTYP ;GET "UCODE" OR "DISP" NUMBER
MOVEI N,[ASCII /(U) /
ASCII /(D) / ] (RAM)
PUSHJ P,PRINT0
MOVEI N,SYMTXT(FPNT) ;GET TEXT ADDRESS
PUSHJ P,PRINT0 ; AND PRINT FIELD NAME
PUSHJ P,CRFLST ;LIST CREF FOR FIELD
CRSLUP: HLRZ SPNT,SYMLNK(SPNT) ;GET NEXT
JUMPE SPNT,CRFLUP ;GET NEXT FIELD IF NULL
MOVE T1,SYMTXT(SPNT)
PUSHJ P,TAB
MOVEI N,SYMTXT(SPNT) ;GET ADR OF SYMBOL
PUSHJ P,PRINT0
PUSHJ P,CRFLST
JRST CRSLUP
;HERE TO PRINT CREF FOR ONE SYMBOL
CRFLST: HRRZ N,SYMCRF(SPNT) ;GET POINTER TO 1ST ITEM
CRILUP: HRRZS N
JUMPE N,NEWLIN ;EXITS WITH POPJ
PUSH P,(N) ;SAVE LIST ITEM
MOVE T1,HORPOS ;GET HORIZONTAL POSITION
CAILE T1,120.+1 ;ROOM FOR ANOTHER ITEM?
PUSHJ P,NEWLIN ;NO
CRILP2: PUSHJ P,TAB ;TAB BEFORE EACH ITEM
MOVE T1,HORPOS
CAIGE T1,NCHARS+8 ;SPACED OVER SYMBOLS?
JRST CRILP2 ;NO, ANOTHER TAB NEEDED
HLRZ C,(P) ;GET LINE NUMBER
TRZ C,400000 ;CLEAR DEFINITION FLAG
PUSHJ P,PNTDEC
SKIPL 0(P) ;IS DEFINITION FLAG SET?
JRST CRILP3 ;NO
PUSHJ P,PRINT ;YES, FLAG IT
ASCIZ / #/
CRILP3: POP P,N
JRST CRILUP
;START LOCATION/LINE LISTING
CRFEND:
IFN FTMAP,[
MOVEI C,[ASCIZ \LOCATION / LINE NUMBER INDEX
; DCODE LOC'N 0 1 2 3 4 5 6 7\]
PUSHJ P,SETHDR
HRLO FPNT,HIGHPC+1 ;GET HIGHEST LOC'N IN DRAM USED
SETCA FPNT, ;USE AS LIMIT ON AOBJN POINTER
JRST DLOCST
DLCLUP: TRNE FPNT,7 ;TIME FOR A NEW LINE?
JRST DLOCL1 ;NO
PUSHJ P,NEWLIN ;YES
TRNN FPNT,70
PUSHJ P,NEWLIN ;DOUBLE SPACE AFTER 100
DLOCST: PUSHJ P,PRINT
ASCIZ /D / ;MARK AS DCODE LOC
MOVEI C,(FPNT) ;GET LOCATION
PUSHJ P,PNTOC4 ;PRINT IN OCTAL, 4 DIGITS
PUSHJ P,TAB
DLOCL1: PUSHJ P,TAB ;SPACE OVER
MOVEI C,(FPNT) ;COPY LOC'N
ROT C,-1 ;PREPARE INDEX INTO DTABL
SKIPGE C ;RIGHT OR LEFT?
SKIPA C,DTABL(C) ;RIGHT
MOVS C,DTABL(C) ;LEFT
TLZ C,-1 ;CLEAR OTHER HALF
SKIPE C ;IF USED,
PUSHJ P,PNTDEC ; PRINT IT
AOBJN FPNT,DLCLUP ;GO TO NEXT
PUSHJ P,CRLF ;RETURN TO LEFT MARGIN
MOVEI C,[ASCIZ \LOCATION / LINE NUMBER INDEX
; UCODE LOC'N 0 1 2 3 4 5 6 7\]
PUSHJ P,SETHDR
HRLO FPNT,HIGHPC ;GET HIGHEST LOC'N USED
SETCA FPNT, ;USE AS LIMIT ON AOBJN POINTER
JRST LOCST
LOCLUP: TRNE FPNT,7 ;TIME FOR A NEW LINE?
JRST LOCL1 ;NO
PUSHJ P,NEWLIN ;YES
TRNN FPNT,70 ;DOUBLE SPACE AFTER 100 LOC'S
PUSHJ P,NEWLIN
LOCST: PUSHJ P,PRINT
ASCIZ /U / ;MARK AS U LOC
MOVEI C,(FPNT) ;GET LOCATION
PUSHJ P,PNTOC4 ;PRINT IN OCTAL, 4 DIGITS
PUSHJ P,TAB
LOCL1: PUSHJ P,TAB ;SPACE OVER
HRRZ C,UTABL(FPNT) ;GET LINE # FOR THIS LOCATION
JUMPE C,LOCL2 ;LOCATION NOT USED
PUSHJ P,PNTDEC ; PRINT IT
HLRZ C,UTABL(FPNT) ;GET CHARACTER (REASON FOR LOC)
PUSHJ P,PUT
LOCL2: AOBJN FPNT,LOCLUP ;GO TO NEXT
PUSHJ P,CRLF ;RETURN TO LEFT MARGIN
];END IFN FTMAP
;HERE WHEN LISTING FINISHED
TRO F,ERROR\NOHDR ;FORCE NEXT MESSAGE TO TTY
SKIPN ERRCNT ;ANY ERRORS?
SKIPA N,[[ASCIZ /
NO/]]
MOVEI N,[ASCIZ /
? /]
PUSHJ P,PRINT0
SKIPE C,ERRCNT
PUSHJ P,PNTDEC ;NUMBER OF ERRORS IF ANY
PUSHJ P,PRINT
ASCIZ / ERROR/
MOVEI C,"S ;PLURAL
MOVE N,ERRCNT
CAIE N,1 ;IS IT PLURAL?
PUSHJ P,PUT ;YES
PUSHJ P,PRINT
ASCIZ / DETECTED
END OF MICRO CODE ASSEMBLY
USED /
.SUSET [.RRUNT,,C] ;GET FINAL RUNTIME
SUB C,STTIME ;GET USED RUNTIME (MS)
IDIVI C,250. ;GET MILLISECONDS
ADDI C,5 ;ROUND TO HUNDREDTH OF SEC
IDIVI C,10.
IDIVI C,100. ;GET HUNDREDTHS OF SEC
PUSH P,C+1 ;SAVE FRACTION
PUSHJ P,PNTDEC ;PRINT SECONDS
MOVEI C,".
PUSHJ P,PUT
POP P,C ;RECOVER FRACTION
PUSHJ P,PNTDC2
PUSHJ P,PRINT
ASCIZ / SECONDS
/
POPJ P, ;LISTING FINISHED
PRINT: POP P,N ;PRINT IN-LINE ASCIZ
PUSHJ P,PRINT0
JRST 1(N)
CRLF: MOVEI N,[ASCIZ /
/]
PRINT0: HRLI N,440700 ;PRINT ASCIZ N ->
PRINT1: ILDB C,N
JUMPE C,CPOPJ
PUSHJ P,PUT
JRST PRINT1
PNTSX0: HRLI N,440600 ;SIXBIT PRINTER
PNTSX1: TLNN N,770000
POPJ P,
ILDB C,N
JUMPE C,CPOPJ
ADDI C,40 ;CONVERT TO ASCII
PUSHJ P,PUT
JRST PNTSX1
PNTOCT: TDZA T1,T1
PNTOC4: MOVEI T1,4
PNTOC2: PUSHJ P,SGNCHK
PNTOC3: IDIVI C,8
HRLM C+1,(P)
SOSG T1
SKIPE C
PUSHJ P,PNTOC3
JRST PNTDC4
PNTDEC: TDZA T1,T1
PNTDC2: MOVEI T1,2
PUSHJ P,SGNCHK
PNTDC3: IDIVI C,10.
HRLM C+1,(P)
SOSG T1
SKIPE C
PUSHJ P,PNTDC3
PNTDC4: HLRE C,(P)
MOVMS C
ADDI C,"0
JRST PUT
SGNCHK: JUMPGE C,CPOPJ
PUSH P,C
MOVEI C,"-
PUSHJ P,PUT
POP P,C
MOVMS C
POPJ P,
NEWLIN: PUSHJ P,CRLF ;SEND END OF LINE
MOVE N,VERPOS ;HOW FAR DOWN PAGE
CAMGE N,LPPAG ;COMPARE LINES PER PAGE LIMIT
POPJ P,
JRST FORM ;EJECT & PRINT NEW HEADER
SETHDR: HRRZM C,HDRPNT ;SAVE ADDR OF NEW SUBHEADER
FORM: SKIPN VERPOS ;ALREADY AT TOP OF PAGE?
POPJ P, ;YES, DON'T BE REDUNDANT
SKIPA C,[14] ;AND GET NEW PAGE
TAB: MOVEI C,11
; JRST PUT
PUT: SKIPGE PAGNUM ;IS PAGE HEADER FLAG SET?
PUSHJ P,HEADER ;NEW HEADER FOR NEW PAGE
SOSG OUTCNT
PUSHJ P,OUTRFL
IDPB C,OUTPNT
CAIE C,^L ;DON'T FORMFEED THE TERMINAL
JRST [ TRNE F,ERROR
.IOT TYOC,C
JRST .+1 ]
TRNN C,140 ;SPACING CHARACTER?
JRST PUT2 ;NO
AOS HORPOS ;INDEX HORIZONTAL LINE POSITION
POPJ P,
PUT2: CAIN C,14
JRST [ AOS PAGNUM
HRROS PAGNUM ;SET HEADER FLAG
SETZM VERPOS
POPJ P, ]
CAIN C,15
SETZM HORPOS ;ZERO POSITION FOR CARRIAGE RETURN
CAIN C,12 ;LF?
AOS VERPOS ;YES, COUNT NEW LINE
CAIE C,11
POPJ P, ;NOT HORIZONTAL TAB
EXCH C,HORPOS
IORI C,7
ADDI C,1
EXCH C,HORPOS
POPJ P,
TABTON: PUSHJ P,TAB
CAMLE N,HORPOS
JRST TABTON
POPJ P,
;OUTPUT LAST BUFFERFULL
OUTCLS: MOVE T1,OUTPNT ;FILL LAST WORD WITH EOF CHRS
MOVEI C,^C
IDPB C,T1
TLNE T1,760000
JRST .-2 ;THEN FALL INTO OUTRFL
;OUTPUT BUFFER REFILL
OUTRFL: PUSH P,C
SKIPN C,OUTPNT ;GET NUMBER OF WORDS GENERATED SO FAR
JRST OUTRF1
HRLOI C,-OUTBUF(C) ;AND MAKE AOBJN POINTER (ASSUMING NO PARTIAL WORDS)
EQVI C,OUTBUF
.IOT OUTCHN,C
JUMPGE C,OUTRF1
.VALUE ;FAILED TO TRANSMIT ALL THE CRUFT?
OUTRF1: MOVE C,[440700,,OUTBUF]
MOVEM C,OUTPNT
MOVEI C,5*BUFL
MOVEM C,OUTCNT
POP P,C
POPJ P,
;PRINT HEADER ROUTINE
HEADER: HRRZS PAGNUM
TRNN F,NOHDR ;HEADERS SUPPRESSED?
TRNN F,PASS2
POPJ P,
PUSH P,16 ;SAVE AC'S 0-16
MOVEI 16,1(P)
BLT 16,16(P)
ADD P,[16,,16]
TRZ F,ERROR ;DON'T SEND HEADER TO TTY
; WILL BE RESTORED WITH AC'S
PUSHJ P,PRINT
ASCIZ /; /
MOVEI N,OUTFIL ;GET ADR OF OUTPUT FILE DESCRIPTOR
PUSHJ P,HEDNAM ;AND PRINT THE DESCRIPTOR
MOVEI N,32.
PUSHJ P,TABTON ;POSITION THE VERSION STUFF
PUSHJ P,PRINT
ASCIZ /MICRO /
MOVEI N,[.FNAM2]
PUSHJ P,PNTSX0
MOVEI N,48. ;SPACE OVER TO TITLE
PUSHJ P,TABTON
SKIPN N,TTLPNT ;IS THERE A TITLE?
MOVEI N,[ASCIZ /MICROCODE FILE/]
PUSHJ P,PRINT0 ;PRINT A TITLE
;HERE TO DO PAGE # & 2ND LINE OF HEADER
PUSHJ P,PRINT
ASCIZ / PAGE /
HRRZ C,PAGNUM
PUSHJ P,PNTDEC ;PRINT PAGE NUMBER
PUSHJ P,PRINT
ASCIZ /
; /
SKIPE N,HDRPNT ;SPECIAL HEADER?
JRST HEAD5 ;YES
MOVEI N,INFILE ;GET CURRENT INPUT FILE DESCRIPTOR
PUSHJ P,HEDNAM
MOVEI N,48.
PUSHJ P,TABTON ;TAB OVER FOR SUBTITLE
HLRZ N,TOCPNT ;GET SUBTTL STRING ADDR
JUMPE N,HEAD6 ;MAKE SURE THERE'S SOMETHING TO PRINT
MOVEI N,1(N) ;POINT TO TEXT STRING
HEAD5: PUSHJ P,PRINT0 ;PRINT SUBTTL OR SPECIAL HEADER
HEAD6: PUSHJ P,CRLF
PUSHJ P,CRLF
SUB P,[16,,16]
MOVSI 16,1(P)
BLT 16,15
POP P,16
POPJ P,
;SUBR TO PRINT FILENAME, TIME, AND DATE
HEDNAM: PUSH P,N ;SAVE DESCRIPTOR POINTER
ADDI N,F.DEV
PUSHJ P,PNTSX0
MOVEI C,":
PUSHJ P,PUT
MOVEI C,40
PUSHJ P,PUT
MOVE N,(P)
ADDI N,F.PPN
PUSHJ P,PNTSX0
MOVEI C,";
PUSHJ P,PUT
MOVEI C,40
PUSHJ P,PUT
MOVE N,(P)
ADDI N,F.NAM ;POINT TO FILE NAME
PUSHJ P,PNTSX0
MOVEI C,40
PUSHJ P,PUT
MOVE N,(P)
ADDI N,F.EXT
PUSHJ P,PNTSX0
PUSHJ P,TAB
POP P,N ;GET POINTER TO BLOCK BACK
MOVE C,F.TIM(N)
LSH C,-2
ASH C,-2
AOJE C,CPOPJ ;SUPPRESS DATE/TIME IF "-"
HRRZ C,F.TIM(N) ;GET 1/2 SECONDS SINCE MIDNIGHT
LSH C,-1
IDIVI C,3600.
PUSH P,C1
PUSHJ P,PNTDC2 ;HOURS
MOVEI C,":
PUSHJ P,PUT
POP P,C
IDIVI C,60.
PUSH P,C1
PUSHJ P,PNTDC2 ;MINUTES
MOVEI C,":
PUSHJ P,PUT
POP P,C
PUSHJ P,PNTDC2 ;SECONDS
MOVEI C,40
PUSHJ P,PUT
LDB C,[.BP (37),F.TIM(N)]
PUSHJ P,PNTDEC ;DAY
LDB C,[.BP (740),F.TIM(N)]
PUSH P,N
MOVEI N,[SIXBIT /-JAN-/
SIXBIT /-FEB-/
SIXBIT /-MAR-/
SIXBIT /-APR-/
SIXBIT /-MAY-/
SIXBIT /-JUNE-/
SIXBIT /-JULY-/
SIXBIT /-AUG-/
SIXBIT /-SEPT-/
SIXBIT /-OCT-/
SIXBIT /-NOV-/
SIXBIT /-DEC-/ ]-1(C) ;INDEX INTO TABLE BY MONTH
PUSHJ P,PNTSX0
POP P,N
LDB C,[.BP (177000),F.TIM(N)]
ADDI C,1900.
PUSHJ P,PNTDEC ;YEAR
POPJ P,
SUBTTL MICRO-LOCATION ASSIGNMENT
;ADD LOCTAB ENTRY
;N HAS DESIRED WORD, EXCEPT T1 HAS %%LCOP FIELD
;ON PASS 2, PC IS RETURNED IN N FOR OPS THAT GET A PC
ADDLOC: DPB T1,[%%LCOP,,N] ;COMPLETE DESIRED WORD
SKIPL T1,LOCPNT
JRST ADDLC9 ;AOBJN POINTER COUNTED OUT LAST TIME
ADD T1,[1,,1]
MOVEM T1,LOCPNT
TRNE F,PASS2
JRST ADDLC2
MOVEM N,LOCTAB-1(T1) ;PASS 1 - JUST ADD TO TABLE
POPJ P,
ADDLC2: XOR N,LOCTAB-1(T1) ;PASS 2 - VERIFY AGAINST TABLE
TLZ N,077777 ;CLEAR %LCLOC, %%LCPC
JUMPN N,ADDLC3 ;VALUES DON'T AGREE
LDB N,[%%LCPC,,LOCTAB-1(T1)]
POPJ P,
ADDLC3: LDB N,[%%LCOP,LOCTAB-1(T1)] ;MAYBE A SAVED ERROR MESSAGE
CAIN N,%LCERR
MSG CPOPJ,!! LOCTAB PHASE ERROR !!
MOVS N,LOCTAB-1(T1) ;MSG COMES FROM RH OF LOCTAB ENTRY
HRRI N,CPOPJ ;EXIT ACTION IS JUST RETURN
1000,,N ;COMPLAIN
ADDLC9: TRNN F,PASS2
MSG STOP,!! LOCTAB NOT BIG ENOUGH !!
MSG STOP,!! PASS 2 READ PAST END OF LOCTAB !!
;SEARCH FOR FREE MICRO WORDS.
; LOCPAT CONTAINS THE 1'S PATTERN
; LOCAST CONTAINS THE ASTERISK "DON'T CARE" PATTERN
; FRECNT CONTAINS THE SIZE OF THE BLOCK WITHIN WHICH
; THE PATTERN OF LOCPAT EXISTS. FRECNT IS ALWAYS
; A SINGLE BIT.
;SUBROUTINE RETURNS THE 1ST LOCATION MEETING CRITERIA AND SKIPS.
;IF CRITERIA CANNOT BE MET WITH ANY LOCATION, THEN NO SKIP
;*** TEMPORARY HACK: ***
; IF THE PATTERN IS MORE THAN 5 BITS WIDE, MATCH IT,
; BUT DO NOT LOOK FOR FREE WORDS OUTSIDE A 32-WORD BLOCK,
; AND RESTRICT PC DEFAULT PROGRESSION TO 32-WORD BLOCK.
FREWRD: JUMPN RAM,STOP
MOVE T1,LOCPAT ;GET PATTERN TO MATCH
IOR T1,LOCAST ;COUNT IN THE *'S
ANDI T1,FRESIZ-1 ;*** LOOK ONLY AT LOW BITS ***
MOVE T1,FRETAB(T1) ;GET LIST OF WORDS FITTING PATTERN
MOVEI T2,FRESIZ ;TABLE IS BUILT FOR 32 WORDS
SUB T2,FRECNT ;GET # OF WORDS TO THROW AWAY
SKIPL T2 ;*** NO SHIFT IF NEGATIVE ***
LSH T1,(T2) ; AND THROW THEM AWAY
MOVEM T1,FREMSK' ;SAVE PATTERN FOR MATCHING
MOVSI N,-MAXPC/36. ;SET UP TABLE LENGTH
FREE2: SETCM T1,USAGE(N) ;GET 1'S FOR FREE PC BITS
FREE3: JFFO T1,FREE5 ;IF ANY FREE HERE, XFER
AOBJN N,FREE2 ;KEEP LOOKING UNTIL ALL GONE
POPJ P, ;NO SUCH STRING
FREE5: HRRZ N1,T1+1 ;GET LEFT MOST BIT # TO BETTER PLACE
SETCM T1+1,USAGE+1(N) ;GET FREE BITS FROM NEXT WORD
LSHC T1,(N1) ;PUT 1ST FREE BIT INTO BIT 0
MOVE T2,T1 ;COPY
AND T2,FREMSK ;LOOK ONLY FOR REQUIRED STRING
HRRZ T3,N ;GET PC FOR THIS BIT
IMULI T3,36.
ADD T3,N1
MOVE T4,FRECNT ;GET MASK FOR PC ZEROS
SUBI T4,1 ;POWER OF 2 CHANGED TO STRING OF 1'S
AND T4,T3 ;GET PC BITS TO TEST
ANDCM T4,LOCAST ;IGNORE PLACES WHERE *'S ARE IN PATTERN
CAMN T2,FREMSK ;PC BITS FREE?
CAME T4,LOCPAT ;CORRECT BIT PATTERN?
JRST FREE6 ;NO OR NO
BLKCNT: MOVN T1,FRECNT ;COUNT WORDS IMPLIED BY FRECNT
ORCMI T1,FRESIZ-1 ;*** IF FRECNT .GT. FRESIZ, USE FRESIZ ***
ANDCB T1,LOCPAT ; AND LOCPAT
ANDCM T1,LOCAST ;*'S DON'T COUNT
MOVSI N,-1
BLKC2: JUMPN T1,[ANDI T1,-1(T1)
ASH N,1
JRST BLKC2 ]
HRR N,T3 ;INSERT PC
JRST CPOPJ1
FREE6: MOVEI T4,1 ;THROW AWAY 1 FREE WORD
LSH T1,(T4) ; AND WIPE OUT THAT MANY BITS
ADD N1,T4 ;CALC TOTAL # OF SHIFT PLACES
MOVNS N1
LSH T1,(N1) ; AND SHIFT PC BITS BACK TO PLACE
JRST FREE3 ;GO LOOK SOME MORE
FRESIZ==32. ;TABLE IS 32 WORDS OF 32 BITS
FRETAB: .BYTE 1
REPEAT 32.,[
.WALGN
XB==.RPCNT
REPEAT 32., IFE .RPCNT&XB,[1]+0
]
.BYTE
PCNEXT: JUMPN RAM,PCNXT1 ;DRAM JUST INCREMENTS
MOVE N,PC(RAM)
JUMPGE N,PCNXT1 ;IF NOT IN ADR BLOCK, IS UNCONSTRAINED
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, ADR BLOCK ENDED
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
MOVEM N,PC(RAM)
POPJ P,
;NEXT PC WHEN UNCONSTRAINED
;IF NOT SEQUENTIAL ADDRESS MODE, THIS PC+1 WILL GET CLOBBERED LATER
PCNXT1: HRRZS PC(RAM) ;CLEAR ADR BLOCK FLAG
AOS N,PC(RAM)
POPJ P,
;TEST PC LOCATION FOR PREVIOUS USAGE
; IF USED, NO SKIP ;IF NOT USED, SKIP
USEDPC: HRRZ N,PC(RAM)
JUMPN RAM,USED1 ;DIFFERENT IF DISPATCH
CAIN N,-1
JRST CPOPJ1 ;PC NOT KNOWN YET
IDIVI N,36.
MOVN T1,N1 ;NEGATE REMAINDER FOR RIGHT SHIFTS
MOVSI N1,(SETZ)
LSH N1,(T1)
TDNN N1,USAGE(N)
AOS (P)
IORM N1,USAGE(N)
POPJ P,
USED1: TRNN F,PASS2 ;COLLECT THIS ON PASS 2 ONLY
JRST CPOPJ1
ROT N,-1 ;DIVIDE BY 2
JUMPL N,USED2 ;ODD, USE RH
HLRZ N1,DTABL(N) ;PREVIOUS CONTENTS
JUMPN N1,CPOPJ ;ERROR IF ALREADY SET
MOVE N1,LINNUM ;ELSE GET THIS LINE #
HRLM N1,DTABL(N) ;AND RECORD IT
JRST CPOPJ1 ;OK RETURN
USED2: HRRZ N1,DTABL(N)
JUMPN N1,CPOPJ
MOVE N1,LINNUM
HRRM N1,DTABL(N)
JRST CPOPJ1
SUBTTL UUO HANDLER - ERROR MESSAGE PRINTER
UUOH: PUSH P,C
LDB C,[331100,,40] ;GET OPCODE
CAIN C,1
JRST UUOHM ;MSG
CAIE C,2
.VALUE ;ILUUO - E.G. HALT
MOVE C,40 ;OUTSTR
HRLI C,440700
PUSH P,N
UUOHOS: ILDB N,C
JUMPE N,UUOHSX
.IOT TYOC,N
JRST UUOHOS
UUOHSX: POP P,N
POP P,C
POPJ P,
;HERE TO PRINT ERROR MESSAGE
;CALLED BY LUUO
UUOHM: TRO F,ERROR
AOS ERRCNT
EXCH N,40
HRRZ T1,(N)
MOVEM T1,-1(P) ;SAVE RETURN
PUSH P,40 ;SAVE N
SKIPN OUTFIL+F.DEV ;IS THERE A FILE ONTO WHICH TO PUT MESSAGE?
JRST NOEFIL ;NOPE, JUST TTY
;FIRST LINE -- MESSAGE TEXT AS SPECIFIED BY CALLER
.IOT TYOC,[15] ;BLANK LINE ON TTY FOR READABILITY
.IOT TYOC,[12]
MOVEI C,"; ;PUT ERROR COMMENT
PUSHJ P,PUT
HLRZ N,(N) ;GET ADR OF MSG
PUSHJ P,PRINT0
;SECOND LINE -- CONTEXT OF ERROR
PUSHJ P,PRINT
ASCIZ /
; /
SKIPN RAM
TRNE F,PASS2
CAIA
JRST UUOHM1 ;UCODE PC NOT KNOWN ON PASS 1
MOVEI N,[ ASCII /U= /
ASCII /D= / ](RAM)
PUSHJ P,PRINT0
HRRZ C,PC(RAM)
PUSHJ P,PNTOC4
MOVEI N,[ASCIZ /, /]
UUOHM1: SKIPN NAME
SKIPE FIELD
PUSHJ P,PRINT0 ;GIVE COMMA SPACE IF FIELD OR NAME TO BE PRINTED
MOVEI N,FIELD
PUSHJ P,PRINT0
MOVEI C,"/
SKIPE FIELD
PUSHJ P,PUT
MOVEI N,NAME
PUSHJ P,PRINT0
MOVE N,I.MAXC ;# OF SOURCE FILES
CAIG N,1 ; MORE THAN ONE?
JRST UUOHP ;NO. NO NEED TO IDENTIFY WHICH
PUSHJ P,PRINT ;YES. IDENTIFY IT
ASCIZ /, FILE= /
MOVEI N,INFILE+F.DEV
PUSHJ P,PNTSX0
PUSHJ P,PRINT
ASCIZ/: /
MOVEI N,INFILE+F.PPN
PUSHJ P,PNTSX0
PUSHJ P,PRINT
ASCIZ/; /
MOVEI N,INFILE+F.NAM ;ADDR OF CURRENT INPUT NAME
PUSHJ P,PNTSX0 ;PRINT IT
MOVEI C,40
PUSHJ P,PUT
MOVEI N,INFILE+F.EXT
PUSHJ P,PNTSX0
UUOHP: TRNN F,PASS2
JRST UUOHL ;PAGE # MEANINGLESS ON PASS 1
PUSHJ P,PRINT
ASCIZ /, PAGE= /
HRRZ C,PAGNUM
PUSHJ P,PNTDEC
UUOHL: PUSHJ P,PRINT
ASCIZ /, LINE= /
HRRZ C,LINNUM
PUSHJ P,PNTDEC
IFN FTECHR,[
PUSHJ P,PRINT
ASCIZ /, CHAR= /
MOVE C,-1(P) ;GET C BACK
MOVEI T1,3 ;TYPE 3 OCTAL DIGITS
PUSHJ P,PNTOC2
];END IFN FTECHR
PUSHJ P,CRLF
MOVEI C,"?
PUSHJ P,PNTLST
POP P,N
POP P,C
POPJ P,
NOEFIL: HLRZ N,(N) ;ADDR OF MESSAGE
.IOT TYOC,["?] ;MAKE IT ERROR-FORM
OUTSTR (N) ;TYPE MESSAGE
OUTSTR [ASCIZ /
/]
EXIT
STOP:
REPEAT 16.,MOVEM .RPCNT,SAVACS+.RPCNT
MSG .+1,[ INTERNAL ERROR, "SAVE" CORE IMAGE
AND (DON'T REALLY!) CALL JUD LEONARD, MARLBORO, X6104]
.VALUE
SUBTTL OPEN INPUT FILE
BEGIO: MOVE T1,I.MAXC ;START LOOKING AT 1ST FILE
MOVNM T1,I.CNT ;INIT COUNTER TO NUMBER OF FILES
NXTFIL: SETOM ENDFIL ;SET END-OF-FILE INDICATOR
SKIPL I.CNT
POPJ P, ;NO FILES LEFT
MOVE C,I.MAXC ;GET NEXT INPUT FILE DESCRIPTOR
ADD C,I.CNT ;C HAS FILE NUMBER
IMULI C,I.LEN
ADDI C,I.STG ;NOW C -> FILE DESC
.CALL [ SETZ
SIXBIT/OPEN/
[.BAI,,INCHN]
I.DEV(C)
I.NAM(C)
I.EXT(C)
SETZ I.PPN(C) ]
PUSHJ P,IFOPER
MOVE C,I.DEV(C) ;.RCHST SCREWS DEVICE NAME
MOVEM C,INFILE+F.DEV
MOVE C,[INCHN,,RCHST]
.RCHST C,
MOVE C,RCHST+1
MOVEM C,INFILE+F.NAM
MOVE C,RCHST+2
MOVEM C,INFILE+F.EXT
MOVE C,RCHST+3
MOVEM C,INFILE+F.PPN
SETO C,
.CALL [ SETZ
'RFDATE
MOVEI INCHN
SETZM INFILE+F.TIM ]
PUSHJ P,IFOPER
AOS I.CNT ;NEXT FILE
SETZM ENDFIL ;CLEAR END-OF-FILE INDICATOR
CPOPJ1: AOSA (P) ;FILE FOUND, SKIP RETURN
POP1J: SUB P,[1,,1]
CPOPJ: POPJ P,
.TNEWL==CPOPJ ;???
;FILE SYSTEM ERROR HANDLING
OFOPER: MOVEI C,O.DEV
IFOPER: PUSH P,T1
PUSH P,T2
.IOT TYOC,[^M]
.IOT TYOC,["?]
.IOT TYOC,[" ]
.OPEN ERRC,[.UAI,,'ERR ? 1]
.LOSE %LSFIL
IFOPE1: .IOT ERRC,T1
CAIGE T1,40
JRST IFOPE2
.IOT TYOC,T1
JRST IFOPE1
IFOPE2: .CLOSE ERRC,
SKIPGE C
EXIT
.IOT TYOC,[40]
.IOT TYOC,["-]
.IOT TYOC,[40]
MOVE T2,I.DEV(C)
PUSHJ P,IFOPE3
.IOT TYOC,[":]
MOVE T2,I.PPN(C)
PUSHJ P,IFOPE3
.IOT TYOC,[";]
MOVE T2,I.NAM(C)
PUSHJ P,IFOPE3
.IOT TYOC,[40]
MOVE T2,I.EXT(C)
PUSHJ P,IFOPE3
.IOT TYOC,[15]
PUSH P,FPNT
PUSH P,SPNT
PUSH P,T3
PUSH P,T4
OUTSTR [ASCIZ/USE WHAT FILENAME INSTEAD? /]
PUSHJ P,FNR."RLINE
SETOM 1FLFLG
MOVE FPNT,C
PUSHJ P,FNR."FNRAA
IRPS R,,T4 T3 SPNT FPNT T2 T1
POP P,R
TERMIN
SOS (P)
SOS (P)
POPJ P, ;RETRY THE .CALL
IFOPE3: MOVEI T1,0
LSHC T1,6
ADDI T1,40
.IOT TYOC,T1
JUMPN T2,IFOPE3
POPJ P,
SUBTTL MOOOOBY TABLES
DEFTAB: 0,,BITSET ;TABLE OF SPECIAL DEFINE FUNCTIONS
"+,,PCINC ;PUT PC INTO VALUE FIELD
"D,,BITSET ;DEFAULT FUNCTION FOR FIELDS
"T,,TIMSET ;DEFAULT FUNCTION FOR TIME FIELD
"P,,PARITY ;PARITY DEFAULT FUNCTION
"F,,DFLOTH ;DEFAULT TO OTHER FIELD
DEFTND:
NDFTAB: NGETA6
NGETA6
NGETA7 ;D
NGETA6
NGETA6
NGETA8 ;F
DEFTYP: POINT 1,SYMVAL(SPNT),0 ;"UCODE" OR "DISP" NUMBER
DEFFLG: POINT 1,SYMVAL(SPNT),1 ;FLAGS FOR A SYMBOL
DEFTM1: POINT 4,SYMVAL(SPNT),5 ;TIME VALUE #1
DEFTM2: POINT 4,SYMVAL(SPNT),9 ;TIME VALUE #2
DEFPOS: POINT 8,SYMVAL(FPNT),9 ;MICRO WORD POSITION
DEFSIZ: POINT 5,SYMVAL(FPNT),14 ;MICRO WORD FIELD SIZE
DEFFNC: POINT 3,SYMVAL(SPNT),17 ;FUNCTION TO EXECUTE
DEFVAL: POINT 18,SYMVAL(SPNT),35 ;VALUE OF SYMBOL (RH OF SYMVAL)
;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 3,CHRTAB(C),2 ;GET CHARACTER TYPE FOR TOKEN BUILDER
STAPNT: POINT .SZTRM,CHRTAB(C),2+.SZTRM ;TERM TYPE FOR TOP LEVEL STATE
GETPNT: POINT 7,CHRTAB(C),35 ;CHARACTER TRANSLATION
IF2 .SHTRM==41-.SZTRM
DEFINE BYTS A,B,C
<A>_41+<B>_.SHTRM+<C>
TERMIN
CHRTAB: ;CHARACTER LOOK UP TABLE
;FIRST PARAMETER IS CHARACTER TYPE
;SECOND IS TERMINATOR SUB-TYPE
;THIRD IS TRANSLATED VALUE
BYTS ,,0 ; NUL
BYTS 7,,1 ; DOWN ARROW
BYTS 7,,2 ; ALPHA
BYTS ,,0 ; EOF CHARACTER (MUST IGNORE)
BYTS 7,,4 ; LOGICAL AND
BYTS 7,,5 ; LOGICAL NOT
BYTS 7,,6 ; EPSILON
BYTS 7,,7 ; PI
BYTS ,,10 ; BACKSPACE
BYTS ,,40 ; TAB
BYTS ,EOL,12 ; LF
BYTS ,EOL,12 ; VT
BYTS ,EOL,12 ; FF
BYTS ,,00 ; CR
BYTS 7,,16 ; INFINITY
BYTS 7,,17 ; PARTIAL DERIVATIVE
BYTS 7,,20 ; LEFT LUMP
BYTS 7,,21 ; RIGHT LUMP
BYTS 7,,22 ; UP LUMP
BYTS 7,,23 ; DOWN LUMP
BYTS 7,,24 ; FOR ALL
BYTS 7,,25 ; THERE EXISTS
BYTS 7,,26 ; WHEEL
BYTS 7,,27 ; LEFT-RIGHT ARROW
BYTS 7,,30 ; LEFT ARROW
BYTS 7,,31 ; RIGHT ARROW
BYTS 7,,32 ; NOT EQUAL
BYTS 7,,33 ; ALTMODE
BYTS 7,,34 ; LESS OR EQUAL
BYTS 7,,35 ; GREATER OR EQUAL
BYTS 7,,36 ; EQUIVALENCE
BYTS 7,,37 ; LOGICAL OR
BYTS 1,,040 ; SP
BYTS 7,,041 ; !
BYTS ,QOT,042 ; "
BYTS 7,,"# ; #
BYTS ,,"$ ; $
BYTS ,,"% ; %
BYTS ,,"& ; &
BYTS ,,"' ; '
BYTS 7,,"( ; (
BYTS 7,,") ; )
BYTS 7,,"* ; *
BYTS 3,,"+ ; +
BYTS ,COM,[",] ; ,
BYTS 4,,"- ; -
BYTS 2,,". ; .
BYTS ,SLSH,"/ ; /
BYTS 5,,"0 ; 0
BYTS 5,,"1 ; 1
BYTS 5,,"2 ; 2
BYTS 5,,"3 ; 3
BYTS 5,,"4 ; 4
BYTS 5,,"5 ; 5
BYTS 5,,"6 ; 6
BYTS 5,,"7 ; 7
BYTS 6,,"8 ; 8
BYTS 6,,"9 ; 9
BYTS ,COL,": ; :
BYTS ,EOL,073 ; ;
BYTS ,,074 ; <
BYTS ,EQL,"= ; =
BYTS ,,076 ; >
BYTS ,,"? ; ?
BYTS ,,"@ ; @
BYTS 7,,"A ; A
BYTS 7,,"B ; B
BYTS 7,,"C ; C
BYTS 7,,"D ; D
BYTS 7,,"E ; E
BYTS 7,,"F ; F
BYTS 7,,"G ; G
BYTS 7,,"H ; H
BYTS 7,,"I ; I
BYTS 7,,"J ; J
BYTS 7,,"K ; K
BYTS 7,,"L ; L
BYTS 7,,"M ; M
BYTS 7,,"N ; N
BYTS 7,,"O ; O
BYTS 7,,"P ; P
BYTS 7,,"Q ; Q
BYTS 7,,"R ; R
BYTS 7,,"S ; S
BYTS 7,,"T ; T
BYTS 7,,"U ; U
BYTS 7,,"V ; V
BYTS 7,,"W ; W
BYTS 7,,"X ; X
BYTS 7,,"Y ; Y
BYTS 7,,"Z ; Z
BYTS 7,,133 ; [
BYTS ,,"\ ; \
BYTS 7,,135 ; ]
BYTS ,,"^ ; ^
BYTS 7,,"_ ; _
BYTS ,,140 ; `
BYTS 7,,"A ; A (LOWER CASE)
BYTS 7,,"B ; B
BYTS 7,,"C ; C
BYTS 7,,"D ; D
BYTS 7,,"E ; E
BYTS 7,,"F ; F
BYTS 7,,"G ; G
BYTS 7,,"H ; H
BYTS 7,,"I ; I
BYTS 7,,"J ; J
BYTS 7,,"K ; K
BYTS 7,,"L ; L
BYTS 7,,"M ; M
BYTS 7,,"N ; N
BYTS 7,,"O ; O
BYTS 7,,"P ; P
BYTS 7,,"Q ; Q
BYTS 7,,"R ; R
BYTS 7,,"S ; S
BYTS 7,,"T ; T
BYTS 7,,"U ; U
BYTS 7,,"V ; V
BYTS 7,,"W ; W
BYTS 7,,"X ; X
BYTS 7,,"Y ; Y
BYTS 7,,"Z ; Z
BYTS ,,173 ; {
BYTS ,,174 ; |
BYTS ,,175 ; }
BYTS ,,176 ; ~
BYTS ,,000 ; DEL
IFN .-CHRTAB-128.,.ERR CHARACTER TABLE MESSED UP
IF1,[
.MXSTA==0
.MXTOK==0
.MXTRM==0
.MXDSP==0
DEFINE ITEM STATE,.TOKTYP,.TRMTYP,.DISP,.NSTATE
IRPS TOKTYP,,[.TOKTYP]TRMTYP,,[.TRMTYP]DISP,,[.DISP]NSTATE,,[.NSTATE]
IFG STATE-.MXSTA,.MXSTA==STATE
IFG TOKTYP-.MXTOK,.MXTOK==TOKTYP
IFG TRMTYP-.MXTRM,.MXTRM==TRMTYP
IFG DISP-STDISP-.MXDSP,.MXDSP==DISP-STDISP
IFG NSTATE-.MXSTA,.MXSTA==NSTATE
.STOP
TERMIN
TERMIN ;END OF DEFINE ITEM
DEFINE EXPAND N
BLOCK 1
TERMIN ;END OF DEFINE EXPAND
];END OF IF1
IF2,[
DEFINE ITEM STATE,.TOKTYP,.TRMTYP,.DISP,.NSTATE
IRPS TOKTYP,,[.TOKTYP]TRMTYP,,[.TRMTYP]DISP,,[.DISP]NSTATE,,[.NSTATE]
.XE==<STATE_.SZTOK+TOKTYP>_.SZTRM+TRMTYP
.XN==36./<.SZDSP+.SZSTA>
.XV==<DISP-STDISP>_.SZSTA+NSTATE
INSERT \<.XE/.XN>,\<.XE-.XE/.XN*.XN>
.STOP
TERMIN
TERMIN ;END OF DEFINE ITEM
DEFINE INSERT Q,R
IFNDEF .ENT!Q,.ENT!Q==0
.ENT!Q==.ENT!Q+.XV_<36.-<R+1>*<.SZDSP+.SZSTA>>
TERMIN ;END OF DEFINE INSERT
DEFINE EXPAND N
IFNDEF .ENT!N,.ENT!N==0
.ENT!N
TERMIN ;END OF DEFINE EXPAND
];END OF IF2
; OLD STATE TOKEN TERM DISP NEW STATE
ITEM 0, .TKB, EQL, DLBLK, 0
ITEM 0, .TKS, COL, DTAG, 0
ITEM 0, .TKN, COL, DLSET, 0
ITEM 0, .TKS, EQL, DDEFS, 0
ITEM 0, .TKS, SLSH, DCFLD, 1
ITEM 0, .TKS, QOT, DMDEF, 0
ITEM 0, .TKS, EOL, DSUDO, 0
ITEM 0, .TKS, COM, DMAC, 0
ITEM 0, .TKB, EOL, DNOP, 0
;?? ITEM 1, .TKS, EQL, DDEFS, 0
ITEM 1, .TKB, EQL, DDEFF, 0
ITEM 1, .TKS, COM, DFSYM, 2
ITEM 1, .TKS, EOL, DFSYM, 0
ITEM 1, .TKN, COM, DFNUM, 2
ITEM 1, .TKN, EOL, DFNUM, 0
ITEM 2, .TKS, SLSH, DFLD, 3
ITEM 2, .TKS, COM, DMAC, 2
ITEM 2, .TKS, EOL, DMAC, 2
ITEM 2, .TKB, EOL, DNOP, 2
ITEM 3, .TKS, COM, DFSYM, 2
ITEM 3, .TKS, EOL, DFSYM, 0
ITEM 3, .TKN, COM, DFNUM, 2
ITEM 3, .TKN, EOL, DFNUM, 0
IFN FTIF,[ ;CONDITIONAL ASSEMBLY STATES
ITEM 4, .TKB, EQL, DCMNT, 4
ITEM 4, .TKS, COL, DNOP, 4
ITEM 4, .TKN, COL, DNOP, 4
ITEM 4, .TKS, EQL, DCMNT, 4
ITEM 4, .TKS, SLSH, DCFLD, 4
ITEM 4, .TKS, QOT, DCMNT, 4
ITEM 4, .TKS, EOL, DCMNT, 4
ITEM 4, .TKS, COM, DCMNT, 4
ITEM 4, .TKB, EOL, DCMNT, 4
];END IFN FTIF
;STATE MEANING
; 0 START OF LINE/MICROWORD
; 1 SYMBOL/ SCANNED AT START OF LINE/MICROWORD
; 2 COMMA SEEN, SO IN MIDDLE OF MICROWORD
; 3 SYMBOL/ SCANNED IN MIDDLE OF MICROWORD
; 4 ASSEMBLY SUPPRESSED
DEFINE LOG2 AA,B
IRPS A,,[AA]
A==0
REPEAT 35.,IFGE B-1_A,A==A+1
TERMIN
TERMIN ;END OF DEFINE LOG2
LOG2 .SZTOK=,.MXTOK
LOG2 .SZSTA=,.MXSTA
LOG2 .SZTRM=,.MXTRM
LOG2 .SZDSP=,.MXDSP
STAMTB: PINDEX .SZDSP+.SZSTA,STATAB(T1)
STATAB: ;EXPANSION OF STATE TABLE
REPEAT 1+<1_<.SZSTA+.SZTOK+.SZTRM>/<36./<.SZDSP+.SZSTA>>>,[
EXPAND \.RPCNT
]
;FAKED SYMBOL TABLE ENTRIES FOR PSEUDO OPS
PSUDO%: XWD ..DCD,0 ;FIELD NODE
..DCD: XWD ..UCD,$DCODE ;SYMBOL NODE
ASCII /DISPATCH/
REPEAT NWORDS-2,0
..UCD: XWD .BIN,$UCODE
ASCII /UCODE/
REPEAT NWORDS-1,0
.BIN: XWD .DCODE,$BIN
ASCII /.BIN/
REPEAT NWORDS-1,0
.DCODE: XWD .NOBIN,$DCODE ;SYMBOL NODE
ASCII /.DCODE/
REPEAT NWORDS-2,0
.NOBIN: XWD .SEQAD,$NOBIN
ASCII /.NOBIN/
REPEAT NWORDS-2,0
.SEQAD: XWD .UCODE,$SEQAD
ASCII /.SEQADR/
REPEAT NWORDS-2,0
.UCODE: XWD 0,$UCODE ;END OF PSEUDO-OP TABLE
ASCII /.UCODE/
REPEAT NWORDS-2,0
PSUDM%: XWD .TITLE,0 ;FIELD NODE FOR PSEUDO-MACROS
.TITLE: XWD .TOC,$TITLE
ASCII /.TITLE/
REPEAT NWORDS-2,0
.TOC: XWD 0,$TOC
ASCII /.TOC/
REPEAT NWORDS-1,0
;FAKED SYMBOL TABLE ENTRIES FOR CONDITIONAL ASSEMBLY OPERATORS
IFN FTIF,[
PSUDF%: XWD .CHNG,0 ;FIELD NODE FOR PSEUDO-FIELDS
.CHNG: XWD .DEFLT,$CHNG
ASCII /.CHANGE/
REPEAT NWORDS-2,0
.DEFLT: XWD .ENDIF,$DEFLT
ASCII /.DEFAULT/
REPEAT NWORDS-2,0
.ENDIF: XWD .IF,$ENDIF
ASCII /.ENDIF/
REPEAT NWORDS-2,0
.IF: XWD .IFNOT,$IF
ASCII /.IF/
REPEAT NWORDS-1,0
.IFNOT: XWD .PAGEL,$IFNOT
ASCII /.IFNOT/
REPEAT NWORDS-2,0
.PAGEL: XWD .RAMFL,$PAGEL
ASCII /.PAGELENGTH/
REPEAT NWORDS-3,0
.RAMFL: XWD .SET,$RAMFL
ASCII /.RAMFILE/
REPEAT NWORDS-2,0
.SET: XWD .WIDTH,$SET
ASCII /.SET/
REPEAT NWORDS-1,0
.WIDTH: XWD 0,$WIDTH
ASCII /.WIDTH/
REPEAT NWORDS-2,0
];END IFN FTIF
IMPURE
.JBFF: HGHIMP ;FIRST FREE LOCATION IN IMPURE
.JBREL: <HGHIMP+1777>&<-2000> ;FIRST LOCATION IN NXM ABOVE IMPURE
PAT:
PATCH: BLOCK 40 ;PATCH SPACE, INTENTIONALLY NOT ZERO'D
LPPAG: 95. ;LINES PER PAGE (LPT6 ON DOVER)
GOBLT:: ;START OF BLT TO ZERO MEMORY
VARIABLES
VERPOS: BLOCK 1 ;LINE NUMBER ON PAGE
HORPOS: BLOCK 1 ;COLUMN NEXT OUTPUT CHARACTER WILL GO INTO
FLDPNT: BLOCK 1 ;POINTS TO BEGINNING OF SYMBOL TABLE
MAXPOS: BLOCK 2 ;LARGEST BIT POSITION DEFINED FOR MICRO CODE
MAXPS1: BLOCK 2 ;LARGEST BIT POSITION SEEN ON PASS 1
VALUE: BLOCK MICMXW ;HOLDS BINARY MICRO CODE UNDER CONSTRUCTION
VALSET: BLOCK MICMXW ;1S IN ALL FIELDS WHERE ITEMS INSERTED INTO "VALUE"
TIME1: BLOCK 1 ;TIME VALUE #1 MAXIMUM
TIME2: BLOCK 1 ;TIME VALUE #2 MAXIMUM
VALEND:: ;END OF BLT TO INIT A MICRO WORD
TKZER:: ;BLOCK TO ZERO FOR EACH TOKEN SCAN
TOKMIN: BLOCK 1 ;FLAG NUMERIC TOKEN IS NEGATIVE
TOKOCT: BLOCK 1 ;BUILDING OCTAL VALUE
TOKDEC: BLOCK 1 ; DECIMAL TOKEN VALUE
NUMBER: BLOCK 1 ;NUMERIC RESULT OF TOKEN SCANNER
NAME: BLOCK NWORDS ;ASCII TEXT FOR SYMBOL NAME
TKARGB: BLOCK NARGWD ;TOKEN MACRO ARGUMENTS BUFFER
TKZEND:: ;END OF BLT TO INIT A TOKEN
FIELD: BLOCK NWORDS ;ASCII TEXT FOR FIELD NAME
PC: BLOCK 2 ;MICRO WORD LOCATION COUNTER
SEQADR: 0 ;NON-ZERO MEANS USE SEQUENTIAL ADDRESSES
STATE: BLOCK 1 ;SYNTAX SCANNER STATE
ENDFIL: BLOCK 1 ;NON-0 INDICATES END OF ALL INPUT DATA
CHRPNT: BLOCK 1 ;HOLDS 0, OR BYTE POINTER FOR RESCANS
INPNT: BLOCK 1 ;BYTE POINTER FOR INPUT FILE
INCNT: BLOCK 1 ;BYTE COUNTER FOR INPUT FILE
OUTPNT: BLOCK 1 ;BYTE POINTER FOR OUTPUT FILE
OUTCNT: BLOCK 1 ;BYTE COUNTER FOR OUTPUT FILE
PDL: BLOCK 100 ;PUSH DOWN LIST
PDLEND::
PMDL: BLOCK 1000 ;STACK FOR RECURSING ON RESCANS
PMEND::
MARGSZ: BLOCK 1 ;MACRO ARGUMENTS SIZE
MARGPT: BLOCK 1 ;MACRO ARGUMENT POINTER
MARGBF: BLOCK NARGWD ;MACRO ARGUMENT BUFFER
STTIME: BLOCK 1 ;RUNTIME AT START
SAVACS: BLOCK 16. ;AC STORAGE DURING FATAL ERRORS
PNTBUF: BLOCK 100./5 ;BUFFER FOR HOLDING LISTING TEXT
PNTMAX==<.-PNTBUF>*5-1
EOLCHR: BLOCK 1 ;HOLDS LAST CHAR IN PRINT LINE
ERRCNT: BLOCK 1 ;COUNTS MSG UUOS FOR ERRORS
PAGNUM: BLOCK 1 ;SOURCE PAGE NUMBER IN RIGHT HALF
;-1 IN LEFT IS FLAG TO PRINT HEADER
TTLPNT: BLOCK 1 ;ADDRESS OF TITLE TEXT
TOCPNT: BLOCK 1 ;LIST POINTER TO TABLE OF CONTENTS
HDRPNT: BLOCK 1 ;ADDRESS OF HEADER TEXT
LINNUM: BLOCK 1 ;SOURCE LINE NUMBER
FRECNT: BLOCK 1 ;COUNT OF REQUIRED CONSECUTIVE MICRO WORDS
LOCPAT: BLOCK 1 ;BIT PATTERN FOR LOCATION ASSIGNMENTS
LOCAST: BLOCK 1 ;BIT PATTERN FOR *'S IN LOCATION PATTERN
LOCCNT: BLOCK 1 ;NUMBER OF LOCS REMAINING IN BLOCK
PNTCNT: BLOCK 1 ;COUNT OF NUMBER OF CHARS IN PNTBUF
PNTPNT: BLOCK 1 ;BYTE POINTER INTO PNTBUF FOR LISTING
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
USAGE: BLOCK MAXPC/36.+1 ;HOLDS 1S FOR EVERY MICRO WORD USED
USGEND::
DTABL: BLOCK MAXDSP/2 ;EACH HALF,LINE # AT WHICH WORD DEFINED
UTABL: BLOCK MAXPC ;CHARACTER,,LINE NUMBER (ZERO IF LOC UNUSED)
LOCPNT: BLOCK 1 ;AOBJN POINTER TO NEXT LOCTAB ENTRY
LOCAOB: BLOCK 1 ;AFTER PASS 1, AOBJN POINTER TO WHOLE LOCTAB
LOCTAB: BLOCK LLOCTB ;TABLE WITH ONE WORD FOR EACH OPERATION
; RELEVANT TO LOCATION ASSIGNMENT
%%LCOP==410300 ;4.9-4.7 OPERATION CODE
%LCTAG==0 ;SET TAG HERE, RH IS SYMBOL
%LCABS==1 ;ABSOLUTE LOCATION SETTING, RH IS VALUE
%LCUCD==2 ;MICRO CODE, RH IS LINE NUMBER
%LCEQL==3 ;EQUAL SIGN, ADDITIONAL BYTES:
%%LCPT==001600 ;PATTERN BIT MASK
%%LCAS==161600 ;ASTERISK BIT MASK
%%LCNB==340500 ;NUMBER OF BITS
%LCERR==4 ;ERROR, RH IS STRING
%LCLOC==040000 ;4.6 PC KNOWN FLAG (NOT IN %LCEQL)
%%LCPC==221600 ;4.5-3.1 PC WHEN KNOWN
RFLDPT: BLOCK 1 ;AOBJN POINTER TO RFLDS, RFLDD
RFLDS: BLOCK MICMXB ;TABLE OF BYTE POINTERS TO SOURCE FIELDS
RFLDD: BLOCK MICMXB ;TABLE OF BYTE POINTERS TO DESTINATION FIELDS
RFLPAR: BLOCK 8 ;PARITY SPECIFICATIONS
;4.9 EVEN PARITY
;3.9-3.1 WHERE TO STORE IT
;2.9-2.1 LEFTMOST BIT
;1.9-1.1 NUMBER OF BITS
RAMFIL: BLOCK 1 ;ZERO OR POINTER TO RAMFILE BUFFER
RFLNWD: BLOCK 1 ;NUMBER OF WORDS PER ENTRY
JCL: BLOCK 100./5 ;JCL BUFFER
JCLE: 0
JCLFNC: -1 ;FENCE
DISTTY: 0 ;-1 IF %TOERS
I.MAXC: BLOCK 1 ;COUNT OF NUMBER OF INPUT FILES
I.CNT: BLOCK 1 ;FILE COUNTER USED BY ALLIN
1FLFLG: 0 ;NON-ZERO FNR READING ONLY ONE FILE
O.DEV: BLOCK 1
O.NAM: BLOCK 1
O.EXT: BLOCK 1
O.PPN: BLOCK 1
O.LEN==.-O.DEV
I.DEV==0 ;INPUT DEVICE
I.NAM==1 ;INPUT FILE NAME/MASK
I.EXT==2 ;INPUT EXTENSION
I.PPN==3 ;INPUT PPN
I.LEN==4 ;LENGTH OF INPUT FILE DESCRIPTOR BLOCK
I.STG: BLOCK 20.*I.LEN ;INPUT FILE DESCRIPS
BUFL==200
INBUF: BLOCK BUFL
OUTBUF: BLOCK BUFL
OUTFIL: BLOCK 5 ;SAVED STUFF FOR OUTPUT FILE
INFILE: BLOCK 5 ;SAVED STUFF FOR CURRENT INPUT FILE
F.DEV==0 ;DEVICE NAME
F.NAM==1 ;FILE NAME
F.EXT==2 ;FILE NAME 2
F.TIM==3 ;FILE DATE ITS FORMAT
F.PPN==4 ;FILE DIRECTORY
RCHST: BLOCK 10. ;FOR .RCHST
ENDBLT: ;END OF BLT TO ZERO MEMORY
SUBTTL COMMAND LINE SCANNER
PURE
FNR.: .BEGIN
A=1
B=2
C=3
D=4
SETZM JCL
MOVE A,[JCL,,JCL+1]
BLT A,JCLE
SETOM JCLFNC
.SUSET [.ROPTION,,A]
TLNE A,OPTCMD
.BREAK 12,[5,,JCL]
PUSHJ P,FNRLIN ;PROCESS COMMAND LINE
SKIPN I.MAXC ;SEE IF GOT ANYTHING
SKIPE O.DEV
POPJ P, ;YUP, OK
.IOT TYOC,["*]
PUSHJ P,RLINE ;NO, READ A LINE FROM TTY
PUSHJ P,FNRLIN
SKIPN I.MAXC
SKIPE O.DEV
POPJ P,
EXIT ;NOTHING FROM TTY, EXIT
; READ A LINE FROM TTY INTO JCL
RLINE: MOVE D,[010700,,JCL-1]
RLINE0: .IOT TYIC,A
CAIE A,177
JRST RLINE1
CAMN D,[010700,,JCL-1]
JRST [ .IOT TYOC,[15] ? JRST RLINE0 ]
LDB A,D
MOVEI B,0
DPB B,D
ADD D,[070000,,]
SKIPGE D
SUB D,[430000,,1]
SKIPN DISTTY
JRST [ .IOT TYOC,A ? JRST RLINE0 ]
.IOT TYOC,[^P]
.IOT TYOC,["X]
JRST RLINE0
RLINE1: CAIE A,^L
JRST RLINE2
.IOT TYOC,[15]
MOVE C,[010700,,JCL-1]
RLIN1A: CAMN C,D
JRST RLINE0
ILDB A,C
.IOT TYOC,A
JRST RLIN1A
RLINE2: CAIE A,^M
CAIN A,^C
CAIA
JUMPN A,RLINE3
MOVEI A,0
IDPB A,D ;END HERE
POPJ P,
RLINE3: IDPB A,D
JRST RLINE0
;GET OUTPUT AND INPUT FILE SPECS FROM JCL
FNRLIN: SETZB FPNT,I.MAXC ;FPNT INDEX INTO I.STG
ADDI FPNT,I.STG ;WELL I REALLY WANTED A POINTER I GUESS
SETZM O.DEV
SETZM O.NAM
SETZM O.EXT
SETZM O.PPN
FNRAA: MOVE SPNT,[000700,,JCL-1] ;SPNT BP TO JCL
FNR0: SETZM I.DEV(FPNT) ;HERE FOR NEXT FILE
SETZM I.NAM(FPNT)
SETZM I.EXT(FPNT)
SETZM I.PPN(FPNT)
FNR1: SETZM D ;HERE FOR NEXT SYLLABLE
MOVE C,[440600,,D]
FNR2: ILDB A,SPNT ;HERE FOR NEXT CHARACTER
CAIGE A,40
JRST FNREND
CAIN A,";
JRST FNRSEM
CAIN A,":
JRST FNRCOL
CAIN A,",
JRST FNRSEP
CAIN A,"
JRST FNRSPC
CAIE A,"=
CAIN A,"_
JRST FNROUT
CAIGE A,140
SUBI A,40
TLNE C,770000
IDPB A,C
JRST FNR2
FNRSEM: MOVEM D,I.PPN(FPNT)
JRST FNR1
FNRCOL: MOVEM D,I.DEV(FPNT)
JRST FNR1
FNRSPC: MOVEM D,I.NAM(FPNT)
JRST FNR1
FNREND: MOVEI A,400000
JRST FNRSEP
FNROUT: SETOM A
CAIE FPNT,I.STG
MSG [EXIT],OUTPUT FILE MUST COME FIRST
FNRSEP: JUMPE D,FNRSP1
SKIPN I.NAM(FPNT)
JRST [ MOVEM D,I.NAM(FPNT)
JRST FNRSP1 ]
MOVEM D,I.EXT(FPNT)
FNRSP1: MOVSI D,(SIXBIT/>/) ;APPLY DEFAULTS
SKIPGE A
MOVSI D,(SIXBIT/MCR/)
SKIPN I.EXT(FPNT)
MOVEM D,I.EXT(FPNT)
MOVSI D,(SIXBIT/DSK/)
CAIE FPNT,I.STG
MOVE D,I.DEV-I.LEN(FPNT)
SKIPN I.DEV(FPNT)
MOVEM D,I.DEV(FPNT)
CAIE FPNT,I.STG
SKIPA D,I.PPN-I.LEN(FPNT)
.SUSET [.RSNAM,,D]
SKIPN I.PPN(FPNT)
MOVEM D,I.PPN(FPNT)
SKIPE 1FLFLG
POPJ P,
JUMPL A,FNROU1
SKIPE I.NAM(FPNT) ;SKIP IF BLANK LINE
AOS I.MAXC
CAIN A,400000
JRST FNREN1 ;END OF LINE
ADDI FPNT,I.LEN
CAIGE FPNT,I.STG+20.*I.LEN
JRST FNR0
MSG [EXIT],ONLY 20. INPUT FILES ALLOWED
FNROU1: IRPS SYL,,[DEV NAM EXT PPN]
MOVE D,I.!SYL(FPNT)
MOVEM D,O.!SYL
TERMIN
JRST FNR0
FNREN1: POPJ P,
.END FNR.
;PURIFICATION CODE
PURIFY: MOVE T1,[-NPURPG,,<HGHSEG/2000>]
.CALL [ SETZ
'CORBLK
MOVEI %CBRED+%CBNDR
MOVEI %JSELF
MOVE T1
SETZI %JSELF ]
.LOSE %LSSYS
MOVE T1,[-NNXMPG,,<GOBLT+1777>/2000]
.CALL [ SETZ
'CORBLK
MOVEI 0
MOVEI %JSELF
SETZ T1 ]
.LOSE %LSSYS
.VALUE [ASCIZ/:PDUMP TS MICRO/]
LIT..:
CONSTANTS
IMPURE
VARIABLES
PURE
IMPURE
IF1,[
DEFINE INFORM A,B
PRINTX\A=B
\
TERMIN
INFORM HIGHEST IMPURE USED,\%%LOW
INFORM HIGHEST PURE USED,\%%HIGH
]
HGHIMP=%%LOW
NPURPG==<%%HIGH-HGHSEG+1777>/2000 ;NUMBER OF PURE PAGES
NNXMPG==<HGHSEG/2000>-<GOBLT+1777>/2000 ;NUMBER OF NXM PAGES BETWEEN LOW AND HIGH
NZERPG==<HGHIMP+1777>/2000-<GOBLT+1777>/2000 ;NUMBER OF INITIAL ZERO PAGES
END MICRO
Reference in New Issue View Git Blame Copy Permalink