--- /dev/null
+
+.SYMTAB 4003.,2000. ;THIS MANY FOR DEC VERSION ON DEC SYSTEM.
+IFN .OSMIDAS-SIXBIT/DEC/, .SYMTAB 5003. ;ON ITS ASSEMBLE FASTER.
+
+TITLE MIDAS
+.MLLIT==1 ;MULTI-LINE MODE.
+
+;AC DEFS
+
+FF=0 ;FLAGS
+P=1
+I=2 ;INDICATOR FLAGS, CONTAIN INFO ON CURRENT SYL, FIELD, WORD; ALSO SEE UNRCHF
+AA=3
+A=4
+B=5
+C=6
+D=7
+T=10 ;NOT SO TEMP AS IN MOST PROGS W/ T
+TT=11
+SYM=12 ;FREQUENTLY CONTAINS SQUOZE SYM W/ FLAGS CLEAR
+LINK=13
+F=14
+CH1=15 ;MACRO PROCESSOR TEMP, CLOBBERED BY CALLS TO RCH
+CH2=16 ;" " "
+TM=17 ;SUPER TEMPORARY
+
+IFDEF .XCREF, .XCREF FF,P,I,A,B,C,D,T
+
+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 ;NONZERO FOR ITS VERSION
+IFNDEF TNXSW,TNXSW==IFDEF JSYS,[1] .ELSE 0 ;NONZERO FOR TENEX VERSION
+IFNDEF DECSW,DECSW==IFDEF LOOKUP,[1-TNXSW] .ELSE 0 ;NONZERO TO RUN ON DEC MONITOR.
+ ; TNXSW SINCE TENEX MIDAS HAS DEC UUO'S
+ ; DEFINED TOO
+IFNDEF DECDBG,DECDBG==0 ;NONZERO FOR DEC VERSION TO RUN WITH DEC DDT.
+IFNDEF SAILSW,SAILSW==IFDEF SPCWAR,[1] .ELSE 0 ;NONZERO FOR SAIL VERSION.
+IFNDEF CMUSW,CMUSW==IFDEF CMUDEC,[1] .ELSE 0 ;NONZERO FOR VERSION TO RUN AT CMU.
+IFN TNXSW,DECSW==1 ;***TEMP*** USE PA1050 FOR NOW
+IFN ITSSW\DECSW\TNXSW,TS==1
+IFNDEF TS,TS==1 ;NON-ZERO FOR ASSEMBLED VERSION TO RUN IN TIME-SHARING
+IFE TS,1PASS
+IFNDEF A1PSW, A1PSW==TS ;FOR 1PASS END-OF-PROGRAM AUTO-REASSEMBLY
+IFNDEF TSSYMS, TSSYMS==ITSSW ;.UAI, ETC. (AND ..RJCL, ETC) - EVER USE THEM?
+IFNDEF BRCFLG, BRCFLG==0 ;1 => BRACES { AND } ARE SPECIAL IN MACRO ARGS, ETC.
+ ;JUST LIKE BRACKETS. BRACES ARE SPECIAL IN CONDITIONALS
+ ;REGARDLESS OF BRCFLG.
+IFNDEF CREFSW, CREFSW==ITSSW ;SET TO ALLOW C SWITCH TO CAUSE CREF OUTPUT.
+IFNDEF LISTSW, LISTSW==1 ;SET TO ALLOW L SWITCH TO CAUSE A LISTING.
+IFNDEF RCHASW, RCHASW==TS ;INCLUDE TTY AS POSSIBLE INPUT DEVICE
+IFNDEF PURESW, PURESW==TS ;NON-ZERO TO SEPARATE PURE CODING FROM IMPURE AND DO PAGE SKIPS
+IFNDEF FASLP, FASLP==ITSSW\TNXSW\CMUSW\SAILSW ;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==ITSSW\TNXSW\CMUSW\SAILSW ;NON-ZERO => INCLUDE .I, .F
+IFNDEF MACSW, MACSW==1 ;NON-ZERO => INCLUDE MACRO PROCESSOR (!)
+IFNDEF RUNTSW, RUNTSW==1 ;ASSEMBLE CODING TO 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,[
+IFE DECSW,IFNDEF MACL,MACL==6000 ;(MUST BE BIG ENOUGH TO COVER INIT CODE)
+ ;IN DEC VERSION, MACL IS DEFINED = SIZE OF 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 DECSW,IFNDEF LPDL,LPDL==200.
+IFNDEF LPDL,LPDL==500 ;LENGTH OF PDL
+IFN DECSW,IFNDEF CONMIN,CONMIN==1000
+IFNDEF CONMIN,CONMIN==3300 ;MINIMUM AMT OF SPACE FOR CONSTANTS TABLES.
+IFNDEF CONMAX,CONMAX==10000 ;MAXIMUM SPACE USER CAN ASK FOR.
+IFNDEF NCONS,NCONS==75. ;MAXIMUM NUMBER OF CONSTANTS AREAS
+IFNDEF NVARS,NVARS==25. ;MAX. NUM. VARIABLES AREAS.
+IFN DECSW,IFNDEF SYMDSZ,SYMDSZ==2003.
+IFNDEF SYMDSZ,SYMDSZ==2707. ;DEFAULT # SYMS IN SYMTAB.
+IFNDEF SYMMSZ,SYMMSZ==10177*2 ;# SYMS IF JNAME IS MMIDAS.
+IFNDEF SYMMAX,SYMMAX==40000 ;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.
+\f
+IF1 [
+
+IFNDEF MIDVRS,MIDVRS=.FNAM2
+IFE MIDVRS-SIXBIT/MID/,[
+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.
+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)
+
+
+;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.
+
+] ;END IF1
+\f
+IF1 [
+
+ ;INDICATOR REGISTER
+
+;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,
+REST=POP P,
+
+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
+] ;END IF1
+\f
+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=="{
+IFNDEF RBRACE,RBRACE=="}
+
+;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.
+
+;CONTROL FLAGS
+;LEFT HALF
+TRIV==400000 ;1 IF OUT FORM IS FOR TRIVIAL LOADER (ABSOLUTE)
+;RIGHT HALF
+ARIM==2 ;IF ONE OUT FOR IS RIM
+SBLKS==10 ;IF ONE OUT FORM IS SIMPLE BLOCKS
+ARIM10==20 ;PDP-10 RIM
+DECREL==40 ;DEC RELOCATABLE FORMAT (CONSIDERED "ABSOLUTE" INSIDE MIDAS)
+FASL==100 ;LISP FASL COMPATIBLE RELOCATABLE FORMAT ( " " ")
+
+] ;END IF1
+\f
+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
+\f
+IF1 [
+
+DEFINE PRINTA A,B,C,D,E,F
+IF1,[PRINTC \7fA!B!C!D!E!F
+\7f]
+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
+\f
+IF1 [
+
+ ;RANDOM MACRO DEFINITIONS
+
+ ;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
+\f
+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
+\f
+IFN DECSW\TNXSW,[
+IF1 [
+IFE .OSMIDAS-SIXBIT/ITS/,[
+ IFE CMUSW\SAILSW,.INSRT SYS:DECDFS
+ IFN SAILSW, .INSRT SYS:SAIDFS
+ IFN CMUSW, .INSRT SYS:CMUDFS
+ IFN TNXSW, .INSRT SYS:TNXDFS
+] ;IF ASSEMBLED ON ITS
+IFN .OSMIDAS-SIXBIT/ITS/,[ ;OTHER PLACES DON'T KEEP THESE ON SYS:
+ IFE CMUSW\SAILSW,.INSRT DECDFS
+ IFN SAILSW, .INSRT SAIDFS
+ IFN CMUSW, .INSRT CMUDFS
+ IFN TNXSW, .INSRT TNXDFS
+] ;IF ASSEMBLED ON A NON-ITS PLACE
+.DECDF
+
+IFN TNXSW,[EXPUNGE RESET ; THE ONLY CONFLICTING JSYS/CALLI
+.TNXDF
+] ;IFN TNXSW
+
+EXPUNGE .SUSET
+DEFINE .SUSET A
+TERMIN
+
+DEFINE HALT
+ JRST 4,.
+TERMIN
+
+EXPUNGE .VALUE
+EQUALS .VALUE HALT
+DEFINE .LOSE A
+ JRST 4,.-1
+TERMIN
+] ;IF1
+IFN PURESW,.DECTWO
+IFE PURESW,.DECREL
+RL0==.
+] ;IFN DECSW\TNXSW
+
+IFN ITSSW,[IF1 [IFNDEF .IOT,[.INSRT SYS:ITSDFS
+ .ITSDF
+] ;IFNDEF .IOT
+IFNDEF %PIPDL,.INSRT SYS:ITSBTS
+ HALT==.VALUE
+ EXPUNG .JBTPC,.JBCNI
+
+DEFINE SYSCAL A,B
+ .CALL [SETZ ? SIXBIT/A/ ? B ((SETZ))]
+TERMIN
+] ;IF1
+RL0==0
+IFDEF .SBLK,.SBLK
+] ;IFN ITSSW
+\f
+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==140 ;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
+
+ ;SWITCH TO CODING ABOVE THE GAP
+
+DEFINE PBLK
+IFN CKPUR,.ERR PBLK
+IFE CKPUR,[VAR.LC==.
+LOC PUR.LC
+]CKPUR==1
+TERMIN
+
+PUR.LC==MINPUR*2000+IFN DECSW,[RL0] ;SAVED LOCATION COUNTER ABOVE THE GAP WHEN ASSEMBLING BELOW
+
+ ;SWITCH TO CODING BELOW THE GAP
+
+DEFINE VBLK
+IFE CKPUR,.ERR VBLK
+IFN CKPUR,[PUR.LC==.
+LOC VAR.LC
+]CKPUR==0
+TERMIN
+
+PBLK ;PBLK NORMAL MODE, VARIABLE AREAS BRACKETED WITH VBLK AND PBLK
+
+] ;END PURESW CONDITIONAL
+
+.YSTGW ;SET UP NOW, STORAGE WORDS OK
+\f
+FOO==.
+LOC 41
+ JSR ERROR
+IFN ITSSW,JSR TSINT
+IFN DECSW,[IFE SAILSW,LOC .JBAPR
+.ELSE LOC JOBAPR
+ 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
+\f
+ ;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
+\f
+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
+\f
+;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 IF SYMTAB HASN'T BEEN SORTED (PSEUDOS DELETED)
+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
+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
+\f
+ ;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
+;GO2 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.
+\f
+;;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
+]
+\f
+
+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,
+\f
+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,INCHR3 ;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
+
+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
+ 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,[
+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,
+\f
+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 MAYBE GET HERE FROM RCH2+2
+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,
+\f
+;;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
+\f
+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,
+\f
+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 (SOMETIMES RETURN HERE FROM RREOF)
+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 RR1-1
+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>
+
+
+\f
+ ;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
+\f
+ ;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,[
+ TLNN FF,FLVOT\FLMAC\FLTTY ;^@ SYLLABLE OPERATOR ROUTINE.
+ CALL RPANUL
+]
+ JRST RRL2
+\f
+ ;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
+\f
+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,
+\f
+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
+ 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
+\f
+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
+\f
+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
+\f
+ ;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)
+\f
+;;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
+ SAVE 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: SAVE 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,
+\f
+;READ IN A FIELD, RETURN IN A,B SETTING IRFLD IF FIELD NOT NULL.
+GETFLD: SAVE 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)
+\f
+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
+\f
+MULTP: MOVEI C,MULTP1 ;ASTERISK, MULTP1 ROUTINE TO PERFORM MULTIPLICATION
+DIVID2: MOVSI TT,20 ;20 PRECEDENCE OF MULTIPLICATION, DIVISION
+ JRST GETFDL
+
+MULTP1: JUMPGE FF,MULTR ;ON P1, DON'T CHECK THIS, SINCE UNDEF SYMS ARE EXTERNALS
+ SKIPL CONTRL ;ELSE IN DECREL ASSEMBLY, TEST FOR EXTERNALS.
+ JRST MULTR
+ MOVE D,GETFLB(P) ;ACTUALLY, GET HERE FOR ABS ASSEMBLIES TOO, BUT SO WHAT?
+ CAME D,GLSP1
+ ETR [ASCIZ /Externals multiplied/]
+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
+\f
+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
+ JUMPGE FF,GETFD4
+ MOVE D,GETFLB(P)
+ CAME D,GLSP1
+ ETR [ASCIZ /Division involving externals/]
+ 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
+ JUMPGE FF,GETFD4 ;DON'T CHECK FOR GLOBALS EXCEPT DURING PUNCHING PASS
+ MOVE D,GETFLB(P) ;PICK UP POINTER TO LEFT OPERAND GLOTB ENTRIES
+ CAME D,GLSP1
+ ETR [ASCIZ /External in arg to \, & or #/]
+ 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)
+\f
+;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
+\f
+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
+\f
+;;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,
+\f
+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 [ SAVE 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
+\f
+;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,
+\f
+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
+\f
+ ;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
+ 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.
+\f
+;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: "? ? "< ? "( ? "[ ? "? ;]
+\f
+;;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.
+\f
+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: 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,
+\f
+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
+\f
+;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
+\f
+;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.
+\f
+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)
+CPOPJ: POPJ P,
+
+;ESDCHK THEN DEFCHK IS SAME AS CALLING ESDEF.
+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,
+\f
+;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: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
+\f
+;;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,SYM
+ PUSH P,ESBK
+ PUSH P,I
+ MOVEI A,[ETSM [ASCIZ/Undefined in =/]]
+ MOVEM A,GTVER
+ TRO I,IRNOEQ+IRDEF+IREQL
+ PUSHJ P,GETWRD
+ MOVEI CH1,CRDF
+ MOVEM CH1,PARBIT ;SET FLAG TO TELL LOADER TO ALLOW REDEFINITION
+ 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
+ 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.
+\f
+;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
+ SKIPN PARBIT ;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
+\f
+;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
+ PUSHJ P,P70 ;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
+\f
+ ;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
+\f
+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
+\f
+;;. ;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
+\f
+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
+ CLEARM PARBIT ;SET FLAG SAYING COLON, FOR DEFINITION PUNCHING
+ 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
+\f
+;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
+\f
+;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
+\f
+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
+ SAVE A
+ SAVE A
+ABLKF2: CALL FASPW
+ MOVEMM GLSP2,GLSP1
+ SOSE (P)
+ JRST ABLKF2
+ JRST POPBAJ
+]
+
+ABLKF1: 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
+\f
+;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: SAVE 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*]
+\f
+;;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
+\f
+;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)
+\f
+;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
+ SAVE ASMOUT
+ SAVE ASMDSP
+ SAVE 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)
+\f
+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
+\f
+ ;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
+\f
+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
+\f
+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
+\f
+;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)
+\f
+ ;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
+\f
+ ;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
+\f
+ ;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,
+\f
+ ;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
+\f
+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/
+\f
+ ;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,
+\f
+ ;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.
+\f
+;;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
+ SAVE [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,[-1-FLVOT-FLPTPF-FLTTY,,-1] ;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
+\f;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 [ SETZM CLOC
+ AOS CRLOC ;CRLOC GETS 1
+]
+ 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,,
+\f
+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==.
+\f
+;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==.
+\f
+;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.
+ 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
+]
+ TRNE T,DECREL
+ JRST SYMDMD
+ JUMPL T,SSYMD ;JUMP IF NOT RELOCATABLE
+ 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
+\f
+;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
+ 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
+ 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 TOPO BIT,
+ MOVEI A,ST ;SORT FROM BOTTOM OOF 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)
+ MOVE C,BKTABP
+ IDIVI C,BKWPB ;# BLOCKS (INCL. .INIT BLOCK).
+ CAIN C,2
+ MOVEI C,1 ;IF ONLY .INIT AND .MAIN, FILE WILL HAVE ONLY GLOBAL.
+ MOVSI A,(C)
+ SUBM B,A ;-<# ENTRIES IN SYMTAB IN FILE>,,
+ LSH A,1 ;-<# WDS IN SYMTAB IN FILE>,,
+ MOVEM A,SCKSUM ;SAVE THIS.
+ PUSHJ P,PPB
+ PUSHJ P,BKCNT ;PUT -<# SYMS IN BLOCK> IN 3RD WD OF EACH BKTAB ENTRY.
+
+;DROPS THROUGH.
+\f
+;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 B,SCKSUM ;GET CHKSUM AFTER 1SS WD. (PPBCK WILL UPDATE)
+ SETOM 1(D) ;PUT A -1 AT END OF BKTAB1.
+ 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
+ JRST SSYMD6 ;NO BLOCKS IN DEC FMT. (OR FASL EITHER)
+ SKIPGE BKTAB1+1
+ JRST SSYMG1 ;ONLY 1 BLOCK, PUT ALL IN GLOBAL.
+ MOVE A,BKTAB(C)
+ PUSHJ P,PPBCK
+ HLRZ A,BKTAB+1(C)
+ HRL A,BKTAB+2(C) ;PUT IN -2*<NUM SYMS>
+ ADD A,[-2,,1]
+SSYMG2: PUSHJ P,PPBCK ;FOLLOWED BY LEVEL.
+ JRST SSYMD6
+
+SSYMG1: MOVE A,[SQUOZE 0,GLOBAL]
+ PUSHJ P,PPBCK
+ HRLZ A,BKTAB+BKWPB+2
+ ADD A,[-2,,]
+ JRST SSYMG2
+
+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 SSYMD3 ;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)
+ 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.
+ JRST SSYMD3 ;ALL SYMS FORR THIS BLOCK DONE, DO NEXT BLOCK.
+\f
+;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
+]
+\f
+;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
+ SKIPGE BKTAB1+1 ;IF ABS ANND BLOCK STR,
+ JRST SSYMG4
+ MOVE A,[SQUOZE 0,GLOBAL]
+ PUSHJ P,PPBCK ;PUT A GLOBAL BLOCK WITH NO SYMS AT END.
+ MOVSI A,-2
+ PUSHJ P,PPBCK
+SSYMG4: MOVE A,B ;ABS 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
+ 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)
+BKSRT: MOVEI D,BKTAB1-1 ;D IS FOR PUSHING INTO BKTAB1.
+ MOVSI A,1 ;START WITH BLOCK 0 (OUTERMOST, .INIT).
+BKSR1: SETZ C, ;HANDLE BLOCK IN A: LOOK FOR ITS SUBBLOCKS.
+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)
+BKSR3: ADDI C,BKWPB
+ CAMGE C,BKTABP
+ JRST BKSR2
+ MOVEI C,(A)
+ JUMPE C,CPOPJ ;DON'T PUT .INIT BLOCK IN BKTAB1.
+ 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
+\f
+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,
+\f
+ ;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
+\f
+ ;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: SAVE 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
+\f
+;;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
+\f
+ ;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
+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,
+\f
+ ;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
+ JUMPGE FF,CPOPJ ;IGNORE IF NOT PUNCHING PASS
+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,
+ 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
+\f
+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,
+\f
+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
+\f
+ ;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,
+\f
+ ;PWRD DURING ABSOLUTE ASSEMBLY
+
+PWRD1: TRNE LINK,DECREL ;DEC 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
+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
+\f
+;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,
+\f
+;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
+ SAVE 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.
+ SAVE [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
+\f
+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,
+
+\f
+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
+ JRST AFRTKL ;THAT CHAR WINS, SALT 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,
+]
+\f ;.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
+\f
+;.GLOBAL, .SCALAR, .VECTOR
+;LH(B) HAS ILGLI, ILVAR, ILVAR+ILFLO RESPECTIVELY.
+
+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,ILFLO ;FOR .VECTOR, SAVE # VARS CREATED BEFORE CREATING THIS ONE.
+ SAVE 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,ILFLO
+ JRST A.GLO2
+ SAVE LINK ;.VECTOR - READ THE SIZE.
+ TLO FF,FLUNRD ;RE-READ THE TERMINATOR AFTER THE SYM, SO "FOO(1)" AND "FOO," WIN
+ 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
+ SKIPE A
+ MOVEM A,VECSIZ ;IF NONZERO SIZE SPEC'D, USE IT AND SET DEFAULT.
+ MOVE A,VECSIZ ;ELSE USE THE DEFAULT.
+ 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
+\f
+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
+\f
+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
+ PUSHJ P,AEND5 ;RELOCATABLE => .LNKOT
+ SKIPGE A,CONTRL
+ 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
+]
+ 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
+
+AEND1A: TLNN A,777000 ;CHECK INSTRUCTION PART
+ TLO A,(JRST) ;INSTRUCTION PART 0; HE WANTS JRST
+ PUSHJ P,PPB
+ 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,[
+ SAVE 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
+
+\f
+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: SAVE A
+ SAVE 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 A,-1(P)
+ SUB P,[2,,2]
+ JRST VALRET ;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.
+ SAVE ARADIX ;LAMBDABIND RADIX TO THAT VALUE.
+ MOVEM A,ARADIX
+ CALL XGETFD ;READ IN THE NEXT FIELD USING THAT RADIX.
+ REST ARADIX
+ JRST VALRET
+\f
+;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
+ SAVE 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.
+ SAVE A
+ CALL GETBPT ;READ BP AND TURN INTO ACTUAL BP POINTING AT T
+ SAVE 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
+ SAVE A
+ CALL YGETFD
+ MOVE T,A
+ REST A
+ LDB A,A
+ JRST VALRET
+\f
+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
+ SAVE [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
+\f
+;EQUAL SYM1,SYM2 ;DEFINE SYM1 SAME AS SYM2.
+AEQUAL: NOVAL
+ PUSHJ P,GETSLD
+ ETR ERRTFA
+ SAVE SYM ;REMEMBER SYM NAME AND BLOCK TO DEF. IN.
+ SAVE 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
+ SAVE A
+ SAVE B ;SAVE INFO ON VALUE OF SYM TO EQUATE TO.
+ SAVE 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
+\f
+ ;UUO HANDLING ROUTINE
+ ;41 HAS JSR ERROR
+
+VBLK
+IFE ITSSW,ERRTTL: 0 ; NUMBER OF ERRORS HIT
+ERRCCT: 0 ;NUM CHARS OUTPUT ON LINE, FOR MAKING MSGS LINE UP.
+ERRJPC: 0 ;JPC READ WHEN UUO.
+ERROR: 0
+IFN TS, .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
+ SAVE C
+ LDB T,[331100,,40] ;PICK UP OP CODE
+ CAIN T,TYPR_-33 ;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
+IFE ITSSW,[
+ AOS ERRTTL ; BUMP ERROR TOTAL
+IFE SAILSW,AOS .JBERR ; BUMP ERROR MESSAGE COUNTER FOR LOADER TO ABORT
+.ELSE AOS JOBERR
+] ; IFE ITSSW
+ 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
+\f
+;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
+\f
+;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
+ CAIN A,ASSEM1 ;IF THIS ERROR IS EXITING THE PSEUDO,
+ SETZM DEFNPS ;SAY WE'RE NOT IN IT ANY MORE.
+ 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
+\f
+;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
+\f
+;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 GO2
+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.
+IFN ITSSW,.RESET TYIC,
+ JRST GO2
+
+ ;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
+
+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
+\f;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)
+ SAVE 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
+ MOVEM A,CLOC
+SIMBL2: MOVEM B,CONTRL ;STORE NEW MODE.
+ 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
+
+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
+]
+\f
+ATITLE: NOVAL
+ SAVE 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?
+ JRST [IFE ITSSW,SKIPE CCLFLG ? TRNN FF,FRPSS2
+ JRST CRR ;ONE OF THESE, FINISH TYPEOUT WITH CR
+ .ALSO RET
+ ] ; AND RETURN IF PASS2 DEC CCL
+IFE ITSSW,SKIPE CCLFLG ? TRNN FF,FRPSS2
+ PUSHJ P,TYO ;NEITHER OF THESE, PRINT CHAR
+A.ERR1: PUSHJ P,RCH ;GET NEXT CHAR IN TITLE
+ JRST ATIT1
+
+;.ERR PSEUDO-OP -- FOLLOWED BY LINE WHICH IS ERROR MSG.
+A.ERR: SAVE CASSM1 ;RETURN TO ASSEM1,
+ ERJ A.ERR1 ;AFTER NUMBERS AND USER'S STRING.
+
+A.FATAL: SAVE [GO2] ;.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
+\f;.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
+\f
+;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
+ SAVE [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
+\f
+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/
+\f
+;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,D
+ PUSH P,SYM
+ SAVE 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,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
+\f
+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
+ 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: 0 ;DELIMITER
+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
+ 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.
+\f
+ASQOZ: HLLM B,(P) ;SAVE FLAG THAT'S 0 FOR SQUOZE, -1 FOR .RSQZ .
+ SAVE 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: HRLES 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: SAVE SYM
+ SAVE 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
+\f
+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
+\f
+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
+\f;;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
+\f
+ ;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
+ JRST -3(A)
+ JRST -4(A)
+
+MRCH1: MOVE B,MACP
+BPOPJ: POPJ B, ;RETURN AT END OF STRING EXPANSION
+\f
+ ;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,
+\f
+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
+\f
+ ;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
+]
+\f
+ ;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
+\f
+ ;STRING CONDITIONALS (IFSE, IFSN)
+
+SCOND: MOVE A,FREEPT
+ MOVEM A,PRSCND
+ MOVEM A,PRSCN1
+ SAVE SYM
+ HRRI B,SCONDF
+ SAVE 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
+\f
+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,
+\f
+;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
+\f
+ ;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
+\f
+ ;READ IN BODY OF MACRO, IRP, OR WHATEVER
+
+WRQOTE: SAVE [0] ;USED FOR LENGTH OF SYMBOL (REALLY 6 MINUS IT).
+WRQLEN==,-2
+ SAVE [0] ;THIS WD USED FOR DEFINE/TERMIN COUNT.
+WRQLVL==,-1
+ SAVE [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,
+\f
+;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".
+ MCFEVL==5 ;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.
+ SAVE CASSM1 ;RETURN TO ASSEM1 EVENTUALLY
+ JSP TM,ERMARK ;ERR MSGS SHOULD SAY WE'RE INSIDE A DEFINE.
+ SAVE SYM ;THESE 2 PUSHES ARE FOR NONAME'S SAKE.
+ SAVE SYM
+ CALL GETSLD
+ CALL NONAME
+ TLZ FF,FLUNRD
+ SUB P,[2,,2]
+ SAVE SYM
+ SAVE 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
+]
+\f
+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 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: SAVE 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
+
+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
+\f
+;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: SAVE I
+ AOS PRCALP
+ AOS MDEPTH
+ SAVE RDWRDP
+ SAVE 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
+ JUMPE B,[TLO FF,FLUNRD ;SAVE CHR FOLLOWING MACRO W/NO ARGUEMENTS
+ TLZ I,ILPRN ;SUCH MACROS
+ SKIPE B,ASMOUT ;IF WITHIN A GROUPING,
+ CAIN B,4
+ JRST MACNX0
+ JSP LINK,SAVAS2 ;RESTORE ASMDSP TO NORMAL IN CASE
+ JRST MACNX0] ;THE CHAR BEING REREAD IS A CLOSE.
+ TLZ I,ILPRN
+ MOVE A,LIMBO1
+ CAIE A,15
+ 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.
+\f
+;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.
+ CAIN B,MCFSTR
+ 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.
+ MOVE T,A ;ELSE SAVE THIS CHAR; IT'S THE DELIMITER.
+ TLZA FF,FLUNRD
+MACST2: CALL PUTREL
+ CALL RCH ;READ ANOTHER CHARACTER. IF IT ISN'T THE DELIMITER,
+ CAME A,T
+ JRST MACST2 ;STORE IT AND READ ANOTHER.
+ 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.
+\f
+;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: MOVE A,@PRCALP ;COPY THE DEFAULT VALUE FROM THE MACRO BODY
+ TRZN LINK,MCFKWD
+ JRST MACDF1
+MACDF0: CALL REDINC
+ CAIE B,377
+ JRST MACDF0
+MACDF1: CALL REDINC ;AS THE ARGUMENT STRING.
+ CAIN B,377
+ JRST MACDF2 ;END OF THE DEFAULT VALUE.
+ EXCH A,B
+ CALL PUTREL
+ EXCH A,B
+ JRST MACDF1
+
+MACDF2: MOVEM A,@PRCALP
+ JRST STPWR
+
+;COME HERE IF GENSYMMABLE ARG IS SPEC'D AS NULL.
+MACGEN: MOVEI A,5
+ MOVEM A,SCKSUM
+ MOVEI A,"G
+ PUSHJ P,PUTREL
+ SAVE 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
+ SAVE 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
+ SAVE 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
+\f
+;HANDLE KEYWORD PARAMETERS. COME HERE WHEN A DESCRIPTOR IS SEEN
+;THAT SPECIFIES A KEYWORD PARAMETER.
+MACK: SAVE RDWRDP
+ SAVE @PRCALP
+ SAVE 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: REST LINK
+ REST @PRCALP ;NOW GO BACK TO THE DESCRIPTOR OF THE FIRST KEYWORD PARAM.
+MACKLP: CALL GPASST ;NOW SEE IF THERE'S AN ARGUMENT TO BE FOUND
+ CAIE A,^M ;IF SO, IT SHOUDL 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,(P) ;NOW SCAN THROUGH THIS RUN OF KEYWORD PARAMS FOR THE
+ SAVE @PRCALP ;ONE WHOSE NAME MATCHES WHAT GSYL READ.
+ SAVE LINK
+ CAIE A,"=
+ 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
+ REST LINK
+ REST @PRCALP
+MACKND: TLO FF,FLUNRD ;MACRO CALL TERMINATOR SEEN.
+;NULL ARG SEEN; ENDS THIS RUN OF KEYWORD ARGS BUT NOT THE CALL.
+MACKN1: 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.
+\f
+;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
+\f
+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
+\f
+;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.
+ SAVE I
+ SAVE RDWRDP
+ HLRZ LINK,B ;GET IRP TYPE CODE TO INDEX BY.
+ CAIE LINK,NIRPN
+ JRST AIRP0
+ CALL AGETFD ;IRPNC, READ THE 3 NUMERIC ARGS.
+ SAVE A
+ CALL AGETFD
+ SAVE 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.
+\f
+;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.
+\f
+;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?
+ SAVE 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
+\f
+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: SAVE 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
+\f
+ ;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.
+\f
+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
+\f
+;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)
+\f
+;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)
+\f
+ ;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
+\f
+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
+\f
+ ;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
+\f
+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
+\f
+ ;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
+GC: MOVEM 17,GCSV+15
+ MOVE 17,[2,,GCSV]
+ BLT 17,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
+ 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
+\f
+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.
+\f
+ ;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
+ MOVS 17,[2,,GCSV]
+ BLT 17,17
+ 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
+\f
+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)
+\f
+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,ACSAV+1
+ PUSHJ P,RCH
+ EXCH I,ACSAV+1
+TERMIN
+
+DEFINE GETT
+ EXCH I,ACSAV+1
+ PUSHJ P,RCH
+ EXCH I,ACSAV+1
+ IDPB A,TPN
+TERMIN
+\f
+; 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
+ACSAV: BLOCK 7
+TEMP: 440600,,(D) ;INDIRECT VIA D
+BYTPNT: 0
+PBLK
+\f
+; ENTRANCE TO 'ALGEBRAIC' TRANSLATOR
+
+A.I: SETOM INTEGR
+ SKIPA
+A.F: SETZM INTEGR
+ PUSHJ P,SWINI ;INITIALISE PASSAGE TO MIDAS ASSEMBLER
+ MOVE TM,[P,,ACSAV]
+ BLT TM,ACSAV+6
+ 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
+\f
+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 )
+
+\f
+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 )
+\f
+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
+\f
+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: MOVE TM,[ACSAV,,P]
+ BLT TM,P+6
+ JRST SWFLS ;GO BACK AND FLUSH
+
+
+CONRBT: GET
+ CAIE A,12 ;LF
+ JRST CONRBT
+ JRST CONRAT
+
+\f
+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
+
+\f
+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
+\f
+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
+ MOVE TM,[ACSAV,,P]
+ BLT TM,P+6
+ 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
+\f
+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
+
+\f
+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,
+\f
+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
+\f
+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
+\f
+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
+\f
+IFN LISTSW,[
+
+;LISTING ROUTINES.
+
+PNTR: MOVEM 17,PNTSA+17
+ MOVEI 17,PNTSA
+ BLT 17,PNTSA+16
+ 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,
+\f
+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
+ SAVE 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
+\f
+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
+\f
+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
+\f
+;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,
+\f
+IFN TS,[ ;;TS ;TIME-SHARING ROUTINES
+
+IFNDEF TYPDLC,TYPDLC==7 ;MAXIMUM TOTAL DEPTH OF .INSRT (INCLUDING TTY)
+IFNDEF MX.INS,MX.INS==5 ;MAXIMUM DEPTH .INSRT FILES ONLY
+IFNDEF MAXIND,MAXIND==6 ;MAXIMUM # @: TABLE ENTRIES FOR .INSRT
+IFN DECSW,[
+ UTOBFL==203
+ CRFBSZ==203
+ UTIBFL==410
+ LSTBSZ==203
+ ERRBSZ==203
+]
+IFNDEF UTIBFL,UTIBFL==400 ;INPUT BUFFER SPACE.
+IFNDEF UTOBFL,UTOBFL==200
+IFNDEF CMBFL,CMBFL==50 ;COMMAND BUFFER LENGTH.
+IFNDEF CRFBSZ,CRFBSZ==200 ;# WDS CREF OUTPUT BUFFER.
+IFNDEF LSTBSZ,LSTBSZ==200
+IFNDEF ERRSW,ERRSW==1 ;1 FOR ERROR FILE OUTPUT CAPABILITY.
+IFNDEF ERRBSZ,ERRBSZ==1 ;ERROR FILE BUFFER SIZE.
+
+ERRC==0 ;ERR DEVICE CHANNEL.
+TYIC==1 ;TTY INPUT CHANNEL
+TYOC==2 ;TTY OUTPUT CHANNEL
+CREFC==3 ;CREF OUTPUT.
+UTYOC==4 ;OUTPUT FILE
+LPTC==5 ;LISTING (LPT)
+ERRFC==6 ;ASSEMBLY ERROR OUTPUT FILE.
+UTYIC==7 ;1ST INPUT CHANNEL, UTYIC+N USED FOR NTH .INSRT LEVEL IN DEC VERSION.
+
+VBLK
+INTJPC: 0 ;SAVES .JPC AT INTERRUPT.
+INTSVP: 0 ;SAVES P ON INTERRUPT FOR DEBUGGING
+
+;NOTE THAT ONLY PDL OV IS NOW ENABLED.
+
+IFN ITSSW,[
+.JBCNI:
+TSINT: 0 ;1ST WD INTERRUPTS (AT PRESENT) ARE CONSIDERED FATAL ERRORS
+.JBTPC: 0 ;ERROR PROCESSOR RE-ENABLES INTERRUPTS
+ .SUSET [.RJPC,,INTJPC]
+ SKIPGE TSINT
+ JRST TTYINT ;SECOND-WORD INTS.
+ JRST TSINT1 ;JUMP INTO PURE CODING AND PROCESS INTERRUPT
+]
+.ELSE CCLFLG:0 ; FLAG TO INDICATE CCL ENTRY FROM COMPIL
+
+PBLK
+TSINT1: MOVEM P,INTSVP ;SAVE P FOR POSSIBLE DEBUGGING
+ .SUSET [.SPICL,,[-1]]
+IFE SAILSW,MOVE A,.JBCNI ;GET INTERRUPT REQUEST WORD
+.ELSE MOVE A,JOBCNI
+ TRNE A,200000 ;PDL OVERFLOW?
+ JRST CONFLP
+ MOVE B,[TYPR [ASCIZ/Unknown interrupt - Fatal/]]
+ MOVEM B,40
+IFE SAILSW,MOVE A,.JBTPC ;SO ERROR ROUTINE WILL PRINT OUT PROPERLY
+.ELSE MOVE A,JOBTPC
+ JSA A,ERROR
+\f
+;MIDAS STARTS HERE.
+BEG:
+IFN DECSW,[
+ TDZA A,A
+ SETO A,
+ MOVEM A,CCLFLG ; REMEMBER TYPE OF START-UP
+ RESET
+ MOVEI A,600000
+ APRENB A,
+]
+IFN ITSSW,[
+ .SUSET [.RSNAM,,RSYSNM] ;GET SYSTEM NAME
+ .SUSET [.SMASK,,[%PIPDL]] ;PDL OVERFLOW ONLY.
+ .SUSET [.SMSK2,,[1_TYIC]]
+ SYSCAL TTYSET,[1000,,TYIC
+ [232020,,202020]
+ [232020,,220220]]
+ .SUSET [.SPICL,,[-1]] ;PERMIT INTERRUPTS (IN CASE RESTARTED DURING INTERRUPT)
+]
+ MOVEI FF,0 ;INITIALIZE FLAGS
+ MOVE P,[-LPDL,,PDL] ;INITIALIZE P
+ AOSN NVRRUN
+ JRST BEG9
+ TYPR [ASCIZ /Can't restart MIDAS/]
+ JRST TSRETN
+
+BEG9: MOVEI D,SYMDSZ ;GET DEFAULT SYMTAB SIZE
+IFN ITSSW,[
+ .SUSET [.RXJNAM,,A]
+ CAME A,['MMIDAS] ;OR LARGER FOR MMIDAS
+ CAMN A,[SIXBIT/MM/]
+ MOVEI D,SYMMSZ
+]
+ SKIPGE ISYMF ;THE FIRST TIME THROUGH,
+ MOVEM D,SYMLEN ;MAKE THAT THE SIZE TO USE.
+ CALL JCLINI ;NOW TRY TO FETCH JCL.
+IFN ITSSW,[SKIPGE ISYMF ;SKIP IF SYMS SPREAD
+ CALL TSYMGT ;GET TS SYMS FROM SYSTEM
+]
+ SKIPGE CMPTR ;IF NO CMD FROM DDT,
+ JRST GO2A ;ANNOUNCE MIDAS'S NAME AND VERSION.
+IFG PURESW-DECSW,[
+ SKIPGE PURIFG
+ TYPR [ASCIZ /NOTPUR /]
+]
+ MOVE B,[SIXBIT /MIDAS./]
+ PUSHJ P,SIXTYO
+ MOVE B,[MIDVRS]
+ PUSHJ P,SIXTYO
+; JRST GO2A
+\f
+GO2A: SETOM FATAL
+ SETZM TTYFLG
+IFE ITSSW,SETZM ERRTTL ; INITIALIZE ERROR COUNTER
+ MOVEI FF,0 ;INITIALIZE FLAGS
+ SKIPLE CMPTR
+ SETZM CMPTR
+IFN RUNTSW,[ PUSHJ P,RNTTMA ;GET INITIAL RUN TIME.
+ MOVEM A,IRUNTM']
+ SETZM LSTTTY
+ PUSHJ P,CMD ;GET TYPED IN COMMAND
+ SKIPGE SMSRTF
+ JRST GO21
+ TYPR [ASCIZ/SYMTAB clobbered
+/]
+ JRST GO2A
+
+GO21: PUSHJ P,GINIT ;INITIALIZE STUFF
+ PUSHJ P,OPNRD ;OPEN INPUT FILE
+ PUSHJ P,WINIT ;OPEN OUTPUT FILE, CREF FILE.
+IFN DECSW,[
+ SKIPGE CCLFLG
+ OUTSTR [ASCIZ /MIDAS: /]
+]
+GO3: MOVEMM TTYFLG,WSWCNT ;TURN OFF TYPEOUT IF THERE WERE (W) SWITCHS.
+ SETOM LSTTTY
+ JSP A,$INIT ;INITIALIZE FOR ASSEMBLY
+ JSP A,PS1 ;DO PASS 1
+ TRNE FF,FRNPSS ;IF 2 PASS ASSEMBLY,
+ PUSHJ P,OPNRD ;THEN RE-OPEN INPUT FILE
+ JSP A,PLOD ;MAYBE PUNCH OUT SBLK LOADER IN SOME FORMAT
+ JSP A,PS2 ;DO PASS 2
+ JSP A,PSYMS ;MAYBE PUNCH OUT SYMBOL TABLE
+IFN A1PSW,[
+ TLZ FF,FLOUT
+ AOS PRGC ;INDICATE END STATEMENT ENCOUNTERED
+ SETOM OUTC ;" " "
+ TRNN FF,FRNPSS ;IF 1 PASS ASSEMBLY,
+ SKIPGE CONTRL
+ CAIA
+ JRST GO3 ;THEN TRY TO ASSEMBLE ANOTHER PROGRAM
+]
+IFN FASLP,[
+ SKIPGE A,CONTRL
+ TRNN A,FASL
+ JRST GO4
+ MOVE A,[SIXBIT /*FASL*/] ;"FINISH" FASL FILE
+ MOVEI B,17
+ PUSHJ P,FASO ;IGNORE END FROB, BUT OUTPUT FASL END CODE
+ MOVE A,[.BYTE 7 ?3 ? 3 ? 3? 3? 3]
+ PUSHJ P,FASO1 ;RANDOMNESS
+ PUSHJ P,FASBE ;WRITE OUT LAST BLOCK
+]
+GO4: SETZM FATAL ;THERE WAS NO FATAL ERROR: OUTPUT FILES GET RENAMED.
+GO2:
+RETN2: PUSHJ P,.FILE
+ SETZM LSTTTY
+IFN RUNTSW,[
+ PUSHJ P,RNTTYO ;TYPE OUT RUN TIME USED SINCE GO2A
+];IFN RUNTSW
+ CALL ERRCLS ;FILE AWAY ERROR FILE.
+ JRST TSRETN
+
+ ;INITIALIZATION ROUTINE CALLED ONCE PER (COMMANDED) ASSEMBLY
+
+GINIT: IFN A1PSW,[
+ SETOM PRGC
+ SETOM OUTC
+]
+IFN DECSW,[ IFE SAILSW,[
+ SETZM V.SITE ;; CODE TO SET UP .SITE'S VALUE, ON DEC SYSTEM.
+ MOVE A,[V.SITE,,V.SITE+1]
+ BLT A,V.SITE+4
+ MOVE B,[440600,,V.SITE]
+ MOVSI C,-5 ;PROCESS 5 WORDS F .GTCNF
+GINIT1: HRLZ A,C
+ HRRI A,11 ;11 = .GTCNF
+ GETTAB A, ;GET 1 WORD
+ SETZ A,
+GINIT2: SETZ AA, ;EXTRACT THE ASCII CHARS AND STORE THEM.
+ ROTC AA,7
+ TRCE AA,140 ;SWAP BIT 40 WITH BIT 100, THUS TURNING
+ TRCE AA,140 ;"A TO 'A, "a TO 'A, "1 TO '1, ETC, AND ^@ TO ' .
+ TRCE AA,140
+ IDPB AA,B ;STORE THE SIXBIT INTO .SITE'S VALUE STRING.
+ JUMPN A,GINIT2 ;WHEN NOTHING LEFT OF THIS WORD OF .GTCNF, GET THE NEXT.
+ AOBJN C,GINIT1
+]];END DECSW
+ MOVE A,[MAXIND,,FDSOFS]
+ MOVEM A,INDDP ;INITIALIZE POINTER INTO INDIRECT FILE TABLE
+IFDINI: MOVE A,[DNAM,,IFDS]
+ BLT A,IFDS+LFDSE-1 ;SET UP INPUT FILE NAMES FROM DNAM ETC.
+ POPJ P,
+\f
+IFN RUNTSW,[ ;TYPE OUT RUN TIME USED
+
+RNTTYO:
+IFE ITSSW,[ ; NOBODY WANTS THIS ON ITS, BUT OTHER PEOPLE DO...SIGH...
+ SKIPE A,ERRTTL ; ANY ASSEMBLY ERRORS?
+ JRST [ TYPR [ASCIZ/? /] ; YES, ERROR MESSAGE FOR BATCH CONTROLLERS
+ CALL DPNT
+ TYPR [ASCIZ/ error(s) detected
+/]
+ JRST .+1]
+IFN DECSW,[
+ SKIPE CCLFLG ; CALLED VIA CCL?
+ RET
+] ; IFN DECSW
+] ; IFE ITSSW
+ TYPR [ASCIZ /Run time = /]
+ CALL A.MRUNT ;GET RUNTIME IN MILLISEC. IN A.
+ IDIVI A,10.
+ IDIVI A,100. ;GET SECS AND HUNDREDTHS.
+ HRLM B,(P) ;SAVE REMAINDER
+ PUSHJ P,HMSTYO ;TYPE OUT SECS
+ MOVEI A,".
+ CALL TYO
+ HLRZ A,(P)
+ CALL RNTYO3 ;TYPE OUT HUNDREDTHS
+ CALL CRR
+ CALL A.SYMC
+ CALL DPNT
+ TYPR [ASCIZ/ Symbols including initial ones
+/]
+ RET
+
+ ;TYPE OUT H:MM:SS TIME IN A
+ ;DOESN'T WORK FOR TIMES .GE. 60. HOURS
+
+HMSTYO: IDIVI A,60.
+ JUMPE A,HMSTY2
+ HRLM B,(P)
+ PUSHJ P,HMSTYO
+ MOVEI A,":
+RNTYO2: PUSHJ P,TYO ;TYPE DELIMITING CHAR
+ HLRZ A,(P)
+RNTYO3: IDIVI A,10.
+ PUSHJ P,ADGTYO ;TYPE OUT DIGIT IN A
+ MOVEI A,"0(B)
+ JRST TYO
+
+HMSTY2: MOVE A,B
+ JRST DPNT
+
+RNTTMA: .SUSET [.RRUNT,,A]
+IFN DECSW,[SETZ A,
+ RUNTIM A,]
+ POPJ P,
+
+A.MRUNT: PUSHJ P,RNTTMA ;GET CURRENT RUN TIME
+ SUB A,IRUNTM' ;SUBTRACT RUN TIME AS OF GO2
+IFN ITSSW,[MULI A,4069. ;CONVERT TO NANOSECONDS
+ DIV A,[1.^6] ;THEN TO MILLISECONDS.
+]
+ JRST CLBPOP
+]
+\f
+ ;TS OUTPUT ROUTINES
+
+PPB: JUMPGE FF,CPOPJ
+PPBA:
+TPPB: SOSGE UTYOCT
+ JRST TPPB1
+ IDPB A,UTYOP
+ RET
+
+TPPB1: CALL TPPBF ;OUTPUT THE BUFFER,
+ JRST TPPB
+
+TPPBF: SAVE C
+ MOVE C,[0 UTYOC,UTOHDR]
+ CALL OBUFO ;OUTPUT & RE-INIT BUFFER.
+ REST C
+ RET
+
+WINIT:
+IFN ERRSW,[
+ SKIPN ERRFP ;IF WANT ERROR OUTPUT FILE,
+ JRST WINIT2
+ CALL OINIT ;OPEN IT.
+ 0 ERRFC,ERRDEV
+ SIXBIT/ERROUT/
+ ERRHDR,,ERRBUF
+ SETOM ERRFOP ;ERROR FILE NOW OPEN.
+WINIT2: ]
+ PUSHJ P,OINIT ;OPEN OUTPUT FILE, FN2=OUTPUT.
+ 13^9 UTYOC,ONAM ;<DEC-MODE> CHNL,NAME-BLOCK.
+ SIXBIT/OUTPUT/
+ UTOHDR,,UTOBUF
+IFN ITSSW,[
+ TLZ FF,FLPTPF ;INITIALLY ASSUME DEVICE NOT PAPER TAPE PUNCH
+ .STATUS UTYOC,A ;GET STATUS OF OUTPUT CHANNEL
+ ANDI A,77 ;MASK TO DEVICE CODE
+ CAIN A,7 ;IF PAPER TAPE PUNCH,
+ TLO FF,FLPTPF ;THEN SET FLPTPF
+]
+IFN LISTSW,[
+ SKIPN LISTP
+ JRST WINIT1
+ CALL OINIT
+ 0 LPTC,LSTDEV ;OPEN LISTING FILE IF DESIRED.
+ SIXBIT/LSTOUT/
+ LSTHDR,,LSTBUF
+WINIT1:
+]
+IFN CREFSW,[
+ SKIPN CREFP ;IF CREF REQUESTED,
+ RET
+ PUSHJ P,OINIT ;OPEN CREF FILE, FN2=CRFOUT
+ 13^9 CREFC,CRFDEV
+ SIXBIT/CRFOUT/
+ CRFHDR,,CRFBUF
+ MOVE A,[.BYTE 7 ? 177 ? "B ? ^W]
+ PUSHJ P,CRFOUT ;OUTPUT HEADER TO INDICATE IMAGE INPUT.
+ PUSHJ P,CRFSSF ;OUTPUT SET-SOURCE-FILE BLOCK.
+]
+ RET
+\f
+IFN ITSSW,RELEAS==.CLOSE
+
+;CLOSE INPUT, BIN, CREF AND LIST FILES.
+.FILE: RELEAS UTYIC,
+ MOVNI A,1
+ SKIPL B,CONTRL ;IF RELOCATABLE,
+ PUSHJ P,TPPB ;OUTPUT A -1 SO STINK WILL SEE EOF
+ SETZ A, ;IN DEC FMT, OUTPUT A 0 AT END.
+ TRNE B,DECREL
+ CALL TPPB
+ SKIPE ONAM+2
+ JRST .FILE2 ;OUTPUT FNAM2 WAS EXPLICITLY SPECIFIED
+ SKIPL B,CONTRL
+ SKIPA A,[IFN DECSW,['STK,,] .ELSE ['REL,,]]
+ MOVSI A,(SIXBIT /BIN/)
+ TRNE B,DECREL ;THE DEFAULT DEPENDS ON OUTPUT TYPE.
+ MOVSI A,'REL
+IFN FASLP,[
+ TRNE B,FASL
+ MOVE A,[IFN ITSSW,[SIXBIT /FASL/] .ELSE ['FAS,,]]
+]
+ MOVEM A,ONAM+2
+.FILE2: JSP A,OCLOSE
+ 0 UTYOC,UTOHDR ;WRITE OUT BUFFER, RENAME AND CLOSE OUTPUT FILE.
+ ONAM
+IFN LISTSW,[
+ SKIPN LISTP ;LISTING FILE OPEN =>
+ JRST .FILE3
+ CALL PNTCR ;END WITH CR AND FF.
+ MOVEI A,^L
+ CALL PILPT
+ JSP A,OCLOSE
+ 0 LPTC,LSTHDR ;OUTPUT BUFFER, RENAME & CLOSE IT.
+ LSTDEV
+.FILE3:
+] ;END IFN LISTSW
+IFN CREFSW,[
+ SKIPN CREFP ;IF CREF FILE OPEN,
+ POPJ P,
+ MOVEI A,0
+ PUSHJ P,CRFOUT ;OUTPUT EOF BLOCK,
+ JSP A,OCLOSE ;WRITE BUFFER, CLOSE.
+ 0 CREFC,CRFHDR ; 0 CHNL,HEADER
+ CRFDEV
+]
+ RET
+
+;FILE OUT ERROR OUTPUT FILE.
+ERRCLS: SETZM FATAL ;ERR FILE RENAMED EVEN AFTER FATAL ERROR.
+IFN ERRSW,[
+ SKIPN ERRFOP
+ RET ;THERE IS NONE.
+ MOVEI A,^M
+ CALL ERRCHR ;PUT CRLF AT ENND.
+ MOVEI A,^J
+ CALL ERRCHR
+ JSP A,OCLOSE ;RENAME AND CLOSE.
+ 0 ERRFC,ERRHDR
+ ERRDEV
+ SETZM ERRFOP
+]
+ RET
+\f; PUSHJ P,OINIT ;OPEN OUTPUT FILE
+; MODE CHNL,NAME-BLOCK-ADDR
+; SIXBIT/DESIRED-TEMPORARY-FN2/
+; HEADER,,BUFFER SPACE ;USED ONLY IN DEC VERSION.
+;THE MODE SHOULD BE 13^9 FOR BINARY, 0 FOR ASCII.
+IFN ITSSW,[
+OINIT: MOVE A,(P)
+ HLRZ B,2(A) ;GET ADDR OF HEADER,
+ SETOM 2(B) ;SET BUFFER BYTE COUNT TO -1 => NOT INITTED.
+ MOVE AA,1(A) ;GET 2ND ARG,
+ MOVS A,@(P) ;COPY OUTPUT FILE'S EVENTUAL NAMES INTO DNAM, ETC.
+ CALL A.IMP1
+ .CALL OINITR ;TRANSLATE THEM AS IF OPENING THAT FILE,
+ JRST OINITL ;(TOO MANY TRANSLATIONS)
+ .CALL OINITB ;DELETE OLD TEMP NAME FILE.
+ JFCL ;THERE WAS NONE.
+ LDB A,[270400,,@(P)] ;GET CHANNEL NUM.
+ HRLI A,7 ;OPEN MODE.
+ LDB B,[331100,,@(P)]
+ CAIN B,0 ;BUT MAYBE WANT ASCII MODE.
+ HRLI A,3
+ .CALL OINITO
+ JRST OINITL
+ HRRZ A,@(P)
+ MOVEI B,3(A) ;SUCCESSFUL OPEN, COPY TRANSLATED NAMES INTO NAME-BLOCK FOR FILE
+ HRLI A,DNAM
+ BLT A,(B) ;FOR EVENTUAL RENAME.
+POPJ3: AOS (P) ;SKIP OVER 3 ARGS.
+POPJ2: AOS (P)
+ JRST POPJ1
+
+; JSP A,OCLOSE
+; 0 CHNL,HEADER
+; NAMEBLOCKADDR
+;WRITE OUT LAST BUFFER, RENAME TO NAMES IN NAMEBLOCK AND CLOSE.
+OCLOSE: MOVE C,(A) ;1ST WD OF ARGS IS WHAT OBUFO WANTS.
+ LDB B,[360600,,1(C)] ;JUST IN CASE THIS IS ASCII FILE,
+ DPB B,[300600,,OCLOSP] ;GET BP TO UNUSED PART OF LAST WD OF BUFFER,
+ MOVE B,[ASCIC//]
+ DPB B,OCLOSP ;AND PAD WITH ^C'S.
+ SOS 2(C) ;OBUFO ASSUMES BYTE COUNT WAS SOS'D.
+ CALL OBUFO ;WRITE OUT LAST PARTIAL BUFFER
+ MOVE B,1(A)
+ LDB C,[270400,,(A)] ;GET CHNL NUM.
+ SKIPE FATAL
+ JRST OCLOS1 ;AFTER FATAL ERROR, DON'T RENAME OUTPUTFILES.
+ .CALL ORENMB ;RENAME (B HAS NAMEBLOCK ADDR)
+ HALT
+OCLOS1: .CALL OCLOSB ;CLOSE
+ HALT
+ JRST 2(A)
+\f
+ORENMB: SETZ ? SIXBIT/RENMWO/
+ C ? 1(B) ? SETZ 2(B) ;[CHNL] ? [FN1] ? [FN2] ((SETZ))
+
+OCLOSB: SETZ ? SIXBIT/CLOSE/
+ SETZ C
+
+OINITB: SETZ ? SIXBIT/DELETE/
+ DNAM ? ['_MIDAS] ? AA ? SETZ SNAM
+
+OINITR: SETZ ? SIXBIT/TRANS/
+ REPEAT 4,DNAM+.RPCNT
+ REPEAT 4,[? 2000,,DNAM+.RPCNT ] ((SETZ))
+
+OINITO: SETZ ? SIXBIT/OPEN/ ? A
+ DNAM ? ['_MIDAS] ? AA ? SETZ SNAM
+
+;WRITE OUT AND REINITIALIZE BUFFER FOR FILE.
+;ASSUMES BYTE COUNT (HEADER 3RD WD) WAS SOS'D.
+;C HAS <0 CHNL,HEADER>
+;IN ITS VERSION, HEADER 1ST WD HAS <SIZE IN BYTES>,,<BUFFER ADDR>-1
+OBUFO: SAVE A
+ SAVE AA
+ AOSGE 2(C) ;WAS COUNT SOS'D FROM -1?
+ JRST OBUFO1 ;YES, BUFFER HADN'T BEEN INITTED, DON'T WRITE IT.
+ MOVN A,1(C)
+ ADD A,(C) ;RH(A) HAS -<# WDS USED IN BUFFER>.
+ MOVSI A,(A)
+ HRR A,(C)
+ AOS A ;A HAS AOBJN -> USED PART OF BUFFER.
+ HLLZ AA,C
+ IOR AA,[.IOT A]
+ SKIPGE A
+ XCT AA ;WRITE IT IN FILE.
+OBUFO1: MOVE A,1(C)
+ HRR A,(C) ;POSITION THE B.P. BEFORE START OF BUFFER,
+ TLZ A,770000 ;AFTER LAST BYTE IN WD (IDPB WILL USE 1ST BUFFER WD)
+ MOVEM A,1(C)
+ HLRE A,(C)
+ MOVEM A,2(C) ;SET UP BYTE COUNT.
+ REST AA
+ JRST POPAJ
+
+TFEED: TLNN FF,FLPTPF ;IF OUTPUT DEVICE NOT PTP,
+ POPJ P, ;THEN DO NOTHING
+ PUSHJ P,TPPBF ;OTHERWISE OUTPUT THE BUFFER,
+TFEED1: .FEED UTYOC, ;FEED A LINE,
+ TLZA FF,FLPTPF ;IF THIS IS EXECUTED, UTYOC DOESN'T HAVE PTP AFTER ALL
+ SOJG B,TFEED1 ;FEED THE SPECIFIED NUMBER OF LINES,
+ POPJ P, ;AND RETURN
+
+TSRETN:
+IFN PURESW,[
+ SKIPGE PURIFG ;IF NOT YET PURIFIED, ASSUME BEING DEBUGGED.
+ .VALUE
+]
+ .LOGOUT ;COME HERE TO COMMIT SUICIDE.
+ .BREAK 16,160000
+
+A.SITE: CALL AGETFD ;.SITE N, RETURNS NTH WORD OF SIXBIT MACHINE NAME.
+ CAIE A,0 ;ON ITS, ONLY WORD 0 IS NONZERO. IT'S THE "MACHINE NAME".
+ JRST CABPOP
+ SYSCAL SSTATU,[MOVEM A ? MOVEM A ? MOVEM A ? MOVEM A ? MOVEM A ? MOVEM A]
+ .LOSE 1000
+ JRST CLBPOP
+] ;END IFN ITSSW
+\f
+OINITL: IFN ITSSW,[
+ HLLZ A,@(P) ;GET CHNL NUM,
+ TLZ A,777037 ;MASK TO JUST AC FIELD (CHNL NUM)
+ IOR A,[.STATUS A]
+ XCT A ;READ ITS STATUS,
+]
+ PUSHJ P,OPNER ;TYPE OUT REASON FOR OPEN FAILURE,
+ TYPR OINITS
+ PUSHJ P,GTYIP ;GET TYPEIN
+ HRLZ A,@(P) ;REPLACE '_MIDAS' WHATEVER BY ACTUAL NAMES.
+ PUSHJ P,A.IMP1
+ PUSHJ P,RFD ;GET NEW FILE DESCRIPTION
+ HRRZ A,@(P) ;GET NAME BLOCK ADDR,
+ MOVEI B,3(A)
+ HRLI A,DNAM ;COPY NAMES JUST READ INTO IT.
+ BLT A,(B)
+ JRST OINIT
+
+OINITS: ASCIZ/Use what filename instead? /
+
+IFN DECSW,[
+OINIT: MOVE AA,(P)
+ MOVS A,(AA) ;GET NAME-BLOCK ADDR IN LH,
+ HRLZ TT,A ;GET CHNL NUM IN LH.
+ TLZ TT,#(0 17,) ;MASK TO AC FIELD (CHANNEL NUM)
+ HRRI A,DNAM
+ BLT A,SNAM ;COPY NAMES INTO DNAM THRU SNAM.
+ HRRZ D,2(AA) ;GET BUFFER SPACE ADDR.
+ HLLZ C,2(AA) ;GET HEADER ADDR.
+ HLRZ A,C
+ SETZM (A) ;CLEAR OUT ITS-VERSION CONTENTS OF 1ST HEADER WD.
+ LDB A,[331100,,(AA)] ;GET MODE TO OPEN IN (WILL BE ASCII OR IMAGE BINARY)
+ CALL OPNRD2 ;DO OPEN.
+ JRST OINITL
+IFE SAILSW,[SAVE .JBFF
+ MOVEM D,.JBFF]
+.ELSE [SAVE JOBFF
+ MOVEM D,JOBFF]
+ XOR TT,[<OPEN A>#<OUTBUF 1>]
+ XCT TT
+IFE SAILSW,REST .JBFF
+.ELSE REST JOBFF
+ MOVE A,[SIXBIT /000MD /]
+ PJOB B, ;GET JOB NUMBER, TO MAKE SIXBIT /<NNN>MD<E, O, OR L>/
+ JFCL ;CAN IT SKIP?
+ IDIVI B,10.
+ DPB C,[220400,,A]
+ IDIVI B,10.
+ DPB C,[300400,,A] ;PUT THE DIGITS OF THE JOB NUMBER INTO THE SIXBIT WORD.
+ DPB B,[360400,,A]
+ MOVE AA,(P)
+ LDB B,[360600,,1(AA)] ;GET 1ST CHAR OF 'OUTPUT, 'LSTOUT, 'CRFOUT, 'ERROUT.
+ IOR A,B ;USE IT AS LAST CHAR OF TEMP FILE NAME.
+ MOVSI B,'TMP
+ SETZ C,
+ MOVE D,SNAM
+ XOR TT,[<OUTBUF 1>#<ENTER A>]
+ XCT TT ;DO ENTER UTYOC,A
+ JRST OINITL
+POPJ3: AOS (P)
+POPJ2: AOS (P)
+ JRST POPJ1
+\f
+;CLOSE AN OUTPUT FILE, SEE NON-DEC VERSION FOR ARGS.
+OCLOSE: MOVE AA,1(A) ;NAME BLOCK ADDR.
+ SKIPGE FATAL
+ JRST OCLOS2
+ MOVE C,(AA) ;DELETE ANY FILE WITH NAMES
+ SETZB B,D ;WE WANT TO RENAME TO.
+ OPEN ERRC,B
+ JRST OCLOS1
+ MOVE B,1(AA)
+ HLLZ C,2(AA)
+ SETZ D,
+ MOVE T,3(AA)
+ LOOKUP ERRC,B
+ JRST OCLOS1 ;THERE IS NONE, JUST RENAME.
+ SETZ B,
+ MOVE T,3(AA)
+ RENAME ERRC,B
+ JFCL
+ RELEAS ERRC,
+OCLOS1: MOVE B,1(AA) ;DESIRED FN1.
+ HLLZ C,2(AA) ;DESIRED FN2.
+ SETZ D,
+ MOVE T,3(AA) ;SNAME (THAT IS, PPN)
+ HLLZ AA,(A) ;GET JUST CHNL NUM.
+ IOR AA,[CLOSE]
+ XCT AA
+ XOR AA,[CLOSE#<RENAME B>]
+ XCT AA
+ JFCL
+OCLOS2: HLLZ B,(A) ;GET CHNL IN AC FIELD.
+ IOR B,[RELEAS]
+ XCT B
+ JRST 2(A)
+
+;WRITE OUT BUFFER OF OUTPUT FILE, C HAS <0 CHNL,HEADER>
+OBUFO: AND C,[0 17,] ;GET JUST CHNL NUM.
+ TLO C,(OUT)
+ XCT C
+ RET
+ SAVE A ;ERROR RETURN FROM OUT UUO.
+ XOR C,[OUT#<GETSTS A>]
+ XCT C ;READ FILE STATUS.
+ TRZ A,74^4 ;CLEAR ERROR BITS.
+ ETR [ASCIZ /Output data error/]
+ XOR C,[<GETSTS A>#<SETSTS (A)>]
+ XCT C
+ JRST POPAJ
+\f
+TFEED: RET
+
+TSRETN: MOVE C,[SIXBIT /MIDAS/]
+ SKIPE MORJCL
+ JRST RFDRUN
+ EXIT
+
+A.SITE:
+IFE SAILSW,[
+ CALL AGETFD ;.SITE ON DEC SYSTEM; VALUE HAS BEEN PRECOMPUTED NTO V.SITE.
+ CAIL A,
+ CAIL A,5
+ JRST CABPOP
+ MOVE A,V.SITE(A)
+ JRST CLBPOP
+];END IFE SAILSW
+.ELSE JRST CABPOP ;SAIL DOESN'T HAVE GETTAB USED IN SETTING UP V.SITE.
+
+;DEVICE NAME IN B, MODE IN A,
+;HEADER ADDR IN C, BUFFER SPACE ADDR IN D,
+;CREAT DEC-STYLE BUFFER RING LEAVING 1 WD BETWEEN BUFFERS.
+BUFINI: MOVEI AA,A
+IFE SAILSW,DEVSIZ AA,
+ SKIPA AA,[204] ;DEFAULT BUFFER SIZE IS THAT FOR DSK.
+ AOJLE AA,.-1 ;GET SIZE INCLUDING EXTRA WD.
+ MOVEI T,1(D) ;ADDR OF WD 2 OF 1ST BUFFER.
+ HRLI AA,T ;@AA IS ADDR OF 2ND WD OF NEXT BUFFER.
+ SUBI D,(AA) ;FACILITATE TEST FOR END OF BUFFER SPACE.
+ HRLI T,400000
+ MOVEM T,(C) ;HEADER -> A BUFFER, SIGN SET.
+ HRRM T,1(C) ;MAKE RH OF BP -> BUFFER 1ST WD.
+ MOVSI T,440000 ;SET UP P-FIELD OF B.P.
+ IORM T,1(C)
+ HRRZ T,1(C)
+ AOS 1(C)
+ HRLI T,-3(AA) ;DATA-AREA-SIZE +1,,ADDR-OF-2ND-WD
+BUFIN1: CAIGE D,-410(T) ;ROOM FOR ANOTHER AFTER THIS BUFFER?
+ JRST BUFIN2 ;NO, ASSUMING 410 WDS BUFFERRrSPACE.
+ MOVEM T,@AA ;YES, MAKE NEXT BUFFER -> THIS ONE,
+ HRRI T,@AA ;POINT TO NEXT ONE.
+ JRST BUFIN1
+
+BUFIN2: ADDI D,1(AA) ;-> 2ND WD OF 1ST BUFFER.
+ MOVEM T,(D) ;1ST BUFFER -> LAST, MAKING RING.
+ RET
+
+;CLOSE ALL INPUT CHANNELS - EQUIVALENT TO ITS .IOPDL.
+$IOPDL: MOVEI A,UTYIC
+ EXCH A,UTICHN ;SET INPUT CHNL NUM. TO LOWEST.
+ LSH A,27
+ IOR A,[RELEAS] ;SET UP TO RELEAS THE HIGHEST IN USE FIRST.
+IOPDL1: XCT A ;RELEAS ONE INPUT CHANNEL,
+ CAMN A,[RELEAS UTYIC,]
+ RET ;ALL DONE.
+ SUB A,[0 1,]
+ JRST IOPDL1 ;RELEAS THE NEXT ONE DOWN.
+
+.IOPDL==CALL $IOPDL
+] ;END IFNN DECSW,
+\f
+ ;TS INPUT ROUTINES
+
+ ;OPEN MAIN INPUT FILE FOR READING
+
+OPNRD: .IOPDL ;RE-INITIALIZE IO PDL
+ INSIRP SETZM,INFCNT INFCUR INFERR
+ MOVE A,[-TYPDLS-1,,TTYPDL]
+ MOVEM A,ITTYP ;INITIALIZE "TTY PDL"
+ PUSHJ P,MACIN1 ;CLOBBER MACRO EXPANSION STATUS
+ MOVS A,IFDS ;GET DEVICE NAME
+ CAIN A,(SIXBIT /TTY/) ;TTY?
+ JRST OPNRDT ;YES, TREAT SPECIAL
+ MOVSI A,IFDS ;NOT TTY, TRY OPENING FILE
+ PUSHJ P,A.IMP1 ;SET UP DNAM, ETC.
+ PUSHJ P,OPNRD1 ;TRY OPENING FILE
+ JRST OPNRDL ;LOSE
+ MOVEM A,INFERR ;ERR MSG IN MAIN FILE SHOULDN'T TYPE NAMES.
+ MOVEI A,0 ;=> INPUT FROM FILE
+OPNRT2: MOVE T,[IFNM1,,RFNAM1]
+ BLT T,RFNAM2 ;SET UP .FNAM1, .FNAM2
+ SETOM NEDCRL
+ JRST RCHSET ;SET UP TO READ FROM FILE OR TTY. (ARG IN A)
+
+OPNRDT: MOVE A,[IFDS+1,,IFNM1] ;TTY SPECIFIED, TREAT SPECIAL
+ BLT A,IFNM2 ;CLOBBER .IFNM1, .IFNM2 TO SPECIFIED
+ TYPR [ASCIZ /Reading from TTY:
+/]
+ MOVEI A,3 ;=> INPUT FROM TTY, DON'T QUIT ON CR
+ JRST OPNRT2
+
+OPNRDL: PUSHJ P,IOPNER ;.OPEN LOST, TYPE OUT MESSAGE
+ JRST GO2A ;READ NEW COMMAND
+
+
+;COMMON STUFF FOR OPNRD1 IN DEC AND ITS VERSIONS.
+OPNRD3: HRRZM A,UTIBED ;SAY BUFFER EMPTY,
+ MOVSI A,^C_13
+ MOVEM A,@UTIBED ;CAUSE IMMEDIATE RELOAD.
+ MOVE A,[INFDEV+1,,IFNM1]
+ BLT A,IFNM2 ;SET UP .IFNM1, .IFNM2.
+ AOS A,INFCNT ;ASSIGN THIS FILE A NUMBER.
+ MOVEM A,INFCUR ;OPNRD EXPECTS THIS LEFT IN A.
+ JRST POPJ1
+
+ ;EOF WHILE TRYING TO READ CHARACTER
+
+RPAEOF: PUSH P,B ;SAVE B
+RPAEO1: MOVE B,ITTYP ;GET PDL POINTER
+ PUSHJ P,BPOPJ ;CALL POP ROUTINE (MAYBE NED'S OUT)
+ JRST RCHTRB ;RETURN TO GET CHARACTER
+
+ ;EOF FROM MAIN FILE
+
+NEDCHK: TRNE FF,FRCMND ;^C READ IN COMMANND, :KILL SELF.
+ JRST TSRETN
+ SKIPE RCHMOD
+ JRST NEDCH1
+ AOSN NEDCRL ;INVENT ONE CRLF AFTER END OF MAIN FILE.
+ JRST [ MOVE B,[440700,,[.BYTE 7 ? ^M ? ^J ? ^C]]
+ MOVEM B,UREDP
+ RET]
+NEDCH1:
+IFN A1PSW,[ PUSHJ P,OUTCHK
+ MOVSI A,-LNEDT
+ XCT NEDT(A) ;SKIPS IF NED CONDITION TO BE COMPLAINED ABOUT
+ AOBJN A,.-1
+ JUMPGE A,GO4
+]
+ ETF [ASCIZ /No END statement/]
+
+IFN A1PSW,[ ;HOLLER "NED" IF ANY OF THE FOLLOWING:
+NEDT: SKIPL PRGC ;NO END STATEMENTS HAVE BEEN ENCOUNTERED
+ SKIPGE OUTC ;OUTPUT HAS OCCURED NOT MATCHED BY AN END STATEMENT
+ SKIPGE OUTN1 ;OUTPUT HAS OCCURED OTHER THAN IN 1PASS MODE
+ TRNN FF,FRPSS2 ;CURRENTLY IN PASS 2
+LNEDT==.-NEDT ;LENGTH OF TABLE
+]
+\f
+IFN ITSSW,[
+ ;TRY .OPENING INPUT FILE (DESCRIPTION IN DNAM, ETC.) SKIPS IF SUCCESSFUL
+
+OPNRD1: MOVE A,[2,,UTYIC] ;MODE,,CHANNEL.
+ .CALL OPENB
+ JRST OPNRD2 ;CAN'T OPEN INPUT FILE.
+ MOVE AA,[UTYIC,,A]
+ .RCHST AA,
+ SKIPN B ;GET SYSTEM FILE NAME 1
+ MOVE B,FNAM1 ;SYSTEM DOESN'T KNOW, USE SPEC'D.
+ SKIPN C ;NOW SAME FOR FN2.
+ MOVE C,FNAM2
+ MOVE AA,[A,,INFDEV]
+ BLT AA,INFDEV+3 ;REMEMBER NAMES OF CURRENT INPUT FILE.
+ HRLZS INFDEV ;MAKE THE DEV NAME BE LEFT-JUST.
+ MOVE A,IUREDP ;SET UP READING PTR,
+ MOVEM A,UREDP
+ JRST OPNRD3 ;SET UP ^C AFTER BUFFER, INFCUR, ETC.
+
+OPNRD2: .STATUS UTYIC,IFSTS ;.OPEN LOST, GET CHANNEL STATUS NOW BEFORE POSSIBLE .IOPOP
+ POPJ P,
+
+OPENB: SETZ ? SIXBIT/OPEN/
+ A ;SHOULD HOLD MODE,,CHANNEL.
+ DNAM ? DNAM+1 ? DNAM+2 ? SETZ SNAM
+
+IUREDP: 440700,,UTIBUF
+
+ ;EOFCH ENCOUNTERED ON READ, RELOAD AND JUMP BACK FOR NEXT CHAR
+
+INCHR3: HRRZ A,UREDP ;GET BYTE POINTER
+ CAME A,UTIBED ;END OF COMPLETELY READ BLOCK?
+ JRST RPAEOF ;NO => REALLY EOF
+ MOVE A,IUREDP
+ MOVEM A,UREDP
+ MOVE A,[-UTIBFL,,UTIBUF]
+ .IOT UTYIC,A ;READ IN BLOCK
+ TLZ A,377777 ;CLEAR OUT @, INDEX FIELDS, ALSO ALL BUT SIGN JUST FOR LAUGHS
+ MOVEM A,UTIBED ;STORE RH (UPDATED POINTER) FOR EOF CHECK AT INCHR3
+ MOVSI A,EOFCH_<18.-7>
+ MOVEM A,@UTIBED ;STORE EOF WORD
+ JRST RCHTRA ;NOW TRY NEXT CHAR
+] ;END IFN ITSSW
+\f
+IFN DECSW,[
+OPNRD1: MOVEI C,UTIHDR ;OPEN THE INPUT FILE W/ NAMES IN DNAM ... SNAM.
+ SETZ A, ;MODE ASCII.
+ MOVEI D,UTIBUF
+ MOVE TT,UTICHN ;GET CHANNEL NUM. TO USE.
+ LSH TT,27 ;PUT IN AC FIELD.
+ CALL OPNRD2 ;DO OPEN.
+ RET ;FAILED.
+ CALL BUFINI ;INITIALIZE THE INPUT BUFFERS AND HEADER.
+ MOVE D,SNAM
+ MOVE A,FNAM1
+ HLLZ B,FNAM2
+ TLC TT,(OPEN#LOOKUP)
+ XCT TT ;LOOKUP CHANNEL,A
+ RET ;FAILED.
+IFE SAILSW,[
+ MOVE A,DNAM
+ DEVNAM A, ;GET REAL NAME OF DEVICE.
+ CAIA
+ MOVEM A,DNAM
+]
+ MOVE A,[DNAM,,INFDEV]
+ BLT A,INFDEV+3
+ MOVE A,UREDP
+ JRST OPNRD3
+
+;TAKE C -> HEADER, D -> BUFFER SPACE, A HAS MODE, TT HAS CHNL IN AC FLD.
+;OPEN FILE IN DNAM ... SNAM, INIT BUFFERS,
+;THEN SET UP FOR LOOKUP OR ENTER.
+;SKIP IF SUCCEED.
+OPNRD2: IOR TT,[OPEN A]
+ MOVE B,DNAM
+ XCT TT ;OPEN CHANNEL,A
+ RET
+ JRST POPJ1
+
+;RELOAD BUFFER, DEC STYLE.
+INCHR3: HRRZ A,UREDP ;EOF AT END OF BUFFER?
+ CAME A,UTIBED
+ JRST RPAEOF ;NO, EOF, ^C IN FILE.
+ SAVE B
+ MOVE A,UTICHN
+ LSH A,27 ;CHANNEL NUM. N AC FLD.
+ TLO A,(IN)
+ XCT A ;GET NEXT BUFFERFULL.
+ CAIA ;SUCCEED.
+ JRST INCHR4 ;ERROR.
+INCHR5: MOVE A,UTICNT
+ ADDI A,9
+ IDIVI A,5
+ ADD A,UREDP ;-> 1ST WD NOT READ INTO.
+ HRRZM A,UTIBED
+ HRRZ A,UREDP
+ AOS A
+ MOVEI B,1 ;SCAN THE FILE AND REPLACE ALL LINE NUMBERS WITH NULLS.
+INCHR6: CAMN A,UTIBED
+ JRST INCHR7
+ TDNE B,(A)
+ MOVEM B,(A)
+ AOJA A,INCHR6
+
+INCHR7: MOVSI B,^C_13
+ MOVEM B,(A) ;PUT EOF CHAR AFTER BUFFER.
+ JRST RCHTRB ;RETRY RCH.
+
+INCHR4: XOR A,[<GETSTS B>#IN]
+ XCT A
+ TRZE B,74^4
+ ETR [ASCIZ /Input data error/]
+ XOR A,[<GETSTS B>#<SETSTS (B)>]
+ XCT A ;CLEAR ERROR BITS IN STATUS.
+ TRNN B,2^4
+ JRST INCHR5
+ JRST RPAEO1 ;EOF.
+] ;END IFN DECSW,
+\f
+ ;IO PDL ROUTINES FOR INPUT FILE
+ ;PUSH THE INPUT FILE
+
+IPUSH: AOSN CMEOF ;WANT TO POP OUT OF TTY? (^C TYPED IN)
+ CALL POPTT ;YES, DO NOW BEFORE FORGET.
+ MOVE D,UREDP ;GET INPUT BYTE POINTER
+IFN ITSSW,[
+ .IOPUS UTYIC,
+ TLNN D,760000 ;AT END OF WORD?
+ ADD D,[430000,,1] ;YES, MAKE IT POINT TO BEGINNING OF NEXT WORD
+ MOVEM D,UREDP
+ MOVNI A,-2(D)
+ ADD A,UTIBED ;GET # WDS WE'LL NEED IN MACTAB.
+ HLR D,UTIBED ;REMEMBER WHETHER EOF ON LAST .IOT.
+ HRRZS UTIBED ;NOW CLEAR OUT LEFT HALF FOR FOLLOWING
+]
+IFN DECSW,[
+ AOS A,UTICHN ;DO ".IOPUSH" - USE NEXT CHANNEL.
+ LSH A,27
+ ADD A,[WAIT-<0 1,>]
+ XCT A ;DON'T MOVE BUFFERS WHILE IO GOING ON!
+ MOVEI A,UTIBFL+2 ;ASSUME MUST SAVE ALL BUFFER SPACE.
+]
+ SAVE A
+ ADD A,FREPTB
+ ANDI A,-1
+ CAML A,MACTND ;NO ROOM IN MACTAB => GC IT.
+ CALL GCA1
+ MOVEI A,370
+ CALL PUTREL ;INDICATE START OF SAVED BUFFER.
+ REST A
+ AOS B,FREPTB
+ SUBI A,1
+ MOVE C,ITTYP ;GET ADDR OF TTY PDL WD THAT'LL POINT TO SAVED BUFFER.
+ ADDI C,1
+ HRRZM C,(B) ;STORE IN RH OF 1ST WD,
+ MOVEI C,(B) ;REMEMBER ADDR OF SAVED BUFFER TO PUSH ON TTYPDL.
+ HRLM A,(B) ;PUT LENGTH IN LH.
+ AOS B
+IFN ITSSW,HRL B,UREDP ;ILH _ ADDR OF 1ST WD TO SAVE.
+IFN DECSW,HRLI B,UTIBUF
+ ADDI A,-2(B) ;ADDR OF LAST WD TO BLT INTO.
+ BLT B,(A)
+ HRLI A,041000
+ MOVEM A,FREPTB ;MAKE FREE BP -> LAST BYTE JUST USED.
+ SUB A,MACTAD
+ ANDI A,-1
+ LSH A,2
+ ADDI A,4 ;GET CHAR ADDR OF NEXT FREE BYTE.
+ MOVEM A,FREEPT
+ MOVE B,ITTYP ;GET LOCAL VERSION OF IOPDL
+IPSHP: PUSH B,C ;PUSH -> SAVED BUFFER (GC WILL RELOCATE)
+IFN DECSW,PUSH B,UTIBED
+IFN DECSW,PUSH B,UTIHDR
+REPEAT 4,PUSH B,INFDEV+.RPCNT ;SAVE NAMES OF INPUT FILE.
+ PUSH B,INFCUR ;SAVE NUMBER OF INPUT FILE.
+ PUSH B,D ;LH=LH(OLD UREDP), RH=LH(OLD UTIBED)
+ ;FOLLOWING TWO MUST BE LAST PUSHED
+ INSIRP PUSH B,[IFNM1 IFNM2] ;CLOBBERED ON PDL IF .OPEN SUCCESSFUL
+INPDEL==.-IPSHP ;LENGTH OF EACH ENTRY ON PDL
+ MOVE A,FREEPT ;W MUST USE SAME GC CONVENTION AS PUTREL;
+ CAML A,MACHI ;NAMELY, GC AFTER USING UP THE LAST BYTE.
+ CALL GCA1
+ MOVEI A,0 ;=> INPUT FROM FILE
+ MOVEM B,ITTYP ;STORE BACK UPDATED POINTER
+ JSP B,PUSHTT ;SAVE STUFF, ADDRESS MODIFY AND RETURN
+ ;POP INTO THE INPUT FILE
+IPOP:
+IFN CREFSW,[ MOVEI A,2 ;IF CREFFING, OUTPUT POP-FILE BLOCK.
+ SKIPE CRFONP
+ PUSHJ P,CRFOUT]
+IPOPL: PUSHJ P,POPTT ;COME HERE IF .INSRT'S OPEN FAILED.
+ SAVE C
+ MOVE B,ITTYP ;GET POINTER
+ INSIRP POP B,[IFNM2 IFNM1 A] ;POP STUFF
+ POP B,INFCUR
+REPEAT 4,POP B,INFDEV+3-.RPCNT
+IFN DECSW,[
+ POP B,C
+ SAVE C ;OLD UTIHDR
+ POP B,UTIBED
+]
+ POP B,C
+ MOVEM B,ITTYP ;SAVED UPDATED PDL POINTERR.
+ HLRZ B,(C) ;GET LENGTH OF SAVED BUFFER,
+IFN ITSSW,[
+ SAVE A
+ CALL SETWH2
+ REST A
+ .IOPOP UTYIC,
+ MOVEI AA,UTIBUF-1(B) ;GET ADDR OF 1ST WD WON'T BLT INTO IN UTIBUF,
+ HRLI AA,(A) ;GET SAVED LH OF UTIBED,
+ MOVEM AA,UTIBED
+ HRRI A,UTIBUF ;MAKE A -> 1ST WD IN BUFFER,
+]
+IFN DECSW,[
+ MOVE AA,UTICHN
+ LSH AA,27
+ IOR AA,[RELEAS]
+ XCT AA ;THIS CODE EQUIVALENT TO .IOPOP.
+ SOS UTICHN
+ REST UTIHDR
+]
+ MOVEM A,UREDP
+ MOVSI A,^C_13
+ MOVEM A,@UTIBED ;PUT EOF CHAR AFTER BUFFER.
+ MOVSI A,1(C) ;GET ADDR OF 1ST DATA WD OF SAVED BUFFER,
+ HRRI A,UTIBUF
+ CAIE B,1
+ BLT A,UTIBUF-2(B)
+ HLLZS (C) ;TELL GC TO RECLAIM SAVED BUFFER.
+POPCJ: REST C
+ RET
+\f
+ ;SAVE INTERNAL POINTERS CONCERNING INPUT MODE
+
+TYPDEL==2 ;NUMBER OF WORDS IN RELEVANT PDL ENTRY
+
+PUSHTT: PUSH P,A
+ PUSH P,F
+ AOSN CMEOF ;IF SUPPOSED TO POP OUT OF TTY SOON,
+ CALL POPTT ;DO IT NOW BEFORE CMEOF CLOBBERED.
+ MOVE F,ITTYP ;GET RELEVANT PDL POINTER
+ MOVEI A,0
+ EXCH A,CLNN ;SET UP NEW LINE NUMBER
+ HRL A,CPGN ;SAVE CURRENT PAGE NUMBER
+ SETZM CPGN ;NOW RE-INITIALIZE
+ SKIPGE CRFILE ;SAVE CREF-ALL-ON-ONE-LINE FLAG.
+ TLO A,400000
+ PUSH F,A ;SAVE CPGN,,CLNN
+ MOVE A,-1(P) ;RETRIEVE NEW MODE
+ PUSHJ P,PSHLMB ;SAVE LIMBO1 AND SET UP INSTRUCTIONS FOR NEW MODE
+IFN ITSSW,[
+ CALL SETWH2
+ .SUSET [.SWHO3,,A]
+]
+ MOVEM F,ITTYP ;STORE BACK UPDATED POINTER
+ JRST POPFAJ
+
+ ;RESTORE INTERNAL POINTERS CONCERNING INPUT MODE
+
+POPTT: PUSH P,A
+ PUSH P,F
+ MOVE F,ITTYP ;GET PDL POINTER
+ PUSHJ P,POPLMB ;POP INTO LIMBO1, SET UP NEW MODE
+ POP F,A ;GET CPGN,,CLNN
+ SETZM CRFILE ;RESTORE ALL-ON-ONE-LINE FLAG.
+ TLZE A,400000
+ SETOM CRFILE
+ HLRZM A,CPGN
+ HRRZM A,CLNN
+IFN ITSSW,[
+ CALL SETWH2
+ ADD A,CPGN
+ .SUSET [.SWHO3,,A]
+]
+ MOVEM F,ITTYP ;STORE BACK UPDATED POINTER
+ JRST POPFAJ
+
+IFN ITSSW,[
+SETWH2: MOVE A,RCHMOD
+ CAIL A,2
+ SKIPA A,[SIXBIT /TTY:/]
+ MOVE A,INFFN1
+ .SUSET [.SWHO2,,A]
+ MOVE A,A.PASS
+ LSH A,30
+ ADD A,[SIXBIT /P0/+1]
+ RET
+]
+\f
+ ;TTY ROUTINES
+
+ ;CAUSE INPUT FROM TTY (MAIN ROUTINES)
+
+GTYIPA: ;PUSH TO TTY, DON'T STO@ AT CR.
+ SETZM A.TTYF
+IFN ITSSW,[ TYPR [ASCIZ/TTY: .INSRTed, end input with ^C
+/] ]
+.ELSE [ IFE SAILSW,[ TYPR [ASCIZ/TTY: .INSRTed, end input with ^Z
+/] ]
+ .ELSE [ TYPR [ASCIZ /TTY: .INSRTed, end input with CTL-META-LF
+/] ]]
+GTYIP1: SKIPA A,[3]
+GTYIP: MOVEI A,2 ;INPUT FROM TTY, STOP AFTER 1 LINE.
+ SETZM CMPTR ;FORCE RELOAD ON 1ST READ.
+ JSP B,PUSHTT ;SET UP VARIABLES AND RETURN
+GTYIPR: SETZM CMPTR ;RETURN ON .INEOF OR CR
+ JRST POPTT
+
+;CALL HERE FROM ASSEM1 LOOP WHEN A ^H INTERRUPT IS DETECTED.
+TTYBRK: SETZM A.TTYF
+ ETR [ASCIZ/^H - break /] ;TYPE FILENAME, PAGE AND LINE #.
+ SKIPE ASMOUT
+ TYPR [ASCIZ/within a <>, () or []
+/]
+ JRST GTYIPA
+
+ ;RCHSET ROUTINES FOR READING FROM TTY
+ ;RCHMOD=3 => DON'T QUIT ON CR
+ ;2 => QUIT ON CR.
+
+RCHTRC:
+RCHARC: TLO FF,FLTTY ;SET FLAG
+ JSP A,CPOPJ
+RCHAC1: REPEAT 2,[ ;RCH2, RR1
+ ILDB A,CMPTR ;GET CHAR
+ CAIN A,0 ;END OF STRING MARKED WITH 0
+ PUSHJ P,TYRLDR ;RELOAD, JUMP BACK FOR NEXT CHAR
+]
+ HALT ;RRL1
+IFN .-RCHAC1-RCHPSN,.ERR RCHAC1 LOSES.
+ ILDB A,CMPTR ;SEMIC
+ CAIN A,15
+ JRST SEMICR
+ JUMPN A,SEMIC
+ PUSHJ P,TYRLD
+ JRST SEMIC
+\f
+TYRLD: MOVEI A,3 ;RETURN AFTER THE CALL, NOT BEFORE.
+ ADDM A,(P)
+
+ ;READ IN STRING
+
+;RELOAD BUFFER IF RAN OUT IN CALL TO RCH.
+TYRLDR: AOSN CMEOF ;EOF DETECTED AFTER LAST RELOAD =>
+ JRST RPAEOF ;POP OUT OF TTY.
+ SAVE A
+ SAVE B
+ MOVE B,RCHMOD
+ PUSH P,F
+ SAVE A.TTYF ;IF CHARS RUBBED OUT THEY SHOULD BE PRINTED.
+ SETZM A.TTYF
+ MOVE F,[10700,,CMBUF-1] ;INITIAL BYTE POINTER TO BUFFER
+ MOVEM F,CMPTR ;STORE AS BYTE POINTER FOR READ
+TYRLD2: PUSHJ P,TYI ;GET CHARACTER
+ CAIN A,177 ;RUBOUT?
+ JRST TYRLD3 ;YES
+ CAIE A,^C
+ CAIN A,^Z
+ JRST TYRLD7 ;^C, ^Z => EOF.
+ CAIN A,^U
+ JRST TYRLD5 ;RUB OUT ALL
+ CAIE B,2 ;FOR .TTYMAC HANDLING, CONVERT LOWER CASE TO UPPER.
+ JRST TYRLD6
+ CAIL A,"A+40
+ CAILE A,"Z+40
+ CAIA
+ SUBI A,40
+TYRLD6: IDPB A,F ;STORE CHARACTER IN BUFFER
+ CAIE A,^M ;CR?
+ JRST TYRLD2 ;NO, GO BACK FOR NEXT
+ CAIN B,2 ;.TTYMAC (MODE 2) => CR ENDS INPUT, SO FAKE EOF.
+ SETOM CMEOF
+ MOVEI A,^J ;FOLLOW THE CR WITH A LF.
+ IDPB A,F
+ SAVE F ;OUTPUT THE ENTIRE LINE TO THE ERROR FILE
+ MOVE F,[10700,,CMBUF-1]
+TYRLD8: CAMN F,(P)
+ JRST TYRLD9
+ ILDB A,F
+ CAIN A,^M ;IF LINE WAS ENDED BY A ^C OR ^Z, PUT THAT IN ERROR
+ SKIPL CMEOF ;FILE, WHICH NEEDS HAIR SINCE THAT CHAR IS NOT
+ JRST TYRLD0 ;IN THE STRING WE STORED.
+ MOVEI A,"^
+ CALL ERRCHR
+ MOVEI A,IFN DECSW,["Z] .ELSE "C
+ CALL ERRCHR
+ LDB A,F
+TYRLD0: CALL ERRCHR
+ JRST TYRLD8
+
+TYRLD9: REST F
+ MOVEI A,0
+ IDPB A,F ;MARK END OF STRING
+ IDPB A,F
+ REST A.TTYF
+ REST F
+ REST B
+ REST A
+ JRST RCHTRA
+
+TYRLD7: SETOM CMEOF ;^C, ^Z FORCE EOF,
+ CALL TYRLCR ;AFTER TURNING INTO ^M.
+ MOVEI A,^M
+ JRST TYRLD6
+
+TYRLCR: MOVEI A,^M
+ CALL TYOX
+ MOVEI A,^J
+ JRST TYOX
+
+TYRLD3: CAMN F,[10700,,CMBUF-1] ;RUBOUT, BEGINNING OF BUFFER?
+ JRST TYRLD4 ;YES
+ LDB A,F ;GET LAST CHARACTER IN BUFFER
+ CALL TYOX ;TYPE IT OUT, DON'T WRITE IN ERROR FILE.
+ ADD F,[70000,,] ;DECREMENT POINTER
+ JUMPGE F,TYRLD2 ;JUMP IF VALID
+ SUB F,[430000,,1] ;WAS 440700,,SOMETHING, BACK IT UP
+ JRST TYRLD2
+
+TYRLD5: MOVE F,[10700,,CMBUF-1] ;^U, BACK TO BEGINNING OF LINE
+TYRLD4: PUSHJ P,TYRLCR ;RUBOUT WHEN AT BEGINNING OF BUFFER, TYPE CR
+ JRST TYRLD2
+\f
+IFN ITSSW,[ ;GET (JUST TYPED IN) CHAR IN A
+OUTCHR==.IOT TYOC,
+
+TYI: SKIPN TTYOP
+ CALL TTYINI ;OPEN THE TTY IF NOT ALREADY DONE.
+ .IOT TYIC,A
+ JUMPE A,TYI
+ CAIN A,^L
+ JRST TYI
+ POPJ P,
+
+ ;INITIALIZE TTY
+
+TTYINI: SAVE A
+ .OPEN TYIC,[SIXBIT / TTYMIDAS TYI/] ;INPUT, CONVERT LOWER CASE TO UPPER
+ .LOSE
+ .OPEN TYOC,[21,,SIXBIT / TTYMIDAS TYO/] ;DISPLAY MODE OUTPUT
+ .LOSE
+ SYSCAL CNSGET,[1000,,TYOC ? 2000,,A ? 2000,,A]
+ MOVSI A,1 ;TTY: IS TRANSLATED TO SOMETHING ELSE => ASSUME INFINITE LINEL
+ MOVEM A,LINEL ;ELSE LINEL GETS WIDTH OF TTY.
+ SETOM TTYOP ;SAY THE TTY IS NOW OPEN.
+ JRST POPAJ
+
+JCLINI: .SUSET [.ROPTIO,,A]
+ TLNN A,40000 ;HAS OUR SUPERIUOR SAID IT HAS A CMD?
+ RET ;NO.
+ MOVE A,[CMBUF,,CMBUF+1]
+ BLT A,CMBUF+CMBFL-2 ;ZERO ALL BUT LAST WD,
+ MOVEM A,CMBUF+CMBFL-1 ;NONZERO LAST WD.
+ .BREAK 12,[5,,CMBUF] ;TRY TO READ COMMAND STRING.
+ MOVE A,[440700,,CMBUF]
+ SKIPE CMBUF ;IF READ A CMD-STRING,
+ MOVEM A,CMPTR ;TELL TYRLD, GO2 IT'S THERE.
+ POPJ P,
+
+;JRST HERE FROM TSINT FOR 2ND WD INTERRUPTS.
+TTYINT: SAVE A
+ MOVEI A,TYIC ;THE TTY CHNL IS THE ONLY ONE ENABLED.
+ .ITYIC A,
+ JRST TTYINX ;NO INT. CHAR.
+ CAIN A,^W
+ AOS A,TTYFLG ;^W SILENCES,
+ CAIN A,^V
+ SOS A,TTYFLG ;^V UNSILENCES,
+ CAIN A,^H
+ SETOM TTYBRF ;^H SAYS BREAK NEXT TIME THRU ASSEM1 LOOP.
+TTYINX: REST A
+ .DISMIS .JBTPC
+] ;END IFN ITSSW
+\f
+IFN DECSW,[
+TYI: SKIPN TTYOP ;OPEN THE TTY, IF NOT ALREADY DONE.
+ CALL TTYINI
+ INCHWL A
+IFN SAILSW,[
+ CAIN A,612 ;SAIL => EOF IS 612. SO TURN INTO NORMAL EOF.
+ MOVEI A,^Z
+]
+ CAIE A,^M ;THROW AWAY THE LF AFTER A CR
+ RET
+ INCHWL A
+ MOVEI A,^M ;NOTE THAT TYRLDR WILL PUT IT BACK IN.
+ RET
+
+TTYINI: OPEN TTYINB
+ JRST TTYINI
+ INSIRP PUSH P,AA A B
+IFE SAILSW,[
+ PJOB A,
+ TRMNO. A,
+ JRST TTYIN1
+ MOVEI AA,1012 ;.TOWID
+ MOVE B,[2,,AA]
+ TRMOP. B, ;READ WIDTH OF TTY LINE INTO B.
+]
+TTYIN1: MOVEI B,80. ;TRMOP. FAILED OR NOT TRIED => ASSUME WIDTH IS 80.
+ MOVEM B,LINEL
+ INSIRP POP P,B A AA
+ SETOM TTYOP
+ RET
+
+TTYINB: 1
+ 'TTY,,
+ 0
+
+TTYREN: IFE SAILSW,LOC .JBREN
+.ELSE LOC JOBREN
+TTYREN
+LOC TTYREN
+ SETOM TTYBRF ;"REENTER" COMMAND COMES HERE
+R: G: IFE SAILSW,JRST @.JBOPC ;TO REQUEST A ^H-BREAK.
+.ELSE JRST @JOBOPC
+]
+
+TAB: MOVEI A,^I
+TYO: SKIPG A.TTYF
+ CALL TYOX
+ERRCHR: IFN ERRSW,[
+ SKIPN ERRFOP ;OUTPUT CHAR IN A TO ERROR FILE IF ONE IS OPEN.
+ RET
+ SOSGE ERRCNT
+ JRST ERRCH1 ;OUTPUT BUFFER.
+ IDPB A,ERRPNT
+ RET
+
+ERRCH1: SAVE C
+ MOVE C,[0 ERRFC,ERRHDR]
+ CALL OBUFO
+ REST C
+ JRST ERRCHR
+]IFE ERRSW,RET
+
+TYOX: SKIPN TTYOP
+ CALL TTYINI
+ OUTCHR A
+ RET
+\f
+IFN DECSW,[
+
+JCLINI: SKIPN CCLFLG ; WAS MIDAS CALLED FROM CCL LEVEL?
+ RET ; NO, DO NOT SNARF TEMPCORE
+ SETZM CCLFLG ; IF TMPCOR LOSES WANT THIS 0 (WILL RE-SETOM BELOW)
+ SETZM CMBUF ; ZERO FIRST COMMAND WORD
+ MOVE A,[CMBUF,,CMBUF+1] ; LOAD BLT POINTER
+ BLT A,CMBUF+CMBFL-2 ; ZERO ALL BUT LAST WORD
+ MOVEM A,CMBUF+CMBFL-1 ; NON-ZERO LAST WORD
+ MOVE A,[2,,['MID,, ? -CMBFL,,CMBUF-1]]
+ TMPCOR A, ; READ COMPIL-GENERATED COMMAND
+ RET ; NO COMMAND, PUNT
+ MOVE A,[440700,,CMBUF] ; LOAD A BYTE POINTER TO THE COMMAND
+ SKIPN CMBUF ; ONE LAST CHECK FOR IT TO BE THERE
+ RET ; ALAS, THERE IS NONE
+ SETOM CCLFLG
+ MOVEM A,CMPTR ; THERE IS, SET COMMAND POINTER
+ SAVE B
+JCLIN1: ILDB B,A
+ CAIE B,^J ;SEE IF OUR COMMAND FILE HAS ANYTHING AFTER 1ST LINE.
+ JRST JCLIN1
+ ILDB B,A
+ JUMPE B,POPBJ
+ SETOM MORJCL ;IT DOES; SET FLAG SO AFTER HANDLING 1ST LINE WE'LL
+ SAVE C
+ MOVE C,[440700,,UTIBUF+2]
+JCLIN2: IDPB B,C
+ ILDB B,A
+ JUMPN B,JCLIN2
+ SUBI C,UTIBUF+1 ;GET # WORDS WRITTEN IN UTIBUF. OPERAND IS RELOCATABLE!
+ HRLOI C,-1(C) ;THESE 2 INSNS TURN SIZE INTO -SIZE,,UTIBUF+1
+ EQVI C,UTIBUF+1
+ MOVEM C,(C)
+ MOVSI C,'MID
+ MOVEM C,UTIBUF
+ MOVE C,[3,,UTIBUF]
+ TMPCOR C,
+ JFCL
+ REST C
+ REST B
+ RET
+];END IFN DECSW
+\f
+ ;TS DATA STORAGE
+
+VBLK
+
+TYPDLS==TYPDLC*TYPDEL+INPDEL*MX.INS
+ ;"TTY PDL", STORES INFORMATION ABOUT CURRENT INPUT MODE
+ ;(SIMILAR TO MACRO PDL BUT NOT GARBAGE COLLECTED)
+
+ITTYP: -TYPDLS-1,,TTYPDL ;PDL POINTER (TYPDEL=LENGTH OF EACH ENTRY)
+TTYPDL: NEDCHK ;ACTUAL PDL: INITIAL ENTRY TO OVERPOP ROUTINE
+ BLOCK TYPDLS ;PDL PROPER
+
+ ;INPUT BUFFER AND VARIABLES
+
+UTIBUF: BLOCK UTIBFL
+UTIHDR: 0 ;INPUT BUFFER HEADER (DEC VERSION)
+UREDP: 440700,,UTIBUF ;INPUT BYTE POINTER
+UTICNT: 0 ;INPUT BYTE COUNT (DEC VERSION)
+UTIBED: UTIBUF ;EOF COMPARISON WITH RH(UREDP), 4.9 => EOF ON .IOT
+IFSTS: 0 ;.STATUS WORD STORED BY OPNRD1 WHEN .OPEN LOSES
+IFN DECSW,UTICHN: UTYIC
+
+ ;FILE DESCRIPTION STORAGE
+
+INDDP: MAXIND,,FDSOFS ;POINTER INTO TABLE
+FDSBEG==. ;BEGINNING OF TABLE AREA
+DNAM: 0 ;DEVICE NAME
+FNAM1: 0 ;FILE NAME 1
+FNAM2: 0 ;" " 2
+SNAM: 0 ;SYSTEM NAME
+LFDSE==.-FDSBEG ;LENGTH OF TABLE ENTRY
+IFDS: BLOCK LFDSE ;SPECIFIED INPUT FILE
+ 0 ;FOR .FDELE AT .FILE TIME
+ONAM: BLOCK 3 ;OUTPUT DEVICE/FILENAMES SPECIFIED
+OFNM1==ONAM+1
+OFNM2==ONAM+2
+OSYSNM: -1 ;SPECIFIED OUTPUT SYSTEM NAME
+IFN CREFSW,[ 0
+CRFDEV: BLOCK 3 ;CREF DEV, FN1, FN2.
+CRFSNM: 0 ;CREF SNAME.
+]
+IFN ERRSW,ERRDEV: BLOCK 4 ;ERROR OUTPUT FILE NAMES.
+IFN LISTSW,[
+LSTDEV: BLOCK 3 ;LISTING FILE NAMES.
+LSTSNM: 0
+]
+FNMEND::
+INFDEV: 0
+INFFN1: BLOCK 3 ;FILENAMES OF INPUT FILE BEING READ NOW.
+INFCNT: 0 ;# INPUT FILE OPENED.
+INFCUR: 0 ;WHAT INFCNT WAS WHEN CURRENT FILE OPENED.
+INFERR: 0 ;WHAT INFCUR HELD AT LAST ERROR MSG.
+FDSOFS==.-FDSBEG ;OFFSET TO BEGINNING OF NON-DEDICATED AREA
+ BLOCK LFDSE*MAXIND ;OPEN NAMES @: FILES (AND FNF'S)
+SFSFDS=.-FDSOFS ;SOURCE SPECIFIED NAMES @: FILES
+ BLOCK LFDSE*MAXIND ;STORAGE FOR "
+
+RFNAM1: 0 ;.FNAM1
+RFNAM2: 0
+IFNM1: 0 ;.IFNM1
+IFNM2: 0
+RSYSNM: 0 ;INITIAL SYSTEM NAME
+
+IFN CMUSW, PPNBUF: BLOCK 4 ;FOR CONVERTING CMU PPNs
+
+IFN DECSW,IFE SAILSW, V.SITE: BLOCK 5 ;SYSTEM NAME IN SIXBIT, FOR .SITE.
+\f
+ ;TTY VARIABLES
+
+CMBUF: BLOCK CMBFL ;TYPEIN BUFFER
+CMPTR: 0 ;BYTE POINTER TO CMBUF, CLEARED AT GO2 IF >0.
+CMEOF: 0 ;-1 => POPTT INSTEAD RELOAD AFTER THIS BUFFERFULL.
+IFN DECSW,MORJCL: 0 ;-1 => THERE ARE MORE LINES OF CCL COMMANDS
+ ;SO DO A RUN SYS:MIDAS WHEN FINISHED.
+TTYOP: 0 ;-1 => THE TTY IS ALREADY OPEN.
+LINEL: 0 ;WIDTH OF TTY (MAY BE 1,, MEANING ASSUME INFINITE).
+A.TTYFLG: ;VALUE OF .TTYFLG:
+TTYFLG: 0 ;TTY TYPEOUT PERMITTED IFF >= 0.
+WSWCNT: 0 ;THE NUMBER OF W-SWITCHES IN THE LAST CMD STRING.
+TTYBRF: 0 ;-1 => ^H BREAK HAS BEEN REQUESTED BUT NOT DONE.
+FATAL: 0 ;AT END OF ASSEMBLY, NOT 0 IFF FATAL ERROR OCCURRED.
+NEDCRL: 0 ;-1 => HAVEN'T YET SUPPLIED A CRLF AT EOF OF MAIN FILE.
+NVRRUN: -1 ;0 => MIDAS WAS RUN; ERROR TO START OR PURIFY.
+
+ ;OPNER VARIABLES
+
+ERRDNM: (SIXBIT /ERR/)
+ 3
+ERRNM2: 0 ;.STATUS WORD
+
+IFN ITSSW,OCLOSP: @1(C) ;TURNED INTO BP TO UNUSED PART OF LAST BFFER WD USED.
+
+ ;OUTPUT VARIABLES
+
+UTOBUF: BLOCK UTOBFL ;OUTPUT BUFFER
+UTOHDR: UTOBFL,,UTOBUF-1
+UTYOP: 444400,, ;OUTPUT (36. BIT) BYTE POINTER
+UTYOCT: 0 ;# WORDS LEFT IN UTOBUF
+
+IFN CREFSW,[ ;CREF OUTPUT VARS.
+CRFBUF: BLOCK CRFBSZ
+CRFHDR: CRFBSZ,,CRFBUF-1 ;HEADER, ASSEMBLED VALUE USED ONLY IFN ITSSW
+CRFPTR: 444400,, ;BP FOR FILLING BUFFER
+CRFCNT: 0 ;NUM. CHARS. EMPTY IN BUFFER
+]
+
+IFN LISTSW,[
+LSTBUF: BLOCK LSTBSZ
+LSTHDR: 5*LSTBSZ,,LSTBUF-1
+LSTPTR: 440700,,
+LSTCNT: 0
+]
+
+IFN ERRSW,[
+ERRBUF: BLOCK ERRBSZ
+ERRHDR: 5*ERRBSZ,,ERRBUF-1
+ERRPNT: 440700,,
+ERRCNT: 0
+ERRFP: 0 ;NON-0 IF WANT ERROR OUTPUT FILE.
+ERRFOP: 0 ;NON-0 IF ERROR FILE OPEN (IE TRY OUTPUTTING TO IT)
+]
+PBLK
+\f
+ ;.INSRT FILEDESCRIPTION<CR>
+ ;INSERT FILE HERE
+ ;TTY: => OK, READS LINE AT A TIME, RUBOUT ALLOWED WITHIN LINE
+ ;PUSHES MACRO EXPANSION, OTHER .INSRT'S
+ ;IN FILEDESCRIPTION, ^R => RESET FILE NAME COUNTER
+
+A.INSR: NOVAL
+ MOVEI F,IFDS-DNAM ;SET UP POINTER TO INPUT FILE NAMES
+ PUSHJ P,A.IMAP ;DEFAULT NAMES = INPUT NAMES
+ MOVSI A,(SIXBIT /DSK/)
+ MOVS B,DNAM
+ CAIN B,(SIXBIT /TTY/) ;IF INPUTTING FROM TTY,
+ MOVEM A,DNAM ;THEN SET DEFAULT DEVICE TO DSK INSTEAD
+IFN ITSSW,MOVSI A,(SIXBIT/>/)
+IFN DECSW,MOVSI A,'MID
+ MOVEM A,FNAM2 ;USE > AS THE DEFAULT FN2.
+ TLO FF,FLUNRD
+A.IN1: PUSHJ P,RFD ;READ FILE DESCRIPTION
+ MOVS A,DNAM ;GET SPECIFIED DEVICE NAME
+ CAIE A,(SIXBIT /@/) ;ATSIGN?
+ PUSHJ P,A.ITRY ;NO, TRY OPENING FILE
+ MOVE A,DNAM(F)
+ AOJE A,A.INT1 ;ALREADY TRYING TO SET UP TABLE ENTRY
+ SKIPA F,[MAXIND,,FDSOFS] ;ATSIGN, OR FNF, SEARCH TABLE
+A.IN2: SUBI F,-LFDSE ;LOOP POINT SEARCHING TABLE, INCREMENT TO NEXT ENTRY, COUNT DOWN LH
+ CAMN F,INDDP ;COMPARE WITH POINTER TO TOP OF TABLE
+ JRST A.IN3 ;AGREE => THIS FILE NOT IN TABLE
+ MOVE A,F ;-> SFSFDS
+ MOVSI B,-LFDSE ;-> DNAM, LH FOR COUNT
+ MOVE T,SFSFDS(A) ;GET SPECIFICATION NAME THIS ENTRY
+ CAMN T,DNAM(B) ;COMPARE WITH THAT JUST SPECIFIED
+ AOBJN B,[AOJA A,.-2] ;CHECK ALL NAMES THIS ENTRY
+ JUMPL B,A.IN2 ;LOOP IF NAMES DON'T ALL AGREE
+ ;FILE IS IN TABLE
+ PUSHJ P,A.IMAP ;SET NEW FILE DESCRIPTION FROM THAT IN TABLE ENTRY
+ PUSHJ P,A.ITRY ;TRY OPENING FILE
+ MOVSI A,SFSFDS(F) ;SET UP LH(BLT POINTER),
+ PUSHJ P,A.IMP1 ;UNMAP TO ORIGINAL NAMES
+ PUSHJ P,TYPFIL ;TYPE OUT SPECIFIED NAMES
+ TYPR [ASCIZ / -> /] ;TYPE OUT POINTER
+ PUSHJ P,A.IMAP ;RE-MAP INTO TRANSLATION ENTRY IN TABLE
+ SETOM DNAM(F) ;"HALF-KILL" ENTRY
+A.INT1: PUSHJ P,IOPNR1 ;TYPE OUT ALL KINDS OF STUFF
+A.INT2: PUSHJ P,GTYIP ;PREPARE TO READ ONE LINE FROM TTY
+ JRST A.IN1 ;TRY AGAIN WITH WHAT HE TYPES IN
+
+ ;FILE NOT IN TABLE
+
+A.IN3: TLNN F,-1 ;MORE ROOM FOR ANOTHER ENTRY IN TABLE?
+ ETF [ASCIZ /Too many @: files/]
+ MOVEI A,SFSFDS(F)
+ HRLI A,DNAM
+ BLT A,SFSFDS+LFDSE-1(F) ;SET UP KEY OF NEW ENTRY
+ SETOM DNAM(F) ;DOCUMENT FACT THAT ENTRY HAS ONLY KEY, NOT TRANSLATION
+ MOVNI A,-LFDSE
+ ADDM A,INDDP ;UPDATE POINTER INTO TABLE
+ MOVS A,DNAM ;GET SPECIFIED DEVICE NAME
+ CAIE A,(SIXBIT /@/) ;ATSIGN?
+ JRST A.INT1 ;NO, TYPE OUT GARBAGE AND TRY AGAIN, READING FROM TTY
+ MOVE A,IFDS ;YES, CLOBBER FROM INPUT DEVICE NAME
+ MOVEM A,DNAM
+ JRST A.INT2
+\f
+ ;TRY OPENING INPUT FILE FOR .INSRT, RETURN IF UNSUCCESSFUL
+
+A.ITRY: MOVS A,DNAM ;GET SPECIFIED DEVICE NAME
+ CAIN A,(SIXBIT /TTY/) ;TTY?
+ JRST A.ITRT ;YES, TREAT SPECIAL
+ TLO FF,FLUNRD
+ PUSHJ P,IPUSH ;SAVE CURRENT STATUS
+ PUSHJ P,OPNRD1 ;TRY OPENING FILE
+ JRST IPOPL ;LOSE, POP AND RETURN
+IFN ITSSW,CALL SETWH2
+ MOVE B,ITTYP
+ MOVEI A,-1-TYPDEL(B)
+ HRLI A,IFNM1
+ BLT A,-TYPDEL(B) ;INTRODUCE HYSTERESIS SO .INSRT'ING FILE CAN REFERENCE .IFNM1, .IFNM2
+IFN CREFSW,[
+ SKIPE CRFONP ;IF CREFFING, OUTPUT PUSH-FILE BLOCK.
+ PUSHJ P,CRFPSH ;(POP-FILE BLOCK OUTPUT AT IPOP)
+]
+A.ITR2:
+ MOVE A,DNAM(F) ;PUSH SUCCESSFUL, NOW CHECK TO SEE IF TABLE ENTRY SHOULD BE FINISHED
+ AOJN A,ASSEM1
+ PUSHJ P,A.OMAP ;YES, DO IT
+ JRST ASSEM1 ;NOW ASSEMBLE FROM FILE (ASSEM1 CLOBBERS PDL)
+
+ ;.INSRT TTY:
+
+A.ITRT: PUSHJ P,GTYIPA ;READ FROM TTY, DON'T QUIT UNTIL .INEOF
+ JRST A.ITR2 ;FALL BACK IN (DOESN'T TOUCH .IFNM1, .IFNM2)
+
+ ;.INEOF ;EOF PSEUDO (MAINLY USEFUL FROM TTY)
+
+A.IEF2: PUSHJ P,PMACP ;LOOP POINT, POP ENTRY OFF MACRO PDL
+A.INEO: TLNE FF,FLMAC ;INPUTTING FROM MACRO?
+ JRST A.IEF2 ;YES, POP IT OFF
+ PUSH P,CMACCR ;BACK TO INPUTTING FROM FILE OR TTY, CAUSE RETURN TO MACCR
+ MOVE B,ITTYP ;GET PDL POINTER
+ POPJ B, ;RETURN TO POP ROUTINE
+
+ ;MISC .INSRT
+
+A.IMAP: MOVSI A,DNAM(F) ;CLOBBER DNAM ETC. FROM TABLE TRANSLATION ENTRY POINTED TO BY F
+A.IMP1: HRRI A,DNAM ;ENTRY FOR LH(BLT POINTER) ALREADY SET UP
+ BLT A,DNAM+LFDSE-1 ;DO IT
+ POPJ P,
+
+A.OMAP: MOVEI A,DNAM(F) ;CLOBBER TRANSLATION OF TABLE ENTRY POINTED TO BY F FROM DNAM ETC.
+ HRLI A,DNAM
+ BLT A,DNAM+LFDSE-1(F)
+ POPJ P,
+
+;CALL FROM ERRH; TYPE INPUT FILE'S NAMES IF CHANGED SINCE LAST ERR MSG.
+ERRTFL: MOVE C,INFCUR
+ EXCH C,INFERR ;SAY LAST ERROR MSG IN THIS FILE.
+ CAMN C,INFERR ;IF PREV. MSG WAS IN OTHER FILE,
+ POPJ P,
+ MOVE C,[-4+DECSW,,INFDEV-DNAM]
+ PUSHJ P,TYPF1 ;TYPE THIS FILE'S NAMES.
+ JRST CRRERR
+\f
+ ;MISC TS
+
+IOPNR1: PUSHJ P,IOPNER ;TYPE OUT CRUFT
+ TYPR OINITS
+ RET
+
+ ;TYPE OUT DNAM ETC. AS FILE SPECIFICATION
+
+TYPFIL: MOVSI C,-4+DECSW
+TYPF1: MOVE B,DNAM(C) ;GET NEXT NAME
+ PUSHJ P,SIXTYO ;TYPE OUT NAME
+ HLRZ A,C
+ MOVE A,FILSPC+4-DECSW(A) ;NOW GET DELIMITING CHARACTER
+ PUSHJ P,TYOERR ;TYPE OUT
+ AOBJN C,TYPF1 ;LOOP FOR ALL NAMES
+IFN ITSSW, POPJ P,
+.ELSE,[ SKIPN B,DNAM(C) ;ON DEC SYSTEM PPN IS A SPECIAL CASE
+ POPJ P,
+ MOVEI A,"[ ;]
+ CALL TYOERR
+IFN CMUSW,[
+ MOVE A,[B,,PPNBUF]
+ DECCMU A,
+ JRST OCTPPN
+ MOVEI B,PPNBUF
+ PUSHJ P,TYPR3
+ JRST PPNRB
+];IFN CMUSW
+IFE SAILSW,[
+OCTPPN: HLRZ B,DNAM(C) ;LH IS PROJ,
+ CALL OCTPNT
+]
+.ELSE [ HLLZ B,DNAM(C)
+ CALL SIXTYO
+]
+ MOVEI A,",
+ CALL TYOERR
+IFE SAILSW,[
+ HRRZ B,DNAM(C)
+ CALL OCTPNT ;RH IS PROG.
+]
+.ELSE [ HRLZ B,DNAM(C)
+ CALL SIXTYO
+]
+PPNRB: ;[
+ MOVEI A,"]
+ JRST TYOERR
+];IFN DECSW
+
+FILSPC: ":
+IFN ITSSW, 40 ? 40 ? ";
+IFN DECSW, ". ? 0
+
+ ;OPENLOSS DOCUMENTATION ROUTINE
+IOPNER: MOVE A,IFSTS ;INPUT
+OPNER: MOVEM A,ERRNM2 ;SAVE .STATUS WORD
+ PUSHJ P,TYPFIL ;TYPE OUT FILE DESCRIPTION
+ PUSHJ P,CRRERR ;NOW CRLF TO ENSURE ROOM FOR FOLLOWING
+IFN DECSW,[
+ TYPR [ASCIZ/OPEN failed/]
+ JRST CRRERR
+]
+IFN ITSSW,[
+ .OPEN ERRC,ERRDNM ;NOW GET THE SYSTEM TO SAY WHAT'S WRONG
+ .VALUE ;CAN'T OPEN ERR DEVICE?
+IOPNR2: .IOT ERRC,A ;GET CHARACTER FROM SYSTEM
+ CAIN A,14 ;ENDS WITH FORM FEED
+ POPJ P,
+ PUSHJ P,TYOERR ;TYPE OUT CHARACTER
+ JRST IOPNR2 ;LOOP BACK FOR NEXT
+] ;END IFN ITSSW
+\f
+;READ SINGLE FILE DESCRIPTION INTO DNAM ... SNAM .
+;FRNNUL 1 IFF SPEC WAS NONNULL.
+;FRMRGO 1 IFF "." WAS SEEN IN DEC VERSION - FORCE NULL FN2.
+;FRCMND 1 IFF SHOULD RECOGNIZE -, COMMA, / AND ( AS SPECIAL CHARACTERS.
+RFD: TRZ FF,FRNNUL+FRMRGO
+RFD8: SETZ D, ;D COUNTS FILENAMES. 0 BEFORE 1ST.
+RFD1: MOVEI C,0 ;INITIALIZE SIXBIT NAME.
+ MOVE B,[440600,,C] ;SET UP BP FOR INPUT
+RFD2: PUSHJ P,RCH ;GET CHARACTER IN A
+ CAIN A,": ;IF COLON...
+ JRST RFDCOL ;THEN PROCESS AS SUCH
+ CAIN A,"; ;SIMILARLY FOR SEMICOLON
+ JRST RFDSEM
+IFN DECSW,[
+ CAIN A,"! ; FOO! MEANS RUN SYS:FOO WITH OFFSET 1
+ JRST RFDRUN
+]
+ CAIN A,^Q ;IF CONTROL Q...
+ JRST RFDCQ ;THEN GET NEXT CHARACTER AND TREAT AS NON-SYNTACTICAL
+ TRNN FF,FRCMND ;IF READING COMMAND, _, COMMA, / AND ( ARE SPECIAL.
+ JRST RFD3
+ CAIN A,"(
+ JRST CMDSW ;READ SWITCHES.
+ CAIN A,"/
+ JRST CMDSL ;READ 1 SWITCH
+IFN DECSW,CAIN A,"=
+.ALSO JRST RFD6 ;ON DEC SYS, "=" = "_"
+ CAIE A,",
+ CAIN A,"_
+ JRST RFD6 ;COMMA AND _ END SPEC.
+RFD3:
+IFN DECSW,[
+ CAIE A,"[ ;]
+ CAIN A,". ;. LIK SPACE ON DEC SYS.
+ JRST RFD6]
+ CAILE A,40 ;LOGICAL SPACE? (INCLUDING CR)
+ JRST RFDC ;NO
+RFD6: TRZN FF,FRMRGO ;EXCEPT AFTER ".",
+ JUMPE C,RFD5 ;IGNORE NULL FILENAMES
+ XCT RFDTAB(D) ;STORE THE NAME (MAY SKIP)
+ ADDI D,1 ;NEXT NAME PUT ELSEWHERE
+IFN DECSW,[
+ CAIN A,".
+ IORI FF,FRMRGO
+]
+ TRO FF,FRNNUL ;SPEC NOT NULL.
+RFD5: IFN DECSW,[CAIN A,"[ ;] READ PPN FOR DEC SYS.
+ JRST RFD7]
+ CAIN A,^R ;CONTROL R,
+ JRST RFD8 ;RESETS FILENAME COUNT
+IFN DECSW,[
+ CAIN A,"= ;ON DEC SYS, "=" = "_".
+ MOVEI A,"_
+]
+ CAIN A,",
+ RET
+ CAIE A,"_ ;RETURN IF SPEC TERMINATOR,
+ CAIN A,^M
+ RET
+ JRST RFD1 ;ELSE NEXT NAME.
+
+RFDCQ: PUSHJ P,RCH ;CONTROL Q EATS UP THE NEXT CHARACTER
+ CAIN A,15
+ JRST RFD6 ;BUT NOT IF CR
+RFDC: CAIL A,140 ;CONVERT LOWER CASE TO UPPER.
+ SUBI A,40
+ SUBI A,40 ;CONVERT CHARACTER TO SIXBIT
+ TLNE B,770000 ;TOO MANY CHARACTERS?
+ IDPB A,B ;NO
+ JRST RFD2 ;LOOP
+
+RFDTAB: MOVEM C,FNAM1 ;1ST NAME.
+ MOVEM C,FNAM2 ;2ND NAME.
+ MOVEM C,DNAM ;3RD NAME IS DEV.
+ MOVEM C,SNAM ;4TH IS SNAME.
+ CAIA ;5TH AND ON IGNORED, DON'T INCR. D.
+\f
+RFDCOL: TRO FF,FRNNUL
+ JUMPE C,RFD1 ;IF HE WANTS THE NULL DEVICE HE GETS TO TYPE IT IN
+ MOVEM C,DNAM ;MOVE TO RH OF DEVICE LOCATION
+ JRST RFD1 ;LOOP
+
+IFN DECSW,[
+RFD7: PUSHJ P,RFDPPN ;READ PPN, USE AS "SNAME".
+]
+RFDSEM: TRO FF,FRNNUL
+ JUMPE C,RFD1 ;NO NULL SYSTEM NAMES PLEASE
+ MOVEM C,SNAM ;MOVE TO SYSTEM NAME LOCATION
+ JRST RFD1 ;LOOP
+
+IFN DECSW,[
+RFDPPN: PUSHJ P,RFDOCT ;READ PROJECT NUM,
+IFN CMUSW, JUMPE C,RCMUPP ;AT CMU WATCH FOR OUR FUNNY PPNs
+ HRLM C,(P)
+ PUSHJ P,RFDOCT ;READ PROGRAMMER NUM.
+ HLL C,(P)
+ POPJ P,
+
+IFE SAILSW,RFDOCL=="0 ? RFDOCH=="8 ;READ OCTAL NUMBERS.
+.ELSE RFDOCL==40 ? RFDOCH==140 ;READ SIXBIT (RIGHT-JUSTIFIED).
+
+RFDOCT: SETZ C, ;READ OCTAL NUM, RETURN IN C.
+RFDOC1: PUSHJ P,RCH
+ CAIL A,140
+ SUBI A,40
+IFN SAILSW,[ ;[ ;EVEN IF READING SIXBIT NAMES (FOR SAIL),
+ CAIE A,", ;COMMA AND CLOSEBRACKET ARE STILL SPECIAL.
+ CAIN A,"]
+ POPJ P,
+]
+ CAIL A,RFDOCL
+ CAIL A,RFDOCH
+ POPJ P, ;NOT OCTAL OR NOT 6BIT, RETURN.
+ IMULI C,RFDOCH-RFDOCL
+ ADDI C,-RFDOCL(A)
+ JRST RFDOC1
+
+IFN CMUSW,[ ;[
+RCMUPP: CAIN A,"] ;WATCH OUT FOR []
+ POPJ P,
+REPEAT 4, SETZM PPNBUF+.RPCNT
+ MOVE C,[440700,,PPNBUF]
+RCMUPL: CAIE A,^M ;Don't look too far
+ SKIPE PPNBUF+3
+ JRST RCMUPD
+ IDPB A,C
+ PUSHJ P,RCH ;[
+ CAIE A,"]
+ JRST RCMUPL
+RCMUPD: MOVE A,[C,,PPNBUF]
+ CMUDEC A,
+ SETZ C,
+ POPJ P,
+];IFN CMUSW
+];IFN DECSW
+\f
+IFN DECSW,[
+
+;PROCESS "FOO!", WHICH MEANS "RUN SYS:FOO WITH AN OFFSET OF 1".
+
+RFDRUN: MOVSI A,'SYS ;DEV NAME
+ MOVE B,C ;FN1
+ SETZB C,D ;DEFAULT THE FN2. 4TH WORD NOT USED.
+ SETZB T,TT ;DEFAULT THE PPN (UNUSED ANYWAY). DON'T SPECIFY CORE SIZE.
+ MOVE AA,[1,,A] ;<START OFFSET>,,<ADDRESS OF ARG BLOCK>
+ JRST RFDRU1
+VBLK
+RFDRU1: MOVE F,[1,,RFDRUE]
+ CORE F, ;FLUSH AS MUCH CORE AS POSSIBLE, SINCE RUN UUO CAN LOSE
+ HALT ;BECAUSE OF HOW MUCH WE HAVE.
+ RUN AA,
+ HALT
+RFDRUE:
+
+PBLK
+];END IFN DECSW,
+
+;COMMAND SWITCH PROCESSING.
+
+CMDSL: CALL RCH ;COME HERE AFTER A SLASH. READ ONE SWITCH.
+ CAIN A,^M
+ JRST RFD6
+ CALL CMDSW1
+ JRST RFD2
+
+CMDSW: PUSHJ P,RCH
+ CAIN A,")
+ JRST RFD2
+ CAIN A,^M
+ JRST RFD6 ;DON'T CRASH IF USER PUTS CR IN SWITCH LIST.
+ CALL CMDSW1
+ JRST CMDSW
+
+CMDSW1: CAIL A,140 ;LOWER CASE TO UPPER.
+ SUBI A,40
+ CAIN A,"T
+ SOS TTYINS ;COUNT # T-SWITCHES.
+IFN LISTSW,[
+ CAIN A,"L
+ JRST CMDLST
+]
+ CAIN A,"W ;W - PREVENT TTY MESSAGES, AND RQ ERROR OUTPUT FILE IF POSSIBLE.
+IFE ERRSW,AOS WSWCNT
+.ELSE [
+ AOSA WSWCNT
+ CAIN A,"E ;E - RQ ERROR LOG FILE.
+ SETOM ERRFP
+]
+IFN CREFSW,[
+ CAIN A,"C ;C - RQ CREF OUTPUT.
+ SETOM CREFP
+]
+ RET
+\f
+;READ COMMAND, DEFAULT FILENAMES.
+CMD: SKIPN CMPTR
+ CALL CRR
+ SKIPN CMPTR ;UNLESS HAVE DDT COMMAND STRING, PROMPT.
+CMDB: TYPR [ASCIZ/*/]
+ MOVEI A,3 ;READ FROM TTY (OR STRING <- CMPTR)
+ CALL RCHSET
+ TRO FF,FRCMND+FRARRO ;TELL RFD ABOUT COMMA, _ AND (.
+ CALL RFD ;NOW SEE IF COMMAND NULL, AND WHETHER HAS _.
+ TRNN FF,FRNNUL
+ CAIE A,^M
+ CAIA
+ JRST CMDB ;JUST A CR WITH NOTHING SIGNIFICANT BEFORE IT.
+CMD0: CAIN A,"_
+ TRZ FF,FRARRO ;FRARRO WILL BE ON IFF NO _ IN STRING.
+ CAIN A,^M
+ JRST CMD1 ;READ THRU THE WHOLE COMMAND.
+ CALL RFD
+ JRST CMD0
+
+;NOW RE-READ THE STRING, FOR REAL THIS TIME.
+CMD1: MOVE F,[440700,,CMBUF]
+ MOVEM F,CMPTR ;START FROM BEGINNING OF STRING.
+IFN CREFSW,SETZM CREFP ;CLEAR ALL SWITCHES BEFORE DECODING THEM.
+INSIRP SETZM 0,ERRFP TTYINS WSWCNT
+IFN LISTSW,[
+ SETZM LISTP
+ SETOM LISTP1 ;WILL BE AOSED BY EACH (L) SWITCH.
+]
+ SETZM DNAM ;CLEAR OUT ALL FILENAMES.
+ MOVE T,[DNAM,,DNAM+1]
+ BLT T,FNMEND-1
+ MOVSI T,'DSK ;DEFAULT DEV IS DSK
+ MOVEM T,DNAM ;EXCEPT PERHAPS IF OUTPUT SPEC NULL.
+ MOVE T,RSYSNM
+ MOVEM T,SNAM ;DEFAULT SNAME IS INITIAL SNAME.
+ TRZ FF,FRNNUL
+ TRNN FF,FRARRO ;DON'T GOBBLE INPUT SPEC AS OUTPUT!
+ CALL RFD ;READ BIN FILE SPEC.
+ MOVE F,FF ;REMEMBER WHETHER NULL
+ MOVE T,[DNAM,,ONAM]
+ BLT T,OSYSNM
+ MOVS T,DNAM
+ CAIN T,'NUL ;IF BIN WENT TO NUL:,
+ MOVEI T,'DSK ;CREF GOES TO DSK.
+ MOVSM T,DNAM ;ELSE DEFAULT DEV FOR CREF IS BIN'S DEV.
+IFN DECSW,MOVSI T,'CRF
+IFN ITSSW,MOVE T,[SIXBIT/CREF/]
+ MOVEM T,FNAM2 ;DEFAULT THE CREF FILE'S NAMES.
+ TRNE FF,FRARRO
+ MOVEI A,"_
+ CAIN A,"_
+ JRST CMD2 ;RAN OUT OF OUTPUT SPECS => JUST USE DEFAULTS.
+ CALL RFD ;READ CREF FILE SPEC.
+IFN CREFSW,[
+ TRNN FF,FRNNUL ;IF SPEC NOT NULL OR ENDED BY _,
+ CAIN A,"_
+ SETOM CREFP ;WE MUST WANT TO CREF.
+CMD2: MOVE T,[DNAM,,CRFDEV]
+ BLT T,CRFSNM
+]IFE CREFSW,CMD2:
+ MOVSI T,'ERR ;DEFAULT THE ERROR OUTPUT FILE'S NNAMES.
+ MOVEM T,FNAM2
+ CAIN A,"_
+ JRST CMD6 ;NO MORE OUTPUT SPECS.
+ CALL RFD ;READ ERROR FILE SPPEC.
+IFN ERRSW,[
+ TRNN FF,FRNNUL ;NONNULL SPEC OR LAST SPEC =>
+ CAIN A,"_
+ SETOM ERRFP ;MUST WAANT ANN ERROR FILE.
+CMD6: MOVE T,[DNAM,,ERRDEV]
+ BLT T,ERRDEV+3
+]
+IFE ERRSW,CMD6:
+IFN LISTSW,[
+IFN DECSW,MOVSI T,'LST
+IFN ITSSW,MOVE T,[SIXBIT/LIST/]
+ MOVEM T,FNAM2 ;DEFAULT LST FILE FN2.
+ CAIN A,"_ ;ANY OUTPUT SPEC REMAINING?
+ JRST CMD3
+ CALL RFD ;YES, READ ONE.
+ SETOM LISTP ;LIST SPEC GIVEN IMPLIES WANT LISTING.
+CMD3: MOVE T,[DNAM,,LSTDEV]
+ BLT T,LSTSNM
+] ;END IFN LISTSW,
+CMD5: CAIN A,"_
+ JRST CMD4
+ CALL RFD ;IGNORE ANY OUTPUT SPECS NOT NEEDED.
+ JRST CMD5
+
+CMD4: MOVSI T,'DSK ;DEFAULT THE INPUT NAMES.
+ MOVS A,DNAM
+ CAIE A,'PTP ;DON'T LEAVE DEV NAME SET TO COMMON OUTPUT-ONLY DEVS.
+ CAIN A,'NUL
+ MOVEM T,DNAM
+IFN DECSW,MOVSI T,'MID
+IFN ITSSW,MOVSI T,'>_14
+ MOVEM T,FNAM2
+ MOVE T,[SIXBIT/PROG/]
+ SKIPN FNAM1 ;THE FN1 ALONE IS STICKY ACROSS THE _.
+ MOVEM T,FNAM1
+ TRO FF,FRARRO ;IF ONLY 1 NAME IT SHOULD BE FNAM1.
+ CALL RFD ;READ INPUT SPEC.
+ MOVE T,[DNAM,,IFDS]
+ BLT T,IFDS+3
+ MOVE T,FNAM1 ;DEFAULT OUTPUT FN1'S TO INPUT.
+ SKIPN ONAM+1
+ MOVEM T,ONAM+1
+IFN CREFSW,[
+ SKIPN CRFDEV+1
+ MOVEM T,CRFDEV+1
+]
+IFN LISTSW,[
+ SKIPN LSTDEV+1
+ MOVEM T,LSTDEV+1
+]
+IFN ERRSW,[SKIPN ERRDEV+1
+ MOVEM T,ERRDEV+1
+]
+ MOVSI A,'NUL ;THE OUTPUT DEV DEFAULTS TO NUL:
+ MOVS T,DNAM ;IF THE INPUT IS FROM TTY:
+ CAIN T,'TTY
+ TRNE F,FRNNUL ;AND THE BIN SPEC WAS NULL.
+ CAIA
+ MOVEM A,ONAM
+ TRZ FF,FRARRO ;DON'T LOUSE UP .INSRT'S READING.
+ RET
+\f
+IFN CREFSW,[
+
+CRFOUT: SOSGE CRFCNT
+ JRST CRFOU1 ;NO ROOM, OUTPUT AND INIT BUFFER.
+ IDPB A,CRFPTR
+ POPJ P,
+
+CRFOU1: SAVE C
+ MOVE C,[0 CREFC,CRFHDR]
+ CALL OBUFO
+ REST C
+ JRST CRFOUT
+
+CRFSSF: SKIPA A,[1] ;OUTPUT SET-SOURCE-FILE BLOCK.
+CRFPSH: MOVEI A,3 ;OUTPUT PUSH-SOURCE-FILE BLOCK.
+REPEAT 4,[ CALL CRFOUT
+ MOVE A,INFDEV+.RPCNT
+]
+ JRST CRFOUT
+]
+
+IFN LISTSW,[
+ ;PRINTING ROUTINES
+
+;L SWITCH TYPED IN DURING COMMAND, SET UP FOR LISTING
+CMDLST: SETOM LISTP ;SAY WANT LISTING.
+ AOS LISTP1 ;(STARTS AS -1, WILL BE POS. AFTER 2ND (L))
+ RET
+
+;PRINT CHARACTER IN A
+PILPT: SOSGE LSTCNT
+ JRST PILPT1
+ IDPB A,LSTPTR
+ RET
+
+PILPT1: SAVE C
+ MOVE C,[0 LPTC,LSTHDR]
+ CALL OBUFO
+ REST C
+ JRST PILPT
+
+LPTCLS==CPOPJ
+] ;END IFN LISTSW,
+\f;GET ANOTHER K OF MACTAB SPACE.
+
+CORRQB: IFN ITSSW,.VALUE ;LOOP POINT FOR DON'T PROCEED
+IFN DECSW,EXIT 1,
+ TLZ AA,400000
+CORRQA: POP P,D
+ POP P,C
+ MOVE A,(P) ;RESTORE A FROM PDL
+ JRST CORRQ1
+
+GCCORQ: MOVE A,MACHI
+ LSH A,-2 ;CONVERT TO WORD #
+ CAIL A,MXMACL ;WANT MORE THAN ALLOWED?
+ POPJ P,
+ MOVE A,MACTND ;NO, GET ADDR OF BLOCK WE WANT TO GET.
+ PUSH P,A ;ENTRY, SAVE A IN CASE HAVE TO TRY AGAIN
+CORRQ1:IFN ITSSW,[
+ HRLI A,10001 ;(CODE FOR FRESH PAGE, _1)
+ LSH A,-1
+ .CBLK A, ;TRY GETTING BLOCK
+]
+IFN DECSW,[
+ IORI A,1777
+ CORE A,
+]
+ JRST CORRQL ;LOSE
+ REST A
+ ADDI A,2000
+ JRST MACIN2 ;UPDATE POINTERS TO END OF MACTAB.
+
+CORRQL: PUSH P,C
+ PUSH P,D
+ TLOE AA,400000
+ JRST CORQL1
+ TYPR [ASCIZ /
+No core for macro table./]
+CORQL1: TYPR [ASCIZ /
+Try again? /]
+CORQL2: PUSHJ P,TYI ;GET CHAR
+ TRZ A,"
+ CAIN A,"Y ;Y,
+ JRST CORRQA ;=> TRY AGAIN
+ CAIN A,"N ;N,
+ JRST CORRQB ;=> BACK TO DDT THEN TRY AGAIN
+ CAIN A,"? ;?,
+ ERJ CORQL1 ;=> TYPE OUT ERROR-TYPE BLURB
+ TYPR [ASCIZ /? /] ;SOMETHING ELSE
+ JRST CORQL2
+
+] ;END TS CONDITIONAL
+\f
+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==./2000 ;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>/2000 ;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.
+\f
+;;INIT ;INITIALIZATION ROUTINES (IN MACRO TABLE, GET WIPED OUT)
+IFN ITSSW,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 COODE 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,[
+ SAVE 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,[ ;YES, GET CORE FOR INCREASE.
+ SAVE 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,.+3(CH1) ;DON'T CALL IF NEED 0 PAGES, WOULD GET ONE.
+ .CALL INITSB(CH1)
+ .VALUE
+ 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
+ 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)
+EISYMP: ;MAY BE MUNGED
+SP1: CAIL AA,EISYMT(CH1)
+ POPJ P,
+ MOVE SYM,(AA)
+ LDB T,[400400,,SYM](CH1)
+ ROT T,-4
+ TLZ SYM,740000
+ PUSHJ P,ES
+ 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
+ AOS AA
+ AOJA AA,SP1(CH1)
+\f
+IFN ITSSW,[
+INITSB: SETZ ? 'CORBLK
+ 1000,,600000 ;BOTH READ AND WRITE.
+ 1000,,-1 ? AA ;INTO SELF, AA IS AOBJN -> PAGES.
+ SETZI 400001 ;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,PURIFD ;NOT PURIFIED => FLUSH PAGES
+ MINPUR-MXIMAC ;OF MACTAB CREATED BY LOADING BUT NOT NEEDED.
+ MXIMAC*1001
+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,
+\f
+IFN PURESW,[ ;HERE ARE THE GUTS OF THE PURIFY ROUTINE
+
+PURIFY: SKIPL NVRRUN
+ .VALUE [ASCIZ /:\eAlready run\e
+/]
+PURIF1: MOVEI P,17 ;START PDL AT 20
+ JSP F,PURIFD ;CALL .CBLK ROUTINE
+ MINMAC-MINBNK ;FLUSH BLANK CODE PAGES (INCL. SYM TAB)
+ MINBNK*1001
+ MINPUR-MXICLR ;FLUSH MACTAB PAGES CREATED BY LOAD BUT NOT NNEEDED.
+ MXICLR*1001
+ MAXPUR-MINPUR ;PURIFY PURE PAGES.
+ 400000+MINPUR*1001
+ SETZM PURIFG ;SET "PURIFIED" FLAG
+ MOVE [1,,2] ;NOW CLEAR OUT REMAINS OF DATA OF SELF
+ MOVEI 1,0
+ BLT 40
+ .VALUE [ASCIZ /:\ePurified\epdump\17 SYS;TS MIDAS\16\e/]
+
+GAPFLS: JSP F,PURIFD ;FLUSH GAP PAGES CREATED ON INITIAL LOAD.
+ MINPUR-MXIMAC
+ MXIMAC*1001
+ .BREAK 16,300000
+
+ ;JSP F,PURIFD ;DO A SEQUENCE OF .CBLKS
+ ;FOLLOW WITH AN ARBITRARY NUMBER OF PAIRS OF ARGUMENTS
+ ;FIRST ARG OF PAIR # PAGES TO PROCESS, MAY BE ZERO
+ ;SECOND INITIAL .CBLK AC CONTENTS
+
+PURIFD: MOVE C,(F) ;GET COUNT
+ TLNE C,777000 ;CHECK INSTRUCTION PART
+ JRST (F) ;INSTRUCTION => RETURN TO IT
+ JUMPE C,PURID2 ;JUMP IF NO PAGES IN COUNT
+ MOVE A,1(F) ;GET INITIAL .CBLK ARG
+PURID1: .CBLK A,
+ .VALUE
+ ADDI A,1001 ;INCREMENT .CBLK ARG TO NEXT PAGE
+ SOJG C,PURID1 ;DO IT THE APPROPRIATE NUMBER OF TIMES
+PURID2: ADDI F,2
+ JRST PURIFD
+
+] ;END PURESW CONDITIONAL
+] ;END ITSSW, CONDITIONAL
+
+IFN DECDBG,[
+DECDBM: 0
+IFE SAILSW,HRLZ A,.JBSYM ;GET ADDR OF START OF DDT SYMS,
+.ELSE HRLZ A,JOBSYM
+ HRRI A,DECDBB+200 ;LEAVE 200 WD SPACE BEFORE THEM.
+IFE SAILSW,[HRRM A,.JBSYM ;MOVE THEM INTO SPACE PROVIDED
+ HLRE B,.JBSYM]
+.ELSE [HRRM A,JOBSYM
+ HLRE B,JOBSYM]
+ MOVMS B
+ BLT A,DECDBB+177(B) ;SO THEY WON'T GET IN MACTAB'S WAY.
+ JRST @DECDBM
+]
+
+CONSTANTS
+\f
+;;ISYMS ;INITIAL SYMBOL TABLE
+
+ADJSP=105_33 ;ALLOW FOR BOOTSTRAP, EVENTUALLY FLUSH, MAYBE
+
+ISMTBB: ADJSP ;FIRST OP. CODE IN ISYMTB
+
+ISYMTB:
+
+SQUOZE 10,ADJSP
+ 0
+ 0
+SQUOZE 10,DFAD
+SQUOZE 10,DFSB
+SQUOZE 10,DFMP
+SQUOZE 10,DFDV
+SQUOZE 10,DADD
+SQUOZE 10,DSUB
+SQUOZE 10,DMUL
+SQUOZE 10,DDIV
+SQUOZE 10,DMOVE
+SQUOZE 10,DMOVN
+SQUOZE 10,FIX
+SQUOZE 10,EXTEND
+SQUOZE 10,DMOVEM
+SQUOZE 10,DMOVNM
+SQUOZE 10,FIXR
+SQUOZE 10,FLTR
+SQUOZE 10,UFA
+SQUOZE 10,DFN
+SQUOZE 10,FSC
+SQUOZE 10,IBP
+SQUOZE 10,ILDB
+SQUOZE 10,LDB
+SQUOZE 10,IDPB
+SQUOZE 10,DPB
+SQUOZE 10,FAD
+SQUOZE 10,FADL
+SQUOZE 10,FADM
+SQUOZE 10,FADB
+SQUOZE 10,FADR
+SQUOZE 10,FADRL
+SQUOZE 10,FADRM
+SQUOZE 10,FADRB
+SQUOZE 10,FSB
+SQUOZE 10,FSBL
+SQUOZE 10,FSBM
+SQUOZE 10,FSBB
+SQUOZE 10,FSBR
+SQUOZE 10,FSBRL
+SQUOZE 10,FSBRM
+SQUOZE 10,FSBRB
+SQUOZE 10,FMP
+SQUOZE 10,FMPL
+SQUOZE 10,FMPM
+SQUOZE 10,FMPB
+SQUOZE 10,FMPR
+\fSQUOZE 10,FMPRL
+SQUOZE 10,FMPRM
+SQUOZE 10,FMPRB
+SQUOZE 10,FDV
+SQUOZE 10,FDVL
+SQUOZE 10,FDVM
+SQUOZE 10,FDVB
+SQUOZE 10,FDVR
+SQUOZE 10,FDVRL
+SQUOZE 10,FDVRM
+SQUOZE 10,FDVRB
+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 ;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
+0
+\fSQUOZE 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
+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
+\fSQUOZE 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
+
+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
+\fSQUOZE 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
+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
+\fSQUOZE 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
+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
+\f
+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:
+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
+\f
+SQUOZE 10,APR
+0
+SQUOZE 10,PI
+4
+SQUOZE 10,PTP
+100
+SQUOZE 10,PTR
+104
+SQUOZE 10,TTY
+120
+SQUOZE 10,LPT
+124
+SQUOZE 10,DIS
+130
+SQUOZE 10,DC
+200
+SQUOZE 10,UTC
+210
+SQUOZE 10,UTS
+214
+
+
+SQUOZE 10,LDBI ;REALLY ILDB,
+LDBI
+SQUOZE 10,DPBI ;AND IDPB
+DPBI
+SQUOZE 10,CLEAR
+CLEAR
+SQUOZE 10,CLEARI
+CLEARI
+SQUOZE 10,CLEARM
+CLEARM
+SQUOZE 10,CLEARB
+CLEARB
+SQUOZE 10,ADJBP
+IBP
+IRPS INST,,FAD FSB FMP FDV
+SQUOZE 10,INST!RI
+INST!RL
+TERMIN
+\f
+IFN DECSW\TNXSW,[
+IFE TNXSW,[
+DEFINE DECDF1 FOO/
+IRPS X,,FOO
+SQUOZE 10,X
+X
+.ISTOP TERMIN TERMIN
+]
+IFN TNXSW,[;; RESET IS BOTH A JSYS AND A CALLI!!
+DEFINE DECDF1 FOO/
+IRPS X,,FOO
+IFSN X,RESET,[SQUOZE 10,X
+X]
+.ISTOP TERMIN TERMIN
+]
+.DECUU DECDF1
+.DECTT DECDF1
+IFE SAILSW,.DECMT DECDF1
+.DECCL DECDF1
+IFN SAILSW,.DECMS DECDF1
+IFE SAILSW,.DEC.J DECDF1
+IFN SAILSW,.DECJB DECDF1
+.DECJH DECDF1
+
+IFN TNXSW,[;; DEFINE JSYS'S ON TENEX VERSION
+DEFINE TNXDF1 FOO/
+IRPS X,,FOO
+SQUOZE 10,X
+X
+.ISTOP TERMIN TERMIN
+.TNXJS TNXDF1
+]]
+SQUOZE 10,.OSMID
+OSMIDAS
+SQUOZEE 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,.DECRE
+A.DECRE
+SQUOZE 4,.DECTX
+A.DCTX
+\f
+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,.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
+.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
+\f
+ ;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
+\f
+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
+]
+\f
+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)
+]
+\f
+IFN TS,[
+SQUOZE 4,.FNAM1
+RFNAM1,,INTSYM
+SQUOZE 4,.FNAM2
+RFNAM2,,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,.TTYFLG
+A.TTYFLG,,INTSYM
+]
+IFN .I.FSW,[
+SQUOZE 4,.F
+A.F
+SQUOZE 4,.I
+A.I
+]
+IFN TSSYMS,[
+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
+ SQUOZE 10,..R!X
+ .IRPCN+1
+IFSN Y,+,[
+ SQUOZE 10,..S!X
+ 400000+.IRPCN+1
+] TERMIN
+]
+
+EISYMT: PRINTA \.-MACTBA-1, words initialization coding.
+IFN DECSW,[
+IFNDEF MACL,MACL=.+5-MACTBA
+IFGE .-MACTBA-MACL,.ERR MACL TOO SMALL
+]
+
+IFN ITSSW,[
+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 ;MUST BE BEFORE RELOCATABLE END STATEMENT,
+ ;SINCE TS MIDAS NOW TRIES TO DO MULTIPLE 1PASS ASSEMBLIES FROM SAME FILE.
+ ;PUTTING RELOCABLE END STATEMENT FIRST CAUSES IT TO ENCOUNTER OTHER
+ ;END STATEMENT IN NEW ASSEMBLY CAUSING CONFUSION
+
+END 100
projects / pdp10-muddle.git / commitdiff