Trailing-Edge
-
PDP-10 Archives
-
SRI_NIC_PERM_SRC_3_19910112
-
midas/omidas.mid
There are no other files named omidas.mid in the archive.
; -*-MIDAS-*-
IFE .OSMIDAS-SIXBIT/DEC/,.SYMTAB 4973.,2000. ;THIS MANY ON DEC SYSTEM
.ELSE .SYMTAB 17393. ;2001.th prime -- Assemble faster elsewhere.
TITLE MIDAS
SUBTTL INITIAL DEFINITIONS
; AC DEFINITIONS. FF AND P MUST BE 0 AND 17 RESPECTIVELY, OTHERWISE
; ONLY CONSTRAINTS ARE EXPRESSED AS SEQUENTIAL ORDERINGS, E.G. B+1 ETC.
; ALSO,
.SEE R1
FF=:0 ; FLAGS. MUST BE AC 0.
AA=:1 ; GENERAL PURPOSE REGS, MUST BE SEQUENTIAL.
A=:AA+1 ; 2
B=:A+1 ; 3
C=:B+1 ; 4
D=:C+1 ; 5
T=:6 ; NOT SO TEMP AS IN MOST PROGS W/ T
TT=:T+1 ; 7
I=:10 ; INDICATOR FLAGS, CONTAIN INFO ON CURRENT SYL, FIELD, WORD; ALSO SEE UNRCHF
SYM=:11 ; FREQUENTLY CONTAINS SQUOZE SYM W/ FLAGS CLEAR
LINK=:SYM+1
F=:13
CH1=:14 ; MACRO PROCESSOR TEMP, CLOBBERED BY CALLS TO RCH
CH2=:CH1+1 ;" " "
TM=:16 ; SUPER TEMPORARY
P=:17 ; PDL AC, MUST BE 17. AS WELL AS RANDOM CROCKS IN PROGRAM, 20X ERCAL
; ASSUMES P=17.
IFDEF .XCREF, .XCREF FF,P,I,A,B,C,D,T
;OPERATING SYSTEM CONDITIONAL FLAGS:
; ITSSW IS 1 IF TO RUN ON ITS.
; DECSW IS 1 IF TO RUN ON ANY SORT OF BOTTOMS-10 (INCL. SAIL AND CMU).
; TNXSW IS 1 IF TO RUN ON TENEX OR TWENEX.
; SAILSW IS 1 IF TO RUN ON SAIL, AS OPPOSED TO OTHER BOTS-10.
; CMUSW IS 1 IF TO RUN AT CMU, AS OPPOSED TO OTHER BOTS-10.
; DECDBG IS 1 (ONLY WHEN DECSW IS 1) TO LEAVE SPACE FOR SYMBOL TABLE
; TO BE MOVED TO AFTEREXECUTION IS STARTED.
; DECBSW IS 1 TO PUT DECBTS IN THE PREDEFINED SYMBOL TABLE (ONLY IF DECSW IS 1).
; SMALSW IS 1 TO OCCUPY AS LITTLE CORE AS POSSIBLE.
; TS IS 1 EXCEPT FOR NON-TIMESHARED VERSION (WHICH IS OBSOLETE).
; CVTSW IS TO MAKE A MIDAS USING A DECDFS OR TNXDFS FILE GENERATED BY CVT.
; CVT READS A MONSYM FILE AND MAKES A TNXDFS.MID FILE, ALTHOUGH IT COULD
; BE HACKED TO READ UUOSYM AND MAKE DECDFS TOO. THERE IS NO SEPARATE
; DECBTS OR TWXBTS FILE WHEN USING CVT.
IF1,[ ;FOR PASS 1 TTY CONDITIONALS
IFDEF SAILSW,IFN SAILSW,DECSW==1
IFDEF CMUSW,IFN CMUSW,DECSW==1
IFDEF DECDBG,IFN DECDBG,DECSW==1
IFDEF DECSW,IFN DECSW,DECSW==1 ? ITSSW==0 ? TNXSW==0
IFDEF ITSSW,IFN ITSSW,ITSSW==1 ? DECSW==0 ? TNXSW==0
IFDEF TNXSW,IFN TNXSW,TNXSW==1 ? DECSW==0 ? ITSSW==0
] ; IF1
IFNDEF ITSSW,ITSSW==IFDEF .IOT,[1] .ELSE 0 ;NON-ZERO => ITS VERSION
IFNDEF TNXSW,TNXSW==IFDEF GTJFN,[1] .ELSE 0 ;NON-ZERO => TENEX VERSION
IFNDEF DECSW,DECSW==IFDEF LOOKUP,[1-TNXSW] .ELSE 0 ;NON-ZERO => DEC VERSION
; TNXSW SINCE OLD VERSIONS OF TENEX MIDAS HAD DEC
; UUO'S DEFINED TOO ONCE UPON A TIME
IF1 IFN ITSSW+DECSW+TNXSW-1,.FATAL So what monitor is MIDAS supposed to run under?
IFNDEF DECDBG,DECDBG==0 ;NON-ZERO => DEC VERSION TO RUN WITH DEC DDT.
IFN DECSW,[
IFNDEF SAILSW,SAILSW==IFDEF SPCWAR,[1] .ELSE 0 ;NON-ZERO => SAIL VERSION.
IFNDEF CMUSW,CMUSW==IFDEF CMUDEC,[1] .ELSE 0 ;NON-ZERO => CMU VERSION.
]
IFE DECSW,SAILSW==0 ? CMUSW==0 ;CAN'T BE SAIL OR CMU FOR ITS OR TENEX VERSION
IFNDEF SMALSW,SMALSW==DECSW-<CMUSW+SAILSW> ;NON-ZERO => SMALL MIDAS (NORMALLY
; FOR RANDOM DEC SITES ONLY)
IFNDEF DECBSW,DECBSW==DECSW*<1-SAILSW>*<1-SMALSW>
;NON-ZERO => INCLUDE DECBTS
IFNDEF CVTSW,CVTSW==0 ;NON-ZERO => BITS DEFINITIONS COME FROM FILES
; MADE USING CVT
IFN ITSSW\DECSW\TNXSW,TS==1
IFNDEF TS,TS==1 ;NON-ZERO => TIME-SHARING VERSION
IFE TS,1PASS
IFNDEF A1PSW, A1PSW==TS ;NON-ZERO => 1PASS END-OF-PROGRAM AUTO-REASSEMBLY
IFNDEF BRCFLG, BRCFLG==0 ;NON-ZERO => BRACES { AND } ARE SPECIAL IN MACRO
; ARGS, ETC. JUST LIKE BRACKETS. BRACES ARE SPECIAL
; IN CONDITIONALS REGARDLESS OF BRCFLG.
IFNDEF CREFSW, CREFSW==ITSSW ;NON-ZERO => ALLOW C SWITCH TO CAUSE CREF OUTPUT.
IFNDEF LISTSW, LISTSW==1 ;NON-ZERO => ALLOW L SWITCH TO CAUSE A LISTING.
IFNDEF RCHASW, RCHASW==TS ;NON-ZERO => INCLUDE TTY AS POSSIBLE INPUT DEVICE
IFNDEF PURESW, PURESW==TS-SAILSW ;NON-ZERO => SEPARATE PURE CODING FROM IMPURE AND
; DO PAGE SKIPS. TWO SEGMENTS HURTS EFFICIENCY AT SAIL.
IFNDEF FASLP, FASLP==1-SMALSW ;NON-ZERO => INCLUDE FASL OUTPUT CAPABILITY
; NOTE!! IF RUNNING UNDER 10/50 THIS MAKES THINGS
; SEVERAL K BIGGER THAN OTHERWISE.
IFNDEF .I.FSW, .I.FSW==1-SMALSW;NON-ZERO => INCLUDE .I, .F
IFNDEF MACSW, MACSW==1 ;NON-ZERO => INCLUDE MACRO PROCESSOR (!)
IFNDEF RUNTSW, RUNTSW==1 ;NON-ZERO => TYPE OUT RUN TIME AT END OF ASSEMBLY
IFNDEF WRQTSW, WRQTSW==1 ;WRQOTE (MACRO DEFINITION READER) VERSION
; ^ 0 => SLOW, 1 => FAST; MAYBE 2 WILL EVENTUALLY BE CREATED
IFE TS,IFNDEF MACL,MACL==6*2000 ;MACRO TABLE SIZE
IFN TS,[
IFN ITSSW,IFNDEF MACL,MACL==6000;DEFAULT MACL SIZE FOR ITS. IF WE HAVE DECBTS OR
IFN TNXSW,IFNDEF MACL,MACL==12*2000 ; TWXBTS, THIS GETS INCREASED, CAUSE THEY ARE HUGE!
IFN DECSW,IFNDEF MACL,MACL==0 ;NON-ITS: WE WANT MACL TO JUST COVER THE INIT CODE.
IFNDEF MXMACL,MXMACL==32.*2000 ;MAXIMUM LENGTH MACTAB
]
IFNDEF MACRUM,MACRUM==4 ;# WORDS NOT USED AT END OF MACTAB
IFNDEF STRL,STRL==20 ;LENGTH OF STRING STORAGE (USED BY GSYL)
IFNDEF DMDEFL,DMDEFL==40 ;MAX NO OF DMY ARGS IN DEFINE
IFNDEF DMYAGL,DMYAGL==400 ;MAX NO COMBINED DMYARGS ALL MACROS CURRENTLY EXPANDING OR PUSHED
IFNDEF MPDLL,MPDLL==300 ;MACRO PDL LENGTH
IFNDEF DSSIZ,DSSIZ==40 ;MAX # ARGS MACRO WHOSE ARGS BEING SCANNED (SHOULD BE .GE. DMDEFL)
IFNDEF BKTABL,BKTABL==40 ;MAX NUM .BEGIN BLOCKS.
IFNDEF BKPDLS,BKPDLS==10 ;MAXIMUM .BEGIN BLOCK NESTING DEPTH.
IFNDEF BSIZE,BSIZE==37 ;PREFERRED SIZE BLOCK MAX SIZE-3
IFN SMALSW,IFNDEF LPDL,LPDL==200.
IFNDEF LPDL,LPDL==1500. ;LENGTH OF PDL
IFN SMALSW,IFNDEF CONMIN,CONMIN==1000
IFNDEF CONMIN,CONMIN==3300 ;MINIMUM AMT OF SPACE FOR CONSTANTS TABLES.
IFNDEF CONMAX,CONMAX==20000 ;MAXIMUM SPACE USER CAN ASK FOR.
IFNDEF NCONS,NCONS==100. ;MAXIMUM NUMBER OF CONSTANTS AREAS
IFNDEF NVARS,NVARS==25. ;MAX. NUM. VARIABLES AREAS.
;; MUST INCLUDE TONS OF SYSTEM DEFS
IFN DECBSW,IFNDEF SYMDSZ,SYMDSZ==4973. ;666.th prime
IFN TNXSW,IFNDEF SYMDSZ,SYMDSZ==7919. ;1000.th prime
IFN SMALSW,IFNDEF SYMDSZ,SYMDSZ==2003.
IFNDEF SYMDSZ,SYMDSZ==2707. ;DEFAULT # SYMS IN SYMTAB.
IFNDEF SYMMSZ,SYMMSZ==11657.*2 ;# SYMS IF JNAME IS MMIDAS.
IFNDEF SYMMAX,SYMMAX==60000 ;MAX SYMTAB SIZE (# SYMS)
IFNDEF FASBL,FASBL==400 ;WORDS USED FOR FASL OUTPUT BUFFER
; MUST HOLD STUFF ASSOC WITH ONE GROUP OF 9 CODE BYTES
IFNDEF FASATL,FASATL==2000 ;WORDS USED FOR FASL ATOM TABLE
; HOLDS PNAMES ETC OF ALL ATOMS AS WILL BE IN FASLOAD'S
; SYMTAB AT LOAD TIME
IFNDEF MINWPS,MINWPS==3 ;MIN # WORDS IN SYMTAB ENTRY
IFNDEF MAXWPS,MAXWPS==3 ;MAX # ALLOWED (WILL BE BIGGER SOME DAY)
IFNDEF NRMWPS,NRMWPS==3 ;DEFAULT #. 2 WDS FOR VALUE & FLAGS, 1 FOR NAME.
; VERSION, FLAGS, ETC.
IF1 [
IFNDEF MIDVRS,[
IFGE .FVERS,[
DEFINE XXX VRS
MIDVRS=SIXBIT/VRS/
TERMIN
RADIX 10.
XXX \.FVERS
RADIX 8
EXPUNGE XXX
]
.ELSE [
PRINTX /What is MIDAS version number? /
.TTYMAC VRS
MIDVRS=SIXBIT/VRS/
TERMIN
]
]
;OSMIDAS GETS THE SIXBIT NAME OF THE TYPE OF OP. SYS. THE VERSION OF MIDAS
;IS BEING ASSEMBLED TO RUN UNDER. IT WILL BE THE VALUE OF ".OSMIDAS" WHEN PROGRAMS
;ARE ASSEMBLED WITH THIS MIDAS. NOTE THAT TNX VERSION ACTUALLY SETS IT
;AT RUNTIME STARTUP TO "TENEX" OR "TWENEX" AS APPROPRIATE.
IFNDEF OSMIDAS,OSMIDAS==IFE TS,[SIXBIT/BARE/] .ELSE IFN ITSSW,[SIXBIT/ITS/] .ELSE IFN CMUSW,[SIXBIT/CMU/] .ELSE IFN SAILSW,[SIXBIT/SAIL/] .ELSE IFN TNXSW,[SIXBIT/TENEX/] .ELSE SIXBIT/DEC/
;FF FLAGS NOT PUSHED
;LEFT HALF
FL==1,,525252
FLPPSS==400000 ;ONE IF PUNCHING PASS; MUST BE SIGN
FLHKIL==100000 ;ONE IF SYM TO BE SEMI KILLED IN DDT
FLVOT== 40000 ;ALL RCH S MUST GO THRU RCH
; IE TYPCTL .NE. POPJ P, (SET/CLEARED BY MDSSET, MDSCLR)
FLMAC== 20000 ;ONE IF CHARS COMING FROM MACRO PROCESSOR, DON'T HACK CPGN/CLNN
FLTTY== 10000 ;ONE IF CHARS FROM SOMEWHERE ELSE BUT NOT HACKING CPGN/CLNN
$FLOUT== 4000 ;ONE IF OUTPUT HAS OCCURED IN CURRENT MODE (USED BY TS NED LOGIC)
FLPTPF== 2000 ;SET IF (TIME SHARING) OUTPUT DEVICE IS PTP
FLUNRD== 1000 ;=> RE-INPUT LAST CHARACTER (SEE RCH)
FL20X==400 ; IN TENEX VERSION, 1= RUNNING ON TOPS-20, 0 = TENEX.
;FF RIGHT HALF FLAGS
FR==525252
FRFIRWD==400000 ;ONE FOR FIRST WORD OF BLOCK
FRSYMS==200000 ;ONE IF SYM PUNCH DESIRED
FRLOC==100000 ;ONE BETWEEN ABS LOC ASSIGN AND
;FIRST BLOCK OUTPUT THEREAFTER (EBLK TO OUTPUT NULL BLOCK SO LINKING LOADER KNOWS $.)
FRNPSS==40000 ;ONE IF TWO PASS ASSEMBLY
FRPSS2==20000 ;ONE ON PASS 2
FRINVT==4000 ;USED BY PBITS AND OUTPUT TO OUTPUT WORDS OF CODE BITS IN CORRECT ORDER (STEAD LOGICAL)
FRNLIK==2000 ;TEMPORARILY SUPPRESS ADR LINKING
FRGLOL==1000 ;ONE IF LOCATION PLUS OFFSET IS GLOBAL
FRBIT7==400 ;SET IF LAST TIPLE OF CODEBITS WAS 7.
FRMRGO==200 ;MACRO PROC TO RETURN TO .GO HACKER W/O READING NEXT CHAR (SEE RCHSAV)
FRCMND==40 ;SET WHILE READING CMD, TELLS RFD TO NOTICE (, _, COMMA.
FRNNUL==20 ;SET ON RETURN FROM RFD IFF NONNULL SPEC.
FRARRO==10 ;TELLS RFD THAT 1ST NAME IS FN1, NOT FN2.
FRFN1==4 ; TELLS RFD THAT 1ST NAME WAS READ.
; FLAGS TO ZERO AT BEGINNING OF PASS 1 ONLY, BY $INIT.
FFINIT==<-1-FLVOT-FLPTPF-FLTTY-FL20X,,-1>
] ;END IF1
;INDICATOR REGISTER
IF1 [
;LEFT HALF
IL==1,,525252
ILGLI==1 ;SET ON " CLEARED EACH SYL
ILVAR==2 ;SET ON ' " " "
ILFLO==4 ;FLOATING NUM, SET ON DIGIT AFTER .
ILDECP==10 ;DECIMAL PREFER, SET WHEN . SEEN.
ILUARI==20 ;1 => RIGHT OPERAND TO UPARROW BEING READ
ILLSRT==40 ;RETURN FROM <
ILWORD==400 ;SET IF CURRENT WORD IS NOT NULL RETURNED BY GETWORD
ILNPRC==1000 ;ONE IF NUMBER ALREADY PROCESSED BY UPARROW
ILMWRD==4000 ;SET ON MULTIPLE WORD
ILPRN==10000 ;SET DURING MACCL IF MACRO NAME WAS FOLLOWED BY (.
ILMWR1==20000 ;SET BY LBRAK AS SIGNAL TO ITSELF THAT THIS NOT FIRST
;WORD OF MULTI-WORD CONSTANT
ILNOPT==40000 ;CONSTANTS OPTIMIZATION SUPPRESSION FLAG; SHOULD BE SET BY
;VALUE-RETURNING PSEUDO DURING NOT PUNCHING PASS TO KEEP ITSELF OUT OF
;CONSTANTS OPTIMIZATION
;RIGHT HALF
IR==525252
IRFLD==1 ;SET IF FLD NOT NULL
IRSYL==2 ;SET IF SYL NOT NULL
IRLET==4 ;SET IF SYL IS SYMBOL
IRDEF==10 ;SET IF CURRENT EXPR DEFINED
IRNOEQ==20 ;SET IF = ISN'T ALLOWED IN CURRENT CONTEXT.
IRCOM==40 ;SET IF CURRENT QUAN IS COMMON
IRPERI==100 ;SET IF PERIOD SEEN IN WHAT IS SO FAR (INCL .) A NUMBER
IREQL==200 ;ONE DURING READING WORD TO RIGHT OF =
IRIOINS==400 ;FIRST FIELD OF CURRENT WORD HAS IO INST
IRCONT==1000 ;SET IF NOT OK TO END BLOCK
IRPSUD==4000 ;SET IF ERROR COMMENTS WILL COME FROM PSEUDO
IRGMNS==20000 ;SET IF ILUARI OR BAKARI HAS GOBBLED MINUS
IROP==200000 ;SET IF OPERATOR SEEN IN CURRENT FIELD
CALL==PUSHJ P,
RET==POPJ P,
;SAVE=PUSH P, ;DON'T USE SAVE! IT'S A JSYS ON TENEX AND TWENEX
REST==POP P,
PJRST==JRST ; FOR JRST'ING TO A POPJ'ING ROUTINE.
ETSM=1000,, ;ERROR, TYPE SYM.
ETR=2000,, ;ERROR, ORDINARY MESSAGE.
ERJ=3000,, ;ERROR, NO MESSAGE, RETURN TO ADDR.
ETI=4000,, ;ERROR, IGNORE LINE, RET. TO ASSEM1.
ETA=5000,, ;ERROR, RET. TO ASSEM1.
ETASM=6000,, ;ERROR, TYPE SYM AND RETURN TO ASSEM1
ETF=7000,, ;FATAL ERROR.
TYPR=(37000) ;UUO, TYPE OUT ASCIZ STRING
TYPCR=(36000) ; LIKE TYPR BUT ADDS CR AT END.
] ;END IF1
IF1 [
;LINK TABLE (GLOTB), ACCUMULATES GLOBAL REFERENCES FOR CURRENT FROB (USUALLY WORD) TO OUTPUT
;GLSP2 POINTS TO (I.E. HAS ADR 1 LESS THAN) BOTTOM OF ACTIVE PART OF TABLE
;GLSP1 POINTS TO TOP (HAS ADR OF LAST ENTRY ACTIVE)
;ACTUAL ENTRIES IN GLOTB:
;IF ENTIRE WORD ZERO, ENTRY IS NULL, WILL (OR SHOULD) BE IGNORED
;RH ADR OF SQUOZE WITH INTERNAL MIDAS FLAGS (USUALLY IN SYMBOL TABLE, BUT MAY BE ANYWHERE IN CORE)
;LH: RIGHT 10. BITS MULTIPLICATION FACTOR OR 0 => 1
;GLOBAL SHOULD BE MULTIPLIED BY IT
;REST OF LH FLAGS:
;SIGN BIT => THIS NOT PART OF FIELD, DON'T PLAY WITH FLAGS AT GETFLD, INTFD
ACF==40000 ;AC LOW OR HIGH (SWAPF => HIGH)
HFWDF==100000 ;MASK GLOBAL TO HALFWORD
SWAPF==200000 ;SWAP
MINF==20000 ;NEGATIVE OF GLOBAL
IFNDEF LBRKT,LBRKT=="[ ;LEFT DELIMITER FOR EXPLICITLY GROUPED CONDITIONALS, MACRO ARGS, REPEAT BODY, ETC.
IFNDEF RBRKT,RBRKT=="] ;RIGHT "
IFNDEF WPS, WPS==3 ;# CONTIG. WDS /STE. IFNDEF FOR DEBUGGING.
IFNDEF BKWPB,BKWPB==3 ;# WDS/BKTAB ENTRY.
IFNDEF EOFCH,EOFCH==3 ;EOF CHAR, BEWARE DISPATCH TABLE ENTRIES.
IFNDEF LBRACE,LBRACE==173
IFNDEF RBRACE,RBRACE==175
;3RDWRD LH. SYM TAB BITS
3REL==600000 ;RELOC BITS, DO NOT CHANGE, SOMETIMES REFERENCED BY NUMERIC BYTE POINTERS
3RLL==400000 ;R(LH)
3RLR==200000 ;R(RH)
3RLNK==100000 ;R(LINK)
3KILL==40000 ;FULLY-KILLED SYM (DON'T GIVE TO DDT).
3VP==20000 ;VALUE PUNCHED
3SKILL==10000 ;SEMI KILL IN DDT
3LLV==4000 ;LINKING LOADER MUST INSERT VAL
3VAS2==2000 ;VAR SEEN ON PASS TWO WITH '
3VCNT==1000 ;USED IN CONSTANT
3MAS==400 ;THIS ISN'T THE LAST DEFINITION OF A SYM WITH THIS NAME
;(SO ES MUST KEEP SEARCHING).
3NCRF==200 ;DON'T CREF THIS SYMBOL.
3MACOK==100 ;OK TO (RE)DEFINE THIS SYM AS MACRO.
;(IE IS A MACRO OR SEEN ONLY IN .XCREF)
3LABEL==40 ;ILLEGAL TO REDEFINE THIS SYM TO DIFFERENT VALUE
3MULTI==20 ;THIS SYM IS MULTIPLY DEFINED, SO FLAG ALL DEFINITIONS.
3DOWN==10 ;THIS DEFINITION SHOULD BE SEEN BY SUBBLOCKS IN 1PASS MODE.
3DFCLR==737110 ;BITS IN LH TO CLEAR ON REDEFINITION.
; FLAGS IN "CONTROL" VARIABLE
.SEE CONTRL
;LEFT HALF
TRIV==400000 ; 1 IF OUTPUT FORMAT IS FOR TRIVIAL LOADER (ABSOLUTE)
; ELSE RELOCATABLE (NOTE THIS CROCKISHLY ONLY MEANS
; STINK FORMAT, SINCE DEC RELOC FORMAT HAS THIS FLAG SET)
;RIGHT HALF
ARIM== 2 ; 1 => OUTPUT FORMAT IS RIM
SBLKS== 10 ; 1 => OUTPUT FORMAT IS SBLK (SIMPLE BLOCKS)
ARIM10== 20 ; 1 => OUTPUT FORMAT IS PDP-10 RIM
DECREL== 40 ; 1 => DEC RELOCATABLE FORMAT (CONSIDERED "ABSOLUTE" INSIDE MIDAS)
FASL== 100 ; 1 => LISP FASL COMPATIBLE RELOCATABLE FORMAT ( " " ")
DECSAV==200 ; 1 => DEC SAV FORMAT (ABSOLUTE) ALSO WINS ON 10X, 20X
PTR==104 ;DEVICE CODE FOR PAPER TAPE READER.
] ;END IF1
IF1 [
;SQUOZE FLAG DEFINITIONS IN MIDAS SYMBOL TABLE
CMMN==0 ;COMMON (NOT USED)
PSUDO==40000 ;PSEUDO OR MACRO, VALUE RH ADDR OF RTN (MACCL FOR MACRO),
; LH WILL BE IN LH OF B WHEN RTN CALLED.
SYMC==100000 ;SYM, VALUE IS VALUE OF SYM.
LCUDF==140000 ;LOCAL UNDEF
DEFLVR==200000 ;DEF LOC VAR, VALUE IS VALUE.
UDEFLV==240000 ;UNDEF LOC VAR, VALUE IS 1+ IDX IN VARIAB. AREA, BUT IGNORD IF VAR AREA GLOB.
LGBLCB==300000 ;CODE BITS EQUAL TO THIS OR HIGHER REPRESENT GLOBAL QUANTITIES
DEFGVR==300000 ;DEF GLO VAR, VALUE IS VALUE
UDEFGV==340000 ;UNDEF GLO VAR, VALUE LIKE UNDEF LOCAL VAR.
GLOETY==400000 ;GLO ENTRY
GLOEXT==440000 ;GLO EXIT
NCDBTS==GLOEXT_<-18.+4>+1 ;# CODE BIT TYPES
DEFINE CDBCHK TBLNAM
IFN .-<TBLNAM>-NCDBTS,.ERR TBLNAM LOSES
TERMIN
;LOADER BLOCK TYPES LINK
LLDCM==1 ;LOADER COMMAND BLOCK
LABS==2 ;ABSOLUTE
LREL==3 ;RELOCATABLE
LPRGN==4 ;PROG NAME
LLIB==5 ;LIBRARY BLOCK
LCOMLOD==6 ;LOAD INTO COMMON
LGPA==7 ;GLOBAL PARAMETER ASSIGN
LDDSYM==10 ;LOCAL SYMS
LTCP==11 ;LOAD TIME COND ON PRESENCE
ELTCB==12 ;END LOAD TIME COND
LPLSH==22 ;POLISH FIXUP
;LOADER COMMANDS
;IN ADR OF LDCMD BLK
LCJMP==1 ;JUMP
LCGLO==2 ;GLOBAL LOC ASSIGN
LCCMST==3 ;SET COMMON BENCHMARK
LCEGLO==4 ;END OF GLOBAL BLOCK
LDCV==5 ;LOAD TIME COND ON VALUE
LDOFS==6 ;LOADER SET GLOBAL OFFSET
LD.OP==7 ;LOADER .OP
;LOADER CODEBITS SECOND SPEC AFTER 7
CDEF==0 ;DEF
CCOMN==1 ;COMMON REL
CLGLO==2 ;LOC-GLO REC
CLIBQ==3 ;LIBREQ
CRDF==4 ;GLO REDEF
CRPT==5 ;REPEAT GLOBAL VALUE
CDEFPT==6 ;DEFINE SYM AS $.
;DEC RELOCATABLE BLOCK TYPES.
DECWDS==1 ;STORAGE WORDS.
DECSYM==2 ;SYMBOL DEFS OR GLOBAL ADDITIVE RQS.
DECHSG==3 ;LOAD INTO HIGH SEG (FOR .DECTWO)
DECENT==4 ;ENTRY NAMES
DECEND==5 ;END BLOCK, HAS PROGRAM BREAK.
DECNAM==6 ;PROGRAM NAME.
DECSTA==7 ;STARTING ADDRESS BLOCK.
DECINT==10 ;INTERNAL REQUEST
DECRQF==16 ;REQUEST LOADING A FILE
DECRQL==17 ;REQUEST LOADING A LIBRARY
] ;END IF1
IF1 [
DEFINE TYPE &STR
TYPR [ASCIZ STR]
TERMIN
DEFINE TYPECR &STR
TYPCR [ASCIZ STR]
TERMIN
DEFINE PRINTA A,B,C,D,E,F
IF1,[PRINTC ~A!B!C!D!E!F
~]
TERMIN
IF1 [DEFINE BNKBLK OP
OP
TERMIN ]
;ADD A LINE TO BNKBLK, ACCUMULATED CONTENT OF
;WHICH IS DUMPED OUT AT END OF ASSEMBLY
;ARG TO BLCODE SHOULD BE FREE OF STORAGE WORDS
DEFINE BLCODE NEWCFT
IF1 [BNKBLK [DEFINE BNKBLK OP
OP]NEWCFT
TERMIN ]
IF2 [IRPW X,,[
NEWCFT
]
IRPS Y,,X
Y=Y
.ISTOP TERMIN TERMIN ] TERMIN
;3RDWRD MANIPULATING MACROS
;GET 3RDWRD INTO LH("A"), "B" HAS INDEX OF 1STWRD INTO SYMBOL TABLE
DEFINE 3GET A,B
MOVE A,ST+2(B)
TERMIN
;GET 3RDWRD INTO "A", "B" HAS ADR OF 1STWRD
DEFINE 3GET1 A,B
MOVE A,2(B)
TERMIN
;PUT "A" INTO 3RDWRD, "B" HAS INDEX OF 1STWRD INTO SYMBOL TABLE
DEFINE 3PUT A,B
MOVEM A,ST+2(B)
TERMIN
;PUT "A" INTO 3RDWRD, "B" HAS ADR OF 1STWRD
DEFINE 3PUT1 A,B
MOVEM A,2(B)
TERMIN
] ;END IF1
;RANDOM MACRO DEFINITIONS
IF1 [
;A HAS ADR OF SYM SQUOZE, SKIP IF IT'S IN SYMBOL TABLE
DEFINE SKPST A
CAIL A,ST
CAML A,MACTAD
TERMIN
;EXECUTE AN INSTRUCTION WITH VARIOUS ADDRESSES (USUALLY PUSH OR POP)
DEFINE INSIRP A,B
IRPS %ADR,,[B]
A,%ADR
TERMIN
TERMIN
DEFINE NOVAL
TDNE I,[ILWORD,,IRNOEQ\IRFLD]
ETSM ERRNVL
TERMIN
DEFINE NOABS
SKIPGE CONTRL
ETASM ERRABS
TERMIN
] ;END IF1
ERRNVL==[ASCIZ /Returns no value/]
ERRABS==[ASCIZ /Allowed only for STINK relocatable format/]
IF1 [
DEFINE MOVEIM B,C
MOVEI A,C
MOVEM A,B
TERMIN
DEFINE MOVEMM B,C
MOVE A,C
MOVEM A,B
TERMIN
] ;END IF1
IF1 [
IFN 0,[
;THESE ARE SOME MACRO DEFINITIONS FOR THE UNFINISHED MULTI-WORD
;SYMBOL NAME FEATURE. FOR COMPATIBILITY, THEY ALL NOW HAVE DEFINITIONS
;THAT ONLY HANDLE ONE WORD. THOSE OTHER DEFINITIONS COME AFTER THESE.
DEFINE TYPE2 X=SYM
MOVE A,X
CALL SYMTYP
IFSN X,SYM,SKIPE A,X+1
.ELSE SKIPE A,SYMX
CALL SYMTYP
TERMIN
DEFINE COPY2 X,Y,Z=USING A
MOVE Z,X
MOVEM Z,Y
MOVE Z,X+1
MOVEM Z,Y+1
TERMIN
DEFINE STORE2 AC,Y,Z=USING A
MOVEM AC,Y
MOVE Z,AC!X
MOVEM Z,Y+1
TERMIN
]
.ELSE [
;THESE ARE THE DEFINITIONS OF THE MACROS THAT DO NOT IMPLEMENT
;MULTI-WORD SYMBOL NAMES.
DEFINE TYPE2 X=SYM
MOVE A,X
CALL SYMTYP
TERMIN
DEFINE COPY2 X,Y,Z=USING A
MOVE Z,X
MOVEM Z,Y
TERMIN
DEFINE STORE2 AC,Y,Z=USING A
MOVEM AC,Y
TERMIN
]
DEFINE USING X
X,TERMIN
] ;END IF1
SUBTTL DEFINE SYS DEPENDENT SYMBOLS & SELECT OUTPUT FORMAT
; THIS DEFSYM MACRO IS FOR COMPILING MIDAS ON ANOTHER OPERATING SYSTEM. THIS
; AVOIDS SAME-NAME SCREWS (IE, "LOCK" IS SOMETHING DIFFERENT ON TWENEX, SAIL,
; AND DEC).
IF1 [
DEFINE DEFSYM X/
IRPS Z,,[X]
EXPUNGE Z
.ISTOP
TERMIN
X
TERMIN
]; IF1
IFN DECSW\TNXSW,[
IF1 [
IFN TNXSW, EQUALS TEM,.SYMTAB
; INSERT UUO DEFINITIONS FILES AS APPROPRIATE.
IFE CMUSW\SAILSW\TNXSW,.INSRT DECDFS
IFN SAILSW, .INSRT SAIDFS
IFN CMUSW, .INSRT CMUDFS
IFN TNXSW, .INSRT TNXDFS
;ACTUALLY DEFINE THE UUOS USING THE MACROS READ FROM THE FILES.
IFE CVTSW,[
IFN DECSW,.DECDF DEFSYM
IFN TNXSW,.TNXDF DEFSYM
;INSERT THE BITS DEFINITION FILES AS APPROPRIATE.
;THESE MUST BE INSERTED EVEN IF THEY ARE PREDEFINED, BECAUSE
;THE MIDAS SYMBOL TABLE IS CONSTRUCTED FROM THE DEFINITIONS IN THIS ASSEMBLY
;OF THOSE SYMBOLS, AND THAT MEANS WE NEED THE LATEST VERSION ASSEMBLED IN.
IFN TNXSW, .INSRT TWXBTS
IFN DECBSW,.INSRT DECBTS
];IFE CVTSW
IFN TNXSW,[ ; AC DEFS FOR DIRECT REFERENCE TO JSYS ARGS
R1==:1 ; SOMEDAY MAYBE THE SYMBOLS A,B ETC WILL CORRESPOND...
R2==:2
R3==:3
R4==:4
R5==:5
]
EXPUNGE HALT
DEFINE HALT
JRST 4,.
TERMIN
EXPUNGE .VALUE
EQUALS .VALUE HALT
DEFINE .LOSE A
JRST 4,.-1
TERMIN
IFN TNXSW, EQUALS .SYMTAB,TEM
] ;IF1
IFN DECSW,[ ; SELECT OUTPUT FORMAT FOR DEC VERSION
IFN PURESW,.DECTWO
IFE PURESW,.DECREL
RL0==.
]
IFN TNXSW,[ ; SELECT OUTPUT FORMAT FOR TNX VERSION
IFNDEF DECSVF,[ ; NORMALLY, USE .DECSAV IF AVAILABLE, ELSE .DECREL,
DECSVF==0 ; BUT USER CAN OVERRIDE THAT BY SPECIFYING DECSVF.
IFDEF .DECSAV,DECSVF==1
]
IFN DECSVF,.DECSAV
.ELSE [ IFN PURESW,.DECTWO
.ELSE .DECREL
]
RL0==0
]
] ;IFN DECSW\TNXSW
IFN ITSSW,[
IF1 [IFNDEF .IOT,[.INSRT SYS:ITSDFS
.ITSDF DEFSYM
] ;IFNDEF .IOT
IFNDEF %PIPDL,.INSRT SYS:ITSBTS
HALT==.VALUE
EXPUNG .JBTPC,.JBCNI
DEFINE SYSCAL A,B
.CALL [SETZ ? SIXBIT/A/ ? B ((SETZ))]
TERMIN
] ;IF1
IFDEF .SBLK,.SBLK ; SELECT OUTPUT FORMAT FOR ITS VERSION
RL0==0
] ;IFN ITSSW
IFE PURESW,[ ;FOLLOWING IF NOT ASSEMBLING PURE CODING
DEFINE PBLK
TERMIN
DEFINE VBLK
TERMIN
]
IFN PURESW,[ ;FOLLOWING IF ASSEMBLING PURE CODING
;MEMORY ORGANIZATION PURE CODING
;MAXVAR BLOCKS OF IMPURE CODING, NO DYNAMIC ALLOCATION
;BLCODE MACRO ACCUMULATES CODING TO BE PUT AT END OF
;IMPURE CODING, NO STORAGE WORDS ALLOWED
;THEN SYM TAB, STARTING AT ST.
;THEN MACRO TABLE (WITH INIT. CODE IN IT)
;STARTING INITIALLY AT MACTBA, ACTUAL ADDR IN MACTAD.
;SYMTAB AND MACTAB DON'T NECESSARILY START ON PAGE BNDRYS.
;THEN GAP TO MINPUR*2000 (HEREAFTER KNOWN AS "THE GAP")
IFN DECSW\TNXSW,MINPUR==200
IFN ITSSW,MINPUR==160 ;BLOCK NUMBER BEGINNING OF PURE CODING
;PURE CODING UNTIL MAXPUR*2000-SOMETHING
;THE FOLLOWING MACROS AND BLCODE MAKE IT NOT COMPLETELY NECESSARY
;TO SEPARATE PURE CODING FROM IMPURE
CKPUR==0 ;0 => ASSEMBLING BELOW THE GAP, 1 ABOVE
; PBLK - SWITCH TO CODING ABOVE THE GAP
DEFINE PBLK
IFN CKPUR,.ERR PBLK
IFE CKPUR,[VAR.LC==.
LOC PUR.LC
]CKPUR==1
TERMIN
; SET INITIAL LOCATION COUNTER FOR ASSEMBLING PURE CODE ABOVE GAP.
IFN ITSSW, PUR.LC==MINPUR*2000
IFN DECSW, PUR.LC==MINPUR*2000+RL0
IFN TNXSW,[
IFN DECSVF,PUR.LC==MINPUR*2000
.ELSE PUR.LC==MINPUR*2000+20 ;SKIP VESTIGIAL JOBDAT AREA.
]
; VBLK - SWITCH TO CODING BELOW THE GAP
DEFINE VBLK
IFE CKPUR,.ERR VBLK
IFN CKPUR,[PUR.LC==.
LOC VAR.LC
]CKPUR==0
TERMIN
IFN TNXSW,IFE DECSVF,LOC 200
PBLK ;PBLK NORMAL MODE, VARIABLE AREAS BRACKETED WITH VBLK AND PBLK
] ;END PURESW CONDITIONAL
.YSTGW ;SET UP NOW, STORAGE WORDS OK
FOO==.
LOC 41
JSR ERROR
IFN ITSSW,JSR TSINT
IFN DECSW,[
LOC .JBAPR
TSINT1
]
LOC FOO
;DISPATCH TABLE FOR NON-SQUOZE CHARACTERS
;REFERENCED AS DTB-40(RH OF POPJ IN GDTAB)
;DTB ENTRY OF SYL TERMINATOR PUT IN CDISP BY GETSYL
DSYL==400000 ;SYL OPERATOR, DISPATCH INDEXED BY RH AT GETSYL (MUST BE SIGN)
DFLD==200000 ;FIELD OPERATOR, GETFD
DWRD==100000 ;WORD OP, GETWD
DSY1==1000 ;SET ONLY IF DSYL SET,
;SET IF OP MIGHT BE 1ST CHAR OF NONNULL SYL.
DSYL1==DSYL+DSY1
DSY2==400 ;SET FOR _ ONLY.
;ALL CLEAR => WORD TERMINATOR, NO DISPATCH
DTB: DWRD,,SPACE ;40 SP, TAB, RUBOUT
DSYL1,,RRL2 ;EXCLAIM AND OPEN-BRACE
DSYL1,,DQUOTE ;"
DFLD,,XORF ;NUM SIGN
DSYL,,RBRAK2 ;CLOSE-BRACE.
0 ;(USED TO BE PERCENT SIGN)
DFLD,,ANDF ;AMPERSAND
DSYL1,,SQUOTE ;'
DFLD,,LEFTP ;( 50
DSYL,,RPARN ;)
DFLD,,MULTP ; STAR TIMES
DFLD,,PLS ;+ PLUS
DWRD,,COMMA ; ,
DFLD,,MINUS ;-
DSYL1,,CTLAT ;^@ (56)
DFLD,,DIVID ;/
DSYL1,,COLON ;COLON 60
DSYL,,SEMIC ;SEMI
DFLD,,LSSTH ;<
DSYL1,,EQUAL ;=
DSYL,,GRTHN ;>
0 ;?
DSYL1,,ATSGN ;AT SIGN
DFLD,,LBRAK ;[
DFLD,,IORF ;BACKSLASH 70
DSYL,,RBRAK ;]
DSYL1,,UPARR ;^
DSYL+DSY2,,BAKAR ;BACKARR
0 ;CR
0 ;(USED TO BE TAB)
0 ;ALL OTHER
DSYL,,LINEF ;LF (DSYL TO HACK CLNN)
DSYL,,FORMF ;FORM FEED (") 100
;NOTE THAT POPJ P, IS VALID TEST FOR SQUOZENESS
;EXCEPT FOR EOFCH
GDTAB: POPJ P,56 ; ^@ GETS IGNORED.
REPEAT 2,POPJ P,76 ;(GDTAB GLOBAL SO OUT OF TS, AIO CAN CLOBBER GDTAB+141 WITH JRST RREOF
;ON OLD FILES)
IFN .-GDTAB-EOFCH,.ERR EOFCH DOESN'T AGREE WITH GDTAB.
IFE TS,[POPJ P,76] IFN TS,[JRST RREOF]
REPEAT 5,POPJ P,76
POPJ P,40 ; TAB
POPJ P,77 ; LF
POPJ P,76 ; VERT TAB
POPJ P,100 ; FORM FEED
POPJ P,74 ; CR
REPEAT "!-16-1,POPJ P,76
POPJ P,40 ; SPACE
POPJ P,41 ; !
POPJ P,42 ; "
POPJ P,43 ; #
ADD SYM,%$SQ(D) ; $
ADD SYM,%%SQ(D) ; %
POPJ P,46 ; &
POPJ P,47 ; '
POPJ P,50 ; (
POPJ P,51 ; )
POPJ P,52 ; *
POPJ P,53 ; +
POPJ P,54 ; ,
POPJ P,55 ; -
JSP CH1,POINT ; .
POPJ P,57 ; /
REPEAT 10.,JSP CH2,RR2 ; DIGITS
POPJ P,60 ; :
POPJ P,61 ; ;
POPJ P,62 ; <
POPJ P,63 ; =
POPJ P,64 ; >
POPJ P,65 ; ?
POPJ P,66 ; @
IFDEF .CRFOFF,.CRFOFF
IRPC Q,,ABCDEFGHIJKLMNOPQRSTUVWXYZ
ADD SYM,%!Q!SQ(D)
TERMIN
POPJ P,67 ; [
POPJ P,70 ; \
POPJ P,71 ; ]
POPJ P,72 ; ^
POPJ P,73 ; _
POPJ P,76 ; NOW LOWER CASE GRAVE ACCENT
IRPC Q,,ABCDEFGHIJKLMNOPQRSTUVWXYZ
ADD SYM,%!Q!SQ(D)
TERMIN
IFDEF .CRFON,.CRFON
POPJ P,41 ;{
POPJ P,76 ;|
POPJ P,44 ;}
POPJ P,76 ;~
POPJ P,40 ; RUBOUT, LIKE SPACE
IFN .-GDTAB-200,.ERR GDTAB LOSES
NSQTB: IFDEF .CRFOFF,.CRFOFF
IRPC Q,,0123456789
ADD SYM,%!Q!SQ(D)
TERMIN
IRPC Q,,ABCDEFGHIJKLMNOPQRSTUVWXYZ1234567890$%.
%!Q!SQ: 0
SQUOZE 0,Q/50/50/50/50/50
SQUOZE 0,Q/50/50/50/50
SQUOZE 0,Q/50/50/50
SQUOZE 0,Q/50/50
SQUOZE 0,Q/50
SQUOZE 0,Q
TERMIN
IFDEF .CRFON,.CRFON
;FORMAT TABLE(S)
;4.9-4.4 ETC SPECIFY SHIFT
;4.4-3.6 ETC SPECIFY NUMBER BITS
;FIELD SPECS IN REVERSE ORDER
IFORTB: 0 ;NCNSN 10 ,
0 ;NCNSF 11 IMPOS
0 ;NCNCN 12 ,,
2200,, ;NCNCF 13 ,,C
2200000000 ;NCFSN 14 ,B
0 ;NCFSF 15 ,B C
0 ;NCFCN 16 ,B,
0 ;NCFCF 17 ,B,C
4400000000 ;FSNSN 20 A
0 ;FSNSF 21 IMPOS
0 ;FSNCN 22 IMPOS
0 ;FSNCF 23 IMPOS
2200440000 ;FSFSN 24 A B
2200220044 ;FSFSF 25 A B C
270400440000 ;FSFCN 26 A B,
2227040044 ;FSFCF 27 A B,C
4400000000 ;FCNSN 30 A,
0 ;FCNSF 31 IMPOS
22220000 ;FCNCN 32 A,,
2200002222 ;FCNCF 33 A,,B
2200440000 ;FCFSN 34 A,B
0 ;FCFSF 35 A,B C
0 ;FCFCN 36 A,B,
0 ;FCFCF 37 A,B,C
FRTBL==.-IFORTB ;LENGTH OF FORMAT TABLE
VBLK
FORTAB: BLOCK FRTBL ;ACTUAL FORMAT TABLE
FRTBE=.-1
PBLK
;VARIABLE STORAGE
VBLK
RETURN: JRST . ;RH HAS RETURN ADR FOR END OF MAJOR ROUTINE (E.G PASS 2)
CDISP: 0 ;CURRENT DISPATCH CODE
PPRIME: 0 ;PUSH DOWN LIST MARKER (GETFLD)
SCNDEP: 0 ;DEPTH IN SUCCESSFUL BRACKET CONDITIONALS INSIDE INNERMOST LITERAL.
CONDLN: 0 ;LINE NUMBER AT WHICH LAST TOP LEVEL SUCCESSFUL CONDITIONAL ENCOUNTERED
CONDPN: 0 ;PAGE NUMBER-- PRINT THESE IF REACH END AND CONDITIONAL NOT TERMINATED
CONDFI: 0 ;SIXBIT FN1 OF FILE CONTAINING LAST TOP LEVEL SUCCESSFUL CONDITIONAL.
A.SUCC: 0 ;NONZERO IFF LAST CONDITIONAL SUCCEEDED.
ASMOUT: 0 ;0 NORMAL, 1 WITHIN <>, 2 IN (), 3 IN [].
ASMDSP: ASSEM3 ;PLACE TO JUMP TO FROM ASSEM1 LOOP.
;ASSEM3 NORMAL. ASSEMC IF WITHIN <>, () OR []
;AND .MLLIT ISN'T POS. LSSTHA AFTER > OR ) SEEN.
;[ ;CONND AFTER ] SEEN.
ASMDS1: 0 ;ASMDSP SAVED HERE DURING ASCII, SIXBIT PSEUDOS.
ASSEMP: 0 ;RESTORE P FROM HERE AT ASSEM1. SAVED OVER LITERAL.
ASMI: 0 ;REINIT I AT ASSEM2 FROM ASMI.
GLSPAS: 0 ;RESTORE GLSP1 AT ASSEM1. SAVED OVER LITERAL.
GLSP1: 0 ;POINTER TO BOT OF LINKAGE TABLE IN USE HIGH ADR
GLSP2: 0 ;POINTER TO TOP OF LINKAGE TABLE IN USE LOW ADR
FORMAT: 0 ;ACCUMULATES FORMAT WORD
FORPNR: 0 ;POINTER INTO FORMAT WORD, SHOULD BE FORMAT+1 SO CLOBBERABLE BY LAST IDPB
FLDCNT: 0 ;NUMBER OF FIELDS PUSHED DOWN IN CURRENT WORD
WRD: 0 ;ACCUMULATES VALUE OF WORD
WRDRLC: 0 ;RELOC OF WRD, MUST COME RIGHT AFTER WRD.
T1: 0 ;TEMP
T2: 0 ;TEMP
PBITS1: 0 ;CURRENT CODE BITS
PBITS2: 0 ;NO OF SPECS LEFT IN CURRENT WORD
PBITS4: 0 ;POINTER TO WHERE CURRENT CODE BITS WILL GO
OPT1: 0 ;POINTER FOR STORING IN BKBUF (OUTPUT BUFFER)
CONTRL: 0 ;FLAG REG FOR IO CONTROL ETC, .GE. 0 => RELOCATABLE/1PASS
CDATBC: 0 ;CURRENT DATA BLOCK CODE TYPE
SCKSUM: 0 ;CKSUM FOR SIMPLE BLOCK FORMAT
IFN A1PSW,[
PRGC: -1 ;ONE LESS THAN # TIMES END HAS BEEN ENCOUNTERED
OUTN1: -1 ;.GE. 0 => OUTPUT HAS OCCURED IN OTHER THAN 1PASS MODE (NOT INITIALIZED)
OUTC: -1 ;.GE. 0 => OUTPUT HAS OCCURED DURING CURRENT ASSEMBLY
]
LINKL: 0 ;SAVE LIMIT OF GLOTB GETWRD
STRCNT: 0 ;COUNT OF CHARS READ (INCL. DELIM) BY GSYL
STRPNT: 0 ;TEMP AT GSYL, BYTE POINTER TO STRING STORAGE
ISYMF: -1 ;-1 IF ISYMS HAVE NOT BEEN SPREAD
SMSRTF: -1 ;-1 BEFORE SYMTAB IS COMPACTED AND SORTED.
;AFTER COMPACTING, HOLDS NUMBER OF SYMS THAT WERE THERE BEFORE COMPACTING.
BITP: 0 ;BYTE PNTR TO CODE BITS IN CURRENT (RELOC) BLOCK
LDCCC: 0 ;DEPTH IN LOADTIME CONDS
PARBIT: 0 ;0 OR 4 FOR : OR = (IN GENERAL, TEMP AT P7X)
LABELF: 0 ;-1 IN COLON, SOMETIMES IN EQUAL. CAUSES 3LABEL TO BE SET.
STGSW: 0 ;NON ZERO GIVES ERROR PRINT ON STORAGE WORDS
HKALL: 0 ;NONZERO => HALF-KILL ALL LABELS (.HKALL'S VALUE)
LITSW: 0 ;-1 => USING A LITERAL GIVES AN ERROR
QMTCH: 0 ;-1 => ' AND " NEED MATCHING CLOSINGS (A LA FAIL, MACRO-10)
STARTA: 0 ;STARTING ADDRESS FOR SBLK, RIM, DECSAV
DECSYA: 0 ; ADDRESS TO LOAD SYMBOLS AT (FOR DECSAV FORMAT)
DECBRK: 0 ;LARGEST RELOC. ADDR. LOADED INTO. (USED FOR DEC FMT)
DECBRA: 0 ;LARGEST ABS. ADDR LOADED INTO.
DECBRH: 0 ;LIKE DECBRK BUT FOR ADDRS IN HI SEG.
DECTWO: MOVE ;NOT = MOVE => .DECTWO WAS DONE, AND THIS WD HAS
;ADDR START OF HISEG.
ISAV: 0 ;I FROM FIELD AT AGETFLD
A.PASS: 0 ; .PASS INTSYM, # OF THIS PASS.
A.PPAS: 0 ;.PPASS INTSYM, # OF PASSES.
WPSTE: NRMWPS ;# WORDS PER SYMTAB ENTRY
WPSTE1: NRMWPS-1;ONE LESS THAN WPSTE - FOR SPEED.
WPSTEB: ,-NRMWPS(B) ;RH HAS - # WORDS PER SYMTAB ENTRY; LH HAS INDEX OF B.
SYMSIZ: 0 ;#WDS IN SYMTAB = WPS*<SYMLEN>
SYMLEN: SYMMSZ ;SYMTAB SIZE (# SYMS)
;ASSEMBLED-IN VALUE USED AS DEFAULT, ONLY IF NON-TS.
SYMAOB: 0 ;-<# SYMS>,,0
INICLB: 0 ;-1 IF INITIALIZATION CODE CLOBBERED.
TTYINS: 0 ;AT START OF ASSEMBLY, -1 => .INSRT TTY PASS1, -2 => PASS2 ALSO.
IFN FASLP,[
FASBP: 0 ;PNTR TO FASL OUTPUT BUFFER
FASATP: 0 ;PNTR TO FASL ATOM TABLE
FASAT1: 0 ;PNTR TO FASL ATOM TABLE AFTER READING IN NEW ATOM
; (MAYBE UPDATE FASATP TO THIS IF ATOM WAS UNIQUE9
FASAT2: 0 ;BYTE PNTR USED TO STORE ATOM IN
FASIDX: 0 ;INDEX NEXT ATOM LOADED INTO FASAT WILL BE
FASPCH: 0 ;AMOUNT OF FASAT "PUNCHED"
FASCBP: 440400,,FASB ;BYTE PNTR TO FASL CODE BIT WORD
FASPWB: 0 ;FASL CODE AT PWRD
FASBLC: 0 ;LOSING BLOCK "COUNT"
FASBLS: 0 ;LOSING BLOCK "SYMBOL"
AFRLD: 0 ;LIST READ CURRENT DEPTH
AFRLEN: 0 ;LIST READ CURRENT LENGTH
AFRDTF: 0 ;LIST READ DOT CONTEXT FLAG (0 NORMAL, 1 SAW DOT, 2 SAW "FROB AFTER DOT"
AFRFTP: 0 ;LIST READ SAVED STATE OF FASATP
AFLTYP: 0 ;TYPE LIST OP IN- 0 EVAL AND THROW AWAY VALUE
;1 "RETURN" LIST
;2 "RETURN" VALUE OF LIST
]
PBLK
;INFO CONVENIENT TO ANYONE GENERATING AN OUT OF TIME-SHARING MIDAS
;MIDAS OUT OF TIME-SHARING ASSEMBLES INTO A COLLECTION OF SUBROUTINES
;IO IS EXPECTED TO BE HANDLED BY OTHER PROGRAMS.
;EXITS FROM THE ASSEMBLER:
;TPPB OUTPUT BINARY WORD IN A
;TFEED IF OUTPUT DEVICE IS PTP, PUNCH OUT # FRAMES OF BLANK TAPE
;SPECIFIED BY B, MAY CLOBBER A AND B
;GO9 RETURN POINT FROM FATAL ERRORS
;TYO TYPE OUT CHARACTER IN A
;TAB TYPE OUT A TAB (MAY CLOBBER A OF COURSE)
;RCHTBL SEE THE RCH ROUTINES
;ENTRIES
;PDL, LPDL MAY BE USED BY COMMAND PROCESSOR BUT WILL BE CLOBBERED BY MAIN ROUTINES
;MAIN ROUTINES, CALLED WITH JSP A, , CLOBBER THE WHOLE WORLD (INCLUDING P)
;INIT INITIALIZE
;PS1 PASS 1
;PLOD IF APPROPRIATE, PUNCH OUT LOADER
;PS2 PASS 2 (DOES ITS OWN PARTIAL INITIALIZATION)
;PSYMS PUNCH OUT SYMBOL TABLE
;OTHER ENTRIES
;CONTRL AFTER ASSEMBLY, .GE. 0 => RELOCATABLE, .LT. 0 => ABSOLUTE
;ISYMF -1 IF SYMS HAVE NOT BEEN SPREAD, ELSE DON'T TRY TO ADD TO INITIAL SYMBOL TABLE
;SMSRTF -1 IF SYMTAB HASN'T BEEN SORTED, ELSE SYMTAB CLOBBERED, DON'T RE-ASSEMBLE
;MIDVRS .FNAM2 OF MIDAS ENGLISH
;SOME FF FLAGS ARE GLOBAL SO COMMAND PROCESSOR CAN KNOW WHAT'S HAPPENED ON RETURN
;COMMAND PROCESSOR MAY ADD TO INITIAL SYMBOL TABLE BEFORE CALLING INIT THE FIRST TIME
;EISYMT IS THE FIRST LOCATION OK TO DUMP INTO
;EISYMP RH SHOULD BE SET BY COMMAND PROCESSOR TO FIRST LOC NOT DUMPED INTO
;INTSYM RH OF SYMTAB VALUE TO RETURN VALUE ADDRESSED BY LH(SYMTAB ENTRY)
;RCH HAS AN ELABORATE SET OF GLOBALS, WHICH I DON'T FEEL LIKE PUTTING DOWN NOW, BUT THEY INCLUDE
;RCH (GET CHAR) SEMIC, RRL1, RREOF, SEMICR, SEMIC, TYPCTL, GDTAB, CPGN, CLNN,
;RCHMOD, MDSCLR, MDSSET, RCHSET, POPLMB, PSHLMB
;ALSO RCHTBL ONLY EXIT
;LISTING FEATURE GLOBALS:
;PILPT PRINT CHAR IN A
;LISTON LISTING ON/OFF FLAG, -1 => ON
;LISTP SAME WORD AS LISTON.
;LISTP1 POSITIVE => LIST EVEN ON NON-PUNCHING PASS.
;LPTCLS END OF LISTING, PRINT FORM FEED, IF TS THEN CLOSE LPT
;CREF FEATURE GLOBALS:
;CRFOUT OUTPUT WORD IN A.
;CREFP -1 => REQUEST GENERATION OF CREF OUTPUT.
;THE RUBOUT-B-^W HEADER, THE SET-SOURCE-FILE BLOCK, AND THE EOF BLOCK
;ARE THE RESPONSIBILITY OF THE COMMAND PROCESSOR.
;;RCH ;CHARACTER INPUT ROUTINES
IFN RCHASW\MACSW,[
;SAVE LIMBO1 STATUS AND RH(B)
;THEN SET UP FOR NEW INPUT MODE (DESCRIPTOR IN A)
;CALLED BY PUSHEM AND PUSHTT
PSHLMB: HRL B,LIMBO1 ;LAST CHARACTER INPUT
TLZE FF,FLUNRD ;RE-INPUT CHARACTER ON RETURN?
XCT LSTPLM ;SET B'S SIGN; IF LISTING, JRST PSHLML.
PSHLMN: EXCH A,RCHMOD ;GET OLD MODE IN A
DPB A,[360500,,B] ;STORE IN 5 OF HIGH 6 BITS IN B
PUSH F,B ;SAVE RESULTANT CRUD
CAMN A,RCHMOD ;COMPARE NEW WITH OLD
POPJ P, ;SAME => SKIP OVERHEAD OF SETTING NEW MODE
MOVE A,RCHMOD ;NOW GET NEW MODE
JRST PSHLM1 ;SET UP INSTRUCTIONS FOR NEW MODE
IFN LISTSW,[
;IF LISTING, LSTPLM HOLDS JRST PSHLML
PSHLML: AOSN PNTSW
JRST PSHLMM ;LAST WAS BREAK CHR
REPEAT 4,IBP PNTBP
SOSA PNTBP
PSHLMM: SETOM LISTBC
TLO B,400000
JRST PSHLMN
]
;UNDO A PSHLMB (NOTE: IN COMMENTS BELOW, "NEW" MODE IS ON PDL, OLD IN RCHMOD)
POPLMB: POP F,A ;GET WORD THAT PSHLMB PUSHED
HLRZS A ;JUST INTERESTED IN LEFT HALF
TRZE A,400000 ;SIGN BIT SET?
TLOA FF,FLUNRD ;YES, SET FLAG TO RE-INPUT LAST CHAR
TLZA FF,FLUNRD ;NO, CLEAR FLAG.
XCT POPLML ;JFCL\IDPB A,PNTBP ;THE LATTER IFF LISTING.
SETZM LIMBO1 ;INITIALIZE FOR DPB
DPB A,[700,,LIMBO1] ;RESTORE LIMBO1
LSH A,-<18.-6> ;RIGHT JUSTIFY RCHMOD DESCRIPTOR
CAMN A,RCHMOD ;COMPARE NEW MODE WITH OLD
POPJ P, ;SAME => SKIP OVERHEAD OF SETTING NEW MODE
JRST RCHSET ;SET UP FOR NEW MODE AND RETURN
]
FOO==0 ;INITIALIZE COUNTER FOR FOLLOWING
DEFINE RCHBLT SIZE,ADR/
MOVSI T,FOO(A)
HRRI T,ADR
BLT T,<SIZE>-1+ADR
FOO==FOO+<SIZE>
TERMIN
DEFINE RCHMOV ADR/
MOVE T,FOO(A)
MOVEM T,ADR
FOO==FOO+1
TERMIN
;SET UP FOR INPUT OF MODE TYPE SPECIFIED IN A, CLOBBER A ONLY
RCHSET: MOVEM A,RCHMOD ;STORE NEW RCHMOD
PSHLM1: TLZ FF,FLMAC\FLTTY ;CLEAR FLAGS (MAYBE DEVICE ROUTINE SETS ONE)
XCT RCHTBL(A) ;GET IN A A POINTER TO A DESCRIPTOR TABLE (MAYBE ALSO SET FLAG)
PUSH P,T ;SAVE T, NEED IT FOR TEMP
RCHBLT 3,RCH2 ;FIRST 3 WORDS RCH2
TLNE FF,FLVOT
JRST POPTJ ;ALL RCH'S TO GO THROUGH RCH, DON'T DO ANYTHING ELSE
MDSST1: RCHBLT 3,RR1 ;NEXT 3 RR1
RCHMOV RRL1 ;NEXT WORD RRL1
RCHPSN==FOO ;# WORDS IN ALL TABLES BUT LAST (NOT OF CONSTANT LENGTH)
RCHBLT 6,SEMIC ;LAST N SEMIC
POPTJ: POP P,T
POPJ P,
IFN LISTSW,[
;SET UP TO "DISPLAY" (ALL RCH'S THROUGH RCH)
MDSSET: TLO FF,FLVOT ;SET FLAG
MOVEI A,MDSSTB-3 ;SET UP AC
PUSH P,T ;SAVE T FOR RESTORATION
JRST MDSST1 ;NOW SET UP
MDSSTB: JRST RRL1 ;RR1
HALT
PUSHJ P,RCH ;RREOF
PUSHJ P,RCH ;RRL1
IFN .-<MDSSTB-3>-RCHPSN,.ERR LOSSAGE AT MDSSTB.
PUSHJ P,RCH ;SEMIC
CAIE A,15
JRST SEMIC
JRST SEMICR
;CLEAR OUT DISPLAY MODE
MDSCLR: TLZ FF,FLVOT ;CLEAR FLAG
MOVE A,RCHMOD
JRST RCHSET ;NOW SET UP FOR REAL IN CURRENT MODE
] ;END IFN LISTSW,
IFN TS,[ ;TABLE FOR RCHSET, INDEXED BY MODE
;MAYBE THIS CONDITIONAL WANTS TO BE CHANGED TO SOMETHING ELSE
RCHTBL: MOVEI A,RCHFIL ;0 => INPUT FROM FILE
IFN MACSW,PUSHJ P,RCHMAC ;1 => INPUT FROM MACRO (DO NOT CHANGE, USED BY MACRO PROCESSOR)
IFN RCHASW,[IFE MACSW,HALT
PUSHJ P,RCHTRC ;2 => TTY, QUIT ON CR
PUSHJ P,RCHARC ;3 => TTY, DON'T QUIT ON CR
]
;TABLE FOR INPUTTING FROM FILE
;MAYBE THIS CONDITIONAL ALSO WANTS TO BE CHANGED
RCHFIL: ILDB A,UREDP ;GETCHR, GET CHARACTER
CAIG A,14 ;SKIP IF TOO BIG TO BE SPECIAL
XCT RPATAB(A) ;SPECIAL, DO THE APPROPRIATE THING
JRST RRL1 ;RR1
HALT
PUSHJ P,[ MOVEI A,0 ;^C IN SYMBOL TREATED LIKE A ^@,
JRST INCHR3] ;BUT ALSO SEE IF REALLY END OF BUFFER. THIS GOES IN RREOF.
ILDB A,UREDP ;RRL1
IFN .-RCHPSN-RCHFIL,.ERR RCHFIL LOSES.
LDB CH1,[360600,,UREDP] ;SEMIC; FIND WHERE IN ITS WORD UREDP POINTS
IDIVI CH1,7
JRST @SEMIC3(CH1) ;AND ENTER THE CR-SCANNING LOOP AT THE APPROPRIATE
JFCL ;PLACE (IT IS A WORD-BY-WORD LOOP).
;TABLE FOR ABOVE, EXECUTED INDEXED BY CHAR, 15 ONLY FROM SEMIC ELSE ANYTHING
;NOTE: MANY OF THESE ROUTINES SUBTRACT 3 FROM THE PC BEFORE RETURNING.
;THE CALLER MUST MAKE SURE THAT THE ILDB UREDP IS WHAT THEY RETURN TO THAT WAY.
RPATAB:
IFN ITSSW, JFCL ;0, ON I.T.S. IS NORMAL CHARACTER
.ELSE CALL RPANUL ;0, ON DEC SYSTEM, IGNORE IT.
JFCL
JFCL
IFN .-RPATAB-EOFCH,.ERR EOFCH DOESN'T AGREE WITH ENTRY IN RPATAB.
PUSHJ P,INCHR3 ;3, EOFCH
REPEAT 6,JFCL
CALL RPALF ;LINE FEED
JFCL ;13
PUSHJ P,RPAFF ;FORM FEED
JRST SEMICR ;FROM SEMIC ONLY, EXIT FROM LOOP
RPAFF: SKIPE ASMOUT ;FORM FEED
SKIPL TEXT4 ;ALLOW FORMFEED WITHIN GROUPING ONLY IF IN A TEXT PSEUDO.
CAIA
ETR [ASCIZ/Formfeed within <>, () or []/]
AOS CH1,CPGN
SETOM CLNN
IFN ITSSW,[
ADD CH1,[SIXBIT /P0/+1]
MOVE CH2,A.PASS
DPB CH2,[300200,,CH1]
.SUSET [.SWHO3,,CH1] ;PUT THE NEW PAGE # IN THE WHO-LINE.
]
RPALF: AOS CH2,CLNN
CAME CH2,A.STPLN
RET
MOVE CH1,CPGN
CAMN CH1,A.STPPG
SETOM TTYBRF
RET
IFN DECSW\TNXSW,[
RPANUL: MOVE CH1,@UREDP ;SAW A NULL - IN A LINE NUMBER?
TRNN CH1,1
JRST RCHTRA ;NO, JUST IGNORE IT.
MOVEI CH1,010700
HRLM CH1,UREDP ;YES, SKIP THIS WHOLE WORD, THEN
CALL RCH ;SKIP THE 1ST CHAR AFTER THE LINE NUMBER
JRST RCHTRA ;RETURN THE NEXT CHAR FROM THIS CALL TO RCH.
]
] ;END IFN TS,
VBLK
LIMBO1: 0 ;LAST CHARACTER READ BY RCH
RCHMOD: 0 ;CURRENT INPUT MODE, 0 => INPUT FROM FILE, 1 => MACRO, ETC.
CLNN: 0 ;1 LESS THAN LINE # IN CURRENT INPUT FILE.
CPGN: 0 ;1 LESS THAN PAGE # IN CURRENT INPUT FILE
A.STPL: 0 ;1 LESS THAN LINE # TO STOP AT.
A.STPP: 0 ;1 LESS THAN PAGE # TO STOP AT.
;(STOPPING MEANS INSERTING THE TTY)
;READ CHARACTER INTO A FROM INPUT FILE, MACRO, OR WHATEVER (RCH)
;CLOBBERS A,CH1,CH2.
RCH: TLZE FF,FLUNRD
JRST RCH1 ;RE-INPUT LAST ONE
RCH2: HALT ;ILDB A,UREDP ;ILDB A,CPTR ;GET CHAR
0 ;CAIG A,14 ;TRZE A,200 ;CHECK FOR SPECIAL
0 ;XCT RPATAB(A) ;PUSHJ P,MACTRM ;SPECIAL, PROCESS
MOVEM A,LIMBO1 ;GOT CHAR, SAVE AS LAST CHAR GOTTEN
IFE TS,RCHLS1==JRST TYPCTL
IFN TS,RCHLS1==RET ;DEFAULT CONTENTS OF RCHLST (IF NOT LISTING)
RCHLST: RCHLS1 ;AOSN PNTSW IF LISTING.
IFN LISTSW,[
PUSHJ P,PNTR
CAIG A,15
JRST RCHL1
RCHL3: IDPB A,PNTBP
TYPCTL: POPJ P, ;OR JRST SOMEWHERE
PBLK
RCHL1: CAIE A,15
CAIN A,12
JRST RCHL2
CAIE A,14
JRST RCHL3
RCHL2: MOVEM A,LISTBC
SETOM PNTSW
JRST TYPCTL
VBLK
RCH1: MOVE A,LIMBO1
RCH1LS: RET ;OR CAILE A,15 IF LISTING.
RET ;NEEDED IN CASE LISTING.
CAIE A,15
CAIN A,12
JRST RCHL2
CAIE A,14
POPJ P,
JRST RCHL2
PBLK
] ;END IFN LISTSW,
IFE LISTSW,[
PBLK
RCH1: MOVE A,LIMBO1
RET
] ;END IFE LISTSW,
;;GETSYL ;VARIOUS SYLLABLE READING ROUTINES (BUT NOT ALL OF THEM)
GSYL: CLEARB SYM,STRCNT
GSYL1: MOVEI D,6
MOVE T,[440700,,STRSTO]
MOVEM T,STRPNT
GSYL3: AOSG A,STRCNT
JRST (F)
PUSHJ P,RCH
IDPB A,STRPNT ;STORE CHAR IN STRING EVEN IF DELIMITER (MINIMUM STRCNT = 1)
A.GSY2: CAIN A,".
JRST GSYL1C
HLRZ CH1,GDTAB(A)
CAIN CH1,(JSP CH2,)
JRST GSYL1A ;NUMBER
PUSHJ P,GSYL1B ;RETURN ONLY ON SYL SEP
HRRZ A,GDTAB(A)
MOVE T,LIMBO1
C%: POPJ P,"%
GSYL1B: XCT GDTAB(A) ;POPJ FOR SYL SEPS
SUB P,[1,,1]
GSYL1D: SOJGE D,GSYL3
AOJA D,GSYL3
GSYL1C: ADD SYM,%.SQ(D)
JRST GSYL1D
GSYL1A: XCT NSQTB-60(A)
JRST GSYL1D
;VERSION OF GETSYL TO TRY UNTIL SYL OR WORD TERMINATOR FOUND
;SKIPS IF NAME THERE (FOR .TYPE, SQUOZE)
GTSLD2: TLNN C,DWRD\DFLD
JRST GTSLD3 ;DELIMITER IS WORD TERMINATOR, TOLERATE THE NULL SYLLABLE
GETSLD: PUSHJ P,GETSYL ;ENTRY, GET A SYL
MOVE C,CDISP ;GET CDISP
TRNN I,IRSYL
JRST GTSLD2 ;NO SYL
AOS (P) ;GOT SYL, CAUSE RETURN TO SKIP
GTSLD3: TLNN C,DWRD\DFLD
TLO FF,FLUNRD ;CAUSE DELIMITER TO BE RE-INPUT
POPJ P,
PASSPS: SKIPA A,LIMBO1
GPASST: CALL RCH
CAIE A,40
CAIN A,^I
JRST GPASST
RET
GETSYL: TLZ I,ILUARI+ILNPRC+ILLSRT
GTSL1: CLEARB SYM,NUMTAB ;RECUR HERE FOR RIGHT ARG TO ^ AND _.
MOVE AA,[NUMTAB,,NUMTAB+1]
AOSN NTCLF
BLT AA,NUMTAB+10 ;NUMTAB NOT CLEAR, HAVE TO CLEAR IT
MOVEI D,6 ;CHARACTER COUNTER FOR BUILDING UP SYM
SETOM ESBK ;NO SPECIFIC BLOCK DESIRED.
TDZ I,[ILDECP+ILFLO+ILVAR+ILGLI,,IRPERI+IRLET+IRSYL]
RRL2: PUSHJ P,RR ;CALL MAIN LOOP ROUTINE, READ UNTIL NON-SQUOZE CHAR
SEMICR: ;RETURN HERE FROM SEMIC WITH CR IN A
MOVEM A,LIMBO1 ;SYLLABLE OPERATOR OR TERMINATOR IN A, SAVE
HRRZ A,GDTAB(A) ;NOW GET RIGHT HALF OF POPJ, INDEX INTO DTB
MOVE C,DTB-40(A) ;GET DTB ENTRY (FLAGS,,JUMP ADR)
MOVEM C,CDISP ;STORE AS DISPATCH CODE FOR LAST CHAR (SORT OF AN INTERPRETED LIMBO1)
RR8: TLNE C,DSYL ;NOW SEE IF SYL OPERATOR FLAG SET
JRST (C) ;SET => INTRA-SYLLABLE OPERATOR
RR10: TRNE I,IRLET ;NOT SET => SYLLABLE TERMINATOR: SYL?
POPJ P, ;SYL HAS LETTERS
TRNN I,IRSYL
JRST CABPOP ;NO SYL
CAMN SYM,[SQUOZE 0,.]
JRST PT1 ;SYM IS .
;NUMBER
RR5: TLNN I,ILNPRC
PUSHJ P,NUMSL
TLNN I,ILFLO
JRST RR9 ;NOT FLOATING POINT
MOVE A,B ;FLOATING, HIGH IN AA,LOW IN A,EXP IN B
ADDI A,306 ;201+105 TO ROUND
ADDI AA,200 ;CAUSE EXPONENT TO BE ACCEPTABLE TO MACHINE
JUMPGE AA,.+3 ;NOW CHECK FOR OVERFLOW ON ROUNDING
LSH AA,-1 ;OVERFLOW, SHIFT BACK ONE
AOS A ;INCREMENT EXPONENT TO COMPENSATE FOR SHIFT
EXCH A,AA ;GET EXPONENT IN AA, REST IN A
ASHC AA,-10 ;SHIFT TO MACHINE FLOATING POINT FORMAT
SKIPE AA ;NOW CHECK HIGH ORDER BITS OF EXPONENT NOT SHIFTED INTO NUMBER
ETR [ASCIZ /Exponent overflow/]
RR9: TLZ I,ILGLI+ILVAR ;NOT TRYING TO DEFINE NUMBER AS VARIABLE OR GLOBAL
CLBPOP: TDZA B,B ;CLEAR OUT B (RELOCATION BITS OF VALUE)
CABPOP: SETZB A,B ;DO JRST CABPOP TO RETURN ZERO AS VALUE
POPJ P,
RRU: MOVE A,LIMBO1 ;GET HERE WHEN FLUNRD SET AT RR, RETRIEVE CHARACTER FROM LIMBO1
CAIG A,14 ;IF TOO BIG,
CAIGE A,12 ;OR IF TOO SMALL,
JRST RR1B ;THEN JUST FALL BACK IN
TLNN FF,FLVOT\FLMAC\FLTTY ;SKIP IF NOT HACKING CPGN/CLNN
XCT RRUTAB-12(A) ;HACKING, UNHACK FOR HACK COMING UP
JRST RR1B ;FALL BACK IN
RRUTAB: SOS CLNN ;LINE FEED (TABLE FOR RRU)
JRST RR1B ;13
SOS CPGN ;FORM FEED
;MAIN LOOP ROUTINE FOR GETSYL, READ SYM OR NUMBER
VBLK
RR: TLZE FF,FLUNRD ;RE-INPUT LAST CHARACTER?
JRST RRU ;YES
RR1: JRST RRL1 ;ILDB A,CPTR ;GET CHAR (" " ")
HALT ;TRZE A,200 ;CHECK FOR END OF STRING
RREOF: PUSHJ P,RCH ;PUSHJ P,MACTRM ;PROCESS CONDITION, GET NEXT CHAR OR JRST RR1 OR RRU
.SEE RCHTRA ;SPECIAL HANDLING OF UNRCHF IN RCHTRA IF CALLED FROM HERE.
RR1B: XCT GDTAB(A) ;GOT CHAR, DO SOMETHING APPROPRIATE (POPJ ON NOT SQUOZE)
TROA I,IRLET\IRSYL ;LETTERS RETURN, JUST UPDATED SYM, SET FLAGS
TRO I,IRSYL ;NUMBERS RETURN, SET FEWER FLAGS
SOJGE D,RR1 ;DECREMENT SYM COUNTER AND LOOP
AOJA D,RR1 ;COUNTER EXHAUSTED, INCREMENT BACK TO 0 AND LOOP
RRL1: PUSHJ P,RCH ;ILDB A,UREDP ;GET CHAR
XCT GDTAB(A) ;NOW MAKE LIKE RR1B (EOFCH => JRST RREOF)
TROA I,IRLET\IRSYL
TRO I,IRSYL
SOJGE D,RRL1
AOJA D,RRL1
;SEMICOLON (GET HERE FROM RR8)
JRST SEMICL ;RETURN HERE FROM SEMIC+2 WHEN FLUNRD SET
;NEXT 4 INSNS ALTERED IN DIFFERENT INPUT MODES. SEE RCHFIL, ETC.
SEMIC: PUSHJ P,RCH ;GET CHAR
CAIE A,15 ;SEE IF SPECIAL
JRST SEMIC ;SPECIAL => DO SOMETHING (JRST SEMICR ON CR)
JRST SEMICR ;IF NOT SPECIAL THEN GO BACK FOR NEXT CHAR
LOC SEMIC+6 ;LEAVE A LITTLE EXTRA ROOM FOR BIG ROUTINES
PBLK
SEMICL: MOVE A,LIMBO1 ;HERE FROM SEMIC-1, RETRIEVE CHARACTER FROM LIMBO1
CAIE A,15 ;SKIP IF SHOULD TERMINATE SCAN
JRST SEMIC ;NOT CR, FALL BACK IN
JRST SEMICR ;DONE
SEMIC2:
REPEAT 5,[
ILDB A,UREDP
CAIG A,15
XCT RPATAB(A)
]
MOVE A,[ASCII /@@@@@/]
SEMIC1: AOS CH1,UREDP
MOVE CH1,(CH1) ;ANY CONTROL CHARS IN THE WORD UREDP POINTS AT?
MOVE CH2,CH1
AND CH1,A
AND CH2,[ASCII/ /]
LSH CH2,1
IOR CH1,CH2
CAMN CH1,A
JRST SEMIC1 ;NO, ADVANCE TO NEXT WORD AND TEST IT.
MOVEI A,440700
HRLM A,UREDP
JRST SEMIC2 ;YES, LOOK AT EACH CHAR AND PROCESS IT.
SEMIC3: REPEAT 6,JRST SEMIC2+3*<5-.RPCNT>
;JSP CH2,RR2 => DIGIT (FROM GDTAB)
;THIS ROUTINE IS GROSSLY SLOW, AND SHOULD BE SPEEDED UP SOMETIME
RR2: XCT NSQTB-"0(A) ;UPDATE SQUOZE.
TRNE I,IRLET
JRST 1(CH2) ;SYL IS SYM, DON'T WASTE TIME.
TRNE I,IRPERI
TLO I,ILFLO ;DIGIT AFTER . => FLOATING.
MAKNUM: SETOM NTCLF ;NUMTAB ABOUT TO NOT BE CLEAR, SET FLAG FOR GETSYL TO CLEAR IT OUT NEXT TIME
MOVEI AA,2 ;INDEX INTO NUMTAB ETC., SOJGE'D TO GET ALL RADICES
MAKNM1: MOVE T,ARADIX(AA) ;GET THIS RADIX,
CAMN T,ARADIX ;REDUNDANT => SKIP THIS PASS.
JUMPN AA,MAKNM4
SKIPGE CH1,HIGHPT(AA)
JRST MAKNM3
MUL T,LOWPT(AA) ;TT HAS OLD LOW TIMES RADIX, T HAS OVFLO TO HIGH.
ADDI TT,-"0(A) ;ADD DIGIT TO LOW PART
TLZE TT,400000
AOJ T, ;OVERFLOW, INCREMENT SPILLOVER FROM MUL OF LOWPT
JUMPE CH1,MAKNM5 ;OLG HIGHPT WAS 0 => SAVE TIME.
JFCL 17,.+1 ;NOW CLEAR OV, ETC.
IMUL CH1,ARADIX(AA) ;MULTIPLY HIGHPT BY RADIX
ADD T,CH1 ;ADD HIGH PARTS
JFCL 10,MAKNM2 ;JUMP ON OVERFLOW FROM IMUL OR ADD
MAKNM5: TLNE I,ILFLO
SOS NUMTAB(AA) ;FLOATING, DECREMENT EXP TO COMPENSATE FOR MULT OF HIGHPT/LOWPT
MOVEM T,HIGHPT(AA) ;NOW STORE STUFF BACK
MOVEM TT,LOWPT(AA)
MAKNM4: SOJGE AA,MAKNM1 ;NOW DO ALL THIS FOR NEXT RADIX
JRST 1(CH2)
MAKNM2: MOVSI B,400000 ;OVERFLOW FROM UPDATING HIGH PARTS
IORM B,HIGHPT(AA) ;SET SIGN BIT
MAKNM3: TLNN I,ILFLO
AOS NUMTAB(AA) ;NOT FLOATING, INCREMENT EXP, MAY NOT WANT TRAILING BITS
JRST MAKNM4
VBLK
NUMTAB: 0 ;EXPONENT
0
0
HIGHPT: 0 ;HIGH PART OF CURRENT NUMBER THIS RADIX
0 ;4.9 => OVERFLOW, TRAILING DIGITS DROPPED
0
LOWPT: 0 ;LOW PART OF CURRENT NUMBER THIS RADIX
0 ;HIGHPT/LOWPT TAKEN AS 70. BIT POSITIVE INTEGER EXCEPT 4.9(HIGHPT) IS FLAG INSTEAD OF
0 ;EXPONENTIATE 70. BIT INTEGER BY NUMTAB (WHICH MAY BE NEGATIVE) TO GET ACTUAL VALUE
ARADIX: 10 ;CURRENT RADIX
12
10
NTCLF: -1 ;-1 => NUMTAB NOT CLEAR (TO SAVE BLT AT GETSYL WHEN CLEAR)
PBLK
;JRST POINT => . (FROM GDTAB)
POINT: TLO I,ILDECP ;PREFER DECIMAL
TROE I,IRPERI ;SET PERIOD FLAG
TRO I,IRLET ;2 POINTS => NAME
ADD SYM,%.SQ(D) ;UPDATE SYM
JRST 1(CH1) ;RETURN
RBRAK: SOSL SCNDEP ;IF A CONDITIONAL TO TERMINATE,
JRST RBRAK2 ;HAVE DONE SO, IGNORE CHAR.
SETZM SCNDEP
;CLOSES OF ALL KINDS COME HERE.
RPARN:
GRTHN: MOVE A,LIMBO1
SKIPE CH1,ASMOUT ;WHAT KIND OF OPEN ARE WE IN?
CAIN CH1,4 ;WITHIN A .ASCII OR
JRST RBRAK1 ;NOT WITHIN GROUPING => THIS CLOSE IS STRAY.
CAME A,ASMOT1(CH1) ;RIGHT KIND OF CLOSE FOR THAT OPEN?
ERJ RBRAK3
RBRAK4: MOVE CH1,ASMOT2(CH1)
MOVEM CH1,ASMDSP ;ARRANGE FOR THIS ASSEM1 LEVEL TO EXIT
RBRAK5: SETZM CDISP
JRST RR10 ;AND GO TERMINATE WORD.
RBRAK3: CALL TYOERR ;COME HERE ON CLOSE WRONG FOR OPEN.
;(EG, ")" MATCHING "<").
TYPR [ASCIZ/ Seen when /]
MOVE A,ASMOT1(CH1)
CALL TYOERR
TYPR [ASCIZ/ expected
/]
JRST RBRAK4
RBRAK1: CAIN CH1,4 ;CLOSE INSIDE A .ASCII =>
JRST RBRAK5 ;TERMINATE WORD BUT DON'T CLOSE ANYTHING.
SKIPN CONSML ;COME HERE FOR STRAY CLOSE.
JRST RRL2
ERJ .+1
TYPR [ASCIZ/Stray /]
MOVE A,LIMBO1 ;GET THE CLOSE WE SAW.
CALL TYOERR
CALL CRRERR
JRST RRL2
;COME HERE FOR CLOSE-BRACE, AND CERTAIN CLOSE-BRACKETS.
RBRAK2: SETOM A.SUCC ;HAVE JUST ENDED SUCCESSFUL BRACKETED CONDIT,
JRST RRL2 ;REMEMBER THAT MOST RECENT CONDITIONAL WAS TRUE.
FORMF: TLNN FF,FLVOT\FLMAC\FLTTY ;FORM FEED SYLLABLE OPERATOR ROUTINE
PUSHJ P,RPAFF ;UNLESS ALREADY DONE, INCREMENT PAGE #.
JRST RR10
LINEF: TLNN FF,FLVOT\FLMAC\FLTTY ;LINE FEED SYLLABLE OPERATOR ROUTINE
CALL RPALF
JRST RR10
CTLAT:
IFN DECSW\TNXSW,[
TLNN FF,FLVOT\FLMAC\FLTTY ;^@ SYLLABLE OPERATOR ROUTINE.
CALL RPANUL
]
JRST RRL2
;DECIPHER A VALUE FROM NUMTABS
;LEAVES HIGH PART IN AA, LOW PART IN A, BINARY EXPONENT IN B
;AND RADIX USED IN D.
NUMSL: TLNN I,ILVAR\ILDECP\ILFLO
SKIPE B,HIGHPT
JRST NUMSLS
MOVE A,LOWPT ;BE VERY FAST IN CASE OF SMALL FIXNUM IN CURRENT RADIX.
MOVE D,ARADIX ;SAVE RADIX AND HIGH PART FOR ^.
SETZ AA,
RET
NUMSLS: CLEARB TT,D ;TT BIT EXPONENT, D INDEX INTO NUMTAB, ETC.
TLNE I,ILDECP+ILVAR ;NEITHER . NOR ', CURRENT RADIX.
TLNE I,ILGLI ;" => CURRENT RADIX DESPITE . OR '.
JRST NUMSL0
MOVEI D,1 ;DECIMAL UNLESS '
TLNE I,ILVAR ;WHICH FORCES OCTAL.
MOVEI D,2
MOVE A,ARADIX(D)
CAMN A,ARADIX ;IF REALLY SAME AS CURRENT RADIX,
MOVEI D,0 ;COMPUTATION WASN'T DONE FOR THIS VALUE OF D,
;SO USE COMPUTATIONS DONE FOR CURRENT RADIX.
NUMSL0: MOVE AA,HIGHPT(D) ;AA := HIGH PART
MOVE B,LOWPT(D) ;B := LOW PART
MOVE T,NUMTAB(D) ;T := EXPONENT
MOVE D,ARADIX(D) ;NO LONGER NEED IDX, GET RADIX VALUE.
TLNN I,ILFLO
JRST FIXNUM ;NOT FLOATING
TLZ AA,400000 ;FLOATING, DON'T NEED DIGITS LOST ON OVERFLOW
NUMC1: JUMPN AA,.+2 ;ENTRY FROM UPARR
JUMPE B,FIX0 ;COMPLETELY ZERO => RETURN FIXED ZERO
JUMPL T,NUMSL1 ;JUMP IF EXPONENT NEGATIVE
JUMPE T,NUMSL2 ;JUMP (SKIP FOLLOWING) IF EXPONENT ZERO
;EXPONENT POSITIVE, DO THE APPROPRIATE THING
NUMSL5: MULI B,(D) ;MULITIPLY LOW PART BY RADIX
MULI AA,(D) ;MULTIPLY HIGH PART BY RADIX
ADD A,B ;A := LOW PART OF HIGH + HIGH PART OF LOW
TLZE A,400000
ADDI AA,1 ;OVERFLOW ON ADDITION, INCREMENT HIGH PART OF HIGH
MOVE B,C ;NO LONGER NEED HIGH OF LOW, GET LOW OF LOW IN B
NUMSL3: JUMPE AA,NUMSL4 ;NOW CHECK FOR OVERFLOW INTO HIGH OF HIGH, JUMP ON NONE
ASHC A,-1 ;NEXT THREE INSTRUCTIONS TO DO ASH3 AA,-1
ASH A,1
ASHC AA,-1
AOJA TT,NUMSL3 ;INCREMENT BIT EXPONENT AND TRY AGAIN
NUMSL4: MOVE AA,A ;FLUSHED OVERFLOW, NOW GET (LOW PART OF) HIGH PART IN AA
SOJG T,NUMSL5 ;COUNT DOWN
NUMSL2: TLNN I,ILFLO
JRST NUMSL9 ;NOT FLOATING, DON'T WASTE TIME NORMALIZING.
SKIPA A,B ;EXPONENT NOW ZERO, GET LOW PART OF NUMBER IN A
NUMSL7: ASHC AA,1 ;NOW NORMALIZE
TLNN AA,200000
SOJA TT,NUMSL7
SKIPA B,TT ;DONE NORMALIZING, RETURN BINARY EXPONENT IN B
PT1: TRO I,IRLET
POPJ P,
NUMSL9: MOVE A,B
MOVEI B,0
ASHC AA,(TT) ;SHIFT 2-WD NUM. BY EXPONENT,
LSH A,1 ;PUT HIGH BIT IN WITH REST.
JRST FIX1
FIX0: TLZ I,ILFLO
FIXNUM: LSHC A,45
FIX1: LSHC AA,-1
JUMPE AA,.+2
ETR [ASCIZ /FIXNUM too big for 36 bits/]
POPJ P,
NUMSL1: SKIPA A,B ;EXPONENT NEGATIVE: NORMALIZE NOW
NUMSL8: ASHC AA,1
NUMSL6: TLNN AA,200000
SOJA TT,NUMSL8 ;NOT NORMALIZED YET
AOS T
MOVEI TM,(D)
TLNN TM,-1 ;GET CONVIENT POWER OF RADIX
JUMPL T,[ IMULI TM,(D)
AOJA T,.-1]
MOVE B,A ;GET NORMALIZED LOW PART IN B
IDIV AA,TM ;DIVIDE HIGH PART BY APPROPRIATE RADIX
DIV A,TM
JUMPL T,NUMSL6
MOVE B,A
JRST NUMSL2
UPARR: TRON I,IRSYL
JRST UPCTRC ;"UNARY UPARROW" => GOBBLE CHARS
TRNE I,IRLET
ETR [ASCIZ /Symbolic 1st arg to "^"/]
PUSHJ P,NUMSL ;DECIPHER NUMTABS
PUSHJ P,UA3 ;GET RIGHT OPERAND IN T
MOVE TT,B ;EXPONENT
MOVE B,A ;LOW PART
PUSHJ P,NUMC1 ;T EXP HIGH IN AA LOW IN B TT BIN EXP
MOVE C,CDISP ;IF A _ WAS DEFERRED WHILE ILUARI WAS SET,
TLO I,ILNPRC
CAME C,[DSYL,,BAKAR] ;DO IT NOW.
JRST RR10
BAKAR: TLNE I,ILUARI
JRST RR5 ;RETURN TO UPARROW (WILL COME BACK HERE LATER)
TRNE I,IRSYL
TRNE I,IRLET
JRST BAK1 ;NO SYL, OR SYL IS NAME
CAMN SYM,[SQUOZE 0,.]
JRST BAK1 ;. ALSO NAME
TLZN I,ILNPRC
PUSHJ P,NUMSL
PUSHJ P,UA3
ADD B,T
ASHC AA,(B)
LSH A,1
LSHC AA,-1
CLEARB B,AA
TLZ I,ILFLO
MOVE C,[DFLD,,CBAKAR]
EXCH C,CDISP ;IF 2ND ARG ENDED WITH A _, TURN INTO FIELD OP.
CAME C,[DSYL,,BAKAR]
EXCH C,CDISP
POPJ P,
UPCTRC: SETZ T,
UPCTR1: JSP F,QOTCOM ;UP ARROW TO GOBBLE SYL AND RETURN MASKED ASCII VALUE
LSH T,7 ;SHIFT ACCUMULATED VALUE OVER 7
CAIL A,140
SUBI A,40
ANDI A,77 ;NOW MASK CHARACTER IN TO TO BOTTOM 6 BITS
ADD T,A ;ADD TO ACCUMULATED
POPJ P,
BAK1: MOVE TT,[DFLD,,CBAKAR]
MOVEM TT,CDISP
JRST RR10
UA3: HRLM D,(P) ;SAVE RADIX (FOR UPARR)
JSP LINK,SGTSY ;PUSH I,AA,A,B
TLO I,ILUARI ;TELL _ TO WAIT TILL LATER (SEE UPARR, BAKARR)
PUSHJ P,RCH
CAIN A,"-
TROA I,IRGMNS
TLO FF,FLUNRD
PUSHJ P,RCH
CAIN A,"<
JRST UAR1
TLO FF,FLUNRD
UA3L: PUSHJ P,GTSL1 ;GOBBLE SYL, LOOP POINT FOR PSEUDO OR MACRO RETURNED WITHOUT VALUE
TRNE I,IRLET
JRST UA3S ;NAME
TLNE I,ILFLO
ETR [ASCIZ /Floating point 2nd arg to "_"/]
UAR2: TRZN I,IRGMNS
SKIPA T,A
MOVN T,A
JSP LINK,SGTSY1 ;RESTORE GETSYL TEMPS.
HLRZ D,(P)
POPJ P,
UA3S: PUSHJ P,GETVAL ;MAKE NUMBER_NAME WORK
JRST UA3SR ;GOT VALUE, PROCESS
JRST UA3L ;NO VALUE, TRY AGAIN
UAR1: TLO I,ILLSRT
TRZ I,IRSYL ;(OR ELSE LSSTH GIVES NOS ERROR.)
SETZB A,B
PUSHJ P,LSSTH
UA3SR: JUMPN B,RLCERR ;RELOC ERR
JRST UAR2
ATSGN: MOVSI A,20 ;ATSIGN
IORM A,WRD
TRO I,IRFLD ;SET IRFLD FLAG EVEN THOUGH NOT DIRECTLY RETURNING VALUE
; ^ CHANGED FROM SYL TO FIELD 9/6/70
JRST RRL2 ;FALL BACK IN
DQUOTE: TRON I,IRSYL
JRST DQUOT8
TRNN I,IRLET ;AFTER NUMBER => CURRENT RADIX.
JRST DQUOT7
PUSHJ P,RCH
TLO FF,FLUNRD ;NEXT CHAR. SQUOZE?
HLRZ A,GDTAB(A)
CAIN A,(POPJ P,)
JRST DQUOT7 ;NO => MAKE PREV. SYM. GLOBAL.
CAMN SYM,[SQUOZE 0,.M] ;SPECIAL BLOCK NAMES
JRST DQUOTM ;.M MEANS MAIN BLOCK,
CAMN SYM,[SQUOZE 0,.U]
JRST DQUOTU ;.U MEANS SUPERIOR.
CAMN SYM,[SQUOZE 0,.C]
JRST DQUOTC ;.C MEANS CURRENT BLOCK.
SKIPGE A,ESBK ;GET SPEC'D BLOCK OR CURRENT,
HRR A,BKCUR ;LOOK FOR SUBBLOCK OF THAT BLOCK.
HLL A,BKTAB+1(A)
ADD A,[1,,] ;LH HAS LEVEL SUBBLOCK OUGHT TO HAVE.
MOVEI T,0
SETO D, ;NO POSSIBLE ALTERNATE CHOICE YET.
DQUOT0: CAME SYM,BKTAB(T) ;LOOK AT ALL BLOCKS SEEN.
JRST DQUOT1 ;HAS THE NAME WE'RE LOOKING FOR?
SKIPGE ESBK ;IF LOOKING FOR A SUBBLOCK OF A PARTICULAR BLOCK,
JRST DQUOT4
CAMN A,BKTAB+1(T)
JRST DQUOT2 ;SUCH A BLOCK WINS; ALL OTHERS LOSE.
JRST DQUOT1
DQUOT4: SKIPN BKTAB+2(T) ;ELSE PREFER DEFINED BLOCKS TO UNDEFINED ONES.
JUMPGE D,DQUOT1
SKIPE BKTAB+2(T)
JUMPL D,DQUOT5
CAME D,[-1] ;THAT'S THE SAME EITHER WAY => PREFER AN INFERIOR
CAMN A,BKTAB+1(T) ;OF THE CURRENT BLOCK TO ONE THAT'S NOT.
JRST DQUOT5
JRST DQUOT1
DQUOT5: HRROI D,(T) ;FOUND A BLOCK WE LIKE BEST SO FAR.
SKIPE BKTAB+2(T)
ANDI D,-1 ;LEAVE SIGN OF D SET UNLESS THE BLOCK IS DEFINED.
DQUOT1: ADDI T,BKWPB
CAMGE T,BKTABP
JRST DQUOT0
HRRZI T,(D) ;NOW USE THE BEST BLOCK FOUND, IF THERE WAS ONE.
CAIE T,-1
JRST DQUOT2
MOVE T,BKTABP ;NOT FOUND, GET IDX OF 1ST UNUSED ENTRY.
CAIL T,BKTABS
ETF ERRTMB ;NO ROOM FOR MORE BLOCKS.
MOVEM SYM,BKTAB(T)
MOVEM A,BKTAB+1(T) ;ADD BLOCK AT END.
MOVEI A,BKWPB(T)
MOVEM A,BKTABP ;POINTS AFTER LAST USED ENTRY.
DQUOT2: MOVEM T,ESBK
SETZ SYM,
DQUOT3: MOVEI D,6 ;NEXT CHAR GOES IN 1ST SQUOZE POS.
JRST RRL2
DQUOTM: MOVEI T,BKWPB ;.M - MAIN BLOCK FOLLOWS INITIAL SYMS BLOCK.
JRST DQUOT2
DQUOTU: SKIPGE T,ESBK ;.U SPEC'D - GET SPEC'D OR CURRENT BLOCK,
MOVE T,BKCUR
HRRZ T,BKTAB+1(T)
JRST DQUOT2 ;SPEC. ITS SUPERIOR.
DQUOTC: SKIPGE T,ESBK ;.C => SPEC THE CURRENT BLOCK.
MOVE T,BKCUR
JRST DQUOT2
SQUOT1: TLOA I,ILVAR
DQUOT7: TLO I,ILGLI
MOVE A,BKCUR ;IF NO SPEC'D BLOCK,
SKIPGE ESBK
MOVEM A,ESBK ;SPEC. CURRENT BLOCK.
JRST RRL2
DQUOT8: SETZ T,
DQUOT9: JSP F,QOTCON ;DOUBLE QUOTE TO GOBBLE SYL AND RETURN ASCII VALUE
LSH T,7 ;SHIFT ACCUMULATED VALUE OVER 7
ADD T,A ;ADD IN ASCII CHARACTER IN A
POPJ P, ;RETURN TO SOMETHING
SQUOTE: TROE I,IRSYL
JRST SQUOT1
SETZ T,
SQUOT9: JSP F,QOTCON ;SIXBIT SYL
CAIGE A,40
ETR ERRN6B ;NOT SIXBIT
CAIL A,140
SUBI A,40 ;CONVERT TO UPPER CASE
LSH T,6 ;SHIFT OVER ACCUMULATED VALUE
ADDI T,-40(A) ;ADD IN SIXBIT FOR CHARACTER IN A
POPJ P,
;COMMON ROUTINE FOR RIGHT JUSTIFIED TEXT SYLS
;CALLED WITH JSP F,; ROUTINE PUSHJ'S BACK W/ CHAR IN T, ACCUM VALUE IN A
;SYL FLAG EXPECTED TO BE ALREADY SET
QOTCON: SKIPE QMTCH ;' AND " COME HERE, BUT NOT ^: IF IN QUOTES-MATCHING MODE, USE A
JRST QOTCO4 ;FAIL-LIKE ALGORITHM. HERE FOLLOWS THE OLD MIDAS WAY OF DOING IT
QOTCOM: CALL RCH ;USE AT LEAST 1 CHAR IN ANY CASE.
JRST QOTCO1
QOTCO2: CALL RCH ;USE SUCCEEDING CHARS IF SQUOZE CHARS.
HLRZ CH1,GDTAB(A)
CAIN CH1,(POPJ P,)
JRST QOTCO3
QOTCO1: CALL (F)
JRST QOTCO2
QOTCO3: CAIN A,"" ;NONSQUOZE: IF IT IS A TEXT SYL INDICATOR,
JRST DQUOT9 ;CONTINUE WITH WHATEVER TYPE OF TEXT
CAIN A,"'
JRST SQUOT9 ;IT INDICATES.
CAIN A,"^
JRST UPCTR1
QOTCO6: TLO FF,FLUNRD
JRST TEXT5
QOTCO4: MOVE B,LIMBO1 ;GET ' OR ", WHICHEVER STARTED THIS SYL, AS THE DELIMITER.
MOVE SYM,[SQUOZE 0,TEXT]
JSP TM,ERMARK
QOTCO5: CALL RCH
CAMN A,B ;FOUND ANOTHER EXAMPLE OF THE DELIMITER?
JRST [ CALL RCH ;IF DUPLICATED, IT PUTS THE DELIMITER IN THE CONSTANT.
CAMN A,B
JRST .+1
JRST QOTCO6] ;OTHERWISE UNREAD THE CHAR AFTER THE DELIMITER AND EXIT.
CALL (F) ;HAVE CHAR TO PUT IN STRING IN A; GO MERGE IT IN.
JRST QOTCO5
;RETURN A VALUE FROM A PSEUDO WHOSE ARGS CAN BE TERMINATED BY EITHER COMMA (GOBBLED)
;OR CR (NOT GOBBLED).
VALRET: MOVE T,A ;ROUTINE TO RETURN VALUE IN A AFTER LAST CHAR GOBBLED BY GETSYL
MOVE B,CDISP ;GET STORED DISPATCH CODE
TLNN B,DWRD\DFLD
JRST VALR1 ;WORD TERMINATOR
;COME HERE TO RETURN A VALUE, AND ALSO
;BARF IF THE NEXT CHARACTER ISN'T A SYLLABLE SEPARATOR
TEXT5: PUSH P,T ;ENTRY FROM TEXT ROUTINES (NLAST CHAR NOT GOBBLED BY GETSYL) TO RETURN VALUE IN T
PUSHJ P,GETSYL ;SEE IF IMMEDIATELY FOLLOWED BY SYL
TRNE I,IRSYL
ETR ERRNOS ;NO SEPARATOR BETWEEN TWO VALUES
POP P,A ;RESTORE VALUE TO RETURN
VALR1: TRO I,IRSYL
JRST CLBPOP
;VARIOUS PUSH AND POP ROUTINES, ALL CALLED W/ JSP LINK,
SGTSY: PUSH P,I
PUSH P,AA
PUSH P,A
PUSH P,B
JRST (LINK)
SGTSY1: POP P,B
POP P,A
POP P,AA
POP P,I
JRST (LINK)
;JSP LINK,SAVWD1 TO SAVE STUFF FOR < OR (, ETC.
SAVWD1: PUSH P,A ;SYLL. BEFORE GROUPING NOW STARTING.
PUSH P,B ;AND ITS RELOC.
SAVWLD: PUSH P,FORMAT
PUSH P,FORPNR
PUSH P,FLDCNT
PUSH P,GLSP2
PUSH P,I
PUSH P,WRD
PUSH P,WRDRLC
PUSH P,SYM
PUSH P,PPRIME
PUSHJ P,(LINK)
SAVL1==.
;POP OFF WHAT PUSHED BY SAVWLD. CLEARS FLUNRD, IN CASE THE > OR ) WAS UN-READ.
USVWLD: POP P,SYM
HRRZS SYM
CAIE SYM,SAVL1
HALT
TLZ FF,FLUNRD
POP P,PPRIME
POP P,SYM
POP P,WRDRLC
POP P,WRD
TDZ I,[-1-(ILWORD)]
IOR I,(P)
POP P,1(P)
POP P,GLSP2
POP P,FLDCNT
POP P,FORPNR
POP P,FORMAT
JRST (LINK)
;;GETFD ;GET FIELD (EXPRESSION); RETURN VALUE IN A, RELOC BITS IN B
;GET FIELD FOR PSEUDO
;SYM SHOULD CONTAIN THE SQUOZE NAME OF THE PSEUDO
;OR A POINTER TO AN INSN TO EXECUTE WHEN UNDEF
;SYMBOL SEEN. SYM IS NOT CLOBBERED.
AGETFD: PUSH P,I ;SAVE I
TRO I,IRPSUD+IRNOEQ ;SET FLAG TO GETVAL TO EXECUTE GTVER ON UNDEFINED SYM ON EITHER PASS
PUSH P,GTVER ;OLD VALUE OF GTVER
MOVEM SYM,GTVER ;ERROR MSG SHOULD GIVE NAME OF PSEUDO.
CALL YGETFD
MOVE SYM,GTVER
REST GTVER
MOVEM I,ISAV ;SAVE FLAGS FOR FIELD GOTTEN
POPIJ: POP P,I
POPJ P,
;READ A FIELD, NOT PART OF THE CURRENT WORD.
YGETFD: PUSH P,WRD
SETZM WRD
CALL XGETFD
TLNE I,ILMWRD
PUSHJ P,IGTXT ;SOAK UP MULTIPLE WORD
ADD A,WRD ;ADD IN INDEX, INDIRECT FIELDS
POP P,WRD
POPJ P,
IFN FASLP,[
FAGTFD: PUSHJ P,AGETFD ;DO AGETFD, COMPLAIN IF RELOCATABLE OR GLOBAL
MOVE TM,GLSP1
CAMN TM,GLSP2
SKIPE B
ETSM [ASCIZ /relocatable or external argument/]
POPJ P,
]
;READ A FIELD PART OF CURRENT WORD (FOR XWD, ETC).
XGETFD: PUSH P,PPRIME
AGTFD3: PUSHJ P,GETFLD
MOVE CH1,CDISP
TLNN CH1,DWRD
TLOA FF,FLUNRD ;DELIMITER IS WORD TERMINATOR => RE-READ IT.
TRNE I,IRFLD ;NON-NULL FIELD SUPPLIED => RETURN IT.
JRST AGTFD4
HRRZ C,CDISP ;ELSE COMMA => RETURN NULL VALUE (0)
CAIN C,SPACE ;SPACE => TRY AGAIN TO READ A FIELD.
JRST AGTFD3 ;NO FIELD, TRY AGAIN
AGTFD4: REST PPRIME
POPJ P,
;IN RELOCATABLE FORMAT
;READ FIELD AND COPY OUT AS WORD
RGETFD: SETZM WRD ;FIRST INITIALIZE SOME STUFF AS THOUGH AT GETWD
SETZM WRDRLC
MOVE A,GLSPAS
MOVEM A,GLSP1
MOVEM A,GLSP2
CALL XGETFD
ADDM A,WRD
ADDM B,WRDRLC
PUSHJ P,PWRDA ;OUTPUT WORD
TLNE I,ILMWRD
JRST IGTXT ;SOAK UP MULTI-WORD FIELD
POPJ P,
;READ IN A FIELD, RETURN IN A,B SETTING IRFLD IF FIELD NOT NULL.
GETFLD: PUSH P,GLSP1 ;REFERED TO AS GETFLB(P) WHEN ONLY 1 SYL PUSHED.
MOVEM P,PPRIME
TRZ I,IRFLD+IROP
GETFD1: TLNE I,ILMWRD
JRST GETFD9 ;MULTIPLE WORD, RE-CALL PSEUDO
PUSHJ P,GETSYL
TRNE I,IRLET
GETFD9: PUSHJ P,GETVAL ;GET OPERAND (MAYBE SKIPS)
GETFD6: SKIPA C,CDISP ;GET INFO ON SYLLABLE TERMINATOR
JRST GETFD1 ;GETVAL SKIPPED => PSEUDO/MACRO WITH NO VALUE, TRY AGAIN
TLNE C,DFLD
JRST (C) ;FIELD OPERATOR, GO PROCESS
TRNE I,IRSYL ;NO DISP MEANS FIELD TERMINATOR.
TRO I,IRFLD
CAME P,PPRIME ;IF ANY OPERATORS PUSHED,
JSP LINK,GETFD8 ;EVAL THEM.
SUB P,[1,,1] ;FLUSH GLSP1 SAVED AT GETFLD.
RET
GETFD8: MOVEI TT, ;END OF FIELD HAS VERY LOW PRIORITY.
JRST GETFD7
;PUSH AN OPERATOR, MAYBE EVALLING STUFF TO LEFT.
;A HAS LEFT OPERAND (IF ANY), B RELOCATION BITS,
;C ADR OF ROUTINE TO PERFORM OPERATION, LH OF TT HAS PRECEDANCE OF OPERATOR
GETFDL: MOVEI LINK,GETFD3 ;AFTER MAYBE EVALLING, GO PUSH OPERATOR.
TRO I,IRFLD+IROP
TRNN I,IRSYL
JRST GETFD5 ;UNARY, EVAL NOTHING, JUST PUSH WITH HIGH PRIO.
GETFD2: CAME P,PPRIME ;NO OPS TO LEFT => NOTHING TO EVAL.
CAMLE TT,GETFLP(P) ;COMPARE PRIO OF PREV. OP. AND CURRENT.
JRST (LINK) ;WAIT UNTIL LATER
GETFD7: HRRZ T,GETFLP(P) ;EVAL THE LAST OP ON STACK.
JRST (T) ;GO DO IT NOW (ROUTINE RETURNS TO GETFD4)
GETFD4: SUB P,[4,,4]
JRST GETFD2
GETFD5: MOVSI TT,200 ;GIVE UNARY OP HIGH PRIO. TO DO BEFORE NEXT BINARY.
GETFD3: PUSH P,B ;GETFLR(P)
PUSH P,A ;GETFLV(P)
HLL C,TT
PUSH P,C ;GETFLP(P)
PUSH P,GLSP1 ;GETFLG(P)
JRST GETFD1
GETFLB==,-4 ;PDL IDX OF GLSP1 BEFORE LEFT OPERAND.
GETFLR==,-3 ;PDL IDX OF RELOC OF LEFT OPERAND.
GETFLV==,-2 ;PDL IDX OF VALUE OF LEFT OPERAND.
GETFLP==,-1 ;PDL IDX OF PRIO,,DISPATCH
GETFLG==0 ;PDL IDX OF GLSP1 AFTER LEFT OPERAND (=BEFORE RIGHT)
PLS: MOVEI C,PLS1 ;PLUS SIGN, PLS1 IS ROUTINE TO PERFORM OPERATION
MINUS2: MOVSI TT,10 ;SET UP PRECEDENCE OF 10 FOR +, -
JRST GETFDL
MINUS: JSP C,MINUS2 ;MINUS SIGN
MOVNS A ;NEGATE VALUE OF RIGHT OPERAND
MOVNS B ;ALSO RELOCATION
JUMPGE FF,PLS1
MOVE T,GETFLG(P)
PUSH P,B
HRLZI B,MINF
PUSH P,C
PUSHJ P,LNKTZ ;COMPLEMENT THE MINUS FLAG ON GLOBALS IN RIGHT OPERAND
POP P,C
POP P,B
PLS1: ADD A,GETFLV(P) ;ADD VALUES
ADD B,GETFLR(P) ;ADD RELOCATIONS
JRST GETFD4
LNKTZ: TDZA C,C
LNKTC1: MOVE T,GLSP2
LINKTC: CAML T,GLSP1
POPJ P,
SKIPL 1(T)
XORM B,1(T)
SKIPL 1(T)
IORM C,1(T)
AOJA T,LINKTC
MULTP: MOVEI C,MULTP1 ;ASTERISK, MULTP1 ROUTINE TO PERFORM MULTIPLICATION
DIVID2: MOVSI TT,20 ;20 PRECEDENCE OF MULTIPLICATION, DIVISION
JRST GETFDL
MULTP1: SKIPL CONTRL ;ELSE IN DECREL ASSEMBLY, TEST FOR EXTERNALS.
JUMPGE FF,MULTR
MOVE D,GETFLB(P) ;ACTUALLY, GET HERE FOR ABS ASSEMBLIES TOO, BUT SO WHAT?
CAMN D,GLSP1
JRST MULTR
SKIPGE FF
ETR [ASCIZ /Externals multiplied/]
TLO I,ILNOPT ;DON'T OPTIMIZE LITERALS CONTAINING UNDEFS ON PASS 1.
MULTR: JUMPE B,MULTP3 ;JUMP ON RIGHT OPERAND NOT RELOCATED
SKIPE GETFLR(P)
JRST MULTP4 ;BOTH OPERANDS RELOCATED
MOVE T,GETFLV(P) ;GET VALUE OF LEFT OPERAND AND FALL IN
JRST MULTP5
MULTP3: MOVE T,A ;RIGHT OPERAND NOT RELOCATED, GET VALUE IN T
MOVE B,GETFLR(P) ;RELOCATION BITS OF LEFT OPERAND
MULTP5: MOVE D,GETFLG(P) ;GLOTB POINTER TO BETWEEN OPERANDS
CAME D,GETFLB(P)
JRST GMUL1 ;LEFT OPERAND HAS GLOBALS
CAME D,GLSP1
JRST GMUL2 ;RIGHT OPERAND HAS GLOBALS
;AT THIS POINT, T HAS VALUE OF ABS OPERAND, B RELOC BITS OF OTHER
GMUL4: IMUL A,GETFLV(P) ;MULTIPLY VALUES
IMULB B,T ;MULTIPLY RELOCATION OF ONE BY VALUE OF OTHER
TRZ T,1
SKIPL CONTRL ;EXCEPT IN STINK ASSEMBLY, OBJECT TO RELOCATION
JRST GETFD4 ;OTHER THAN 0 OR 1 (ONLY AFFECTS DECREL, SINCE
JUMPE T,GETFD4 ;RELOCATION CAN'T BE NONZERO IN ABS ASSEMBLY).
MULTP4: ETR [ASCIZ+Relocatable arg to * or / or Boolean+]
JRST GETFD4
GMUL1: TLNE FF,FLPPSS ;LEFT OPERAND HAS GLOBALS, CHEK RIGHT OPERAND
CAMN D,GLSP1
SKIPA CH1,A ;LOOKS OK, GET VALUE IN CH1
ETR [ASCIZ /Multiplying two externals/]
SKIPA D,GETFLB(P) ;GET GLOTB POINTER TO BOTTOM OF LEFT OPERAND
GMUL2: MOVE CH1,GETFLV(P) ;GLOBALS IN RIGHT OPERAND ONLY, GET LEFT OPERAND
GMUL3: CAML D,GLSP1
JRST GMUL4 ;TABLE COUNTED OUT
SKIPGE 1(D)
AOJA D,GMUL3
JUMPE CH1,GMUL5 ;MULTIPLYING BY ZERO, CLEAR OUT GLOTB ENTRY AND LOOP BACK
LDB CH2,[221200,,1(D)] ;PICK UP MULTIPLICATION FIELD THIS GLOBAL
SKIPN CH2
MOVEI CH2,1 ;0 => 1
IMUL CH2,CH1
CAIN CH2,1
MOVEI CH2,0 ;IF ONE THEN USE ZERO
DPB CH2,[221200,,1(D)]
AOJA D,GMUL3
GMUL5: CLEARM 1(D)
AOJA D,GMUL3
DIVID: JSP C,DIVID2 ;SLASH, PRECEDENCE = 20
DIVID1: JUMPN B,MULTP4 ;JUMP IF RIGHT OPERAND RELOCATED
SKIPE GETFLR(P)
JRST MULTP4 ;LEFT OPERAND RELOCATED
EXCH A,GETFLV(P)
IDIV A,GETFLV(P)
MOVEI B,0
MOVE D,GETFLB(P)
CAMN D,GLSP1 ;IF THERE ARE EXTERNALS OR UNDEFINED SYMBOLS,
JRST GETFD4
SKIPGE FF ;ON PUNCHING PASS IT'S AN ERROR.
ETR [ASCIZ /Division involving externals/]
TLO I,ILNOPT ;ON PASS 1, DON'T OPTIMIZE THIS IF IN A LITERAL.
JRST GETFD4
;LOGIC OPERATORS & (PREC = 40), # (PREC = 34), \ (PREC = 30)
ANDF: MOVSI TT,40 ;&
JSP C,GETFDL
JSP D,LOGIC1 ;GO DO IT
AND A,GETFLV(P) ;INSTRUCTION ARGUMENT TO LOGIC1
XORF: MOVSI TT,34 ;#
TRNN I,IRSYL ;IF ABOUT TO BE UNARY,
MOVNI A,1 ;THEN TURN LEFT OPERAND INTO -1
JSP C,GETFDL
JSP D,LOGIC1
XOR A,GETFLV(P)
IORF: MOVSI TT,30 ;\
JSP C,GETFDL
JSP D,LOGIC1
IOR A,GETFLV(P)
;COMMON EXECUTION ROUTINE FOR LOGICAL OPERATORS
LOGIC1: JUMPN B,MULTP4 ;NO RELOCATION ALLOWED
SKIPE GETFLR(P) ;NOW CHECK RELOCATION OF LEFT OPERAND
JRST MULTP4
XCT (D) ;ALL TESTS PASSED, DO IT
MOVE D,GETFLB(P) ;ARE THERE ANY GLOBALS OR UNDEFINED SYMBOLS?
CAMN D,GLSP1
JRST GETFD4 ;NO.
SKIPGE FF ;YES. ON THE PUNCHING PASS, THAT'S AN ERROR.
ETR [ASCIZ /External in arg to \, & or #/]
TLO I,ILNOPT ;ON PASS 1, JUST DON'T OPTIMIZE IF IN LITERAL.
JRST GETFD4
CBAKAR: MOVSI TT,100 ;BACKARROW AS FIELD OPERATOR, PREC = 100
JSP C,GETFDL ;RETURN TO GETFLD TO READ 2ND ARGUMENT.
JSP D,LOGIC1 ;FOR EVALUATION, CALL LOGIC1
JSP D,.+1 ;WHICH EXECUTES THIS INSTRUCTION,
MOVE T,A ;TO CALL THIS SUBROUTINE.
MOVE A,GETFLV(P)
LSH A,(T)
JRST (D)
;D SHOULD HAVE 1 FOR <, 2 FOR (, 3 FOR [ ;]
LSSTH9: JSP LINK,SAVAS1 ;SAVE ASSEM1 PDL LEVELS, .BYTE MODE, ETC.
MOVEM D,ASMOUT ;SAY WHAT KIND OF OPEN WE JUST DID
JRST ASSEM3 ;REENTER ASSEM1 LOOP AT INNER LEVEL.
;COME HERE TO EXIT FROM AN ASSEM1 LEVEL THAT WAS ENTERED BY LSSTH9.
LSSTHA: SKIPE BYTM ;IN BYTE MODE, DO .WALGN. SINCE ASMDSP
JRST A.BY3 ;STILL POINTS HERE, WE'LL COME BACK.
MOVE P,CONSTP
JSP T,CONNDP ;POP STUFF SAVED BY SAVAS1
MOVE A,WRD ;RETURN THE WORD IN THE GROUPING
MOVE B,WRDRLC ;(OUR CALLER WILL USVWLD, CLOBBERING WRD)
POPJ P,
LSSTH: MOVEI D,1 ;1 FOR <.
JSP LINK,SAVWD1
PUSHJ P,LSSTH9
LSSTH3: JSP LINK,USVWLD ;POP OFF ALL BUTPREVIOUS SYLL.
;GROUPINGS EXCEPT (PARENS THAT ADD TO WORD)
;SYLL IMMEDIATELY BEFORE OR AFTER IS ERROR.
LSSTH2: ADDM A,-1(P) ;SYLL BEFORE GROUPING, PUSHED BY SAVWD1.
ADDM B,(P)
TRNE I,IRSYL ;IF WAS SYLL BEFORE GROUPING, ERROR.
ETR ERRNOS
LSSTH5: MOVE A,LIMBO1 ;CHECK FOR FOLLOWING SYLL.
CAIE A,15
CAIN A,12
JRST LSSTH6 ;DELIMITER CR OR LF
PUSHJ P,RCH ;NOT CR OR LF, GET NEXT CHAR
CAIN A,"! ;IGNORE EXCLAMATION POINT
JRST .-2
TLO FF,FLUNRD ;CAUSE IT TO BE RE-INPUT
HLRZ CH1,GDTAB(A)
CAIE CH1,(POPJ P,)
JRST LSSTH4 ;SQUOZE CHAR. MEANS FOLLOWING SYLL.
HRRZ CH1,GDTAB(A)
MOVE CH1,DTB-40(CH1) ;GET DISPATCH FOR CHAR.
TLNE CH1,DSY1 ;MIGHT START SYL => NOS ERROR.
JRST LSSTH4
LSSTH7: PUSHJ P,GTSL1
LSSTH6: TRO I,IRSYL
POP P,B
POP P,A ;VALUE OF GROUPING WAS ADDM'ED INTO THESE.
TLZE I,ILLSRT ?.SEE UA3
RET ;IF CALLED BY ^ OR _ AS SYL OP, RETURN TO IT.
JRST GETFD6
LSSTH1: TLO I,ILWORD ;A NUMBER IN PARENS BY ITSELF IS A NONNULL WORD.
ADDM A,WRD
ADDM B,WRDRLC
TRNE I,IRSYL ;IF SYLL BEFORE,
JRST LSSTH5 ;ERROR IF SYL AFTER.
JRST LSSTH8 ;ELSE NO ERROR.
LSSTH4: ETR ERRNOS ;FOLLOWING SYLL WHEN THAT IS ERROR.
LSSTH8: TLNE I,ILLSRT ?.SEE UA3
JRST LSSTH6
SUB P,[2,,2]
JRST GETFD1
ERRNOS: ASCIZ /Syllables not separated/
POP2J: SUB P,[2,,2]
POPJ P,
LEFTP: MOVEI D,2 ;2 FOR ).
JSP LINK,SAVWD1
MOVEI C,0
TRNE I,IROP
TRNE I,IRSYL
TLO C,400000 ;CAUSE IT TO GET ADDED INTO WORD STEAD HAVE VALUE AS SYL
PUSH P,C
PUSHJ P,LSSTH9
POP P,C
MOVSM A,T1 ;STORE SWAPPED VALUE
ADDI B,400000 ;NOW WANT TO SWAP RELOCATION, MAKE LH CORRECT
HLREM B,T2 ;STORE AS RH WITH SIGN EXTENDED
MOVSI B,400000(B) ;GET RIGHT HALF IN LEFT
ADDM B,T2 ;FINISH RELOCATION SWAP (THIS IS PAINLESS COMPARED TO THE HAIR EVERYWHERE
;ELSE WHEN KEEPING THE HALFWORDS SEPARATE)
MOVSI B,SWAPF
PUSHJ P,LNKTC1
JSP LINK,USVWLD
MOVE A,T1
MOVE B,T2
JUMPL C,LSSTH1 ;ADD TO WHOLE WORD
JRST LSSTH2
;VERSION OF GETWRD FOR PSEUDO,
;PSEUDO MUST EITHER SAVE I, PPRIME AND GTVER OR RETURN TO ASSEM1.
;SYM SHOULD HOLD NAME OF PSUEUDO.
AGETWD: MOVEM SYM,GTVER ;STORE NAME OF PSEUDO FOR UNDEF SYM MSGS.
TRO I,IRPSUD\IRDEF\IRNOEQ
PUSHJ P,GETWRD
MOVE SYM,GTVER ;RESTORE SYM.
TLNE I,ILMWRD
PUSHJ P,IGTXT ;SOAK UP MULTIPLE WORD
RET
;;GETWD ;READ A WORD, LEAVE VALUE IN A AND WRD, RELOC IN WRDRLC AND B
GETWRD: MOVE T,GLSP1
MOVEM T,GLSP2
CLEARM FORMAT ;CLEAR FORMAT, WILL ACCUMULATE FORMAT NUMBER BY IDPB
CLEARM WRD ;CLEAR WRD, WILL ACCUMULATE ABSOLUTE PART OF WORD
CLEARM WRDRLC ; " RELOCATION BITS, "
TDZ I,[ILWORD,,IRIOINS]
CLEARM FLDCNT ;NO FIELDS YET
MOVE T,[50100,,FORMAT] ;SET UP BIT POINTER TO FORMAT
MOVEM T,FORPNR
GTWD1: PUSHJ P,GETFLD ;READ NEXT FIELD
SPACE6: MOVEI T,1 ;SET T TO 1, AC FOR IDPB ON ROUTINE DISPATCHED TO
SKIPA C,CDISP
SPACE5: REST A
TLNE C,DWRD
JRST (C) ;NO DISPATCH MEANS WD TERMINATOR
MOVE C,GLSP1
MOVEM C,LINKL ;MARK END OF ACTIVE PART OF GLOTB
TRNN I,IRFLD
JRST GETWD2 ;LAST FIELD NULL, MAYBE HAVE TO POP STUFF OFF
IDPB T,FORPNR ;MARK NON-NULL FIELD IN FORMAT
GTWD4A: TLO I,ILWORD ;NON-NULL WORD
MOVE TT,FORMAT
SKIPN TT,FORTAB-10(TT) ;PICK UP BYTE POINTER POSITION/SIZE FIELDS FOR FIELDS IN WORD
ETR [ASCIZ /Undefined format/]
MOVEM TT,FORMAT ;STORE IN FORMAT
MOVE T,[301400,,FORMAT]
MOVEM T,FORPNR
;AT THIS POINT, FLDCNT HAS 1 LESS THAN # FIELDS; PUT FIELDS TOGETHER TO FORM WORD
GTWD3: LDB T,FORPNR
MOVE D,FLDCNT
CAIG D,2
IBP FORPNR ;HAVEN'T BACKED UP TO THIRD FIELD YET, INCREMENT TO DESC FOR PREV
TRNE I,IRIOINS
PUSHJ P,INTIOW
PUSHJ P,INTFLD ;PUT FIELD WHERE IT BELONGS
SOSGE FLDCNT
JRST GTWD5 ;THIS WAS LAST (FIRST) FIELD
POP P,GLSP2 ;NOT YET, POP OFF MORE
POP P,GLSP1
POP P,B
POP P,A
JRST GTWD3
GTWD5: MOVE A,WRD
MOVE B,WRDRLC
MOVE C,LINKL
MOVEM C,GLSP1
TRZ I,IRIOINS
POPJ P,
COMMA: TRNN I,IRFLD ;FIELD DELIMITER WAS COMMA (T HAS 1)
JRST COMMA1 ;NO FIELD
IDPB T,FORPNR ;MARK NON-NULL FIELD
COMMA4: IDPB T,FORPNR ;MARK FIELD TERMINATOR WAS COMMA
MOVE TT,FLDCNT
CAIL TT,2
ETR [ASCIZ /Comma past the 3rd field of a word/]
PUSHFD: PUSH P,A ;DONE WITH THIS FIELD, NOW TO GET NEXT
PUSH P,B
PUSH P,GLSP1
PUSH P,GLSP2
AOS FLDCNT ;ANOTHER FIELD
MOVE TT,GLSP1
MOVEM TT,GLSP2
HRRZ T,FORPNR
CAIE T,FORMAT
HRRZS FORPNR ;STABILIZE FORPNR
TLO I,ILWORD ;SAY WE HAVE A NON-NULL WORD IN PROGRESS (LOC, ETC. ILLEGAL).
JRST GTWD1
GETWD2: SKIPN FORMAT ;LAST FIELD OF WORD IS NULL
JRST GTWD5 ;ENTIRE WORD NULL, MAYBE WERE PARENS.
SOS FLDCNT
POP P,GLSP2
POP P,GLSP1
POP P,B
POP P,A
JRST GTWD4A
COMMA1: LDB TT,FORPNR ;COMMA TERMINATED NULL FOELD.
SKIPE FORMAT
JUMPE TT,COMMA2 ;NOT 1ST FIELD, JMP IF PREV WAS TERM BY SPACE.
IBP FORPNR ;ELSE MARK NULL FIELD IN FORMAT.
JRST COMMA4
;FIELD SPACE COMMA, PATHOLOGICAL CASE
;(EG MACRO STARTED WITH A COMMA)
COMMA2: DPB T,FORPNR ;REPLACE SPACE WITH COMMA.
JRST GTWD1
;FIELD TERMINATOR IS SPACE (T HAS 1)
SPACE: MOVE TT,LIMBO1
CAIE TT,^I ;HEURISTIC: REAL SPACES ARE LIKELY TO BE FOLLOWED BY SQUOZE,
JRST SPACE4 ;WHILE TABS ARE LIKELY TO BE FOLLOWED BY COMMENTS.
PUSH P,A
MOVE TT,GDTAB+40
PUSHJ P,RCH
CAMN TT,GDTAB(A)
JRST .-2 ;FLUSH OTHER LOGICAL SPACES
CAIN A,"; ;TAB WAS FOLLOWED BY SEMICOLON:
JRST [ PUSH P,B
TRZ I,IRSYL
CALL SEMIC ;FLUSH THE COMMENT
MOVEI T,1
REST B
JRST SPACE5] ;AND HANDLE THE C.R.
SPACE3: POP P,A
TLO FF,FLUNRD ;CAUSE CHAR TO BE RE-READ NEXT TIME
SPACE4: TRNN I,IRFLD
JRST GTWD1 ;NO FIELD
IDPB T,FORPNR ;T HAS 1, MARK NON-NULL FIELD IN FORMAT
IBP FORPNR ;MARK FIELD TERMINATOR WAS SPACE
JRST PUSHFD
;T HAS DESC BYTE, PUT FIELD IN ITS PLACE
;ALSO CALLED FROM PBYTE, MUSTN'T CLOBBER AA.
INTFLD: MOVE TT,GLSP2
CAMN TT,GLSP1
JUMPE B,INTFD1 ;NO GLOBALS, JUMP IF NO RELOCATION
CAIN T,2222 ;LH
JRST INTL
CAIN T,22 ;RH
JRST INTR
CAIN T,44 ;WHOLE WORD
JRST INTW
SKIPE B
ETR [ASCIZ/Relocation attempted in irrelocatable field/]
;(ASSUME) NO RELOCATION, CHECK FOR GLOBAL AC FIELDS
CAIN T,2704 ;HIGH AC
JRST INTACH
CAIN T,504 ;AC LOW
JRST INTACL
JUMPGE FF,INTFD1 ;JUMP ON NOT PUNCHING PASS
CAME TT,GLSP1
ETR [ASCIZ/Global symbol in illegal field/]
INTFD1: MOVEI TT,C_12.
ROTC T,-12. ;SHIFT BYTE POINTER INTO TT
MOVEI C,0 ;INITIALIZE C TO RECEIVE FIELD IN PROPER PLACE
DPB A,TT
CAMN TT,[2200,,C]
JRST INTFD2 ;RIGHT HALF, DON'T ALLOW CARRY INTO LH
ADDM C,WRD ;ALLOW CARRY
INTFD3: ADDM B,WRDRLC ;ADD RELOCATIONS, WILL BE BROKEN BACK INTO HALF-WORDS LATER
POPJ P,
INTFD2: ADD C,WRD ;ADD RIGHT HALVES
HRRM C,WRD
JRST INTFD3
INTIOW: CAIE T,2704
CAIN T,504
TRZA A,3 ;IO DEVICE FIELD
POPJ P, ;NOT "AC" FIELD
ADDI T,611-504
POPJ P,
INTR: HRRE D,B ;RH
MOVEI B,0
PUSH P,T
HRLZI C,HFWDF
PUSHJ P,LNKTC1 ;THIS IS A BUG WHICH SHOULD BE FIXED SOMETIME
PRTCL: MOVE B,D ;GET BACK MAPPED RELOCATION BITS
PRTCL2: POP P,T
INTW: MOVE D,GLSP2 ;WHOLE WORD
HRLOI LINK,377777
CAML D,GLSP1
JRST INTFD1
ANDM LINK,1(D)
AOJA D,.-3
INTL: HRLZ D,B ;LH
MOVSI B,SWAPF
MOVSI C,HFWDF
PUSH P,T
MOVE T,GLSP2
INTL2: CAML T,GLSP1
JRST PRTCL
SKIPGE 1(T)
AOJA T,INTL2 ;INDEX FIELD, ETC => LEAVE ALONE
IORM C,1(T) ;SET HFWDF
XORM B,1(T) ;COMPLEMENT SWAP STATUS
TDNN B,1(T)
SETZM 1(T) ;SWAPPED TO RH, FLUSH IT
AOJA T,INTL2
INTACL: TDZA B,B ;AC LOW
INTACH: HRLZI B,SWAPF ;AC HIGH
HRLZI C,ACF
PUSH P,T
PUSHJ P,LNKTC1
MOVEI B,0
JRST PRTCL2
IOINST: HLLZ A,B ;IO INSTRUCTION, GET WHICH ONE INTO A
SKIPN FLDCNT ;THIS FIRST FIELD OF WORD?
TRO I,IRIOINS ;YES
JRST CLBPOP ;RETURN VALUE
;TOP LEVEL LOOP, ASSEMBLE STORAGE WORDS
;LOTS OF PSEUDOS MEANINGLESS IN STORAGE WORDS
;(E.G. BLOCK, CONSTA) DO JRST ASSEM1 WHEN DONE
;THERE'S ALSO AN ERROR UUO WHICH RETURNS TO ASSEM1
ASSEM1: MOVE P,ASSEMP
JRST @ASMDSP
;COME HERE TO START THE NEXT EXPRESSION OR WHATEVER.
ASSEM3: PUSHJ P,RCH
CAIN A,^I
JRST ASSEM2 ;PROBABLY NOT PROFITABLE TO SKIP AFTER SEE A TAB.
CAIG A,40
JRST ASSEM3 ;FLUSH LEADING GARBAGE
TLO FF,FLUNRD ;CAUSE NON-GARBAGE CHAR FOUND TO BE RE-INPUT
;ASMDSP POINTS HERE WITHIN ASCII, SIXBIT ETC.
ASSEM2: TRZ I,IRFLD+IRSYL+IRLET+IRPSUD+IRCOM+IRCONT+IRGMNS+IROP+IRNOEQ+IREQL
TLZ I,ILGLI+ILVAR+ILFLO+ILDECP+ILUARI+ILWORD+ILNPRC+ILNOPT
IOR I,ASMI ;SET DEF AND RESTORE PSEUDF.
MOVE A,GLSPAS
SKIPL BYTM
MOVEM A,GLSP1
;GETWRD WILL COPY GLSP1 INTO GLSP2
IFN TS,[AOSN TTYBRF ;DO A ^H-BREAK IF REQUESTED.
CALL TTYBRK]
PUSHJ P,GETWRD
TLZN I,ILWORD
JRST @ASMDSP ;NO WORD ASSEMBLED,TRY AGAIN
SKIPGE BYTM
JRST PBYTE ;IN BYTE MODE, OUTPUT BYTE INSTEAD OF WORD, A,B MUST HAVE WRD,WRDRLC.
MOVE AA,ASMOUT ;OUTPUT WD AS APPRO. FOR GROUPING, IF ANY.
JRST @ASMOT0(AA)
ASSEM6: SKIPE STGSW ;ASMOT0 POINS HERE. COME IF NOT IN GROUPING.
ETR ERRSWD ;STORAGE WORD ASSEMBLED
PUSHJ P,PWRD ;OUTPUT THE WORD.
AOS CLOC
HRRZS CLOC ;INCREM. POINT .
JRST @ASMDSP ;ASSEM3 OR ASSEM2
ERRSWD: ASCIZ /Storage word assembled/
ASSEM4: JSP T,PCONST ;ASMOT0+3 POINTS HERE. COME IF IN CONSTANT.
JRST @ASMDSP
;ASMDSP POINTS HERE WITHIN GROUPING IF NOT IN MULTI-LINE MODE
;[ ;AND NO CLOSE (">)]") HAS BEEN SEEN.
ASSEMC: MOVE AA,ASMOUT
SKIPE CONSML ;IN ERROR MODE, GIVE APPROPRIATE ERROR MSG.
XCT ASMOT3(AA)
JRST @ASMOT2(AA) ;CLOSE WHATEVER TYPE GRPING WE'RE IN.
;JUMP THRU THIS TABLE TO OUTPUT A WORD.
ASMOT0: ASSEM6? ASSEM1? ASSEM1? ASSEM4? [HALT ]
;THIS TABLE GIVES APPRO. CLOSE FOR EACH TYPE OF GROUPING. ;[
ASMOT1: "? ? "> ? ") ? "] ? "?
;THIS TABLE SAYS WHERE TO GO TO END THE GROUPING.
ASMOT2: [HALT ]? LSSTHA? LSSTHA? CONND? [HALT ]
;APPROPRIATE ERROR MESSAGE FOR MISSING CLOSE OF GROUPING. [
ASMOT3: HALT
ETR [ASCIZ /Missing >/]
ETR [ASCIZ /Missing )/]
ETR [ASCIZ /Missing ]/]
HALT
;THIS TABLE TELLS PBYTE HOW TO HANDLE BYTE MODE.
ASMOT4: PBY4 ? PBY5 ? PBY5 ? PBY3 ? [HALT ]
;TABLE SAYING WHAT CHAR MUST HAVE OPENED THE GROUPING.
ASMOT5: "? ? "< ? "( ? "[ ? "? ;]
;;GETVAL ;GET VALUE OF SYM
;SKIPS ON PSEUDO NOT RETURNING VALUE (E.G. MACRO STARTING TO BE EXPANDED)
;ELSE RETURNS VALUE IN A, RELOCATION BITS IN B
VBLK
GTVER: 0 ;SQUOZE NAME OF CALLING PSEUDO, OR POINTER
;TO INSN TO EXECUTE WHEN IF SYM IS UNDEF.
PBLK
GETVAL: PUSHJ P,ES
JRST GVNF ;NO STE.
IFN CREFSW,XCT CRFINU ;JFCL OR CALL TO CREF RTN.
JRST @.+1(A) ;FOUND, DISPATCH ON SQUOZE FLAGS
GVTAB: GVCOM ;COMMON (UNUSED)
GVPSEU ;PSEUDO OR MACRO.
GVSYM ;LOCAL SYMBOL.
GVUL ;LOCAL UNDEF (MAYBE STINK KNOWS VALUE)
GVDLV ;DEFINED LOCAL VAR.
GVULV ;UNDEF LOC VAR.
GVDGV ;DEF GLO VAR
GVUGV ;UNDEF GLO VAR
GVDG ;DEF GLOBAL
GVUG ;UNDEF GLOBAL
;DEF LOCAL VAR.
GVDLV: PUSHJ P,GVDLGV ;IF PASS2 AND HAS ' THIS TIME, SET 3VAS2 FOR AVARIAB
TLZN I,ILGLI
JRST GVDLV2
MOVSI T,DEFGVR ;NOW DEF GLO VAR.
PUSHJ P,VSM2
JRST GVDG1 ;MAYBE OUTPUT GLOBAL DEF. TO STINK.
GVDGV: PUSHJ P,GVDLGV ;DEF GLO VAR; IF PASS 2 AND ' THIS TIME, SET 3VAS2
JRST GVDG2 ;MUSN'T PUNCH VALUE, AVARIAB WILL.
GVDLGV: TRNE FF,FRPSS2 ;IF PASS 2
TLNN I,ILVAR ;AND THIS TIME HAVE SINGLEQUOTE
POPJ P,
TLO C,3VAS2 ;TELL AVARIAB SEEN IN PASS 2 WITH '.
3PUT C,D
POPJ P,
GVULV: TLZN I,ILGLI ;UNDEF LOCAL VAR, MAYBE MAKE GLOBAL.
JRST GVUNDF
PUSHJ P,PLOGLO ;IF SO, TELL STINK SYM IS GLOBAL,
MOVSI T,UDEFGV ;SYM NOW UNDEF GLO VAR
PUSHJ P,VSM2
JRST GVUNDF ;IN EITHER CASE, HANDLE UNDEF SYM.
GVUL: TLZE C,3MACOK ;UNDEF LOCAL, PRESUMED NUMERIC
3PUT C,D ;DON'T LET IT BECOME MACRO AND SCREW PASS2.
TLNE C,3LLV
JRST GVGLTB ;(REALLY DEFINED BUT ONLY STINK KNOWS HOW)
TLNE I,ILGLI ;IF MAKING GLOBAL, TELL STINK.
PUSHJ P,PLOGLO
GVNF1: TLZE I,ILVAR ;IF ', MAKE VAR (WILL CHECK ILGLI)
JRST GVUL1
TLZN I,ILGLI ;NOT MAKING VAR, MAYBE GLOBAL?
JRST GVUNDF ;NO, MAYBE ERROR, MAKE GLOTB ENTRY.
MOVSI T,GLOEXT
PUSHJ P,VSM2 ;NOW GLOBAL UNDEF,
JRST GVGLTB ;NO ERROR, JUST GLOTB ENTRY.
GVUL1: TLZN I,ILGLI ;UNDEF LOCAL BECOMES
SKIPA T,[UDEFLV,,] ;UNDEF LOC VAR OR
GVGVAR: MOVSI T,UDEFGV ;UNDEF GLO VAR.
GVVAR: CALL ESDEF ;DEFINING SYM AS A VAR => INSIST ON DEFINING LOCAL TO INNERMOST BLOCK.
JFCL
AOS VARCNT
HRR B,VARCNT
PUSHJ P,VSM2 ;MAKE IT A VAR,
JRST GVUNDF ;PRETEND HAD ALREADY BEEN A VAR.
GVUG: TLZE I,ILVAR ;UNDEF GLOBAL: MAYBE MAKE UNDEF GLO VAR.
JRST GVGVAR
GVGLTB: SKIPGE CONTRL ;UNDEF GLO IN ABS ASSEM =>
JRST GVUND1 ;MAYBE TREAT AS UNDEF.
GVGLT1: AOS GLSP1 ;DON'T KNOW SYM'S VALUE, MAKE GLOTB ENTRY.
MOVEI T,ST(D)
HRRZM T,@GLSP1
JRST CABPOP ;RETURN 0 AS VALUE.
GVNF:
IFN CREFSW,XCT CRFINU ;ONLY IF NOT FOUND WOULD NOT CREF AFTER ES.
TLNE I,ILVAR+ILGLI ;MAKING VAR OR GLOBAL FORCED CURRENTBLOCK ALREADY
JRST GVNF1 ;AND WILL STORE NAME IN STE ANYWAY.
SKIPGE ESBK ;ELSE IF NO SPEC'D BLOCK,
TRNN FF,FRNPSS ;FORCE .MAIN BLOCK SO DON'T GET LOTS OF UNDEF ENTRIES.
CAIA ;BUT CAN'T DO THAT FOR 1PASS OR WOULD MISS FWD REFS.
HRRI C,BKWPB
MOVSI T,LCUDF
PUSHJ P,VSM2
JRST GVUNDF ;MAYBE ERROR, MAKE GLOTB ENTRY.
GVCOM: TRO I,IRCOM ;COMMON: SAY THIS WAS ONE.
HRRZ A,B ;RETURN RH OF VALUE, ABSOLUTE.
JRST CLBPOP
GVPSEU: TLNN I,ILVAR+ILGLI ;CAN'T MAKE PSEUD OR MACRO GLOBAL OR VAR.
JRST (B) ;OTHERWISE, DISPATCH TO IT.
TLZE I,ILVAR
ETSM ERRCBV
TLZE I,ILGLI
ETSM ERRCBG
JRST (B) ;DISPATCH TO PSEUDO (OR MACCL IF MACRO)
;EXPECTS LH OF VALUE IN LH OF B.
ERRCBV: ASCIZ /Can't be a variable/
ERRCBG: ASCIZ /Can't be global/
GTVL7B: TLNE C,3RLL ;R(LH)
TLO SYM,200000
TLNE C,3RLR ;R(RH)
TLO SYM,100000
POPJ P,
GVSYM: TLNN C,3REL
TLNE I,ILVAR\ILGLI
JRST GVSYM2
MOVE A,B ;THIS CODE DOES WHAT GVSYM2 WOULD DO, BUT FASTER.
SETZ B,
RET
GVSYM2: TLZE I,ILVAR ;LOCAL SYM: CAN'T MAKE VARIABLE.
ETSM ERRMDV
TLZN I,ILGLI
JRST GVSYM0 ;NOT MAKING GLOBAL, GET VALUE & RETURN.
GVSYM1: MOVSI T,GLOETY ;BECOMES DEF. GLOBAL.
PUSHJ P,VSM2
JRST GVDG1 ;HANDLE AS IF WAS DEF GLOBAL.
ERRMDV: ASCIZ /Multiply-defined variable/
GVDG: TLZE I,ILVAR ;GLOBAL ENTRY
ETSM ERRMDV
;COME HERE FOR DEF GLOBAL
GVDG1: SKIPGE CONTRL
JRST GVDLV2 ;DON'T PUNCH VALUE IF ABSOLUTE.
TLNE C,3VP
JRST GVDG2 ;VALUE PUNCHED ALREADY, NOT AGAIN.
JUMPGE FF,GVDG2
TLNN C,3LLV
TRNE I,IRPSUD+IREQL
JRST GVDG2
TLO SYM,40000
PUSH P,WRD
PUSHJ P,OUTDE2
POP P,WRD
GVDG2: TRNN I,IRPSUD\IREQL ;IF INSIDE AN ORDINARY STORAGE WORD,
TLNN C,3REL ;GENERATE A GLOBAL REF IF GLOBAL IS RELOCATABLE (HEURISTIC).
GVDLV2: TLNE C,3LLV ;IF VAL KNOWN ONLY BY STINK, MUST MAKE A GLOBAL REF.
JRST GVGLTB
GVSYM0: MOVE A,B ;USED IN LBRAK
LDB B,[.BP (3RLR),C]
TLNE C,3RLL
TLO B,1
POPJ P,
GVUND1: MOVE A,CONTRL
TRNE A,DECREL+FASL ;DEC FMT OR FASL => UNDEF GLOBALS OK.
JRST GVGLT1
GVUGV:
GVUNDF: TRZ I,IRDEF ;UNDEFINED, MAYBE ERROR, MAKE GLOTB ENTRY.
TRNE I,IRPSUD\IREQL
JRST GVUND2 ;PSEUDO
TRNN FF,FRPSS2
JRST GVGLT1 ;PASS 1
SKIPN CONDEP
ETSM [ASCIZ/Undefined/]
SKIPE CONDEP
ETSM [ASCIZ/Undefined in literal/]
JRST CABPOP
GVUND2: HLRZ A,GTVER ;DOES GTVER POINT TO AN INSN?
JUMPE A,[XCT @GTVER ? JRST CABPOP]
ERJ .+1 ;NO, IT IS NAME OF PSEUDO.
MOVE A,LINEL
CAIGE A,75. ;CR-LF-TAB NOW IF WHOLE MSG WON'T FIT ON A LINE.
CALL CRRTBX
TYPE2 SYM ;TYPE NAME OF UNDEF SYM.
TYPR [ASCIZ/ Undefined in /]
TYPE2 GTVER
CALL CRRERR
JRST CABPOP
;EVALUATE SYMBOL, SQUOZE (FLAGS OFF) IN SYM
;IDX OF BLOCK TO DEFINE IN IN ESBK (OR -1 => ANY BLOCK NOW IN PROGRESS).
;DOESN'T CLOBBER F (FOR WRQOTE)
;RETURNS SKIPPING IF SYM FOUND, WITH SQUOZE FLAGS IN BOTTOM OF A,
;VALUE OF SYM IN B, STE IDX IN D, AND 3RDWD IN C.
;IF NOT FOUND, RETURNS IN D THE IDX OF A PLACE TO DEFINE SYM.
;CALL ESDCHK TO GET THE FOLLOWING EXTRA INFO (WHETHER SYM FOUND OR NOT):
;ESLAST -> LAST STE WITH DESIRED NAME SEEN, REGARDLESS OF WHAT BLOCK IT'S IN
;ESL1 HAS LEVEL OF BLOCK OF BEST STE SEEN, -1 IF NOT FOUND
;ESL2 HAS 3RDWRD OF BEST.
;ESXPUN HAS -1 OR IDX OF A STE WHICH MIGHT BE USED TO DEFINE THE SYM.
;RH(TM) GETS BLOCK IDX TO DEFINE IN IF DEFINE THE SYM.
;TT HAS -<# STE NOT LOOKED AT YET>
;THEN IF SYM IS FOUND IN A CONTAINING BLOCK AND YOU WANT TO DEFINE
;IT IN THE CURRENT BLOCK, YOU CAN CALL DEFCHK TO FIND AN STE TO DO IT IN.
;CALLING ESDEF IS AS GOOD AS CALLING ESDCHK AND DEFCHK, BUT DOESN'T
;LET YOU SEE WHAT YOU ARE GOING TO SHADOW.
ESDEF: MOVE A,BKCUR ;EVAL SYM IN ORDER TO DEFINE IT:
SKIPGE ESBK ;IF NO SPEC'D BLOCK, SPEC THE CURRENT BLOCK,
MOVEM A,ESBK ;SO DEFS IN CONTAINING BLOCKS WON'T BE SEEN
ESDCHK: SETOM ESLAST ;CALL HERE IF WE MIGHT END UP CALLING DEFCHK,
SETOM ESL1 ;SINCE IN THAT CASE WE'LL NEED THESE VARS EVEN IF SYM IS FOUND
SETOM ESXPUN ;RIGHT AWAY.
MOVN TT,SYMLEN
ES: MOVE C,SYM ;HASH AWAY
TSC C,SYM ;THIS MAKES SURE THAT THE FIRST FEW CHARS OF SYMBOL DON'T GIVE
;A ZERO REMAINDER, IF SYMLEN IS A ROUND NUMBER.
MOVMS C ;THIS IS BECAUSE IDIV OF NEGATIVE NUMBER GIVES NEG. REMAINDER.
IDIV C,SYMLEN
IMUL D,WPSTE
SKIPGE TM,ESBK ;GET BKTAB IDX OF SPEC'D BLOCK
HRR TM,BKCUR ;OR -1,,BKTAB IDX OF CURRENT BLOCK.
;NOW CHECK FAST FOR AN IMMEDIATE MATCH - AVOID SETTING UP FLAGS NEEDED ONLY WHEN
;SYM APPEARS IN MULTIPLE BLOCKS OR ISN'T DEFINED.
SKIPN B,ST(D)
JRST ESEND0 ;SYM IS KNOWN NOT TO BE DEFINED.
TLZ B,740000
CAME B,SYM
JRST ESBAD0 ;NOT FOUND IN 1ST ENTRY - MUST SET UP INFO AND LOOP
3GET C,D
MOVEI A,(C)
CAIN A,(TM)
JRST ESGOOD ;IN THE DESIRED BLOCK => GOOD.
TDNN C,[3MAS,,-1] ;IN THE INITIAL SYMS BLOCK, NOT PRESENT IN ANY OTHER,
JUMPL TM,ESGOOD ;AND BLOCK WASN'T EXPLICITLY SPEC'D => GOOD.
MOVN TT,SYMLEN ;ELSE MUST KEEP LOOKING TO SEE IF THIS DEF IS REALLY ONE WE WANT.
SETOM ESLAST
SETOM ESL1
SETOM ESXPUN
JUMPGE TM,ESIGN
JRST ESLP1
;LOOK AT THE NEXT STE, WHILE LOOPING.
ESLP: SKIPN B,ST(D) ;GET SQUOZE IN THIS ST SLOT
JRST ESEND ;NOTHING WHERE SYM BELONGS, END SEARCH
TLZ B,740000 ;CLEAR OUT FLAGS
CAME B,SYM ;COMPARE WITH WANTED
JRST ESBAD ;NO MATCH BUT MAYBE KEEP GOING
3GET C,D ;FOUND SYM, GET 3RDWRD
MOVEI A,(C)
CAIN A,(TM) ;DEFINED IN DESIRED BLOCK
JRST ESGOOD ; => MUST BE GOOD.
ESLP0: JUMPGE TM,ESIGN ;BLOCK SPEC'D => ALLOW NO OTHERS.
TDNE C,[3MAS,,-1] ;IF IN INITIAL SYMS BLK, NO MORE DEFS,
JRST ESLP1
SKIPGE ESL1 ;AND NO PREVIOUS DEFS,
JRST ESGOOD ;UNREDEFINED INITL SYM MUST BE GOOD.
ESLP1: HLRZ B,BKTAB+1(C) ;GET LEVEL OF BLOCK DEF. IS IN.
CAMN A,BKPDL(B) ;SAME AS BLOCK WE'RE IN AT THAT LEVEL?
CAMLE B,BKLVL ;AND NOT A BLOCK WE'VE EXITED
JRST ESIGN
CAMG B,ESL1 ;OR HIGHER LEVEL THAN PREVIOUS BEST
JRST ESIGN
MOVEM C,ESL2 ;REPLACE BEST'S 3RDWRD, LEVEL, ADDR.
MOVEM B,ESL1
MOVEM D,SADR
ESIGN: HRRZM D,ESLAST ;THIS ENTRY LAST SEEN WITH THIS NAME.
TLNN C,3MAS ;MORE STE'S FOR THIS SYM =>
JRST ESEND1
JRST ESNXT ;KEEP LOOKING.
;COME HERE IF 1ST SYM SEEN ISN'T THE SAME NAME. SET UP TO LOOP.
ESBAD0: MOVN TT,SYMLEN
SETOM ESLAST
SETOM ESL1
SETOB C,ESXPUN
;HERE WHILE LOOPING WHEN SYM WITH WRONG NAME IS SEEN.
ESBAD: JUMPN B,ESNXT
SKIPGE A,ESXPUN ;IF THIS IS 1ST EXPUNGED ENTRY SEEN
MOVEM D,ESXPUN ;REMEMBER IT FOR DEFINITION.
SKIPGE A
HRROS ESLAST ;AND SET OLD ENTRY'S 3MAS.
ESNXT: ADD D,WPSTE
CAML D,SYMSIZ ;AT END => GO TO BEGINNING
MOVEI D,0
AOJN TT,ESLP
JRST ESEND1 ;NOT FOUND.
ESEND0: MOVEI C,(TM) ;COME HERE IF 1ST PLACE LOOKED AT SHOWS THE SYM ISN'T DEFINED
MOVEM D,ESXPUN
POPJ P,
ESEND: SKIPGE A,ESXPUN ;FREE ENTRY CAN BE USED TO DEFINE.
MOVEM D,ESXPUN
SKIPGE A
HRROS ESLAST
ESEND1: SKIPGE ESL1 ;NOT FOUND => FIND PLACE TO DEFINE IT.
JRST DEFCH1
MOVE D,SADR ;IDX OF BEST FOUND.
TRNN FF,FRNPSS
JRST ES1PS ;1-PASS, SPECIAL CHECK.
MOVE C,ESL2 ;GET BEST'S 3RDWRD.
ESGOOD: LDB A,[400400,,ST(D)] ;GET SQUOZE FLAGS IN A.
ES1POK: MOVE B,ST+1(D) ;VALUE OF SYM. IN B.
;D HAS IDX OF 1STWRD IN SYM TAB.
;C HAS 3RDWRD
POPJ1: AOS (P)
APOPJ:
CPOPJ: POPJ P,
;ESDCHK THEN DEFCHK IS SAME AS CALLING ESDEF.
;WE ASSUME THAT D AND TT ARE STILL SET UP FROM A CALL TO ESDCHK.
DEFCHK: SKIPGE ESL1 ;IF WE DIDN'T TAKE TIME TO SET ESLAST BEFORE,
HRRZM D,ESLAST ;DO IT NOW. (SEE BEFORE ESLP1)
JRST DEFCH1
ES1PS: LDB A,[400400,,ST(D)] ;1PASS & FOUND IN CONTAINING BLOCK:
MOVE C,ESL2
TRNN C,-1 ;INITIAL SYM, OK;
JRST ES1POK
CAIE A,1 ;PSEUDO OR MACRO
TLNE C,3DOWN ;OR .DOWN'D SYMBOL OK;
JRST ES1POK ;ELSE GET NEW STE TO DEF.
DEFCH1: MOVEI C,(TM) ;INITIALIZE NEW 3RDWRD WITH BLOCK TO DEF IN.
SKIPL D,ESXPUN ;IF FOUND EXPUNGED OR FREE ENTRY, USE IT.
JRST DEFCH2
SKIPGE D,ESLAST ;ELSE LOOK FOR ONE.
ETF ERRSCE
DEFCH4: MOVE B,ST(D)
TLZ B,740000
JUMPE B,DEFCH3 ;MUST RETURN 0 IN B IF DON'T SKIP.
ADD D,WPSTE
CAML D,SYMSIZ
MOVEI D,0
AOJL TT,DEFCH4 ;ASSUME TT LEFT AROUND FROM ES.
ETF ERRSCE
ERRSCE: ASCIZ /Symbol table full/
;ESLAST HAS -1 IF NO ENTRY SEEN; ELSE
;RH HAS IDX OF LAST SEEN, SIGN SET IF SEEN BEFORE PLACE TO DEFINE.
DEFCH3: MOVEM D,ESXPUN ;REMEMBER ADDR WHERE CAN DEFINE
HRROS ESLAST ;LAST PLACE SEEN MUST BE EARLIER.
DEFCH2: SKIPL A,ESLAST
JRST DEFCH5 ;LAST PLACE SEEN WAS SEEN AFTER PLACE TO DEFINE.
CAMN A,[-1]
POPJ P, ;REALLY NEVER SEEN.
MOVSI TM,3MAS
IORM TM,ST+2(A) ;PLACE SEEN IS EARLIER, SET ITS 3MAS.
POPJ P,
DEFCH5: TLO C,3MAS ;PLACE TO DEF BEFORE EXISTING STES.
POPJ P,
;ENTER A SYM IN SYMBOL TABLE
;B HAS VALUE
;C HAS 3RDWRD
;D HAS INDEX INTO ST (PROBABLY SET UP BY ES)
;T HAS SQUOZE FLAGS (ONLY) IN PLACE FOR IOR OF SQUOZE
;SYM HAS SQUOZE, FLAGS OF WHICH ARE IGNORED
VSM2LV: TLOA C,3LLV ;ENTRY FOR LINKING LOADER MUST SUPPLY VALUE
VSM2W: MOVE B,WRD ;ENTRY TO ENTER VALUE OF WRD STEAD B
VSM2: MOVE CH1,SYM
TLZ CH1,740000
IOR CH1,T ;CH1 := SQUOZE WITH FLAGS
MOVEM CH1,ST(D) ;STORE SQUOZE
MOVEM B,ST+1(D) ;STORE VALUE
VSM3A: 3PUT C,D ;STORE 3RDWRD
POPJ P,
;RETURN THE NUMBER OF SYMTAB SLOTS IN USE.
A.SYMCN:SKIPL A,SMSRTF ;IF SYMTAB HAS BEEN COMPACTED, GET # OF SYMS THAT IT HAD
JRST CLBPOP ;BEFORE COMPACTION AND RETURN THAT.
MOVE D,SYMAOB
SETZ A,
A.SYC1: MOVE B,ST(D)
TLZ B,740000
SKIPE B
AOS A
ADD D,WPSTE1
AOBJN D,A.SYC1
JRST CLBPOP
;;EQUAL ;EQUAL SIGN ENCOUNTERED, DO PARAMETER ASSIGNMENT
EQUAL: TLZ FF,FLHKIL
PUSHJ P,RCH
CAIE A,"= ;DECIDE WHETHER TO HALF-KILL THE SYM.
TLOA FF,FLUNRD
TLO FF,FLHKIL
SETZM LABELF
CALL RCH
CAIE A,": ;DECIDE WHETHER TO MARK SYM AS NOT REDEFINABLE.
TLOA FF,FLUNRD
SETOM LABELF
CAMN SYM,[SQUOZE 0,.] ;.=FOO, SAME AS LOC FOO
JRST PTEQ
TDNN I,[ILWORD,,IROP+IRNOEQ]
TRNN I,IRLET
ETR [ASCIZ/= With bad format or bad context/]
PUSH P,LABELF
PUSH P,SYM
PUSH P,ESBK
PUSH P,I
MOVEI A,[ETSM [ASCIZ/Undefined in =/]]
MOVEM A,GTVER
TRO I,IRNOEQ+IRDEF+IREQL
PUSHJ P,GETWRD
TRNN I,IRDEF
JRST ASEM1A ;UNDEFINED SYMS IN VALUE, IGNORE
IFN LISTSW,[
SKIPN LSTONP
JRST EQUAL1 ;NOT LISTING.
SKIPGE LISTPF
PUSHJ P,PNTR
MOVE SYM,WRD
MOVEM SYM,LISTWD
MOVE SYM,WRDRLC
MOVEM SYM,LSTRLC
SETOM LISTAD
SETOM LISTPF
EQUAL1:
] ;END IFN LISTSW,
TDZ I,[-1-(ILMWRD)]
IOR I,(P)
TLZ FF,FLUNRD
POP P,(P)
POP P,ESBK
POP P,SYM
POP P,LABELF
MOVE A,WRDRLC ;GET RELOCATION
TDNN A,[-2,,-2] ;SKIP ON NON-STANDARD RELOCATION BITS
SKIPE LDCCC
JRST EQG1 ;STRANGE RELOCATION OR IN LOAD TIME CONDITIONALS => HAND PROBLEM TO LOADER
MOVE A,GLSP1
CAMN A,GLSP2
JRST EQL1 ;NO GLOBALS IN DEFINITION
;FALLS THROUGH.
;FALLS THROUGH.
;GLOBALS TO RIGHT OF = OR WITHIN LOADER CONDIT.
EQG1: IFN CREFSW, XCT CRFLBL ;CREF DEF. OF NORMAL SYM,
SKIPGE CONTRL
JUMPL FF,[ETASM [ASCIZ /Externals in =/]]
CALL ESDCHK ;SEARCH SYM TAB.
JRST EQL2 ;NOT FOUND IN CURRENT OR CONTAINING BLKS.
HRRZI T,(C) ;GET BKTAB IDX OF BLOCK FOUND IN.
CAIE T,(TM)
JRST EQG1A
XCT EQG1TB(A) ;FOUND IN DESIRED BLOCK.
JRST ASSEM1
EQG1A: JUMPN T,EQG2
CAIN A,PSUDO_-16 ;FOUND AS INITIAL PSEUDO => ERROR.
ETSM ERRQPA
EQG2: CALL DEFCHK ;FIND FREE STE TO DEFINE IN DESIRED BLOCK.
JRST EQL2 ;PRETEND WASN'T FOUND.
ERRQPA: ASCIZ /Shadowing a pseudo-op/
ERRIPA: ASCIZ /Illegal =/
EQG1TB: ETSM ERRIPA ;COMMON
ETSM ERRIPA ;PSEUDO OR MACRO
JRST EQL2 ;SYM
JRST EQGUL ;LOCAL UNDEF
ETSM ERRIPA ;DEF LOC VAR
ETSM ERRIPA ;UNDEF LOC VAR
ETSM ERRIPA ;DEF GLO VAR
ETSM ERRIPA ;UNDEF GLO VAR
JRST EQL7 ;GLO ENTRY
JRST EQL8 ;GLO EXIT
EQL8: PUSHJ P,GLKPNR
TLZ C,3LABEL\3MULTI
EQL7: MOVSI T,GLOETY ;GLOBAL PARA ASSIGN
MOVEI B,0
TLO SYM,40000
LOPRA1: PUSH P,CASM1A ;RETURN TO ASSEM1A AFTER FOLLOWING.
TLNE C,3MULTI
ETSM ERRMDT
SKIPE LABELF
TLO C,3LABEL
TLNE FF,FLHKIL
TLOA SYM,400000 ;SET FLAG TO HALF-KILL SYM
TLZA C,3SKILL
TLO C,3SKILL ;SET CORRESPONDING FLAG IN 3RDWRD
PUSHJ P,VSM2LV
JUMPGE FF,CPOPJ ;JUMP ON NOT PUNCHING PASS
TRNN I,IREQL ;IF CAME FROM COLON ROUTINE,
JRST PDEFPT ;PUNCH "DEFINE SYM AS $.".
TLO C,3VP ;VALUE PUNCHED
3PUT C,D ;STORE UPDATED 3RDWRD
PUSHJ P,EBLK
MOVEI TT,LGPA
DPB TT,[310700,,BKBUF]
PUSHJ P,OUTSM0
PUSHJ P,PWRDA
JRST EBLK
EQGUL: PUSHJ P,LKPNRO ;LOCAL UNDEF, OUTPUT LINK REQUEST.
TLZ C,3LABEL\3MULTI ;CAN'T DETECT MDT'S WHEN ONLY STINK KNOWS FOR SURE.
EQL2: TLNE I,ILGLI
JRST EQL7 ;MAKE IT GLOBAL
MOVSI T,LCUDF ;LOCAL UNDEFINED
JRST LOPRA1
CASM1A: JRST ASEM1A
;MAYBE PUNCH OUT LINK REQUEST
;SYM HAS NAME OF SYM TO REQUEST, D STE IDX OF SYM, C 3RDWRD, B ADR OF REQUEST
;REQUEST WILL BE PUNCHED IF 3RLNK SET IN C OR IF ANYTHING SET IN LH(B)
GLKPNR: TLO SYM,40000 ;GLO BIT
LKPNRO: TLNN C,3RLNK
TLNE B,-1
TROA I,IRCONT
POPJ P, ;DON'T PUNCH REQUEST
MOVE A,CONTRL
TRNE A,DECREL
JRST LKPNDR ;DIFFERENT WAY TO OUTPUT THIS INFO IN DECREL FMT
MOVEI A,6
PUSHJ P,PBITS
PUSHJ P,OUTSM0 ;PUNCH SYM
HLRZ A,B
TLZE C,3RLNK ;RELOC OF LINK PNR
TLO A,100000
HRRZS B ;CLEAR OUT LH OF B
TRZ I,IRCONT ;OK TO END BLOCK NOW
JRST $OUTPT ;PUNCH OUT A AND RETURN
LKPNDR: MOVSI A,DECINT ;WRITE AN "INTERNAL REQUEST" WITH ONE DATA WORD.
CALL DECBLK
SETZ TM, ;COMPUTE RELOC OF ADDRESS AND DATA IN TM.
TLNE C,3RLNK
TRO TM,2
SKIPE WRDRLC
TRO TM,1
MOVE A,WRD ;ADDRESS TO LINK,,DATA
HRL A,B
CALL DECWR1
JRST EBLK
;THESE ASSUME STE IDX IN D, SQUOZE W/ FLAGS IN SYM.
;C HAS 3RDWRD, B OR WRD HAS VALUE TO DEF. WITH.
;CALL ONLY IN RELOCATABLE ASSEMBLY.
OUTDE2: MOVEM B,WRD
OUTDE1: TLNE FF,FLPPSS
TLO C,3VP ;VALUE PUNCHED
3PUT C,D
SKIPGE CONTRL
RET
TRO I,IRCONT
SETZ A,
TLNN C,3LABEL ;WHAT KIND OF DEFINITION DEPENDS ON WHETHER SYM IS REDEFINABLE.
MOVEI A,CRDF
CALL P7X ;PUNCH OUT CODE BITS
PUSHJ P,GTVL7B ;SET RELOCATION BITS IN SQUOZE
PUSHJ P,OUTSM0
TRZ I,IRCONT
JRST OUTWD ;OUTPUT VALUE
;PUNCH OUT LOCAL-GLOBAL RECOVERY BITS AND SYM
;I.E. TELL LOADER THAT SQUOZE IN SYM, FORMERLY CONSIDERED LOCAL, IS REALLY GLOBAL
PLOGLO: SKIPGE CONTRL
RET
PUSH P,A
PUSHJ P,PBITS7
MOVEI A,CLGLO
PUSHJ P,PBITS
TLO SYM,400000 ;SAY THIS IS NEW STYLE RQ,
PUSHJ P,OUTSM0 ;PUNCH "OLD NAME" = SYMTAB IDX,
TLC SYM,440000 ;SAY MAKE GLOBAL, OUTPUT ACTUAL NAME OF SYM.
PUSHJ P,OUTSM
JRST POPAJ
;NO GLOBALS TO RIGHT OF EQUAL SIGN
EQL1: PUSHJ P,ESDCHK
JRST EQL1A ;NOT FOUND
IFN CREFSW,XCT CRFEQL ;DEF. OCCUR. OF NORMAL SYM. OR INTSYM.
MOVEI T,(C) ;GET BKTAB IDX OF BLOCK FOUND IN.
CAIE T,(TM)
JRST EQL1F
SKIPE LABELF ;"=:" MEANS "SYM'S VALUE SHOULDN'T BE CHANGED".
TLO C,3LABEL
XCT EQL1TB(A) ;FOUND IN DESIRED BLOCK => NOW REDEFINE.
JRST ASSEM1
EQL1F: JUMPN T,EQL10
CAIE A,PSUDO_-16
JRST EQL10
MOVEI T,(B) ;FOUND AS PSEUDO IN INITIAL SYMS BLOCK,
CAIN T,INTSYM ;SPECIAL WAY TO REDEFINE IF LIKE .MLLIT, ETC.
JRST EQLINT
ETSM ERRQPA ;SHADOWING AN INITIAL PSEUDO, TELL USER.
EQL10: CALL DEFCHK ;FOUND IN OUTER BLOCK, GET NEW STE,
JRST EQL1A ;DEFINE THERE AS IF NOT FOUND.
EQL1TB: ETSM ERRIPA ;COMMON
JRST EQL1B2 ;PSEUDO OR MACRO
JRST EQL1B ;SYM
JRST EQL1C ;LOCAL UNDEF
ETSM ERRIPA ;DEF LOC VAR
ETSM ERRIPA ;UNDEF LOC VAR
ETSM ERRIPA ;DEF GLO VAR
ETSM ERRIPA ;UNDEF GLO VAR
JRST EQL1D ;GLO ENTRY
JRST EQL1E ;GLO EXIT
EQL1E: PUSHJ P,GLKPNR ;DUMP LINKING POINTER
CAIA
EQL1D: CALL MDTCHK
PUSHJ P,RCHKT ;GLO ENTRY
EQLB2: PUSHJ P,RMOVET
TLNE FF,FLHKIL
TLOA SYM,400000
TLZA C,3SKILL
TLO C,3SKILL
HRLZI T,GLOETY
SKIPE LDCCC ;IF IN LOADER CONDITIONAL,
TLO C,3LLV ;THEN LOADER MUST SUPPLY VALUE
PUSHJ P,VSM2W ;DEFINE SYM
TLO SYM,40000 ;SET GLOBAL BIT IN SQUOZE
EQL1CE: JUMPGE FF,ASEM1A
PUSHJ P,OUTDE1
ASEM1A: TLNE I,ILMWRD
PUSHJ P,IGTXT
JRST ASSEM1
;CHECK WHETHER DEFINING AN MDT, OR REDEFINING A LABEL (=> THIS IS AN MDT)
MDTCHK: TLNN C,3LABEL
JRST MDTCH1
CALL GVSYM0 ;MOVE VALUE OF SYM TO A, GET RELOC (WRDRLC STYLE) IN B
CAMN A,WRD
CAME B,WRDRLC ;IF WE'RE CHANGING THE VALUE, MARK SYM AS MDT
MDTCHL: TLO C,3MULTI
MDTCH1: TLNE C,3MULTI ;EVER ASSIGNING TO MDT, EVEN SAME VALUE, GIVES ERR MSG
ETSM ERRMDT
RET
EQL1C: TLNE I,ILGLI
JRST EQL1CA ;MAKE GLOBAL
PUSH P,C
PUSHJ P,LKPNRO ;MAYBE OUTPUT LINK REQUEST
PUSHJ P,RCHKT
PUSHJ P,RMOVET ;INITIALIZE 3RDWRD
MOVSI T,SYMC ;SYM
PUSHJ P,EQA2A ;ENTER DEF IN SYMTAB
TLNE C,3SKILL
TLO SYM,400000
POP P,AA
TLNE AA,3VCNT ;USED IN CONSTANT
PUSHJ P,CONBUG
JRST EQL1CE
;PUNCH OUT CODE BIT PAIR, FIRST OF WHICH IS 7
P7X: MOVEM A,PARBIT ;ENTRY FOR SECOND BYTE IN A
P70: PUSHJ P,PBITS7 ;ENTRY FOR SECOND BITE IN PARBIT, PUNCH OUT THE 7
SKIPA A,PARBIT ;GET SECOND BYTE BACK
PBITS7: MOVEI A,7 ;ENTRY TO JUST PUNCH OUT 7
JRST PBITS
EQL1CA: PUSHJ P,PLOGLO
JRST EQL1E
EQA2: PUSH P,CASM1A
EQA2A: TLNE FF,FLHKIL
TLO C,3SKILL
JRST VSM2W
EQL1B2: HRRZ A,B ;ATTEMPT TO ASSIGN PSEUDO-OP, IS IT AN INTSYM?
CAIN A,INTSYM
JRST EQLINT ;YES, GO SET WD IT POINTS TO.
ETSM [ASCIZ /Pseudo or macro ='D/]
EQL1B: CALL MDTCHK
PUSHJ P,RCHKT
TLNE I,ILGLI
JRST EQLB2 ;WAS LOCAL, MAKE IT GLOBAL
;WAS LOCAL, LEAVE IT LOCAL
PUSHJ P,RMOVET ;PUT RELOCATION BITS IN BITS 0 AND 1 OF C (I.E. START SETTING UP 3RDWRD)
MOVSI T,SYMC ;SYM
JRST EQA2
EQL1A1: PUSHJ P,RCHKT
PUSHJ P,RMOVET
HRLZI T,SYMC
JRST EQA2
EQL1A: SKIPE LABELF ;"=:" MEANS "SYM'S VALUE SHOULDN'T BE CHANGED".
TLO C,3LABEL
IFN CREFSW,XCT CRFLBL ;DEF. OCCUR. OF NORMAL SYM.
TLNN I,ILGLI
JRST EQL1A1
JRST EQL1E
EQLINT: HLRZS B ;GET ADDR OF WD HOLDING VALUE.
MOVEMM (B),WRD ;PUT NEW VALUE IN IT.
JRST ASEM1A
;;. ;ROUTINES DEALING WITH THE CURRENT LOCATION AND OFFSET
VBLK
CLOC: 0 ;PUNCHING LOC
CRLOC: 0 ;PUNCHING RELOC
OFLOC: 0 ;OFSET VAL
OFRLOC: 0 ;OFSET RELOC
;VAL OF PT=CLOC+OFLOC,CRLOC+OFLOC
SYLOC: 0 ;VAL OF LAST TAG
SYSYM: 0 ;LAST TAG
SYLOC1: 0 ;VALUE OF NEXT TO LAST TAG
SYSYM1: 0 ;NEXT TO LAST TAG
GLOCTP: 0 ;4.9 => CURRENT LOCATION GLOBAL, 2.9 => OFFSET GLOBAL
;FRGLOL (FLAG IN FF) IS IOR OF BITS 4.9 AND 2.9 OF GLOCTP
;EXCEPT AFTER .=NON-GLOBAL WITH GLOBAL OFFSET
;OTHER BITS USED ONLY WHEN IN LINK (NEVER SET IN GLOCTP):
;400 => ARG GLOBAL
PBLK
;POINT (.) AS PSEUDO-OP
GTVLP: TRNE FF,FRGLOL
JRST GTVLP2 ;LOCATION GLOBAL
MOVE B,OFRLOC ;GET RELOCATION OF OFFSET
ADD B,CRLOC ;ADD CURRENT RELOCATION
MOVE A,CLOC ;GET CURRENT LOCATION
SKIPGE BYTM1 ;IF IN BYTE MODE,
HLL A,BYTWP ;SET LEFT HALF TO BYTE POINTER LEFT HALF FOR ILDB
ADD A,OFLOC ;NOW ADD OFFSET
TLZ I,ILFLO+ILDECP+IRPERI ;CLEAR OUT FLAGS SET WHEN LOOKED LIKE FLOATING POINT NUMBER
POPJ P,
GTVLP2: MOVEI T,$.H ;LOCATION GLOBAL
AOS GLSP1
HRRZM T,@GLSP1 ;PUT $. ON GLOBAL LIST (INCLUDES OFFSET, WHETHER GLOBAL OR NOT)
SKIPL BYTM1 ;IN BYTE MODE?
TDZA A,A ;NO, CLEAR ABS PART OF VALUE
HLLZ A,BYTWP ;YES, USE LH(BP) AS ABS PART
JRST CLBPOP
$.H: (GLOETY)+SQUOZE 0,$. ;CURRENT LOCATION + OFFSET IN LOADER
$L.H: (GLOETY)+SQUOZE 0,$L. ;LOCATION BEING LOADED INTO BY LOADER, USED BY ABLOCK
$O.H: (GLOETY)+SQUOZE 0,$O. ;LOADER OFFSET
$R.H: (GLOEXT)+SQUOZE 0,$R. ;RELOCATION AS GLOBAL
COLON: TRNE I,IRLET
TRNN I,IRSYL
ETA [ASCIZ/Colon without preceding symbol/]
TLNN I,ILWORD
TRNE I,IROP+IRPSUD+IREQL+IRNOEQ
ETSM [ASCIZ/Label inside an expression/]
SKIPE ASMOUT
ETSM [ASCIZ /Label inside <>, () or []/]
TLZ FF,FLHKIL
PUSHJ P,RCH ;GET NEXT CHAR
CAIN A,": ;IF NEXT CHAR ANOTHER COLON,
TLOA FF,FLHKIL ;THEN SET FLAG TO HALF-KILL
TLO FF,FLUNRD ;NOT COLON, CAUSE IT TO BE RE-INPUT
SKIPE HKALL ;CHECK FOR HALF-KILL-ALL-LABELS MODE.
TLO FF,FLHKIL
MOVE T,CLOC ;GET CURRENT LOCATION
SKIPGE BYTM1
HLL T,BYTWP ;BYTE MODE, SET LEFT HALF OF VALUE TO LEFT HALF OF BYTE POINTER
ADD T,OFLOC ;ADD OFFSET
MOVEM T,WRD ;STORE RESULT AWAY FOR POSSIBLE PUNCHOUT
EXCH T,SYLOC ;NOW SET UP STUFF FOR ERROR PRINTOUT
MOVEM T,SYLOC1
EXCH SYM,SYSYM
MOVEM SYM,SYSYM1
MOVE SYM,SYSYM
MOVE A,CRLOC ;SET UP RELOCATION
ADD A,OFRLOC
MOVEM A,WRDRLC
SETOM LABELF ;SET FLAG CAUSING 3LABEL (DON'T REDEFINE) TO BE SET.
SKIPN LDCCC
TRNE FF,FRGLOL
JRST GCOL1 ;LOCATION VIRTUAL OR IN LOAD TIME CONDITIONAL
PUSHJ P,ESDCHK ;TRY FINDING CURRENT ENTRY IN ST
JRST EQL1A ;NOT ALREADY DEFINED
IFN CREFSW,XCT CRFLBL
COLON1: MOVEI T,(C) ;BKTAB IDX OF BLOCK FOUND IN,
CAIE T,(TM) ;FOUND IN DESIRED BLOCK => TRY REDEFINING.
JRST COLON3
TLO C,3LABEL ;CAUSE REDEFINING SYMBOL TO BARF
XCT COLON2(A) ;BUT MAYBE PRINT ERR MSG FIRST.
JRST EQL1B
CASSM1: JRST ASSEM1
COLON3: JUMPN T,EQL10 ;NOT INITIAL SYM => CAN SHADOW,
CAIN A,SYMC_-14. ;INITIAL SYM => CAN SHADOW IF IT'S AN ORDINARY LOCAL SYM
CAME B,WRD ;AND NEW VALUE SAME AS OLD VALUE.
CAIA
SKIPE WRDRLC
ETSM ERRRES ;ELSE GIVE ERROR MESSAGE BEFORE SHADOWING, TO WARN USER.
JRST EQL10
ERRRES: ASCIZ /Pseudo, macro or initial sym as label/
ERRMDT: ASCIZ /Multiply defined/
COLON2: TLO C,3MULTI ;COMMON
ETSM ERRRES ;MACRO OR PSEUDO
JRST EQL1B ;SYM
JRST EQL1C ;LOCAL UNDEF
TLO C,3MULTI
TLO C,3MULTI
TLO C,3MULTI
TLO C,3MULTI ;SETTING 3MULTI CAUSES EQL1B TO PRINT AN MDT ERROR.
JRST EQL1D ;GLOBAL ENTRY
JRST EQL1E ;GLO EXIT
;COLON WHEN LOCATION VIRTUAL, OR IN LOAD TIME CONDITIONAL
GCOL1: IFN CREFSW,XCT CRFLBL ;DEFINING ORDINARY SYM.
SKIPGE CONTRL
ETASM [ASCIZ /Virtual label in abs assembly/]
PUSHJ P,ESDCHK ;FIND ITS SLOT IN ST
JRST EQL2 ;JUST LIKE EQG1 EXCEPT FOR ERROR MESSAGES.
MOVEI T,(C)
CAIE T,(TM)
JRST COLON5
XCT GCOL1T(A) ;FOUND IN DESIRED BLOCK, REDEFINING.
JRST EQL2
COLON5: JUMPN T,EQG2 ;SHADOWING, OK UNLESS INITIAL SYM.
ETSM ERRRES
JRST EQG2
GCOL1T: TLO C,3MULTI ;COMMON
ETSM ERRRES ;PSEUDO.
JRST EQL2 ;SYM.
JRST EQGUL ;LOCAL UNDEF.
TLO C,3MULTI ;VAR
TLO C,3MULTI
TLO C,3MULTI
TLO C,3MULTI
JRST EQL7 ;DEF GLO
JRST EQL8 ;UNDEF GLO.
;PUNCH OUT "DEFINE SYM AS $."
PDEFPT: MOVEI A,CDEFPT
PUSHJ P,P7X ;OUTPUT 7 THEN PDEFPT
JRST OUTSM0 ;OUTPUT SYM, WITHOUT BITS
;LOC, BLOCK, .=
ALOC: PUSHJ P,ALOCRG ;LOC, GET ARG
ALOC1: SETZM SYLOC ;CLEAR OUT LOC OF LAST TAG
SETZM SYSYM ;CLEAR OUT LAST TAG SO ERROR MESSAGES DON'T PRINT OBSCENE INCREMENTS
IFN FASLP,[
SKIPGE TM,CONTRL
TRNN TM,FASL
JRST .+2
ETA [ASCIZ /LOC illegal in FASL assembly/]
]
TRZE LINK,400 ;GLOBALS IN ARG?
JRST ALOC2 ;YES
HRRZM A,CLOC ;STORE NEW ABSOLUTE PART OF CURRENT LOCATION
CALL SLOCF ;RE-INIT NEXT OUTPUT BLOCK'S HEADER; SET LOCF.
MOVEI A,LCEGLO ;=> RESET GLOBAL RELOCATION (BACK TO ORIGINAL NON-GLOBAL RELOCATION)
TLZE LINK,400000 ;IS CURRENT LOCATION NOW GLOBAL?
PUSHJ P,PLDCM ;YES, RESET IT
MOVE B,WRDRLC ;GET BACK NEW RELOCATION
ALOC2B: TRZE B,-2 ;NO BITS ALLOWED EXCEPT LOW ORDER
ETR [ASCIZ *Illegal relocation in LOC/BLOCK/.=*]
HRRZM B,CRLOC ;STORE NEW RELOCATION
SKIPGE CONTRL
JRST ASSEM1 ;DON'T BOTHER WITH REST IF ABS.
MOVEI B,2(B) ;LABS OR LREL
DPB B,[310700,,BKBUF] ;STORE NEW BLOCK TYPE
MOVEM B,CDATBC ;ALSO STORE AS NORMAL BLOCK TYPE
AOFSTX: TDNN LINK,[SETZ(SETZ)] ;ENTRY FROM AOFFSET, SKIP IF FRGLOL SHOULD BE SET
TRZA FF,FRGLOL ;CURRENT LOCATION PLUS OFFSET NOT GLOBAL, CLEAR FLAG
TRO FF,FRGLOL ;GLOBAL, SET FLAG
TRZ LINK,600 ;CLEAR OUT TEMPORARY FLAGS SO WON'T GET STORED IN GLOCTP
MOVEM LINK,GLOCTP ;STORE BACK STATUS FLAGS
JRST ASSEM1
PTEQ: MOVE SYM,[SQUOZE 0,LOC]
PUSHJ P,ALOCRG ;.=, GET ARG
MOVE T,[MINF+HFWDF,,$O.H] ;GLOTB ENTRY IF .+1 DOESN'T SKIP
TRNE LINK,400000 ;OFFSET GLOBAL?
JRST PTEQ2 ;YES, WANT TO DO LOC ARG-$O."
PUSHJ P,SBWDOF ;OFFSET IS LOCAL, SUBTRACT FROM ARG
JRST ALOC1
ABLOCK: PUSHJ P,ABLKRG ;GET ARG TO "BLOCK" PSEUDOOP.
TRNE LINK,400 ;GLOBALS IN ARG?
JRST ABLKG ;GLOBALS IN ARG
TLNE LINK,400000
JRST ABLKG ;JUMP IF LOSER CHANGING RELOCATION WHILE CLOC GLOBAL
IFN FASLP,[
MOVE D,CONTRL
TRNN D,FASL ;IN FASL FORMAT, CAN'T SET LOC. CTR.,
JRST ABLKF1
SKIPE B
ETA [ASCIZ /BLOCK size relocatable/]
JUMPGE FF,ABLKF1
CALL ABLKF ;SO ON PASS 2 OUTPUT A BUNCH OF ZEROS.
JRST ABLKF1
;OUTPUT C(A) ZEROS, IN FASL FORMAT. NO-OP ON PASS 1. DOESN'T SET THE LOCATION COUNTER.
ABLKF: JUMPE A,CPOPJ
JUMPGE FF,CPOPJ
SETZM WRD
SETZM WRDRLC
PUSH P,A
PUSH P,A
ABLKF2: CALL FASPW
MOVEMM GLSP2,GLSP1
SOSE (P)
JRST ABLKF2
JRST POPBAJ
]
ABLKF1: JUMPL A,[ETA [ASCIZ /BLOCK size negative/]]
ADD A,CLOC ;ARG TO BLOCK IS LOCAL, ADD DIRECTLY TO CLOC
ADD B,CRLOC ;ALSO ADD RELOCATIONS
HRRZM A,CLOC ;STORE NEW ABSOLUTE PART OF LOCATION
CALL SLOCF ;FALL INTO ALOC ROUTINE, MAKING SURE FRLOC GETS SET
JRST ALOC2B
SBWDOF: SUB A,OFLOC ;SUBTRACT OFFSET FROM WRD, ETC. IN A,B
HRRZM A,WRD ;MAKE SURE RESULT GETS STORED IN WRD, AS WELL AS AC'S
SUB B,OFRLOC ;NOW DO RELOCATIONS
HRRZM B,WRDRLC
POPJ P,
ABLKG: TRNE LINK,400000 ;GLOBAL BLOCK, IS OFFSET GLOBAL?
JRST ABLKG2 ;YES, OK TO REFERENCE $L.
PUSHJ P,SBWDOF ;NO, FOR COMPATIBILITY, DON'T REFERENCE $L.
SKIPA T,[HFWDF,,$.H]
ABLKG2: MOVE T,[HFWDF,,$L.H]
PTEQ2: AOS GLSP1 ;STORE T IN GLOTB
MOVEM T,@GLSP1
ALOC2: TLO LINK,400000 ;SET GLOBAL LOCATION FLAG
MOVEI A,LCGLO ;=> GLOBAL LOCATION ASSIGNMENT
PUSHJ P,PLDCM ;PUNCH OUT GLOBAL LOCATION ASSIGNMENT
SETZM CLOC ;CLEAR OUT CLOC, NEW RELOCATION NOW
SETZB B,BKBUF ;ALSO CLEAR OUT HEADER, JUST TO BE SURE
AOJA B,ALOC2B ;SET RELOCATION TO 1 AND FALL IN
AOFFSET: PUSHJ P,AOFFS2 ;OFFSET, GET ARG
MOVE A,T
MOVEM A,WRD ;RESTORE UNTRUNCATED ARG.
TRZE LINK,400 ;GLOBALS IN ARG?
TROA LINK,400000 ;GLOBALS IN ARG, SET GLOBAL OFFSET FLAG
TRZ LINK,400000 ;NO GLOBALS IN ARG
MOVEM A,OFLOC ;STORE NEW OFFSET
MOVEM B,OFRLOC ;ALSO STORE RELOCATION BITS
SKIPGE CONTRL ;IN RELOCATABLE,
JRST AOFSTX
MOVEI A,LDOFS ;LOADER OFFSET LOADER COMMAND TYPE
PUSHJ P,PLDCM ;PUNCH OUT LOADER COMMAND
JRST AOFSTX
;GET ARG TO LOC, BLOCK, .=, OFFSET
ALOCRG:
ABLKRG: MOVE A,CLOC
SKIPN CRLOC
JRST [ CAML A,DECBRA ;IF ADDR BEFORE THE LOC WAS ABS,
MOVEM A,DECBRA ;UPDATE HIGHEST ABS ADDR IF NEC.
JRST ABLKR1]
CAML A,DECTWO ;IT WAS RELOCA; UPDATE HIGHEST
JRST [ CAML A,DECBRH ;ADDR OF APPROPRIATE SEG.
MOVEM A,DECBRH
JRST ABLKR1]
CAML A,DECBRK
MOVEM A,DECBRK
AOFFS2:
ABLKR1: PUSH P,SYM
PUSHJ P,CONBAD ;ERROR IF IN GROUPING
REST SYM
TRNE I,IRNOEQ\IRPSUD\IREQL
ETSM [ASCIZ /Inside pseudo or =/]
TDNE I,[ILWORD,,IRFLD]
ETSM ERRNVL
PUSHJ P,EBLK ;MAYBE END CURRENT OUTPUT BLOCK
PUSHJ P,AGETWD ;GET ARG
MOVE LINK,GLOCTP ;GET GLOCTP FLAGS IN LINK, STAYS THERE UNTIL ALMOST DONE
MOVE T,GLSP2
CAME T,GLSP1
TROA LINK,400 ;SIGNAL GLOBAL ARG
TRZ LINK,400 ;LOCAL
MOVE T,A ;SAVE UNTRUNCATED FOR AOFFSET,
HRRZS A,WRD ;TRUNCATE FOR LOC, BLOCK, .=.
TRNN I,IRDEF ;ALL DEFINED?
JRST ASSEM1
SKIPGE CONTRL ;YES, RETURN SKIPPING OVER ARG
TRNN LINK,400
RET
MOVE SYM,GTVER
ETASM [ASCIZ *Argument has externals*]
;;CONSTANTS AND VARIABLES
;VARIABLES AREA
VBLK
LCNGLO==CONMIN/4
LCONTB==CONMIN
BLCODE [
PCNTB: BLOCK NCONS*3 ;CONSTANTS AREAS TABLE
VARTAB: BLOCK NVARS
]
CONTBA: CONTAB ;ADDRESS OF BEGINNING OF CONSTANTS TABLE.
CONTBE: CONTAB+LCONTB ;ADDRESS OF WORD AFTER END OF CONSTANTS TABLE.
PLIM: 0 ;POINTER TO FIRST UNUSED WORD IN CONSTANTS TABLE.
CONGLA: CONGLO ;ADDRESS OF BEGINNING OF CONSTANT-GLOBALS TABLE.
CONGLE: CONGLO+LCNGLO ;ADDRESS OF WORD AFTER END OF CONSTANT GLOBALS TABLE.
CONGOL: 0 ;HAS ADR OF FIRST WORD INACTIVE IN CONSTANT-GLOBALS TABLE.
CONBIA: CONBIT ;ADDRESS OF BEGINNING OF CONSTANT-RELOCATION-BITS TABLE.
CONLEN: CONMIN ;TOTAL SPACE ALLOCATED TO CONSTANTS TABLES.
;ALL THE HOOKS ARE IN FOR DYNAMIC ALLOCATION OF THESE TABLES
;(CONTAB, CONGLO, AND CONBIT). ALL THAT IS NEEDED IS TO GET
;THE SPACE AND INITIALIZE CONTBA, CONTBE, CONGLA, CONGLE, CONBIA.
;PCNTB STUFF
;EACH ENTRY 3 WORDS; FIRST WORD SQUOZE, NAME OF AREA IF GLOBAL
CSQZ: 0 ;SQUOZE COUNTER
;SECOND WORD RH LOC OF AREA (WITH OFFSET), LH LOC FIRST AFTER AREA (WITHOUT OFFSET)
;THIRD WORD LH FLAGS
CGBAL==100000 ;GLOBAL (INCLUDING OFFSET)
CTRL==200000 ;RELOCATED ( " )
CTDEF==400000 ;DEFINED (MUST BE SIGN)
PBCON: 0 ;POINTER INTO PCNTB, HAS ADR OF ENTRY FOR NEXT CONSTA
PBCONL: 0 ;POINTER TO ABSOLUTE TOP OF PCNTB
CONCNT: 0 ;NUMBER OF TIMES CONSTANTS CAN APPEAR (DECREMENTED BY CONSTA)
CONDEP: 0 ;DEPTH IN CONSTANTS (0 TOP LEVEL)
CONSAD: 0 ;ADDR IN CONSTANTS TABLE OF ENTRY FOR CURRENT CONST.
CONSML: 0 ;VALUE OF .MLLIT INTSYM.
;NEGATIVE => ERROR MODE (DEFAULT)
;ZERO => OLD MODE.
;POSITIVE => NEW (MULTI-LINE) MODE.
CONSTP: 0 ;PDL POINTER BELOW WDS FOR INNERMOST CONSTANT.
CONSP1: 0
;VARIABLES FOR VARIABLES CODING
VARCNT: 0 ;NO OF VAR IN CURRENT VAR AREA SO FAR
VARPNT: 0 ;POINTER TO CURRENT PLACE IN VARTAB
VARCNR: 0 ;NO OF TIMES VARIABLES MAY APPEAR
VCLOC: 0 ;TEM FOR VARIAB
VECSIZ: 0 ;DEFAULT SIZE FOR .VECTOR.
PBLK
;LEFT-BRACKET ENCOUNTERED; HERE ON DISPATCH FROM GETFD
;SAVE WORLD, BYTE MODE, ASSEM1 PDL LEVELS.
;THEN SET ASSEM1 PDL LEVELS TO CURRENT LEVELS
;SO ASSEM1 WON'T FLUSH PAST LEVEL OF CONSTANT.
;SET CONSTP _ CURRENT PDL LEVEL. PCONS WILL PUT WORDS
;OF CONSTANT ABOVE CONSTP, AND SET ASSEMP ABOVE THEM.
LBRAK: SKIPE LITSW
ETR [ASCIZ /Literal/]
TRO I,IRFLD ;LEFT BRACKET
JSP LINK,SAVWD1 ;SAVE CRUFT
PUSH P,SCNDEP ;SO THE NEXT RBRKT WON'T TRY TO CLOSE CONDIT.
JSP LINK,SAVAS1
MOVEIM ASMOUT,3
SETZM SCNDEP ;NOT WITHIN CONDITIONALS IN THIS LITERAL.
AOS CONDEP ;ONE DEEPER IN LITERALS.
JRST ASSEM3 ;GO ASSEMBLE THE WORDS OF THE CONSTANT.
;OUTPUT WORD TO CONSTANT. P MUST EQUAL ASSEMP HERE.
PCONS: SKIPL CONTRL ;IF RELOCATABLE,
PUSHJ P,$RSET ;HANDLE STRANGE RELOCATIONS.
MOVE B,GLSP1
SUB B,GLSP2 ;NUM. GLOBAL ENTRIES FOR THIS WD.
HLRZ A,WRDRLC ;ONLY 1.1 AND 3.1 BITS MATTER.
LSH A,1
IOR A,WRDRLC ;GET THEM INTO 1.1, 1.2 BITS.
TLNE I,ILNOPT ;REMEMBER ILNOPT ALSO.
IORI A,4
DPB B,[032200,,A] ;AND # GLBLS.
PUSH P,A ;SAVE THEM ALL.
HRLI B,(B) ;GET # GLBLS,,# GLBLS .
JUMPE B,PCONS1
MOVE A,GLSP2
MOVSI A,1(A)
HRRI A,1(P) ;SAVE THE GLBLS, IF ANY.
ADD P,B
JUMPGE P,CONFLP
BLT A,(P)
PCONS1: PUSH P,WRD
MOVEM P,ASSEMP ;ASSEMP -> ABOVE WDS FOR LIT.; CONSTP, BELOW.
JRST (T)
;JSP LINK,SAVAS1 TO PUSH DATA ON ASSEM1 LEVEL AND CALL ASSEM1
;LOOP RECURSIVELY.
.SEE CONNDP ;WHICH IS WHERE THESE THINGS ARE POPPED.
SAVAS1: SKIPN BYTM ;IF IN BYTM NOW (WILL PUSH AND TURN OFF)
JRST LBRAK1
MOVSI A,BYBYT ;SAVE ALL THE DETAILS.
HRRI A,1(P)
ADD P,[LBYBYT+BYTMCL,,LBYBYT+BYTMCL]
JUMPGE P,CONFLP ;(SOFTWARE-DETECTED PDL-OV)
BLT A,-BYTMCL(P)
MOVSI A,BYTMC
HRRI A,1-BYTMCL(P)
BLT A,(P)
LBRAK1: PUSH P,BYTM
SETZM BYTM
PUSH P,ASMOUT
PUSH P,ASMDSP
PUSH P,ASMI
PUSH P,GLSPAS ;SAVE ASSEM1 PDL LEVELS.
PUSH P,ASSEMP
PUSH P,CONSTP
MOVE A,I
ANDI A,IRPSUD+IREQL
IORI A,IRDEF
MOVEM A,ASMI ;ASMI IOR'D INTO I AT ASSEM2 LOOP.
HRRZ A,CPGN
HRL A,CLNN ;REMEMBER WHERE THIS LITERAL STARTS.
INSIRP PUSH P,[A SYSYM SYLOC]
MOVEM P,ASSEMP ;SO ASSEM1 WON'T FLUSH WHAT WE PUSHED.
MOVEM P,CONSTP ;SO CONND CAN FIND 1ST WD OF CONSTANT.
MOVEMM GLSPAS,GLSP1
SAVAS2: MOVEI A,ASSEM3 ;IF NOT MULTI-LINE MODE, ARRANGE TO
SKIPG CONSML ;END THE CONSTANT AFTER 1 WORD.
MOVEI A,ASSEMC
MOVEM A,ASMDSP
JRST (LINK)
PCONST: MOVE CH1,ASMDSP ;OUTPUT TO CONST. FROM ASSEM1
CAIN CH1,CONND ;LAST WD OF CONST?
CAME P,CONSTP ;1ST WD?
JRST PCONS ;NO, DO THE GENERAL THING.
SKIPL CONTRL ;THIS MUST BE ONLY WORD OF CONST,
PUSHJ P,$RSET ;DON'T BOTHER PUSHING, END CONST. NOW.
PUSH P,CONSTP
TLZ I,ILMWRD+ILMWR1 ;THIS IS 1ST WD, NO MORE WDS.
JRST CONND3 ;PRETEND JUST POPPED IT.
;COME HERE FROM ASSEM1 TO END A CONSTANT.
CONND: SKIPE BYTM ;IF IN BYTE MODE, LEAVE IT AND DO .WALGN
JRST A.BY3 ;(WILL COME BACK SINCE ASMDSP STILL SET)
CONNDW: MOVEMM CONSP1,CONSTP
TLZ I,ILMWR1 ;THIS IS 1ST WORD COMING UP.
CONND0: TLZ I,ILMWRD+ILNOPT
SETZM WRDRLC
MOVE F,CONSP1 ;ADDR IN IN PDL OF NEXT WD.
CAMN F,ASSEMP
JRST CONND2 ;J IF NO WORDS.
MOVE A,1(F) ;GET SAVED NUM GLBLS,,NUM GLBLS
DPB A,[100,,WRDRLC]
LSH A,-1 ;RESTORE WRDRLC BITS 1.1, 3.1
DPB A,[220100,,WRDRLC]
TRNE A,2
TLO I,ILNOPT ;RESTORE NOOPTF.
LSH A,-2 ;GET # GLBLS.
HRLI A,(A) ;# GLBLS,,# GLBLS.
AOBJN F,.+1
HRRZM F,GLSP2 ;ADDR BEFORE 1ST GLOBAL ENTRY.
ADD F,A
HRRZM F,GLSP1 ;ADDR OF LAST GLOBAL ENTRY.
MOVE A,1(F)
MOVEM A,WRD
AOBJN F,.+1 ;POINT TO NEXT CONST WD IF ANY,
MOVEM F,CONSP1
CAME F,ASSEMP ;IF MORE WORDS SET ILMWRD
TLO I,ILMWRD
JRST CONND3
CONND2: INSIRP SETZM,[WRD,GLSP1,GLSP2]
CONND3: MOVE F,GLSP1
SUB F,GLSP2
JUMPE F,SCON ;JUMP IF NOTHING VIRTUAL
MOVEI B,-1(F)
MOVN TT,B
JUMPE B,SCON ;JUMP IF ONLY ONE GLOBAL
;SORT GLOTB ENTRIES THIS CONSTANT
LSORT: HRL T,TT ;SET UP AOBJN POINTER TO GLOBALS REMAINING
HRR T,GLSP2
LSORT2: MOVE A,1(T)
CAMLE A,2(T)
EXCH A,2(T) ;INTERCHANGE
MOVEM A,1(T)
AOBJN T,LSORT2 ;INNER LOOP POINT
SOJG B,LSORT ;OUTER LOOP
;DROPS THROUGH
;DROPS THROUGH
SCON: PUSHJ P,RCHKT
PUSHJ P,RMOVET ;SET UP RELOACTION BITS.
ROT T,2 ;ROTATE TO BOTTOM TWO BITS OF T
TLNE I,ILMWRD+ILMWR1+ILNOPT
JRST NOCON ;MULTIPLE WORD OR OPTIMIZATION SUPPRESSED, DON'T TRY TO FIND MATCH
MOVE A,CONTBA
SCON1: CAML A,PLIM ;SEARCH CONSTANTS TABLE TO SEE IF ALREADY THERE
JRST NOCON ;END OF TABLE, NO MATCH
MOVE B,WRD
CAME B,(A)
SCON2: AOJA A,SCON1 ;VAL DISAGREES
PUSHJ P,CPTMK ;GET BP TO CONSTANTS-BIT TABLE IN C
LDB F,C ;GET RELOCATION BITS THIS CONSTANT
CAME F,T
JRST SCON2 ;RLC DIFFRS
MOVE B,CONGLA ;VALUE AND RELOCATION AGREE, NOW TO CHECK GLOBALS
SKIPA C,GLSP2
SCON2B: AOS B ;SEARCH FOR GLOBAL POINTING TO CONSTANT WHICH HAS MATCHED SO FAR
CAML B,CONGOL
JRST SCON3 ;GLOBALS MATCH SO FAR
CAME A,1(B) ;SKIP IF ONE FOUND
SCON7: AOJA B,SCON2B ;NOT YET
MOVE D,(B) ;FOUND ONE, GET GLOTB ENTRY
CAME D,1(C) ;COMPARE WITH THIS ENTRY IN GLOTB
JRST SCON2 ;NO MATCH, FLUSH THIS CONSTANT
AOJA C,SCON7 ;MATCH, TRY NEXT GLOBAL
SCON3: CAME C,GLSP1 ;GLOBALS MATCH, BUT ARE WE EXACTLY AT END OF GLOTB?
JRST SCON2 ;NO, BACK TO SEARCH
JRST NOCON4
NOCON: AOS A,PLIM ;CONSTANT NOT ALREADY IN TABLE
CAMLE A,CONTBE
ETF [ASCIZ/Literal table full/]
MOVE AA,WRD
MOVEM AA,-1(A)
SOS A
PUSHJ P,CPTMK
TLNE I,ILNOPT
TRO T,4 ;1.3 OF RELOCATION BITS => DON'T OPTIMIZE ON TOP OF ME
DPB T,C
MOVE B,GLSP2
NOCON3: CAML B,GLSP1
JRST NOCON4
SKIPN C,1(B)
AOJA B,NOCON3 ;THIS ENTRY NOT REALLY HERE
MOVEM C,@CONGOL
HRRZS C
PUSHJ P,NOCON5
MOVEM A,@CONGOL
PUSHJ P,NOCON5
SKPST C, ;SKIP IF IN SYMBOL TABLE
AOJA B,NOCON3
3GET1 D,C ;IN SYMBOL TABLE
TLO D,3VCNT ;THIS SYM USED IN CONSTANT
3PUT1 D,C ;UPDATE 3RDWRD TABLE ENTRY
AOJA B,NOCON3
NOCON5: AOS AA,CONGOL
CAML AA,CONGLE
ETF [ASCIZ/Constants-global table full/]
POPJ P,
;SET UP BYTE POINTER TO CONSTANTS-BIT TABLE
;A SHOULD HAVE ADR OF CONSTANTS TABLE ENTRY
;LEAVES ANSWER IN C
;BITS IN CONSTANTS-BIT TABLE PER ENTRY:
;1.2, 1.1 RELOCATION BITS
;1.3 ILNOPT BIT => DON'T OPTIMIZE ON TOP OF ME
CPTMK: PUSH P,A
SUB A,CONTBA
PUSH P,B
IDIVI A,12.
MOVEI C,(A)
ADD C,CONBIA ;SET UP ADDRESS PART
IMULI B,3
DPB B,[360600,,C] ;STORE POSITION FIELD FROM REMAINDER
TLO C,200 ;SET UP SIZE FIELD
POPBAJ: POP P,B
JRST POPAJ
NOCON4: TLON I,ILMWR1
MOVEM A,CONSAD ;IF 1ST WD SAVE ADDR.
TLNE I,ILMWRD ;IF MORE WORDS, HANDLE NEXT.
JRST CONND0
MOVE P,CONSTP ;VALUE OF CONSTP AT CONND.
MOVE C,GLSPAS ;TO RESTORE GLSP1
JSP T,CONNDP ;POP STUFF.
HRRZ A,CONSAD ;ADDR OF CONSTANTS TABLE ENTRY OF 1ST WD.
MOVE B,PBCON ;ADDR OF WDS DESCRIBING CONST. AREA.
SKIPL 2(B) ;CONST. AREA LOCATION DEFINITE?
AOJA C,CONND6 ;NO, USE GLOBAL.
MOVEM C,GLSP1
HRRZ C,1(B) ;ADD ACTUAL ADDR OF CONST. AREA.
ADDI A,(C) ;GET C(CONTBA) + ADDR OF CONSTANT.
LDB B,[420100,,2(B)]
JRST CONND7
CONND6: MOVEM C,GLSP1
MOVEM B,(C)
MOVEI B,0
CONND7: SUB A,CONTBA
JRST LSSTH3 ;POP OUT INTO OUTER WORD.
.SEE SAVAS1 ;WHICH IS WHAT PUSHES WHAT CONNDP POPS.
CONNDP: SUB P,[3,,3] ;FLUSH SAVED SYLOC AND SYSYM AND CLNN,,CPGN.
CONFL2: HRL T,ASMOUT ;REMEMBER IF POPPING A LITERAL OR NOT.
INSIRP POP P,[CONSTP,ASSEMP,GLSPAS,ASMI,ASMDSP,ASMOUT,BYTM]
SKIPN BYTM ;IF IN BYTE MODE, POP DETAILS.
JRST CONND5
MOVSI A,1-BYTMCL(P)
HRRI A,BYTMC
BLT A,BYTMC+BYTMCL-1
MOVSI A,1-BYTMCL-LBYBYT(P)
HRRI A,BYBYT
BLT A,BYBYT+LBYBYT-1
SUB P,[LBYBYT+BYTMCL,,LBYBYT+BYTMCL]
CONND5: HLRZ A,T
CAIE A,3
JRST (T)
POP P,A
ADDM A,SCNDEP ;DON'T FORGET ABOUT ANY CONDITIONALS.
SOS CONDEP ;HAVE POPPED ONE CONSTANT.
JRST (T)
CONFLS: MOVE P,ASSEMP ;FLUSH ALL CONSTANTS.
CAMN P,[-LPDL,,PDL] ;IF IN ANY,
JRST (LINK)
MOVE P,CONSTP ;POINT AFTER ITS PDL ENTRY,
JSP T,CONNDP ;POP IT,
JRST CONFLS ;TRY AGAIN.
CONBAD: SKIPN ASMOUT ;IF IN GROUPING, ERROR.
POPJ P,
ETSM [ASCIZ/Within <>, () or []/]
JRST ASSEM1
;COME HERE FOR PDL-OV ON P.
;IF IN A CONSTANT, FLUSH ALL OF THEM, SAYING WHERE EACH STARTED.
;THEN TYPE A PDL ERROR MSG AND RETURN TO ASSEM1.
;OTHERWISE FATAL ERROR.
CONFLP: MOVEI LINK,ASSEM1
MOVEI CH1,ERRPDL
SKIPE CONDEP
JRST CONFL3 ;IN A CONSTANT.
MOVEI P,PDL ;RE-INIT PDL SO NO MORE PDL-OV.
ETF ERRPDL
ERRPDL: ASCIZ /PDL overflow/
;JSP LINK,CONFLM TO FLUSH CONSTANTS, SAYING WHERE THEYY STARTED,
;AND GIVE ERROR MSG.
CONFLM: MOVE CH1,ASMOUT
SKIPA CH1,ASMOT3(CH1)
CONFLZ: SETZ CH1, ;LIKE CONFLM BUT NO ERR MSG AT END.
CONFL3: SETO C,
CONFL1: MOVE P,CONSTP ;GET STACK ABOVE INNERMOST LITERAL.
REST SYLOC
REST SYSYM
REST D ;GET INFO ON WHERE STARTED
AOSN C ;THE 1ST TIME ONLY, SAY WHAT'S GOING ON.
TYPR [ASCIZ/Within groupings: /]
SKIPE C
TYPR [ASCIZ/, /]
MOVE A,ASMOUT ;SAY WHAT KIND OF GROUPING IS BEING CLOSED
MOVE A,ASMOT5(A)
CALL TYOERR ;BY SAYING WHAT CHAR OPENED IT.
JSP T,CONFL2 ;POP REST OF WDS SAVED AT LBRAK.
TYPR [ASCIZ/ at /]
MOVEI A,1(D) ;PAGE # GROUPING STARTED ON.
CALL DPNT ;PRINT IN DECIMAL.
MOVEI A,"-
CALL TYOERR
HLRZ A,D ;LINE NUMBER IT STARTED ON.
ADDI A,1
CALL D3PNT2 ;PRINT W/ AT LEAST 3 CHARS, NO ZERO SUPPR.
MOVE A,ASSEMP
CAME A,[-LPDL,,PDL] ;MORE GROUPINGS TO POP => DO.
JRST CONFL1
CALL CRRERR
MOVE P,ASSEMP
JUMPE CH1,(LINK) ;IF CALLED CONFLZ, NO ERR MSG (CALLER WILL GIVE ONE)
ETR (CH1) ;[ NO] OR PDL.
CALL CRRERR
JRST (LINK)
;CONSTA
CNSTNT: NOVAL
SKIPE ASMOUT ;IF ANY GROUPNGS,
JSP LINK,CONFLM ;FLUSH THEM, GIVE ERROR.
PUSHJ P,CNSTN0
JRST ASSEM1
CNSTN0: SOSGE CONCNT ;ENTRY FROM AEND
ETF [ASCIZ /Too many constants areas/]
MOVE B,CLOC
ADD B,OFLOC
HRRZ T,PBCON
TRNN FF,FRPSS2
JRST CNST1 ;PASS 1
MOVSI A,CGBAL
TDZ A,2(T)
TRNE FF,FRGLOL
TLC A,CGBAL
SKIPN A
ETR [ASCIZ /Constants globality phase error/]
HRRZ B,1(T)
SUB B,OFLOC
HRRZS B
CAME B,CLOC
ETR [ASCIZ /Constants location phase error/]
MOVE B,2(T)
ROT B,2
XOR B,CRLOC
XOR B,OFRLOC
TRNE B,1
ETR [ASCIZ /Constants relocation phase error/]
;DROPS THROUGH
;DROPS THROUGH
CNST2: MOVEI D,(T) ;STE IDX IN D FOR OUTSM0
MOVE SYM,(T) ;GET NAME OF AREA
TLC SYM,400000#LCUDF ;CLEAR LCUDF, SET HALF-KILL
TRNE FF,FRGLOL
PUSHJ P,PDEFPT ;DEFINE SYM FOR BEGINNING OF CONSTANTS AREA
MOVE A,CONTBA
CNSTH: CAML A,PLIM
JRST CNSTA ;THRU
MOVE TT,(A)
MOVEM TT,WRD
PUSHJ P,CPTMK
LDB F,C ;GET THIS CONSTANT'S RELOCATION BITS
TRZE F,2
TLO F,1 ;RELOCATE LEFT HALF
MOVEM F,WRDRLC ;STORE RELOCATION
MOVEI D,GLOTB ;AND NOW TO SET UP GLOTB!
MOVEM D,GLSP2
MOVE C,CONGLA
CNSTC: CAML C,CONGOL
JRST CNSTB ;END OF CONSTANT-GLOBAL TABLE
CAMN A,1(C) ;POINTS TO THIS CONSTANT?
PUSH D,(C) ;YES, STORE ENTRY IN GLOTB
AOS C
AOJA C,CNSTC
CNSTB: HRRZM D,GLSP1 ;MARK END OF ACTIVE PART OF GLOTB
PUSH P,A
PUSHJ P,PWRD ;OUTPUT THIS CONSTANT
AOS CLOC ;INCREMENT CLOC TO NEXT
HRRZS CLOC ;MAKE SURE IT STAYS IN A HALF-WORD (IMPORTANT SINCE MAY BE LESS THAN RELOCATION)
POP P,A ;RESTORE POINTER INTO CONSTANTS TABLE
AOJA A,CNSTH
CNST3: HLRZ A,1(T) ;GET POINTER TO TOP OF AREA STORED DURING PASS 1
CAMN A,CLOC ;SAME AS CURRENT?
JRST CNSTE ;YES, NO HAIR
CAMGE A,CLOC ;DIFFERENT; LOWER?
ETR [ASCIZ /More constants on pass 2 than 1/]
;INSUFFICIENT CONSTANT SPACE; CONSTANTS AREA TRYING TO BE BIGGER
;IN PASS 2 THAN PASS 1; THE EXTRA CONSTANTS WERE BACKED OVER
MOVEM A,CLOC ;EITHER WAY, SET CLOC TO TOP OF AREA SO WON'T HAVE MDT TROUBLE
PUSHJ P,EBLK ;END CURRENT BLOCK
CALL SLOCF ;IF RELOCATABLE, MAKE SURE NEW VALUE OF $. GETS PUNCHED
JRST CNSTE
;CALL SLOCF WHENEVER "." IS CHANGED WITHOUT THE OUTPUTTING OF A STORAGE WORD.
SLOCF: MOVE A,CLOC ;STORE NEW "." IN HEADER FOR NEXT BLOCK OF OUTPUT.
SKIPGE TM,CONTRL
TRNN TM,DECREL+FASL ;BUT NOT IN DEC OR FASL OUTPUT FORMATS.
HRRM A,BKBUF
IORI FF,FRLOC ;MAKE SURE NULL BLOCK IS OUTPUT IF NEC. TO TELL LOADER "." HAS CHANGED.
RET
;CONSTA DURING PASS 1
CNST1: HRRM B,1(T) ;STORE LOCATION OF AREA
MOVEI D,0
MOVE A,CRLOC
ADD A,OFRLOC
TRNE A,1
TLO D,CTRL ;RELOCATED
TRNE FF,FRGLOL
TLO D,CGBAL ;GLOBAL
IORM D,2(T) ;STORE FLAGS DESCRIBING AREA
JUMPL FF,CNST2 ;JUMP ON PUNCHING PASS, PUNCH OUT AREA NOW
MOVE T,PLIM
SUB T,CONTBA
ADDM T,CLOC ;PASS 1, JUST UPDATE CLOC
HRRZS CLOC
CNSTA: HRRZ T,PBCON
TRNE FF,FRGLOL
JRST CNSTD ;LOCATION GLOBAL
TRNN FF,FRNPSS
SKIPGE 2(T)
JRST CNSTDA ;2 PASS ASSEMBLY OR AREA DEFINED
TRO I,IRCONT ;1PASS AND NOT DEFINED
SETZM PARBIT
PUSHJ P,P70 ;DEFINE SYM
MOVE A,(T)
TLC A,400000#LCUDF
SKIPE CRLOC
TLO A,100000 ;RELOCATE
PUSHJ P,$OUTPT
HRRZ A,1(T)
PUSHJ P,$OUTPT ;OUTPUT VALUE, FIRST LOCATION IN AREA
TRZ I,IRCONT
CNSTDA: MOVSI A,CTDEF
IORM A,2(T) ;CALL IT DEFINED
CNSTD: TRNE FF,FRPSS2
JRST CNST3 ;PASS 2
MOVE A,CLOC
HRLM A,1(T) ;MARK END OF AREA
CNSTE: MOVE A,CONTBA
MOVEM A,PLIM
MOVE A,CONGLA
MOVEM A,CONGOL
MOVEI T,3
ADDB T,PBCON
CAML T,PBCONL
MOVEM T,PBCONL
AOS A,CSQZ
MOVEM A,(T)
POPJ P,
;DEFINING SYM USED IN CONSTANT, DELETE REFERENCES FROM CONSTANT-GLOBAL TABLE
CONBUG: MOVE A,CONGLA ;B VAL C FLAGS ST(D) SADR
PUSH P,T
PUSH P,C ;SAVE FLAGS
CONBG2: MOVE C,(P) ;GET FLAGS
CAML A,CONGOL ;DONE WITH SCAN?
JRST CONBG1 ;YES
HRRZ F,(A) ;NO, GET CONSTANT-GLOBAL TABLE ENTRY
CAIE F,ST(D) ;POINT TO THIS SYM?
AOJA A,CONBG6
PUSH P,B ;YES, SAVE VALUE, ABOUT TO WORK WITH B
MOVE T,(A) ;GET ENTIRE CONSTANT-GLOBAL TABLE ENTRY
LDB CH2,[221200,,T] ;GET MULTIPLICATION FIELD
SKIPE CH2
IMUL B,CH2 ;NON-ZERO => MULTIPLY VALUE OF SYM
TLNE T,MINF
MOVNS B ;NEGATE VALUE
TLNE T,HFWDF
HRRZS B ;TRUNCATE TO HALFWORD
TLNE T,ACF
ANDI B,17 ;AC, MASK TO FOUR BITS
TLNE T,SWAPF
MOVSS B ;SWAP VALUE
TLNE T,ACF
LSH B,5 ;AC, SHIFT FIVE
ADD B,@1(A) ;ADD ABS PART OF VALUE
TLNN T,SWAPF
HRRM B,@1(A) ;NOT SWAPPED, STORE LH
TLNE T,SWAPF
HLLM B,@1(A) ;SWAPPED, STORE LH
TLNN T,HFWDF
MOVEM B,@1(A) ;FULL WORD, STORE VALUE
LDB CH1,[420200+P,,-1] ;GET HIGH BITS OF 3RDWRD, RELOCATION BITS
TLNE T,HFWDF ;NOW TO MAP RELOCATION BITS
TRZ CH1,2
TLNE T,SWAPF
LSH CH1,1
TRZE CH1,4
TRO CH1,1
PUSH P,A
HRRZ A,1(A) ;GET POINTER INTO CONSTANTS TABLE
PUSHJ P,CPTMK
LDB B,C ;GET RELOCATION BITS
TLNE T,MINF
JRST CONBG8 ;NEGATE
TRNE B,(CH1)
ETA ERRCRI
;ATTEMPTED MULTIPLE RELOCATION IN CONSTANT
; ^ ABOVE SHOULD BE REPLACED WITH A $RSET LIKE ROUTINE
;THAT ALSO SEARCHES CONSTANT-GLOBAL TABLE FOR $R. ALREADY THERE
IOR B,CH1 ;LOOKS OK, IOR IN BITS FOR GLOBAL
CONB8A: DPB B,C ;STORE BACK NEW RELOCATION BITS FOR CONSTANT
POP P,A
CLEARM (A) ;CLEAR OUT CONSTANT-GLOBAL TABLE ENTRY
CLEARM 1(A)
POP P,B
AOS A
CONBG6: AOJA A,CONBG2 ;BACK FOR NEXT CONSTANT, DON'T KNOW HOW MANY THIS SYM USED IN
CONBG1: MOVE A,CONGLA
PUSH P,B
MOVE B,CONGLA
CONBG7: CAML A,CONGOL
JRST CONBG3
SKIPN C,(A)
CONBG5: AOJA A,CONBG4
MOVEM C,(B)
MOVE C,1(A)
MOVEM C,1(B)
AOS B
AOJA B,CONBG5
CONBG4: AOJA A,CONBG7
CONBG3: MOVEM B,CONGOL
POP P,B
POP P,C
POP P,T
POPJ P,
CONBG8: XORI B,3
TRNE B,(CH1)
ETA ERRCRI
ANDCB B,CH1
JRST CONB8A
ERRCRI: ASCIZ /Multiple relocation in constant/
;VARIAB
AVARIAB: NOVAL
SKIPE ASMOUT ;FLUSH ANY GROUPINGS IN PROGRESS.
JSP LINK,CONFLM
PUSHJ P,AVARI0
JRST ASSEM1
AVARI0: SOSG VARCNR ;ENTRY FROM AEND
ETF [ASCIZ /Too many variable areas/]
MOVE D,SYMAOB ;SET UP AOBJN POINTER TO ST
MOVE T,CLOC
MOVEM T,VCLOC ;STORE AS LOCATION OF VARIABLE AREA
ADD T,OFLOC
MOVE C,CRLOC
ADD C,OFRLOC
TRNE FF,FRPSS2
JRST AVAR1 ;PASS 2
HRL T,VARCNT ;SIZE OF AREA
TRNE C,1
TLO T,400000 ;RELOCATED
MOVEM T,@VARPNT
JRST AVAR2E
AVAR1: HRRZ A,@VARPNT ;VARIAB DURING PASS 2
CAIE A,(T)
ETR [ASCIZ /Variables location phase error/]
HLRZ A,@VARPNT
TRZE A,400000
XORI C,1
TRNE C,1
ETR [ASCIZ /Variables relocation phase error/]
SKIPE VARCNT
ETR [ASCIZ /Variables area size phase error/]
AVAR2E: HLRZ T,@VARPNT
TRNN T,377777
JRST AVAR2C ;IF THIS VAR AREA IS EMPTY, DON'T SCAN SYMTAB.
AVAR2: HLRZ LINK,ST(D) ;SCAN, CHECKING EACH SYM FOR WHETHER IT'S A VARIABLE
CAIL LINK,DEFLVR
JRST AVAR2B
ADD D,WPSTE1
AOBJN D,AVAR2
JRST AVAR2C ;ALL SCANNED.
AVAR2B: 3GET C,D ;FOUND A VARIABLE; DECIDE WHAT TO DO WITH IT.
MOVE B,ST+1(D)
MOVE SYM,ST(D)
TLZ SYM,740000
LDB LINK,[400400,,ST(D)]
CAIE LINK,UDEFLV_-14.
CAIN LINK,UDEFGV_-14.
JRST AVAR3 ;UNDEFINED VARIABLE
CAIE LINK,DEFGVR_-14.
CAIN LINK,DEFLVR_-14.
JRST AVAR4 ;DEFINED VARIABLE
AVAR2A: ADD D,WPSTE1
AOBJN D,AVAR2 ;CHECK ENTIRE SYMTAB
AVAR2C: HLRZ A,@VARPNT ;NOW GET SIZE OF AREA
TRZ A,400000 ;CLEAR OUT RELOCATION CHECK BIT
IFN FASLP,[
MOVE D,CONTRL
TRNE D,FASL ;IN FASL ASSEMBLY, CAN'T JUST SET LOC CTR; MUST OUTPUT 0'S.
CALL ABLKF
]
ADD A,VCLOC ;ADD LOCATION OF BEGINNING OF VARIABLE AREA
MOVEM A,CLOC ;STORE AS NEW CURRENT LOCATION
PUSHJ P,EBLK
CALL SLOCF
CLEARM VARCNT ;INITIALIZE COUNT OF VARIABLES IN NEXT AREA
AOS VARPNT ;INCREMENT POINTER TO POINT TO NEXT AREA
POPJ P,
;UNDEFINED VARIABLE FOUND IN SYMTAB SCAN
AVAR3: CAIN LINK,UDEFGV_-14. ;GLOBAL?
TLO SYM,40000 ;GLOBAL
PUSHJ P,LKPNRO
MOVSI T,DEFLVR
CAIN LINK,UDEFGV_-14.
MOVSI T,DEFGVR
TRNE FF,FRGLOL
JRST AVAR3A ;LOCATION GLOBAL
MOVEI B,-1(B)
ADD B,VCLOC
ADD B,OFLOC
MOVE TT,CRLOC
ADD TT,OFRLOC
SKIPE TT
TLO C,3RLR
CAIE LINK,UDEFGV_-14.
TLZN C,3VCNT
SKIPA
PUSHJ P,CONBUG
AVAR4B: PUSHJ P,VSM2
JUMPGE FF,AVAR2A ;IF PUNCHING PASS, OUTPUT DEFINITION.
PUSHJ P,OUTDE2
JRST AVAR2A
AVAR4: TLNE C,3VAS2 ;DEFINED VARIABLE FOUND DURING SYMTAB SCAN
TLOE C,3VP
JRST AVAR2A
MOVSI T,(LINK) ;CAUSE AVAR4B TO REDEFINE AS SAME TYPE.
LSH T,14.
TRNN FF,FRGLOL
JRST AVAR4A
AVAR3A: PUSHJ P,VSM2LV
JUMPGE FF,AVAR2A
PUSHJ P,PDEFPT
MOVEI A,0
PUSHJ P,PBITS
PUSHJ P,$OUTPT
AOS CLOC
JRST AVAR2A
AVAR4A: CAIN LINK,DEFGVR_-14. ;DEF VAR, 3VAS2, POINT NOT GLOBAL.
JRST AVAR4B ;VAR GLOBAL, MUST PUNCH DEF SINCE DIDN'T ON PASS1.
3PUT C,D ;LOCAL, JUST SET 3VP SO DON'T SEE IT NEXT VARIAB.
JRST AVAR2A ;NO NEED TO PUNCH DEF SINCE WAS DEF ON PASS1.
;;MAIN ;"MAIN" MIDAS ROUTINES: INIT, PS1, PLOD, PS2, PSYMS
;ALL CALLED WITH JSP A,; ALL GLOBAL
;RETURN INSTRUCTION FROM JSP IN LOCATION RETURN
PS1: HRRM A,RETURN ;PASS 1, (PASS 1 INITIALIZATION ALREADY DONE), SAVE RETURN
PUSH P,[ASSEM1-1] ;SIMBLK WILL POPJ1.
IFN A1PSW,[SKIPL PRGC
JRST A1PAS1 ;THIS NOT FIRST PROGRAM THIS ASSEMBLY, SET MODE TO 1PASS
]
TRO FF,FRNPSS
IFN ITSSW,JRST SIMBLK ;SELECT SBLK AND ASSEMBLE
IFN DECSW\TNXSW,JRST A.DECRE ;SELECT .DECREL AND ASSEMBLE.
PS2: HRRM A,RETURN ;PASS 2 (MAIN ROUTINE, PASS 2 INITIALIZATION NOT ALREADY DONE), SAVE RETURN
JUMPL FF,PA2A ;JUMP IF PASS 1 ENDED IN 1PASS MODE
TDO FF,[FLPPSS,,FRPSS2] ;SET PUNCHING PASS AND PASS 2 FLAGS
PUSHJ P,P2INI ;INITIALIZE
JRST ASSEM1 ;START ASSEMBLING
PA2A: MOVE A,SYMAOB ;PASS 2 OF 1PASS ASSEMBLY, CHECK FOR UNDEFINED LOCALS
PA2C: MOVE SYM,ST(A) ;GET SQUOZE THIS SYMTAB ENTRY
LDB B,[400400,,SYM] ;GET FLAGS
CAIE B,LCUDF_-14. ;LOCAL UNDEFINED?
JRST PA2B ;NOT LOCAL UNDEFINED, DON'T COMPLAIN
3GET C,A ;LOCAL UNDEFINED, GET 3RDWRD ST ENTRY
TLZ SYM,740000 ;CLEAR OUT FLAGS IN SYM IN ANTICIPATION OF TYPING OUT COMPLAINT
TLNN C,3LLV ;PROBLEM HANDED TO LINKING LOADER?
ETSM [ASCIZ /Undefined/] ;NO
PA2B: ADD A,WPSTE1 ;NOW GO FOR NEXT ST ENTRY
AOBJN A,PA2C
JRST RETURN
$INIT: HRRM A,RETURN ;INITIALIZATION (BEFORE PASS 1 ONLY) ROUTINE, SAVE RETURN POINT
IFN CREFSW,PUSHJ P,CRFOFF ;DON'T CREF ON 1ST PASS.
IFN LISTSW,CALL LSTOFF ;DON'T LIST ON 1ST PASS.
SKIPGE ISYMF
JRST INIT1 ;SPREAD SYMS (RETURNS TO SP4)
MOVE A,SYMAOB ;ALREADY SPREAD, JUST FLUSH ALL BUT INITIAL SYMS
INIT4: SKIPN B,ST(A)
JRST INIT2
3GET C,A
TRNE C,-1 ;INITIAL SYM?
CLEARM ST(A) ;NO
INIT2: ADD A,WPSTE1
AOBJN A,INIT4
SETZM BBKCOD
MOVE A,[BBKCOD,,BBKCOD+1]
BLT A,EBKCOD ;CLEAR OUT BLANK CODE
SP4: PUSH P,CRETN
P1INI: CLEARB I, LDCCC
INSIRP SETZM,BKBUF ISYMF A.PASS
IFN FASLP,[
INSIRP SETZM,FASATP FASPCH
CLEARM FASIDX
]
MOVEMM DECTWO,[[MOVE]]
TDZ FF,[FFINIT] ;INITIALIZE MOST FF FLAGS
MOVEIM A.PPASS,2 ;DEFAULT IS 2-PASS.
PUSHJ P,MACINI ;INITIALIZE MACRO STATUS
MOVEI A,PCNTB
MOVEM A,PBCONL
MOVS A,[BKTAB,,P1INI1]
BLT A,BKTAB+4
MOVEIM BKTABP,BKWPB*2
;DROPS IN.
P2INI: INSIRP SETZM,[CPGN,CLNN,GENSM,OFLOC,OFRLOC,CRLOC,BKPDL
SYLOC,SYSYM,BYTW,BYTRLC,STGSW,DECBRK,DEFNPS,BYTM,BYTM1,HKALL,QMTCH]
AOS B,A.PASS
IFN ITSSW,[
CALL SETWH2 ;SET UP .WHO2, PREPARE .WHO3 IN A WITH PAGENUM=1.
.SUSET [.SWHO3,,A] ;'P1 ',,PAGENUM OR 'P2 ',,PAGENUM
.SUSET [.SWHO1,,[.BYTE 8 ? 166 ? 0 ? 165 ? 0]]
]
TDZ FF,[FLUNRD,,FRGLOL]
IRP X,,[BKWPB,BKCUR,,BKPDL+1,1,BKLVL,IRDEF,ASMI
NCONS,CONCNT,VARTAB,VARPNT,NVARS,VARCNR,1,VECSIZ]
IFE 1&.IRPCN,IFSN [X], MOVEI A,X
IFN 1&.IRPCN, MOVEM A,X
TERMIN
MOVE A,CONTBA
MOVEM A,PLIM
MOVE A,CONGLA
MOVEM A,CONGOL
CLEARM VARCNT
CLEARM PBITS2
MOVE A,[440300,,PBITS1]
MOVEM A,BITP
MOVEI A,PBITS4
HRRZM A,PBITS4
CLEARB I,PBITS1
MOVEI A,PCNTB
MOVEM A,PBCON
MOVE A,[(LCUDF)+<SQUOZE 0,$ >+1] ;< AND > FOR COMPATIBILITY WITH OLD
MOVEM A,PCNTB
MOVEM A,CSQZ
MOVEI A,8
MOVEM A,ARADIX
IFN ITSSW,[
MOVEI A,100
MOVEM A,CLOC
]
.ELSE [
SETZ A, ; SET LOC COUNTERS APPROPRIATELY
SKIPGE B,CONTRL
TRNE B,DECREL+FASL
JRST [SETZM CLOC ; ASSUME RELOCATABLE
AOS CRLOC ; CRLOC GETS 1
JRST P2INI5]
TRNE B,DECSAV ; ASSUME ABSOLUTE
MOVEI A,140
TRNE B,SBLKS
MOVEI A,100 ; IF SBLK FORMAT ASSUME FOR ITS.
MOVEM A,CLOC
P2INI5:
]
SETZM GLOCTP
MOVEI A,BKBUF+1
MOVEM A,OPT1
MOVE A,CONTRL ;IN DEC FORMAT, OUTPUT PROGRAM NAME.
TRNE A,DECREL
CALL DECPGN ;CLOBBERS A
IFN FASLP,[
SETOM FASBLC ;LOSING BLOCK COUNT
MOVE A,CONTRL ;IN FASL FORMAT, OUTPUT FASL HEADER
TRNE A,FASL
CALL FASOIN ;INITIALIZE FASL OUTPUT
]
SETZM DECBRH
TRO FF,FRSYMS+FRFIRWD
MOVE A,[IFORTB,,FORTAB] ;INITIALIZE FORMAT TABLE ON EACH PASS
BLT A,FRTBE
MOVEIM GLSPAS,GLOTB ;INIT. ASSEM1 PDL LEVELS TO BOTTOM.
MOVEMM ASSEMP,[[-LPDL,,PDL]]
MOVEIM ASMDSP,ASSEM3
SETZM ASMOUT
SETZM CONSTP
SETZM SCNDEP ;NOT IN CONDIT. OR CONSTANT.
SETZM CONDEP
HRRZM P,CONSML ;START OUT IN MULTI-LINE MODE.
IFN LISTSW,[
MOVE A,[440700,,LISTBF]
MOVEM A,PNTBP
CLEARM LISTPF
SETOM LISTBC
SKIPG LISTP1 ;IF LIST ON PASS 1
JUMPGE FF,CRETN ;OR PUNCHING PASS,
SKIPE LISTP ;IF WANT LISTING,
CALL LSTON ;TURN ON OUTPUT OF LISTING.
]
IFN CREFSW,[
JUMPGE FF,CRETN
SKIPE CREFP ;IF C SWITCH WAS SEEN,
PUSHJ P,CRFON ;TURN ON CREFFING,
]
CRETN: POPJ P,RETURN
P1INI1: SQUOZE 0,.INIT ? 0 ? 3
SQUOZE 0,.MAIN ? 1,,
PLOD: HRRM A,RETURN ;MAIN ROUTINE TO PUNCH LOADER, CALLED BEFORE PASS 2 (PS2"), SAVE RETURN POINT
PUSHJ P,PLOD1 ;PUNCH LOADER
JRST RETURN ;RETURN
;PUNCH OUT THE LOADER
PLOD1: PUSHJ P,FEED1 ;LEAVE LOTS OF BLANK PAPER TAPE
MOVE B,CONTRL
TRNE B,ARIM10
JRST PLOD2 ;RIM10 => PUNCH OUT SBLK LOADER FOR PDP10 READIN-MODE READIN
TRNN B,SBLKS
POPJ P, ;NOT SBLK => DON'T PUNCH LOADER
PLOD1A: MOVSI B,SLOAD-SLOADP ;PUNCH SBLK LOADER IN RIM FORMAT
MOVSI C,(DATAI PTR,)
PLOAD1: MOVE A,C
PUSHJ P,PPBA
CAMN C,[DATAI PTR,13]
HRRI C,27
MOVE A,SLOAD(B)
PUSHJ P,PPBA
AOS C
AOBJN B,PLOAD1
MOVE A,[JRST 1]
PUSHJ P, PPBA
JRST FEED1
PLOD2: MOVSI C,LDR10-ELDR10 ;PUNCH SBLK LOADER FOR PDP10 READIN
PLOD3: MOVE A,LDR10(C)
PUSHJ P,PPBA
AOBJN C,PLOD3
JRST FEED1
;SBLK LOADER NORMALLY PUNCHED OUT IN RIM FORMAT
SLOAD: CONO PTR,60 ;0 RESTART POINT (NEW BLOCK)
JSP 14,30 ;1 START POINT, LOOP POINT FOR NEW BLOCK; WAIT FOR DATA WORD READY
DATAI PTR,16 ;GET HEADER
MOVE 15,16 ;INITIALIZE CHECKSUM
JUMPGE 16,16 ;HEADER .GE. 0 => STARTING INSTRUCTION
JSP 14,30 ;5 LOOP POINT FOR NEXT DATA WORD: WAIT FOR READY
DATAI PTR,(16) ;READ IN DATA WORD
ROT 15,1 ;NOW UPDATE CHECKSUM
ADD 15,(16)
AOBJN 16,5 ;LOOP FOR ALL DATA WORDS THIS BLOCK
MOVEI 14,33 ;30 TO RETURN TO 33
JRST 30 ;WAIT FOR READY THEN GO TO 33
;14 JSP AC FOR ROUTINE AT 30
;15 CHECKSUM
;16 AOBJN POINTER (UPDATED HEADER)
CONSO PTR,10 ;30 ROUTINE TO WAIT FOR DATA WORD READY FOR DATAI
JRST 30
JRST (14)
DATAI PTR,16 ;33 GET CHECKSUM
CAMN 15,16 ;COMPARE WITH CALCULATED
JUMPA 1 ;OK, GO GET NEXT BLOCK (DON'T CHANGE TO JRST OR REAL LOADERS WILL GET CONFUSED)
JRST 4, ;CHECKSUM ERROR
SLOADP==.
;PDP10 SBLK LOADER
;FOLLOWING CODING ACTUAL WORDS TO BE OUTPUT
;BY ASSEMBLER, COMPILER, OR WHATEVER
;SHOULD BE EXECUTED BY PDP10 HARDWARE READIN FEATURE
;USES ONLY THE AC'S (BUT ALL OF THEM)
LDR10:
-17,,0 ;BLKI POINTER FOR READ SWITCH
LDRC=0 ;CHECKSUM (OK, SO YOU'RE NOT ALLOWED TO LOAD
;INTO IT DURING HARDWARE READIN, BUT WHO SAYS
;YOUR PROGRAM CAN'T USE IT?)
OFFSET -.+1 ;BEGIN LOADING INTO 1 AS PER HEADER
LDRGO==.
CONO PTR,60 ;START UP PTR (RESTART POINT)
LDRRD==.
HRRI LDRB,.+2 ;INITIALIZE INDEX
LDRW==.
CONSO PTR,10 ;WAIT FOR WORD TO BE AVAILABLE
JRST .-1
ROT LDRC,-LDRRD(LDRB) ;BEFORE READING IN HEADER, ROTATE 2 BITS (THEN IGNORE)
;BEFORE READING IN EACH DATA WORD, ROTATE 1 BIT (FOR UPDATING CHECKSUM)
;BEFORE READING IN CHECKSUM, ROTATE NOT AT ALL (DON'T ROTATE CALCULATED CHECKSUM)
DATAI PTR,@LDRT1-LDRRD(LDRB) ;READ WORD INTO RIGHT PLACE
;HEADER => READ INTO C
;STORAGE WORD => READ INDEXED BY AOBJN POINTER IN A
;CHECKSUM => READ INTO A FOR COMPARISON WITH C(C)
XCT LDRT1-LDRRD(LDRB) ;EXECUTE RELEVANT T1 ENTRY (MAYBE SKIPS)
XCT LDRT2-LDRRD(LDRB) ;EXECUTE RELEVANT T2 ENTRY (MAYBE JUMPS)
LDRB==.
SOJA ., ;-RD(B) IS 2, 1, AND 0 FOR SUCCESSIVE ENCOUNTERS OF THIS INSTRUCTION
;USED AS INDEX INTO TABLES, ETC.
;TABLE 1
;INDIRECTED THROUGH FOR DATAI
;THEN EXECUTED TO SEE WHAT TO DO WITH READ IN WORD
;ENTRIES EXECUTED IN REVERSE ORDER
LDRT1==.
CAME LDRC,LDRA ;COMPARE CHECKSUM WITH CALCULATED, SKIP TO B IF THEY AGREE
ADD LDRC,(LDRA) ;UPDATE CHECKSUM
SKIPL LDRA,LDRC ;INITIALIZE HEADER AND SKIP UNLESS JUMP BLOCK
;TABLE 2
;EXECUTED IF CORRESPONDING ENTRY IN TABLE 1 DIDN'T SKIP WHEN EXECUTED
LDRT2==.
JRST 4,LDRGO ;CHECKSUM ERROR
AOBJN LDRA,LDRW ;UPDATE AOBJN POINTER AND GO BACK FOR NEXT STORAGE WORD IF NOT EXHAUSTED
LDRA==.
JRST LDRRD ;WHEN INITIALLY LOADED IS JUMP BLOCK TO THIS LOADER
;DURING LOADING USED TO HOLD HEADER (AOBJN POINTER), WHICH MAY BE LOADED JUMP BLOCK
OFFSET 0
ELDR10==.
;FLAGS IN SQUOZE OF SYMS TO OUTPUT
ABSGLO==040000 ;SYM IS GLOBAL (IF RELOCA, SAYS THIS IS BLOCK NAME)
ABSLCL==100000 ;LOCAL
ABSDLI==200000 ;DELETE INPUT (DON'T RECOGNIZE IT IF TYPED IN)
ABSDLO==400000 ;DELETE OUTPUT (DON'T TYPE IT OUT)
PSYMS: HRRM A,RETURN ;PUNCH OUT SYMBOL TABLE, CALLED AFTER EVERYTHING ELSE, SAVE RETURN POINT
PUSH P,PSYMS ;AT END, POPJ TO RETURN.
TRNE FF,FRSYMS
JRST SYMDMP ;PUNCH SYMS IF NEC.
SKIPL A,CONTRL
JRST SYMDA ;IF RELOCA, PUNCH PROGRAM NAME.
TRNE A,DECSAV ;IF DEC SAVE FORMAT WITHOUT SYMBOLS
JRST SYMDSA ;STILL DUMP START ADDRESS
TRNN A,DECREL
POPJ P,
PSYMSD: MOVSI A,DECEND
PUSHJ P,DECBLK ;START AN END-BLOCK.
MOVE A,DECTWO ;IN 2-SEG PROGRAMS,
CAME A,[MOVE]
JRST [ CAMG A,DECBRH ;OUTPUT HISEG BREAK
MOVE A,DECBRH
MOVEM A,WRD
MOVEIM WRDRLC,1
CALL PWRD
MOVEMM WRD,DECBRK
CALL PWRD ;FOLLOWED BY LOSEG BREAK
JRST EBLK]
MOVEMM WRD,DECBRK ;OUTPUT THE PROGRAM BREAK.
MOVEIM WRDRLC,1
PUSHJ P,PWRD
MOVE A,DECBRA ;OUTPUT HIGHEST ABS. ADDR
CAIG A,140
SETZ A, ;IF IT'S ABOVE THE JOBDAT AREA.
PUSHJ P,DECWRD
JRST EBLK
SYMDA: MOVEI A,LPRGN ;NOW PUNCH PROGRAM NAME
DPB A,[310700,,BKBUF]
MOVE A,PRGNM
TLO A,40000
PUSHJ P,$OUTPT
PUSHJ P,EBLK
TLZ FF,$FLOUT
POPJ P,
;DUMP OUT THE SYMBOL TABLE
SYMDMP: TRZ I,IRCONT ;OK TO END BLOCK
CLEARM GLSP1
CLEARM GLSP2
CLEARM WRDRLC
MOVE T,CONTRL
MOVEI A,BKBUF+1
MOVEM A,OPT1
CLEARM CLOC
CLEARM BKBUF
IFN FASLP,[
TRNE T,FASL
JRST SYMDM1
]
IFN ITSSW,[
TRNE T,SBLKS ; ON ITS, IF OUTPUTTING IN SBLK FMT
CALL SYMDDB ; THEN OUTPUT A DEBUGGING INFO BLOCK.
]
TRNE T,DECREL
JRST SYMDMD
JUMPL T,SSYMD ;JUMP IF NOT STINK
MOVEI B,LDDSYM ;LOCAL SYMS BLOCK TYPE
DPB B,[310700,,BKBUF] ;SET BLOCK TYPE
MOVEM B,CDATBC
MOVE B,SYMAOB ;CAUSE SSYMD3 TO LOOK AT ENTIRE SYM TAB.
JRST SSYMDR
SYMDMD: MOVSI A,DECSYM ;IN DEC FMT, START SYMBOLS BLOCK.
PUSHJ P,DECBLK
SYMDM1: MOVE B,SYMAOB
JRST SSYMDR
IFN ITSSW,[
; OUTPUT DEBUGGING INFO BLOCK (ITS SBLK ONLY)
SYMDDB: MOVE A,[-7,,3] ;OUTPUT A "DEBUGGING INFORMATION" BLOCK
MOVE B,A ;UPDATING THE CHECKSUM IN B.
PUSHJ P,PPB
MOVE A,[-6,,1] ;THE BLOCK CONTAINS ONE SUBBLOCK - A "MIDAS INFO" SUBBLOCK.
PUSHJ P,PPBCK
.SUSET [.RXUNAME,,A] ;CONTAINING NAME OF USER, DATE IN DISK FORMAT,
PUSHJ P,PPBCK
SYSCAL RQDATE,[%CLOUT,,A]
.LOSE %LSSYS
PUSHJ P,PPBCK ;AND THE SOURCE FILE NAMES (DEV, FN1, FN2, SNAME).
REPEAT 4,[
MOVE A,INFB+$F6DEV+.RPCNT
PUSHJ P,PPBCK
]
MOVE A,B
PJRST PPB ; PUNCH OUT CHECKSUM & RETURN
] ;IFN ITSSW,
;AC ALLOCATIONS DURING PHASE 1 (COMPACTING THE SYMBOL TABLE):
;AA INITIALLY HAS -SMK,,; INPUT INDEX INTO ST
;A TEMP
;B SQUOZE
;D OUTPUT INDEX INTO SYMTAB
;CH1 VALUE OF SYM
;CH2 3RDWRD
SSYMD: MOVEI D,ST-1
SETZB C,SMSRTF ;SYMS SORTED => INITIAL SYMS CLOBBERED
MOVE AA,SYMAOB
SSYMD1: SKIPE B,ST(AA) ;GET SYM NAME FROM TABLE
TDNN B,[37777,,-1] ;MAKE SURE NOT EXPUNGED
JRST SSYMDL ;NOT (REALLY) THERE, TRY NEXT
AOS SMSRTF
MOVE CH1,ST+1(AA) ;GET VALUE OF SYM
3GET CH2,AA ;GET 3RDWRD
TRNE CH2,-1
TLNE CH2,3KILL+3LLV
JRST SSYMDL ;DON'T PUNCH INITIAL OR KILLED SYMS.
MOVEI A,0 ;INITIALIZE FOR SHIFTING IN FLAGS
LSHC A,4 ;SHIFT FLAGS INTO A
XCT SSYMDT(A) ;DO THE APPROPRIATE THING THIS KIND OF SYMTAB ENTRY
JRST SSYMDL
SSYMD2: LSH B,-4 ;SHIFT SQUOZE BACK TO WHERE IT BELONGS
TLO B,ABSLCL ;SET LOCAL BIT
TLNE CH2,3SKILL
TLO B,ABSDLO ;HALF-KILL SYM
CAIL A,DEFGVR_-16
TLC B,ABSGLO\ABSLCL ;FOR GLOBAL SYM, SET GLOBAL BIT INSTEAD OF LOCAL BIT,
CAIGE A,DEFGVR_-16 ;AND PUT IT IN THE GLOBAL BLOCK IN THE SYMTAB.
SKIPN PRGNM+BKWPB ;IF ONLY ONE BLOCK IN PROGRAM, PUT ALL SYMS IN GLOBAL BLOCK.
HRRI CH2,0
PUSH D,B ;STORE NAME OF SYM IN OUTPUT SLOT
PUSH D,CH1 ;STORE VALUE
PUSH D,CH2 ;STORE 3RDWRD
SSYMDL: ADD AA,WPSTE1
AOBJN AA,SSYMD1 ;LOOP FOR ALL SYMS IN TABLE
MOVSI CH2,4^5 ;1ST BIT TO SORT ON IS TOP BIT,
MOVEI A,ST ;SORT FROM BOTTOM OF SYMTAB
MOVEI B,1(D) ;TO WHERE WE FILLED UP TO.
MOVE CH1,[TDNE CH2,1(A)] ;SORT ON 2ND WD, WDS WITH BIT ON COME FIRST.
MOVE C,[TDNN CH2,1(B)]
JSP AA,SSYMD9
TLC C,(TDNE#TDNN) ;ON BITS AFTER 1ST, ENTRIES WITH BIT OFF COME FIRST.
TLC CH1,(TDNE#TDNN)
MOVEI AA,SSRTX ;NEED ONLY CHANGE C, CH1 THE FIRST TIME.
JRST SSRTX
SSYMD9: PUSHJ P,SSRTX ;SORT SYMS ARITHMETICALLY BY VALUE.
MOVNI B,(B)
ADDI B,ST ;SIZE OF AREA OF SYMTAB STILL IN USE.
IDIV B,WPSTE
HRLZI B,(B) ;-<# SYMTAB ENTRIES>,,
MOVE T,CONTRL ; GET CONTRL FOR OUTPUT FMT CHECKS
MOVE A,[SQUOZE 0,GLOBAL]
MOVEM A,BKTAB ;CALL THE .INIT BLOCK "GLOBAL" WHICH IS WHAT DDT WANTS AS TOP BLOCK.
MOVE C,BKTABP
IDIVI C,BKWPB ;# BLOCKS (INCL. GLOBAL BLOCK).
CAIN C,2 ;IF ONLY GLOBAL AND MAIN, TELL BKSRT TO IGNORE MAIN.
SETZM PRGNM+1
CAIN C,2
MOVEI C,1 ;IF ONLY GLOBAL AND MAIN, FILE WILL HAVE ONLY 1 BLOCK (GLOBAL).
CAILE C,1 ;IF MORE THAN ONE BLOCK IN FILE,
TRNN T,DECSAV ;AND OUTPUT FORMAT IS DECSAV,
CAIA
ADDI C,1 ;THEN ALLOW FOR ONE MORE "BLOCK" (PGM NAME).
;NOTE THAT DECSAV FMT REPLACES BLOCKNAME WITH PGM-NAME
;FOR SINGLE-BLOCK CASE, SO COUNT OF 1 WORKS OK.
MOVSI A,(C) ; <# BLOCKS TO OUTPUT>,,
SUBM B,A ;-<# ENTRIES IN SYMTAB IN FILE>,,
LSH A,1 ;-<# WDS IN SYMTAB IN FILE>,,
TRNE T,DECSAV ; IF OUTPUT FORMAT IS DEC SAV,
JRST [ HRR A,DECSYA ; GET LOC TO STORE SYMS AT
MOVE C,A
MOVE A,[-1,,116-1] ; STORE IT AT .JBSYM
CALL PPB
MOVE A,C
CALL PPB
HRRI A,-1(A) ; SET -<# WDS IN SYMTAB>,,<LOC-1 TO STORE AT>
JRST .+1]
MOVEM A,SCKSUM ;SAVE 1ST WD FOR CHECKSUM (DECSAV IGNORES IT)
PUSHJ P,PPB
PUSHJ P,BKCNT ;PUT -<# SYMS IN BLOCK> IN 3RD WD OF EACH BKTAB ENTRY.
;DROPS THROUGH.
;DROPS IN IF ABS, JUMPS HERE IF RELOC.
;NOTE THAT IN ABS ASSEMBLY, B WILL CONTAIN THE CHECKSUM AND
;SHOULD NOT BE CLOBBERED.
SSYMDR: PUSH P,B ;-<# SYMS>,,0 ;IT WILL BE -1(P)
PUSHJ P,BKSRT ;SORT BLOCKS INTO BKTAB1
MOVE A,BKTAB
CAME A,[SQUOZE 0,GLOBAL] ;IF ABS, WE RENAMED .INIT TO GLOBAL, SO LEAVE IT IN BKTAB1
SOS D ;ELSE FLUSH .INIT FROM THE END OF BKTAB1.
SETOM 1(D) ;PUT A -1 AT END OF BKTAB1.
MOVE B,SCKSUM ;GET CHKSUM AFTER 1ST WD. (PPBCK WILL UPDATE)
PUSH P,[-1] ;(P) WILL BE BKTAB1 IDX OF NEXT BLOCK TO OUTPUT.
SSYMD3: AOS F,(P) ;F HAS BKTAB1 IDX OF BLOCK.
SKIPGE C,BKTAB1(F) ;BKTAB1 ELT HAS BKTAB IDX OR
JRST SSYMDX ; -1 AFTER LAST BLOCK.
SKIPL LINK,CONTRL
JRST SSYMD7 ;DIFFERENT RTN TO OUTPUT BLOCK NAME IF RELOCA.
TRNE LINK,DECREL+FASL+DECSAV
JRST SSYMD6 ; ALL THESE SKIP OVER SBLK-TYPE BLOCKNAME OUTPUT
MOVE A,BKTAB(C)
PUSHJ P,PPBCK ;OUTPUT BLOCK NAME WITH NO FLAG BITS SET.
HLRZ A,BKTAB+1(C)
SKIPE A
ADDI A,1 ;A GETS 0 FOR GLOBAL BLOCK, ELSE DDT LEVEL (= 1 + MIDAS LEVEL).
HRL A,BKTAB+2(C) ;PUT IN -2*<NUM SYMS>
ADD A,[-2,,]
SSYMG2: PUSHJ P,PPBCK ;OUTPUT -SIZE,,LEVEL WORD OF BLOCK NAME ENTRY.
JRST SSYMD6
SSYMD7: MOVE A,BKTAB(C) ;OUTPUT BLOCK NAME IN RELOCATABLE.
TLO A,ABSGLO ;TELL STINK IT'S BLOCK NAME.
PUSHJ P,$OUTPT
HLRZ A,BKTAB+1(C)
SUBI A,1
PUSHJ P,$OUTPT
SSYMD6: SKIPL C,-1(P) ;AOBJN PTR TO SYMS.
JRST SSYMD8 ;IN CASE NO SYMS.
SSYMD4: HRRZ A,ST+2(C) ;OUPUT ONLY THE SYMS IN THE BLOCK
CAME A,BKTAB1(F) ;NOW BEING HANDLED.
JRST SSYMD5
SKIPGE LINK,CONTRL
TRNE LINK,DECREL+FASL
JRST SYMD2 ;SPECIAL IF RELOCA.
MOVE A,ST(C)
TRNE LINK,DECSAV
CALL RSQZA ; RIGHT-JUSTIFY THE SQUOZE (SIGH)
PUSHJ P,PPBCK ;1ST, SQUOZE WITH FLAGS.
MOVE A,ST+1(C)
PUSHJ P,PPBCK ;2ND, VALUE.
SSYMD5: ADD C,WPSTE1
AOBJN C,SSYMD4 ;HANDLE NEXT SYM.
SSYMD8: TRNN LINK,DECSAV
JRST SSYMD3 ;ALL SYMS FOR THIS BLOCK DONE, DO NEXT BLOCK.
; DECSAV FMT HAS BLOCK NAMES OUTPUT LAST.
SKIPN PRGNM+BKWPB ;IF ONLY ONE BLOCK IN PGM,
JRST SSYMD3 ; FORGET IT; PGM-NAME SUBSTITUTES FOR BLKNAME.
MOVE C,BKTAB1(F) ; GET IDX FOR BLOCK
MOVE A,BKTAB(C) ; GET BLOCKNAME WITH FLAGS CLEAR
TLO A,140000 ; SET FLAGS TO SAY SYM IS BLOCKNAME
CALL RSQZA ; RIGHT-JUSTIFY SQUOZE FOR DEC (UGH BLETCH)
CALL PPB
HLRZ A,BKTAB+1(C) ; GET LEVEL OF BLOCK (NO WD COUNTS)
CALL PPB
JRST SSYMD3
; RIGHT-JUSTIFY SQUOZE IN A, PRESERVING FLAGS.
; (WHICH ASQOZR RTN DOESN'T)
; CLOBBERS B.
RSQZA: PUSH P,A ; SAVE FLAGS
TLZA A,740000 ; ZAP
RSQZA2: DPB A,[004000,,(P)] ; UPDATE
IDIVI A,50
JUMPE B,RSQZA2
POP P,A
POPJ P,
;PUNCH OUT LOCAL SYM (RELOCATABLE ASSEMBLY)
;NORMALLY OUTPUT SQUOZE W/ FLAGS ? VALUE,
;IF 3LLV SET OUTPUT PHONY NAME (= STE ADDR) ? SQUOZE W/ FLAGS, STINK FIXES IT UP.
SYMD2: LDB A,[400400,,ST(C)]
MOVE CH1,ST+1(C) ;SSYMDT MAY CHANGE CH1.
MOVE CH2,ST+2(C)
XCT SSYMDT(A) ;SKIPS IF SHOULD OUTPUT SYM.
JRST SSYMD5
TLNE CH2,3KILL
JRST SSYMD5
MOVE B,ST(C)
TLZ B,740000
JUMPE B,SSYMD5 ;UNUSED ENTRY.
JUMPL LINK,SYMDEC ;J IF DEC OR FASL FMT
TLNE CH2,3RLL
TLO B,200000 ;RELOCATE LEFT HALF
TLNE CH2,3RLR
TLO B,100000 ;RELOCATE RIGHT HALF
TLNE CH2,3SKILL
TLO B,400000 ;HALF-KILL
MOVEI A,ST(C)
TLNE CH2,3LLV ;IF STINK HAS VALUE,
PUSHJ P,$OUTPT ;GIVE STINK NAME STINK KNOWS SYMBOL BY.
TLNE CH2,3LLV ;IF GIVING PHONY NAME, INSURE LOCAL FLAG SET
TLO B,ABSLCL ;(STINK WILL DO SO OTHERWISE)
MOVE A,B
PUSHJ P,$OUTPT ;OUTPUT SYM
MOVE A,CH1
TLNN CH2,3LLV ;DON'T OUTPUT VALUE IF DON'T KNOW IT.
PUSHJ P,$OUTPT ;OUTPUT VALUE
JRST SSYMD5
SYMDEC: IFN FASLP,[
TRNE LINK,FASL
JRST SYMFSL ;FASL ASSMBLY
]
PUSHJ P,ASQOZR ;RIGHT-JUSTIFY THE SQUOZE,
TLNE CH2,3SKILL
TLO B,ABSDLO ;MAYBE HALFKILL,
TLO B,ABSGLO
LDB A,[400400,,ST(C)]
CAIGE A,DEFGVR_-14.
TLC B,ABSGLO+ABSLCL ;LOCAL SYM, CHANGE GLO TO LCL.
MOVEM B,WRD
PUSH P,C
PUSHJ P,DECPW ;FIRST, THE NAME,
POP P,C
LDB TM,[420200,,ST+2(C)]
MOVE A,ST+1(C) ;THEN THE VALUE AND RELOCATION BITS.
PUSHJ P,DECWR1
JRST SSYMD5
IFN FASLP,[
SYMFSL: TLO B,400000 ;GET VALUE FROM SECOND WD
TLNE CH2,3RLL
TLO B,200000 ;RELOCATE LH
TLNE CH2,3RLR
TLO B,100000
CAIL A,LGBLCB_<-18.+4>
TLO B,40000 ;GLOBAL FLAG
MOVE A,B
MOVEI B,15 ;PUTDDTSYM
PUSHJ P,FASO
MOVE A,CH1
PUSHJ P,FASO1
JRST SSYMD5
]
;XCT INDEXED ON SQUOZE FLAGS; SHOULDN'T PUNCH SYM IF DOESN'T SKIP.
SSYMDT: JFCL ;COM
JFCL ;PSEUDO OR MACRO
CAIA ;SYM, PUNCH OUT
TLNN CH2,3LLV ;LOCAL UNDEFINED, OUTPUT IF STINK HAS VALUE TO TELL STINK WHERE TO PUT IT.
TLZA CH1,-1 ;DEFINED LOCAL VARIABLE, CLEAR OUT LH(VALUE)
JFCL ;UNDEFINED LOCAL VARIABLE
SKIPL CONTRL ;DEFINED GLOBAL VARIABLE, PUNCH OUT IF ABS.
JFCL ;UNDEFINED GLOBAL VARIABLE
SKIPL CONTRL ;GLOBAL ENTRY, PUNCH OUT IF ABS ASSEM.
JFCL ;GLOBAL EXIT, DON'T PUNCH OUT
IFN .-SSYMDT-NCDBTS,.ERR SSYMDT LOSES.
SSYMDX: SKIPGE LINK,CONTRL
TRNE LINK,DECREL+FASL
JRST SSYMG3
TRNE LINK,DECSAV ; IN DECSAV FORMAT,
JRST [ MOVE A,PRGNM ; PGM NAME IS LAST THING IN SYMTAB
CALL RSQZA
CALL PPB ; WITH FUNNY VALUE OF
SETZ A, ; -<# SYMTAB WDS USED BY PGM>,,<RELOC CONSTANT>
CALL PPB ; BUT LAST PGM IN SYMTAB MUST HAVE LH=0, SO...
JRST SSYMG3]
MOVE A,B ; SBLK OR RIM ASSEMBLY, OUTPUT CHKSUM.
PUSHJ P,PPB
SSYMG3: SUB P,[2,,2]
PUSHJ P,EBLK ;END CURRENT OUTPUT BLOCK
SKIPL A,CONTRL ;RELOCATABLE => OUTPUT PROG NAME.
JRST SYMDA
IFN FASLP,[
TRNE A,FASL
POPJ P,
]
TRNE A,DECREL ;DEC FMT => OUTPUT END BLOCK.
JRST PSYMSD
SYMDSA: MOVE A,STARTA ;NOW GET STARTING INSTRUCTION
JRST PPB ;PUNCH IT OUT AND RETURN
;PUT INTO BKTAB1 THE BKTAB IDXS OF ALL THE BLOCKS IN THE ORDER THEIR
;SYMS SHOULD BE PUNCHED (A BLOCK'S SUBBLOCKS PRECEDE IT)
;THE .INIT BLOCK (MAYBE BY NOW RENAMED "GLOBAL") GOES IN LAST. D POINTS AT WHERE IT WAS PUT.
; NOTE THAT FOR DECSAV FORMAT THE ORDERING IS REVERSED; A BLOCK'S SUBBLOCKS
; FOLLOW IT, AND THE .INIT BLOCK GOES IN FIRST.
BKSRT: MOVEI D,BKTAB1-1 ;D IS FOR PUSHING INTO BKTAB1.
MOVSI A,1 ;START WITH BLOCK 0 (OUTERMOST, .INIT).
MOVE LINK,CONTRL
;HANDLE BLOCK IN A: LOOK FOR ITS SUBBLOCKS.
BKSR1: TRNE LINK,DECSAV
JRST [ MOVEI C,(A) ? PUSH D,C ? JRST .+1]
SETZ C,
BKSR2: CAME A,BKTAB+1(C)
JRST BKSR3 ;THIS BLOCK ISN'T A SUBBLOCK.
ADD A,[1,,] ;LH HAS SUBBLOCK'S LEVEL.
HRRI A,(C) ;RH HAS SUBBLOCK.
PUSHJ P,BKSR1 ;HANDLE THE SUBBLOCK
MOVE A,BKTAB+1(C) ; RESTORE A (C IS PRESERVED OVER CALL)
BKSR3: ADDI C,BKWPB
CAMGE C,BKTABP
JRST BKSR2
MOVEI C,(A) ; RESTORE C INDEX BKSR1 WAS ENTERED WITH
TRNE LINK,DECSAV
POPJ P,
PUSH D,C ;PUT THE BLOCK IN BKTAB1 (AFTER SUBBLOCKS)
POPJ P,
PPBCK: ROT B,1 ;OUTPUT WD IN A, UPDATING CKSUM IN B.
ADD B,A
JRST PPB
;THE THIRD WORD OF EACH BLOCK'S ENTRY IN BKTAB GETS THE NUMBER OF
;SYMBOLS IN THAT BLOCK (OF THE SYMBOLS THAT WE WILL PUT IN THE SYMTAB).
BKCNT: PUSH P,B
MOVEI C,0
BKCNT0: SETZM BKTAB+2(C) ;ZERO 3RD WD OF EACH BKTAB ENTRY.
ADDI C,BKWPB
CAMGE C,BKTABP
JRST BKCNT0
BKCNT1: MOVE C,ST+2(B)
SOS BKTAB+2(C) ;ADD -2 FOR EACH SYM IN THE BLOCK.
SOS BKTAB+2(C)
ADD B,WPSTE1
AOBJN B,BKCNT1
POPBJ: POP P,B
POPJ P,
SSRTX: HRLM B,(P) ;DO ONE PASS OF RADIX-EXCHANGE. SAVE END.
CAIL A,@WPSTEB ;ONLY 1 ENTRY, NOTHING TO DO.
JRST SSRTX7
PUSH P,A ;SAVE START.
SSRTX3: XCT CH1
JRST SSRTX4 ;MOVE UP TO 1ST WITH BIT ON.
SUB B,WPSTE
XCT C ;MOVE DOWN TO LAST WITH BIT OFF.
JRST SSRTX5
MOVE D,WPSTE
CAIE D,MAXWPS
JRST .+4
REPEAT MAXWPS,[
MOVE D,.RPCNT(A) ;EXCHANGE THEM,
EXCH D,.RPCNT(B)
MOVEM D,.RPCNT(A)]
SSRTX4: ADD A,WPSTE
SSRTX5: CAME A,B ;ALL DONE => DO NEXT BIT.
JRST SSRTX3 ;MORE IN THIS PASS.
ROT CH2,-1 ;NEXT BIT DOWN.
POP P,A ;A -> START, B -> END OF 1ST HALF.
JUMPL CH2,SSRTX6 ;ALL BITS IN WD DONE, STOP.
PUSHJ P,(AA) ;DO NEXT BIT ON 1ST HALF.
HLRZ B,(P) ;A -> END OF 1ST HALF, B -> END OF ALL.
PUSHJ P,(AA) ;DO SECOND HALF.
SSRTX6: ROT CH2,1 ;LEAVE CH2 AS FOUND IT.
SSRTX7: HLRZ A,(P) ;LEAVE A -> END OF AREA SORTED.
POPJ P,
;ARITHMETIC CONDITIONALS (B HAS JUMP<COND> A,)
COND: PUSH P,B ;SAVE CONDITIONAL JUMP
PUSHJ P,AGETFD ;GET FIELD TO TEST VALUE OF
CONDPP: POP P,T ;RESTORE CONDITIONAL JUMP INSTRUCTION
HRRI T,COND2 ;HRRI IN JUMP ADDRESS, GO TO COND2 IF CONDITIONAL TRUE
XCT T ;JUMP IF COND T,ASSEMBLE STRING
COND4: SETZM A.SUCC ;MOST RECENT CONDIT. FAILED.
COND5: JSP TM,ERMARK ;ERROR MSGS SHOULD SAY WHAT PSEUDO WE'RE IN.
CALL RCH
JSP D,RARL4 ;INIT FOR THE CONDITIONALIZED STUFF.
CAIA
CALL RARFLS ;READ AND IGNORE THE ARG.
JRST MACCR
ANULL: TLO FF,FLUNRD
JRST COND5
;.ELSE, .ALSO - B'S LH WILL HAVE SKIPE OR SKIPN.
A.ELSE: HRRI B,A.SUCC
XCT B
JRST COND4 ;CONDITION FALSE.
JRST COND2 ;TRUE.
;IF1, IF2 - B'S LH WILL HAVE TRNE FF, OR TRNN FF,
COND1: HRRI B,FRPSS2
XCT B
JRST COND4 ;NO
;CONDITION TRUE, ASSEMBLE STRING
COND2: SETOM A.SUCC ;LAST CONDITIONAL SUCCEEDED.
COND6: PUSHJ P,RCH ;GET NEXT CHAR
CAIE A,LBRKT
JRST [ CAIE A,LBRACE
TLO FF,FLUNRD
JRST MACCR]
SKIPN SCNDEP ;BRACKET TYPE CONDITIONAL.
SKIPE CONDEP
JRST COND7
MOVEMM CONDLN,CLNN ;AT TOP LEVEL, SAVE IN CASE THIS UNTERMINATED
MOVEMM CONDPN,CPGN
IFN TS, MOVEMM CONDFI,INFFN1
COND7: AOS SCNDEP ;COUNT IT FOR RBRAK'S SAKE.
JRST MACCR
;IFB, IFNB
SBCND: PUSH P,B ;SAVE TEST JUMP
SETZB B,C ;C COUNTS SQUOZE CHARS FOR IFB/IFNB
;B COUNTS NONSQUOZE FOR IFSQ/IFNSQ
JSP D,RARG ;INIT FOR READING OF ARG WHOSE BLANKNESS
JRST CONDPP ;IS TO BE TESTED.
JSP D,RARGCH(T) ;READ 1 CHAR,
JRST CONDPP ;(NO MORE CHARS)
HLRZ A,GDTAB(A) ;GET GDTAB ENTRY
CAIE A,(POPJ P,) ;POPJ => NOT SQUOZE
AOJA C,RARGCH(T)
AOJA B,RARGCH(T)
;IFDEF, IFNDEF
DEFCND: PUSH P,SYM
PUSH P,B ;SAVE CONDITIONAL JUMP
PUSHJ P,GETSLD ;GET NAME
CALL NONAME
PUSHJ P,ES
MOVEI A,0 ;UNDEFINED
IFN CREFSW,XCT CRFINU
CAIN A,GLOEXT_-14. ;GLOBAL EXIT...
SKIPL CONTRL ;DURING ABSOLUTE ASSEMBLY?
CAIN A,3 ;NO, LOCAL UNDEF?
MOVEI A,0 ;ONE OF THESE => UNDEF
REST SYM
EXCH SYM,(P) ;POP SYM OUT FROM UNDER THE CONDITIONAL JUMP.
JRST CONDPP
;;PWRD ;ROUTINES TO OUTPUT ASSEMBLES WORDS AND PORTIONS THEREOF
;HERE FROM PBITS TO OUTPUT WORD OF CODE BITS
PBITS3: PUSH P,A
MOVEI A,14
MOVEM A,PBITS2 ;INITIALIZE PBITS2 FOR COUNTING DOWN THROUGH NEXT SET OF CODE BITS
MOVE A,[440300,,PBITS1]
MOVEM A,BITP ;SET UP BITP FOR RELOADING PBITS1 WITH CODE BITS
MOVE A,PBITS1 ;NOW GET ACCUMULATED WORD OF BITS
MOVEM A,@PBITS4 ;STORE IN BKBUF
AOS A,OPT1 ;RESERVE SPACE FOR NEW WORD
;IF FRBIT7 SET (LAST CALL TO PBITS HAD 7) THEN NEXT WORD OF CODE BITS GOES
;AFTER NEXT WORD OUTPUT (REALLY!), OTHERWISE BEFORE
TRNN FF,FRBIT7
SOSA A
TRO FF,FRINVT
HRRZM A,PBITS4
POP P,A
CLEARM PBITS1
;DROPS THROUGH
;OUTPUT RELOCATION CODE BITS IN A
PBITS: SKIPGE CONTRL
POPJ P, ;NOT RELOCATABLE
SOSGE PBITS2
JRST PBITS3 ;NO MORE ROOM IN WORD, OUTPUT IT AND TRY AGAIN
CAIN A,7
TROA FF,FRBIT7
TRZ FF,FRBIT7
IDPB A,BITP
POPJ P,
;FOLLOWING ROUTINES SAVE AC'S EXCEPT FOR A
OUTSM0: MOVE A,SYM ;OUTPUT NAME STINK KNOWS SYMBOL BY.
TLZ A,37777 ;FOR LOCALS, THAT'S THE STE ADDR,
HRRI A,ST(D)
TLNN SYM,40000 ;FOR GLOBALS, THAT'S THE SQUOZE.
JRST $OUTPT
OUTSM: SKIPA A,SYM
OUTWD: MOVE A,WRD
$OUTPT: SKIPGE CONTRL ;DIRECTLY PUNCH OUT WORD IN A IN RELOCATABLE ASSEMBLY ONLY
POPJ P, ;DO NOTHING IF ABSOLUTE ASSEMBLY
PUSH P,AA
MOVE AA,OPT1
TRZN FF,FRINVT ;SKIP IF BEING HACKED FROM PBITS3, PUT WORD BEFORE WHERE IT NORMALLY BELONGS
AOS AA
MOVEM A,-1(AA)
MOVE A,CLOC
TRZE FF,FRFIRWD
HRRM A,BKBUF
POP P,AA
AOS A,OPT1
CAIL A,BSIZE+BKBUF
TRNE I,IRCONT
POPJ P,
;MAY DROP THROUGH
;END CURRENT OUTPUT BLOCK
EBLK: PUSH P,T
PUSH P,TT
PUSH P,A
PUSH P,B
MOVE T,CONTRL
JUMPGE T,EBLK3 ;JUMP IF RELOCATABLE ASSEMBLY
TRNE T,ARIM10\SBLKS
JRST ESBLK
TRNE T,DECSAV
JRST EDSBLK
IFN FASLP,[
TRNE T,FASL
JRST FASLE ;FASL HAS NO BLOCKS TO END - IGNORE
]
TRNE T,DECREL
JRST DECEBL
JRST EBLK5
EBLK3: MOVE T,PBITS1
MOVEM T,@PBITS4
MOVEI T,PBITS4
MOVEM T,PBITS4
MOVE T,[440300,,PBITS1]
MOVEM T,BITP
CLEARB TT,PBITS2
CLEARM PBITS1
MOVEI T,BKBUF
MOVE B,OPT1 ;GET POINTER TO END OF BLOCK
SUBI B,BKBUF+1 ;CONVERT TO # WORDS IN BLOCK (EXCLUDING HEADER)
DPB B,[220700,,BKBUF] ;SET COUNT FIELD IN HEADER
TRZN FF,FRLOC
JUMPLE B,EBLK5 ;IGNORE NULL BLOCK UNLESS FRLOC SET
TLO FF,$FLOUT ;INDICATE THAT OUTPUT HAS OCCURED (FOR 1PASS MULTIPLE-ASSEMBLY HACKING)
PUSHJ P,FEED
EBK1: CAML T,OPT1 ;DONE WITH BLOCK?
JRST EBK2 ;YES
MOVE A,(T) ;NO, GET DATA WORD
JFCL 4,.+1 ;UPDATE CHECKSUM
ADD TT,A
JFCL 4,[AOJA TT,.+1]
PUSHJ P,PPB ;OUTPUT WORD
AOJA T,EBK1
EBK2: SETCM A,TT ;DONE OUTPUTTING BLOCK, NOW GET CHECKSUM
PUSHJ P,PPB ;OUTPUT CHECKSUM
MOVE T,CDATBC ;GET BLOCK TYPE
DPB T,[310700,,BKBUF] ;SET NE T BLOCK TYPE TO STORAGE WORDS BLOCK TYPE
MOVEI T,BKBUF+1
MOVEM T,OPT1
EBLK4: TLO FF,$FLOUT ;INDICATE THAT OUTPUT HAS OCCURED (FOR 1PASS MULTIPLE-ASSEMBLY HACKING)
EBLK5: TRO FF,FRFIRWD
FASLE: POP P,B
POP P,A
PTT.TJ: POP P,TT
POP P,T
POPJ P,
;PUNCH OUT WORD OF CODED DATA (E.G. STORAGE WORD); WRD, WRDRLC, GLOTB ENTRIES
PWRDA: TROA FF,FRNLIK ;SUPPRESS ADR LINKING
PWRD: TRZ FF,FRNLIK ;PERMIT ADR LINKING
IFN LISTSW,[
SKIPN LSTONP
JRST PWRDL ;NOT MAKING LISTING NOW.
SKIPGE LISTPF
PUSHJ P,PNTR
SETOM LISTPF
MOVE LINK,WRD
MOVEM LINK,LISTWD
MOVE LINK,WRDRLC
MOVEM LINK,LSTRLC
MOVE LINK,CLOC
MOVEM LINK,LISTAD
MOVE LINK,CRLOC
DPB LINK,[220100,,LISTAD]
PWRDL:
] ;END IFN LISTSW,
JUMPGE FF,CPOPJ ;IGNORE IF NOT PUNCHING PASS
SKIPGE LINK,CONTRL
JRST PWRD1 ;ABSOLUTE ASSEMBLY
;RELOCATABLE ASSEMBLY
PUSHJ P,$RSET ;CHECK VALIDITY OF RELOCATION, STANDARDIZE IF NON-STANDARD
MOVE A,GLSP2
CAMN A,GLSP1
JRST PWRD2 ;NO GLOBALS
;NOW TO SEE IF IT'S POSSIBLE OR DESIRABLE TO ADDRESS LINK
HRLZ B,WRD
HRR B,WRDRLC
JUMPN B,PWRD3 ;JUMP IF RH NON-ZERO
TRNN FF,FRNLIK
SKIPGE GLOCTP
JRST PWRD3 ;ADR LINKING SUPPRESSED OR CLOC GLOBAL
SKIPE LDCCC
JRST PWRD3 ;IN LOAD TIME CONDITIONALS
MOVNI T,1 ;INITIALIZE T FOR COUNTING
PWRD4: CAML A,GLSP1
JRST PWRD5 ;DONE
HRRZ TT,1(A) ;GET GLOTB ENTRY
JUMPE TT,PWRD7A
LDB TT,[400400,,(TT)] ;GET SQUOZE FLAGS FROM SYM
CAIE TT,DEFGVR_-14.
CAIN TT,GLOETY_-14.
JRST PWRD3 ;DEFINED, BUT MUST BE HERE FOR A REASON (SEE $.H)
HLRZ TT,1(A)
TRNE TT,1777+MINF
JRST PWRD3 ;NEGATED OR MULTIPLIED
TRNE TT,HFWDF
JRST PWRD7
TRNE TT,ACF
TRNN TT,SWAPF
JRST PWRD3 ;NOT HIGH AC
PWRD7A: AOJA A,PWRD4
PWRD7: TRNE TT,SWAPF
AOJA A,PWRD4 ;LEFT HALF
AOJN T,PWRD3 ;JUMP IF THIS NOT FIRST GLOBAL IN RIGHT HALF
MOVEI D,1(A) ;FIRST GLOBAL, SET UP POINTER TO GLOTB ENTRY
AOJA A,PWRD4
PWRD5: AOJE T,PWRD3 ;NO GLOBALS LOOK BAD AND THERE AREN'T TOO MANY; JUMP IF NONE IN RH
HRRZ T,(D) ;GET ADR OF SQUOZE
SKPST T, ;SKIP IF IN SYMBOL TABLE
JRST PWRD3 ;BELOW SYMBOL TABLE, DON'T ADDRESS LINK AFTER ALL
PUSH P,T ;HOORAY, WE CAN ADDRESS LINK
SETZM (D) ;CLEAR OUT GLOTB ENTRY, DON'T NEED IT ANY MORE
PUSHJ P,PWRD31 ;DUMP OUT THE OTHER GLOBALS
POP P,D ;GET ST ADR OF THIS AGAIN
3GET1 A,D
LDB A,[.BP (3RLNK),A]
MOVE B,WRDRLC
TLNE B,1
TRO A,2 ;RELOCATE LEFT HALF
PUSHJ P,PBITS ;PUNCH OUT APPROPRIATE BITS FOR LINK LIST ENTRY
HLR A,1(D) ;GET ADR OF LAST
HLL A,WRD
PUSHJ P,$OUTPT ;OUTPUT WORD WITH RH = ADR OF LAST RQ FOR SYM TO PUT IN RH'S
MOVE A,CLOC ;NOW UPDATE ST ENTRY
HRLM A,1(D)
3GET1 B,D
SKIPN CRLOC
TLZA B,3RLNK ;CLOC NOT RELOCATED LAST TIME THIS SYM USED
TLO B,3RLNK ;RELOCATED
3PUT1 B,D
POPJ P,
PWRD31: MOVE T,GLSP2 ;DUMP ALL GLO S IN GENERAL FORMAT
PWRD3A: CAML T,GLSP1
POPJ P,
MOVE B,1(T)
TRNN B,-1
AOJA T,PWRD3A
TLNE B,1777
JRST RPWRD ;REPEAT
RPWRD1: LDB A,[.BP (MINF),B]
TRO A,4
PUSHJ P,PBITS
MOVE A,(B) ;CODEBITS +SQUOZE FOR SYM
HLRZ C,A
TLZ A,740000
CAIL C,DEFGVR
TLOA A,40000 ;SYM IS GLO
JRST [
MOVEI C,(B) ;IF WE ARE OUTPUTTING A REFERENCE TO THE
CAIL C,PCNTB ;"LABEL" AT THE BEGINNING OF A CONSTANTS AREA
CAIL C,PCNTB+NCONS*3 ;(BECAUSE THIS IS A 1PASS ASSEMBLY) USE THE
MOVEI A,(B) ;NAME, SINCE THE SYMBOL ISN'T IN THE
JRST .+1] ;SYMTAB
TLNE B,SWAPF
TLO A,400000
TLNE B,ACF
JRST PWRD3E ;AC HIGH OR LOW
TLNN B,HFWDF
JRST PWRD3F ;ALL THROUGH
TLO A,100000
TLNE B,SWAPF
TLC A,300000
PWRD3F: PUSHJ P,$OUTPT
AOJA T,PWRD3A
RPWRD: PUSHJ P,PBITS7
MOVEI A,CRPT
PUSHJ P,PBITS
LDB A,[221200,,B]
PUSHJ P,$OUTPT
JRST RPWRD1
PWRD3E: TLO A,300000
JRST PWRD3F
PWRD3: PUSHJ P,PWRD31
PWRD2: PUSHJ P,RCHKT
HRRZ A,B
DPB T,[10100,,A]
PUSHJ P,PBITS
JRST OUTWD
;CHECK FOR VALIDITY OF RELOCATION BITS OF CURRENT WORD
;LEAVE RELOC (RH) IN B, RELOC (LH) IN T
RCHKT: HRRZ B,WRDRLC ;CHECK FOR RELOC. OTHER THAN 0 OR 1.
HLRZ T,WRDRLC
TRZN B,-2
TRZE T,-2
RLCERR: ETSM [ASCIZ /Illegal relocation/]
POPJ P,
RMOVET: ROT T,-1
DPB B,[420100,,T]
TLZ C,3DFCLR ;SET RELOC BITS IN C
IOR C,T ;FROM B AND T.
POPJ P,
;CHECK WRDRLC FOR VALIDITY (CAPABILITY OF BEING PUNCHED OUT)
;IF STANDARD THEN JUST RETURN
;IF NON-STANDARD BUT OTHERWISE OK, PUT $R. ON GLOBAL LIST, RESET WRDRLC, AND RETURN
;LEAVES B AND C SET UP WITH RH, LH OF WRDRLC.
$RSET: MOVE C,WRDRLC ;GET RELOCATION
ADDI C,400000 ;WANT TO SEPARATE HALFWORDS
HLRE B,C ;GET LH IN B
HRREI C,400000(C) ;GET RH IN C (WILL EXCHANGE LATER)
MOVE A,[SWAPF+HFWDF,,$R.H] ;PUT THIS ON GLOBAL LIST IF LH NEEDS $R.
TRNE B,-2 ;CHECK LH
PUSHJ P,$RSET1 ;LH NEEDS GLOBAL REFERENCE
EXCH B,C
HRLI A,HFWDF
TRNE B,-2 ;CHECK RH
PUSHJ P,$RSET1 ;RH NEEDS GLOBAL REFERENCE
HRLZM C,WRDRLC ;RELOC OF LH
ADDM B,WRDRLC ;COMPLETE SETTING UP WRDRLC
POPJ P,
$RSET1: JUMPGE B,$RSET2 ;STRANGE RELOCATION IN B, JUMP IF NON-NEGATIVE
MOVN T,B ;NEGATIVE, GET MAGNITUDE
TLOA A,MINF ;SET FLAG TO NEGATE GLOBAL
$RSET2: SOSA T,B ;POSITIVE, GET ONE LESS THAN IT IN T
TDZA B,B ;NEGATIVE, CLEAR B, RELOCATION LEFT OVER
MOVEI B,1 ;POSITIVE, SET RELOCATION LEFT OVER TO 1
CAIN T,1
MOVEI T,0 ;MULTIPLYING BY TWO OR SUBTRACTING TIMES 1
TRNE T,-2000
ETSM [ASCIZ /Relocation too large/] ;TOO BIG EVEN FOR $RSET
DPB T,[221200,,A] ;LOOKS OK, STORE TIMES FIELD IN $R. REFERENCE
AOS GLSP1 ;NOW PUT $R. ON GLOBAL LIST
MOVEM A,@GLSP1
POPJ P,
;PWRD DURING ABSOLUTE ASSEMBLY
PWRD1: TRNE LINK,DECREL ; DEC REL FMT IS CONSIDERED ABSOLUTE.
JRST DECPW
IFN FASLP,[
TRNE LINK,FASL
JRST FASPW ;SO IS FASL
]
MOVE A,GLSP1
CAME A,GLSP2
ETR ERRILG ;GLOBALS APPEARING ILLEGALLY
SKIPE WRDRLC
ETR ERRIRL ;RELOCATION APPEARING ILLEGALLY
TRNE LINK,ARIM
JRST PRIM ;RIM
TRNE LINK,DECSAV
JRST DSBLK1
SBLKS1: MOVE A,WRD ;SBLK
MOVEM A,@OPT1 ;STORE WRD IN BKBUF
MOVE A,CLOC
TRZE FF,FRFIRWD
MOVEM A,BKBUF ;FIRST WORD OF BLOCK, SET UP HEADER
AOS A,OPT1
CAIGE A,BKBUF+BSIZE
POPJ P, ;BKBUF NOT FULL YET
SBLKS2: SUBI A,BKBUF+1
JUMPE A,CPOPJ
MOVNS A
HRLM A,BKBUF
PUSHJ P,FEED
MOVEI T,BKBUF
CLEARM SCKSUM
SBLK1: CAML T,OPT1
JRST SBLK2
MOVE A,SCKSUM
ROT A,1
ADD A,(T)
MOVEM A,SCKSUM
MOVE A,(T)
PUSHJ P,PPB
AOJA T,SBLK1
SBLK2: TRO FF,FRFIRWD
MOVEI A,BKBUF+1
MOVEM A,OPT1
MOVE A,SCKSUM
JRST PPB
ESBLK: MOVE A,OPT1
CAIN A,BKBUF+1
JRST EBLK5 ;AVOID SETTING $FLOUT IF NULL BLOCK.
PUSHJ P,SBLKS2
JRST EBLK4
PRIM: MOVSI A,(DATAI PTR,)
HRR A,CLOC
PUSHJ P,PPB
MOVE A,WRD
JRST PPB
; COME HERE TO OUTPUT WD IN ABSOLUTE DEC FMT (DECSAV)
DSBLK1: MOVE A,WRD
MOVEM A,@OPT1 ;STORE WRD IN BKBUF
MOVE A,CLOC
TRZE FF,FRFIRWD
MOVEM A,BKBUF ;FIRST WORD OF BLOCK, SET UP HEADER
AOS A,OPT1
CAIGE A,BKBUF+BSIZE
POPJ P, ;BKBUF NOT FULL YET, RETURN
DSBLK2: SUBI A,BKBUF+1
JUMPE A,CPOPJ
MOVNS A
SOS BKBUF ; DEC "IOWD" FMT, POINT AT LOC-1
HRLM A,BKBUF
PUSHJ P,FEED
MOVEI T,BKBUF
DSBLK3: CAML T,OPT1
JRST DSBLK4
MOVE A,(T)
PUSHJ P,PPB
AOJA T,DSBLK3
DSBLK4: TRO FF,FRFIRWD
MOVEI A,BKBUF+1
MOVEM A,OPT1
POPJ P,
; END A BLOCK IN DEC SAV FMT, COME HERE FROM EBLK.
EDSBLK: MOVE A,OPT1
CAIN A,BKBUF+1
JRST EBLK5 ;AVOID SETTING $FLOUT IF NULL BLOCK.
PUSHJ P,DSBLK2
JRST EBLK4
;END A BLOCK IN DEC FMT. COME FROM EBLK.
DECEBL: PUSH P,[EBLK5]
DECEB1: MOVSI A,DECWDS ;JUST INIT. AN ORDINARY BLOCK,
;COME HERE TO OUTPUT PREVIOUS BLOCK AND START NEW BLOCK OF TYPE IN LH OF A.
DECBLK: PUSH P,A
HRRZ A,BKBUF ;GET DATA-WORD COUNT OF CURRENT BLOCK.
JUMPE A,DECB1 ;NO WORDS => CAN IGNORE.
MOVEI TT,BKBUF+1
DECB0: MOVE A,-1(TT) ;GET AND PUNCH NEXT WD OF BLOCK.
PUSHJ P,PPB
CAME TT,OPT1 ;STOP WHEN NEXT WD ISN'T IN BLOCK.
AOJA TT,DECB0
DECB1: POP P,A
HLLZM A,BKBUF ;PUT BLOCK TYPE IN LH OF HEADER, DATA WD COUNT IN RH IS 0.
MOVEI TT,BKBUF+2 ;ADDR OF PLACE FOR 1ST DATA WD
MOVEM TT,OPT1 ;(LEAVE SPACE FOR WD OF RELOC BITS)
MOVE TT,[440200,,BKBUF+1]
MOVEM TT,BITP ;BP FOR STORING PAIRS OF RELOC BITS.
SETZM BKBUF+1 ;CLEAR THE WD OF RELOC BITS.
TLO FF,$FLOUT
POPJ P,
;COME HERE TO OUTPUT A WORD IN DEC FORMAT.
DECPW: MOVS A,BKBUF
CAIE A,DECWDS ;BEFORE THE 1ST STORAGE WD IN ORDINARY BLOCK,
JRST DECPW0
MOVE A,CRLOC ;MUST GO THE LOCATION CTR.
IDPB A,BITP
MOVE A,CLOC
MOVEM A,@OPT1
AOS OPT1
AOS BKBUF ;IT COUNTS AS DATA WORD.
DECPW0: MOVE A,BITP
TLNE A,77^4 ;IF NO ROOM FOR MORE RELOC BITS,
JRST DECPW1
HLLZ A,BKBUF ;START A NEW BLOCK.
PUSHJ P,DECBLK
JRST DECPW
DECPW1: PUSHJ P,$RSET ;SET UP RELOC BITS OF HALVES IN B,C.
LSH C,1
IORI B,(C) ;COMBINE THEM.
MOVE A,GLSP1
CAME A,GLSP2
JRST DECPG ;GO HANDLE GLOBALS.
DECPW3: IDPB B,BITP ;STORE THE RELOC BITS
MOVE A,WRD
DECPW2: MOVEM A,@OPT1 ;AND THE VALUE.
AOS OPT1
AOS BKBUF
POPJ P,
;PUT A WORD DIRECTLY INTO DEC FMT BLOCK.
DECWRD: SETZ TM,
DECWR1: IDPB TM,BITP ;SKIP A PAIR OF RELOC BITS,
JRST DECPW2 ;STORE THE WORD.
;HANDLE GLOBAL REFS IN DEC FMT.
DECPG: PUSHJ P,DECPW3 ;FIRST, OUTPUT THE WORD,
DECPG0: MOVSI A,DECSYM
PUSHJ P,DECBLK ;THEN STRT A SYMBOLS BLOCK.
MOVE C,GLSP2
PUSH P,SYM
DECPG1: CAMN C,GLSP1 ;ALL DONE =>
JRST DECPG2 ;GO START AN ORDINARY BLOCK FOR NEXT WD.
MOVE A,BITP
TLNN A,77^4 ;BLOCK FULL => START ANOTHER.
JRST DECPG0
AOS C,GLSP2 ;GET ADDR OF NEXT GLOBAL REF.
MOVE B,(C)
MOVE B,(B) ;GET NAME OF SYM.
TLZ B,740000
CAMN B,[SQUOZE 0,$R.]
JRST DECPG3 ;(DEC'S LOADER HAS NO SUCH HACK.)
CALL ASQOZR ;RIGHT-JUSTIFY THE SQUOZE FOR DEC SYSTEM.
MOVE A,B
TLO A,600000 ;PUT IN FLAGS SAYING ADDITIVE GLOBAL RQ.
PUSHJ P,DECWRD ;OUTPUT NAME.
HRRZ A,CLOC ;GET ADDR OF RQ,
TLO A,400000 ;MACRO-10 SETS THIS BIT SO I WILL.
MOVE B,(C)
TLNE B,SWAPF ;SWAPPED => TELL LOADER..
TLO A,200000
TLNE B,ACF+MINF
ETSM ERRILG ;CAN'T NEGATE GLOBAL OR PUT IN AC.
MOVE TM,CRLOC
PUSHJ P,DECWR1 ;OUTPUT 2ND WD,
JRST DECPG1 ;GO BACK FOR MORE GLOBAL REFS.
DECPG2: REST SYM
JRST DECEB1
DECPG3: ETR ERRIRL ;WE NEEDED $R. BUT DIDN'T HAVE IT.
JRST DECPG1
ERRILG: ASCIZ /Illegal use of external/
ERRIRL: ASCIZ /Illegal use of relocatables/
;OUTPUT PROGRAM NAME BLOCK (AT START OF PASS 2)
;IF 2-SEG PROGRAM, ALSO OUTPUT A TYPE-3 BLOCK (LOAD INTO HISEG)
DECPGN: JUMPGE FF,CPOPJ ;ONLY ON PASS 2.
PUSH P,[EBLK]
MOVSI A,DECNAM
CALL DECBLK
MOVE B,PRGNM
CALL ASQOZR
MOVE A,B
CALL DECWRD
MOVSI A,14 ;IDENTIFY THIS REL FILE AS MADE BY MIDAS.
CALL DECWRD
MOVE A,DECTWO
CAMN A,[MOVE]
RET ;NOT A 2-SEG PROGRAM.
DECP2S: MOVSI A,DECHSG
CALL DECBLK ;START A LOAD-INTO-HISEG BLOCK.
MOVE A,DECTWO
HRL A,DECBRH ;HISEG BRK,,TWOSEG ORIGIN.
SKIPL A
HRLI A,(A)
MOVEI TM,1 ;RELOCATION IS 1.
JRST DECWR1
IFN FASLP,[
;INITIALIZE OUTPUT FOR FASL ASSEMBLY
FASOIN: JUMPGE FF,CPOPJ ;ONLY ON PASS 2
MOVE A,[SIXBIT /*FASL*/]
PUSHJ P,PPB
MOVE A,[MIDVRS]
LSH A,-6
TLO A,(SIXBIT /M/)
PUSHJ P,PPB ;"LISP" VERSION NUMBER (USE M AND MIDAS NUMBER)
MOVE A,[440400,,FASB] ;INITIALIZE FASL OUTPUT BUFFER
MOVEM A,FASCBP
MOVEI A,FASB+1
MOVEM A,FASBP
POPJ P,
;COME HERE TO OUTPUT A WORD IN FASL FORMAT
FASPW: MOVE C,FASPCH
CAME C,FASATP
PUSHJ P,FPATB ;"PUNCH" OUT ATOM TBL (IF MORE HAS APPEARED)
PUSHJ P,$RSET ;GET RELOC
PUSH P,C ;SAVE LH RELOC
MOVEM B,FASPWB ;B HAS RELOC, WHICH IS ALSO FASL CODE FOR RELOC =1
MOVE A,GLSP2
FASPW3: CAME A,GLSP1
JRST FASPW1 ;LOOK TO SEE ..
FASPW2: MOVE A,WRD ;B HAS RELOC, WHICH ALSO HAPPENS TO BE FASL CODE TYPE
MOVE B,FASPWB
PUSHJ P,FASO ;OUTPUT WORD IN A WITH FASL CODE IN B
POP P,TM
JUMPE TM,FASPW5 ;NO LEFT HALF RELOC, OK
MOVNI A,1 ;ACTIVATE FASL HACK FOR LH RELOC
MOVEI B,7 ;WOULD OTHERWISE BE GETDDTSYM
PUSHJ P,FASO
FASPW5: MOVE C,GLSP2
FASPW6: CAMN C,GLSP1
POPJ P,
HRRZ TM,1(C)
JUMPE TM,[AOJA C,FASPW6]
MOVE SYM,(TM) ;GET SQUOZE OF SYM
TLZ SYM,740000 ;CLEAR CODE BITS
HLRZ D,1(C)
TRZ D,400000 ;DONT WORRY ABOUT THAT BIT
TRZE D,MINF
TLO SYM,400000 ;NEGATE
CAIN D,SWAPF
JRST FSPWSW
CAIN D,HFWDF
JRST FSPWRH
CAIN D,ACF+SWAPF
JRST FSPWAC
JUMPE D,FSPWWD
ETSM [ASCIZ /Global in illegal FASL context/]
FSPWWD: TLOA SYM,140000
FSPWAC: TLOA SYM,100000
FSPWRH: TLO SYM,40000
FSPWSW: MOVE A,SYM
MOVEI B,7 ;DDT SYM
PUSHJ P,FASO
AOJA C,FASPW6
FASPW1: HRRZ TM,1(A) ;GLOTB ENTRY
JUMPE TM,FASPW4
CAIL TM,AFDMY1
CAIL TM,AFDMY2
FASPW4: AOJA A,FASPW3
MOVE C,1(A) ;ITS A LIST STRUCTURE REF
TLNN C,-1-HFWDF
SKIPE FASPWB
ETA [ASCIZ /Illegal LISP structure reference/]
MOVE TM,AFDMY2-AFDMY1(TM) ;GET FASL BITS
MOVEM TM,FASPWB ;FASL BITS
CLEARM 1(A) ;FLUSH THAT GUY
AOJA A,FASPW3
FPATB: CAMN C,FASATP ;PUNCH OUT ATOM TBL, AMT ALREADY PUNCHED IN C
POPJ P, ;THRU
MOVEI B,12 ;ATOM TBL INFO
MOVE A,FASAT(C)
TRNN A,-1
AOJA C,FPATB3 ;LIST WORD .. SHOULD HAVE PUNCHED ITSELF
PUSHJ P,FASO
HRRZ D,FASAT(C) ;ATOM "LENGTH"
AOS C
FPATB1: SOJL D,FPATB2
MOVE A,FASAT(C)
PUSHJ P,FASO1
AOJA C,FPATB1
FPATB3: ETR [ASCIZ /Internal loss at FPATB3/]
FPATB2: MOVEM C,FASPCH ;RECORD AMOUNT PUNCHED
JRST FPATB ;LOOP BACK IF MORE
FASO: PUSHJ P,FASBO ;WRITE BITS
FASO1: MOVEM A,@FASBP ;STORE A IN FASL OUTPUT BUFFER
AOS TM,FASBP
CAIL TM,FASB+FASBL
ETF [ASCIZ /.FASL output block too long/]
POPJ P,
FASBO: MOVE TM,FASCBP ;OUTPUT FASL CODEBITS IN B, WRITE PREV BLOCK IF NECC
TLNN TM,770000
PUSHJ P,FASBE ;WRITE PREV FASL BLOCK
IDPB B,FASCBP
POPJ P,
FASBE: PUSH P,A
PUSH P,B
MOVEI TT,FASB
FASBO2: CAML TT,FASBP
JRST FASBO3
MOVE A,(TT)
PUSHJ P,PPB
AOJA TT,FASBO2
FASBO3: POP P,B
POP P,A
CLEARM FASB ;NEW CODE WORD
MOVEI TM,FASB+1
MOVEM TM,FASBP
SOS FASCBP
POPJ P,
AFATOM: PUSH P,B ;SAVE CODEBITS
SKIPGE B,CONTRL
TRNN B,FASL
ETI [ASCIZ /.ATOM illegal except in FASL assembly/]
PUSHJ P,AFRATM ;READ "ATOM", RETURN INDEX IN A
POP P,B
HLRZS B
AFLST1: AOS GLSP1
MOVEI T,AFDMY1(B) ;DUMMY (STORE THIS INFO IN SYM SO CONSTANTS WILL WIN
HRRZM T,@GLSP1
MOVEI B,0 ;NO RELOCATION
POPJ P,
;GLOBALS IN THIS TABLE KEEP TRACK OF LIST REFS
;UNDEF GLOBAL GODEBITS
AFDMY1: SQUOZE 44,.%VCEL ;EVENTUALLY POINT TO VALUE CELL
SQUOZE 44,.%SCAL ;EVENTUALLY BECOME "SMASHABLE CALL"
SQUOZE 44,.%ATM ;EVENTUALLY POINT TO ATOM
SQUOZE 44,.%ARY ;EVENTUALLY POINT TO ARRAY
AFDMY2: 2 ;CODE BITS FOR VALUE CELL REF
3 ;CODE BITS FOR SMASHABLE CALL
4 ;CODE BITS FOR POINTER TO ATOM
10 ;CODE BITS FOR POINTER TO ARRAY
AFRATM: PUSHJ P,AFRTKN ;READ TOKEN, LEAVING IT AT END OF FASAT
PUSHJ P,AFRITN ;"INTERN" IT, SKIP IF NOT FOUND
POPJ P, ;IF FOUND, INDEX IN A
PUSHJ P,AFRENT ;ENTER IN FASAT
POPJ P,
AFRENT: MOVE A,FASAT1 ;STORE FASAT1 IN FASATP
MOVEM A,FASATP
AOS A,FASIDX ;RETURN LOAD TIME ATOM INDEX
POPJ P,
AFRTKN: MOVE A,FASATP
ADD A,[700,,FASAT]
MOVEM A,FASAT2 ;BYTE PNTR TO USE TO STORE ATOM
CLEARM (A)
CLEARM 1(A) ;MAKE SURE ALL LOW BITS CLEARED
PUSHJ P,RCH
CAIN A,"#
JRST AFRTK1 ;READ NUMBER INTO FIXNUM SPACE
CAIN A,"&
JRST AFRTK2 ;READ NUMBER INTO FLONUM SPACE
AFRTKL: IDPB A,FASAT2 ;STORE CHAR
HRRZ A,FASAT2
CAIL A,FASAT+FASATL-1
AFTERR: ETA [ASCIZ /LISP atom name table full/]
CLEARM 1(A)
AFRTL2: PUSHJ P,RCH
CAIN A,12
JRST AFRTL2 ;IGNORE LF IN ATOM NAMES (PRIMARILY SO /CR WINS WITH ONE
CAIN A,"/ ;SLASH
JRST AFRQT ;QUOTE CHAR
CAIE A,40
CAIN A,15
JRST AFREND
CAIE A,";
CAIN A,11
JRST AFREND
CAIE A,"(
CAIN A,")
JRST AFREN2
CAIL A,"A+40
CAILE A,"Z+40
JRST AFRTKL ;THAT CHAR WINS, SALT IT
SUBI A,40
JRST AFRTKL ;MAYBE MUST CONVERT TO L.C. BEFORE SALTING IT.
AFRQT: PUSHJ P,RCH ;TAKE NEXT CHR NO MATTER WHAT
JRST AFRTKL
AFRTK1: SKIPA TM,[100000,,1] ;PUT VAL IN FIXNUM SPACE
AFRTK2: MOVE TM,[200000,,1] ;PUT IT IN FLONUM SPACE
PUSH P,TM
MOVE SYM,[SQUOZE 0,ATOM]
PUSHJ P,FAGTFD
POP P,TM
MOVE B,FASATP
ADDI B,2
CAIL B,FASAT+FASATL
XCT AFTERR
MOVEM TM,FASAT-2(B)
MOVEM A,FASAT-1(B)
MOVEM B,FASAT1
POPJ P,
AFREN2: TLO FF,FLUNRD ;SAVE ( OR ) AS WELL AS FLUSHING
AFREND: MOVEI B,5 ;PAD END OF P.N. WITH 0 S
MOVEI TM,0
AFREN1: IDPB TM,FASAT2
HRRZ A,FASAT2
CAIL A,FASAT+FASATL-1
XCT AFTERR
CLEARM 1(A)
SOJG B,AFREN1
SUBI A,FASAT
MOVEM A,FASAT1 ;STORE PNTR TO WORD BEYOND ATOM
; MAYBE PUT THIS IN FASATP
MOVE B,FASATP ;ADR OF START OF ATOM READ
SUBI A,1(B) ;COMPUTE LENGTH OF FASAT
HRRZM A,FASAT(B) ;PN ATOM 4.8-4.7 =0 STORE LENGTH IN HEADER WD
POPJ P,
AFRITN: MOVEI B,0 ;"INTERN" LAST ATOM READ IN
MOVEI A,1 ;A CONTAINS RUNTIME ATOM TBL INDEX
;B INDEX WITHIN FASAT
AFRIT1: CAML B,FASATP
JRST POPJ1 ;NOT FOUND
MOVE C,FASATP ;POINTS AT HEADER OF WORD OF NEW (?) ATOM
HRRZ D,FASAT(B) ;HEADER WD OF GUY IN TBL(RIGHT HALF HAS LENGTH)
JUMPE D,AFRIT4 ;JUMP ON RESERVED FOR LIST
AFRIT2: MOVE TM,FASAT(C)
CAME TM,FASAT(B)
AOJA B,AFRIT3 ;THIS ONE LOSES
SOJL D,CPOPJ ;THIS ONE WINS!
AOS B
AOJA C,AFRIT2
AFRIT3: SOJL D,[AOJA A,AFRIT1] ;FINISH SPACING OVER THIS GUY
AFRIT4: AOJA B,AFRIT3
AFENTY: SKIPGE B,CONTRL
TRNN B,FASL
ETI [ASCIZ /.ENTRY in NON-FASL/]
SKIPN CRLOC
ETI [ASCIZ /.ENTRY when . is absolute/]
PUSHJ P,AFRATM ;READ FUNCTION NAME
HRLZS A
PUSH P,A
PUSHJ P,AFRATM ;READ TYPE (SUBR, LSUBR, ETC)
HRRM A,(P)
MOVE SYM,[SQUOZE 0,.ENTRY]
PUSHJ P,FAGTFD ;READ ARGS PROP
JUMPGE FF,ASSEM1 ;NOT PUNCHING PASS
PUSH P,A
MOVE C,FASPCH
CAME C,FASATP
PUSHJ P,FPATB ;MAKE SURE ANY NEW ATOMS OUT
POP P,C
POP P,A
MOVEI B,13
PUSHJ P,FASO
HRL A,C
HRR A,CLOC
PUSHJ P,FASO1
JRST ASSEM1
AFLIST: HLRZM B,AFLTYP
SKIPGE B,CONTRL
TRNN B,FASL
ETI [ASCIZ /.LIST illegal except in FASL assembly/]
PUSHJ P,AFRLST ;READ LIST, RTN ATM TBL INDEX IN A
SKIPN AFLTYP
JRST ASSEM1 ;JUST EVAL IN LISP AND THROW AWAY VALUE
MOVEI B,AFDMAI ;"ATOM" INDEX IN AFDMY1 TBL
JRST AFLST1 ;TREAT AS ATOM
AFRLST: CLEARM AFRLD ;"DEPTH"
CLEARM AFRLEN ;"LENGTH" OF LIST AT CURRENT LEVEL
CLEARM AFRDTF ;DOT CONTEXT FLAG
JUMPGE FF,AFRLI1
MOVE C,FASPCH
CAME C,FASATP
PUSHJ P,FPATB ;MAKE SURE ALL ATOMS "PUNCHED"
MOVE A,FASATP
MOVEM A,AFRFTP ;SAVED STATE OF FASAT POINTER
MOVE C,AFLTYP
MOVEI B,16 ;EVAL TYPE HACK
CAIN C,1
MOVEI B,5 ;LIST TYPE HACK
PUSHJ P,FASBO ;WRITE CODE BITS
AFRLI1:
AFRL1: PUSHJ P,RCH
CAIE A,40 ;PREV ATOM (OR WHATEVER) "DELIMITED", SO THESE MEANINGLESS
CAIN A,15 ;UNLESS AT TOP LEVEL AND HAVE READ SOMETHING
JRST AFRL1A
CAIE A,11
CAIN A,12
JRST AFRL1A
CAIN A,"(
JRST AFRLO
CAIN A,")
JRST AFRLC
CAIN A,".
JRST AFRDT ;DOT..
TLO FF,FLUNRD
SKIPE AFRLD
JRST AFRNXT ;READ NEXT GUY THIS LVL
SKIPE AFRLEN
AFRLO2: ETI [ASCIZ /LISP read context error/]
AFRNXT: SKIPN TM,AFRDTF
JRST AFRNX2 ;NOT HACKING DOTS, OK
AOS TM,AFRDTF
CAIE TM,2
JRST AFRLO2 ;DIDNT JUST SEE THE DOT
AFRNX2: PUSHJ P,AFRATM
JUMPGE FF,AFRNX1 ;XFER ON NOT PUNCHING PASS
PUSHJ P,FASO1 ;TELL LOADER TO PUSH THIS ON ITS STACK
AFRNX1: AOS AFRLEN ;LIST NOW ONE LONGER THIS LVL
JRST AFRL1
AFRLO: SKIPN TM,AFRDTF
JRST AFRLO3 ;NOT HACKING DOTS
SOJN TM,AFRLO2
CLEARM AFRDTF
JRST AFRL1 ;IGNORE BOTH . AND (
AFRLO3: SKIPE AFRLD ;(
JRST AFRLO1
SKIPE AFRLEN
JRST AFRLO2
AFRLO1: PUSH P,AFRLEN
CLEARM AFRLEN ;START NEW LVL
AOS AFRLD ;DEPTH NOW ONE GREATER
JRST AFRL1
AFRLC: SOSGE AFRLD ;)
JRST AFRLO2 ;AT TOP LEVEL, BARF
MOVE A,AFRLEN
SKIPN TM,AFRDTF
JRST AFRLC2 ;NOT HACKING DOTS
CAIE TM,2
JRST AFRLO2
SOS A ;MAIN LIST NOW ONE SHORTER
TLOA A,200000 ;DOT WITH LAST THING ON STACK
AFRLC2: TLO A,100000 ;TELL LOADER TO MAKE LIST THIS LONG
JUMPGE FF,AFRLC5
PUSHJ P,FASO1
AFRLC5: POP P,AFRLEN ;LENGTH AT PREV LVL
AOS AFRLEN ;NOW ONE MORE
CLEARM AFRDTF ;NOT HACKING DOTS NOW
SKIPE AFRLD ;RETURNING TO TOP LEVEL?
JRST AFRL1
JRST AFRX1 ;YES THRU
AFRDT: SKIPN AFRDTF
SKIPN AFRLEN
JRST AFRLO2 ;DOT IN FIRST POSITION OF LIST
AOS AFRDTF ;ENTER STATE 1 OF DOT HACKING
JRST AFRL1
AFRL1A: SKIPN AFRLD ;SPACER CHAR TERMINATES AT TOP LVL IF HAVE RD SOMETHING
SKIPN AFRLEN
JRST AFRL1
AFRX1: JUMPGE FF,AFRX2 ;NOT PUNCHING PASS
MOVE A,AFRFTP
CAME A,FASATP
ETR [ASCIZ /Saw atoms in list on pass 2 for first time/]
SKIPN B,AFLTYP ;TYP LIST OP
SKIPA A,[-1,,]
MOVSI A,-2 ;PUT LIST OR VALUE OF LIST IN ATOM TBL
PUSHJ P,FASO1 ;TERM OP AND PUT IT IN ATOM TBL
MOVEI A,0
MOVE B,AFLTYP
JUMPE B,CPOPJ ;JUST WANT VALUE OF LIST
CAIN B,1 ;ONLY WANT THIS FOR STRAIGHT LIST
PUSHJ P,FASO1 ;OUTPUT "SXHASH" WORD
AOS A,FASATP
CLEARM FASAT-1(A) ;RESERVE SLOT IN FASAT TBL
MOVEM A,FASPCH ;SAY ALREADY PUNCHED OUT
AOS A,FASIDX
POPJ P,
AFRX2: TLO I,ILNOPT ;DONT TRY TO OPTIMIZE IF IN CONSTANT
CLEARB A,B
POPJ P,
]
;.LIBRA, .LIFS, ETC.
A.LIB: NOVAL ? NOABS
HLRZM B,LIBTYP' ;STORE BLOCK TYPE TO OUTPUT
CLEARM LIBOP ;INITIALIZE SQUOZE FLAGS
PUSHJ P,EBLK ;END CURRENT OUTPUT BLOCK, MAKING SURE LOADER KNOWS $.
LIB1: PUSHJ P,GETSYL ;GET NAME
TRNN I,IRSYL
JRST LIB2 ;NO SYL, DON'T OUTPUT
IOR SYM,LIBOP
TLO SYM,40000
PUSHJ P,OUTSM
MOVSI A,400000
ANDCAM A,LIBOP
LIB2: MOVE B,CDISP ;GET CDISP
TLNN B,DWRD\DFLD ;CHECK FOR WORD TERMINATOR
JRST LIB3 ;WORD TERMINATOR => DONE
MOVE A,LIBOP
MOVE B,LIMBO1 ;RETRIEVE LAST CHAR READ
CAIN B,",
MOVSI A,400000
CAIN B,"+
TLZ A,200000
CAIN B,"-
TLO A,200000
MOVEM A,LIBOP' ;STORE SQUOZE FLAGS (LESS GLBL BIT) FOR NEXT SYM
JRST LIB1
LIB3: MOVE A,LIBTYP ;GET BLOCK TYPE TO OUTPUT
DPB A,[310700,,BKBUF]
PUSHJ P,EBLK
CAIN A,LLIB ;.LIBRA?
JRST ARELC1 ;.LIBRA, NOW PLAY LIKE RELOCA PSEUDO
JRST LIB5 ;SOMETHING ELSE (.LIFS), INCREMENT DEPTH IN LOAD TIME CONDITIONALS
A.ELDC: NOVAL ? NOABS
PUSHJ P,EBLK
MOVEI A,ELTCB
DPB A,[310700,,BKBUF]
TRO FF,FRLOC ;MAKE EBLK OUTPUT NULL BLOCK
PUSHJ P,EBLK
SOSGE LDCCC
CLEARM LDCCC ;LOADER CONDITIONAL UNDERFLOW
JRST ASSEM1
;LOADER CONDITIONAL ON VALUE
A.LDCV: NOVAL ? NOABS
LSH B,-27.
PUSH P,B
PUSHJ P,AGETWD
POP P,B
DPB B,[400300,,BKBUF]
MOVEI A,LDCV
PUSHJ P,PLDCM
MOVEI A,0
DPB A,[400300,,BKBUF]
LIB5: AOS LDCCC
CCASM1: JRST ASSEM1
;.GLOBAL, .SCALAR, .VECTOR
;LH(B) HAS ILGLI, ILVAR, ILVAR+ILFLO RESPECTIVELY.
; Note that use of ILFLO flag is a crock here.
A.GLOB: NOVAL
HLLZ LINK,B ;REMEMBER WHICH OF THE THREE PSEUDO'S THIS IS.
A.GLO2: MOVE A,GLSPAS
MOVEM A,GLSP1
SETOM FLDCNT
PUSHJ P,GETSLD ;GET NAME
JRST MACCR ;NO NAME => DONE
CALL ES
JRST A.GLO1
CAIE A,PSUDO_-14.
JRST A.GLO1
JSP B,GVPSEU ;TRYING TO .GLOBAL A PSEUDO => TYPE APPRO. ERR MSG AND RETURN.
JRST A.GLO2 ;DON'T DO ANYTHING TO IT; MOVE ON TO NEXT ARG.
A.GLO1: IOR I,LINK ;SET THE GLOBAL FLAG OR THE VARIABLE FLAG.
TLNE LINK,ILVAR ;FOR .VECTOR OR .SCALAR, SAVE # VARS CREATED BEFORE CREATING THIS ONE.
PUSH P,VARCNT ;SO WE CAN TELL IF THIS CALL TO GETVAL ACTUALY CREATES IT.
PUSHJ P,GETVAL ;NOW GET VALUE (CLOBBERS SQUOZE FLAGS)
CAIA
HALT
TLNN LINK,ILVAR ; THAT'S IT IF .GLOBAL, ELSE CONTINUE
JRST A.GLO2
PUSH P,LINK ;.VECTOR OR .SCALAR, MUST READ THE SIZE.
TLO FF,FLUNRD ;RE-READ THE TERMINATOR AFTER THE SYM, SO "FOO(1)" AND "FOO," WIN
MOVE SYM,[SQUOZE 0,.SCALAR]
TLNE LINK,ILFLO ; USE RIGHT SYM
MOVE SYM,[SQUOZE 0,.VECTOR]
CALL AGETFD
REST LINK
REST B ;GET PREV. VARCNT, SO WE CAN SEE IF IT WAS INCREMENTED.
TRNN A,-1 ;MAKE (N) WORK AS SIZE BY USIN L.H. IF R.H. IS 0.
HLRZS A
JUMPN A,A.GLO3 ;JUMP IF NONZERO SIZE SPEC'D
TLNN LINK,ILFLO ; ZERO, USE DEFAULT
JRST A.GLO2 ; WHICH IS ALWAYS 1 FOR .SCALAR
SKIPA A,VECSIZ ; AND VECSIZ FOR .VECTOR.
A.GLO3: TLNE LINK,ILFLO ;NONZERO SIZE, SO
MOVEM A,VECSIZ ;DEFAULT MUST BE REMEMBERED FOR .VECTOR.
SUBI A,1 ;1 WORD WAS ALLOCATED BY GETVAL - HOW MANY MORE WANTED?
CAME B,VARCNT ;(MAYBE SYM ALREADY DEFINED, MAYBE PASS2, ...)
ADDM A,VARCNT ;IF GETVAL REALLY ALLOCATED THE SPACE THIS TIME, ALLOCATE THE
JRST A.GLO2 ;RIGHT AMOUNT.
;.LOP
A.LOP: NOVAL ? NOABS
PUSHJ P,EBLK ;TERMINATE CURRENT BLOCK
REPEAT 3,PUSHJ P,RGETFD ;GET THE FIELDS
MOVEI A,LD.OP
PUSHJ P,PLDCN
JRST ASSEM1
;.LIBRQ
A.LIBRQ: NOVAL ? NOABS
A.LBR1: PUSHJ P,GETSLD
JRST MACCR
PUSHJ P,PBITS7
MOVEI A,3
PUSHJ P,PBITS
TLO SYM,40000
PUSHJ P,OUTSM
JRST A.LBR1
A.LNKOT: AOS (P) ;THIS PSEUDO RETURNS NO VALUE.
NOVAL
AEND5: JUMPGE FF,CPOPJ ;IGNORE FOLLOWING ON NOT PUNCHING PASS
MOVE D,SYMAOB
AEND5A: MOVE SYM,ST(D)
LDB T,[400400,,SYM]
CAIE T,DEFLVR_-14.
CAIN T,DEFGVR_-14.
JRST AEND5E
CAIE T,LCUDF_-14.
CAIN T,GLOEXT_-14.
JRST AEND5B
AEND5C: ADD D,WPSTE1
AOBJN D,AEND5A
POPJ P,
AEND5E: 3GET C,D
TLNN C,3LLV
JRST AEND5C
AEND5B: HLLZ B,ST+1(D)
3GET C,D
TLNN C,3RLNK
JUMPE B,AEND5C
TLZ SYM,740000
CAIE T,LCUDF_-14.
CAIN T,DEFLVR_-14.
SKIPA
TLO SYM,40000
PUSHJ P,LKPNRO
HRRZS ST+1(D) ;CLEAR OUT LIST HEAD POINTER.
TLZ C,3RLNK ;INDICATE NO LIST.
3PUT C,D
JRST AEND5C
;PUNCH OUT COMPLETE LOADER COMMAND, PUNCHING OUT WRD AS ONLY CONTENTS
PLDCM: PUSH P,LINK ;SAVE LINK FOR ALOC AND FRIENDS (CLOBBERS OTHER AC'S)
PUSH P,A ;SAVE LOADER COMMAND TYPE
PUSHJ P,EBLK ;TERMINATE PREV BLOCK, MAKING SURE LOADER KNOWS $.
PUSHJ P,PWRDA ;PUNCH OUT THE WORD
POP P,A ;GET BACK LOADER COMMAND TYPE FOR PLDCN
PUSHJ P,PLDCN ;OUTPUT THE RESULTING BLOCK
PLINKJ: POP P,LINK ;RESTORE LINK
POPJ P,
PLDCN: HRRM A,BKBUF ;STORE LOADER COMMAND TYPE IN BKBUF HEADER
MOVEI A,LLDCM ;LOADER COMMAND BLOCK TYPE
DPB A,[310700,,BKBUF] ;STORE BLOCK TYPE IN HEADER
TRO FF,FRLOC ;MAKE EBLK OUTPUT BLOCK EVEN IF EMPTY
JRST EBLK
;.RELP <ARG> RETURNS RELOCATION OF ARG
A.RELP: CALL AGETFD
MOVE A,B
JRST VALRET
;.ABSP <ARG> RETURNS ABSOLUTE PART OF ARG.
A.ABSP: CALL AGETFD
JRST VALRET
;.RL1 IN RELOCATABLE ASSEMBLY RETURNS ZERO WITH RELOCATION FACTOR ONE.
;IN ABSOLUTE ASSEMBLY, IT RETURNS JUST ZERO.
;IFN <.RELP .RL1>, IS A TEST FOR A RELOCATABLE ASSEMBLY.
A.RL1: SKIPGE A,CONTRL
TRNE A,DECREL\FASL
SKIPA B,[1]
SETZ B,
SETZ A,
RET
AEND: NOVAL
SKIPE ASMOUT ; ERROR IF IN GROUPING.
JSP LINK,CONFLM ;FLUSH CONSTANTS, GIVE ERROR MSG.
SKIPE SCNDEP ;IF THERE ARE UNTERMINATED SUCCESSFUL
CALL AENDM1 ;CONDITIONALS, MENTION THEM.
MOVE A,BKCUR
CAIE A,BKWPB ;NOT IN .MAIN BLOCK => ERROR.
ETR ERRUMB
MOVE A,CDISP
TLNN A,DWRD
TLO FF,FLUNRD ;IF LAST TERM. WAS WORD TERM., RE-READ.
IFN LISTSW,[
MOVE A,[440700,,LISTBF]
EXCH A,PNTBP
MOVEM A,LISTTM
]
PUSHJ P,AVARI0
PUSHJ P,CNSTN0
SKIPL A,CONTRL
JRST [ PUSHJ P,AEND5 ; STINK RELOCATABLE => .LNKOT
JRST AEND6]
TRNE A,DECSAV ; IF DECSAV FMT,
JRST [ MOVE A,CLOC ; USE LOC COUNTER AT END AS LOC OF SYMBOLS
SKIPN DECSYA ; UNLESS LOC ALREADY SPECIFIED.
MOVEM A,DECSYA
JRST AEND6]
TRNN A,DECREL
JRST AEND6
MOVE A,CLOC ;IN DEC FMT, UPDATE HIGHEST ADDR SEEN,
SKIPN CRLOC ;UPDATE EITHER THE HIGHEST ABS ADDR
JRST [ CAML A,DECBRA
MOVEM A,DECBRA
JRST AEND6]
CAML A,DECTWO ;OR THE HIGHEST REL ADDR IN THE
JRST [ CAML A,DECBRH ;APPROPRIATE SEG.
MOVEM A,DECBRH
JRST AEND6]
CAML A,DECBRK
MOVEM A,DECBRK
AEND6: JUMPL FF,AEND1 ;ON PUNCHING PASS, SPECIAL STUFF
PUSHJ P,GETWRD ;OTHERWISE EAT UP WORD,
JRST RETURN ;AND RETURN
AEND1: PUSHJ P,EBLK
IFN LISTSW,[
SKIPGE LISTPF
PUSHJ P,PNTR
MOVE A,LISTTM
MOVEM A,PNTBP
]
MOVE SYM,[SQUOZE 0,END]
TLZ I,ILWORD
PUSHJ P,AGETWD
IFN LISTSW,[
MOVEM A,LISTWD
MOVEM B,LSTRLC
SETOM LISTAD
SETOM LISTPF
SKIPE LSTONP
PUSHJ P,PNTR
SKIPE LISTP
PUSHJ P,LPTCLS ;DONE LISTING
MOVE A,LISTWD
] ;END IFN LISTSW,
SKIPL B,CONTRL
JRST AEND3 ;RELOCATABLE
IFN FASLP,[
TRNE B,FASL
JRST FASEN ;FASL FORM
]
TRNE B,DECSAV
JRST AEND4
TRNN B,DECREL ;IF DEC FORMAT,
JRST AEND1A
TLNN I,ILWORD ;THEN IF THERE7S A STARTING ADDRESS,
JRST AEND2
MOVSI A,DECSTA ;OUTPUT START-ADDRESS BLOCK.
PUSHJ P,DECBLK
PUSHJ P,PWRD
PUSHJ P,EBLK
JRST AEND2
IFN FASLP,[
FASEN: JRST AEND2
]
AEND3: HRRZ A,CLOC
HRRM A,BKBUF ;SET UP PROGRAM BREAK JUST IN CASE OUTPUTTING MORE NULL DATA BLOCKS
MOVEI A,LCJMP
PUSHJ P,PLDCM
JRST AEND2
; HERE FOR DECSAV FORMAT.
AEND4: TLNE A,-1
JRST AEND1B ; IF SOMETHING IN LH, MAY BE ENTRY VECTOR.
MOVE B,A
MOVE A,[-1,,120-1] ; NOTHING, SO ASSUME SIMPLE JRST. MUST
PUSHJ P,PPB ; FIRST SAVE S.A. IN .JBSA CROCK.
MOVE A,B
PUSHJ P,PPB
TLO A,(JRST) ; FURNISH JRST FOR PUTTING AT END OF OUTPUT.
JRST AEND1B
AEND1A: ; CHECK WORD AND MAYBE MAKE IT A JRST
TLNN A,777000 ; CHECK INSTRUCTION PART
TLO A,(JRST) ; WANTS JRST
PUSHJ P,PPB
AEND1B: JUMPG A,.+3
ETR [ASCIZ /Start instruction negative/]
HRLI A,(JRST) ;END SYMTAB WITH POSITIVE WORD
MOVEM A,STARTA ;SAVE FOR PUNCHOUT AT END OF SYMTAB
PUSHJ P,FEED1
AEND2: PUSH P,[RETURN]
CNARTP:
IFN DECSW\TNXSW,[
PUSH P,TTYFLG
SKIPE CCLFLG ;IN DEC VERSION, IF RUN BY CCL, DON'T PRINT
AOS TTYFLG ;THIS STUFF ON THE TTY - ONLY IN ERROR FILE AND LISTING.
CALL CNTPD
REST TTYFLG
RET
CNTPD:
]
MOVNI D,1
MOVEI TT,PCNTB
CNTP1: CAML TT,PBCONL
RET
HRRZ B,1(TT)
HLRZ A,1(TT)
CAMN A,B
JRST CNTP2
AOSN D
TYPR [ASCIZ /Constants area inclusive
From To
/]
LDB B,[.BP (CGBAL),2(TT)]
SKIPE B
TYPR [ASCIZ /Global+/]
HRRZ B,1(TT)
PUSHJ P,OCTPNT
PUSHJ P,TABERR
HLRZ B,1(TT)
SOS B
PUSHJ P,OCTPNT
PUSHJ P,CRRERR
CNTP2: ADDI TT,3
JRST CNTP1
AENDM1: TYPR [ASCIZ /Unterminated successful bracketed conditionals
The first was at /]
AOS A,CONDPN
CALL DPNT
MOVEI A,"-
CALL TYOERR
AOS A,CONDLN
CALL D3PNT2
IFN TS,[
TYPR [ASCIZ/ of file /]
MOVE B,CONDFI
CALL SIXTYO
]
JRST CRRERR
AXWORD: CALL XGETFD ;READ 1ST FIELD,
TLNE I,ILMWRD
CALL IGTXT ;SOAK UP REST OF TEXT PSEUDO.
HRLM A,WRD
HRLM B,WRDRLC
MOVSI C,HFWDF
MOVSI B,SWAPF
PUSHJ P,LNKTC1
PUSH P,GLSP1
CALL XGETFD ;NOW THE SECOND FIELD
HRRM A,WRD
HRRES B
ADDM B,WRDRLC
MOVSI C,HFWDF
MOVEI B,0
POP P,T
PUSHJ P,LINKTC
JRST CABPOP
A.NTHWD:CALL AGETFD ;READ THE NUMBER OF THE WORD WE WANT.
SOJL A,CABPOP ;NEGATIVE OR 0 => RETURN 0.
SOJL A,A.1STWD ;1 => TURN INTO .1STWD.
;ELSE SKIP APPRO. # OF WORDS, THEN DO .1STWD.
A.NTH1: PUSH P,A
PUSH P,WRD
CALL XGETFD
TLZ FF,FLUNRD
REST WRD
REST A
TLNN I,ILMWRD
JRST CABPOP ;IF STRING ENDS BEFORE DESIRED WORD, RETURN 0.
SOJGE A,A.NTH1
A.1STWD: CALL XGETFD ;GET THE 1ST WD OF FOLLOWING TEXT PSEUDO,
CALL IGTXT ;THROW AWAY THE REST.
MOVE T,A ;RETURN THE VALUE
JRST TEXT5 ;COMPLAINING IF FOLLOWED IMMEDIATELY BY SYLLABLE.
A.LENGTH: CALL PASSPS
PUSH P,[0]
PUSH P,A
A.LN1: PUSHJ P,RCH
AOS -1(P)
CAME A,(P)
JRST A.LN1
SOS T,-1(P)
SUB P,[2,,2]
JRST TEXT5 ;RETURN VALUE IN T
ARDIX: NOVAL
PUSHJ P,AGETFD ;GET FIELD ARG
MOVEM A,ARADIX
JRST MACCR ;RETURN WITHOUT CLOBBERING CURRENT VALUE
A.RADIX: CALL AGETFD ;READ THE TEMP. RADIX.
PUSH P,ARADIX ;LAMBDABIND RADIX TO THAT VALUE.
MOVEM A,ARADIX
CALL XGETFD ;READ IN THE NEXT FIELD USING THAT RADIX.
REST ARADIX
JRST VALRET
;READ A BIT-MASK AS ARG, RETURN THE LH OF BP. FOR THAT BYTE.
A.BP: CALL YGETFD
MOVEI C,SPACE
SKIPE CDISP ;IF ARG WAS ENDED BY A COMMA, TURN IT INTO A SPACE
HRRM C,CDISP ;SO THAT .BP FOO,BAR USES THE FLD SPACE FLD FORMAT.
JUMPE A,VALR1
PUSH P,A
JFFO A,.+2
MOVEI B,36.
EXCH B,(P) ;(P) HAS # LEADING ZEROS.
MOVN A,B
AND A,B ;A HAS ONLY THE LOW BIT OF THE BYTE.
JFFO A,.+2
MOVNI B,1 ;B HAS 35.-<# TRAILING ZREROS.>
MOVEI A,1(B)
SUB A,(P) ;A HAS SIZE OF BYTE
LSH A,30 ;PUT IN S FIELD OF BP.
SUB P,[1,,1]
MOVNS B
ADDI B,35. ;B HAS # TRAILING ZEROS.
DPB B,[360600,,A] ;PUT THAT IN P FIELD OF BP.
JRST VALR1
;READ IN BP, RETURN BIT MASK TO SPEC'D BYTE.
;THE ARG SHOULD BE JUST THE LH OF A BP, WHICH MAY BE IN EITHER HALF OF THE ARG.
A.BM: CALL GETBPT ;READ IN A BYTE POINTER ARG, IN A, POINTING AT T.
SETZ T,
SETO C,
A.DPB1: DPB C,A ;PUT 1'S IN SPEC'D PART OF ACCUM T
MOVE A,T
JRST VALRET
;READ IN A BYTE POINTER (REALLY JUST S AND P FIELDS) AND MAKE POINT AT AC T.
;RETURN IT IN AC A.
GETBPT: CALL YGETFD
TLNN A,-1 ;IF ARG ISN'T IN LH, USE RH.
HRLI A,(A)
TLZ A,77 ;MAKE BP. -> AC T
HRRI A,T
RET
;RETURN # TRAILING ZEROS IN ARGUMENT.
A.TZ: CALL YGETFD
MOVN B,A
AND A,B ;A HAS JUST LOW BIT OF ARG SET.
JFFO A,.+2
MOVNI B,1 ;# OF ZEROS BEFORE LOW BIT =
MOVN A,B ;35. - <# TRAILING ZEROS>
ADDI A,35.
JRST VALRET
;RETURN # LEADING ZEROS IN ARG.
A.LZ: CALL YGETFD
JFFO A,.+2
MOVEI B,36.
MOVE A,B
JRST VALRET
;.DPB STUFF,BP,WORD DOES A DPB OF STUFF INTO THE FIELD OF WORD SPEC'D BY BP,
;RETURNING THE RESULTING WORD.
A.DPB: CALL YGETFD ;READ STUFF.
PUSH P,A
CALL GETBPT ;READ BP AND TURN INTO ACTUAL BP POINTING AT T
PUSH P,A
CALL YGETFD ;READ IN WORD AND PUT IN T.
MOVE T,A
REST A ;A HAS BP
REST C ;C HAS STUFF
JRST A.DPB1 ;GO DO THE DEPOSIT AND RETURN THE ALTERED WORD.
;.LDB BP,WORD RETURNS THE CONTENTS OF THE BYTE IN WORD SELECTED BY BP
A.LDB: CALL GETBPT
PUSH P,A
CALL YGETFD
MOVE T,A
REST A
LDB A,A
JRST VALRET
;.IBP BP RETURNS AN INCREMENTED BP.
A.IBP: CALL YGETFD
TLNN A,-1 ;IF ARG ISN'T IN LH, USE RH.
HRLZS A
IBP A
JRST VALRET
AWORD: NOVAL
PUSHJ P,EBLK
PUSHJ P,GETWRD ;ON UNDEFINED SYM, WYB UNDEFINED SYM IN "WORD"?
PUSHJ P,PPB
JRST ASSEM1
;.BIND - MAKE SYMS BE DEFINED IN CURRENT (SPEC'D) BLOCK. LH(B) HAS 0.
;.KILL - FULLY KILL THE SYMS.LH(B) HAS 3KILL.
;.HKILL - HALFKILL THEM. LH(B) HAS 3SKILL.
;.XCREF - PREVENT CREFFING OF SYMS. LH(B) HAS 3NCRF.
;.DOWN - SET 3DOWN, MAKING SYM VISIBLE IN SUBBLOCKS IN 1 PASS ASSEMBLY.
A.KILL: NOVAL
HLLZ LINK,B ;REMEMBER BIT TO SET.
A.KIL1: CALL GETSLD ;READ NEXT SYMBOL NAME.
JRST MACCR ;NO MORE, EXIT.
SKIPE LINK ;EXCEPT FOR .BIND, DO NOTHING ON PASS 1.
JUMPGE FF,A.KIL1
CALL ESDEF ;DEFINE THE SYMBOL, D HAS STE IDX.
JRST A.KIL2 ;SYMBOL NEVER SEEN.
IORM LINK,ST+2(D) ;SET THE BIT IN 3RDWRD..
IOR C,LINK ;(IF .XCREF, PREVENT CREFFING THIS TIME)
IFN CREFSW,XCT CRFINU ;CREF THE SYMBOL
JRST A.KIL1
A.KIL2: MOVSI T,LCUDF ;SYMBOL UNDEFINED, MAKE UNDEF LOCAL.
IOR C,LINK ;WITH THE DESIRED BIT SET.
TLO C,3MACOK ;SHOULDN'T BE ERROR IF IT BECOMES MACRO.
CALL VSM2
IFN CREFSW,XCT CRFINU
JRST A.KIL1
;EXPUNG SYM1,SYM2 ... ;UNDEFINE THOSE SYMS.
AEXPUNG: NOVAL
AEXPU2: PUSHJ P,GETSLD ;GET NAME
JRST MACCR ;NO MORE NAMES
PUSH P,[AEXPU2] ;AFTER THIS SYM, POPJ TO READ ANOTHER.
;EXPUNGE 1 SYMBOL, SQUOZE IN SYM.
AEXPU1: PUSHJ P,ES
JFCL ;NOT FOUND, DON'T COMPLAIN, JUST CREF.
IFN CREFSW,XCT CRFDEF
HRLZI T,400000 ;EXPUNGED ZERO SYM
SKIPE ST(D)
MOVEM T,ST(D)
SKIPL CONTRL ;IF RELOCATABLE ANDLOCAL SYMBOL,
CAIL A,DEFGVR_-33.
RET
PUSHJ P,PBITS7 ;TELL STINK TO EXPUNGE SYM.
MOVEI A,CLGLO
PUSHJ P,PBITS
TLO SYM,400000 ;SAY IS NEW TYPE RQ,
PUSHJ P,OUTSM0
MOVSI A,400000 ;NEW NAME NULL => DELETE.
JRST $OUTPT
;EQUAL SYM1,SYM2 ;DEFINE SYM1 SAME AS SYM2.
AEQUAL: NOVAL
PUSHJ P,GETSLD
ETR ERRTFA
PUSH P,SYM ;REMEMBER SYM NAME AND BLOCK TO DEF. IN.
PUSH P,ESBK
PUSHJ P,GETSLD
ETR ERRTFA
IFN CREFSW,XCT CRFINU ;CREF SYM DEFINED AS.
CALL ES ;LOOK UP SYM TO EQUATE TO.
JRST [ REST ESBK ;NOT FOUND => EXPUNGE THE 1ST SYM.
REST SYM
JRST AEXPU1]
REST ESBK
REST SYM
IFN CREFSW,XCT CRFDEF
PUSH P,A
PUSH P,B ;SAVE INFO ON VALUE OF SYM TO EQUATE TO.
PUSH P,C
CALL ESDEF
MOVEM SYM,ST(D)
REST B ;3RDWRD OF 2ND SYMBOL.
REST ST+1(D) ;(WHAT WAS PUSHED FROM B)
REST A
DPB A,[400400,,ST(D)]
TLZ C,3DFCLR ;SAVE OLD 3MAS, 3NCRF OF 1ST SYMBOL (AND ITS BLOCK #).
AND B,[3DFCLR,,] ;SET REST OF 3RDWRD BITS FROM 2ND SYMBOL.
IOR B,C
3PUT B,D
JRST MACCR
ERRTFA: ASCIZ /Too few args - EQUAL/
;.SEE SYM1,SYM2,... ;CREF THOSE SYMS.
A.SEE: CALL GETSLD ;READ 1 SYMBOL.
JRST MACCR ;NONE TO BE READ.
IFN CREFSW,[
SKIPN CRFONP ;IF CREFFING,
JRST A.SEE
CALL ES
MOVEI A,SYMC_-33.
XCT CRFINU ;CREF THE SYMBOL.
]
JRST A.SEE
;UUO HANDLING ROUTINE
;41 HAS JSR ERROR
VBLK
ERRCNT: 0 ; NUMBER OF ERRORS HIT -- VALUE OF .ERRCNT
ERRCCT: 0 ;NUM CHARS OUTPUT ON LINE, FOR MAKING MSGS LINE UP.
ERRJPC: 0 ;JPC READ WHEN UUO.
ERROR: 0
IFN ITSSW, .SUSET [.RJPC,,ERRJPC]
JRST ERRH ;GO HANDLE IT
PBLK
ERRH: PUSH P,T
PUSH P,B ;NOT TYPR => ERROR OF SOME KIND
PUSH P,A
PUSH P,C
LDB T,[331100,,40] ;PICK UP OP CODE
CAIN T,TYPCR_-33 ; TYPCR?
JRST TYPCR1
CAIN T,TYPR_-33 ; OR TYPR?
JRST TYPR1 ; YES
;ERROR OF SOME KIND
CAIE T,ETASM_-33 ;CHECK FOR SPECIAL LOSSAGES AT COLON
CAIN T,ETSM_-33
CAME SYM,SYSYM ;ARE WE ABOUT TO MENTIO THIS LOSING LABEL AS THE LAST ONE?
JRST ERRH1
MOVE T,SYSYM1
MOVEM T,SYSYM ;COLON LOSSAGE, DE-MUNG TAG WORDS FOR PRINTOUT
MOVE T,SYLOC1
MOVEM T,SYLOC
ERRH1:
IFN TS,[
IFN LISTSW,[
CALL PNTR ;FORCE OUT BUFFERED LISTING OUTPUT
CALL PNTCRR ;AND CR, SO USER CAN SEE WHERE ERROR WAS.
]
PUSHJ P,ERRTFL ;IF NOT SAME FILE AS LAST, PRINT FILE NAME.
]
SETZM ERRCCT
AOS ERRCNT ; BUMP ERROR TOTAL
IFN DECSW,AOS .JBERR ; BUMP ERROR MESSAGE COUNTER FOR LOADER TO ABORT
MOVE A,SYSYM ;GET LAST TAG DEFINED
JUMPE A,ERR1 ;SKIP PRINTOUT IF NONE THERE
PUSHJ P,SYMTYP ;THERE, TYPE IT OUT
MOVE B,CLOC ;NOW GET CURRENT LOCATION
SUB B,SYLOC ;SUBTRACT VALUE OF LAST TAG
JUMPE B,ERR1 ;SKIP NUMERIC PRINTOUT IF RIGHT AT TAG
MOVEI A,"+ ;NOT AT TAG,
PUSHJ P,TYOERR ;TYPE OUT PLUS SIGN,
AOS ERRCCT ;(1 MORE CHAR TYPED)
PUSHJ P,OCTPNT ;THEN TYPE OUT DIFFERENCE IN OCTAL
ERR1: PUSHJ P,TABERR ;NOW SEPARATE WITH TAB
MOVE A,ERRCCT
CAIGE A,8 ;MAKE SURE MOVE TO COLUMN 16.
PUSHJ P,TABERR
MOVEI B,[ASCIZ/GL+/]
SKIPGE GLOCTP ;LOCATION GLOBAL?
PUSHJ P,TYPR3 ;YES, TYPE OUT THAT FACT.
MOVE B,CLOC ;GET CURRENT LOCATION
PUSHJ P,OCTPNT ;TYPE OUT IN OCTAL
;DROPS THROUGH
;DROPS THROUGH.
PUSHJ P,TABERR
MOVE A,MDEPTH ;NOW DEPTH IN MACRO (NOT IRP, REPEAT, ETC.) EXPANSIONS
MOVSI T,-2
CALL DPNT0 ;PRINT, IN 2-CHAR FIELD.
MOVEI A,".
CALL TYOERR ;(USED TO BE OCTAL)
MOVE A,CPGN ;CURRENT PAGE NUMBER (FIRST PAGE OF FILE => 0)
PUSHJ P,[AOJA A,D6PNT] ;TYPE IT OUT IN DECIMAL
MOVEI A,"-
CALL TYOERR
MOVE A,CLNN ;ALSO CURRENT LINE NUMBER
PUSHJ P,[AOJA A,D3PNT2]
PUSHJ P,TABERR
MOVEI A,48. ;ASSUME ALL THE STUFF WE'VE PRINTED TAKES 48. CHARS
MOVEM A,ERRCCT ;MAYBE SOMEDAY TABERR, ETC. WILL REALLY UPDATE ERRCCT PROPERLY.
LDB A,[331100,,40] ;PICK UP OP CODE AGAIN
CAIGE A,8 ;ERROR UUO MAX
JRST .+1(A)
JRST [HALT ? JRST .-1] ;OPCODE 0, OR TOO BIG.
JRST ERRSM ;ETSM => TYPE SYM AND MESSAGE.
JRST ERRR ;ETR => JUST PRINT MESSAGE
JRST ERRJ ;ERJ => RH(40) HAS JUMP ADR
JRST ERRI ;ETI => IGNORE LINE RET TO ASSEM1
JRST ERRA ;ETA => RET TO ASSEM1
JRST ERRASM ;ETASM => TYPE SYM AND GO TO ASSEM1
JRST IAE ;ERF => FATAL.
ERRJ: MOVE A,40 ;ERJ => RH(40) HAS JUMP ADR
HRRM A,ERROR
JRST ERRET1
ERRI: PUSHJ P,RCH ;ETI => IGNORE LINE, RETURN TO ASSEM1: EAT UP LINE
CAIE A,12
JRST .-2
ERRA: MOVEI A,ASSEM1 ;ETA => RETURN TO ASSEM1, DON'T TYPE SYM.
MOVEM A,ERROR
JRST ERRR
ERRASM: MOVEI A,ASSEM1 ;ETASM => TYPE SYM AND RETURN TO ASSEM1
MOVEM A,ERROR
ERRSM: MOVEI C,56. ;ETSM OR ETASM => TYPE OUT SYM THEN MESSAGE
CALL TYPE37 ;CR NOW IF WHOLE MSG WON'T FIT ON ONE LINE.
MOVE A,SYM
PUSHJ P,SYMTYP
PUSHJ P,TABERR
ERRR: CALL TYPE40 ;TYPE THE ERROR MESSAGE.
ERRET1: REST C
POP P,A ;COMMON RETURN POINT FROM UUOS
POP P,B
POP P,T
JRST 2,@ERROR
;FINISH UP AN ERROR UUO'S ERROR MESSAGE. PRINT THE SPECIFIED STRING
;AND ALSO "IN DEFINE AT ..." IF NECESSARY, ALONG WITH APPROPRIATE CR'S.
TYPE40: MOVE C,ERRCCT
CALL TYPE37
CALL TYPR4 ;PRINT THE ASCIZ STRING
CALL CRRERR
SKIPN A,DEFNPS ;IF INSIDE A LONG PSEUDO,
RET
MOVE A,DEFNLN
MOVE B,DEFNPN
CAMN A,CLNN ;WHICH DIDN'T START IN THIS VERY LINE,
CAME B,CPGN
JRST TYPE42
MOVE A,DEFNFI
CAMN A,INFFN1
JRST TYPE43
TYPE42: MOVEI B,[ASCIZ/ in /]
CALL TYPR3
MOVE A,DEFNPS
CALL SYMTYP ;SAY WHAT PSEUDO, AND WHERE IT STARTED.
MOVEI B,[ASCIZ/ Starting at /]
CALL TYPR3
MOVE A,DEFNPN ;PAGE # -1.
CALL [AOJA A,DPNT] ;PRINT PAGE #.
MOVEI A,"-
CALL TYOERR
AOS A,DEFNLN
CALL D3PNT2 ;PRINT LINE #.
IFN TS,[
MOVE B,DEFNFI ;PRINT FILE NAME IF IT ISN'T THE CURRENT FILE.
CAMN B,INFFN1
JRST TYPE41
MOVEI B,[ASCIZ/ of file /]
CALL TYPR3
MOVE B,DEFNFI
CALL SIXTYO
]
TYPE41: CALL CRRERR ;AND CRLF.
TYPE43: MOVE A,ERROR
CAIE A,ASSEM1 ;IF THIS ERROR IS EXITING THE PSEUDO,
RET
SETZM DEFNPS ;SAY WE'RE NOT IN IT ANY MORE.
SETOM TEXT4
RET
;JSP TM,ERMARK IN A PSEUDO, TO ARRANGE FOR ERROR MESSAGES TO MENTION
;THAT PSEUDO. SYM SHOULD CONTAIN THE NAME OF THE PSEUDO.
;PUSHES A WORD ON THE STACK SO THAT WHEN THE PSEUDO RETURNS DEFNPS WILL BE CLEARED.
;IF DEFNPS IS SET UP ALREADY, DOES NOTHING (DOESN'T SET DEFNPS; DOESN'T PUSH THE WORD)
ERMARK: SKIPE DEFNPS
JRST (TM)
MOVEM SYM,DEFNPS
MOVE SYM,CLNN
MOVEM SYM,DEFNLN
MOVE SYM,CPGN
MOVEM SYM,DEFNPN
MOVE SYM,INFFN1
MOVEM SYM,DEFNFI
MOVE SYM,DEFNPS
CALL (TM)
CAIA
AOS (P)
SETZM DEFNPS
RET
;C SHOULD HAVE CURRENT HORIZ POS. IF TYPING THE STRING 40 POINTS AT
;WOULD OVERFLOW THE LINE, TYPE A CRLF AND TAB NOW ON THE TTY ONLY.
TYPE37: HRRZ B,40
HRLI B,440700 ;FIRST, FIGURE OUT HOW FAR ON LINE WE'LL TYPE IF WE DON'T CR.
ILDB A,B
CAIE A, ;AND COUNT CHARS IN THE ERR MSG.
AOJA C,.-2
CAMGE C,LINEL
RET
CRRTBX: MOVEI A,10
MOVEM A,ERRCCT ;PREVENT THIS FROM BEING DONE TWICE.
SKIPE TTYFLG
RET
MOVEI A,^M ;IF THERE'S NO ROOM, CRLF ON THE TTY ONLY (NOT THE ERR FILE).
PUSHJ P,TYOX
MOVEI A,^J
PUSHJ P,TYOX
MOVEI A,^I
JRST TYOX
;TYPE OUT SQUOZE (FLAGS OFF) IN A
SYMTYP: PUSHJ P,SQCCV ;GET NEXT CHAR IN ASCII.
AOS ERRCCT
PUSHJ P,TYOERR ;TYPE IT OUT.
JUMPE B,CPOPJ ;RETURN IF NOTHING LEFT (TYPED OUT AT LEAST ONE CHAR THOUGH)
IMULI B,50 ;LEFT-JUSTIFY REMAINDER
MOVE A,B ;GET LEFT-JUSTIFIED REMAINDER IN A
JRST SYMTYP ;TYPE OUT REMAINDER OF SYM
;TYPE OUT SQUOZE CHARACTER (IN A)
SQCCV: IDIV A,[50*50*50*50*50]
CAIG A,10.
SOJA A,SQCDTO ;NUMBER (OR BLANK =>SLASH)
CAIL A,45
SKIPA A,SYTB-45(A) ;SPECIAL
ADDI A,"A-13 ;LETTER
POPJ P,
SQCDTO: ADDI A,"0
POPJ P,
SYTB: ".
"$
"%
D3PNT2: MOVE T,[-3,,400000] ;3 CHAR FIELD, NO ZERO SUPPRESSION.
JRST DPNT0
DPNT: TDZA T,T ;ORDINARY DECIMAL PRINT.
D6PNT: MOVSI T,-6 ;6 CHAR FIELD, ZERO SUPPRESSION.
DPNT0: IDIVI A,10.
HRLM B,(P)
TRNE T,377777 ;IF NOT LAST DIGIT,
TRNE T,400000 ;AND ZERO-SUPPR. WANTED,
JRST DPNT2
JUMPN A,DPNT2 ;IF THIS IS A LEADING 0,
JUMPN B,DPNT2
MOVEI B," -"0
HRLM B,(P) ;REPLACE WITH A SPACE.
DPNT2: AOBJN T,.+2 ;J IF NOT ENOUGH CHARS YET.
JUMPE A,DPNT1 ;ENOUGH, DON'T MAKE MORE IF NOT NEEDED.
CALL DPNT0
JRST DPNT1
;TYPE HALFWORD IN B IN OCTAL.
OCTPNT: HRRZ A,B
IDIVI A,10
HRLM B,(P)
JUMPE A,.+2
PUSHJ P,.-3
AOS ERRCCT
DPNT1: HLRZ A,(P)
ADGTYO: ADDI A,"0
JRST TYOERR
;TYPE OUT THE SIXBIT WORD IN B
SIXTYO: JUMPE B,CPOPJ
MOVEI A,0
ROTC A,6
ADDI A,40
PUSHJ P,TYOERR
JRST SIXTYO
;TYPE CRLF
CRR: MOVEI A,15
PUSHJ P,TYO
MOVEI A,12
JRST TYO
;OP CODE 0 => NO RECOVERY RETURN TO GO9
IAE: CALL TYPE40 ;PRINT THE ERROR MESSAGE.
SKIPE ASMOUT
JSP LINK,CONFLZ ;TELL USER ABOUT UNTERM. GROUPINGS.
SKIPE SCNDEP ;MENTION ANY UNTERMINATED SUCCESSFUL
CALL AENDM1 ;CONDITIONALS.
MOVEI B,[ASCIZ /Error is fatal.
/]
CALL TYPR3
IFN ITSSW,[
.SUSET [.RTTY,,A]
SKIPL A
.RESET TYIC,
]
JRST GO9
;TYPR [ASCIZ /STRING/] ;TYPE OUT STRING
TYPR1: PUSH P,[ERRET1]
TYPR4: HRRZ B,40 ;GET ADR OF BEGINNING OF STRING
TYPR3: HRLI B,440700 ;CONVERT TO BYTE POINTER
TYPR2: ILDB A,B ;GET NEXT CHAR
JUMPE A,CPOPJ ;JUMP IF ZERO, END OF STRING
PUSHJ P,TYOERR ;NON-ZERO, TYPE IT OUT
JRST TYPR2
; TYPCR [ASCIZ /STRING/] ; Type out string, followed by CRLF
TYPCR1: PUSH P,[ERRET1]
PUSHJ P,TYPR4 ; When done, fall thru.
CRRERR: MOVEI A,^M ;CRLF IN ERROR MESSAGE.
CALL TYOERR
SKIPA A,[^J]
TABERR: MOVEI A,^I ;TAB INN ERROR MESSAGE.
TYOERR:
IFN LISTSW,[
SKIPE LSTTTY ;OUTPUT TO LISTING UNLESS LSTTTY ZERO.
CALL PILPTX
]
SKIPG LSTTTY
JRST TYO ;TO TTY UNLESS LSTTTY POSITIVE.
RET
;OUTPUT-FORMAT SELECTING PSEUDOS:
;.SLDR -- ON PASS 2, PUNCH OUT SBLK LOADER AND SELECT SBLK FORMAT
A.SLDR: NOVAL
JUMPGE FF,MACCR ;DO NOTHING ON PASS 1.
PUSHJ P,FEED1 ;LEAVE LOTS OF BLANK PAPER TAPE FIRST
PUSHJ P,PLOD1A ;PUNCH OUT LOADER
SIMBLK: MOVSI B,SBLKS ;ENTRY FROM PS1, A.SLDR SELECT SBLK
JRST SIMBL1
SRIM: MOVE A,SYM ;ENTRY FROM GETVAL, LH(B) HAS RH(CONTRL)
PUSH P,B
CALL SYMTYP
TYPR [ASCIZ/ Encountered
/]
REST B
SIMBL1: TRO FF,FRNPSS
HRRI B,TRIV ;SET UP TRIV FLAG FOR LH(CONTRL)
MOVSS B
CAME B,CONTRL ;IF CHANGING MODES, END THE BLOCK IN THE OLD MODE
CALL EBLK
MOVE A,CONTRL ;IF OLD MODE WAS RELOCATABLE OF SOME KIND,
TRNN A,DECREL\FASL
JUMPL A,SIMBL2
SETZM CRLOC ;INITIALIZE LOCATION COUNTER.
MOVEI A,100 ; USE 100 ASSUMING ITS SBLK
TRNE B,DECSAV
MOVEI A,140 ; BUT USE 140 FOR DEC ABS.
MOVEM A,CLOC
SIMBL2: MOVEM B,CONTRL ;STORE NEW MODE.
TRNE B,ARIM\ARIM10
TRZ F,FRSYMS ;RIM AND RIM10 MODES IMPLY NO SYMBOLS.
AOS (P)
;ROUTINE TO SET VARIABLES FOR BENEFIT OF NED LOGIC
;CALLED BY OUTPUT SELECTING PSEUDOS
OUTUPD: NOVAL
IFN A1PSW,[
TRNE FF,FRNPSS ;IF PASS 1,
TLNN FF,$FLOUT
JRST OUTCHK
AOS OUTN1 ;INDICATE "OUTPUT" HAS OCCURED OTHER THAN IN 1PASS MODE
OUTCHK: TLZE FF,$FLOUT
AOS OUTC ;INDICATE "OUTPUT" HAS OCCURED DURING CURRENT ASSEMBLY
]
RET
ANOSYMS: NOVAL
TRZ FF,FRSYMS
JRST MACCR
A1PASS: PUSHJ P,OUTUPD
A1PAS1: TLO FF,FLPPSS
MOVEIM A.PPASS,1 ;SET .PPASS TO 1.
IFN CREFSW,[ SKIPE CREFP ;THIS NOW PUNCHING PASS,
PUSHJ P,CRFON ;MAYBE TURN ON CREFFING.
]
IFN LISTSW,[
SKIPE LISTP
CALL LSTON ;LIST NOW IF WANT LISTING AT ALL.
]
MOVE A,CONTRL
TRNE A,DECREL
CALL DECPGN
TRZA FF,FRNPSS
ARELOC: PUSHJ P,OUTUPD
ARELC1: PUSHJ P,EBLK ;FINISH CURRENT OUTPUT BLOCK
TRO FF,FRLOC ;DOING LOCATION ASSIGNMENT, MAKE SURE NEXT GETS OUTPUT
CLEARM CLOC
MOVEI A,1
MOVEM A,CRLOC
CLEARM CONTRL
SETZM BKBUF
MOVEI A,LREL
DPB A,[310700,,BKBUF]
MOVEM A,CDATBC
JRST MACCR
; .DECSAV - SELECT DEC ABSOLUTE ZERO-COMPRESSED (SAV) FORMAT
A.DECSAV: NOVAL
MOVSI B,DECSAV ; SET FLAG
JRST SIMBL1 ; THEN HANDLE ALMOST LIKE .SBLK
A.DECTWO: CALL AGETFD ;READ THE TWOSEG ORIGIN.
TRNN FF,FRNPSS
ETF [ASCIZ /.DECTWO follows 1PASS/]
MOVE C,ISAV
TRNN C,IRFLD ;NO ARG => DEFAULT IT TO 400000
MOVEI A,400000
MOVEM A,DECTWO
A.DECREL: PUSHJ P,OUTUPD
TRZ FF,FRLOC
PUSHJ P,EBLK ;FORCE OUT BLOCK IN OTHER FMT.
MOVE A,[SETZ DECREL]
CAME A,CONTRL ;SWITCHING TO .DECREL MODE FOR 1ST TIME
TRNE FF,FRNPSS ;IN A 1PASS ASSEMBLY
JRST A.FAS1
CALL A.FAS1 ;DO THE SWITCH
JFCL
CALL DECPGN ;THEN WRITE THE PROGRAM NAME
JRST MACCR
A.FAS1: MOVEM A,CONTRL ;DEC FMT COUNTS AS ABS ASSEMBLY.
SETZM BKBUF ;(SO EBLK W0N'T OUTPUT ANYTHING)
SETZM CLOC ;START ASSEMBLING FROM RELOCATABLE 0.
MOVEI A,1
MOVEM A,CRLOC
PUSHJ P,EBLK ;INITIALIZE AN ORDINARY (DECWDS) BLOCK.
JRST MACCR
IFN FASLP,[
A.FASL: PUSHJ P,OUTUPD
PUSHJ P,EBLK
MOVE A,[SETZ FASL] ;FASL ALSO COUNTS AS ABS
JRST A.FAS1
]
ATITLE: NOVAL
PUSH P,CASSM1 ;RETURN TO ASSEM1.
PUSHJ P,GSYL
SKIPE SYM
MOVEM SYM,PRGNM
MOVE T,[440700,,STRSTO]
ATIT2: ILDB A,T ;GET CHAR FROM TITLE STRING
SOSG STRCNT
JRST ATIT3 ;CHAR IS SYLLABLE TERMINATOR
IFE ITSSW,[
SKIPE CCLFLG
TRNN FF,FRPSS2
]
PUSHJ P,TYO ;NOT TERMINATOR, TYPE OUT AND LOOP BACK
JRST ATIT2
ATIT3: CALL ATIT1 ;PRINT THE REST OF THIS LINE.
MOVE A,CONTRL
TRNE A,DECREL
TRNE FF,FRNPSS
CAIA
ETF [ASCIZ /TITLE follows 1PASS/]
MOVE A,TTYINS
ADD A,A.PASS ;SHOULD WE .INSRT TTY: THIS PASS (T SWITCH)
JUMPG A,CPOPJ
IFDEF GTYIPA,JRST GTYIPA ;GO PUSH TO TTY IF CAN,
IFNDEF GTYIPA,HALT ;WHY DID YOU SET TTYINS IF CAN'T?
ATIT1: CAIE A,15 ;CR?
CAIN A,12 ;LF?
IFN ITSSW,JRST CRR ;ONE OF THESE, FINISH TYPEOUT WITH CR
.ELSE [ JRST [ SKIPE CCLFLG
TRNN FF,FRPSS2
JRST CRR
RET]
SKIPE CCLFLG ;NEITHER OF THESE, PRINT CHAR.
TRNN FF,FRPSS2 ;ON DEC SYS, DON'T PRINT THE TITLE ON P2, OR AT ALL IF RUN BY CCL.
]
PUSHJ P,TYO
A.ERR1: PUSHJ P,RCH ;GET NEXT CHAR IN TITLE
JRST ATIT1
;.ERR PSEUDO-OP -- FOLLOWED BY LINE WHICH IS ERROR MSG.
A.ERR: PUSH P,CASSM1 ;RETURN TO ASSEM1,
ERJ A.ERR1 ;AFTER NUMBERS AND USER'S STRING.
A.FATAL:PUSH P,[GO9] ;.FATAL - CAUSE A FATAL ERROR.
ERJ A.ERR1
APRINT: NOVAL
HLRZS B ;B SAYS WHETHER PRINTX, PRINTC OR COMMENT.
JSP TM,ERMARK
CALL PASSPS
MOVE T,A
APRIN1: PUSHJ P,RCH
CAME A,T
JRST (B) ;GO TO APRIN1 FOR COMMENT,
JRST MACCR
APRIN2: CAIE A,"! ;COME HERE FOR PRINTX
APRIN3: PUSHJ P,TYO ;HERE FOR PRINTC
JRST APRIN1
A.TYO: NOVAL
CALL AGETFD ;PSEUDO TO TYPE A CHARACTER (AS NUMERIC ARG).
CALL TYOERR
JRST MACCR
A.TYO6: NOVAL
CALL AGETFD ;PSEUDO TO TYPE A WORD OF SIXBIT.
MOVE B,A
CALL SIXTYO
JRST MACCR
;.BEGIN - START NEW BLOCK WITH NAME = ARG, OR LAST LABEL DEFINED.
A.BEGIN: NOVAL
SKIPE ASMOUT ;IF IN GROUPING, FLUSH IT & ERROR.
JSP LINK,CONFLM
PUSHJ P,GETSLD ;READ A NAME.
MOVE SYM,SYSYM ;NO ARG, USE NAME OF LAST LABEL.
MOVE A,SYM ;NAME TO USE FOR BLOCK.
MOVE B,BKLVL ;CURRENT LEVEL + 1
HRLZI B,1(B) ;IS LEVEL OF NEW BLOCK.
HRR B,BKCUR ;ITS SUPERIOR IS CURRENT BLOCK.
MOVEI C,0 ;SEE IF AN ENTRY EXISTS FOR THIS BLOCK.
MOVE AA,A.PASS
A.BEG0: CAMN A,BKTAB(C)
CAME B,BKTAB+1(C)
JRST A.BEG1 ;THIS ENTRY ISN'T FOR BLOCK BEING ENTERED.
TDNE AA,BKTAB+2(C) ;FOUND: DEFINED IN THIS PASS?
ETSM [ASCIZ /Multiply defined BLOCK/]
JRST A.BEG2 ;NO, SAY IT'S DEFINED.
A.BEG1: ADDI C,BKWPB ;LOOK THRU ALL ENTRIES.
CAMGE C,BKTABP
JRST A.BEG0
CAIL C,BKTABS ;ALL ENTRIES USED => ERROR.
ETF ERRTMB
MOVEM A,BKTAB(C) ;ALLOCATE NEW ENTRY
MOVEM B,BKTAB+1(C) ;STORE NAME, LEVEL, SUPPRO.
MOVEI A,BKWPB(C)
MOVEM A,BKTABP ;POINTS TO 1ST UNUSED ENTRY.
A.BEG2: IORM AA,BKTAB+2(C) ;INDICATE BLOCK SEEN THIS PASS.
MOVEM C,BKCUR ;NEW BLOCK NOW CURRENT BLOCK,
AOS A,BKLVL ;ITS LEVEL NOW CURRENT LEVEL,
CAIL A,BKPDLS ;PUSH IT ON BLOCK PDL
ETF [ASCIZ /.BEGIN nesting too deep/]
MOVEM C,BKPDL(A)
JRST ASSEM1
ERRTMB: ASCIZ /Too many symbol blocks/
ERRUMB: ASCIZ /Unmatched .BEGIN - .END/
;.END - POP CURRENT BLOCK.
A.END: NOVAL
SKIPE ASMOUT ;IN GROUPING => TERMINATE IT & ERROR.
JSP LINK,CONFLM
MOVE A,CDISP ;IF FOLLOWED BY WORD TERM,
TLNN A,DWRD ;CAUSE IT TO BE RE-READ
TLO FF,FLUNRD ;SO ARG WILL BE NULL.
PUSHJ P,GETSLD ;READ ARG.
JRST A.END0 ;NO ARG.
MOVE C,BKCUR ;ERROR UNLESS BLOCK BEING TERMINATED
MOVE A,BKTAB(C) ;HAS SAME NAME AS ARG.
EXCH A,SYM ;(MAKE SURE SYM NAME TYPED IS BLOCK'S NAME)
CAME A,SYM
ETSM ERRUMB ;ERROR, PRINT SYM (BLOCK'S NAME)
A.END0: MOVE C,BKCUR ;NOT OK TO END .MAIN BLOCK OR .INIT BLOCK.
CAIG C,BKWPB
ETA ERRUMB
HRRZ C,BKTAB+1(C)
MOVEM C,BKCUR ;POP INTO FATHER OF PREV. CURRENT BLOCK.
SOS BKLVL
JRST ASSEM1
;BKTAB: 3-WORD ENTRIES, 1 PER BLOCK, IN NO PARTICULAR ORDER.
;1ST WD HAS SQUOZE NAME OF BLOCK, FLAGS CLEAR.
;2ND WD HAS LEVEL,,BKTAB IDX OF CONTAINING BLOCK("FATHER", "SUPERIOR")
;3RD WD BIT 1.N ON => BLOCK ENTERED ON PASS N.
;SYMBOL TABLE OUTPUT RTN PUTS -2*<NUM SYMS IN BLOCK> IN 3RD WD.
;THE FIRST BKTAB ENTRY IS THAT OF THE OUTERMOST BLOCK (.INIT)
;IN WHICH INITIAL SYMS ARE DEFINED.
;THAT ENTRY'S 2ND AND 3RD WDS ARE 0.
;THE NEXT IS THAT OF THE MAIN BLOCK (.MAIN) IN WHICH
;ALL SYMBOLS ARE NORMALLY DEFINED (THAT IS, YOU ARE IN THAT BLOCK
;BEFORE YOU DO ANY .BEGIN'S).
;THAT ENTRY'S 2ND WD IS 1,, ; ITS 3RD, 0.
;THE BKPDL IS A TABLE OF BLOCKS CURRENTLY ENTERED & NOT ENDED.
;BKPDL'S 1ST ENTRY IS FOR OUTERMOST BLOCK.
;LAST ENTRY IS BKPDL+@BKLVL, FOR CURRENT BLOCK.
BKTABS==BKTABL*BKWPB
VBLK
BLCODE [
BKTAB: BLOCK 3 ;ENTRY FOR .INIT BLOCK.
PRGNM: BLOCK BKTABS-BKWPB ;PROGRAM NAME IS NAME OF MAIN BLOCK.
]
BKTABP: 0 ;IDX IN BKTAB OF 1ST UNUSED ENTRY.
BKPDL: BLOCK BKPDLS ;TABLE OF BLOCKS STARTED, NOT FINISHED.
BKLVL: 0 ;CURRENT BLOCK LEVEL, IDX OF LAST USED IN BKPDL.
BKCUR: 0 ;BKTAB IDX OF CURRENT BLOCK.
ESBK: 0 ;-1 OR BLOCK TO EVAL SYM. IN.
ESL1: 0 ;IN ES, LEVEL OF BLOCK OF BEST SYM SO FAR.
ESL2: 0 ;3RDWRD OF BEST SO FAR.
SADR: 0 ;SYM TAB IDX OF BEST SO FAR.
ESLAST: 0 ;RH IDX OF LAST DEF (EVEN IF NO GOOD) -1 IF NONE
;SIGN NEG. IF LAST DEF SEEN BEFORE @ESXPUN
ESXPUN: -1 ;IF SEE EXPUNGED OR FREE ENTRY, PUT IDX HERE.
BKTAB1: BLOCK BKTABL ;USED BY SSYMD.
PBLK
;.SYMTAB ARG ;SAY WANT AT LEAST ARG STE'S IN SYMTAB.
A.SYMTAB: NOVAL
PUSH P,[0] ;THIS WORD WILL BE SETOM'ED IF THERE IS REALLY ANY WORK NEEDED.
PUSHJ P,AGETFD ;GET DESIRED SYM TAB SIZE.
CAMG A,SYMLEN ;IF HAVE ENOGH ROOM ALREADY,
JRST A.SYM1 ;NO NEED TO RE-INIT.
CAILE A,SYMMAX ;IF WANTS MORE THAN MAXIMUM, ERROR.
ETF [ASCIZ/.SYMTAB 1st arg too big/]
MOVEM A,SYMLEN ;TELL INITS ABOUT NEW SIZE.
SETOM (P)
A.SYM1: CALL AGETFD ;READ DESIRED CONSTANTS TABLE SPACE ALLOCATION.
CAMG A,CONLEN ;IF TABLE ALREADY BUG ENOUGH, NOTHING TO DO.
JRST A.SYM2
CAILE A,CONMAX
ETF [ASCIZ/.SYMTAB 2nd arg too big/]
MOVEM A,CONLEN ;ELSE REMEMBER IT AND SAY REALLOCATION NECESSARY.
SETOM (P)
A.SYM2: CALL AGETFD ;3RD ARG IS # WORDS PER SYMBOL - BUT ONLY 3 IS ALLOWED NOW.
JUMPE A,A.SYM3 ;EVENTUALLY 4 WILL GET 12-CHARACTER SYMBOLS.
CAIL A,MINWPS
CAILE A,MAXWPS
ETF [ASCIZ/.SYMTAB 3rd arg out of range/]
CAME A,WPSTE
SETOM (P)
MOVEM A,WPSTE
A.SYM3: REST A ;IS THERE ANYTHING THAT ACTUALLY NEEDS TO BE CHANGED?
JUMPE A,ASSEM1 ;IF NOT, NEVER GIVE ERROR - ELSE WOULD ALWAYS LOSE ON PASS 2.
MOVE B,PLIM
CAMN B,CONTBA ;IF THERE HAVE BEEN ANY LITERALS
SKIPE INICLB ;OR ANY MACROS, IRPS, REPEATS, ETC., THEN ...
ETF [ASCIZ/Too late to do .SYMTAB/]
MOVE CH1,MACTAD ;SET UP AC -> START OF INIT CODE
SUBI CH1,MACTBA ;SO IT CAN REFER TO ITSELF.
PUSHJ P,INITS(CH1) ;RE-INIT, SET SYMSIZ, SYMAOB, ETC.
PUSHJ P,MACINI ;INIT PTRS TO END OF MACTAB.
JRST ASSEM1
A.OP: PUSHJ P,A.OP1 ;.OP,
JRST VALRET ;RETURNS VALUE
A.AOP: NOVAL
AOS (P) ;.AOP DOESN'T RETURN VALUE
A.OP1: PUSHJ P,AGETFD
PUSH P,A
PUSHJ P,AGETFD
PUSH P,A ;PDL NOW HAS FIELD 0 AND FIELD 1
PUSHJ P,AGETFD
POP P,B ;B NOW HAS FIELD 1, A HAS FIELD 2, PDL HAS FIELD 0
EXCH A,B
POP P,T ;T HAS FIELD 0, A HAS FIELD 1, B HAS FIELD 2
TLNN T,(0 17,) ;IF AC FIELD NOT PRESENT IN INSN, SUPPLY ONE.
TLO T,(0 A,)
TDNN T,[0 -1(17)] ;IF NO ADDR OR IDX FIELD IN INSTRUCTION,
HRRI T,B ;SUPPLY ONE.
SETOM A.ASKIP' ;.ASKIP WILL BE -1 IFF INSN SKIPPED, ELSE 0.
TLNE T,74000 ;AVOID EXECUTING OPCODE ZERO.
XCT T
SETZM A.ASKIP
MOVEM A,AVAL1' ;STORE C(AC) AS .AVAL1
MOVEM B,AVAL2' ;STORE C(E) FOR .AVAL2
POPJ P, ;RETURN TO WHATEVER
AASCIZ: TDZA T,T
A.ASCII: MOVEI T,1
MOVEM T,AASCF1 ;STORE TYPE
MOVE D,[440700,,T]
SETZM AASCFT
JRST AASC1
AASCII: SKIPA D,[440700,,T]
ASIXBI: MOVE D,[440600,,T]
SETZM AASCFT ;INDICATE NOT .DECTXT
SETOM AASCF1 ;INDICATE REGULAR (NOT ASCIZ)
JRST AASC1
A.DCTX: NOVAL
MOVE A,CONTRL
TRNN A,DECREL
ETA [ASCIZ /.DECTXT in non-DECREL assembly/]
CALL EBLK
SETZ B,
SETOM AASCFT
SETOM AASCF1 ;INDICATE ASCIZ-STYLE PADDING
MOVE D,[440700,,T]
AASC1: TLZE I,ILMWRD
JRST TEXT2 ;MULTIPLE WORD, FALL IN FOR NEXT SET OF CHARS
MOVEMM ASMDS1,ASMDSP
MOVEM SYM,DEFNPS ;REMEMBER LOCATION IN FILE OF PSEUDO
MOVEMM DEFNLN,CLNN ;IN CASE THE DELIMITER IS MISSING.
MOVEMM DEFNPN,CPGN
IFN TS, MOVEMM DEFNFI,INFFN1
HLRZ T,B ;GET FILL CHARACTER
IMUL T,[REPEAT 5,[1_<.RPCNT*7>+]0] ;CONVERT TO ASCII FILL WORD SHIFTED -1 (IMUL SCREW)
LSH T,1 ;SHIFT TO PROPER POSITION (EXTRA IN CASE WANT TO FILL W/ HIGH BIT SET)
MOVEM T,AASEFW ;STORE AS FILL WORD, T NOW SET UP TO ACCUMULATE VALUE
CALL PASSPS
MOVEM A,TEXT4 ;STORE TERMINATOR
TEXT7: PUSHJ P,RCH
AASC8: CAMN A,TEXT4
JRST AASC1A ;TERMINATOR
TLNN D,760000
JRST TEXT6 ;WORD FULL
TEXT9: TLNE D,100 ;CHECK BOTTOM BIT OF SIZE FIELD OF BP
JRST AASC2 ;SET => NOT SIXBIT
SUBI A,40
CAILE A,77
SUBI A,40 ;CONVERT LOWER CASE ASCII TO UPPER CASE
JUMPGE A,.+2
ETR ERRN6B
AASC3: IDPB A,D
TRO I,IRSYL
JRST TEXT7
ERRN6B: ASCIZ /Character not SIXBIT/
;TERMINATOR
AASC1A: TLNN D,760000 ;SKIP UNLESS END OF WORD
SKIPGE AASCF1 ;SKIP UNLESS REGULAR
JRST [ MOVE CH1,ASMDS1 ;REGULAR OR NOT END OF WORD
MOVEM CH1,ASMDSP ;RESTORE ASMDSP AS SAVED AT START OF PSEUDO.
JRST TEXTX]
MOVEI CH1,1 ;END OF WORD AND NOT REGULAR
JRST AASC1B ;EXTRA 0 NEED FOR Z FLAVOR
AASC2: CAIN A,"!
SKIPG AASCF1
JRST AASC3 ;NOT .ASCII OR NOT EXCL
PUSH P,T ;READ FIELD
PUSH P,TEXT4
PUSH P,D
PUSH P,SYM
PUSH P,ASMOUT ;PREVENT CLOSEBRACKETS FROM TRYING TO TAKE EFFECT.
MOVEIM ASMOUT,4 ;NOTE THIS LOSES IF CALL PSEUDO THAT RETURNS TO ASSEM1.
MOVEI SYM,[SETOM ASUDS1] ;NOW TO SET UP UNDEFINED SYM CONDITION
TLNE FF,FLPPSS
MOVE SYM,[SQUOZE 0,.ASCII] ;PUNCHING PASS, UNDEFINED => REAL ERROR
CLEARM ASUDS1
PUSHJ P,AGETFD
;"UNDEFINED IN .ASCII" ERROR INSTR, ERROR MESSAGE BUT ONLY ON PASS 2
;BUT NOTE THAT ON PASS 2 IT MIGHT ASSEMBLE DIFFERENT NUMBER OF WORDS,
;CAUSING LOSSAGE IF NOT IN CONSTANT
REST ASMOUT
POP P,SYM
POP P,D
POP P,TEXT4
POP P,T
SKIPGE ASUDS1
MOVNI A,1 ;HAD UNDEFINED SYMS SO ASSUME MAX
SKIPGE ASUDS1
TLO I,ILNOPT ;ALSO DON'T OPTIMIZE OVER IN CONSTANT
MOVE CH1,[440700,,AASBF]
MOVEM CH1,ASBP1
MOVEM CH1,ASBP2
PUSH P,[AASC5]
MOVE CH1,A
AASC6: LSHC CH1,-35.
LSH CH2,-1
DIV CH1,ARADIX
HRLM CH2,(P)
JUMPE CH1,.+2
PUSHJ P,AASC6
HLRZ A,(P)
ADDI A,"0
IDPB A,ASBP1
POPJ P,
AASC5: MOVEI A,0
IDPB A,ASBP1 ;END .ASCII NUMBER WITH ZERO
AASC8A: TLNN D,760000
JRST AASC7 ;END OF WORD
ILDB A,ASBP2
JUMPE A,AASC9
IDPB A,D
JRST AASC8A
AASC9: TLO FF,FLUNRD
JRST TEXT7
AASC7: TDZA CH1,CH1
TEXT6: MOVNI CH1,1 ;WORD FULL
AASC1B: MOVEM CH1,AASCF2
CLEARM CDISP
MOVEM A,TEXT8
MOVE A,T
SKIPE AASCFT ;FOR .DECTXT, OUTPUT WORD INSTEAD OF RETURNING IT.
JRST [ CALL PPB
MOVE D,[440700,,T]
JRST TEXT2A]
TLO I,ILMWRD ;ELSE ARRANGE TO BE CALLED BACK TO RETURN NEXT WORD.
MOVEI T,ASSEM2
MOVEM T,ASMDSP
SKIPLE CONSML ;IF NOT MULTI-LINE MODE,
JRST CLBPOP
MOVE T,ASMOUT ;IF THE TEXT IS IN <>'S OR ()'S,
HRRZ T,ASMOT2(T)
CAIE T,LSSTHA
JRST CLBPOP
CALL IGTXT ;USE ONLY THE FIRST WORD.
SKIPE CONSML ;AND ERROR IF IN ERROR MODE.
ETR [ASCIZ/Multi-word text pseudo in brackets/]
JRST CLBPOP
;GET NEXT WORD
TEXT2: TRO I,IRFLD
TEXT2A: MOVE T,AASEFW ;INITIALIZE T TO FILL WORD
MOVE A,TEXT8 ;GET NEXT CHAR (ALREADY READ BY RCH)
SKIPGE B,AASCF2
JRST TEXT9 ;REG OR HAVEN'T READ SECOND DELIMITER, FALL BACK IN
JUMPE B,AASC8A
TEXTX: SETZM DEFNPS
SETOM TEXT4
SKIPN AASCFT
JRST TEXT5 ;RETURNING FROM ASCIZ AFTER PUTTING THE TRAILING ZERO OUT.
MOVE A,T
CALL PPB ;FOR .DECTXT, OUTPUT THE FILL WORD INSTEAD.
JRST MACCR
VBLK
AASCF1: 0 ;-1 REG OR SIXBIT, 1 .ASCI 0 ASCIZ
AASCF2: 0 ;MULTIPLE WORD RETURN FLAG -1 REG 0 FINISH ! HACK 1 OUTPUT FILL WORD FOR Z
AASCFT: 0 ;0 REGULAR, -1 => .DECTXT (OUTPUT WORDS TO FILE INSTEAD OF RETURNING THEM)
TEXT4: -1 ;DELIMITER, OR -1 IF NOT INSIDE A TEXT PSEUDO.
TEXT8: 0 ;SAVED NEXT CHAR WHILE RETURNING BETWEEN WORDS
ASBP1: 0 ;IDPB TO AASBF ON .ASCII FIELD
ASBP2: 0 ;ILDB FROM AASBF "
AASBF: BLOCK 8 ;ACCUMULATED TYPEOUT OF NUMBER FOR .ASCII, EXTRA LONG FOR HACKERS TYPING OUT BINARY
ASUDS1: 0 ;UNDEFINED SYM FLAG FOR .ASCII DURING PASS 1
AASEFW: 0 ;FILL WORD
PBLK
IGTXT: TLNN I,ILMWRD
RET
PUSH P,A ;ROUTINE TO EAT UP TEXT OF UNDESIRED MULTIPLE WORD
SKIPLE AASCF2 ;DETECT SCREW CASE: AFTER ASCIZ OF 5 CHARS, DELIMITER IS
JRST IGTXT1 ;ALREADY GOBBLED, BUT SOME OF THE ASCIZ REMAINS.
PUSHJ P,RCH
CAME A,TEXT4
JRST .-2
IGTXT1: TLZ I,ILMWRD
MOVEMM ASMDSP,ASMDS1
SETZM DEFNPS
SETOM TEXT4
JRST POPAJ
;".ASCVL /X" RETURNS THE ASCII VALUE OF "X". NOTE THE DELIMITER IS NOT REPEATED
;AND SERVES ONLY TO ALLOW SPACES TO BE IGNORED WHILE WINNING IF X IS A SPACE.
A.ASCV: CALL PASSPS ;SKIP SPACES TO REACH THE DELIMITER.
CALL RCH ;READ THE CHAR AFTER THE DELIMITER
MOVE T,A
JRST TEXT5 ;AND RETURN ITS ASCII VALUE.
ASQOZ: HLLM B,(P) ;SAVE FLAG THAT'S 0 FOR SQUOZE, -1 FOR .RSQZ .
PUSH P,SYM
PUSHJ P,AGETFD
LSH A,36
PUSH P,A
PUSHJ P,GETSLD ;GET SYM, SAVE DELIMITER FOR REINPUT
CALL NONAME
REST A
LDB B,[4000,,SYM] ;GET JUST THE SQUOZE.
SKIPGE -1(P)
PUSHJ P,ASQOZR ;FOR .RSQZ, RIGHT-JUSTIFY IT.
SUB P,[1,,1]
ADD A,B
JRST CLBPOP
;RIGHT-JUSTIFY THE SQUOZE WORD IN B.
ASQOZR: MOVE SYM,B
IDIVI SYM,50
JUMPN LINK,CPOPJ ;LAST ISN'T BLANK, DONE.
MOVE B,SYM ;ELSE REPLACE BY WHAT'S SHIFTED RIGHT 1 CHAR.
JRST ASQOZR
;COMMON PSEUDO ROUTINE TO RETURN MIDAS INTERNAL QUANTITY
;ADR IN LH(B)) AS VALUE (EG. .RPCNT, .FNAM1, .AVAL2, ETC.
;INTSYMS MAY APPEAR TO LEFT OF =
INTSYM: MOVE A,B ;GET ADR IN LH(A)
JRA A,CLBPOP ;RETURN IT
;.YSTGW, .NSTGW ACCORDING TO WHAT'S IN LH(B)
STGWS: HLRES B ;.NSTGW INCREMENTS STGSW, .YSTGW DECREMENTS.
ADDB B,STGSW
SKIPGE B ;BUT DON'T DECREMENT PAST 0.
SETZM STGSW
JRST MACCR ;STORAGE WORDS ARE ALLOWED IF STGSW IS ZERO.
;.TYPE
A.TYPE: PUSH P,SYM
PUSH P,SYM
PUSHJ P,GETSLD ;GET NAME
CALL NONAME
SUB P,[2,,2]
TRNN I,IRLET ;IF SYLLABLE IS A NUMBER,
JRST [ SETO A, ;RETURN -1.
JRST CLBPOP]
PUSHJ P,ES ;EVALUATE SYM, INTERESTED IN SQUOZE FLAGS RETURNED IN A
MOVEI A,17 ;DIDN'T SKIP, RETURN 17 => UNSEEN
IFN CREFSW,XCT CRFINU
JRST CLBPOP
NONAME: MOVE SYM,-2(P)
ETSM [ASCIZ /No arg/]
SETZ SYM,
POPJ P,
;.FORMAT
A.FORMAT: PUSHJ P,AGETFD ;GET FIRST FIELD (FORMAT #)
MOVE B,CDISP ;WORD TERMINATOR ENDED 1ST ARG =>
TLNN B,DWRD
JRST A.FOR1 ;RETURN CURRENT SPEC FOR THAT FORMAT.
PUSH P,A
PUSHJ P,AGETFD ;GET SECOND FIELD (TABLE ENTRY FOR FORMAT NUMBER)
POP P,B
MOVEM A,FORTAB-10(B)
JRST ASSEM1
A.FOR1: MOVE A,FORTAB-10(A)
JRST CLBPOP
A.BYTE: NOVAL
CLEARM NBYTS ;# BYTES ASSEMBLED
CLEARM BYTMT ;TOTAL ACTIVE BYTES IN TABLE
MOVE A,[440700,,BYBYT] ;POINTER TO NEW TABLE
MOVEM A,BYTMP
A.BY1: PUSHJ P,AGETFD ;GET FIELD, .GE. 0 => BYTE, .LT. 0 => HOLE
MOVE C,ISAV
TRNN C,IRFLD
JRST A.BY2 ;NO FIELD
MOVM B,A
SKIPGE A
TRO B,100
IDPB B,BYTMP
AOS BYTMT
A.BY2: TLNE CH1,DWRD ;CDISP LEFT IN CH1 BY AGETFD
JRST A.BY1 ;NOT WORD TERMINATOR
SKIPN BYTMT ;WORD TERMINATOR, ANY FIELDS?
JRST A.BY3 ;NO, DO .WALGN AND RESET TO WORD MODE
SETOM BYTM ;ENTERING BYTE MODE
MOVE A,[-LPDL,,PDL]
CAMN A,ASSEMP
SETOM BYTM1
PUSHJ P,BYSET
MOVE A,GLSPAS
MOVEM A,GLSP1
JRST ASSEM1
;RESET THE BYTE DESCRIPTOR TABLE POINTERS TO POINT TO NEW WORD
BYSET: CLEARM BYTMC ;COUNT OF BYTES PROCESSED THIS TABLE SCAN
MOVE A,[440700,,BYBYT] ;POINTER TO DESCRIPTOR TABLE
MOVEM A,BYTMP
ILDB A,BYTMP ;FIRST DESCRIPTOR BYTE
AOS BYTMC
DPB A,[300600,,BYTWP] ;DEPOSIT AS FIRST BYTE SIZE
POPJ P,
A.BY3: CLEARM BYTM ;NO LONGER IN BYTE MODE
MOVE A,[-LPDL,,PDL]
CAMN A,ASSEMP
SETZM BYTM1
JRST A.WAL1
A.WALGN: NOVAL
A.WAL1: LDB A,[360600,,BYTWP]
CAIN A,44
JRST ASSEM1 ;ALREADY AT BEGINNING OF WORD
MOVEI A,44
DPB A,[360600,,BYTWP] ;MAKE IT POINT TO BEGINNING OF WORD
PUSHJ P,BYSET
CLEARM T1
JRST PBY1
BYTIN1: CLEARM BYTMC
MOVE A,[440700,,BYBYT]
MOVEM A,BYTMP
BYTINC: AOS A,BYTMC
CAMLE A,BYTMT
JRST BYTIN1
ILDB A,BYTMP
DPB A,[300600,,BYTWP]
MOVEM A,T1
HLLZ A,BYTWP
IBP A
TRNN A,-1
JRST BYTINR
;NEXT BYTE GOES IN NEXT WORD
PBY1: MOVE P,ASSEMP ;PCONS NEEDS THIS.
MOVEI A,WRD-1
PUSH A,BYTW ;INTO WRD,
PUSH A,BYTRLC ;INTO WRDRLC
CLEARM BYTW
SETZM BYTRLC
MOVEI A,44
DPB A,[360600,,BYTWP]
MOVE AA,ASMOUT
JRST @ASMOT4(AA) ;TO PBY4 OR PBY5 OR PBY3
PBY4: SKIPE STGSW
ETR ERRSWD
PUSHJ P,PWRD ;NOT IN CONST., OUTPUT WORD.
AOSA CLOC
PBY3: JSP T,PCONS ;OUTPUT INTO CONST.
PBY5: MOVE A,GLSPAS
MOVEM A,GLSP1
BYTINR: MOVE A,T1 ;CURRENT BYTE SIZE
TRNN A,100
JRST @ASMDSP
SETZB A,B ;ASSEMBLE HOLE (BLANK BYTE) IMMEDIATELY AFTER PREVIOUS BYTE
JRST PBY2
PBYTE: AOS NBYTS
PBY2: MOVEI AA,WRD-1
PUSH AA,BYTW ;INTO WRD
PUSH AA,BYTRLC ;INTO WRDRLC
IBP BYTWP
LDB T,[301400,,BYTWP]
PUSHJ P,INTFLD
POP AA,BYTRLC ;WRDRLC
POP AA,BYTW ;WRD
JRST BYTINC
;VARIABLES FOR .BYTE, .BYTC, .WALGN
VBLK
BYTM: 0 ;-1 FOR IN BYTE MODE, LAMBDA BOUND BY <'S, ('S, AND ['S ;]
BYTMC: 0 ;COUNT CORRESP WITH BYTMP
BYTMP: 0 ;POINTER TO BYTE DESC TABLE
BYTMT: 0 ;TOTAL ACTIVE BYTES IN TABLE
BYTM1: 0 ;GLOBAL VALUE OF BYTM - WHAT IT WAS OUTSIDE THE OUTERMOST BRACKET
;FORMAT OF BYTE DESC TABLE
;SEVEN BIT BYTES
;1.7=0 ASSEMBLE =1 BLANK
;1.1 - 1.6 NUMBER OF BITS
IFNDEF LBYBYT,LBYBYT==5 ;LENGTH OF BYBYT
BLCODE [BYBYT: BLOCK LBYBYT] ;BYTE DESC TABLE, 7 BITS PER DESC
BYTWP: 440000,,BYTW ;POINTER TO BYTW IDPB TO DEPOSIT CURRENT BYTE
BYTW: 0 ;WORD BEING ASSEMBLED IN BYTE MODE
BYTRLC: 0 ;RELOC OF BYTW.
NBYTS: 0 ;NUMBER BYTES ASSEMBLED (FOR .BYTC)
BYTMCL==.-BYTMC
PBLK
;;MACRO PROCESSOR
IFN MACSW,[
;GET IN B THE CHAR WHOSE ADR IS IN A, INCREMENT A
REDINC: MOVE CH1,A
IDIVI CH1,4
LDB B,PTAB(CH2)
AOJA A,CPOPJ
VBLK ;THIS STUFF ALL RELOCATED WHEN MACTAB ADDR CHANGED.
PTAB: (341000+CH1)MACTBA ;BYTE TABLE
(241000+CH1)MACTBA
(141000+CH1)MACTBA
(41000+CH1)MACTBA
(341000+CH1)MACTBA+1
;IN FOLLOWING MACROS, B = -1, 0, OR +1 (+ SIGN MUST BE GIVEN)
;0 => BP SAME AS CHAR ADR, -1 => BP FOR ILDB, 1 => BP ONE AHEAD
;CHAR ADR IN A, RETURNS BP IN A, CLOBBERS A+1
DEFINE BCOMP A,B/
IDIVI <A>,4
ADD <A>,(<A>+1)BCOMPT!B
TERMIN
STOPPT: 041000,,MACTBA-1
BCOMPT: 341000,,MACTBA
241000,,MACTBA
BCOMPU: 141000,,MACTBA
041000,,MACTBA
341000,,MACTBA+1
;BP IN A RETURN CHAR ADR IN A, CLOBBERS A-1 (YES, A MINUS 1)
;2ND ARG IS SUBTRACTED - -1 GIVES ADDR OF THE NEXT CHAR.
DEFINE CCOMP A,B/
MOVEI <A>-1,0
ASHC <A>-1,2
SUB <A>,(<A>-1)CCOMPT!B
TERMIN
;BP IN A RETURN CHAR ADR IN A+1, CLOBBERS A
DEFINE CCOMP1 A,B/
MULI <A>,4
SUB <A>+1,(A)CCOMPT!B
TERMIN
;FROM HERE THRU CCOMPE SET BY MACINI.
CCOMPB: 0 ;4*<41000,,MACTBA>-4
CCOMPT: REPEAT 5,0 ;4*<41000,,MACTBA>+.RPCNT-3
CCOMPE::PBLK
;BP IN A, DECREMENT IT
DEFINE DBPM A
ADD A,[100000,,]
SKIPGE A
SUB A,[400000,,1]
TERMIN
;SET UP CPTR FROM CHAR ADR IN A
ACPTRS: MOVEI CH1,(A) ;GET CHAR ADR IN CH1
BCOMP CH1,-1 ;CONVERT TO BYTE POINTER
MOVEM CH1,CPTR ;STORE COMPUTED CPTR
POPJ P,
AFCOMP: HRRZM A,FREEPT ;ENTRY TO STORE C(A) INTO FREEPT
FCOMP: MOVE CH1,FREEPT ;COMPUTE FREPTB FROM FREEPT
BCOMP CH1,-1
MOVEM CH1,FREPTB ;STORE CALCULATED BYTE POINTER
POPJ P,
STPWR: MOVEI A,375
JRST PUTREL
VBLK
PUT377: MOVEI A,377
PUTREL: JRST PUTRE1 ;IDPB A,FREPTB;STORE CHAR INTO FREE CHARACTER STORAGE
AOS A,FREEPT ;CLOBBERS ONLY A.
AOS PUTCNT
CAMGE A,MACHI
POPJ P,
JRST GCA
PBLK
PUTRE1: PUSH P,[IDPB A,FREPTB]
POP P,PUTREL ;COME HERE ONLY ON 1ST CALL TO PUTREL.
SETOM INICLB ;HAVE WRITTEN IN MACRO TAB & CLOBBERED INIT.
JRST PUTREL ;NOW GO BACK AND REALLY WRITE CHAR.
;200 BIT SET ON CHAR READ FROM MACTAB, PROCESS SPECIAL CONDITION
;CLOBBERS A,CH1,CH2.
MACTRM: CAIN A,176 ;376?
JRST RCHTRA ;376 => IGNORE, CHARACTER USED TO CLOBBER UNDESIRED CHARACTERS IN MACRO STORAGE
PUSH P,B ;SAVE B
CAIE A,177
CAIN A,175
JRST MRCH1 ;377, 375 => STOP
ADD A,BBASE ;DUMMY, RELOCATE TO POINT TO DUMMY TABLE
MOVEI B,RCHSAV ;RETURN TO RCHSAV ON END OF DUMMY
PUSHJ P,PUSHEM ;SAVE CURRENT STATUS
HRRZ A,(A) ;GET CHAR ADR OF DUMMY
BCOMP A,-1 ;CONVERT TO BYTE POINTER
MOVEM A,CPTR ;STORE AS NEW CPTR
MOVE A,TOPP
MOVEM A,BBASE
RCHTRB: POP P,B
RCHTRA: POP P,A ;POP RETURN
TLZN FF,FLUNRD ;IF NO CHAR TO RE-READ, JUST RETURN BACK TO THE ILDB A,UREDP.
JRST -3(A)
ANDI A,-1 ;IF A CHAR TO RE-READ, IF CALLED FROM RREOF, WE CAN RETURN TO RRU
CAIN A,RREOF+1
JRST RRU
PUSH P,A ;OTHERWISE, CALL RCH TO RE-READ THAT CHAR, AND RETURN IT FROM
JRST RCH1 ;THE CURRENT ATTEMPT TO READ A CHAR.
MRCH1: MOVE B,MACP
BPOPJ: POPJ B, ;RETURN AT END OF STRING EXPANSION
;RCHSET ROUTINE TO CAUSE INPUT FROM MACRO PROCESSOR
RCHMAC: TLO FF,FLMAC ;SET FLAG
JSP A,CPOPJ
RCHMC0: REPEAT 2,[ ;GETCHR, RR1
ILDB A,CPTR ;GET CHAR
TRZE A,200 ;200 BIT...
PUSHJ P,MACTRM ;=> SPECIAL, PROCESS
]
.VALUE
IFN .-RCHPSN-RCHMC0,.ERR RCHMC0 LOSES.
ILDB A,CPTR ;SEMIC
TRZE A,200
PUSHJ P,MACTRM
CAIE A,15
JRST SEMIC ;NOT YET
JRST SEMICR ;YET
;PUSH INPUT STATUS IN FAVOR OF MACRO
;B HAS RETURN ADR FOR END OF MACRO (OR WHATEVER)
;SEE ALSO PMACP
PUSHEM: PUSH P,A
PUSH P,F
MOVE F,MACP ;GET MACRO PDL POINTER
MOVE CH1,CPTR
CCOMP1 CH1,-1 ;CONVERT TO CHARACTER ADDRESS
HRL CH2,BBASE
PUSH F,CH2 ;PUSH BBASE,,CPTR
MOVEI A,1 ;=> EXPAND MACRO
PUSHJ P,PSHLMB ;SAVE LIMBO1 STATUS AND RETURN
JRST PSHM1
;UNDO A PUSHEM
;RETURNS BBASE,,CPTR IN B (CPTR RE-INITIALIZED, BBASE NOT)
POPEM: PUSH P,A
PUSH P,F
MOVE F,MACP
PUSHJ P,POPLMB ;RESTORE LIMBO1 STATUS
POP F,B ;BBASE,,CPTR
MOVEI CH1,(B) ;GET CHAR ADR IN CH1
BCOMP CH1,-1 ;CONVERT TO BYTE POINTER
MOVEM CH1,CPTR ;STORE NEW CPTR
PSHM1: MOVEM F,MACP ;STORE BACK MACRO PDL POINTER
POPFAJ: POP P,F
POPAJ: POP P,A
POPJ P,
PMACP: MOVE B,MACP ;POP MACRO PDL
HRRZ A,(B)
SUB B,[1,,1]
IFN RCHASW,CAIE A,A.TYM8
CAIN A,AIRR
JRST A.GO6 ;IRP OR .TTYMAC
CAIN A,REPT1
JRST A.GO4 ;REPEAT
CAIE A,RCHSV1 ;MACRO
CAIN A,RCHSAV ;ARG
JRST A.GO6
.VALUE ;DON'T HAVE RETURN,
JRST A.GO6 ;BUT TRY A.GO6 LIKE EVERYTHING BUT REPEAT
A.GO4: HLLZS -1(B) ;REPEAT, CLEAR OUT COUNT REMAINING
A.GO6: TRO FF,FRMRGO ;EVERYTHING ELSE, SET FLAG TO QUIT
JRST (A)
;4.9(B) => .STOP ELSE .ISTOP
A.STOP: HRRZ A,MACP
JUMPL B,A.STP1
HRRZ B,(A) ;.ISTOP
CAIN B,REPT1
HLLZS -2(A) ;REPEAT, STOP ALL INTERATIONS
CAIN B,AIRR
HRRZS -1(A) ;IRP TYPE, CLEAR OUT # GROUPS, DON'T ALLOW RECYCLE
A.STP1: MOVE A,STOPPT
MOVEM A,CPTR ;CAUSE STOP
JRST POPJ1
A.QOTE: JFCL
ATERMI: ETSM [ASCIZ/Not in macro/]
JRST MACCR ;MAYBE FLUSH MESSAGE IF PEOPLE HAVE PROBLEMS
;PDL STRUCTURE FOR REPEAT
;TWO TWO WORD ENTRIES
;BBASE,,CPTR
;LIMBO1 STATUS,,# TIMES LEFT
;OLD .RPCNT,,BEG OF BODY
;GARBAGE,,REPT1
AREPEAT: PUSHJ P,AGETFD
JUMPLE A,COND5 ;NO REPEAT PLAY LIKE STRING COND FALSE
PUSH P,A
MOVE A,FREEPT
MOVEM A,PRREPT ;CHAR ADR BEGINNING OF REPEAT
MOVEI A,373 ;CHECK CHAR FOR REPEAT
PUSHJ P,PUTREL ;STORE AS FIRST CHR OF BODY
JSP D,RARL1
CAIA
CALL RARGCP ;READ THE ARG & COPY INTO MACRO STORAGE.
MOVEI A,^M ;IF THE ARG WASN'T BRACKETED,
TLNE FF,FLUNRD
CALL PUTREL ;INCLUDE THE TERMINATING CR.
SWRET1: PUSHJ P,STPWR ;ALSO RETURN FROM STRING WRITE (.F .I)
POP P,B ;# TIMES TO GO THROUGH
PUSHJ P,PUSHEM
MOVE B,MACP ;NOW GET MACRO PDL POINTER FOR PUSH OF SECOND ENTRY
MOVNI T,1
EXCH T,CRPTCT ;GET OLD .RPCNT, INITIALIZE NEW ONE TO -1
CREPT1: SETZI TT,REPT1
EXCH TT,PRREPT ;GET LOC BEGINNING OF BODY, CLEAR OUT PRREPT, DON'T NEED IT ANYMORE
HRL TT,T
PUSH B,TT ;SAVE OLD .RPCNT,,ADDRESS OF BODY.
PUSH B,CREPT1 ;PUSH CRUD,,REPT1 FOR RETURN
MOVEM B,MACP ;STORE BACK UPDATED MACRO POINTER
MOVE A,STOPPT
MOVEM A,CPTR ;CAUSE IMMEDIATE CYCLE
JRST MACCR
IFN .I.FSW,[ ;CODING FOR .I, .F
SWINI: MOVE A,FREEPT ;INITIALIZE, WILL EVENTUALLY PLAY LIKE REPEAT 1
MOVEM A,PRREPT
MOVEI A,373
JRST PUTREL
SWRET: PUSH P,[1] ;REPEAT COUNT
JRST SWRET1
SWFLS: MOVE A,PRREPT ;FLUSH RETURN
PUSHJ P,AFCOMP
JRST MACCR
]
;RECYCLE AROUND REPEAT
REPT1: PUSH P,A
PUSH P,C
HRRZ A,(B) ;CHAR ADR BEG BODY
PUSHJ P,REDINC
CAIE B,373
HALT ;FIRST CHAR OF REPEAT BODY NOT 373
HRRZ C,MACP
HRRZ B,-2(C) ;# TIMES LEFT
SOJL B,REPT2 ;JUMP IF LAST TIME THROUGH WAS LAST TIME TO GO THROUGH
AOS CRPTCT
PUSHJ P,ACPTRS ;SET UP CPTR (CHAR ADR IN A)
HRRM B,-2(C) ;STORE UPDATED COUNTDOWN
REPT3: POP P,C
POP P,A
JRST REPT6
REPT2: SOS A ;MOVE BACK TO BEG OF REPEAT
;(IN CASE GETS STORED INTO FREEPT)
MOVE CH2,CPTR
CCOMP CH2,-1 ;CONVERT TO CHARACTER ADDRESS
CAMN CH2,FREEPT
PUSHJ P,AFCOMP
MOVE A,[-3,,-2]
ADDB A,MACP
HLRZ A,1(A)
MOVEM A,CRPTCT
PUSHJ P,POPEM
JRST REPT3
;STRING CONDITIONALS (IFSE, IFSN)
SCOND: MOVE A,FREEPT
MOVEM A,PRSCND
MOVEM A,PRSCN1
PUSH P,SYM
HRRI B,SCONDF
PUSH P,B ;REMEMBER TEST INSTRUCTION.
SETOB C,SCONDF
JSP D,RARG ;COPY THE 1ST OF THE 2 STRINGS
CAIA
CALL RARGCP ;INTO MACRO STORAGE, FOLLOWED BY 375.
CALL STPWR
JSP D,RARG ;THEN START READING THE 2ND ARG,
JRST SCOND3 ;GO TO SCOND3 WHEN REACH END OF 2ND ARG.
JSP D,RARGCH(T) ;READ NEXT CHAR OF 2ND ARG,
JRST SCOND3
EXCH A,PRSCND
PUSHJ P,REDINC ;RE-FETCH NEXT CHAR OF 1ST ARG
EXCH A,PRSCND
CAMN B,A ;COMPARE CHARACTERS
JRST RARGCH(T) ;CHARS EQUAL, KEEP COMPARING.
CAIL A,"A+40
CAILE A,"Z+40 ;NOT EQUAL => CONVERT BOTH TO UPPER CASE.
CAIA
SUBI A,40
CAIL B,"A+40
CAILE B,"Z+40
CAIA
SUBI B,40
CAMN B,A ;ARE THEY SAME EXCEPT FOR CASE?
JRST RARGCH(T) ;CHARS EQUAL, KEEP COMPARING.
CLEARM SCONDF ;STRINGS DIFFER
CALL RARFLS ;IGNORE REMAINDER OF 2ND ARG.
SCOND3: CLEARB A,C ;END OF (SECOND) STRING ARG ENCOUNTERED
EXCH C,PRSCN1
MOVEM C,FREEPT
PUSHJ P,FCOMP
EXCH A,PRSCND
PUSHJ P,REDINC
CAIE B,375
CLEARM SCONDF
REST B
REST SYM
XCT B ;DO THE TEST.
JRST COND4
JRST COND2
VBLK
BLCODE [DMYDEF: BLOCK DMDEFL] ;TABLE OF DUMMY NAMES FOR THING BEING DEFINED
DMYTOP: DMYDEF ;POINTER INTO DMYDEF, POINTS TO AVAILABLE WORD
;SINCE ONLY ONE THING CAN BE DEFINED AT ONCE, IT IS NOT NECESSARY TO SAVE AND RESTORE DMYTOP
DMYBOT: DMYDEF ;-> 1ST DMYDEF WD USED AT THIS LEVEL.
;RIGHT NOW, ALWAYS -> DMYDEF SINCE CAN'T HAVE DEFINITION
;WITHIN A DEFINITION YET.
PBLK
PDEF: PUSHJ P,GSYL ;READ IN SYL
CAIE T,", ;IF DELIMITING CHR NOT ,
JUMPE SYM,CPOPJ ;AND SYM NULL, RETURN
PDEF1: MOVEM SYM,@DMYTOP ;STORE SYM
AOS D,DMYTOP ;INCR PNTR
CAIL D,DMYDEF+DMDEFL ;CHECK FOR TABLE SIZE EXCEEDED
ETF [ASCIZ/Too many dummies in DEFINE or IRP/]
POPJ P,
VBLK
BLCODE [DSTG: BLOCK DSSIZ] ;TABLE OF CHAR ADRS OF DUMMIES BEING DEFINED PRIOR TO MACRO EXPANSION
RDWRDP: DSTG ;POINTER TO DSTG, POINTS TO FREE WORD
;NOTE THAT RDWRDP MUST BE SAVED AND RESTORED SINCE MORE MACROS CAN
;BE EXPANDED DURING FIELD READ FOR DUMMY
PBLK
ADDTR1: CLEARM PUTCNT
ADDTRN: MOVE A,FREEPT
ADDTR2: MOVEM A,@RDWRDP
AOS A,RDWRDP
CAIL A,DSTG+DSSIZ
ETF [ASCIZ/Too many dummies in all macros & IRPs being expanded/]
RET
VBLK
BLCODE [DMYAGT: BLOCK DMYAGL] ;TABLE OF CHAR ADRS OF DUMMYS OF MACROS BEING EXPANDED
;DMYAGT TRACKS WITH THE MACRO PDL;
;DMYAGT CAN'T BE COMBINED WITH DSTG SINCE DMYAGT CAN BE SHIFTING AROUND RANDOMLY DURING ARG SCAN
BBASE: DMYAGT ;POINTER TO BEGINNING OF ACTIVE DUMMY LIST (FOR DEEPEST-NESTED MACRO BEING EXPANDED)
;ADD TO DUMMY # TO GET LOCATION CONTAINING CHAR ADR OF DUMMY
TOPP: DMYAGT ;POINTER TO TOP OF DMYAGT ACTIVE, POINTS TO FREE REGISTER
PBLK
;ACTIVATE DUMMYS ON TOP OF DSTG TABLE
;A -> FIRST (LOWEST) DUMMY IN DSTG TO ACTIVATE
DMYTRN: MOVE B,TOPP
MOVEM B,BBASE
PUSH P,A
DMYTR2: CAML A,RDWRDP
JRST DMYTR1
MOVE B,(A)
MOVEM B,@TOPP
AOS B,TOPP
CAIL B,DMYAGT+DMYAGL
ETF [ASCIZ /Too many dummy args active/]
AOJA A,DMYTR2
DMYTR1: POP P,RDWRDP
POPJ P,
;THE MACRO TABLE IS FILLED MAINLY WITH 8-BIT BYTES.
;THE FIRST WORD'S ADDR IS IN MACTAD; THE LAST+1'S IN MACTND.
;THE CHARACTER NUMBER OF THE LAST+1ST CHAR IS IN MACHI.
;MACHIB IS BP. TO HIGHEST BYTE OK TO FILL (LAST IN C(MACTND)-1)
;IF A BYTE IN THE TABLE HAS ITS HIGH BIT OFF, IT IS AN ASCII CHARACTER.
;OTHERWISE, IT IS SPECIAL. IF THE 100 BIT IS OFF IT MEANS
;SUBSTITUTE A MACRO DUMMY ARG WHEN READ; THE CHAR IS THE NUMBER OF THE ARG+200 .
;377 AND 375 ARE STOP CODES, CAUSING A POP OUT OF THE CURRENT STRING.
;GC CONSIDERS THE CHAR. AFTER A 375 TO START A NEW STRING.
;376 IS IGNORED WHEN READ; USED TO CLOBBER UNWANTED CHARACTERS IN STRINHGS.
;374 STARTS EVERY MACRO-DEFINITION.
;373 STARTS THE BODY OF A REPEAT.
;370 STARTS A WORD STRING:
;THE WORD AFTER THAT WHICH CONTAINS THE 370
; HAS THE LENGTH IN WORDS OF THE STRING IN ITS LH,
; IN ITS RH, THE ADDRESS OF WD WHICH POINTS BACK TO THIS ONE.
; THEN FOLLOW RANDOM WDS HOLDING ANYTHING AT ALL.
; GC WILL MAKE SURE IT STAYS ON WD BOUNDARY.
; THE LENGTH INCLUDES THE WD HOLDING THE LENGTH.
; IF THE RH OF 1ST WD HAS 0, GC WILL FLUSH THE STRING
STRTYP: PUSHJ P,REDINC ;DEBUGGING AID ONLY
EXCH A,B
TRZE A,200
JRST STRTP1
STRTP2: PUSHJ P,TYO ;NORMAL CHAR, JUST TYPE OUT
MOVE A,B
JRST STRTYP
STRTP1: PUSH P,A
MOVEI A,"* ;SPECIAL CHAR, TYPE *
PUSHJ P,TYO
POP P,A
TRNE A,100
JRST STRTP3 ;CONTROL CHAR
ADDI A,260 ;DUMMY, CONVERT TO #
JRST STRTP2 ;TYPE OUT (SINGLE DIGIT) NUMBER
STRTP3: CAIN A,175
SKIPA A,C% ;STOP, TYPE %
MOVEI A,"/ ;SOMETHING ELSE, TYPE /
JRST STRTP2
;.GSSET, SET GENERATED SYM COUNTER
A.GSSET: CALL AGETFD
MOVEM A,GENSM
JRST ASSEM1
;GSYL-LIKE ROUTINE, READ A SYL FOR WRQOTE
WRQRR: PUSHJ P,RCH ;GET CHAR (MAYBE WANT THIS TO BE FASTER YET)
IDPB A,FREPTB ;DEPOSIT IN MACRO TABLE
CAMN F,FREPTB ;WAS THIS LAST CHAR IN TABLE?
JRST WRQRGC ;YES, NEED GARBAGE COLLECTION
WRQRR2: XCT GDTAB(A) ;DISPATCH ON CHAR
JFCL ;(MAYBE SKIPS)
SOJGE D,WRQRR ;LOOP FOR FIRST SEVEN CHARS
HRRI D,0
JRST WRQRR
;HERE FROM WRQRR WHEN NEED GARBAGE COLLECTION OF MACRO TABLE
WRQRGC: MOVEM C,WRQTBP ;PUT POINTER TO BEGINNING OF SYL WHERE IT WILL BE GC'D
MOVE A,MACHI
PUSHJ P,GCA ;GARBAGE COLLECT
MOVE F,MACHIB ;RESET F TO POINT TO NEW LAST CHAR IN MACTAB
MOVEI C,0
EXCH C,WRQTBP ;GET BACK POINTER TO CHAR BEFORE SYL
MOVE A,LIMBO1 ;RETRIEVE LAST CHAR READ
JRST WRQRR2 ;LOOP BACK, PROCESS CHAR
;HERE FROM WRQOTE IF .QUOTE SEEN
;.QUOTE TAKES ARG LIKE ASCII, PRINTC, ETC.
A.QOT1: MOVE A,WRQBEG(P) ;GET BACK BP TO CHAR BEFORE .QUOTE
PUSHJ P,A.QOTS ;SET UP FREEPT AND FREPTB PROPERLY
MOVE A,LIMBO1 ;NOW GET CHAR AFTER .QUOTE
CAIE A,^I
CAIN A,40 ;COMPARE WITH SPACE
PUSHJ P,RCH ;SPACE, GOBBLE NEXT CHAR FOR DELIMITER, ELSE THIS ONE
MOVEM A,A.QOT2 ;STORE AS TERMINATOR OF STRING
A.QOT3: PUSHJ P,RCH ;GET CHAR TO QUOTE
CAMN A,A.QOT2 ;TERMINATOR?
JRST WRQOT1 ;TERMINATOR, BACK FOR MORE DEFINITION
PUSHJ P,PUTREL ;DEPOSIT CHAR
JRST A.QOT3
;READ IN BODY OF MACRO, IRP, OR WHATEVER
WRQOTE: PUSH P,[0] ;USED FOR LENGTH OF SYMBOL (REALLY 6 MINUS IT).
WRQLEN==,-2
PUSH P,[0] ;THIS WD USED FOR DEFINE/TERMIN COUNT.
WRQLVL==,-1
PUSH P,[0] ;USED TO REMEMBER BEGINNING OF SYMBOL.
WRQBEG==0
SETOM INICLB ;CLOBBERED INITS, .SYMTAB NOW ILLEGAL.
PUSHJ P,RCH ;MAYBE POP UP A LEVEL IN EXPANSIONS, SAVE MACTAB SPACE
TLO FF,FLUNRD ;CAUSE CHAR TO BE RE-INPUT
MOVE F,MACHIB ;POINTER TO LAST CHAR OK TO PUT IN MACTAB, STAYS IN F
TRO I,IRSYL\IRLET ;MAKE SURE FLAGS SET SO WON'T WASTE TIME AT MAKNUM, POINT
WRQOT0:
WRQOT1: MOVEI D,6 ;SQUOZE COUNTER
MOVEI SYM,0 ;INITIALIZE SYM
MOVE C,FREPTB ;GET POINTER TO CHAR BEFORE SYL ABOUT TO READ
PUSHJ P,WRQRR ;READ SYL
JUMPE SYM,.-2 ;LOOP UNTIL NON-NULL
;NOW SEE IF DUMMY; **NOTE**: C STILL HAS BYTE POINTER, A SYL TERMINATOR
MOVE B,DMYBOT
CAML B,DMYTOP
JRST WRQOT2 ;NOT DUMMY
CAME SYM,(B) ;COMPARE WITH DUMMY NAME
AOJA B,.-3 ;LOOP ON NO MATCH
SUB B,DMYBOT ;DUMMY, CONVERT TO NUMBER + 200
SUBI B,200
LDB T,C ;GET LAST CHAR BEFORE SYL
CAIE T,"! ; ^ NOTE THAT THIS CAN LOSE IF MACRO HAS 33. ARGS
IDPB B,C ;NOT EXCLAMATION POINT, LEAVE THERE, DEPOSITING DUMMY CHAR
CAIN T,"!
DPB B,C ;EXCL, WIPE IT OUT
MOVEM C,FREPTB ;RESET FREPTB
CAIE A,"! ;A HAS DUMMY TERMINATOR, COMPARE WITH EXCL
TLO FF,FLUNRD ;NOT EXCLAMATION POINT, CAUSE IT TO BE RE-INPUT
JRST WRQOT1 ;LOOP BACK FOR NEXT SYL
;SYL ISN'T DUMMY, CHECK FOR PSEUDO
WRQOT2: MOVEM D,WRQLEN(P) ;REMEMBER START OF AND LENGHTH OF THE SYMBOL.
MOVEM C,WRQBEG(P)
SETOM ESBK ;EVAL IN CURRENT BLOCK.
PUSHJ P,ES ;EVALUATE SYM (DOESN'T CLOBBER F)
JRST WRQOT0 ;NOT SEEN
CAIE A,PSUDO/40000
JRST WRQOT0 ;NOT PSEUDO
TLZ B,-1 ;CLEAR OUT LH OF VALUE, ONLY INTERESTED IN RH
CAIN B,A.QOTE
JRST A.QOT1 ;.QUOTE
CAIE B,ADEFINE
CAIN B,AIRP
AOS WRQLVL(P) ;DEFINE OR IRP
IFN RCHASW,[CAIN B,A.TTYM
AOS WRQLVL(P) ;.TTYMAC
]
CAIE B,ATERMIN
JRST WRQOT0
SKIPGE WRQLEN(P)
ETR [ASCIZ /TERMIN longer than 6 chars/]
SOSL WRQLVL(P) ;TERMIN, SKIP IF THE TERMINATING ONE
JRST WRQOT0 ;NOT MATCHING TERMIN, BACK FOR NEXT SYL
POP P,A ;GET BACK BP TO LAST CHAR BEFORE TERMIN
SUB P,[2,,2] .SEE WRQLVL,WRQBEG
MOVE T,DMYBOT ;WE'RE NO LONGER USING SPACE IN DMYDEF.
MOVEM T,DMYTOP
A.QOTS: LDB T,A ;HERE ALSO FROM A.QOT1, GET CHAR BEFORE .QUOTE OR TERMIN
CAIE T,"!
JRST A.QTS2 ;NOT EXCLAMATION POINT => OK
DBPM A, ;EXCLAMATION POINT, DECREMENT POINTER
A.QTS2: MOVEM A,FREPTB ;STORE AS NEW FREPTB
CCOMP1 A,-1 ;CONVERT TO CHAR ADR
MOVEM B,FREEPT ;STORE CHAR ADR AS NEW FREEPT
POPJ P,
;FORMAT OF A MACRO:
;IT STARTS WITH A 374.
;THEN COME ARGUMENT DESCRIPTORS, ONE PER ARGUMENT.
MCF==777650 ;BITS AND FIELDS ARE:
MCFDEF==200 ;ARG IS DEFAULTED. MCFDEF AND MCFGEN NEVER BOTH SET.
MCFGEN==100 ;ARG SHOULD BE GENSYMMED IF NOT GIVEN IN CALL.
MCFKWD==40 ;ARG IS A KEYWORD ARG, SELECTED BY <ARGNAME>= RATHER THAN POSITION.
MCFSYN==7 ;FIELD THAT SPECIFIES THE ARGUMENT'S SYNTAX.
MCFNRM==1 ;MCFSYN CONTAINS MCFNRM => NORMAL-SYNTAX ARG
MCFLIN==2 ;MCFSYN CONTAINS MCFLIN => WHOLE LINE ARG
MCFBAL==3 ;MCFSYN CONTAINS MCFBAL => BALANCED ARG
MCFSTR==4 ;MCFSYN CONTAINS MCFSTR => ARG IS A DELIMITED STRING, AS IN "ASCIZ".
MCFKST==5 ;MCFSYN CONTAINS MCFKST => JUST LIKE MCFSTR, BUT DELIMITERS ARE RETAINED.
MCFEVL==6 ;MCFSYN CONTAINS MCFEVL => ARG IS BY VALUE (PREEVALUATED).
;IF MCFKWD IS SET, THE DESCRIPTOR IS FOLLOWED BY THE NAME OF THE ARGUMENT,
;TERMINATED BY A 377.
;IF MCFDEF IS SET, THE DESCRIPTOR IS FOLLOWED BY THE DEFAULT VALUE OF THE ARG,
;TERMINATED BY A 377.
;IF MCFKWD AND MCFDEF ARE BOTH SET, THE ARG NAME COMES FIRST.
;A ZERO BYTE ENDS THE DESCRIPTOR LIST.
;THEN COMES THE BODY OF THE MACRO, FOLLOWED BY A 375.
ADEFINE: NOVAL ;ERROR IF CONTEXT WANTS A VALUE.
PUSH P,CASSM1 ;RETURN TO ASSEM1 EVENTUALLY
JSP TM,ERMARK ;ERR MSGS SHOULD SAY WE'RE INSIDE A DEFINE.
PUSH P,SYM ;THESE 2 PUSHES ARE FOR NONAME'S SAKE.
PUSH P,SYM
CALL GETSLD
CALL NONAME
TLZ FF,FLUNRD
SUB P,[2,,2]
PUSH P,SYM
PUSH P,ESBK ;SAVE BLOCK TO DEFINE IN FOR ES'S SAKE.
IFN CREFSW,XCT CRFMCD
CALL A.TYM1
POP P,ESBK
REST SYM
PUSHJ P,ESDEF ;FIND SLOT IN SYMBOL TABLE FOR IT
TLO C,3MACOK ;NEVER SEEN, OK TO MAKE MACRO.
TLON C,3MACOK ;ELSE ERROR IF NUMERIC OR ALREADY USED.
ETSM [ASCIZ/Non-macro made macro/]
MOVEI B,MACCL ;RH(VALUE) = MACCL
HRL B,PRDEF ;LH(VALUE) = CHAR ADR OF MACRO
CLEARM PRDEF ;NO LONGER NEED PRDEF
MOVSI T,PSUDO ;SYMBOL TABLE ENTRY LOOKS LIKE PSEUDO
JRST VSM2
IFN RCHASW,[
;.TTYMAC NAME
;BODY
;TERMIN
;NAME DUMMY, CAUSES READIN OF CRUD FROM TTY -> CR (NOT INCLUSIVE)
A.TTYM: JSP TM,ERMARK ;ERROR MSGS SHOULD SAY WE'RE INSIDE A .TTYMAC
CALL A.TYM1 ;READ IN A MACRO-DEFINITION.
MOVEI A,40 ;DON'T LET THE CHAR ENDING THE TERMIN
MOVEM A,LIMBO1 ;MAKE MACCL THINK THERE ARE NO ARGS.
CALL GTYIP1 ;PUSH INTO TTY FOR INPUT
HRLZ B,PRDEF ;PHONY UP A MACRO WHOSE DEFN IS WHAT WE READ.
SETZM PRDEF
MOVEI A,A.TYM8
JRST A.TYM2 ;CALL THE MACRO:
;READ THE ARGS, POP OUT OF TTY, EXPAND THE MACRO
;AND THEN EXIT TO A.TYM8
]
A.TYM1: MOVE A,FREEPT
MOVEM A,PRDEF
MOVEI LINK,MCFNRM ;INITIALLY, DUMMIES ARE NORMAL.
MOVEI A,374
PUSHJ P,PUTREL ;MARK BEGINNING OF MACRO
DEFNI: MOVE T,LIMBO1
MOVE A,LINK
DEFNC: CAIE T,12
CAIN T,15
JRST DEFNA ;NO MORE ARGS (DONE WITH LINE)
CAIE T,LBRACE
CAIN T,LBRKT
JRST DEFNB1
CAIE T,RBRACE
CAIN T,RBRKT
JRST DEFNB2
CAIE T,"< ;OPENS TURN ON BALANCEDNESS.
CAIN T,"(
JRST DEFNB1
CAIE T,"> ;CLOSES TURN OFF BALANCEDNESS.
CAIN T,")
JRST DEFNB2
CAIN T,"? ;? TURNS BALANCEDNESS ON OR OFF.
JRST DEFBAL
CAIN T,"+ ;+ COMPLEMENTS KEYWORDNESS
XORI LINK,MCFKWD
CAIN T,"\ ;\ COMPLEMENTS GENSYMMEDNESS
XORI LINK,MCFGEN
CAIN T,"- ;- TURNS WHOLELINENESS ON OR OFF.
JRST DEFWHL
CAIN T,"* ;* TURNS ASCIZ-STYLE-NESS ON OR OFF.
JRST DEFASC
CAIN T,"& ;& TURNS KEEP-STRUNGNESS ON OR OFF.
JRST DEFKST
CAIN T,"# ;# TURNS EVALUATEDNESS ON OR OFF.
JRST DEFEVL
CAIN T,": ;: MAKES FOLLOWING ARGS NORMAL
MOVEI LINK,MCFNRM ;IN ALL RESPECTS
CAIN T,";
JRST DEFNSM ;ALLOW DEFINE LINE TO BE COMMENTED
DEFND: PUSH P,A
CALL GSYL ;READ IN SYMBOL AS SQUOZE IN SYM.
REST A
CAIN T,"/ ;/ MEANS PREVIOUS ARG IS WHOLE-LINE.
XORI LINK,MCFLIN#MCFNRM
JUMPE SYM,DEFNC ;JUMP IF SYMBOL NAME WAS NULL.
CALL PDEF1 ;ELSE PUSH IT ON LIST OF DUMMIES.
MOVE A,LINK
CAIE T,"=
JRST DEFNL
IORI A,MCFDEF ;ONE ARG, WITH DEFAULT VALUE.
ANDCMI A,MCFGEN ;NOT TO BE GENSYMMED.
DEFNL: CALL PUTREL ;OUTPUT A DESCRIPTOR FOR THIS ARG
TRNE LINK,MCFKWD
CALL DEFNM ;PUT OUT ARG NAME IF KWD ARG
CAIE T,"= ;THEN DEFAULT VALUE IF DEFAULTED.
JRST DEFNI
JSP D,RARG ;INIT. FOR READING THE DEFAULT VALUE.
CAIA
CALL RARGCP ;COPY THE ARG INTO MACRO SPACE,
CALL PUT377 ;TERMINATED BY A 377.
JRST DEFNI ;NOW FOR THE NEXT ARG.
DEFNM: MOVE D,[440700,,STRSTO]
DEFNM1: ILDB A,D
CAMN D,STRPNT
JRST PUT377
CALL PUTREL
JRST DEFNM1
DEFEVL: SKIPA A,[MCFEVL] ;TURN EVALUATEDNESS ON OR OFF.
DEFASC: MOVEI A,MCFSTR ;TURN ASCIINESS ON OR OFF.
JRST DEFN9
DEFKST: MOVEI A,MCFKST ;TURN KEEP-STRUNGNESS ON OR OFF.
JRST DEFN9
DEFBAL: SKIPA A,[MCFBAL] ;TURN ON BALANCEDNESS, BUT IF ALREADY ON TURN OFF.
DEFWHL: MOVEI A,MCFLIN ;SIMILAR FOR WHOLELINENESS.
DEFN9: LDB B,[.BP MCFSYN,LINK]
CAMN A,B ;IF CURRENT STATE IS SAME AS IN A,
MOVEI A,MCFNRM ;SWITCH TO NORMAL MODE INSTEAD.
DPB A,[.BP MCFSYN,LINK]
JRST DEFND
DEFNB2: SKIPA A,[MCFNRM] ;TURN OFF BALANCEDNESS
DEFNB1: MOVEI A,MCFBAL ;TURN ON BALANCEDNESS
DPB A,[.BP MCFSYN,LINK]
JRST DEFND
DEFNSM: PUSHJ P,RCH ;SEMICOLON IN DEFINE LINE
CAIE A,15
CAIN A,12
DEFNA: SKIPA A,LINK ;END OF DEFINE LINE, GET COUNT
JRST DEFNSM
MOVEI A,0
PUSHJ P,PUTREL ;DEPOSIT END-OF-DESCRIPTORS MARK
PUSHJ P,RCH
CAIE A,12
TLO FF,FLUNRD ;CHAR AFTER CR NOT LF
PUSHJ P,WRQOTE ;READ IN BODY
JRST STPWR
;COME HERE TO EXPAND MACRO; LH OF B POINTS TO STRING.
;SYM HOLDS NAME OF MACRO (USED BY CALL TO AGETFD IN MACEVL).
MACCL: JSP TM,ERMARK ;ERROR MESSAGE DURING ARG SCAN SHOULD SAY WE'RE IN IT.
MOVEI A,RCHSV1
A.TYM2: PUSH P,I
AOS PRCALP
AOS MDEPTH
PUSH P,RDWRDP
PUSH P,A ;RCHSV1 FOR MACRO, A.TYM8 FOR .TTYMA
MOVEI LINK,0
HLRZ A,B
PUSHJ P,REDINC
CAIE B,374
HALT
MOVEM A,@PRCALP
PUSHJ P,REDINC
TLZ I,ILPRN
JUMPE B,MACCLE ;MACRO TAKES NO ARGS => UN-READ NEXT CHARACTER.
MOVE A,LIMBO1
CAIE A,") ;MACRO NAME TERMINATED WITH A CLOSE-BRACKET OF SOME SORT
CAIN A,"> ;=> UN-READ THE FOLLOWING CHARACTER.
JRST MACCLE
CAIN A,RBRKT
JRST MACCLE
CAIE A,15 ;MACRO NAME ENDED BY A CR OR LF =>
CAIN A,12
JRST MACCLD ;NO ARGS IN THIS CALL; NULLIFY ALL ARGS.
CAIE A,"<
CAIN A,"(
TLO I,ILPRN ;BUT MAYBE THERE IS A (. IF SO, IT'S A PAREN'D CALL,
CAIN A,LBRKT ;AND WON'T END TILL THE MATCHING CLOSE.
TLO I,ILPRN
CAIE A,40 ;IF THE CHAR ENDING THE MACRO NAME ISN'T AN OPENPAREN,
CAIN A,^I ;EOL, OR SPACE, RE-READ IT AS PART OF 1ST MACRO ARG.
JRST MACNX0
TLNN I,ILPRN
TLO FF,FLUNRD
MACNX0: TDZ LINK,LINK
MACNXD: CALL MACDES ;FETCH NEXT DESCRIPTOR
JRST MACPUS ;NO MORE => THIS IS END OF THE CALL
TRNE LINK,MCFKWD
JRST MACK ;KEYWORD PARAM => SPECIAL SCANNER
;READ IN THE VALUE OF THE NEXT ARG, WHICH IS NORMAL (NOT KEYWORD)
MACNRM: CALL ADDTRN ;PUSH WORD TO HOLD VALUE OF ARG ONTO DSTG,
;INITIALIZED -> FREEPT, WHERE WE WILL NOW WRITE THE ARG.
SOS C,A ;TELL MACRED WHERE THAT WORD IS.
CALL MACRED ;READ IN THE ARGUMENT VALUE.
JRST MACNXD ;THEN HANDLE ANOTHER ARG
.VALUE
JRST MACCLD ;END OF ARG LIST => NULLIFY REMAINING ARGS.
MACCLE: TLO FF,FLUNRD ;SAVE CHR FOLLOWING MACRO W/NO ARGUMENTS
;AND IF THAT CHAR WAS A CLOSE-BRACKET,
SKIPE B,ASMOUT ;CLEAR OUT THE CHANGE IT MADE TO ASMDSP.
CAIN B,4
CAIA
JSP LINK,SAVAS2
SETZ LINK,
JRST MACCLD ;NOW GO NULLIFY ANY ARGS THE MACRO WANTED, AND EXIT.
;READ IN THE NEXT MACRO ARGUMENT ACC TO SYNTAX FLAGS IN LINK.
;C HAS ADDRESS OF WORD ON THE RDWRDP STACK WHICH HOLDS THE POINTER TO THIS ARG
;IN CASE WE WISH TO SET THE ARG TO THE NULL STRING. B AND LINK NOT CLOBBERED.
;RETURNS SKIPPING TWICE IF NO ARG BECAUSE END OF MACRO CALL SEEN.
MACRED: MOVEI D,MACNXR ;RARL3, RARB, RARGBR RETURN TO MACNXR
CALL RCH
CAIE A,^M
CAIN A,^J
JRST MACEND ;MAYBE WE HAVE REACHED THE END OF THE MACRO CALL.
LDB B,[.BP MCFSYN,LINK]
CAIN B,MCFLIN
JRST RARL3 ;ELSE, IF WHOLELINE ARG, NOTHING ELSE TO CHECK,
;SO INIT FOR READING IT IN.
CAIN A,",
JRST MACNUL ;NON-WHOLELINE ARG IS NULL IF NEXT CHAR IS COMMA
CAIN A,"; ;SEMICOLON ENDS ARG LIST UNLESS INSIDE WHOLELINE ARG
JRST MACEND
CAIN B,MCFBAL
JRST RARB ;FOR BALANCED ARG, NOTHING ELSE SPECIAL, SO INIT.
CAIE B,MCFSTR ;FOR BOTH FLAVORS OF STRUNGNESS,
CAIN B,MCFKST ;GO GOBBLE AN ASCIZ-STYLE ARGUMENT.
JRST MACSTR
CAIN B,MCFEVL ;FOR EVALUATED ARG, READ FIELD AND EXPRESS AS NUMERAL.
TLOA FF,FLUNRD ;AND THE CHAR WE JUST READ WAS THE 1ST CHAR OF THE FIELD.
CAIN A,"\ ;NORMAL ARG STARTING WITH "\" TREATED THE SAME WAY, BUT FIELD
JRST MACEVL ;STARTS WITH NEXT CHAR.
CAIN A,LBRKT
JRST RARGBR ;FOR ORDINARY ARG, OPEN-BRACKET MAKES IT SPECIAL
IFN BRCFLG,[
CAIN A,LBRACE
JRST RARGRR
]
MOVEI T,RARGN ;OTHERWISE IT'S A NORMAL ARG
TLOA FF,FLUNRD ;AND THE CHAR WE RCH'ED IS THE 1ST CHAR OF IT
MACNXR: JRST MACEN1 ;NON-SKIP RETURN FROM RARB, RARL3 OR RARGBR => ARG NULL
CALL RARGCP ;ARG NON-NULL => COPY IT INTO STRING SPACE
CAIE A,";
CSTPWR: JRST STPWR ;AND TERMINATE IT
MACSC: MOVE A,(C) ;EXCEPT THAT SEMICOLONS INVALIDATE ALL THE SPACES
CAME A,FREEPT ;AND TABS THAT PRECEDE THEM.
JRST STPWR ;IF, AS A RESULT OF THAT, THE ARG IS NULL, END THE ARGLIST.
;COME HERE WHEN THE END OF THE MACRO'S WHOLE ARGLIST IS SEEN.
MACEND: TLO FF,FLUNRD
MACEN1: AOS (P) ;2-SKIP RETURN FROM MACRED INDICATES END OF ARGLIST
AOS (P) ;END OF ARGLIST => THIS ARG IS NULL.
;COME HERE TO NULLIFY CURRENT ARG (WHERE C POINTS)
MACNUL: TRZE LINK,MCFDEF
JRST MACDEF ;MAYBE DEFAULT IT
TRNE LINK,MCFGEN
JRST MACGEN ;MAYBE GENSYM IT
SETZM (C) ;ELSE SET TO NULL STRING.
RET
MACST1: CALL RCH
CAIN A,",
JRST MACNUL
MACSTR: CAIE A,40 ;HERE FOR ARG DELIMITED LIKE TEXT STRINGS: /TEXT/.
CAIN A,^I ;SKIP ALL SPACES AND TABS BEFORE THE ARG.
JRST MACST1
JSP D,RARB ;FIND END OF LINE, COMMENT, OR CLOSEBRACKET =>
JRST MACEND ;NULLIFY ARG AND END MACRO CALL.
MOVEI T,(A) ;ELSE SAVE THIS CHAR; IT'S THE DELIMITER.
TLZ FF,FLUNRD ;DON'T RE-READ DELIMITER,
CAIN B,MCFKST ;BUT IF ARG IS KEEP-STRUNG, DROP THRU TO STORE IT.
MACST2: CALL PUTREL
CALL RCH ;READ ANOTHER CHARACTER. IF IT ISN'T THE DELIMITER,
CAIE A,(T)
JRST MACST2 ;STORE IT AND READ ANOTHER.
CAIN B,MCFKST ;HIT DELIMITER, DONE. BUT IF ARG IS KEEP-STRUNG,
CALL PUTREL ;KEEP DELIMITER BY STORING IT TOO.
CALL STPWR
MACST3: CALL RCH ;PASS BY SPACES AFTER THE CLOSING DELIMITER
CAIE A,40
CAIN A,^I
JRST MACST3
CAIE A,", ;COMMA HERE ENDS THE ARG BUT NOT THE MACRO CALL.
JSP D,RARB ;ELSE CHECK FOR OTHER TERMINATORS.
RET ;WE FOUND AN ACCEPTABLE ARG TERMINATOR.
ETR [ASCIZ /Garbage in ASCIZ-style macro arg/]
JRST RARFLS ;IF THERE'S ANYTHING ELSE, COMPLAIN AND SKIP IT.
;COME HERE TO GIVE AN ARG ITS DEFAULT VALUE.
;MCFDEF WAS CLEARED SO MACDES WILL KNOW THE DEFAULT VALUE HAS
;ALREADY BEEN PASSED OVER AND WON'T TRY TO SKIP OVER IT.
;IF MCFKWD IS SET, WE MUST SKIP OVER THE KWD ARG'S NAME FIRST.
MACDEF: TRZN LINK,MCFKWD
JRST MACDF1
MOVE A,@PRCALP
MACDF0: CALL REDINC ;SKIP ARG NAME IF KEYWORD ARG.
CAIE B,377
JRST MACDF0
MOVEM A,@PRCALP
MACDF1: MOVE A,@PRCALP ;COPY THE DEFAULT VALUE AS THE ARGUMENT VALUE.
CALL REDINC ;AS THE ARGUMENT STRING.
MOVEM A,@PRCALP
CAIN B,377
JRST STPWR ;END OF THE DEFAULT VALUE.
EXCH A,B
CALL PUTREL
EXCH A,B
JRST MACDF1
;COME HERE IF GENSYMMABLE ARG IS SPEC'D AS NULL.
MACGEN: MOVEI A,5
MOVEM A,SCKSUM
MOVEI A,"G
PUSHJ P,PUTREL
PUSH P,CSTPWR
AOS A,GENSM
IDIVI A,10
HRLM B,(P)
SOSLE SCKSUM
PUSHJ P,.-3
JRST MACEV2
;PROCESS ARG THAT STARTS WITH \, OR #-TYPE ARG.
MACEVL: CALL RCH ;FIRST, CHECK FOR IMMEDIATE END OF MACRO CALL.
JSP D,RARB
JRST MACEN1
PUSH P,C
PUSH P,LINK ;SAVE LINK, NEED FLAGS
PUSHJ P,AGETFD ;GET THE FIELD
SKIPE B
ETR [ASCIZ /Relocatable \'d macro arg/]
POP P,LINK
REST C ;IF AGETFD EXPANDED A MACRO, FREEPT HAS CHANGED, SO
MOVE CH1,FREEPT ;PUT NEW VALUE INTO THE POINTER TO THIS DUMMY.
MOVEM CH1,(C)
MOVE CH1,A ;SAVE VALUE OF FIELD FROM CLOBBERAGE
PUSH P,CSTPWR
MACEV1: LSHC CH1,-35. ;NOW "TYPE OUT" VALUE OF FIELD IN CURRENT RADIX
LSH CH2,-1
DIV CH1,ARADIX
HRLM CH2,(P)
JUMPE CH1,.+2
PUSHJ P,MACEV1
MACEV2: HLRZ A,(P)
ADDI A,60
JRST PUTREL ;OUTPUT TO MACTAB STRING BEING DEFINED
;HANDLE KEYWORD PARAMETERS. COME HERE WHEN A DESCRIPTOR IS SEEN
;THAT SPECIFIES A KEYWORD PARAMETER.
MACK: PUSH P,RDWRDP
MOVE A,@PRCALP ;PUSH A COPY OF POINTER TO 1ST KWD ARG'S DESCRIPTOR
AOS PRCALP ;SO WE CAN ADVANCE THE COPY WHILE KEEPING ORIGINAL FIXED.
MOVEM A,@PRCALP
PUSH P,LINK
;FIRST, PUSH A "NOT SET" MARKER FOR EACH OF THE KEYWORD PARAMS IN THIS RUN OF SUCH.
MACK2: SETO A,
CALL ADDTR2
CALL MACDES ;NOTE THAT THERE IS ONLY ONE PARAM PER DESCRIPTOR
JRST MACK1 ;FOR KEYWORD PARAMS, SO NO NEED TO COUNT DOWN.
TRNE LINK,MCFKWD
JRST MACK2
MACK1: MOVE LINK,(P) ;NOW GO BACK TO THE DESCRIPTOR OF THE FIRST KEYWORD PARAM.
MOVE B,PRCALP
MOVE B,-1(B)
MOVEM B,@PRCALP
MACKLP: CALL GPASST ;NOW SEE IF THERE'S AN ARGUMENT TO BE FOUND
CAIE A,^M ;IF SO, IT SHOULD START WITH A KEYWORD.
CAIN A,^J
JRST MACKND ;CR OR LF => NO KEYWORD, AND END SCAN.
CAIN A,";
JRST MACKND
CAIN A,",
JRST MACKN1 ;NULL ARG => NO KEYWORD, BUT DON'T END SCAN.
CAIE A,")
CAIN A,">
JRST MACKND ;DETECT END OF PARENTHESIZED CALLS, ETC.
CAIE A,RBRKT
CAIN A,RBRACE
JRST MACKND
TLO FF,FLUNRD
CALL GSYL ;THERE SHOULD BE ANOTHER ARG, SO TRY READING KEYWORD NAME
CALL PASSPS
MOVE C,-1(P) ;NOW SCAN THROUGH THIS RUN OF KEYWORD PARAMS FOR THE ONE
CAIE A,"= ;WHOSE NAME MATCHES WHAT GSYL READ.
JRST MACKL5 ;NOT FOLLOWED BY "="??
DPB A,STRPNT
MACKL4: MOVE D,[440700,,STRSTO]
MOVE A,@PRCALP
MACKL1: CALL REDINC
ILDB AA,D
CAIN B,377 ;IF REACHED END OF KEYWORD'S NAME, AND EQUAL SO FAR
JRST MACKL2 ;SEE IF ARG'S NAME ALSO OVER.
CAMN B,AA
JRST MACKL1 ;ELSE KEEP COMPARING IF NAMES STILL SAME SO FAR.
MACKL6: MOVEM A,@PRCALP
CALL MACDES ;THIS KEYWORD DOESN'T MATCH SO FIND THE NEXT
JRST MACKL3 ;THERE ARE NO MORE; LOSE - ARG WITH BAD KEYWORD.
TRNN LINK,MCFKWD
JRST MACKL3
AOJA C,MACKL4
MACKL5: ETR [ASCIZ /Bad format keyword argument/]
TLOA FF,FLUNRD ;INCLUDE THE BAD NON-"=" AS PART OF WHAT WE DISCARD
MACKL3: ETR [ASCIZ /Arg with undefined keyword/]
MOVEI T,RARGN
CALL RARFLS ;SKIP AN ORDINARY-SYNTAX MACRO ARG TO TRY TO RECOVER.
JRST MACK1
;COME HERE AFTER FINDING THE PARAM THAT MATCHES THIS ARG.
;C POINTS TO THE WORD IN DSTG FOR THAT ARG (DSTG IS WHAT ADDTRN PUSHES IN)
MACKL2: TRZ LINK,MCFKWD ;(IN CASE WE GO TO MACKL6, SINCE KWD NAME SKIPPED ALREADY)
CAIE AA,"=
JRST MACKL6 ;KWD NAME OVER BUT SPEC'D NAME NOT => MISMATCH
MOVEMM (C),FREEPT
CALL MACRED ;READ IN THE VALUE OF THE ARG, THUS SETTING THIS PARAM.
JRST MACK1 ;THERE ARE MORE ARGS => HANDLE THEM
.VALUE
MACKND: TLO FF,FLUNRD ;MACRO CALL TERMINATOR SEEN.
;NULL ARG SEEN; ENDS THIS RUN OF KEYWORD ARGS BUT NOT THE CALL.
MACKN1: REST LINK ;NOW GO BACK TO THE DESCRIPTOR OF THE FIRST KEYWORD PARAM.
SOS PRCALP
REST C ;GET PTR TO 1ST KWD ARG'S VALUE-WORD
MACKN2: MOVE A,(C)
AOJN A,MACKN4 ;IF THIS ARG WASN'T SPECIFIED,
MOVEMM (C),FREEPT
CALL MACNUL ;NULLIFY IT (MAYBE DEFAULT OR GENSYM)
MACKN4: CALL MACDES ;NOW SKIP OVER THE DESCRIPTORS OF THIS RUN OF KEYWORD PARAMS
JRST MACPUS ;EXHAUSTED ALL THE DESCR'S => END OF MACRO CALL.
TRNE LINK,MCFKWD ;SAME IF REACH A NON-KWD ARG.
AOJA C,MACKN2
TLNN FF,FLUNRD ;REACHED A NON-KEYWORD PARAM: IF TERMINATOR WAS A NULL ARG,
JRST MACNRM ;GO ON TO READ THE VALUE OF THE NON-KEYWORD PARAM.
JRST MACCLS ;ELSE CALL WAS REALLY ENDED, SO NULLIFY REMAINING ARGS.
;COME HERE TO FIND THE NEXT DESCRIPTOR.
;SKIPS OVER THE NAME AND DEFAULT VALUE OF THE PREVIOUS DESCRIPTOR, IF ANY.
;THE CONTENTS OF LINKK SAY WHETHER THEY EXIST TO BE SKIPPED OVER.
MACDES: MOVE A,@PRCALP
CALL REDINC ;READ NEXT CHAR OF MACRO
MOVEM A,@PRCALP
TRNE LINK,MCFKWD\MCFDEF
JRST [ CAIE B,377 ;IF THERE'S NAME OR DEFAULT TO SKIP, GO PAST TERMINATOR
JRST MACDES
TRZN LINK,MCFKWD ;AND SAY WE FOUND ONE
TRZ LINK,MCFDEF ;NOTE THERE MAY BE ANOTHER, IN WHICH CASE WE WILL
JRST MACDES] ;SKIP TILL ANOTHER 377
JUMPE B,CPOPJ ;THIS DESC IS TERMINATOR => RETURN NO SKIP.
MOVEI LINK,(B) ;ELSE PUT FLAGS IN LINK.
JRST POPJ1
;COME HERE WHEN A MACRO CALL TERMINATOR IS ENCOUNTERED, TO NULLIFY ALL
;THE REMAINING PARAMS THAT THE MACRO WANTS, THEN ENTER THE MACRO.
;ENTER AT MACCLS IF HAVE JUST READ A DESCRIPTOR AND NOT NULLIFIED THE ARG,
;OR AT MACCLD IF HAVE JUST PROCESSED AN ARG, TO READ THE NEXT DESCRIPTOR.
MACCLS: TRNE LINK,MCFDEF\MCFGEN
JRST MACCL2
SETZ A, ;NULLIFY NON-GENSYMMED, NON-DEFAULTED ARGS QUICKLY
CALL ADDTR2
MACCLD: CALL MACDES ;THEN READ THE NEXT DESCRIPTOR.
JRST MACPUS ;IF NO MORE ARGS, ENTER THE MACRO.
JRST MACCLS
MACCL2: CALL ADDTRN ;FOR GENSYMMED OR DEFAULTED ARG, PUSH PTR TO FREE STG
SOS C,A
CALL MACNUL ;THEN WRITE THE DESIRED VALUE THERE
JRST MACCLD ;THEN HANDLE NEXT DESCRIPTOR.
;COME TO MACPUS WHEN ALL THE PARAMS HAVE HAD VALUES PUT IN DSTG (USING ADDTRN)
;TO ENTER THE MACRO.
MACPUS: TLZE I,ILPRN ;SPECIAL PARENTHESIZED CALL?
CALL MACPRN ;YES, SKIP PAST THE CLOSING PAREN.
MOVE B,(P) ;IS THIS A .TTYMAC?
CAIN B,A.TYM8
CALL A.INEO ;YES, POP OUT OF TTY AFTER READING ARGS.
JFCL
REST B ;RCHSV1 OR A.TYM8
PUSHJ P,PUSHEM
MOVE A,@PRCALP
PUSHJ P,ACPTRS ;SET UP CPTR
POP P,A
PUSHJ P,DMYTRN
SOS PRCALP
REST I
MACCR: AOS (P) ;COMMON RETURN FROM PSEUDOS TO RETURN FROM GETVAL WITHOUT VALUE
CMACCR: POPJ P,MACCR
MACPRN: MOVEI TT,1 ;START PAREN-DEPTH AT 1
JSP D,RARBC ;AND READ CHARS, UPDATING THE DEPTH, UNTIL
HALT
JUMPN TT,.-2 ;THE DEPTH GETS TO BE 0.
RET
A.GOMC: ILDB B,A ;.GO ROUTINE TO SKIP PAST DESCRIPTORS
JUMPN B,A.GOMC ;IN HEADER OF MACRO DEFINITION.
JRST A.GORT
RCHSV1: SOS MDEPTH ;END OF MACRO EXPANSION, DECREMENT DEPTH IN MACRO EXPANSIONS
A.TYM8: PUSH P,A ;ENTRY FROM .TTYMAC END OF EXPANSION
MOVE B,TOPP
RCHSV3: CAMG B,BBASE
JRST RCHSV2
HLRZ A,-1(B)
ADD A,-1(B)
MOVEI A,1(A)
CAME A,FREEPT
JRST RCHSV2
HRRZ A,-1(B) ;GET NEW FREEPT
SOJA B,RCHSV3
RCHSV2: POP P,A
;RETURN ROUTINE FOR END OF DUMMY
RCHSAV: MOVE B,BBASE
MOVEM B,TOPP
PUSHJ P,POPEM
HLRM B,BBASE
REPT6: TRZE FF,FRMRGO
POPJ P, ;RETURN TO .GO
JRST RCHTRB
;IRP, IRPS, IRPC, IRPW, IRPNC ALL CALL HERE.
;ALL USE 2 FRAMES ON THE MACRO PDL:
; <OLD BBASE>,,<OLD CPTR>
; <SAVED LIMBO1 STATUS>,,<OUTER .IRPCNT>
; <IRP TYPE>\<# GROUPS>,,<CHAR ADDR START OF IRP BODY>
; <SAVED TOPP>,,AIRR
;THE 3RD WORD HAS IN BITS 4.1-4.3 THE IRP TYPE CODE
; (NIRPO, NIRPC, ETC)
;AND IN THE REST OF THE LH, THE NUMBER OF GROUPS
; (TRIPLES OF TWO DUMMIES AND A LIST)
.SEE NIRPO ;FOR DEFINITIONS OF IRP TYPE CODES.
AIRP: JSP TM,ERMARK ;ERROR MESSAGES SHOULD SAY WE'RE INSIDE IT.
PUSH P,I
PUSH P,RDWRDP
HLRZ LINK,B ;GET IRP TYPE CODE TO INDEX BY.
CAIE LINK,NIRPN
JRST AIRP0
CALL AGETFD ;IRPNC, READ THE 3 NUMERIC ARGS.
PUSH P,A
CALL AGETFD
PUSH P,A
CALL AGETFD
MOVEM A,AIRPN2 ;THE LAST ARG,
REST AIRPN1 ;THE MIDDLE,
REST AIRPN0 ;THE FIRST.
MOVEI LINK,NIRPN
AIRP0: SETZM IRPCR ;NO GROUPS SEEN YET.
;FALLS THROUGH.
;FALLS THROUGH.
;TRY TO READ IN ANOTHER GROUP.
AIRP1: CALL PDEF ;READ IN DUMMY NAME, PUSH ON DMYTOP.
CAIE T,", ;TERMINATOR WASN'T COMMA AND NAME WAS NULL
JUMPE SYM,AIRP2 ;=> NO MORE GROUPS.
CALL PDEF ;NONNULL GROUP, READ & PUSH 2ND NAME.
CAIN T,"[ ;] TRY TO DETECT "IRP X,[", ETC. ]
CALL [ETR [ASCIZ/Comma missing in IRP/]
TLO FF,FLUNRD ;GENERATE A COMMA.
RET]
CALL ADDTRN ;PUSH CHAR ADDR OF 1ST DUMMY,
CAIE LINK,NIRPS
CAIN LINK,NIRPC ;LEAVE SPACE FOR IRPC'S 1ST ARG, IRPS'S 2ND.
CALL PUT377
MOVE A,RDWRDP
CAIN LINK,NIRPS
AOS -1(A) ;IRPS - 1ST ARG GOES AFTER NEXT 377.
CALL ADDTRN ;PUSH CHAR ADDR OF 2ND DUMMY.
CALL PUT377
MOVE A,RDWRDP
XCT AIRP1T-1(LINK) ;MAYBE INCREMENT THAT ADDR.
AOS IRPCR ;ONE MORE GROUP SEEN.
JSP D,RARG ;INITIALIZE READING LIST.
JRST AIRP3 ;NO LIST.
JRST @.(LINK)
OFFSET 1-.
NIRPO:: AIRPO ;IRP
NIRPC:: AIRPC ;IRPC
NIRPS:: AIRPS ;IRPS
NIRPW:: AIRPW ;IRPW
NIRPN:: AIRPN ;IRPNC
OFFSET 0
AIRP1T: AOS -1(A)
AOS -1(A) ;INCR. THE 2ND DUMMY ADDR FOR IRP, IRPC.
SOS -1(A)
JFCL ;DECR. FOR IRPS, NOTHING FOR IRPW.
AOS -1(A) ;INCR. FOR IRPNC.
;READ LIST FOR IRPC OR IRP AND STUFF INTO STRING.
AIRPC:
AIRPO: CALL RARGCP ;COPY UP TO END OF ARG INTO MACRO SPACE.
JRST AIRP3
AIRPW3: CALL PUT377 ;END A LINE,
CAIGE C,
CALL PUT377 ;IF NO ; YET, MAKE NULL 2ND ARG.
;COME HERE FOR IRPW, LOOP BACK FOR NEXT LINE.
AIRPW: SETO C, ;NO ; SEEN YET IN LINE.
AIRPW1: JSP D,RARGCH(T)
JRST AIRP3 ;END OF LIST, GO WRITE 375.
CAIE A,^M
CAIN A,^J
JRST AIRPW1 ;IGNORE NULL LINES.
AIRPW4: CAIN A,";
AOJE C,AIRPW2 ;ON 1ST SEMI, SWITCH TO 2ND ARG.
CAIE A,^J
CAIN A,^M
JRST AIRPW3 ;END OF LINE => END BOTH ARGS, START OVER.
AIRPW5: CALL PUTREL
JSP D,RARGCH(T)
JRST AIRP3 ;END OF LIST.
JRST AIRPW4
AIRPW2: MOVEI A,377
JRST AIRPW5
AIRPS: SETO C, ;NO SQUOZE CHAR SEEN YET.
AIRPS2: JSP D,RARGCH(T)
JRST AIRP3
HLRZ CH1,GDTAB(A)
CAIN CH1,(RET)
CAIN A,"!
AOJA C,AIRPS0 ;A SQUOZE CHAR OR !.
JUMPL C,AIRPS2 ;NON SQUOZE FOLLOWING ANOTHER, FLUSH.
DPB A,AIRPSP ;NONSQUOZE ENDING NONNULL SYL, PUT BEFORE SYL.
SETZM AIRPSP
CALL PUT377 ;FOLLOW SYL WITH 377.
JRST AIRPS
AIRPS0: JUMPN C,AIRPS3 ;NOT 1ST CHAR IN SYL?
PUSH P,A
CALL PUT377 ;1ST, LEAVE A SPACE FOR THE SYL'S TERMINATOR.
MOVE A,FREPTB
MOVEM A,AIRPSP ;REMEMBER WHERE THE SPACE IS.
REST A
AIRPS3: CALL PUTREL
JRST AIRPS2
AIRPN: SKIPG C,AIRPN0 ;ANY CHARS TO IGNORE?
JRST AIRPN4
JSP D,RARGCH(T)
JRST AIRP3
SOJG C,.-2
AIRPN4: SKIPN C,AIRPN2 ;GET MAX # GRPS OF CHARS.
JRST AIRPN7 ;0 => IGNORE THE REST.
AIRPN5: MOVE B,AIRPN1 ;DO NEXT GRP, GET # CHARS/GRP.
AIRPN6: JSP D,RARGCH(T)
JRST AIRP3
CALL PUTREL ;STORE THE NEXT CHAR.
SOJG B,RARGCH(T) ;COUNT CHARS IN GRP.
MOVEI A,376
CALL PUTREL ;FOLLOW GRP BY 376.
SOJN C,AIRPN5 ;MAYBE CAN DO MORE GRPS.
AIRPN7: CALL RARFLS ;DID AS MANY GRPS AS CAN DO,
;IGNORE REMAINDER OF LIST.
;COME HERE WHEN EXHAUST THE LIST.
AIRP3: CALL STPWR
JRST AIRP1 ;READ ANOTHER GROUP.
;ALL GROUPS READ IN; NOW READ IN BODY.
AIRP2: CAIE T,"; ;IF A SEMICOLON ENDED THE ARGS, SKIP THE COMMENT.
JRST AIRP4
AIRP5: CALL RCH
CAIE A,^M
JRST AIRP5
AIRP4: PUSH P,LINK
MOVE A,FREEPT ;SAVE CHAR ADDR START OF BODY
MOVEM A,PRIRP ;WHERE GC WILL RELOCATE IT.
PUSHJ P,RCH ;IF NEXT CHAR LF, THEN FLUSH IT
CAIE A,12
TLO FF,FLUNRD
PUSHJ P,WRQOTE ;READ BODY OF IRP
PUSHJ P,STPWR ;WRITE STOP
PUSHJ P,PUSHEM ;SAVE WORLD
REST LINK
POP P,A ;RESTORE RDWRDP FROM LONG AGO
PUSH P,TOPP ;NOW SAVE TOPP
PUSHJ P,DMYTRN ;ACTIVATE DUMMYS
MOVE B,MACP ;NOW GET MACRO PDL POINTER
MOVE A,CIRPCT ;GET .IRPCNT
HRRM A,(B) ;CLOBBER "RETURN" ON PDL TO OLD IRPCNT
SETOM CIRPCT ;INITIALIZE IRPCNT
MOVS A,IRPCR ;GET # GROUPS
HRR A,PRIRP ;CHAR ADR OF BEGINNING OF BODY
SETZM PRIRP
DPB LINK,[410300,,A] ;PUT IN TYPE OF IRP.
PUSH B,A ;PUSH <SPECIFICATION BITS\# GROUPS>,,CHAR ADR BEGINNING
POP P,A ;NOW GET OLD TOPP
HRLS A ;MOVE TO LEFT HALF
HRRI A,AIRR ;RETURN TO AIRR ON END OF BODY
PUSH B,A ;PUSH OLD TOPP,,AIRP4
MOVEM B,MACP ;STORE BACK UPDATED MACRO PDL POINTER
MOVE A,STOPPT
MOVEM A,CPTR ;CAUSE STOP RIGHT AWAY TO CAUSE CYCLING
REST I
JRST MACCR
;RECYCLE THROUGH IRP
;AC ALLOCATIONS:
AIRR: PUSH P,A ;A GETS BP ILDBING THRU ARG LIST.
PUSH P,C ;C # GROUPS LEFT
PUSH P,T ;T ADR OF PAIR OF CHAR ADR'S OF DUMMYS
PUSH P,TT ;TT TYPE OF IRP (NIRPO, NIRPC, ETC)
AOS CIRPCT ;INCREMENT .IRPCNT
HRRZ A,(B) ;GET CHARACTER ADR BEG BODY FROM PDL
PUSHJ P,ACPTRS ;SET UP CPTR
SETOM AIRPT
TRNE FF,FRMRGO
JRST AIRR9 ;RETURN TO .GO
HLRZ T,1(B) ;DUMMY TAB ADR
LDB C,[220600,,(B)] ;# GROUPS
JUMPE C,AIRR9 ;JUMP IF NO GROUPS
LDB TT,[410300,,(B)] ;GET TYPE OF IRP (NIRPO, ETC)
AIRR6: JRST @.+1(TT)
AIRRER ? AIRRO ? AIRRC ? AIRRS ? AIRRW ? AIRRN ? AIRRER ? AIRRER
AIRRER: .VALUE
;MOVE 1 ARG THRU 1 GROUP OF IRP.
AIRRO: HRRZ A,1(T) ;THE 1ST ARG WILL START THIS TIME
HRRZM A,(T) ;WHERE THE "REST OF STRING" STARTED LAST TIME.
BCOMP A,-1 ;GET BP THAT'LL ILDB THAT CHAR.
SETO CH1, ;COUNT [-] DEPTH.
AIRRO1: ILDB B,A
CAIN B,375
JRST AIRRO4 ;END OF STRING IS END OF ARG.
SETZM AIRPT ;THIS GROUP NOT NULL.
CAIN B,"[
AOJE CH1,AIRRO3 ;FLUSH OUTERMOST [-] PAIRS.
CAIN B,"]
SOJL CH1,AIRRO3
JUMPGE CH1,AIRRO1 ;DON'T LOOK FOR , WITHIN [-].
CAIE B,^J
CAIN B,",
JRST AIRRO2 ;END OF ARG.
CAIE B,^M ;^M IS IGNORED (FLUSHED.)
JRST AIRRO1
AIRRO3: MOVEI B,376 ;FLUSH A CHAR BY REPLACING WITH 376
DPB B,A
JRST AIRRO1
AIRRC4: SUB P,[1,,1]
AIRRC3: SETZM (T) ;NULLIFY BOTH ARGS PERMANENTLY.
AIRRO4: SETZM 1(T) ;NULLIFY 2ND ARG PERMANENTLY
JRST AIRR8 ;DONE WITH THIS GROUP.
AIRRO2: MOVEI B,377 ;REPLACE CHAR THAT ENDED ARG WITH TERMINATOR.
DPB B,A
AIRRW3: CCOMP1 A,-1 ;GET ADDR OF CHAR AFTER.
HRRZM B,1(T) ;"REST OF STRING" STARTS THERE.
JRST AIRR8
AIRRN: MOVE A,1(T) ;NEW 1ST DUMMY STARTS AT OLD "REST OF STRING".
MOVEM A,(T)
BCOMP A,-1 ;NEW "REST OF STRING" STARTS AFTER 376,
JRST AIRRW2 ;WHICH WILL BECOME A 377.
AIRRW: MOVE A,1(T) ;GET CHAR ADDR START OF 2ND HALF OF PREV LINE.
CALL AIRRM ;SET 1ST DUMMY -> AFTER NEXT 376 OR 377 .
AIRRW2: ILDB B,A ;MOVE UP TO NEXT 377 OR END OF STRING.
CAIN B,375 ;END OF STRING ENDS 1ST DUMMY'S ARG =>
JRST AIRRO4 ;NULLIFY THE 2ND DUMMY.
SETZM AIRPT ;THIS GROUP NOT NULL.
CAIGE B,376
JRST AIRRW2
JRST AIRRO2 ;SET UP 2ND DUMMY -> NEXT CHAR.
;MOVE UP IN 1 GROUP OF IRPS.
AIRRS: MOVE A,(T) ;MOVE FROM 1ST DUMMY,
CALL AIRRM ;PUT 1ST DUMMY AFTER NEXT 377,
AOS (T) ;MOVE IT PAST THE SYL'S TERMINATING CHAR,
ILDB CH1,A ;GET THAT CHAR,
MOVE A,1(T)
JRST AIRRS2 ;STORE AS 2ND DUMMY.
AIRRM: BCOMP A,-1 ;A HAS CHAR ADDR; WILL ILDB THAT CHAR.
AIRRM1: ILDB B,A
CAIN B,375 ;END OF STRING => NULLIFY BOTH ARGS
JRST AIRRC4 ;AND FINISHED WITH GROUP.
CAIE B,377
JRST AIRRM1
MOVE CH1,A
CCOMP1 CH1,-1 ;GET CHAR ADDR OF CHAR AFTER 377
MOVEM CH2,(T) ;PUT 1ST DUMMY THERE.
RET ;NOTE A NOT CLOBBERED, CAN GO ON ILDB'ING.
;MOVE UP IN ONE GROUP OF IRPC.
AIRRC: AOS A,1(T) ;DELETE 1ST CHAR FROM "REST OF STRING".
BCOMP A,-1 ;GET BP -> THAT CHAR.
LDB CH1,A ;GET THE CHAR.
MOVE A,(T) ;GET CHAR ADDR OF PLACE TO PUT IT.
AIRRS2: CAIN CH1,375 ;REACHED END OF STRING =>
JRST AIRRC3 ;NULLIFY BOTH ARGS.
BCOMP A,0
DPB CH1,A ;STORE IT IN THE 1-CHAR ARG.
AIRR7: SETZM AIRPT ;THIS GROUP NOT EXHAUSTED YET.
AIRR8: ADDI T,2
SOJG C,AIRR6 ;MORE GROUPS => DO THE NEXT.
AIRR9: POP P,TT ;RETURN FROM AAIRPC
POP P,T
SKIPL AIRPT
JRST REPT3
MOVN A,[2,,2] ;ARGS EXHAUSTED, RETURN
ADDB A,MACP
HRRZ A,(A)
MOVEM A,CIRPCT
POP P,C
POP P,A
JRST RCHSAV
;IRP ARG-STRING READING COROUTINES: CALL WITH JSP D,
;INITIALIZE FOR READIN OF ARG BUT DON'T GET A CHAR.
;SKIPS IF NONNULL ARG AVAILABLE.
;COROUTINES REMEMBER INFO IN T AND TT BETWEEN CALLS.
;THE CALLER SHOULDN'T CLOBBER THEM.
RARG: CALL RCH ;DECIDE WHAT TYPE OF ARG FOLLOWS, IF ANY.
CAIN A,LBRKT ;RARG ALLOWS [-] AND MAYBE {-} ARGS AS WELL AS SIMPLE ONES.
JRST RARGBR
IFN BRCFLG,[
CAIN A,LBRACE
JRST RARGRR
]
TLO FF,FLUNRD
JSP T,RARGXT ;CAUSE FAILURE RETURN ON SEMI, CR, LF.
RARGN: CALL RCH ;RARGCH RTN FOR NORMAL ARG.
RARGX1: CAIN A,",
JRST (D) ;COMMA ENDS ARG.
RARGXT: CAIN A,";
JRST RARGSM ;SEMI ENDS SCAN.
RARGX2: CAIE A,^M
CAIN A,^J ;CR, LF END SCAN.
RARGSM: TLOA FF,FLUNRD
JRST 1(D)
JRST (D)
RARGBR: SETZ TT, ;TT USED AS BRACKET COUNTER.
JSP T,1(D) ;RETURN, WITH RARGCH RTN IN T.
;READ-CHAR RTN FOR [-] TYPE ARGS.
RARGBC: CALL RCH ;READ NEXT CHAR OF ARG.
CAIN A,LBRKT
AOJA TT,1(D)
CAIN A,RBRKT
SOJL TT,(D)
JRST 1(D) ;SKIP-RETURN UNLESS JUST READ THE FINAL CLOSEBRACKET.
RARGRR: SETZ TT, ;TT USED AS BRACE COUNTER.
JSP T,1(D) ;RETURN, WITH RARGCH RTN IN T.
;READ-CHAR RTN FOR {-} TYPE ARGS.
RARGRC: CALL RCH ;READ NEXT CHAR OF ARG.
CAIN A,LBRACE
AOJA TT,1(D)
CAIN A,RBRACE
SOJL TT,(D)
JRST 1(D) ;SKIP-RETURN UNLESS JUST READ THE FINAL CLOSEBRACE.
;TO GET THE NEXT CHAR OF THE ARG IN A, DO JSP D,RARGCH(T).
;SKIPS UNLESS NO MORE CHARS TO GET.
;NO SKIP AND SET => SCAN SHOULD BE TERMINATED.
;RARG SHOULD NOT BE CALLED AGAIN IN THAT CASE.
RARGCH==0 ;THIS SYMBOL IS FOR CREF'S SAKE.
;COPY THE ARG BEING READ INTO MACRO SPACE.
;ON RETURN, A WILL HOLD "; IF ARGUMENT WAS ENDED BY ";".
RARGCP: JSP D,RARGCH(T)
JRST RARGC1
CALL PUTREL
JRST RARGCH(T)
RARGC1: CAIE A,"; ;IF SEMI ENDED THE ARG, FLUSH THE
RET ;SPACES AND TABS BEFORE IT.
RARGC2: LDB A,FREPTB
CAIN A,^I
JRST RARGC3
CAIE A,40
JRST [ MOVEI A,"; ;LAST CHAR OF ARG ISN'T SP OR TAB.
RET] ;MAKE SURE A HAS ";" IF ARG WAS ENDED BY ";".
RARGC3: SOS FREEPT ;IT IS ONE; BACK OVER IT.
MOVE A,FREPTB
DBPM A
MOVEM A,FREPTB
JRST RARGC2
;IGNORE THE REST OF THE ARG NOW BEING READ.
RARFLS: JSP D,RARGCH(T)
RET
JRST RARGCH(T)
;COME HERE TO SET UP TO READ A BALANCED ARG.
;IF THERE'S NO ARG, RETURNS WOTH JRST (D).
;ELSE RETURNS WITH JRST 1(D) SETTING UNRCHF.
RARB: TLO FF,FLUNRD
SETZ TT, ;TT USED AS BRACKET COUNTER.
CAIE A,RBRACE
CAIN A,") ;IF 1ST CHAR IS A CLOSE,
JRST RARB4 ;THERE'S NO ARG.
CAIE A,">
CAIN A,RBRKT
JRST RARB4
JSP T,RARGXT ;CHECK FOR CR, LF, SEMI, AND RETURN.
;1-CHAR RTN FOR READING BALANCED ARG.
RARBC: CALL RCH
CAIE A,RBRACE
CAIN A,"> ;FOR CLOSES, MAYBE END ARG.
JRST RARB2
CAIE A,")
CAIN A,RBRKT
JRST RARB2
CAIE A,LBRACE
CAIN A,"< ;FOR OPEN BRACKETS, INCR. THE COUNT.
AOJA TT,1(D) ;OPENS CAN'T END THE ARG.
CAIE A,"(
CAIN A,LBRKT
AOJA TT,1(D)
JUMPN TT,1(D)
JRST RARGX1 ;NOT WITHIN BRACKETS, TEST FOR COMMA, ETC.
RARB2: SOJGE TT,1(D) ;COME HERE FOR CLOSEBRKTS.
RARB4: TLO FF,FLUNRD
JRST (D)
;COME HERE TO INIT FOR AN ARG FOR REPEAT, ETC.
;THAT IS, EITHER A BRACKETED ARG OR A 1-LINE ARG.
RARL1: CALL RCH
RARL2:
IFN BRCFLG,[
RARL4: CAIN A,LBRACE
JRST RARGRR ;1ST CHAR A BRACE => BRACED ARG.
]
CAIN A,LBRKT ;1ST CHAR A BRKT => BRKT ARG.
JRST RARGBR
TLO FF,FLUNRD
;INIT FOR A 1-LINE ARG.
RARL: JSP T,1(D)
;1-CHAR RTN FOR 1-LINE ARGS.
RARLC: CALL RCH
JRST RARGX2
IFE BRCFLG,[
;IF BRACES AREN'T USED BY MOST THINGS, THE NORMAL ROUTINE RARL1 DOESN'T
;CHECK FOR THEM, BUT RALR4 (CALLED BY CONDITIONALS) STILL MUST.
RARL4: CAIN A,LBRACE
JRST RARGRR
JRST RARL2
]
;1-LINE ARGS TO MACROS: DON'T TERMINATE THE SPEC,
;AND SKIP OVER THE CR AND LF.
RARL3: TLO FF,FLUNRD
JSP T,1(D)
CALL RCH
CAIN A,^J
JRST (D) ;LF IS THE END - SKIP IT.
CAIE A,^M
JRST 1(D)
CALL RCH ;CR => SKIP FOLLOWING LF, END ARG.
CAIE A,^J
TLO FF,FLUNRD
JRST (D)
;PUSHJ P,A.GST SEARCH CURRENT MACRO STRING FOR TAG (IN A.GST4)
;SKIP IF FOUND, RETURN ON END OF STRING ANYWAY
;BYTE POINTER (ILDB TO GET FIRST CHARACTER) IN A
A.GST: MOVEM A,A.GST3 ;SAVE BYTE POINTER
A.GST1: ILDB B,A.GST3 ;GET CHAR
CAIL B,300
POPJ P, ;END OF STRING => STOP
CAIE B,".
JRST A.GST1 ;WAIT FOR POINT
PUSHJ P,A.GSYL ;FOUND POINT, GET REST OF NAME
JUMPL T,CPOPJ ;RETURN ON END OF STRING
CAME SYM,[SQUOZE 0,TAG] ;TAG?
JRST A.GST1 ;NO, KEEP GOING
PUSHJ P,A.GSYL ;GET THE TAG
JUMPL T,CPOPJ ;RETURN ON END OF STRING (THERE MUST BE BREAK CHAR AFTER TAG BEFORE STOP)
CAME SYM,A.GST4
JRST A.GST1 ;NOT THE ONE BEING LOOKED FOR
MOVE A,A.GST3
LDB B,A ;GET DELIMITER
CAIE B,15 ;CR?
JRST POPJ1
ILDB B,A ;CR, GET NEXT CHAR
CAIE B,12 ;LINE FEED?
MOVE A,A.GST3 ;NO, DON'T FLUSH
JRST POPJ1
;LOOK BACKWARD FOR BEGINNING OF STRING, BYTE POINTER AN A
;LEAVES POINTER POINTING AT STOP CHAR (NOT BEFORE); ALSO LEAVES STOP CHAR IN B
AG.SP: MOVE B,(A) ;GET WORD FROM MACTAB
XOR B,[300_28.+300_20.+300_12.+300_4] ;DO XOR TO ANITIALLY SET UP
LDB CH1,[400400,,A] ;PICK UP 4 HIGH ORDER BITS OF POSITION FIELD
JRST A.GSP2-1(CH1) ;DISPATCH ON POSITION FIELD (-1 SINCE BIT SET IN POSITION FIELD)
AG.SP3: MOVE B,(A)
XOR B,[300_28.+300_20.+300_12.+300_4]
A.GSP2: TRNN B,300_4
JSP CH1,AG.SF
TLNN B,3
JSP CH1,AG.SF
TLNN B,300_2
JSP CH1,AG.SF
TLNN B,300_10.
JSP CH1,AG.SF
SOJA A,AG.SP3
AG.SF: SUBI CH1,A.GSP2-1 ;GET HERE WHEN STOP CHAR FOUND
DPB CH1,[400400,,A] ;CLOBBER POSITION FIELD OF BYTE POINTER AGAIN
ILDB B,A ;INCREMENT TO UNIVERSALLY ACCEPTABLE POINTER, GETTING STOP CHAR IN B AT SAME TIME
POPJ P, ;THAT'S ALL
A.TAG: PUSHJ P,GSYL
CAIE T,15
JRST MACCR
PUSHJ P,RCH
CAIE A,12
TLO FF,FLUNRD
JRST MACCR
A.GO: PUSHJ P,GSYL ;DOESN'T WORK RELIABLY FROM DUMMY
MOVEM SYM,A.GST4
A.GO1: TLNN FF,FLMAC
JRST MACCR ;NOT GETTING CHARS FROM MACRO => STOP
MOVE A,CPTR
PUSHJ P,AG.SP ;BACK TO BEGINNING
CAIN B,374
JRST A.GOMC ;MACRO, SKIP PAST HEADER
A.GORT: PUSHJ P,A.GST
JRST A.GO2 ;END OF STRING, TRY POPPING UP ONE
MOVEM A,CPTR
JRST MACCR
A.GO2: PUSHJ P,PMACP
JRST A.GO1
A.GSYL: MOVNI D,100000 ;GET SYL FOR .GO WHILE LOOKING FOR TAG
MOVEM D,STRCNT ;STRCNT .LT. 0 SIGNAL FOR GSYL TO JRST (F)
MOVEI SYM,0
JSP F,GSYL1
A.GSY3: ILDB A,A.GST3 ;GET CHAR
TRZN A,200 ;CHECK FOR SPECIAL
JRST A.GSY2 ;NO, FALL BACK IN
CAIG A,100 ;BIG ENOUGH TO BE SPECIAL?
JRST A.GSY3 ;NO, MUST BE DUMMY, IGNORE
HRROI T,(A) ;SPECIAL => ASSUME STOP: T .LT. 0 SIGNAL TO CALLING ROUTINE
POPJ P, ;RETURN TO CALLING ROUTINE
;INITIALIZE MACRO STATUS
MACINI: MOVEI A,3
MOVEM A,FREEPT ;FORGET ALL STRINGS IN MACTAB
PUSHJ P,FCOMP
MOVE A,MACTAD
HRLI A,41000 ;SET UP CCOMPB THRU CCOMPE
LSH A,2 ;(THEIR VALUES CAN'T BE ASSEMBLED IN BECAUSE
SUBI A,4 ;THEY ARE MUTLTIPLY RELOCATABLE, AND IN DEC
MOVSI AA,CCOMPB-CCOMPE ;VERSION THAT CAN'T BE DONE)
MACIN0: MOVEM A,CCOMPB(AA)
AOJ A,
AOBJN AA,MACIN0
MOVE A,MACTAD
ADDI A,MACL+1777
ANDI A,-2000 ;ADDR OF 1ST WD AFTER MACTAB.
CALL MACIN2 ;SET UP PTRS TO END OF MACTAB.
SETZM GCCNT ;CLEAR OUT GC COUNT SO WILL GET MORE CORE FIRST THREE
MACIN1: SETZM MDEPTH ;NOW INITIALIZE MACRO EXPANSION STATUS
SETZM PRSTG ;NOW TO CLEAR OUT BYTE POINTERS
MOVE A,[PRSTG,,PRSTG+1]
BLT A,EPRSTT-1
MOVEI A,DSTG
MOVEM A,RDWRDP
MOVEI A,DMYAGT
MOVEM A,TOPP
MOVEM A,BBASE
MOVE A,[-MPDLL,,MACPDL]
MOVEM A,MACP
POPJ P,
;A -> 1ST WD AFTER MACTAB, SET UP ALL POINTERS TO END OF MACTAB.
MACIN2: MOVEM A,MACTND
SUB A,MACTAD
LSH A,2 ;1ST BYTE MACTAB DOESN'T HAVE.
MOVEM A,MACHI
SUBI A,MACRUM*4
MOVEM A,GCRDHI
MOVE A,STOPPT
HRR A,MACTND
SOS A ;LAST WD IN MACTAB.
MOVEM A,MACHIB ;INITIALIZE BYTE POINTER TO HIGHEST BYTE OK TO FILL
RET
;MACRO VARIABLE AREA (MOST THEREOF)
VBLK
MACP: 0 ;MAC PDL POINTER
BLCODE [MACPDL: BLOCK MPDLL+1] ;MACRO PDL
FREEPT: 0 ;MACRO STG PNTR POINTS TO FREE CHAR
FREPTB: 0 ;FREEPT IN BYTE POINTER FORM
MACTAD: MACTBA ;ADDR OF START OF MACRO TABLE.
MACTND: 0 ;ADDR OF 1ST WD AFTER MACTAB.
MACHI: 0 ;CHAR ADR ONE ABOVE ACTIVE MACTAB
MACHIB: 0 ;POINTS TO LAST BYTE IN MACTAB
SCONDF: 0 ;STRING CONDITIONAL FLAG, -1 => IDENTICAL, 0 DIFFERENT
GENSM: 0 ;GENERATED SYM COUNT
DEFNPS: 0 ;NONZERO => NAME OF PSEUDO NOW READING ITS ARG.
;A FATAL ERROR WILL TYPE THE PSEUDO'S NAME.
DEFNPN: 0 ;PAGE # -1 OF THAT PSEUDO. ALSO TYPED BY FATAL ERRORS.
DEFNLN: 0 ;LINE # -1.
DEFNFI: 0 ;SIXBIT FN1 OF FILE CONTAINING PSEUDO THAT DEFNPS REFERS TO.
MDEPTH: 0 ;DEPTH IN MACRO (NOT IRP OR REPEAT) EXPANSIONS
PUTCNT: 0 ;AOS'D BY PUTREL, USED BY CALLING ROUTINE, USUALLY TO COUNT ACTIVE CHARS (DURING DEFINITION)
IRPCR: 0 ;COUNT OF A,B,[LIST] GROUPS IN IRP IRPC IRPS, " " "
AIRPT: 0 ;IRP EXPANSION TEMP, -1 => NO NON-NULL DUMMYS YET, ELSE 0
AIRPN0: 0 ;1ST NUMERIC ARG TO IRPNC
AIRPN1: 0 ;2ND,
AIRPN2: 0 ;3RD.
A.QOT2: 0 ;DELIMITER FOR .QUOTE
CRPTCT: -1 ;COUNT THROUGH CURRENT REPEAT (FOR .RPCNT)
CIRPCT: -1 ;COUNT THOUGH CURRENT IRP (FOR .IRPCNT)
A.GST3: 0 ;ON .GO, NAME (IN SQUOZE) OF TAG BEING SEARCHED FOR
A.GST4: 0 ;BYTE POINTER FOR ILDB WHILE SEARCHING FOR TAG
PRCALP: PRCAL-1 ;POINTER INTO PRCALP, POINTS TO LAST ACTIVE ENTRY
PRSTG: ;BEGIN WORDS GARBAGE COLLECTED: FIRST BYTE POINTERS ILDB'D
CPTR: 0 ;ILDB TO GET NEXT CHAR FROM MACRO OR WHATEVER
IFE WRQTSW-1,WRQTBP: 0 ;POINTS TO LAST CHAR BEFORE CURRENT SYL AT WRQOTE
AIRPSP: 0 ;-> PLACE TO STORE SYL-TERMINATOR, IN IRPS READIN.
GCBPL==.-PRSTG ;END BYTE POINTERS, BEGIN CHARACTER ADDRESSES
PRSCND: 0 ;CHARACTER ADDRESS OF CURRENT LOCATION IN FIRST STRING OF IFSE,IFSN WHILE COMPARING WITH SECOND
PRSCN1: 0 ;CHAR ADR BEG OF FIRST STRING IFSE, IFSN
PRREPT: 0 ;CHAR ADR BEG OF BODY OF REPT
PRIRP: 0 ;CHAR ADR BEG OF IRP BODY
PRDEF: 0 ;CHAR ADR BEG OF MACRO BEING DEFINED
PRCAL: REPEAT 10,0 ;TEMP STORAGE FOR CHAR ADR BEG MACRO BODY, USED TO READ DUMMY SPECS
EPRSTT: ;END CHAR ADR WORDS GARBAGE COLLECTED
;BEGIN GARBAGE COLLECTOR VARIABLES
GCCNT: 0 ;CNT OF GC'S
SYMSTR: 0 ;PNTR TO CHAIN OF MACRO PNTRS IN SYM TABLE (DURING GC), LINKED THROUGH RH'S OF "VALUE"
REDPT: 0 ;CHAR ADR READING FROM WHEN MOVING STRING DOWN
REDPTB: 0 ;REDPT IN BYTE POINTER FORM
;GC WRITES WITH FREEPT/FREPTB
COFST: 0 ;AMOUNT CHARS MOVED DOWN BY, SUBTRACTED FROM CHAR ADR TO RELOCATE
SVF: 0 ;FLAG, .GE. 0 => NO POINTERS FOUND POINTING TO CURRENT STRING
FREPTS: 0 ;-> BEGINNING OF CURRENT STRING BEING COPIED DOWN
FRPTBS: 0 ;FREPTS IN BYTE POINTER FORM
GCENDF: 0 ;-1 => END OF LAST STRING FOUND, AFTER RELOCATING POINTERS, MSTG2 SHOULD EXIT
GCHI: 0 ;GC HIGH POINTER, CHAR ADR FIRST NOT TO GARBAGE COLLECT
GCRDHI: <MACL-MACRUM>*4 ;GC DROPS DEAD (MACTAB FULL) IFWRITING INTO THIS CHAR ADR
BLCODE [GCSV: BLOCK 16] ;AC SAVE AREA FOR GC
PBLK
;GARBAGE COLLECT THE MACRO TABLE
GCA1: MOVE A,FREEPT ;GC ALL IN MACTAB.
GCA: MOVEM A,GCHI ;ENTRY TO STORE A IN GCHI -> FIRST CHAR NOT TO GARBAGE COLLECT
IFN 17-P+FF,.ERR GC ac saver wants FF=0, P=17!
GC: MOVEM 16,GCSV+15 ; Save all ACs except FF and P.
MOVE 16,[1,,GCSV]
BLT 16,GCSV+14
IFN TS,[AOS A,GCCNT
CAIGE A,4
PUSHJ P,GCCORQ ;EXPAND CORE ON FIRST THREE GC'S
] CLEARB T,GCENDF
MOVEI A,3
MOVEM A,REDPT ;SET UP FOR READING
MOVEM A,FREEPT ;ALSO FOR WRITING
MOVE A,BCOMPU ;ALSO SET UP CORRESPINDING BYTE POINTERS
MOVEM A,FREPTB
MOVEM A,REDPTB
MOVE C,[-GCBPL,,PRSTG]
GCLP1: SKIPN B,(C) ;NOW CONVERT BYTE POINTERS...
JRST GCLP1B ;(INACTIVE)
CCOMP B,-1 ;TO CHARACTER ADDRESSES
MOVEM B,(C) ;STORE BACK CHARACTER ADDRESS
GCLP1B: AOBJN C,GCLP1 ;LOOP FOR ALL SUCH BYTE POINTERS
MOVE A,SYMAOB ;NOW SET UP MACRO LIST; T INITIALLY HAS 0 => END OF LIST DURING COMPUTATION
SYMMG: ;POINTS TO FIRST MACRO SYMTAB ENTRY ON LIST
LDB B,[400400,,ST(A)] ;GET SQUOZE FLAGS THIS SYM
CAIN B,PSUDO_-14. ;PSEUDO? (=> MAYBE MACRO)
JRST SYMMG1 ;YES, MAYBE PUT ON LIST (RETURNS TO SYMMG2)
SYMMG2: ADD A,WPSTE1
AOBJN A,SYMMG ;LOOP FOR ENTIRE SYMTAB
MOVEM T,SYMSTR ;STORE INITIAL LIST ENTRY FOR MACROS
;DROPS THROUGH
;GC DEALS WITH "UNIT STRINGS", EACH STRING ENDS WITH 375
;GENERAL PROCEDURE IS TO COPY A STRING DOWN THEN SEARCH FOR POINTERS TO WHERE STRING USED TO BE
;IF POINTERS FOUND THEY ARE RELOCATED TO POINT TO COPIED DOWN STRING
;IF POINTERS ARE NOT FOUND THE STRING IS WIPED OUT
;DROPS THROUGH
MSTG: MOVE C,REDPT ;SET UP C TO POINT TO BEG OF STRING BEING READ
;(FOR EVENTUALLY SEARCHING FOR POINTERS TO STRING, NOTE C STAYS AROUND FOR AWHILE)
MOVE TT,FREEPT
CAML TT,GCHI ;IF ALL OF ACTIVE PART OF MACTAB ALREAD GC'D, STOP NOW.
JRST GCEND
MOVEM TT,FREPTS ;-> BEGINNING OF WRITTEN STRING
MOVE TT,FREPTB
MOVEM TT,FRPTBS ;BYTE POINTER -> BEGINNING OF WRITTEN STRING
PUSHJ P,RDTRNS ;COPY CHARACTER
CAIN B,370
JRST MSTGB ;THAT WAS NO STRING, THAT WAS MY IO-BUFFER!
MOVE TT,B ;SAVE CHARACTER JUST COPIED
MSTG1: CAML LINK,GCHI
JRST GCEND ;JUST READ LAST CHAR IN PART OF MACTAB TO GARBAGE COLLECT => DONE
CAIN B,375
JRST MSTG2 ;END THIS STRING, NOW SEARCH FOR POINTERS, RETURNS TO MSTG
PUSHJ P,RDTRNS ;STRING NOT EXHAUSTED, COPY NEXT CHAR
JRST MSTG1
SYMMG1: HRRZ B,ST+1(A) ;PSEUDO FOUND IN SYMTAB, GET "VALUE"
CAIE B,MACCL ;MACCL? (=> MACRO, CHAR ADR OF BODY IN LH)
JRST SYMMG2 ;NO, JUST FALL BACK INTO LOOP
HRRM T,ST+1(A) ;MACRO, REPLACE MACCL PART OF VALUE WITH POINTER TO NEXT
MOVEI T,ST+1(A) ;UPDATE T (INITIAL LIST ENTRY) TO POINT TO WORD JUST CLOBBERED
PUSH P,A
HLRZ A,ST+1(A)
PUSHJ P,REDINC
CAIE B,374
HALT
POP P,A
JRST SYMMG2
;COPY CHARACTER DOWN (REDPTB -> FREPTB)
;LEAVE INCREMENTED REDPT IN LINK, FREEPT IN A, CHAR IN B
RDTRNS: ILDB B,REDPTB
IDPB B,FREPTB
AOS LINK,REDPT
AOS A,FREEPT
POPJ P,
MSTGB: ADDI A,3 ;COPY AN IO-BUFFER:
TRZ A,3
MOVEM A,FREEPT ;WRITE INTO WORD BOUNDARY.
ADDI LINK,3
TRZ LINK,3
MOVEM LINK,REDPT ;READ FROM WORD BOUNDARY.
MOVEI B,041000
HRLM B,REDPTB
HRLM B,FREPTB
MOVE B,FREPTB
MOVE A,REDPTB
ADDI B,1 ;NEW ADDR OF 1ST WD.
HRRZ LINK,1(A) ;GET ADDR OF POINTER TO STRING.
MOVEM LINK,SVF ;REMEMBER WHETHER TO FLUSH STRING.
SKIPE LINK
HRRM B,(LINK) ;RELOCATE THAT POINTER (IF ANY)
HRLI B,1(A) ;SET UP AC FOR BLT.
HLRZ LINK,1(A) ;GET LENGTH OF STRING.
ADDM LINK,REDPTB
LSH LINK,2
ADDM LINK,FREEPT
ADDM LINK,REDPT
LSH LINK,-2
ADDB LINK,FREPTB
BLT B,(LINK)
MOVE LINK,REDPT
CAML LINK,GCHI ;IF THIS IO-BUFFER IS LAST THING IN MACRO SPACE,
SETOM GCENDF ;DON'T LOOK FOR ANYTHING FOLLOWING IT.
JRST MSTGB1 ;NOW MAYBE FLUSH THIS STRING, COPY NEXT.
;GET HERE WHEN MSTG2 FINISHES WITH FLAG SET TO EXIT: UNDO INITIALIZATION AND RETURN
GCEND1: IFN TS,[
MOVE A,FREEPT
ADDI A,2000*4
CAML A,MACHI
PUSHJ P,GCCORQ
] MOVE A,FREEPT
CAML A,GCRDHI
ETF [ASCIZ /Macro space full/]
SKIPN T,SYMSTR
JRST USYMG1 ;EMPTY LIST
MOVEI C,MACCL ;SET UP C FOR HRRM'ING
USYMG: HRRZ TT,(T) ;GET ADR ON LIST
HRRM C,(T) ;CLOBBER RH JUST GOT NEXT POINTER FROM TO MACCL
HLRZ A,(T)
PUSHJ P,REDINC
CAIE B,374
HALT
SKIPE T,TT ;MAKE NEXT POINTER CURRENT, SKIP IF END OF LIST
JRST USYMG
USYMG1: MOVE C,[-GCBPL,,PRSTG]
GCLP2: MOVE A,(C) ;NOW CONVERT CHARACTER ADDRESSES...
BCOMP A,-1 ;BACK TO BYTE POINTERS
MOVEM A,(C)
AOBJN C,GCLP2
IFN 17-P+FF,.ERR GC AC restorer wants FF=0 and P=17!
MOVS 16,[1,,GCSV] ; Restore all ACs except FF and P.
BLT 16,16
POPJ P, ;EXIT FROM GARBAGE COLLECTOR
;GC ROUTINE TO SCAN TABLE AREA FOR POINTERS TO CURRENT STRING
;CH1 -> BEGINNING OF TABLE, 4.9 => LOOK AT PAIRS SKIPPING SECOND OF EACH PAIR
;T POINTS TO LAST WORD IN TABLE + 1
;RELOCATE POINTERS IN TABLE POINTED TO
;C POINTS TO BEGINNING OF STRING, B -> END + 1
MSCN: CAIG T,(CH1)
POPJ P, ;TABLE EXHAUSTED
HRRZ TT,-1(T) ;GET LAST ENTRY IN TABLE (UPPER POINTER UPDATED TO COUNT DOWN)
CAML TT,C
CAML TT,B
JRST MSCN1 ;DOESN'T POINT TO CURRENT STRING
SUB TT,COFST ;POINTS TO STRING, RELOCATE
HRRM TT,-1(T) ;STORE BACK RELOCATED POINTER
SETOM SVF ;SET FLAG TO SAVE STRING
MSCN1: SKIPGE CH1
SOS T ;CH1 NEGATIVE => SKIP A WORD
SOJA T,MSCN
GCEND: SETOM GCENDF ;DONE READING FROM MACTAB, BUT FIRST HAVE TO RELOCATE POINTERS TO LAST STRING
MSTG2: CLEARM SVF ;NO POINTERS FOUND TO STRING YET
MOVE D,REDPT
SUB D,FREEPT
MOVEM D,COFST ;STORE AMOUNT CHARS COPIED DOWN BY FOR CHAR ADR RELOCATION
MOVE B,REDPT
CAIE TT,374
JRST MSTG3 ;NOT A MACRO
MOVE T,SYMSTR
JUMPE T,MSTG3 ;JUMP IF NO MACROS ON LIST
MSTG5: HLRZ TT,(T) ;GET CHAR ADR THIS MACRO
CAML TT,C ;SKIP IF POINTS BELOW BEGINNING THIS STRING
CAML TT,B ;SKIP UNLESS POINTS TO OR ABOVE FIRST CHAR NOT YET READ
JRST MSTG4 ;DOESN'T POINT TO THIS STRING
SETOM SVF ;POINTS TO THIS STRING, SET FLAG TO SAVE STRING
SUB TT,COFST ;RELOCATE
HRLM TT,(T) ;STORE BACK UPDATED CHAR ADR THIS MACRO
MSTG4: HRRZ T,(T) ;NOW GET POINTER TO NEXT MACRO
JUMPN T,MSTG5 ;LOOP FOR ALL MACROS ON LIST
MSTG3: MOVE T,TOPP
MOVEI CH1,DMYAGT
PUSHJ P,MSCN ;RELOCATE POINTERS IN DUMMY ARG TABLE
HRRZ T,MACP
HRROI CH1,MACPDL
PUSHJ P,MSCN ;RELOCATE POINTERS IN MACRO PDL
HRRZ T,PRCALP
AOS T
MOVEI CH1,PRSTG
PUSHJ P,MSCN ;RELOCATE POINTERS IN PRSTG
HRRZ T,RDWRDP
MOVEI CH1,DSTG
PUSHJ P,MSCN ;RELOCATE DUMMY ARGS READ (OR BEING READ) IN BUT NOT YET ACTIVATED
SKIPGE GCENDF
JRST GCEND1 ;EXIT
MSTGB1: SKIPE SVF
JRST MSTGB2 ;FOUND POINTERS TO THIS STRING, DON'T FLUSH
MOVE TT,FREPTS ;NO POINTERS FOUND, FLUSH STRING
MOVEM TT,FREEPT
MOVE TT,FRPTBS
MOVEM TT,FREPTB
MSTGB2: SKIPGE GCENDF ;IF WE JUST HACKED AN I-O BUFFER, MAYBE IT'S THE LAST
JRST GCEND1 ;THING IN MACRO SPACE.
JRST MSTG
] ;END MACSW CONDITIONAL (AND MACRO PROCESSOR ROUTINES)
IFN .I.FSW,[ ;;.I.F ;ALGEBRAIC COMPILER ROUTINE
; 'ALGEBRAIC' CRUFT MARO DEFINITIONS
DEFINE MOAN ARG/
MOVEI D,[SIXBIT /ARG!!/]
JRST ERRCON
TERMIN
DEFINE RETLIN
MOVEI A,15 ;CARRIAGE RETURN
PUSHJ P,PUTREL
MOVEI A,12 ;LINE FEED
PUSHJ P,PUTREL
TERMIN
DEFINE NUMBER
MOVE A,BTPNT
ILDB I,A
CAIE I,"#
CAIGE I,"@
TERMIN
DEFINE RESTOR
MOVE D,BTPNT
SETZM STRING
SETZM STRING+1
SETZM STRING+2
TERMIN
DEFINE SPECN
POP P,RANDM
MOVE A,ENN
SUB A,RANDM
MOVEM A,ENN
TERMIN
DEFINE $GET
EXCH I,ACSVI
PUSHJ P,RCH
EXCH I,ACSVI
TERMIN
DEFINE GETT
EXCH I,ACSVI
PUSHJ P,RCH
EXCH I,ACSVI
IDPB A,TPN
TERMIN
; START OF COMPILER PROPER
OPDL: CH?CH?CH?CH?CH?CH?CH?CH ;COMMUTATOR
CH?SP?CH?CH?CH?CR?CH?CH
CH?CH?CH?CH?CH?CH?CH?CH
CH?CH?CH?CH?CH?CH?CH?CH
SP?CH?CH?CH?DL?CH?CH?CH
LP?RP?TX?PL?CM?MN?CH?DV
CH?CH?CH?CH?CH?CH?CH?CH
CH?CH?CH?KL?LB?EQ?RB?CH
; CH?CH?CH?CH?CH?CH?CH?CH
; CH?CH?CH?CH?CH?CH?CH?CH
; CH?CH?CH?CH?CH?CH?CH?CH
; CH?CH?CH?CH?CH?CH?UP?CH
; CH?CH?CH?CH?CH?CH?CH?CH
; CH?CH?CH?CH?CH?CH?CH?CH
; CH?CH?CH?CH?CH?CH?CH?CH
; CH?CH?CH?CH?CH?CH?CH?CH
VBLK
ENN: 60 ;ACCUMULATOR NUMBER - TROUBLE IF GOES PAST 9
BTPNT: 440700,,STRING ;D
STRING: BLOCK 10 ;CHARACTER ASSEMBLY (D) - TROUBLE IF OVERFLOWS
TPN: 0
DIRPNT: 440700,,DIROUT ;TPN
DIROUT: BLOCK 40 ;COPY OF LINE IN PROGRESS (TPN) - TROUBLE IF OVERFLOWS
OPSTKL==40
0
OPSTK: BLOCK OPSTKL ;OPERATOR STACK (R) - TROUBLE IF OVERFLOWS
0
ENDSTT: 0 ;ON IF END OF STATEMENT ENCOUNTERED
CHARF: 0 ;LAST WAS NOT OPERATOR
NUMFL: 0 ;STRING IS NUMERIC CONSTANT (NEEDS [ AND ])
R1SV: 0 ;SAVED A
R2SV: 0 ;SAVED I, CALLED V EARLIER ON
INTEGR: 0 ;INTEGER ARITHMETIC
WARN: 0 ;ON AFTER ) TO STOP NON-OPERATOR
RANDM: 0 ;DUMP COMMA COUNT HERE
TEMP: 440600,,(D) ;INDIRECT VIA D
BYTPNT: 0
; Save 7 acs here, done by move(m)s for robustness
IRP AC,,[AA,A,B,C,D,I,P]
ACSV!AC: 0
TERMIN
PBLK
; ENTRANCE TO 'ALGEBRAIC' TRANSLATOR
A.I: SETOM INTEGR
SKIPA
A.F: SETZM INTEGR
PUSHJ P,SWINI ;INITIALISE PASSAGE TO MIDAS ASSEMBLER
IRP AC,,[AA,A,B,C,D,I,P]
MOVEM AC,ACSV!AC
TERMIN
SETZM ENDSTT ;RESET END OF STMNT FLAG
SETZM EQHIT' ;RESET LAST CHAR WAS= FLAG
SETZM WARN ;SET OFF ERROR DETECTOR
MOVEI A,"0 ;INITIALISE POINTERS
MOVEM A,ENN
MOVE A,DIRPNT
MOVEM A,TPN ;POINTER TO SAVED INPUT
MOVE SYM,[-OPSTKL,,OPSTK]
PUSH SYM,[0,,ENDSAT]
PUSH P,[0] ;INITIALISE COMMA-COUNTER
SETZM CHARF
CLSTR: RESTOR
RDITTS: SKIPE ENDSTT
JRST BDEND
RDITA: GETT
CAIGE A,100 ;FOR ABBREVIATED DISPATCH TABLE
JRST @OPDL(A)
CAIN A,"\
JRST AB
CAIN A,"^
JRST UP
CH: SETZM EQHIT
SKIPE WARN
JRST CHBRT
CHEY: IDPB A,D
SETOM CHARF ;NON UNARY FLAG
JRST RDITA
GAMB: RESTOR
COMMT: MOVE I,R2SV
JRST GOPURT
SHORT: ;DECIDES IF STRING CAN BE USED IN IMMEDIATE TYPE OPS
SETZM IMMED'
SKIPN STRING
POPJ P, ;NO STRING
MOVE A,BTPNT
ILDB I,A
CAIN I,"#
JRST APUPJ ;YEPE HE ASKED FOR IT
SKIPE STRING+1
POPJ P, ;STRING IS LONG
SKIPA
TSTSHL: ILDB I,A
JUMPE I,APUPJ ;ITS OK FOUND ONLY NUMBERS
CAILE I,"@
POPJ P, ;NON-NUMBER IN STRING
CAIE I,".
JRST TSTSHL
ILDB I,A
SKIPN I ;ANYTHING FOLLOW '.' QST
APUPJ: SETOM IMMED' ;INDICATE IMMEDIATE USAGE IS POSSIBLE
POPJ P,
SZPRT: SETZM CHARF
GOPRT: SETZM WARN
GOPART: MOVEM I,R2SV
GOPURT: HLRZ B,I
HLRZ C,(SYM)
CAMLE B,C
JRST PSOPR ;GO PUSH OPERATOR
SKIPN INTEGR
SETOM IMMED ;FOR ARITH OPS ONLY FIXED WILL DO IMMEDIATE
PUSHJ P,SHORT ;ESTABLISH IF STRING CAN BE IMMEDIFIED
POP SYM,A ;POP AN OPERATOR
JUMPN A,(A)
MOAN OVERPOPPED OPERATOR STACK
CHEX: MOVE A,R1SV
JRST CHEY
RP: SKIPE EQHIT
AOS ENN ;TAKE CARE OF UNSATISFIED = AT END
SKIPN CHARF
JRST RTONOP
SETOM CHARF
BUDDY: SETOM WARN
MOVEI I,RPAR
JRST GOPART
RTONOP: MOVE I,(SYM)
CAIN I,FUNCT
JRST BUDDY ;NO ARGUMENT FUNCTION
MOAN ) FOLLOWS OPERATOR
BDEND: MOAN TOO MANY ('S
CHBRT: MOAN NON-OPERATOR FOLLOWS )
CR: SKIPE EQHIT
AOS ENN ;HANDLES UNSATISFIED = AT END
SETOM ENDSTT
MOVEI I,RCAR
JRST GOPRT
LP: SETZM EQHIT
SKIPE WARN
JRST LFRHT
SETZM CHARF
SKIPE STRING
JRST INDX
PUSH P,[0] ;INITIALISE COMMA-COUNTER
PUSH SYM,[0,,LFTPR]
JRST RDITA
INDX: NUMBER
JRST NUSTRB
GETT
CAIG A,"9
JRST NMRINX
MOVEI I,"(
IDPB I,D
INDY: IDPB A,D
GETT
CAIN A,"+ ;IS IT COMPOUND SUBSCRIPT
JRST CMPNDN
CAIN A,"-
JRST CMPNDN
CAIE A,") ;SEARCH FOR NEXT RP
JRST INDY
IDPB A,D
CMBAN: SETOM CHARF ;MAKE BELIEVE CHARATER LAST
SETOM WARN ;YET SET ) TRAP
JRST RDITA
NMRINX: CAIN A,"- ;IS IT A MINUS
JRST INDZ
CAIN A,"+
JRST INDZ
MOVEI I,"+ ;NUMERICAL SUBSCRIPT
IDPB I,D
INDZ: IDPB A,D
GETT
CAIN A,"+ ;IS IT COMPOUND SUBSCRIPT
JRST CMPNDC
CAIE A,")
JRST INDZ
JRST CMBAN
CMPNDN: MOVEI I,")
IDPB I,D
JRST INDZ
CMPNDC: MOVEI I,"(
IDPB I,D
JRST INDY
LFRHT: MOAN ( FOLLOWS DIRECTLY ON )
SP=RDITA ;USE FOR NON ARITH STATS
CM: MOVE I,[1,,COMMX]
SKIPN CHARF
AOS ENN
JRST SZPRT
EQ: SETOM EQHIT
SETZM WARN
SKIPN CHARF ;TEST FOR EXISTANCE OF L H S
JRST EQFLOP
NUMBER ;IS L H S A NUMBER
JRST EQNUMB
MOVEI I,EQAAL
EQVAL: SETZM CHARF
PUSH SYM,I
PUSH P,STRING
PUSH P,STRING+1
PUSH P,STRING+2
PUSH P,[0]
JRST CLSTR
PL: MOVE I,[2,,PLUS]
SKIPN CHARF
JRST RDITA ;UNARY PLUS
JRST SZPRT
MN: MOVE I,[2,,MINUX]
SKIPN CHARF
MOVE I,[5,,UMINU]
JRST SZPRT
AB: SKIPE CHARF ;ABSOLUTE VALUE
JRST ABERR ;NOT UNARY
MOVE I,[5,,UABS]
JRST SZPRT
LB: SKIPN CHARF
JRST LP ;TREAT LIKE (
NUMBER
JRST NUBRST
MOVEI I,FUNCT
JRST EQVAL
RB=RP
NUBRST: MOAN '<' FOLLOWS NUMBER
NUSTRB: MOAN '(' FOLLOWS NUMBER
EQFLOP: MOAN '=' FOLLOWS OPERATOR
EQNUMB: MOAN '=' FOLLOWS NUMBER
ABERR: MOAN NON-UNARY ABS
TX: MOVE I,[4,,TIMES]
SKIPN CHARF
JRST RDITA ;UNARY TIMES
JRST SZPRT
DL: $GET ;CONTINUE STATEMENT RC
$GET ;LF
$GET ;.
CAIE A,". ;DOT
JRST BDCONT
$GET ;F OR I
$GET ;CONTROL I OR SPACE
MOVE A,DIRPNT
MOVEM A,TPN ;RESET SAVED INPUT POINTER TO AVOID FILLING ITS BUFFER
MOVEI A,"$
IDPB A,TPN
MOVEI A,40
IDPB A,TPN
JRST RDITA
ERRCON: TRNE FF,FRPSS2 ;NO OUTPUT ON SECOND PASS
JRST CONRBT
;MAY ALSO WANT TO USE STATEMENT PLUS LINE NUMBER TYPE TACTIC
MOVE B,DIRPNT
OUTRR: ILDB A,B
PUSHJ P,TYO
CAME B,TPN
JRST OUTRR
SKIPE ENDSTT
JRST CONERT
DORSTL: MOVEI A,40
PUSHJ P,TYO
MOVEI A,"? ;POINT AT ERROR
PUSHJ P,TYO
MOVEI A,40
PUSHJ P,TYO
DORSAL: $GET ;COPY UP TO LINE FEED
PUSHJ P,TYO
CAIE A,12 ;LF
JRST DORSAL
CONERT: PUSHJ P,TIPIS
PUSHJ P,CRR
CONRAT:
IRP AC,,[AA,A,B,C,D,I,P]
MOVE AC,ACSV!AC
TERMIN
JRST SWFLS ;GO BACK AND FLUSH
CONRBT: $GET
CAIE A,12 ;LF
JRST CONRBT
JRST CONRAT
UP: SKIPN WARN ;FOR (NUMBER)^N
SKIPN STRING
JRST ITSEX
MOVEM A,R1SV ;SAVE THE ARROW
NUMBER
JRST CHEX ;ITS PART OF A NUMBER
ITSEX: MOVE I,[6,,STRSTR]
SKIPN CHARF
JRST EXMB
JRST SZPRT
EXMB: MOAN UNARY ^
BDCONT: MOAN BAD CONTINUATION
KL=CR ;SEMICOLON ACTS LIKE CR IN TERMINATING
STRSTR: SKIPN STRING
JRST EXLS
NUMBER
SKIPA
JRST EXLS
SUBI I,61
TDNE I,[-1,,777774]
JRST EXLS
MOVE A,STRING
TDNE A,[3777,,-1]
JRST EXLS
ADDI I,POWR
JRST @(I)
EXLS: PUSH P,[ASCII !EXPLO!]
PUSH P,[ASCII !G !]
PUSH P,[0]
PUSH P,[1]
SETOM EXRET'
JRST FUNET
DV: MOVE I,[4,,DIVIX]
SKIPN CHARF
MOVE I,[5,,UDIVI]
JRST SZPRT
PSOPR: PUSH SYM,I ;PUSH OPERATOR FOR LATER EXCECUTION
SKIPN STRING
JRST RDITTS
PUSHJ P,SHORT ;CAN WE IMMEDIFY
PUSHJ P,MVOI ;AND MOVE OPERAND INTO STACK
JRST CLSTR
PRODB: NUMBER ;OUTPUT WHAT IS IN STRING
SKIPE IMMED ;NO [ & ] IF IMMEDIATE USE
JRST OVNM
PUSH P,A
MOVEI A,"[ ;[ FOR CONSTANT
PUSHJ P,PUTREL
POP P,A
SETOM NUMFL
OVNM: CAIN I,"#
JRST PRDOC
EXCH A,I
PUSHJ P,PUTREL
MOVE A,I
PRDOC: ILDB I,A
JUMPN I,OVNM
SKIPN NUMFL
POPJ P,
MOVEI A,"] ;] FOR CONSTANT
PUSHJ P,PUTREL
SETZM NUMFL
POPJ P,
PRODC: HRLI A,440700 ;MAKE BYTE POINTER
JRST PRDOC
LFTPR: SPECN
JRST RDITTS ;IGNORE LP ON STACK
RCAR: HALT ;IMPOSSIBLE FOR THESE TO BE ON STACK
RPAR: HALT
EQAAL: SPECN
SKIPE STRING
PUSHJ P,MVOI
MOVEI A,[ASCIZ ! MOVEM A!]
PUSHJ P,PRODC
POP P,STRING+2
POP P,STRING+1
POP P,STRING
MOVE A,ENN
SOS A
PUSHJ P,FINOF
JRST GAMB
ENDSAT: SPECN
SKIPN ENDSTT
JRST TOEARL
SKIPE STRING
PUSHJ P,MVOI
GETLF: $GET
CAIE A,12 ;LF
JRST GETLF
IRP AC,,[AA,A,B,C,D,I,P]
MOVE AC,ACSV!AC
TERMIN
JRST SWRET ;GO BACK
MVOI: MOVE A,BTPNT
ILDB I,A
CAIN I,"&
JRST MVOALR ;OPERAND ALREADY THERE
MOVEI A,[ASCIZ ! MOVE A!]
SKIPE IMMED
MOVEI A,[ASCIZ ! MOVEI A!]
MVOIK: PUSHJ P,PRODC
MOVE A,ENN
AOS ENN
FINOF: PUSHJ P,PUTREL
MOVEI A,",
PUSHJ P,PUTREL
PUSHJ P,PRODB
RETLIN
POPJ P,
MVOALR: AOS ENN
POPJ P,
TOEARL: MOAN TOO MANY )'S
PLUS: MOVEI A,[ASCIZ ! FADR A!]
SKIPE INTEGR
MOVEI A,[ASCIZ ! ADD A!]
SKIPE IMMED
MOVEI A,[ASCIZ ! ADDI A!]
OPERT: PUSHJ P,PRODC
SKIPE STRING
JRST GAINS
SOS ENN
OPRTE: MOVE A,ENN
SOS A
PUSHJ P,PUTREL
PUSHJ P,COMMAA
MOVE A,ENN
PUSHJ P,PUTREL
RETLIN
JRST COMMT
COMMAA: MOVEI A,",
PUSHJ P,PUTREL
MOVEI A,"A
JRST PUTREL
GAINS: MOVE A,ENN
SOS A
PUSHJ P,FINOF
JRST GAMB
MINUX: MOVEI A,[ASCIZ ! FSBR A!]
SKIPE INTEGR
MOVEI A,[ASCIZ ! SUB A!]
SKIPE IMMED
MOVEI A,[ASCIZ ! SUBI A!]
JRST OPERT
TIMES: PUSHJ P,TMSTR
SKIPE IMMED
MOVEI A,[ASCIZ ! IMULI A!]
JRST OPERT
DIVIX: MOVEI A,[ASCIZ ! FDVR A!]
SKIPE INTEGR
MOVEI A,[ASCIZ ! IDIV A!]
SKIPE IMMED
MOVEI A,[ASCIZ ! IDIVI A!]
JRST OPERT
UMINU: CAMN B,C
JRST BAKWD ;THESE HAVE TO BE STACKED REVERSE
SKIPE STRING
JRST MOABC
MOVEI A,[ASCIZ ! MOVNS A!]
UMINUC: PUSHJ P,PRODC
MOVE A,ENN
SOS A
PUSHJ P,PUTREL
RETLIN
JRST COMMT
MOABC: MOVEI A,[ASCIZ ! MOVN A!]
SKIPE IMMED
MOVEI A,[ASCIZ ! MOVNI A!]
PUSHJ P,MVOIK
JRST GAMB
UABS: CAMN B,C
JRST BAKWD
SKIPE STRING
JRST MOABS
MOVEI A,[ASCIZ ! MOVMS A!]
JRST UMINUC
MOABS: MOVEI A,[ASCIZ ! MOVM A!]
SKIPE IMMED
MOVEI A,[ASCIZ ! MOVMI A!]
PUSHJ P,MVOIK
JRST GAMB
MVONT: MOVEI A,[ASCIZ ! MOVE A!]
PUSHJ P,PRODC
MOVE A,ENN
JRST ONMVS
TMSTR: MOVEI A,[ASCIZ ! FMPR A!]
SKIPE INTEGR
MOVEI A,[ASCIZ ! IMUL A!]
POPJ P,
BAKWD: PUSH SYM,A
JRST PSOPR
UDIVI: CAMN B,C
JRST BAKWD ;THESE HAVE TO BE STACKED REVERSE
SKIPE INTEGR
JRST UINDV
SKIPN STRING
PUSHJ P,MVONT
MOVEI A,[ASCIZ ! HRLZI A!]
PUSHJ P,PRODC
MOVE A,ENN
SKIPN STRING
SOS A
PUSHJ P,PUTREL
MOVEI A,[ASCIZ !,201400!]
PUSHJ P,PRODC
RETLIN
AOS ENN
JRST DIVIX
ONTMS: PUSHJ P,TMSTR
PUSHJ P,PRODC
MOVE A,ENN
SOS A
ONMVS: PUSHJ P,PUTREL
PUSHJ P,COMMAA
MOVE A,ENN
SOS A
LSTCHX: PUSHJ P,PUTREL
RETLIN
POPJ P,
POWR: GAMB?POWR2?POWAA?POWR4
POWR4: PUSHJ P,ONTMS
POWR2: PUSHJ P,ONTMS
JRST GAMB
POWAA: PUSHJ P,MVONT
AOS ENN
PUSHJ P,ONTMS
SOS ENN
PUSHJ P,TMSTR
PUSHJ P,PRODC
RESTOR
JRST OPRTE
COMMX: AOS (P)
SKIPE STRING
PUSHJ P,MVOI
JRST GAMB
UINDV: MOAN INTEGER UNARY DIVIDE
FUNCT: SETZM EXRET
FUNET: SKIPE STRING
PUSHJ P,MVOI
SPECN
PUSHJ P,MORFMC
MOVEI A,[ASCIZ ! PUSHJ P,!]
POP P,STRING+2
POP P,STRING+1
POP P,STRING
PUSHJ P,PRODC
PUSHJ P,PRODB
RESTOR
RETLIN
PUSHJ P,MORFNC
SKIPN EXRET
JRST RDITTS ;AS USED FROM FUNCT
JRST COMMT ;AS USED FROM STRSTR
MORFMC: MOVE A,RANDM
MOVEM A,RANSV'
SKIPN CHARF ;NO ARGUMENTS
AOS ENN
SETOM CHARF
MOVEI A,"1
CAMN A,ENN ;ARE ARGUMENT ALREADY IN A0 AND UP
POPJ P,
SETZM CORDM
MORYLP: PUSHJ P,ZENBD
AOS CORDM
SOSL RANSV
JRST MORYLP
POPJ P,
MORFNC: MOVEI A,"1
CAMN A,ENN
POPJ P,
MOVE A,RANDM
MOVEM A,CORDM'
MORXLP: PUSHJ P,ZENBD
SOSL CORDM
JRST MORXLP
POPJ P,
ZENBD: MOVEI A,[ASCIZ ! EXCH A!]
PUSHJ P,PRODC
MOVE A,CORDM
ADDI A,"0
PUSHJ P,PUTREL
PUSHJ P,COMMAA
MOVE A,ENN
SOS A
ADD A,CORDM
JRST LSTCHX
TIPIS: MOVE A,TEMP
MOVEM A,BYTPNT
MORTP: ILDB A,BYTPNT
CAIN A,1 ;EXCLAMATION
POPJ P,
ADDI A," ;SPACE
PUSHJ P,TYO
JRST MORTP
] ;END .I.FSW CONDITIONAL
IFN LISTSW,[
;LISTING ROUTINES.
PNTR: MOVEM 17,PNTSA+17
MOVEI 17,PNTSA
BLT 17,PNTSA+16
MOVE P,PNTSA+P ; P = 17 so must restore.
IFN P-17, .ERR P=17 assumption at PNTR!
SKIPL LSTONP
JRST PNTR5
AOSE LISTPF
JRST PNTR1
SKIPGE T,LISTAD
JRST PNTR2
PUSHJ P,P6OD
HLRZS T
PUSHJ P,PSOS ;PRINT SPACE OR '
PUSHJ P,PILPTS
PNTR3: HLRZ T,LISTWD
PUSHJ P,P6OD
MOVS T,LSTRLC
TLNE T,400000
AOJ T,
PUSHJ P,PSOS
HRRZ T,LISTWD
PUSHJ P,P6OD
HRRZ T,LSTRLC
PUSHJ P,PSOS
PUSHJ P,PILPTS
PUSHJ P,PILPTS
PNTR4: MOVE TT,[440700,,LISTBF]
PNTR6: CAMN TT,PNTBP
JRST PNTR5A
ILDB A,TT
PUSHJ P,PILPT
JRST PNTR6
PNTR5A: CALL PNTCR
MOVE A,LISTBC
CAIE A,14
JRST PNTR7
PNTR5C: CALL PILPT ;OUTPUT THE ^L,
CALL PNTHDR ;AND THE PAGE NUMBER.
JRST PNTR5D
PNTR7: MOVEI A,12
PUSHJ P,PILPT
PNTR5D: SETOM LISTBC
PNTR5: MOVNI A,LISTBS*5-1
MOVEM A,PNTSW ;DETECT OVERFLOW OF LISTBF
MOVE TT,[440700,,LISTBF]
MOVEM TT,PNTBP
MOVSI 17,PNTSA
BLT 17,17
POPJ P,
PNTR5B: MOVE A,LISTBC
CAIN A,14
JRST PNTR5C
JRST PNTR5D
PNTR2: MOVEI T,8
MOVEI A,40
PUSHJ P,PILPT
SOJG T,.-1
JRST PNTR3
PNTR1: MOVE TT,[440700,,LISTBF]
CAMN TT,PNTBP
JRST PNTR5B
MOVEI T,25.
MOVEI A,40
PUSHJ P,PILPT
SOJG T,.-1
JRST PNTR4
PSOS: MOVEI A,"'
TRNN T,-1
PILPTS: MOVEI A,40
JRST PILPT
P6OD: MOVE TT,[220300,,T]
P6OD1: ILDB A,TT
ADDI A,"0
PUSHJ P,PILPT
TLNE TT,770000
JRST P6OD1
POPJ P,
PNTCR: MOVEI A,^M ;OUTPUT ^M TO LST IF OPEN.
PILPTX: SKIPE LSTONP;OUTPUT CHAR TO LST IF LSTING.
JRST PILPT
RET
PNTHDR: MOVEI A,^I
MOVEI B,10. ;MOVE TO COLUMN 80.,
CALL PILPT
SOJG B,.-1
PUSH P,LSTTTY
HLLOM B,LSTTTY ;POSITIVE SO TYOERR GOES ONLY TO LST.
TYPR [ASCIZ/Page /]
MOVE A,CPGN
CALL [AOJA A,DPNT]
REST LSTTTY
PNTCRR: CALL PNTCR ;OUTPUT CRLF TO LST IF OPEN.
PNTLF: MOVEI A,^J
JRST PILPTX
DEFINE LSTM %A,B,C
IF1 [ [B] ? [C] ]
IF2 [ MOVE A,[B]
MOVEM A,%A
.=.+LSTM0-2
MOVE A,[C]
MOVEM A,%A
.=.-LSTM0
]
TERMIN
A.LSTFF: AOS (P) ;RETURN NO VALUE.
; ADDR, CONTENTS IF NOT LISTING, CONTENTS IF LISTING.
LSTOFF: LSTM LSTONP,0,-1
LSTM LSTPLM,[TLO B,4^5][JRST PSHLML]
LSTM RCHLST,RCHLS1,AOSN PNTSW
LSTM RCH1LS,RET,[CAILE A,^M]
LSTM POPLML,JFCL,[IDPB A,PNTBP]
JRST MDSCLR
LSTM0==.-LSTOFF
LSTON: BLOCK LSTM0-1
JRST MDSSET
A.LSTN: SKIPN LISTP1 ;IF SHOULD LIST THIS PASS
JUMPGE FF,MACCR
SKIPE LISTP ;AND WANT LISTING,
CALL LSTON ;TURN ON LISTING OUTPUT.
JRST MACCR
IFNDEF LISTBS,LISTBS==50. ;LISTBF SIZE IN WORDS.
VBLK ;LISTING FEATURE VARIABLES
PNTBP: 0 ;POINTER TO LISTING LINE BUFFER
LSTONP: 0 ;NONZERO WHEN OUTPUTTING TO LISTING FILE.
LISTP:
LISTON: 0 ;-1 IF LISTING ON
PNTSW: 0 ;-1 IF LAST CHR CR OR LF, OR -<# CHARS SPACE LEFT IN LISTBF>
LISTBF: BLOCK LISTBS
LISTAD: 0 ;ADDRESS OR -1 NONE 3.1 RELOC
LISTWD: 0 ;WORD
LSTRLC: 0 ;RELOCATION
LISTPF: 0 ;-1 OTHERS CONTAIN SOMETHING
LISTBC: 0 ;BREAK CHR CR LF OR FF OR -1 IF NONE SINCE LAST PNTR
LISTTM: 0 ;TEMP AT AEND
PNTSA: BLOCK 20 ;AC SAVE AREA FOR LISTING FEATURE
LISTP1: 0 ;POSITIVE => WANT TO LIST EVEN ON PASS 1.
] ;END IFN LISTSW,
IFE LISTSW,VBLK
;THESE VARIABLES ARE REFERENCED EVEN IF LISTSW IS 0.
LSTTTY: 0 ;TYOERR TYPES ON TTY IFF LE 0, ON LST IF NOT 0.
LSTPLM: TLO B,4^5 ;OR JRST PSHLML ;XCT'D BY PSHLMB.
POPLML: JFCL ;OR IDPB A,PNTSW ;XCT'D IN POPLMB.
PBLK
IFE LISTSW, A.LSTN: A.LSTF: RET
VBLK
IFN CREFSW,[
CREFP: 0 ;SET BY C SWITCH TO REQUEST CREFFING.
CRFONP: 0 ;SET WHILE CREFFING.
CRFLFL: 0 ;LAST PAGNUM,,LINENUM OUTPUT.
CRFINU: JFCL\PUSHJ P,CRFUSE ;XCT THIS TO CREF NON-DEF OCCUR.
CRFLBL: JFCL\PUSHJ P,CRFLB1 ;XCT FOR DEF. OF NORMAL SYM.
CRFEQL: JFCL\PUSHJ P,CRFEQ1 ; FOR DEF. OF NORMAL SYM. OR INTSYM.
CRFMCD: JFCL\PUSHJ P,CRFMC1 ; FOR DEF. OF MACRO.
CRFDEF: JFCL\PUSHJ P,CRFDF1 ; FOR RANDOM DEF, CHECK FLAGS.
]
CRFILE: 0 ;SET => SHOULDN'T OUTPUT PAGNUM,,LINENUM'S
;USED BY .CRFILE INTSYM SO CAN'T BE IN CONDIT.
PBLK
IFN CREFSW,[
CRFEQ1: MOVEI T,(B)
CAIN A,1 ;IF NOT PSEUDO OR NOT INTSYM,
CAIE T,INTSYM
JRST CRFLB1 ;IS NORMAL SYM.
CRFOD1: MOVSI T,600000 ;ELSE DEFINING INSN.
JRST CRFEQ2
CRFDF2: MOVEI T,(B) ;DECIDE WHETHER DEFINING MACRO OR PSEUDO.
CAIE T,MACCL
JRST CRFOD1
CRFMC1: SKIPA T,[500000,,] ;DEFINING MACRO.
CRFLB1: MOVSI T,440000 ;DEFINING NORMAL SYM.
CRFEQ2: PUSH P,A
MOVE A,T
JRST CRFMA1
;COME HERE FOR NON-DEF; MUST DECIDE WHAT TYPE SYM.
CRFUSE: TLNE C,3NCRF ;SYM MAY HAVE CREFFING SUPPRESSED.
POPJ P,
PUSH P,A
CAIN A,1
JRST CRFMAC ;PSEUDOS, MACROS.
MOVSI A,40000 ;FLAG FOR NORMAL SYM.
TRNN C,-1
MOVSI A,200000 ;FLAG FOR INSNS.
CRFMA1: PUSH P,A
MOVE A,CLNN
HRL A,CPGN
AOBJN A,.+1 ;A HAS PAGNUM,,LINENUM .
SKIPGE CRFILE ;IF SHOULD OUTPUT IT,
JRST CRFUS1
CAME A,CRFLFL ;AND HAS CHANGED, DO SO.
PUSHJ P,CRFOUT
MOVEM A,CRFLFL
CRFUS1: POP P,A
IOR A,SYM ;COMBINE SYM AND CREF FLAG.
PUSHJ P,CRFOUT
JRST POPAJ
CRFMAC: MOVEI A,(B)
CAIN A,MACCL
SKIPA A,[100000,,] ;MACRO
MOVSI A,200000 ;PSEUDO-OP.
JRST CRFMA1
;DEFINING OCCURRENCE, MIGHT BE ANY TYPE SYM.
CRFDF1: CAIN A,1 ;TYPE 1 => MACRO OR PSEUDO.
JRST CRFDF2
TRNE C,-1 ;ELSE INSN OR NORMAL SYM.
JRST CRFLB1
JRST CRFOD1
DEFINE CRFM %A,B,C
IF1 [ [B]
[C] ]
IF2 [ MOVE A,[B]
MOVEM A,%A
.=.+CRFM0-2
MOVE A,[C]
MOVEM A,%A
.=.-CRFM0]
TERMIN
A.CRFFF: AOS (P) ;.CRFOFF - STOP CREFFING. NO VAUE.
; LOCATION, NORMAL VALUE, VALUE WHILE CREFFING
CRFOFF: CRFM CRFONP,0,-1
CRFM CRFLBL,JFCL,[PUSHJ P,CRFLB1]
CRFM CRFEQL,JFCL,[PUSHJ P,CRFEQ1]
CRFM CRFMCD,JFCL,[PUSHJ P,CRFMC1]
CRFM CRFINU,JFCL,[PUSHJ P,CRFUSE]
CRFM CRFDEF,JFCL,[PUSHJ P,CRFDF1]
POPJ P,
CRFM0==.-CRFOFF
CRFON: BLOCK CRFM0-1
POPJ P,
A.CRFN: JUMPGE FF,MACCR
SKIPE CREFP ;.CRFON, IF HAVE CREF FILE, START CREFFING.
PUSHJ P,CRFON
JRST MACCR
] ;END IFN CREFSW,
SUBTTL TS Routines for I/O & overall control
IFN TS,.INSRT TSRTNS
FEED1: SKIPA B,[40]
FEED: MOVEI B,5
JRST TFEED
VBLK
IFG PURESW-DECSW,[ ;PURIFICATION ROUTINE
PURIFG: -1 ;-1 IF NOT (YET) PURIFIED
]
VARIAB
VPAT:
VPATCH: BLOCK 20
VPATCE=.-1
PBLK
CONSTANTS
PAT:
PATCH: BLOCK 100
PATCHE: -1
IFG PURESW-DECSW,[LOC <.+1777>&-2000 ;SKIP TO NEXT PAGE
MAXPUR==._-10. ;FIRST PAGE ABOVE PURE PAGES
PRINTA Pure pages = ,\MAXPUR-MINPUR
]
VBLK
PDL: BLOCK LPDL+1
IFN DECDBG, DECDBB: BLOCK 8000. ;SPACE FOR DEC DDT'S SYMS.
.NSTGW
BBKCOD==. ;BEGIN BLANK CODING, CLEARED OUT DURING INITIALIZATION
IFG PURESW-DECSW,MINBNK==<.+1777>_-10. ;FIRST PAGE OF BLANK CODE
BNKBLK ;DUMP OUT ACCUMULATED BLANK CODING
;NOW MORE BLANK CODING
BKBUF: BLOCK BSIZE+5 ;CURRENT BLOCK TO OUTPUT
GLOTB: BLOCK 20 ;GLOBAL TABLE, EACH ENTRY FLAGS,,ADR OF SQUOZE (SEE COMMENTS NEAR BEGINNING)
STRSTO: BLOCK STRL ;STRING STORAGE FOR GSYL AND FRIENDS
IFN FASLP,[
FASB: BLOCK FASBL ;OUTPUT BUFFER FOR FASL MODE
;FIRST WD 9 FOUR BIT CODE GROUPS, REST ASSOC STUFF
FASAT: BLOCK FASATL ;ATOM TABLE FOR FASL MODE
;EACH ENTRY CONSISTS OF ATOM IN FORMAT DESIRED BY FASLOAD,
;NAMELY:
; HEADER WD. RH LENGTH IN WDS
; 4.8-4.7 TYPE 0-PN 1 FIX 2 FLO 3 BIG (NOT IMPLEMENTED)
; FOLLOWED BY PN OR VALUE
;-EXCEPT- IF RH OF HEADER =0, THIS SLOT RESERVED FOR LIST
]
EBKCOD==. ;END BLANK CODING
.YSTGW
PRINTA ST = ,\.-RL0
ST: ;SYMBOL TABLE 3 WORDS/SYM FIRST SQUOZE, SECOND "VALUE", 3RD FLAGS,,BLOCK.
BLOCK NRMWPS*SYMDSZ
;LITERALS TABLES - CAN MOVE AND GROW. THESE TAGS & LENGTHS ARE JUST THE DEFAULTS
.SEE CONTBA ;ETC, WHICH CONTAIN THE ACTUAL ADDRESSES. SO DON'T USE THEM!
CONTAB: BLOCK LCONTB ;CONSTANTS TABLE, VALUES OF CONSTANTS THIS CONSTANTS AREA
CONGLO: BLOCK LCNGLO ;CONSTANTS GLOBAL TABLE, EACH ENTRY TWO WORDS
;FIRST WD GLOTB ENTRY. SECOND WD ADR IN CONTAB OF CONSTANT TO WHICH IT REFERS
CONBIT: BLOCK LCONTB/12.+1 ;RELOCATION BITS AND ILNOPT BIT(SEE CPTMK)
;3 BITS FOR EACH WORD OF CONTAB.
;;INIT ;INITIALIZATION ROUTINES (IN MACRO TABLE, GET WIPED OUT)
IFN ITSSW\TNXSW,MINMAC==./2000 ;# OF 1ST PAGE HOLDING PART OF MACTAB.
;NOTE THAT THIS CODE IS COPIED UPWARD WHEN MACTAB IS MOVED
;DUE TO SYMTAB EXPANSION. THEREFOR IT MUST REFER TO ITSELF
;INDEXED BY THE OFFSET OF WHERE IT IS FROM WHERE IT WAS ASSEMBLED.
;THAT IS KEPT IN CH1. ALL LITERALS MUST BE USED INDEX OF CH1, TOO.
;MAC PROC TABLES
MACTBA: 773767750000 ;MACRO CHARACTER STORAGE (FIRST WORD 3 375'S)
INIT1: MOVE CH1,MACTAD ;GET ADDR THIS CODE REALLY STARTS AT.
SUBI CH1,MACTBA ;GET OFFSET FROM WHERE ASSEMBLED.
SETZM BBKCOD
MOVE A,[BBKCOD,,BBKCOD+1](CH1)
BLT A,EBKCOD-1 ;CLEAR OUT BLANK CODING
PUSH P,[SP4](CH1) ;NOW INIT THE SYMTAB & FINISHED.
;INITIALIZE THE SYMTAB, EXPECT SIZE IN SYMLEN.
INITS: MOVE AA,SYMLEN ;SET UP THE OTHER VARS
IMUL AA,WPSTE ;DEALING WITH SYMTAB SIZE.
MOVEM AA,SYMSIZ
ADDI AA,ST ;ADDR OF START OF CONTAB.
MOVEM AA,CONTBA
MOVEM AA,PLIM
ADD AA,CONLEN ;ADD LENGTH OF CONTAB TO GET ADDR OF CONGLO TAB.
MOVEM AA,CONTBE ;WHICH IS ALSO THE END OF CONTAB.
MOVEM AA,CONGLA
MOVEM AA,CONGOL
MOVE A,CONLEN ;ADD IN LENGTH OF CONGLO (1/4 OF CONLEN)
LSH A,-2
ADD AA,A
MOVEM AA,CONGLE ;TO GET END OF CONGLO, AND START OF CONBIT TABLE.
MOVEM AA,CONBIA
MOVE A,CONLEN
ADDI A,11.
IDIVI A,12.
ADD AA,A ;ADD LENGTH OF CONBIT (1/12 OF CONLEN) GETTING ADDR OF MACTAB.
IFN DECSW,[
PUSH P,AA
ADDI AA,MACL-1
IORI AA,1777 ;FIX ALLOCATION PROBLEMS ON KI-10
CORE AA,
ETF [ASCIZ /No core for symbols/](CH1)
REST AA
]
MOVN A,SYMLEN
HRLZM A,SYMAOB ;AOBJN -> SYMTAB.
MOVE A,WPSTE
SUBI A,1
MOVEM A,WPSTE1
MOVN A,WPSTE
HRRM A,WPSTEB
CAMG AA,MACTAD ;MOVED MACTAB UP?
JRST INITS1(CH1)
IFN ITSSW\TNXSW,[ ;YES, GET CORE FOR INCREASE.
PUSH P,AA
MOVEI AA,MACL+1777(AA)
LSH AA,-10. ;1ST PAGE NOT NEEDED BY MACTAB.
MOVEI A,MACL+1777+MACTBA(CH1)
LSH A,-10. ;1ST PAGE MACTAB DOESN'T YET HAVE.
SUBM A,AA ;# PAGES NEEDED.
HRLZI AA,(AA)
HRRI AA,(A) ;-<# PAGES>,,<1ST NEEDED>
JUMPGE AA,INITS3(CH1) ;DON'T CALL IF NEED 0 PAGES, WOULD GET ONE.
IFN TNXSW, PUSHJ P,TCORGT
IFN ITSSW, .CALL INITSB(CH1) ? .VALUE
INITS3: REST AA
]
SUBM AA,MACTAD ;MACTAD _ SHIFT IN START OF MACTAB.
EXCH AA,MACTAD ;MACTAD GETS NEW START, AA HAS SHIFT.
MOVSI A,PTAB-CCOMPB
ADDM AA,PTAB(A) ;RELOCATE BYTE-PTRS INTO MACTAB.
AOBJN A,.-1(CH1)
MOVNI B,INITS2(CH1)
HRROI A,@EISYMP(CH1)
ADDI B,1(A) ;GET # WDS IN SECOND HALF OF INIT CODE.
HRRM AA,.+1(CH1) ;COPY 2ND HALF UPWARD WITH POP-LOOP.
POP A,(A) ;THIS INSN IMPURE.
SOJG B,.-1(CH1)
ADDI CH1,(AA) ;CHANGE OFFSET TO PT. TO NEW LOCATIONN OF INIT CODE.
JRST INITS2(CH1) ;JUMP INTO 2ND HALF, WHERE IT'S BEEN COPIED TO.
INITS2: HRROI A,INITS2-1(CH1) ;THEN COPY 1ST HALF (WHICH ENNDS BEFORE INITS2)
SUBI A,(AA) ;GET WHERE NOW ENDS, NOT WHERE WILL END.
MOVEI B,INITS2-MACTBA ;UP UNDERNEATH THE 2ND HALF.
HRRM AA,.+1(CH1) ;(THIS TWO-STEP COPYING HANDLES ALL OVERLAPS)
POP A,(A)
SOJG B,.-1(CH1)
INITS1: MOVE AA,SYMSIZ
SETZM ST
MOVE A,[ST,,ST+1](CH1)
BLT A,ST-1(AA) ;CLEAR OUT SYMBOL TABLE
SETZM ESBK ;DEFINE THEM IN OUTER BLOCK.
MOVEI AA,ISYMTB(CH1)
MOVS F,ISMTBB(CH1) ;GET SWAPPED VALUE OF FIRST INSTRUCTION
SP3: CAIL AA,EISYM1(CH1)
JRST SP1(CH1) ;DONE WITH INSTRUCTIONS
MOVE SYM,(AA)
JUMPE SYM,SP2(CH1)
TLZ SYM,740000
PUSHJ P,ES ;WON'T SKIP
CAIA
.VALUE ;INSTRUCTION PRESENT TWICE IN TABLE!!?!?
HRLZI T,SYMC
HRLZ B,F
MOVSI C,3KILL
PUSH P,CH1
PUSHJ P,VSM2
POP P,CH1
SP2: ADDI F,1000
AOJA AA,SP3(CH1)
;AFTER HACKING ALL THE INSTRUCTIONS, STORED AS JUST THE NAMES IN NUMERIC ORDER,
;HACK ALL THE OTHER PREDEFINED SYMS, STORED AS 2 WORDS (NAME ? VALUE).
EISYMP: ;MAY BE MUNGED IF MORE SYMBOLS ARE ADDED AFTER EISYMT.
SP1: CAIL AA,EISYMT(CH1)
POPJ P,
MOVE SYM,(AA)
LDB T,[400400,,SYM](CH1)
ROT T,-4
TLZ SYM,740000
PUSHJ P,ES
CAIA
JRST SP5(CH1) ;SYM ALREADY DEFINED? (MIGHT BE .UAI, IN ITS AND IN MIDAS).
MOVE B,1(AA)
MOVSI C,3KILL
CAME T,[GLOETY,,](CH1) ;GLOBAL ENTRIES REALLY EXITS, HACKED TO DEFEAT ADDRESS LINKING
CAMN T,[GLOEXT,,](CH1)
TLO C,3LLV
PUSH P,CH1
PUSHJ P,VSM2
POP P,CH1
SP5: AOS AA
AOJA AA,SP1(CH1)
IFN ITSSW,[
INITSB: SETZ ? 'CORBLK
MOVEI %CBNDR+%CBNDW ;BOTH READ AND WRITE.
MOVEI %JSELF ? AA ;INTO SELF, AA IS AOBJN -> PAGES.
SETZI %JSNEW ;FRESH PAGES.
;GOBBLE SYMS FROM SYSTEM
;TABLE AREA IN SYSTEM:
;FIRST LOC SYSYMB
;LAST (AS OPPOSED TO LAST + 1) SYSYME
TSYMGT: MOVE AA,[MXICLR-MXIMAC,,MXICLR]
.CALL INITSB ;GET MACTAB PAGES NNOT LOADED INTO.
.VALUE
IFN PURESW,[
MOVE AA,[MINBNK-MINMAC,,MINBNK]
.CALL INITSB ;GET PAGES FOR BLANK CODE & SYMTAB.
.VALUE
SKIPN PURIFG
JRST TSYMG3
JSP F,FLSPGS ;NOT PURIFIED => FLUSH PAGES
<MXIMAC-MINPUR>,,MXIMAC ;OF MACTAB CREATED BY LOADING BUT NOT NEEDED.
TSYMG3:
]
MOVEI A,EISYMT ;EISYMT FIRST LOC FOR ITS SYMS
MOVE B,[SIXBIT /CALLS/] ;SYSTEM CALLS
.GETSYS A, ;READ IN SYSTEM CALLS (SHOULD SKIP)
.VALUE
SKIPGE A
.VALUE ;.GETSYS DIDN'T UPDATE AOBJN POINTER
HRRM A,SP1 ;MARK END OF SYMS
ANDI A,-1
CAIL A,MACTBA+MACL
.VALUE ;MACL TOO SMALL! INITS MIGHT LOSE.
MOVEI B,EISYMT
MOVEI AA,SYMC_<-18.+4> ;SQUOZE FLAG FOR SYM
TSYMG2: DPB AA,[400400,,(B)]
ADDI B,2
CAIE B,(A)
JRST TSYMG2
POPJ P,
]; IFN ITSSW
SUBTTL Purifier routines - PURIFY$G, GAPFLS$G, also DECDBM
IFN ITSSW\TNXSW,[
IFN PURESW,[ ;HERE ARE THE GUTS OF THE PURIFY ROUTINE
PURIFY: SKIPL NVRRUN
IFN ITSSW,[ .VALUE [ASCIZ /:Already run
/]]
IFN TNXSW,[
JRST [ HRROI 1,[ASCIZ /? Already run
/]
PSOUT
HALTF
JRST .+1] ; If continued, go ahead anyway.
] ;IFN TNXSW
PURIF1: MOVEI P,17 ; Start PDL at 20
JSP F,FLSPGS ; First flush blank-code pages,
<MINBNK-MINMAC>,,MINBNK ; incl. symbol table.
JSP F,FLSPGS
<MXICLR-MINPUR>,,MXICLR ; Flush MACTAB pages created by load but not needed.
JSP F,PURIFD
<MINPUR-MAXPUR>,,MINPUR ; Purify pure pages.
SETZM PURIFG ; Set "purified" flag
MOVE [1,,2] ; Now clear out remains of data of self
MOVEI 1,0
BLT 40
IFN ITSSW,.VALUE [ASCIZ /:Purifiedpdump SYS;TS MIDAS/]
IFN TNXSW,[
HRROI 1,[ASCIZ / Purified, now SAVE
/]
PSOUT
HALTF
] ; IFN TNXSW
GAPFLS: JSP F,FLSPGS ; Flush gap pages created on initial load.
<MXIMAC-MINPUR>,,MXIMAC
IFN ITSSW, .BREAK 16,300000
IFN TNXSW, HALTF
; JSP F,FLSPGS
; -<# pgs>,,<page to start>
; Flush pages specified by page AOBJN
FLSPGS: MOVE A,(F) ; Get the page AOBJN
IFN ITSSW,[
SYSCAL CORBLK,[MOVEI 0 ? MOVEI %JSELF ? A]
.LOSE 1000
]
IFN TNXSW,[
ASH A,1 ; Multiply # pages, page # by 2.
HLRE B,A
HRLI A,.FHSLF
MOVNS B
TLO B,(PM%CNT) ; Say hacking repeat count
FLSPG2: SYSCAL PMAP,[[-1] ? A ? B] ; Flush these pages.
TLNN FF,FL20X ; If on 20X, that's all.
JRST [ HRRI B,-1(B) ; Else, on 10X, must iterate manually.
TRNE B,400000 ; See if became "negative".
JRST .+1 ; Yep, done with manual iteration.
AOJA A,FLSPG2] ; Nope, bump page #.
]
JRST 1(F)
; JSP F,PURIFD - Just like FLSPGS, but purifies the pages instead.
PURIFD: MOVE A,(F) ; Get page AOBJN
IFN ITSSW,[
SYSCAL CORBLK,[MOVEI %CBNDR ; Read access only.
MOVEI %JSELF ? A]
.LOSE 1000
]
IFN TNXSW,[
ASH A,1 ; Double everything.
HLRE B,A
MOVNS B
HRLI A,.FHSLF
PURID1: SYSCAL SPACS,[A ? [PA%RD+PA%EX]]
ADDI A,1
SOJG B,PURID1
]
JRST 1(F)
IFN TNXSW,[
; PURSAV - More useful hack for 10X/20X since it preserves page access
PURSV0: PUSHJ P,RDJERR
PURSAV: MOVEI P,20
HRROI R1,[ASCIZ /Pure-Save to file: /]
PSOUT
MOVSI R1,(GJ%NEW+GJ%FOU+GJ%SHT+GJ%FNS)
MOVE R2,[.PRIIN,,.PRIOU]
GTJFN ; Get JFN from TTY
JRST PURSV0
SETZM PURIFG ; Claim purified...
SETOM MEMDBG ; and keeping watch on memory.
HRLI R1,.FHSLF
MOVEI R2,[
2*<0-MINBNK>,,0+SS%RD+SS%WR+SS%EXE ; Variables/buffers
2*<MINMAC-MXICLR>,,2*MINMAC+SS%RD+SS%WR+SS%EXE ; MACTAB init
2*<MINPUR-MAXPUR>,,2*MINPUR+SS%RD+SS%EXE ; Purify pure pages.
0 ] ; End of SSAVE table
SETZ R3,
SSAVE ; Do it!
HRROI R1,[ASCIZ /Saved./]
PSOUT
HALTF
] ; IFN TNXSW
] ; IFN PURESW
] ; IFN ITSSW\TNXSW
IFN DECDBG,[
DECDBM: 0
HRLZ A,.JBSYM ;GET ADDR OF START OF DDT SYMS,
HRRI A,DECDBB+200 ;LEAVE 200 WD SPACE BEFORE THEM.
HRRM A,.JBSYM ;MOVE THEM INTO SPACE PROVIDED
HLRE B,.JBSYM
MOVMS B
BLT A,DECDBB+177(B) ;SO THEY WON'T GET IN MACTAB'S WAY.
JRST @DECDBM
]
CONSTANTS
;;ISYMS ;INITIAL SYMBOL TABLE
IFNDEF JSYS,JSYS=104_33 ;ALLOW FOR BOOTSTRAP, EVENTUALLY FLUSH, MAYBE
ISMTBB: JSYS ;FIRST OP. CODE IN ISYMTB
ISYMTB:
; 104-177 (JSYS - FDVRB)
SQUOZE 10,JSYS ;BBN PAGER INSTRUCTION
SQUOZE 10,ADJSP ;KL10 INSTRUCTION
0
0
SQUOZE 10,DFAD ;KI10 INSTRUCTION
SQUOZE 10,DFSB ;KI10 INSTRUCTION
SQUOZE 10,DFMP ;KI10 INSTRUCTION
SQUOZE 10,DFDV ;KI10 INSTRUCTION
SQUOZE 10,DADD ;KL10 INSTRUCTION
SQUOZE 10,DSUB ;KL10 INSTRUCTION
SQUOZE 10,DMUL ;KL10 INSTRUCTION
SQUOZE 10,DDIV ;KL10 INSTRUCTION
SQUOZE 10,DMOVE ;KI10 INSTRUCTION
SQUOZE 10,DMOVN ;KI10 INSTRUCTION
SQUOZE 10,FIX ;KI10 INSTRUCTION
SQUOZE 10,EXTEND ;KL10 INSTRUCTION
SQUOZE 10,DMOVEM ;KI10 INSTRUCTION
SQUOZE 10,DMOVNM ;KI10 INSTRUCTION
SQUOZE 10,FIXR ;KI10 INSTRUCTION
SQUOZE 10,FLTR ;KI10 INSTRUCTION
SQUOZE 10,UFA ;KA/KI10 INSTRUCTION
SQUOZE 10,DFN ;KA/KI10 INSTRUCTION
SQUOZE 10,FSC
SQUOZE 10,IBP
SQUOZE 10,ILDB
SQUOZE 10,LDB
SQUOZE 10,IDPB
SQUOZE 10,DPB
SQUOZE 10,FAD
SQUOZE 10,FADL ;PDP6/KA/KI INSTRUCTION
SQUOZE 10,FADM
SQUOZE 10,FADB
SQUOZE 10,FADR
SQUOZE 10,FADRI ;PDP10 INSTRUCTION
SQUOZE 10,FADRM
SQUOZE 10,FADRB
SQUOZE 10,FSB
SQUOZE 10,FSBL ;PDP6/KA/KI INSTRUCTION
SQUOZE 10,FSBM
SQUOZE 10,FSBB
SQUOZE 10,FSBR
SQUOZE 10,FSBRI ;PDP10 INSTRUCTION
SQUOZE 10,FSBRM
SQUOZE 10,FSBRB
SQUOZE 10,FMP
SQUOZE 10,FMPL ;PDP6/KA/KI INSTRUCTION
SQUOZE 10,FMPM
SQUOZE 10,FMPB
SQUOZE 10,FMPR
SQUOZE 10,FMPRI ;PDP10 INSTRUCTION
SQUOZE 10,FMPRM
SQUOZE 10,FMPRB
SQUOZE 10,FDV
SQUOZE 10,FDVL ;PDP6/KA/KI INSTRUCTION
SQUOZE 10,FDVM
SQUOZE 10,FDVB
SQUOZE 10,FDVR
SQUOZE 10,FDVRI ;PDP10 INSTRUCTION
SQUOZE 10,FDVRM
SQUOZE 10,FDVRB
; 200-277 (MOVE - SUBB)
SQUOZE 10,MOVE
SQUOZE 10,MOVEI
SQUOZE 10,MOVEM
SQUOZE 10,MOVES
SQUOZE 10,MOVS
SQUOZE 10,MOVSI
SQUOZE 10,MOVSM
SQUOZE 10,MOVSS
SQUOZE 10,MOVN
SQUOZE 10,MOVNI
SQUOZE 10,MOVNM
SQUOZE 10,MOVNS
SQUOZE 10,MOVM
SQUOZE 10,MOVMI
SQUOZE 10,MOVMM
SQUOZE 10,MOVMS
SQUOZE 10,IMUL
SQUOZE 10,IMULI
SQUOZE 10,IMULM
SQUOZE 10,IMULB
SQUOZE 10,MUL
SQUOZE 10,MULI
SQUOZE 10,MULM
SQUOZE 10,MULB
SQUOZE 10,IDIV
SQUOZE 10,IDIVI
SQUOZE 10,IDIVM
SQUOZE 10,IDIVB
SQUOZE 10,DIV
SQUOZE 10,DIVI
SQUOZE 10,DIVM
SQUOZE 10,DIVB
SQUOZE 10,ASH
SQUOZE 10,ROT
SQUOZE 10,LSH
SQUOZE 10,JFFO ;PDP10 INSTRUCTION
SQUOZE 10,ASHC
SQUOZE 10,ROTC
SQUOZE 10,LSHC
SQUOZE 10,CIRC ;AI PDP10 INST. CIRCULATE: ROTC WITH AC+1 GOING THE WRONG WAY
SQUOZE 10,EXCH
SQUOZE 10,BLT
SQUOZE 10,AOBJP
SQUOZE 10,AOBJN
SQUOZE 10,JRST
SQUOZE 10,JFCL
SQUOZE 10,XCT
SQUOZE 10,MAP ;KI10 INSTRUCTION
SQUOZE 10,PUSHJ
SQUOZE 10,PUSH
SQUOZE 10,POP
SQUOZE 10,POPJ
SQUOZE 10,JSR
SQUOZE 10,JSP
SQUOZE 10,JSA
SQUOZE 10,JRA
SQUOZE 10,ADD
SQUOZE 10,ADDI
SQUOZE 10,ADDM
SQUOZE 10,ADDB
SQUOZE 10,SUB
SQUOZE 10,SUBI
SQUOZE 10,SUBM
SQUOZE 10,SUBB
; 300-377 (CAI - SOSG)
SQUOZE 10,CAI
SQUOZE 10,CAIL
SQUOZE 10,CAIE
SQUOZE 10,CAILE
SQUOZE 10,CAIA
SQUOZE 10,CAIGE
SQUOZE 10,CAIN
SQUOZE 10,CAIG
SQUOZE 10,CAM
SQUOZE 10,CAML
SQUOZE 10,CAME
SQUOZE 10,CAMLE
SQUOZE 10,CAMA
SQUOZE 10,CAMGE
SQUOZE 10,CAMN
SQUOZE 10,CAMG
SQUOZE 10,JUMP
SQUOZE 10,JUMPL
SQUOZE 10,JUMPE
SQUOZE 10,JUMPLE
SQUOZE 10,JUMPA
SQUOZE 10,JUMPGE
SQUOZE 10,JUMPN
SQUOZE 10,JUMPG
SQUOZE 10,SKIP
SQUOZE 10,SKIPL
SQUOZE 10,SKIPE
SQUOZE 10,SKIPLE
SQUOZE 10,SKIPA
SQUOZE 10,SKIPGE
SQUOZE 10,SKIPN
SQUOZE 10,SKIPG
SQUOZE 10,AOJ
SQUOZE 10,AOJL
SQUOZE 10,AOJE
SQUOZE 10,AOJLE
SQUOZE 10,AOJA
SQUOZE 10,AOJGE
SQUOZE 10,AOJN
SQUOZE 10,AOJG
SQUOZE 10,AOS
SQUOZE 10,AOSL
SQUOZE 10,AOSE
SQUOZE 10,AOSLE
SQUOZE 10,AOSA
SQUOZE 10,AOSGE
SQUOZE 10,AOSN
SQUOZE 10,AOSG
SQUOZE 10,SOJ
SQUOZE 10,SOJL
SQUOZE 10,SOJE
SQUOZE 10,SOJLE
SQUOZE 10,SOJA
SQUOZE 10,SOJGE
SQUOZE 10,SOJN
SQUOZE 10,SOJG
SQUOZE 10,SOS
SQUOZE 10,SOSL
SQUOZE 10,SOSE
SQUOZE 10,SOSLE
SQUOZE 10,SOSA
SQUOZE 10,SOSGE
SQUOZE 10,SOSN
SQUOZE 10,SOSG
; 400-477 (SETZ - SETOB)
SQUOZE 10,SETZ
SQUOZE 10,SETZI
SQUOZE 10,SETZM
SQUOZE 10,SETZB
SQUOZE 10,AND
SQUOZE 10,ANDI
SQUOZE 10,ANDM
SQUOZE 10,ANDB
SQUOZE 10,ANDCA
SQUOZE 10,ANDCAI
SQUOZE 10,ANDCAM
SQUOZE 10,ANDCAB
SQUOZE 10,SETM
SQUOZE 10,SETMI
SQUOZE 10,SETMM
SQUOZE 10,SETMB
SQUOZE 10,ANDCM
SQUOZE 10,ANDCMI
SQUOZE 10,ANDCMM
SQUOZE 10,ANDCMB
SQUOZE 10,SETA
SQUOZE 10,SETAI
SQUOZE 10,SETAM
SQUOZE 10,SETAB
SQUOZE 10,XOR
SQUOZE 10,XORI
SQUOZE 10,XORM
SQUOZE 10,XORB
SQUOZE 10,IOR
SQUOZE 10,IORI
SQUOZE 10,IORM
SQUOZE 10,IORB
SQUOZE 10,ANDCB
SQUOZE 10,ANDCBI
SQUOZE 10,ANDCBM
SQUOZE 10,ANDCBB
SQUOZE 10,EQV
SQUOZE 10,EQVI
SQUOZE 10,EQVM
SQUOZE 10,EQVB
SQUOZE 10,SETCA
SQUOZE 10,SETCAI
SQUOZE 10,SETCAM
SQUOZE 10,SETCAB
SQUOZE 10,ORCA
SQUOZE 10,ORCAI
SQUOZE 10,ORCAM
SQUOZE 10,ORCAB
SQUOZE 10,SETCM
SQUOZE 10,SETCMI
SQUOZE 10,SETCMM
SQUOZE 10,SETCMB
SQUOZE 10,ORCM
SQUOZE 10,ORCMI
SQUOZE 10,ORCMM
SQUOZE 10,ORCMB
SQUOZE 10,ORCB
SQUOZE 10,ORCBI
SQUOZE 10,ORCBM
SQUOZE 10,ORCBB
SQUOZE 10,SETO
SQUOZE 10,SETOI
SQUOZE 10,SETOM
SQUOZE 10,SETOB
; 500-577 (HLL - HLRES)
SQUOZE 10,HLL
SQUOZE 10,HLLI
SQUOZE 10,HLLM
SQUOZE 10,HLLS
SQUOZE 10,HRL
SQUOZE 10,HRLI
SQUOZE 10,HRLM
SQUOZE 10,HRLS
SQUOZE 10,HLLZ
SQUOZE 10,HLLZI
SQUOZE 10,HLLZM
SQUOZE 10,HLLZS
SQUOZE 10,HRLZ
SQUOZE 10,HRLZI
SQUOZE 10,HRLZM
SQUOZE 10,HRLZS
SQUOZE 10,HLLO
SQUOZE 10,HLLOI
SQUOZE 10,HLLOM
SQUOZE 10,HLLOS
SQUOZE 10,HRLO
SQUOZE 10,HRLOI
SQUOZE 10,HRLOM
SQUOZE 10,HRLOS
SQUOZE 10,HLLE
SQUOZE 10,HLLEI
SQUOZE 10,HLLEM
SQUOZE 10,HLLES
SQUOZE 10,HRLE
SQUOZE 10,HRLEI
SQUOZE 10,HRLEM
SQUOZE 10,HRLES
SQUOZE 10,HRR
SQUOZE 10,HRRI
SQUOZE 10,HRRM
SQUOZE 10,HRRS
SQUOZE 10,HLR
SQUOZE 10,HLRI
SQUOZE 10,HLRM
SQUOZE 10,HLRS
SQUOZE 10,HRRZ
SQUOZE 10,HRRZI
SQUOZE 10,HRRZM
SQUOZE 10,HRRZS
SQUOZE 10,HLRZ
SQUOZE 10,HLRZI
SQUOZE 10,HLRZM
SQUOZE 10,HLRZS
SQUOZE 10,HRRO
SQUOZE 10,HRROI
SQUOZE 10,HRROM
SQUOZE 10,HRROS
SQUOZE 10,HLRO
SQUOZE 10,HLROI
SQUOZE 10,HLROM
SQUOZE 10,HLROS
SQUOZE 10,HRRE
SQUOZE 10,HRREI
SQUOZE 10,HRREM
SQUOZE 10,HRRES
SQUOZE 10,HLRE
SQUOZE 10,HLREI
SQUOZE 10,HLREM
SQUOZE 10,HLRES
; 600-677 (TRN - TSON)
SQUOZE 10,TRN
SQUOZE 10,TLN
SQUOZE 10,TRNE
SQUOZE 10,TLNE
SQUOZE 10,TRNA
SQUOZE 10,TLNA
SQUOZE 10,TRNN
SQUOZE 10,TLNN
SQUOZE 10,TDN
SQUOZE 10,TSN
SQUOZE 10,TDNE
SQUOZE 10,TSNE
SQUOZE 10,TDNA
SQUOZE 10,TSNA
SQUOZE 10,TDNN
SQUOZE 10,TSNN
SQUOZE 10,TRZ
SQUOZE 10,TLZ
SQUOZE 10,TRZE
SQUOZE 10,TLZE
SQUOZE 10,TRZA
SQUOZE 10,TLZA
SQUOZE 10,TRZN
SQUOZE 10,TLZN
SQUOZE 10,TDZ
SQUOZE 10,TSZ
SQUOZE 10,TDZE
SQUOZE 10,TSZE
SQUOZE 10,TDZA
SQUOZE 10,TSZA
SQUOZE 10,TDZN
SQUOZE 10,TSZN
SQUOZE 10,TRC
SQUOZE 10,TLC
SQUOZE 10,TRCE
SQUOZE 10,TLCE
SQUOZE 10,TRCA
SQUOZE 10,TLCA
SQUOZE 10,TRCN
SQUOZE 10,TLCN
SQUOZE 10,TDC
SQUOZE 10,TSC
SQUOZE 10,TDCE
SQUOZE 10,TSCE
SQUOZE 10,TDCA
SQUOZE 10,TSCA
SQUOZE 10,TDCN
SQUOZE 10,TSCN
SQUOZE 10,TRO
SQUOZE 10,TLO
SQUOZE 10,TROE
SQUOZE 10,TLOE
SQUOZE 10,TROA
SQUOZE 10,TLOA
SQUOZE 10,TRON
SQUOZE 10,TLON
SQUOZE 10,TDO
SQUOZE 10,TSO
SQUOZE 10,TDOE
SQUOZE 10,TSOE
SQUOZE 10,TDOA
SQUOZE 10,TSOA
SQUOZE 10,TDON
SQUOZE 10,TSON
EISYM1:
; I/O INSTRUCTIONS
SQUOZE 4,BLKI
BLKI IOINST
SQUOZE 4,DATAI
DATAI IOINST
SQUOZE 4,BLKO
BLKO IOINST
SQUOZE 4,DATAO
DATAO IOINST
SQUOZE 4,CONO
CONO IOINST
SQUOZE 4,CONI
CONI IOINST
SQUOZE 4,CONSZ
CONSZ IOINST
SQUOZE 4,CONSO
CONSO IOINST
;EXTEND MNEMONICS
SQUOZE 10,CMPSL
001000,,
SQUOZE 10,CMPSE
002000,,
SQUOZE 10,CMPSLE
003000,,
SQUOZE 10,EDIT
004000,,
SQUOZE 10,CMPSGE
005000,,
SQUOZE 10,CMPSN
006000,,
SQUOZE 10,CMPSG
007000,,
SQUOZE 10,CVTDBO
010000,,
SQUOZE 10,CVTDBT
011000,,
SQUOZE 10,CVTBDO
012000,,
SQUOZE 10,CBTBDT
013000,,
SQUOZE 10,MOVSO
014000,,
SQUOZE 10,MOVST
015000,,
SQUOZE 10,MOVSLJ
016000,,
SQUOZE 10,MOVSRJ
017000,,
SQUOZE 10,XBLT
020000,,
;OLD PROGRAMS USE THESE NAMES
SQUOZE 10,CLEAR
SETZ
SQUOZE 10,CLEARI
SETZI
SQUOZE 10,CLEARM
SETZM
SQUOZE 10,CLEARB
SETZB
;RANDOM ALIAS NAMES
SQUOZE 10,ADJBP ;KL10 FORM OF IBP WITH VARIABLE NUMBER TO INCREMENT
IBP
SQUOZE 10,JFOV ;PDP10 INSTRUCTION (PC CHANGE ON PDP6)
JFCL 1,
SQUOZE 10,JCRY1
JFCL 2,
SQUOZE 10,JCRY0
JFCL 4,
SQUOZE 10,JCRY
JFCL 6,
SQUOZE 10,JOV
JFCL 10,
SQUOZE 10,PORTAL ;KI10 INSTRUCTION
JRST 1,
SQUOZE 10,JRSTF
JRST 2,
SQUOZE 10,HALT
JRST 4,
SQUOZE 10,XJRSTF ;KL10 INSTRUCTION
JRST 5,
SQUOZE 10,XJEN ;KL10 INSTRUCTION
JRST 6,
SQUOZE 10,XPCW ;KL10 INSTRUCTION
JRST 7,
SQUOZE 10,JEN
JRST 12,
SQUOZE 10,SFM ;KL10 INSTRUCTION
JRST 14,
SQUOZE 10,XMOVEI ;KL10 INSTRUCTION
SETMI
SQUOZE 10,XHLLI ;KL10 INSTRUCTION
HLLI
;PDP6 HAS LONG FORM ROUNDED INSTEAD OF IMMEDIATES
IRPS INST,,FAD FSB FMP FDV
SQUOZE 10,INST!RL
INST!RI
TERMIN
;; redefines DEFSYM so as to make entry into initial symbol table
DEFINE DEFSYM X/
IRPS Z,,[X]
SQUOZE 8.,Z
Z
.ISTOP
TERMIN
TERMIN
IFN DECSW,[
IFE CVTSW,[
.DECDF DEFSYM
IFN DECBSW,.INSRT DECBTS
];IFE CVTSW
IFN CVTSW,[
.INSRT DECDFS
];IFN CVTSW
] ;IFN DECSW
IFN TNXSW,[;; DEFINE JSYS'S ON TENEX VERSION
IFE CVTSW,[
.TNXJS DEFSYM
.INSRT TWXBTS
];IFE CVTSW
IFN CVTSW,[
.INSRT TNXDFS
];IFN CVTSW
] ;IFN TNXSW
SQUOZE 10,.OSMID ; Crock here - in TNX version, SITINI sets value at
OSMID: OSMIDAS ; runtime before syms spread.
SQUOZE 4,.SITE
A.SITE
SQUOZE 4,RIM10
ARIM10,,SRIM
SQUOZE 4,SBLK
SBLKS,,SRIM
SQUOZE 4,RIM
ARIM,,SRIM
SQUOZE 4,SQUOZE
ASQOZ
SQUOZE 4,.RSQZ
-1,,ASQOZ
SQUOZE 4,XWD
AXWORD
SQUOZE 4,CONSTA
CNSTNT
SQUOZE 4,ASCIC
EOFCH,,AASCIZ
SQUOZE 4,RADIX
ARDIX
SQUOZE 4,END
AEND
SQUOZE 4,TITLE
ATITLE
SQUOZE 4,.BEGIN
A.BEGIN
SQUOZE 4,.END
A.END
SQUOZE 4,VARIAB
AVARIAB
SQUOZE 4,SIXBIT
ASIXBIT
SQUOZE 4,ASCII
AASCII
SQUOZE 4,ASCIZ
AASCIZ
SQUOZE 4,.ASCII
A.ASCII
SQUOZE 4,.ASCVL
A.ASCV
SQUOZE 4,BLOCK
ABLOCK
SQUOZE 4,LOC
ALOC
SQUOZE 4,OFFSET
AOFFSET
SQUOZE 4,.SBLK
SIMBLK
SQUOZE 4,RELOCA
ARELOCA
SQUOZE 4,1PASS
A1PASS
SQUOZE 4,.DECSA
A.DECSA
SQUOZE 4,.DECRE
A.DECRE
SQUOZE 4,.DECTX
A.DCTX
SQUOZE 4,.DECTW
A.DECTW
SQUOZE 4,NOSYMS
ANOSYMS
SQUOZE 4,EXPUNGE
AEXPUNGE
SQUOZE 4,EQUALS
AEQUALS
SQUOZE 4,NULL
ANULL
SQUOZE 4,SUBTTL
ANULL
SQUOZE 4,WORD
AWORD
SQUOZE 4,.SYMTAB
A.SYMTAB
SQUOZE 4,.SEE
A.SEE
SQUOZE 4,.AUXIL
MACCR
SQUOZE 4,.MRUNT
A.MRUNT
SQUOZE 4,.SYMCN
A.SYMC
SQUOZE 4,.TYPE
A.TYPE
SQUOZE 4,.FORMAT
A.FORMAT
SQUOZE 4,.OP
A.OP
SQUOZE 4,.AOP
A.AOP
SQUOZE 4,.RADIX
A.RADIX
SQUOZE 4,.FATAL
A.FATAL
SQUOZE 4,.BP
A.BP
SQUOZE 4,.BM
A.BM
SQUOZE 4,.LZ
A.LZ
SQUOZE 4,.TZ
A.TZ
SQUOZE 4,.DPB
A.DPB
SQUOZE 4,.LDB
A.LDB
SQUOZE 4,.IBP
A.IBP
SQUOZE 4,.1STWD
A.1STWD
SQUOZE 4,.NTHWD
A.NTHWD
IRPS X,,[.BIND=0,.KILL=3KILL,.HKILL=3SKILL,.XCREF=3NCRF,.DOWN=3DOWN]
IFE 1&.IRPCN, SQUOZE 4,X
IFN 1&.IRPCN, X,,A.KILL
TERMIN
SQUOZE 4,.LSTON
A.LSTN
SQUOZE 4,.LSTOF
A.LSTF
IRPS X,,[.MLLIT=CONSML,.PASS=A.PASS,.PPASS=A.PPASS,.SUCCESS=A.SUCCESS
.HKALL=HKALL,.STGSW=STGSW,.LITSW=LITSW,.AVAL1=AVAL1,.AVAL2=AVAL2,.ERRCNT=ERRCNT
.ASKIP=A.ASKIP,.CURLN=CLNN,.CURPG=CPGN,.QMTCH=QMTCH,.STPLN=A.STPLN,.STPPG=A.STPPG]
IFE 1&.IRPCN, SQUOZE 4,X
IFN 1&.IRPCN, X,,INTSYM
TERMIN
;CONDITIONALS (SEE ALSO IFSE, IFSN)
SQUOZE 4,IFG
JUMPG A,COND
SQUOZE 4,IFGE
JUMPGE A,COND
SQUOZE 4,IFE
JUMPE A,COND
SQUOZE 4,IFLE
JUMPLE A,COND
SQUOZE 4,IFL
JUMPL A,COND
SQUOZE 4,IFN
JUMPN A,COND
SQUOZE 4,.ELSE
SKIPE A.ELSE
SQUOZE 4,.ALSO
SKIPN A.ELSE
SQUOZE 4,IF1
TRNE FF,COND1
SQUOZE 4,IF2
TRNN FF,COND1
SQUOZE 4,IFDEF ;ASSEMBLE IF SYM DEFINED
JUMPG A,DEFCND
SQUOZE 4,IFNDEF ;ASSEMBLE IF SYM NOT DEFINED
JUMPE A,DEFCND
SQUOZE 4,IFB ;ASSEMBLE IF STRING BLANK (HAS NO SQUOZE CHARS)
JUMPLE C,SBCND
SQUOZE 4,IFNB ;ASSEMBLE IF STRING NOT BLANK
JUMPG C,SBCND
SQUOZE 4,IFSQ ;ASSEMBLE IF STRING ARG IS ALL SQUOZE
JUMPLE B,SBCND
SQUOZE 4,IFNSQ ;ASSEMBLE IF STRING ARG IS NOT ALL SQUOZE.
JUMPG B,SBCND
SQUOZE 4,PRINTX
APRIN2,,APRINT
SQUOZE 4,PRINTC
APRIN3,,APRINT
SQUOZE 4,COMMEN
APRIN1,,APRINT
SQUOZE 4,.TYO
A.TYO
SQUOZE 4,.TYO6
A.TYO6
SQUOZE 4,.ERR
A.ERR
SQUOZE 4,.RELP
A.RELP
SQUOZE 4,.ABSP
A.ABSP
SQUOZE 4,.RL1
A.RL1
SQUOZE 4,.LIBRA
LLIB,,A.LIB
SQUOZE 4,.LENGTH
A.LENGTH
SQUOZE 4,.LIFS
LTCP,,A.LIB
SQUOZE 4,.ELDC
A.ELDC
IRPS A,,E N G LE GE L
SQUOZE 4,.LIF!A
JUMP!A A.LDCV
TERMIN
SQUOZE 4,.SLDR
A.SLDR
SQUOZE 4,.
GTVLP
SQUOZE 4,.LOP
A.LOP
SQUOZE 40,$.
0
SQUOZE 44,$R.
0
SQUOZE 40,$O. ;(OH) GLOBAL OFFSET
0
SQUOZE 40,$L. ;REAL LOCATION (WITHOUT OFFSET)
0
SQUOZE 40,.LVAL1
0
SQUOZE 40,.LVAL2
0
SQUOZE 4,.LNKOT
A.LNKOT
SQUOZE 4,.NSTGW
1,,STGWS
SQUOZE 4,.YSTGW
-1,,STGWS
SQUOZE 4,.LIBRQ
A.LIBRQ
SQUOZE 4,.GLOBAL
ILGLI,,A.GLOB
SQUOZE 4,.SCALAR
ILVAR,,A.GLOB
SQUOZE 4,.VECTOR
ILVAR\ILFLO,,A.GLOB
SQUOZE 4,.BYTC
NBYTS,,INTSYM
SQUOZE 4,.BYTE
A.BYTE
SQUOZE 4,.WALGN
A.WALGN
;CREF PSEUDO-OPS.
SQUOZE 4,.CRFON
A.CRFN ;START CREFFING.
SQUOZE 4,.CRFOFF
A.CRFFF ;STOP CREFFING.
SQUOZE 4,.CRFIL
CRFILE,,INTSYM
IFE CREFSW,[
A.CRFN==ASSEM1 ;THESE DO NOTHING IF CAN'T CREF.
A.CRFFF==ASSEM1
]
IFN MACSW,[ ;MACRO PROCESSOR PSEUDOS
;MACROS GET DEFINED AS
;SQUOZE 4, <MACRO NAME>
;<CHAR ADR>,, MACCL
SQUOZE 4,REPEAT
AREPEAT
SQUOZE 4,DEFINE
ADEFINE
SQUOZE 4,IRP
NIRPO,,AIRP
SQUOZE 4,IRPC
NIRPC,,AIRP
SQUOZE 4,IRPS
NIRPS,,AIRP
SQUOZE 4,IRPW
NIRPW,,AIRP
SQUOZE 4,IRPNC
NIRPN,,AIRP
SQUOZE 4,TERMIN
ATERMIN
SQUOZE 4,.QUOTE
A.QOTE
SQUOZE 4,.STOP
(400000)A.STOP
SQUOZE 4,.ISTOP
A.STOP
SQUOZE 4,.RPCNT
CRPTCT,,INTSYM
SQUOZE 4,.GSSET
A.GSSET
SQUOZE 4,.GSCNT
GENSM,,INTSYM
SQUOZE 4,.GO
A.GO
SQUOZE 4,.TAG
A.TAG
SQUOZE 4,.IRPCNT
CIRPCT,,INTSYM
IFN RCHASW,[SQUOZE 4,.TTYMAC
A.TTYM
]
SQUOZE 4,IFSE
SKIPN SCOND
SQUOZE 4,IFSN
SKIPE SCOND
]
IFN FASLP,[
SQUOZE 4,.FASL
A.FASL
SQUOZE 4,.ARRAY ;3 INDEX TO AFDMY1 TBL
AFATOM(3)
SQUOZE 4,.ATOM
AFATOM(AFDMAI) ;2 INDEX TO AFDMY1 TBL
AFDMAI==2 ;INDEX OF ATOM IN AFDMY1 TBL
SQUOZE 4,.FUNCT
AFATOM(1) ;1 " " " "
SQUOZE 4,.SPECI
AFATOM(0) ;0 " " " "
SQUOZE 4,.SX
AFLIST(1) ;NORMAL LIST
SQUOZE 4,.SXEVA
AFLIST ;EVAL LIST AND THROW VALUE AWAY
SQUOZE 4,.SXE
AFLIST(2) ;EVAL LIST AND "RETURN" VALUE
SQUOZE 4,.ENTRY
AFENTY ;DECLARE LISP ENTRY POINT (SUBR ETC)
]
IFN TS,[
SQUOZE 4,.FNAM1
RFNAM1,,INTSYM
SQUOZE 4,.FNAM2
RFNAM2,,INTSYM
SQUOZE 4,.FVERS
RFVERS,,INTSYM
SQUOZE 4,.INSRT
A.INSRT
SQUOZE 4,.INEOF
A.INEO
IRPS X,,I O
IRPS Y,,1 2
SQUOZE 4,.!X!FNM!Y
X!FNM!Y,,INTSYM
TERMIN TERMIN
SQUOZE 4,.IFVRS
IFVRS,,INTSYM
SQUOZE 4,.TTYFLG
A.TTYFLG,,INTSYM
]
IFN .I.FSW,[
SQUOZE 4,.F
A.F
SQUOZE 4,.I
A.I
]
IFN ITSSW,[
IRPS X,,UAI UAO BAI BAO UII UIO BII BIO
SQUOZE 10,.!X
.IRPCN
TERMIN
IRPS X,Y,START LFILE STP+SYM JCL PFILE STB CONV+XUNAME XJNAME LJB+
SQUOZE 10,..R!X
.IRPCN+1
IFSN Y,+,[
SQUOZE 10,..S!X
400000+.IRPCN+1
] TERMIN
]
EISYMT: PRINTA \.-MACTBA-1, words initialization coding.
VARIAB
IFN .-EISYMT,.ERR Non-empty variables area
IFN DECSW,[
IFGE .-MACTBA-MACL,[
IFN MACL, PRINTA [MACL too small, set to ]\.-MACTBA
MACL==.-MACTBA
]]
IFN ITSSW\TNXSW,[
IFGE .+2400-MACTBA-MACL,.ERR MACL too small
LOC <.+1777>&-2000
MXICLR==./2000 ;FIRST PAGE ABOVE INITIALIZING CODING
LOC <MACTBA+MACL+1777>&-2000
MXIMAC==./2000 ;FIRST PAGE ABOVE INITIAL MACTBA
MAXMAC==<CONMAX+CONMAX/4+CONMAX/12+1+MXMACL+SYMMAX*MAXWPS+ST+1777>/2000
;1ST PAGE MACRO TABLE CAN'T POSSIBLY USE.
IFLE MINPUR-MAXMAC,.ERR Pure too low.
PRINTA MINPUR-MAXMAC = ,\MINPUR-MAXMAC
]
IFN TS,END BEG
END