github.com/PDP-10.its
1
0
Fork 0
mirror of https://github.com/PDP-10/its.git synced 2026-01-16 16:28:40 +00:00
Code Issues Releases Wiki Activity
PDP-10.its/src/syseng/micro.52
Lars Brinkhoff 646dcd7d4a Microcode assembler and converters for KL10.
2018-06-12 07:58:19 +02:00

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