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