Disable the "purify high core" CORBLK (dubious).

[pdp10-muddle.git] / <mdl.int> / midas.323

.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
        TRO I,IRCONT    ;Don't end block between the two words
        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.
        TRZ I,IRCONT
        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
        JRST [  MOVEI A,CDEFPT  ;Define sym for beginning of constants area
                PUSHJ P,P7X
                PUSHJ P,OUTSM   ;As PDEFPT but punch squoze (see RPWRD1)
                JRST .+1]
        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)
        TRZ I,IRCONT
        PUSHJ P,$OUTPT  ;OUTPUT VALUE, FIRST LOCATION IN AREA
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
        TRO I,IRCONT    ;Don't end block between the two words
        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.
        TRZ I,IRCONT
        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