<mdl.int>/midas.323

   1
   2 .SYMTAB 4003.,2000.     ;THIS MANY FOR DEC VERSION ON DEC SYSTEM.
   3 IFN .OSMIDAS-SIXBIT/DEC/, .SYMTAB 5003. ;ON ITS ASSEMBLE FASTER.
   4
   5 TITLE MIDAS
   6 .MLLIT==1       ;MULTI-LINE MODE.
   7
   8 ;AC DEFS
   9
  10 FF=0    ;FLAGS
  11 P=1
  12 I=2     ;INDICATOR FLAGS, CONTAIN INFO ON CURRENT SYL, FIELD, WORD; ALSO SEE UNRCHF
  13 AA=3
  14 A=4
  15 B=5
  16 C=6
  17 D=7
  18 T=10    ;NOT SO TEMP AS IN MOST PROGS W/ T
  19 TT=11
  20 SYM=12  ;FREQUENTLY CONTAINS SQUOZE SYM W/ FLAGS CLEAR
  21 LINK=13
  22 F=14
  23 CH1=15  ;MACRO PROCESSOR TEMP, CLOBBERED BY CALLS TO RCH
  24 CH2=16  ;" " "
  25 TM=17   ;SUPER TEMPORARY
  26
  27 IFDEF .XCREF, .XCREF FF,P,I,A,B,C,D,T
  28
  29 IF1,[   ;FOR PASS 1 TTY CONDITIONALS
  30 IFDEF SAILSW,IFN SAILSW,DECSW==1
  31 IFDEF CMUSW,IFN CMUSW,DECSW==1
  32 IFDEF DECDBG,IFN DECDBG,DECSW==1
  33 IFDEF DECSW,IFN DECSW,DECSW==1 ? ITSSW==0 ? TNXSW==0
  34 IFDEF ITSSW,IFN ITSSW,ITSSW==1 ? DECSW==0 ? TNXSW==0
  35 IFDEF TNXSW,IFN TNXSW,TNXSW==1 ? DECSW==0 ? ITSSW==0
  36 ] ; IF1
  37 IFNDEF ITSSW,ITSSW==IFDEF .IOT,[1] .ELSE 0      ;NONZERO FOR ITS VERSION
  38 IFNDEF TNXSW,TNXSW==IFDEF JSYS,[1] .ELSE 0      ;NONZERO FOR TENEX VERSION
  39 IFNDEF DECSW,DECSW==IFDEF LOOKUP,[1-TNXSW] .ELSE 0      ;NONZERO TO RUN ON DEC MONITOR.
  40                                 ; TNXSW SINCE TENEX MIDAS HAS DEC UUO'S
  41                                 ; DEFINED TOO
  42 IFNDEF DECDBG,DECDBG==0         ;NONZERO FOR DEC VERSION TO RUN WITH DEC DDT.
  43 IFNDEF SAILSW,SAILSW==IFDEF SPCWAR,[1] .ELSE 0  ;NONZERO FOR SAIL VERSION.
  44 IFNDEF CMUSW,CMUSW==IFDEF CMUDEC,[1] .ELSE 0    ;NONZERO FOR VERSION TO RUN AT CMU.
  45 IFN TNXSW,DECSW==1      ;***TEMP*** USE PA1050 FOR NOW
  46 IFN ITSSW\DECSW\TNXSW,TS==1
  47 IFNDEF TS,TS==1                 ;NON-ZERO FOR ASSEMBLED VERSION TO RUN IN TIME-SHARING
  48 IFE TS,1PASS
  49 IFNDEF A1PSW,   A1PSW==TS       ;FOR 1PASS END-OF-PROGRAM AUTO-REASSEMBLY
  50 IFNDEF TSSYMS,  TSSYMS==ITSSW   ;.UAI, ETC. (AND ..RJCL, ETC) - EVER USE THEM?
  51 IFNDEF BRCFLG,  BRCFLG==0       ;1 => BRACES { AND } ARE SPECIAL IN MACRO ARGS, ETC.
  52                                 ;JUST LIKE BRACKETS. BRACES ARE SPECIAL IN CONDITIONALS
  53                                 ;REGARDLESS OF BRCFLG.
  54 IFNDEF CREFSW,  CREFSW==ITSSW   ;SET TO ALLOW C SWITCH TO CAUSE CREF OUTPUT.
  55 IFNDEF LISTSW,  LISTSW==1       ;SET TO ALLOW L SWITCH TO CAUSE A LISTING.
  56 IFNDEF RCHASW,  RCHASW==TS      ;INCLUDE TTY AS POSSIBLE INPUT DEVICE
  57 IFNDEF PURESW,  PURESW==TS      ;NON-ZERO TO SEPARATE PURE CODING FROM IMPURE AND DO PAGE SKIPS
  58 IFNDEF FASLP,   FASLP==ITSSW\TNXSW\CMUSW\SAILSW ;NON-ZERO => INCLUDE FASL OUTPUT CAPABILITY
  59                                 ; NOTE!! IF RUNNING UNDER 10/50 THIS MAKES THINGS
  60                                 ; SEVERAL K BIGGER THAN OTHERWISE
  61 IFNDEF .I.FSW,  .I.FSW==ITSSW\TNXSW\CMUSW\SAILSW        ;NON-ZERO => INCLUDE .I, .F
  62 IFNDEF MACSW,   MACSW==1        ;NON-ZERO => INCLUDE MACRO PROCESSOR (!)
  63 IFNDEF RUNTSW,  RUNTSW==1       ;ASSEMBLE CODING TO TYPE OUT RUN TIME AT END OF ASSEMBLY
  64 IFNDEF WRQTSW,  WRQTSW==1       ;WRQOTE (MACRO DEFINITION READER) VERSION
  65         ; ^ 0 => SLOW,   1 => FAST; MAYBE 2 WILL EVENTUALLY BE CREATED
  66 IFE TS,IFNDEF MACL,MACL==6*2000 ;MACRO TABLE SIZE
  67 IFN TS,[
  68 IFE DECSW,IFNDEF MACL,MACL==6000 ;(MUST BE BIG ENOUGH TO COVER INIT CODE)
  69                                  ;IN DEC VERSION, MACL IS DEFINED = SIZE OF INIT CODE.
  70 IFNDEF MXMACL,MXMACL==32.*2000  ;MAXIMUM LENGTH MACTAB
  71 ]
  72 IFNDEF MACRUM,MACRUM==4         ;# WORDS NOT USED AT END OF MACTAB
  73 IFNDEF STRL,STRL==20            ;LENGTH OF STRING STORAGE (USED BY GSYL)
  74 IFNDEF DMDEFL,DMDEFL==40        ;MAX NO OF DMY ARGS IN DEFINE
  75 IFNDEF DMYAGL,DMYAGL==400       ;MAX NO COMBINED DMYARGS ALL MACROS CURRENTLY EXPANDING OR PUSHED
  76 IFNDEF MPDLL,MPDLL==300         ;MACRO PDL LENGTH
  77 IFNDEF DSSIZ,DSSIZ==40          ;MAX # ARGS MACRO WHOSE ARGS BEING SCANNED (SHOULD BE .GE. DMDEFL)
  78 IFNDEF BKTABL,BKTABL==40        ;MAX NUM .BEGIN BLOCKS.
  79 IFNDEF BKPDLS,BKPDLS==10        ;MAXIMUM .BEGIN BLOCK NESTING DEPTH.
  80 IFNDEF BSIZE,BSIZE==37          ;PREFERRED SIZE BLOCK  MAX SIZE-3
  81 IFN DECSW,IFNDEF LPDL,LPDL==200.
  82 IFNDEF LPDL,LPDL==500           ;LENGTH OF PDL
  83 IFN DECSW,IFNDEF CONMIN,CONMIN==1000
  84 IFNDEF CONMIN,CONMIN==3300      ;MINIMUM AMT OF SPACE FOR CONSTANTS TABLES.
  85 IFNDEF CONMAX,CONMAX==10000     ;MAXIMUM SPACE USER CAN ASK FOR.
  86 IFNDEF NCONS,NCONS==75.         ;MAXIMUM NUMBER OF CONSTANTS AREAS
  87 IFNDEF NVARS,NVARS==25.         ;MAX. NUM. VARIABLES AREAS.
  88 IFN DECSW,IFNDEF SYMDSZ,SYMDSZ==2003.
  89 IFNDEF SYMDSZ,SYMDSZ==2707.     ;DEFAULT # SYMS IN SYMTAB.
  90 IFNDEF SYMMSZ,SYMMSZ==10177*2   ;# SYMS IF JNAME IS MMIDAS.
  91 IFNDEF SYMMAX,SYMMAX==40000     ;MAX SYMTAB SIZE (# SYMS)
  92 IFNDEF FASBL,FASBL==400         ;WORDS  USED FOR FASL OUTPUT BUFFER
  93                                 ; MUST HOLD STUFF ASSOC WITH ONE GROUP OF 9 CODE BYTES
  94 IFNDEF FASATL,FASATL==2000      ;WORDS USED FOR FASL ATOM TABLE
  95                                 ; HOLDS PNAMES ETC OF ALL ATOMS AS WILL BE IN FASLOAD'S
  96                                 ; SYMTAB AT LOAD TIME
  97 IFNDEF MINWPS,MINWPS==3         ;MIN # WORDS IN SYMTAB ENTRY
  98 IFNDEF MAXWPS,MAXWPS==3         ;MAX # ALLOWED (WILL BE BIGGER SOME DAY)
  99 IFNDEF NRMWPS,NRMWPS==3         ;DEFAULT #.   2 WDS FOR VALUE & FLAGS, 1 FOR NAME.
 100 \f
 101 IF1 [
 102
 103 IFNDEF MIDVRS,MIDVRS=.FNAM2
 104 IFE MIDVRS-SIXBIT/MID/,[
 105 PRINTX /What is MIDAS version number? /
 106 .TTYMAC VRS
 107 MIDVRS=SIXBIT/VRS/
 108 TERMIN
 109 ]
 110
 111 ;OSMIDAS GETS THE SIXBIT NAME OF THE TYPE OF OP. SYS. THE VERSION OF MIDAS
 112 ;IS BEING ASSEMBLED TO RUN UNDER.  IT WILL BE THE VALUE OF ".OSMIDAS" WHEN PROGRAMS
 113 ;ARE ASSEMBLED WITH THIS MIDAS.
 114 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/
 115
 116 ;FF FLAGS NOT PUSHED
 117 ;LEFT HALF
 118 FL==1,,525252
 119 FLPPSS==400000  ;ONE IF PUNCHING PASS; MUST BE SIGN
 120 FLHKIL==100000  ;ONE IF SYM TO BE SEMI KILLED IN DDT
 121
 122 FLVOT==40000    ;ALL RCH S MUST GO THRU RCH
 123         ; IE TYPCTL .NE. POPJ P, (SET/CLEARED BY MDSSET, MDSCLR)
 124 FLMAC==20000    ;ONE IF CHARS COMING FROM MACRO PROCESSOR, DON'T HACK CPGN/CLNN
 125 FLTTY==10000    ;ONE IF CHARS FROM SOMEWHERE ELSE BUT NOT HACKING CPGN/CLNN
 126 FLOUT==4000     ;ONE IF OUTPUT HAS OCCURED IN CURRENT MODE (USED BY TS NED LOGIC)
 127 FLPTPF==2000    ;SET IF (TIME SHARING) OUTPUT DEVICE IS PTP
 128 FLUNRD==1000    ;=> RE-INPUT LAST CHARACTER (SEE RCH)
 129
 130
 131 ;FF RIGHT HALF FLAGS
 132
 133 FR==525252
 134 FRFIRWD==400000 ;ONE FOR FIRST WORD OF BLOCK
 135 FRSYMS==200000  ;ONE IF SYM PUNCH DESIRED
 136 FRLOC==100000   ;ONE BETWEEN ABS LOC ASSIGN AND
 137         ;FIRST BLOCK OUTPUT THEREAFTER (EBLK TO OUTPUT NULL BLOCK SO LINKING LOADER KNOWS $.)
 138
 139 FRNPSS==40000   ;ONE IF TWO PASS ASSEMBLY
 140 FRPSS2==20000   ;ONE ON PASS 2
 141
 142 FRINVT==4000    ;USED BY PBITS AND OUTPUT TO OUTPUT WORDS OF CODE BITS IN CORRECT ORDER (STEAD LOGICAL)
 143 FRNLIK==2000    ;TEMPORARILY SUPPRESS ADR LINKING
 144 FRGLOL==1000    ;ONE IF LOCATION PLUS OFFSET IS GLOBAL
 145
 146 FRBIT7==400     ;SET IF LAST TIPLE OF CODEBITS WAS 7.
 147 FRMRGO==200     ;MACRO PROC TO RETURN TO .GO HACKER W/O READING NEXT CHAR (SEE RCHSAV)
 148
 149 FRCMND==40      ;SET WHILE READING CMD, TELLS RFD TO NOTICE (, _, COMMA.
 150 FRNNUL==20      ;SET ON RETURN FROM RFD IFF NONNULL SPEC.
 151 FRARRO==10      ;TELLS RFD THAT 1ST NAME IS FN1, NOT FN2.
 152
 153 ] ;END IF1
 154 \f
 155 IF1 [
 156
 157         ;INDICATOR REGISTER
 158
 159 ;LEFT HALF
 160 IL==1,,525252
 161 ILGLI==1        ;SET ON " CLEARED EACH SYL
 162 ILVAR==2        ;SET ON '    "     "   "
 163 ILFLO==4        ;FLOATING NUM, SET ON DIGIT AFTER .
 164 ILDECP==10      ;DECIMAL PREFER, SET WHEN . SEEN.
 165 ILUARI==20      ;1 => RIGHT OPERAND TO UPARROW BEING READ
 166 ILLSRT==40      ;RETURN FROM <
 167 ILWORD==400     ;SET IF CURRENT WORD IS NOT NULL RETURNED BY GETWORD
 168 ILNPRC==1000    ;ONE IF NUMBER ALREADY PROCESSED BY UPARROW
 169 ILMWRD==4000    ;SET ON MULTIPLE WORD
 170 ILPRN==10000    ;SET DURING MACCL IF MACRO NAME WAS FOLLOWED BY (.
 171 ILMWR1==20000   ;SET BY LBRAK AS SIGNAL TO ITSELF THAT THIS NOT FIRST
 172                 ;WORD OF MULTI-WORD CONSTANT
 173 ILNOPT==40000   ;CONSTANTS OPTIMIZATION SUPPRESSION FLAG; SHOULD BE SET BY
 174                 ;VALUE-RETURNING PSEUDO DURING NOT PUNCHING PASS TO KEEP ITSELF OUT OF
 175                 ;CONSTANTS OPTIMIZATION
 176
 177
 178 ;RIGHT HALF
 179
 180 IR==525252
 181 IRFLD==1        ;SET IF FLD NOT NULL
 182 IRSYL==2        ;SET IF SYL NOT NULL
 183 IRLET==4        ;SET IF SYL IS SYMBOL
 184 IRDEF==10       ;SET IF CURRENT EXPR DEFINED
 185 IRNOEQ==20      ;SET IF = ISN'T ALLOWED IN CURRENT CONTEXT.
 186 IRCOM==40       ;SET IF CURRENT QUAN IS COMMON
 187 IRPERI==100     ;SET IF PERIOD SEEN IN WHAT IS SO FAR (INCL .) A NUMBER
 188 IREQL==200      ;ONE DURING READING WORD TO RIGHT OF =
 189 IRIOINS==400    ;FIRST FIELD OF CURRENT WORD HAS IO INST
 190 IRCONT==1000    ;SET IF NOT OK TO END BLOCK
 191 IRPSUD==4000    ;SET IF ERROR COMMENTS WILL COME FROM PSEUDO
 192 IRGMNS==20000   ;SET IF ILUARI OR BAKARI HAS GOBBLED MINUS
 193 IROP==200000    ;SET IF OPERATOR SEEN IN CURRENT FIELD
 194
 195
 196 CALL=PUSHJ P,
 197 RET=POPJ P,
 198 SAVE=PUSH P,
 199 REST=POP P,
 200
 201 ETSM=1000,,     ;ERROR, TYPE SYM.
 202 ETR=2000,,      ;ERROR, ORDINARY MESSAGE.
 203 ERJ=3000,,      ;ERROR, NO MESSAGE, RETURN TO ADDR.
 204 ETI=4000,,      ;ERROR, IGNORE LINE, RET. TO ASSEM1.
 205 ETA=5000,,      ;ERROR, RET. TO ASSEM1.
 206 ETASM=6000,,    ;ERROR, TYPE SYM AND RETURN TO ASSEM1
 207 ETF=7000,,      ;FATAL ERROR.
 208 TYPR=(37000)    ;UUO, TYPE OUT ASCIZ STRING
 209 ] ;END IF1
 210 \f
 211 IF1 [
 212 ;LINK TABLE (GLOTB), ACCUMULATES GLOBAL REFERENCES FOR CURRENT FROB (USUALLY WORD) TO OUTPUT
 213 ;GLSP2 POINTS TO (I.E. HAS ADR 1 LESS THAN) BOTTOM OF ACTIVE PART OF TABLE
 214 ;GLSP1 POINTS TO TOP (HAS ADR OF LAST ENTRY ACTIVE)
 215
 216 ;ACTUAL ENTRIES IN GLOTB:
 217 ;IF ENTIRE WORD ZERO, ENTRY IS NULL, WILL (OR SHOULD) BE IGNORED
 218 ;RH ADR OF SQUOZE WITH INTERNAL MIDAS FLAGS (USUALLY IN SYMBOL TABLE, BUT MAY BE ANYWHERE IN CORE)
 219 ;LH: RIGHT 10. BITS MULTIPLICATION FACTOR OR 0 => 1
 220         ;GLOBAL SHOULD BE MULTIPLIED BY IT
 221 ;REST OF LH FLAGS:
 222
 223 ;SIGN BIT => THIS NOT PART OF FIELD, DON'T PLAY WITH FLAGS AT GETFLD, INTFD
 224 ACF==40000      ;AC LOW OR HIGH (SWAPF => HIGH)
 225 HFWDF==100000   ;MASK GLOBAL TO HALFWORD
 226 SWAPF==200000   ;SWAP
 227 MINF==20000     ;NEGATIVE OF GLOBAL
 228
 229 IFNDEF LBRKT,LBRKT=="[  ;LEFT DELIMITER FOR EXPLICITLY GROUPED CONDITIONALS, MACRO ARGS, REPEAT BODY, ETC.
 230 IFNDEF RBRKT,RBRKT=="]  ;RIGHT "
 231 IFNDEF WPS,     WPS==3  ;# CONTIG. WDS /STE. IFNDEF FOR DEBUGGING.
 232 IFNDEF BKWPB,BKWPB==3   ;# WDS/BKTAB ENTRY.
 233 IFNDEF EOFCH,EOFCH==3   ;EOF CHAR, BEWARE DISPATCH TABLE ENTRIES.
 234 IFNDEF LBRACE,LBRACE=="{
 235 IFNDEF RBRACE,RBRACE=="}
 236
 237 ;3RDWRD LH. SYM TAB BITS
 238
 239 3REL==600000    ;RELOC BITS, DO NOT CHANGE, SOMETIMES REFERENCED BY NUMERIC BYTE POINTERS
 240 3RLL==400000    ;R(LH)
 241 3RLR==200000    ;R(RH)
 242 3RLNK==100000   ;R(LINK)
 243 3KILL==40000    ;FULLY-KILLED SYM (DON'T GIVE TO DDT).
 244 3VP==20000      ;VALUE PUNCHED
 245 3SKILL==10000   ;SEMI KILL IN DDT
 246 3LLV==4000      ;LINKING LOADER MUST INSERT VAL
 247 3VAS2==2000     ;VAR SEEN ON PASS TWO WITH '
 248 3VCNT==1000     ;USED IN CONSTANT
 249 3MAS==400       ;THIS ISN'T THE LAST DEFINITION OF A SYM WITH THIS NAME
 250                 ;(SO ES MUST KEEP SEARCHING).
 251 3NCRF==200      ;DON'T CREF THIS SYMBOL.
 252 3MACOK==100     ;OK TO (RE)DEFINE THIS SYM AS MACRO.
 253                 ;(IE IS A MACRO OR SEEN ONLY IN .XCREF)
 254 3LABEL==40      ;ILLEGAL TO REDEFINE THIS SYM TO DIFFERENT VALUE
 255 3MULTI==20      ;THIS SYM IS MULTIPLY DEFINED, SO FLAG ALL DEFINITIONS.
 256 3DOWN==10       ;THIS DEFINITION SHOULD BE SEEN BY SUBBLOCKS IN 1PASS MODE.
 257
 258 3DFCLR==737110  ;BITS IN LH TO CLEAR ON REDEFINITION.
 259
 260 ;CONTROL FLAGS
 261 ;LEFT HALF
 262 TRIV==400000    ;1 IF OUT FORM IS FOR TRIVIAL LOADER (ABSOLUTE)
 263 ;RIGHT HALF
 264 ARIM==2         ;IF ONE OUT FOR IS RIM
 265 SBLKS==10       ;IF ONE OUT FORM IS SIMPLE BLOCKS
 266 ARIM10==20      ;PDP-10 RIM
 267 DECREL==40      ;DEC RELOCATABLE FORMAT (CONSIDERED "ABSOLUTE" INSIDE MIDAS)
 268 FASL==100       ;LISP FASL COMPATIBLE RELOCATABLE FORMAT  ( "  "  ")
 269
 270 ] ;END IF1
 271 \f
 272 IF1 [
 273
 274 ;SQUOZE FLAG DEFINITIONS IN MIDAS SYMBOL TABLE
 275
 276 CMMN==0         ;COMMON (NOT USED)
 277 PSUDO==40000    ;PSEUDO OR MACRO, VALUE RH ADDR OF RTN (MACCL FOR MACRO),
 278                 ; LH WILL BE IN LH OF B WHEN RTN CALLED.
 279 SYMC==100000    ;SYM, VALUE IS VALUE OF SYM.
 280 LCUDF==140000   ;LOCAL UNDEF
 281 DEFLVR==200000  ;DEF LOC VAR, VALUE IS VALUE.
 282 UDEFLV==240000  ;UNDEF LOC VAR, VALUE IS 1+ IDX IN VARIAB. AREA, BUT IGNORD IF VAR AREA GLOB.
 283 LGBLCB==300000  ;CODE BITS EQUAL TO THIS OR HIGHER REPRESENT GLOBAL QUANTITIES
 284 DEFGVR==300000  ;DEF GLO VAR, VALUE IS VALUE
 285 UDEFGV==340000  ;UNDEF GLO VAR, VALUE LIKE UNDEF LOCAL VAR.
 286 GLOETY==400000  ;GLO ENTRY
 287 GLOEXT==440000  ;GLO EXIT
 288 NCDBTS==GLOEXT_<-18.+4>+1       ;# CODE BIT TYPES
 289
 290 DEFINE CDBCHK TBLNAM
 291 IFN .-<TBLNAM>-NCDBTS,.ERR TBLNAM LOSES
 292 TERMIN
 293
 294 ;LOADER BLOCK TYPES LINK
 295 LLDCM==1        ;LOADER COMMAND BLOCK
 296 LABS==2         ;ABSOLUTE
 297 LREL==3         ;RELOCATABLE
 298 LPRGN==4        ;PROG NAME
 299 LLIB==5         ;LIBRARY BLOCK
 300 LCOMLOD==6      ;LOAD INTO COMMON
 301 LGPA==7         ;GLOBAL PARAMETER ASSIGN
 302 LDDSYM==10      ;LOCAL SYMS
 303 LTCP==11        ;LOAD TIME COND ON PRESENCE
 304 ELTCB==12       ;END LOAD TIME COND
 305 LPLSH==22       ;POLISH FIXUP
 306
 307 ;LOADER COMMANDS
 308 ;IN ADR OF LDCMD BLK
 309 LCJMP==1        ;JUMP
 310 LCGLO==2        ;GLOBAL LOC ASSIGN
 311 LCCMST==3       ;SET COMMON BENCHMARK
 312 LCEGLO==4       ;END OF GLOBAL BLOCK
 313 LDCV==5         ;LOAD TIME COND ON VALUE
 314 LDOFS==6        ;LOADER SET GLOBAL OFFSET
 315 LD.OP==7        ;LOADER .OP
 316
 317 ;LOADER CODEBITS SECOND SPEC AFTER 7
 318 CDEF==0         ;DEF
 319 CCOMN==1        ;COMMON REL
 320 CLGLO==2        ;LOC-GLO REC
 321 CLIBQ==3        ;LIBREQ
 322 CRDF==4         ;GLO REDEF
 323 CRPT==5         ;REPEAT GLOBAL VALUE
 324 CDEFPT==6       ;DEFINE SYM AS $.
 325
 326 ;DEC RELOCATABLE BLOCK TYPES.
 327 DECWDS==1       ;STORAGE WORDS.
 328 DECSYM==2       ;SYMBOL DEFS OR GLOBAL ADDITIVE RQS.
 329 DECHSG==3       ;LOAD INTO HIGH SEG (FOR .DECTWO)
 330 DECENT==4       ;ENTRY NAMES
 331 DECEND==5       ;END BLOCK, HAS PROGRAM BREAK.
 332 DECNAM==6       ;PROGRAM NAME.
 333 DECSTA==7       ;STARTING ADDRESS BLOCK.
 334 DECINT==10      ;INTERNAL REQUEST
 335 DECRQF==16      ;REQUEST LOADING A FILE
 336 DECRQL==17      ;REQUEST LOADING A LIBRARY
 337 ] ;END IF1
 338 \f
 339 IF1 [
 340
 341 DEFINE PRINTA A,B,C,D,E,F
 342 IF1,[PRINTC \7fA!B!C!D!E!F
 343 \7f]
 344 TERMIN
 345
 346 IF1 [DEFINE BNKBLK OP
 347 OP
 348 TERMIN ]
 349
 350         ;ADD A LINE TO BNKBLK, ACCUMULATED CONTENT OF
 351         ;WHICH IS DUMPED OUT AT END OF ASSEMBLY
 352         ;ARG TO BLCODE SHOULD BE FREE OF STORAGE WORDS
 353
 354 DEFINE BLCODE NEWCFT
 355 IF1 [BNKBLK [DEFINE BNKBLK OP
 356 OP]NEWCFT
 357 TERMIN ]
 358 IF2 [IRPW X,,[
 359 NEWCFT
 360 ]
 361 IRPS Y,,X
 362 Y=Y
 363 .ISTOP TERMIN TERMIN ] TERMIN
 364
 365                 ;3RDWRD MANIPULATING MACROS
 366                 ;GET 3RDWRD INTO LH("A"), "B" HAS INDEX OF 1STWRD INTO SYMBOL TABLE
 367
 368 DEFINE 3GET A,B
 369         MOVE A,ST+2(B)
 370         TERMIN
 371
 372                 ;GET 3RDWRD INTO "A", "B" HAS ADR OF 1STWRD
 373
 374 DEFINE 3GET1 A,B
 375         MOVE A,2(B)
 376         TERMIN
 377
 378                 ;PUT "A" INTO 3RDWRD, "B" HAS INDEX OF 1STWRD INTO SYMBOL TABLE
 379
 380 DEFINE 3PUT A,B
 381         MOVEM A,ST+2(B)
 382         TERMIN
 383
 384                 ;PUT "A" INTO 3RDWRD, "B" HAS ADR OF 1STWRD
 385
 386 DEFINE 3PUT1 A,B
 387         MOVEM A,2(B)
 388         TERMIN
 389
 390 ] ;END IF1
 391 \f
 392 IF1 [
 393
 394                 ;RANDOM MACRO DEFINITIONS
 395
 396                 ;A HAS ADR OF SYM SQUOZE, SKIP IF IT'S IN SYMBOL TABLE
 397
 398 DEFINE SKPST A
 399         CAIL A,ST
 400         CAML A,MACTAD
 401 TERMIN
 402
 403                 ;EXECUTE AN INSTRUCTION WITH VARIOUS ADDRESSES (USUALLY PUSH OR POP)
 404
 405 DEFINE INSIRP A,B
 406         IRPS %ADR,,[B]
 407                 A,%ADR
 408         TERMIN
 409 TERMIN
 410
 411 DEFINE NOVAL
 412         TDNE I,[ILWORD,,IRNOEQ\IRFLD]
 413          ETSM ERRNVL
 414 TERMIN
 415
 416 DEFINE NOABS
 417         SKIPGE CONTRL
 418          ETASM ERRABS
 419 TERMIN
 420
 421 ] ;END IF1
 422
 423 ERRNVL==[ASCIZ /Returns no value/]
 424 ERRABS==[ASCIZ /Allowed only for STINK relocatable format/]
 425
 426 IF1 [
 427
 428 DEFINE MOVEIM B,C
 429         MOVEI A,C
 430         MOVEM A,B
 431 TERMIN
 432
 433 DEFINE MOVEMM B,C
 434         MOVE A,C
 435         MOVEM A,B
 436 TERMIN
 437 ] ;END IF1
 438 \f
 439 IF1 [
 440 IFN 0,[
 441 ;THESE ARE SOME MACRO DEFINITIONS FOR THE UNFINISHED MULTI-WORD
 442 ;SYMBOL NAME FEATURE. FOR COMPATIBILITY, THEY ALL NOW HAVE DEFINITIONS
 443 ;THAT ONLY HANDLE ONE WORD. THOSE OTHER DEFINITIONS COME AFTER THESE.
 444
 445 DEFINE TYPE2 X=SYM
 446         MOVE A,X
 447         CALL SYMTYP
 448 IFSN X,SYM,SKIPE A,X+1
 449 .ELSE      SKIPE A,SYMX
 450          CALL SYMTYP
 451 TERMIN
 452
 453 DEFINE COPY2 X,Y,Z=USING A
 454         MOVE Z,X
 455         MOVEM Z,Y
 456         MOVE Z,X+1
 457         MOVEM Z,Y+1
 458 TERMIN
 459
 460 DEFINE STORE2 AC,Y,Z=USING A
 461         MOVEM AC,Y
 462         MOVE Z,AC!X
 463         MOVEM Z,Y+1
 464 TERMIN
 465 ]
 466
 467 .ELSE [
 468 ;THESE ARE THE DEFINITIONS OF THE MACROS THAT DO NOT IMPLEMENT
 469 ;MULTI-WORD SYMBOL NAMES.
 470
 471 DEFINE TYPE2 X=SYM
 472         MOVE A,X
 473         CALL SYMTYP
 474 TERMIN
 475
 476 DEFINE COPY2 X,Y,Z=USING A
 477         MOVE Z,X
 478         MOVEM Z,Y
 479 TERMIN
 480
 481 DEFINE STORE2 AC,Y,Z=USING A
 482         MOVEM AC,Y
 483 TERMIN
 484 ]
 485
 486 DEFINE USING X
 487 X,TERMIN
 488
 489 ] ;END IF1
 490 \f
 491 IFN DECSW\TNXSW,[
 492 IF1 [
 493 IFE .OSMIDAS-SIXBIT/ITS/,[
 494   IFE CMUSW\SAILSW,.INSRT SYS:DECDFS
 495   IFN SAILSW,   .INSRT SYS:SAIDFS
 496   IFN CMUSW,    .INSRT SYS:CMUDFS
 497   IFN TNXSW,    .INSRT SYS:TNXDFS
 498 ] ;IF ASSEMBLED ON ITS
 499 IFN .OSMIDAS-SIXBIT/ITS/,[ ;OTHER PLACES DON'T KEEP THESE ON SYS:
 500   IFE CMUSW\SAILSW,.INSRT DECDFS
 501   IFN SAILSW,   .INSRT SAIDFS
 502   IFN CMUSW,    .INSRT CMUDFS
 503   IFN TNXSW,    .INSRT TNXDFS
 504 ] ;IF ASSEMBLED ON A NON-ITS PLACE
 505 .DECDF
 506
 507 IFN TNXSW,[EXPUNGE RESET        ; THE ONLY CONFLICTING JSYS/CALLI
 508 .TNXDF
 509 ] ;IFN TNXSW
 510
 511 EXPUNGE .SUSET
 512 DEFINE .SUSET A
 513 TERMIN
 514
 515 DEFINE HALT
 516         JRST 4,.
 517 TERMIN
 518
 519 EXPUNGE .VALUE
 520 EQUALS .VALUE HALT
 521 DEFINE .LOSE A
 522         JRST 4,.-1
 523 TERMIN
 524 ] ;IF1
 525 IFN PURESW,.DECTWO
 526 IFE PURESW,.DECREL
 527 RL0==.
 528 ] ;IFN DECSW\TNXSW
 529
 530 IFN ITSSW,[IF1 [IFNDEF .IOT,[.INSRT SYS:ITSDFS
 531         .ITSDF
 532 ] ;IFNDEF .IOT
 533 IFNDEF %PIPDL,.INSRT SYS:ITSBTS
 534         HALT==.VALUE
 535         EXPUNG .JBTPC,.JBCNI
 536
 537 DEFINE SYSCAL A,B
 538         .CALL [SETZ ? SIXBIT/A/ ? B ((SETZ))]
 539 TERMIN
 540 ] ;IF1
 541 RL0==0
 542 IFDEF .SBLK,.SBLK
 543 ] ;IFN ITSSW
 544 \f
 545 IFE PURESW,[    ;FOLLOWING IF NOT ASSEMBLING PURE CODING
 546
 547 DEFINE PBLK
 548 TERMIN
 549
 550 DEFINE VBLK
 551 TERMIN
 552 ]
 553
 554 IFN PURESW,[    ;FOLLOWING IF ASSEMBLING PURE CODING
 555
 556 ;MEMORY ORGANIZATION PURE CODING
 557
 558 ;MAXVAR BLOCKS OF IMPURE CODING, NO DYNAMIC ALLOCATION
 559         ;BLCODE MACRO ACCUMULATES CODING TO BE PUT AT END OF
 560         ;IMPURE CODING, NO STORAGE WORDS ALLOWED
 561 ;THEN SYM TAB, STARTING AT ST.
 562 ;THEN MACRO TABLE (WITH INIT. CODE IN IT)
 563 ;STARTING INITIALLY AT MACTBA, ACTUAL ADDR IN MACTAD.
 564 ;SYMTAB AND MACTAB DON'T NECESSARILY START ON PAGE BNDRYS.
 565 ;THEN GAP TO MINPUR*2000 (HEREAFTER KNOWN AS "THE GAP")
 566 IFN DECSW\TNXSW,MINPUR==200
 567 IFN ITSSW,MINPUR==140   ;BLOCK NUMBER BEGINNING OF PURE CODING
 568 ;PURE CODING UNTIL MAXPUR*2000-SOMETHING
 569 ;THE FOLLOWING MACROS AND BLCODE MAKE IT NOT COMPLETELY NECESSARY
 570 ;TO SEPARATE PURE CODING FROM IMPURE
 571
 572 CKPUR==0        ;0 => ASSEMBLING BELOW THE GAP, 1 ABOVE
 573
 574                 ;SWITCH TO CODING ABOVE THE GAP
 575
 576 DEFINE PBLK
 577 IFN CKPUR,.ERR PBLK
 578 IFE CKPUR,[VAR.LC==.
 579 LOC PUR.LC
 580 ]CKPUR==1
 581 TERMIN
 582
 583 PUR.LC==MINPUR*2000+IFN DECSW,[RL0]     ;SAVED LOCATION COUNTER ABOVE THE GAP WHEN ASSEMBLING BELOW
 584
 585                 ;SWITCH TO CODING BELOW THE GAP
 586
 587 DEFINE VBLK
 588 IFE CKPUR,.ERR VBLK
 589 IFN CKPUR,[PUR.LC==.
 590 LOC VAR.LC
 591 ]CKPUR==0
 592 TERMIN
 593
 594 PBLK            ;PBLK NORMAL MODE, VARIABLE AREAS BRACKETED WITH VBLK AND PBLK
 595
 596 ]               ;END PURESW CONDITIONAL
 597
 598 .YSTGW          ;SET UP NOW, STORAGE WORDS OK
 599 \f
 600 FOO==.
 601 LOC 41
 602         JSR ERROR
 603 IFN ITSSW,JSR TSINT
 604 IFN DECSW,[IFE SAILSW,LOC .JBAPR
 605 .ELSE LOC JOBAPR
 606         TSINT1]
 607 LOC FOO
 608
 609                 ;DISPATCH TABLE FOR NON-SQUOZE CHARACTERS
 610                 ;REFERENCED AS DTB-40(RH OF POPJ IN GDTAB)
 611                 ;DTB ENTRY OF SYL TERMINATOR PUT IN CDISP BY GETSYL
 612
 613 DSYL==400000    ;SYL OPERATOR, DISPATCH INDEXED BY RH AT GETSYL (MUST BE SIGN)
 614 DFLD==200000    ;FIELD OPERATOR, GETFD
 615 DWRD==100000    ;WORD OP, GETWD
 616 DSY1==1000      ;SET ONLY IF DSYL SET,
 617                 ;SET IF OP MIGHT BE 1ST CHAR OF NONNULL SYL.
 618 DSYL1==DSYL+DSY1
 619 DSY2==400       ;SET FOR _ ONLY.
 620
 621 ;ALL CLEAR => WORD TERMINATOR, NO DISPATCH
 622
 623 DTB:    DWRD,,SPACE     ;40  SP, TAB, RUBOUT
 624         DSYL1,,RRL2     ;EXCLAIM AND OPEN-BRACE
 625         DSYL1,,DQUOTE   ;"
 626         DFLD,,XORF      ;NUM SIGN
 627         DSYL,,RBRAK2    ;CLOSE-BRACE.
 628         0               ;(USED TO BE PERCENT SIGN)
 629         DFLD,,ANDF      ;AMPERSAND
 630         DSYL1,,SQUOTE   ;'
 631         DFLD,,LEFTP     ;(  50
 632         DSYL,,RPARN     ;)
 633         DFLD,,MULTP     ; STAR  TIMES
 634         DFLD,,PLS       ;+  PLUS
 635         DWRD,,COMMA     ; ,
 636         DFLD,,MINUS     ;-
 637         DSYL1,,CTLAT    ;^@ (56)
 638         DFLD,,DIVID     ;/
 639         DSYL1,,COLON    ;COLON  60
 640         DSYL,,SEMIC     ;SEMI
 641         DFLD,,LSSTH     ;<
 642         DSYL1,,EQUAL    ;=
 643         DSYL,,GRTHN     ;>
 644         0               ;?
 645         DSYL1,,ATSGN    ;AT SIGN
 646         DFLD,,LBRAK     ;[
 647         DFLD,,IORF      ;BACKSLASH 70
 648         DSYL,,RBRAK     ;]
 649         DSYL1,,UPARR    ;^
 650         DSYL+DSY2,,BAKAR ;BACKARR
 651         0               ;CR
 652         0               ;(USED TO BE TAB)
 653         0               ;ALL OTHER
 654         DSYL,,LINEF     ;LF (DSYL TO HACK CLNN)
 655         DSYL,,FORMF     ;FORM FEED (")  100
 656 \f
 657         ;NOTE THAT POPJ P, IS VALID TEST FOR SQUOZENESS
 658         ;EXCEPT FOR EOFCH
 659
 660 GDTAB:  POPJ P,56       ; ^@ GETS IGNORED.
 661         REPEAT 2,POPJ P,76      ;(GDTAB GLOBAL SO OUT OF TS, AIO CAN CLOBBER GDTAB+141 WITH JRST RREOF
 662                 ;ON OLD FILES)
 663 IFN .-GDTAB-EOFCH,.ERR EOFCH DOESN'T AGREE WITH GDTAB.
 664 IFE TS,[POPJ P,76] IFN TS,[JRST RREOF]
 665         REPEAT 5,POPJ P,76
 666         POPJ P,40       ; TAB
 667         POPJ P,77       ; LF
 668         POPJ P,76       ; VERT TAB
 669         POPJ P,100      ; FORM FEED
 670         POPJ P,74       ; CR
 671         REPEAT "!-16-1,POPJ P,76
 672         POPJ P,40       ; SPACE
 673         POPJ P,41       ; !
 674         POPJ P,42       ; "
 675         POPJ P,43       ; #
 676         ADD SYM,%$SQ(D) ; $
 677         ADD SYM,%%SQ(D) ; %
 678         POPJ P,46       ; &
 679         POPJ P,47       ; '
 680         POPJ P,50       ; (
 681         POPJ P,51       ; )
 682         POPJ P,52       ; *
 683         POPJ P,53       ; +
 684         POPJ P,54       ; ,
 685         POPJ P,55       ; -
 686         JSP CH1,POINT   ; .
 687         POPJ P,57       ; /
 688         REPEAT 10.,JSP CH2,RR2  ; DIGITS
 689         POPJ P,60       ; :
 690         POPJ P,61       ; ;
 691         POPJ P,62       ; <
 692         POPJ P,63       ; =
 693         POPJ P,64       ; >
 694         POPJ P,65       ; ?
 695         POPJ P,66       ; @
 696 IFDEF .CRFOFF,.CRFOFF
 697 IRPC Q,,ABCDEFGHIJKLMNOPQRSTUVWXYZ
 698         ADD SYM,%!Q!SQ(D)
 699 TERMIN
 700         POPJ P,67       ; [
 701         POPJ P,70       ; \
 702         POPJ P,71       ; ]
 703         POPJ P,72       ; ^
 704         POPJ P,73       ; _
 705         POPJ P,76       ; NOW LOWER CASE GRAVE ACCENT
 706
 707 IRPC Q,,ABCDEFGHIJKLMNOPQRSTUVWXYZ
 708         ADD SYM,%!Q!SQ(D)
 709 TERMIN
 710 IFDEF .CRFON,.CRFON
 711         POPJ P,41       ;{
 712         POPJ P,76       ;|
 713         POPJ P,44       ;}
 714         POPJ P,76       ;~
 715         POPJ P,40       ; RUBOUT, LIKE SPACE
 716         IFN .-GDTAB-200,.ERR GDTAB LOSES
 717 \f
 718 NSQTB:  IFDEF .CRFOFF,.CRFOFF
 719 IRPC Q,,0123456789
 720         ADD SYM,%!Q!SQ(D)
 721 TERMIN
 722
 723 IRPC Q,,ABCDEFGHIJKLMNOPQRSTUVWXYZ1234567890$%.
 724 %!Q!SQ: 0
 725         SQUOZE 0,Q/50/50/50/50/50
 726         SQUOZE 0,Q/50/50/50/50
 727         SQUOZE 0,Q/50/50/50
 728         SQUOZE 0,Q/50/50
 729         SQUOZE 0,Q/50
 730         SQUOZE 0,Q
 731 TERMIN
 732 IFDEF .CRFON,.CRFON
 733
 734 ;FORMAT TABLE(S)
 735 ;4.9-4.4 ETC SPECIFY SHIFT
 736 ;4.4-3.6 ETC SPECIFY NUMBER BITS
 737 ;FIELD SPECS IN REVERSE ORDER
 738
 739 IFORTB: 0               ;NCNSN 10 ,
 740         0               ;NCNSF 11 IMPOS
 741         0               ;NCNCN 12 ,,
 742         2200,,          ;NCNCF 13 ,,C
 743         2200000000      ;NCFSN 14 ,B
 744         0               ;NCFSF 15 ,B C
 745         0               ;NCFCN 16 ,B,
 746         0               ;NCFCF 17 ,B,C
 747         4400000000      ;FSNSN 20 A
 748         0               ;FSNSF 21 IMPOS
 749         0               ;FSNCN 22 IMPOS
 750         0               ;FSNCF 23 IMPOS
 751         2200440000      ;FSFSN 24 A B
 752         2200220044      ;FSFSF 25 A B C
 753         270400440000    ;FSFCN 26 A B,
 754         2227040044      ;FSFCF 27 A B,C
 755         4400000000      ;FCNSN 30 A,
 756         0               ;FCNSF 31 IMPOS
 757         22220000        ;FCNCN 32 A,,
 758         2200002222      ;FCNCF 33 A,,B
 759         2200440000      ;FCFSN 34 A,B
 760         0               ;FCFSF 35 A,B C
 761         0               ;FCFCN 36 A,B,
 762         0               ;FCFCF 37 A,B,C
 763 FRTBL==.-IFORTB ;LENGTH OF FORMAT TABLE
 764 VBLK
 765 FORTAB: BLOCK FRTBL     ;ACTUAL FORMAT TABLE
 766 FRTBE=.-1
 767 PBLK
 768 \f
 769 ;VARIABLE STORAGE
 770
 771 VBLK
 772
 773 RETURN: JRST .  ;RH HAS RETURN ADR FOR END OF MAJOR ROUTINE (E.G PASS 2)
 774 CDISP:  0       ;CURRENT DISPATCH CODE
 775 PPRIME: 0       ;PUSH DOWN LIST MARKER  (GETFLD)
 776 SCNDEP: 0       ;DEPTH IN SUCCESSFUL BRACKET CONDITIONALS INSIDE INNERMOST LITERAL.
 777 CONDLN: 0       ;LINE NUMBER AT WHICH LAST TOP LEVEL SUCCESSFUL CONDITIONAL ENCOUNTERED
 778 CONDPN: 0       ;PAGE NUMBER-- PRINT THESE IF REACH END AND CONDITIONAL NOT TERMINATED
 779 CONDFI: 0       ;SIXBIT FN1 OF FILE CONTAINING LAST TOP LEVEL SUCCESSFUL CONDITIONAL.
 780 A.SUCC: 0       ;NONZERO IFF LAST CONDITIONAL SUCCEEDED.
 781 ASMOUT: 0       ;0 NORMAL, 1 WITHIN <>, 2 IN (), 3 IN [].
 782 ASMDSP: ASSEM3  ;PLACE TO JUMP TO FROM ASSEM1 LOOP.
 783                 ;ASSEM3 NORMAL. ASSEMC IF WITHIN <>, () OR []
 784                 ;AND .MLLIT ISN'T POS.  LSSTHA AFTER > OR ) SEEN.
 785                 ;[ ;CONND AFTER ] SEEN.
 786 ASMDS1: 0       ;ASMDSP SAVED HERE DURING ASCII, SIXBIT PSEUDOS.
 787 ASSEMP: 0       ;RESTORE P FROM HERE AT ASSEM1. SAVED OVER LITERAL.
 788 ASMI:   0       ;REINIT I AT ASSEM2 FROM ASMI.
 789 GLSPAS: 0       ;RESTORE GLSP1  AT ASSEM1. SAVED OVER LITERAL.
 790 GLSP1:  0       ;POINTER TO BOT OF LINKAGE TABLE IN USE HIGH ADR
 791 GLSP2:  0       ;POINTER TO TOP OF LINKAGE TABLE IN USE LOW ADR
 792 FORMAT: 0       ;ACCUMULATES FORMAT WORD
 793 FORPNR: 0       ;POINTER INTO FORMAT WORD, SHOULD BE FORMAT+1 SO CLOBBERABLE BY LAST IDPB
 794 FLDCNT: 0       ;NUMBER OF FIELDS PUSHED DOWN IN CURRENT WORD
 795 WRD:    0       ;ACCUMULATES VALUE OF WORD
 796 WRDRLC: 0       ;RELOC OF WRD, MUST COME RIGHT AFTER WRD.
 797 T1:     0       ;TEMP
 798 T2:     0       ;TEMP
 799 PBITS1: 0       ;CURRENT CODE BITS
 800 PBITS2: 0       ;NO OF SPECS LEFT IN CURRENT WORD
 801 PBITS4: 0       ;POINTER TO WHERE CURRENT CODE BITS WILL GO
 802 OPT1:   0       ;POINTER FOR STORING IN BKBUF (OUTPUT BUFFER)
 803 CONTRL: 0       ;FLAG REG FOR IO CONTROL ETC, .GE. 0 => RELOCATABLE/1PASS
 804 CDATBC: 0       ;CURRENT DATA BLOCK CODE TYPE
 805 SCKSUM: 0       ;CKSUM FOR SIMPLE BLOCK FORMAT
 806 IFN A1PSW,[
 807 PRGC:   -1      ;ONE LESS THAN # TIMES END HAS BEEN ENCOUNTERED
 808 OUTN1:  -1      ;.GE. 0 => OUTPUT HAS OCCURED IN OTHER THAN 1PASS MODE (NOT INITIALIZED)
 809 OUTC:   -1      ;.GE. 0 => OUTPUT HAS OCCURED DURING CURRENT ASSEMBLY
 810 ]
 811 LINKL:  0       ;SAVE LIMIT OF GLOTB  GETWRD
 812 STRCNT: 0       ;COUNT OF CHARS READ (INCL. DELIM) BY GSYL
 813 STRPNT: 0       ;TEMP AT GSYL, BYTE POINTER TO STRING STORAGE
 814 ISYMF:  -1      ;-1 IF ISYMS HAVE NOT BEEN SPREAD
 815 SMSRTF: -1      ;-1 IF SYMTAB HASN'T BEEN SORTED (PSEUDOS DELETED)
 816 BITP:   0       ;BYTE PNTR TO CODE BITS IN CURRENT (RELOC) BLOCK
 817 LDCCC:  0       ;DEPTH IN LOADTIME CONDS
 818 PARBIT: 0       ;0 OR 4 FOR : OR = (IN GENERAL, TEMP AT P7X)
 819 LABELF: 0       ;-1 IN COLON, SOMETIMES IN EQUAL. CAUSES 3LABEL TO BE SET.
 820 STGSW:  0       ;NON ZERO GIVES ERROR PRINT ON STORAGE WORDS
 821 HKALL:  0       ;NONZERO => HALF-KILL ALL LABELS (.HKALL'S VALUE)
 822 LITSW:  0       ;-1 => USING A LITERAL GIVES AN ERROR
 823 QMTCH:  0       ;-1 => ' AND " NEED MATCHING CLOSINGS (A LA FAIL, MACRO-10)
 824 STARTA: 0       ;STARTING ADDRESS FOR SBLK, RIM
 825 DECBRK: 0       ;LARGEST RELOC. ADDR. LOADED INTO. (USED FOR DEC FMT)
 826 DECBRA: 0       ;LARGEST ABS. ADDR LOADED INTO.
 827 DECBRH: 0       ;LIKE DECBRK BUT FOR ADDRS IN HI SEG.
 828 DECTWO: MOVE    ;NOT = MOVE => .DECTWO WAS DONE, AND THIS WD HAS
 829                 ;ADDR START OF HISEG.
 830 ISAV:   0       ;I FROM FIELD AT AGETFLD
 831 A.PASS: 0       ; .PASS INTSYM, # OF THIS PASS.
 832 A.PPAS: 0       ;.PPASS INTSYM, # OF PASSES.
 833 WPSTE:  NRMWPS  ;# WORDS PER SYMTAB ENTRY
 834 WPSTE1: NRMWPS-1;ONE LESS THAN WPSTE - FOR SPEED.
 835 WPSTEB: ,-NRMWPS(B)     ;RH HAS - # WORDS PER SYMTAB ENTRY; LH HAS INDEX OF B.
 836 SYMSIZ: 0       ;#WDS IN SYMTAB = WPS*<SYMLEN>
 837 SYMLEN: SYMMSZ  ;SYMTAB SIZE (# SYMS)
 838         ;ASSEMBLED-IN VALUE USED AS DEFAULT,  ONLY IF NON-TS.
 839 SYMAOB: 0       ;-<# SYMS>,,0
 840 INICLB: 0       ;-1 IF INITIALIZATION CODE CLOBBERED.
 841 TTYINS: 0       ;AT START OF ASSEMBLY, -1 => .INSRT TTY PASS1, -2 => PASS2 ALSO.
 842 IFN FASLP,[
 843 FASBP:  0       ;PNTR TO FASL OUTPUT BUFFER
 844 FASATP: 0       ;PNTR TO FASL ATOM TABLE
 845 FASAT1: 0       ;PNTR TO FASL ATOM TABLE AFTER READING IN NEW ATOM
 846                 ; (MAYBE UPDATE FASATP TO THIS IF ATOM WAS UNIQUE9
 847 FASAT2: 0       ;BYTE PNTR USED TO STORE ATOM IN
 848 FASIDX: 0       ;INDEX NEXT ATOM LOADED INTO FASAT WILL BE
 849 FASPCH: 0       ;AMOUNT OF FASAT "PUNCHED"
 850 FASCBP: 440400,,FASB    ;BYTE PNTR TO FASL CODE BIT WORD
 851 FASPWB: 0       ;FASL CODE AT PWRD
 852 FASBLC: 0       ;LOSING BLOCK "COUNT"
 853 FASBLS: 0       ;LOSING BLOCK "SYMBOL"
 854 AFRLD:  0       ;LIST READ CURRENT DEPTH
 855 AFRLEN: 0       ;LIST READ CURRENT LENGTH
 856 AFRDTF: 0       ;LIST READ DOT CONTEXT FLAG (0 NORMAL, 1 SAW DOT, 2 SAW "FROB AFTER DOT"
 857 AFRFTP: 0       ;LIST READ SAVED STATE OF FASATP
 858 AFLTYP: 0       ;TYPE LIST OP IN- 0 EVAL AND THROW AWAY VALUE
 859                         ;1 "RETURN" LIST
 860                         ;2 "RETURN" VALUE OF LIST
 861 ]
 862 PBLK
 863 \f
 864                 ;INFO CONVENIENT TO ANYONE GENERATING AN OUT OF TIME-SHARING MIDAS
 865
 866 ;MIDAS OUT OF TIME-SHARING ASSEMBLES INTO A COLLECTION OF SUBROUTINES
 867 ;IO IS EXPECTED TO BE HANDLED BY OTHER PROGRAMS.
 868
 869 ;EXITS FROM THE ASSEMBLER:
 870 ;TPPB OUTPUT BINARY WORD IN A
 871 ;TFEED IF OUTPUT DEVICE IS PTP, PUNCH OUT # FRAMES OF BLANK TAPE
 872         ;SPECIFIED BY B, MAY CLOBBER A AND B
 873 ;GO2 RETURN POINT FROM FATAL ERRORS
 874 ;TYO TYPE OUT CHARACTER IN A
 875 ;TAB TYPE OUT A TAB (MAY CLOBBER A OF COURSE)
 876 ;RCHTBL SEE THE RCH ROUTINES
 877
 878 ;ENTRIES
 879
 880 ;PDL, LPDL MAY BE USED BY COMMAND PROCESSOR BUT WILL BE CLOBBERED BY MAIN ROUTINES
 881 ;MAIN ROUTINES, CALLED WITH JSP A, , CLOBBER THE WHOLE WORLD (INCLUDING P)
 882 ;INIT INITIALIZE
 883 ;PS1 PASS 1
 884 ;PLOD IF APPROPRIATE, PUNCH OUT LOADER
 885 ;PS2 PASS 2 (DOES ITS OWN PARTIAL INITIALIZATION)
 886 ;PSYMS PUNCH OUT SYMBOL TABLE
 887
 888 ;OTHER ENTRIES
 889
 890 ;CONTRL AFTER ASSEMBLY, .GE. 0 => RELOCATABLE, .LT. 0 => ABSOLUTE
 891 ;ISYMF -1 IF SYMS HAVE NOT BEEN SPREAD, ELSE DON'T TRY TO ADD TO INITIAL SYMBOL TABLE
 892 ;SMSRTF -1 IF SYMTAB HASN'T BEEN SORTED, ELSE SYMTAB CLOBBERED, DON'T RE-ASSEMBLE
 893 ;MIDVRS .FNAM2 OF MIDAS ENGLISH
 894
 895 ;SOME FF FLAGS ARE GLOBAL SO COMMAND PROCESSOR CAN KNOW WHAT'S HAPPENED ON RETURN
 896
 897 ;COMMAND PROCESSOR MAY ADD TO INITIAL SYMBOL TABLE BEFORE CALLING INIT THE FIRST TIME
 898 ;EISYMT IS THE FIRST LOCATION OK TO DUMP INTO
 899 ;EISYMP RH SHOULD BE SET BY COMMAND PROCESSOR TO FIRST LOC NOT DUMPED INTO
 900 ;INTSYM RH OF SYMTAB VALUE TO RETURN VALUE ADDRESSED BY LH(SYMTAB ENTRY)
 901
 902 ;RCH HAS AN ELABORATE SET OF GLOBALS, WHICH I DON'T FEEL LIKE PUTTING DOWN NOW, BUT THEY INCLUDE
 903 ;RCH (GET CHAR) SEMIC, RRL1, RREOF, SEMICR, SEMIC, TYPCTL, GDTAB, CPGN, CLNN,
 904 ;RCHMOD, MDSCLR, MDSSET, RCHSET, POPLMB, PSHLMB
 905 ;ALSO RCHTBL ONLY EXIT
 906
 907 ;LISTING FEATURE GLOBALS:
 908 ;PILPT PRINT CHAR IN A
 909 ;LISTON LISTING ON/OFF FLAG, -1 => ON
 910 ;LISTP SAME WORD AS LISTON.
 911 ;LISTP1 POSITIVE => LIST EVEN ON NON-PUNCHING PASS.
 912 ;LPTCLS END OF LISTING, PRINT FORM FEED, IF TS THEN CLOSE LPT
 913
 914 ;CREF FEATURE GLOBALS:
 915 ;CRFOUT OUTPUT WORD IN A.
 916 ;CREFP -1 => REQUEST GENERATION OF CREF OUTPUT.
 917 ;THE RUBOUT-B-^W HEADER, THE SET-SOURCE-FILE BLOCK, AND THE EOF BLOCK
 918 ;ARE THE RESPONSIBILITY OF THE COMMAND PROCESSOR.
 919 \f
 920 ;;RCH           ;CHARACTER INPUT ROUTINES
 921
 922 IFN RCHASW\MACSW,[
 923                 ;SAVE LIMBO1 STATUS AND RH(B)
 924                 ;THEN SET UP FOR NEW INPUT MODE (DESCRIPTOR IN A)
 925                 ;CALLED BY PUSHEM AND PUSHTT
 926
 927 PSHLMB: HRL B,LIMBO1    ;LAST CHARACTER INPUT
 928         TLZE FF,FLUNRD  ;RE-INPUT CHARACTER ON RETURN?
 929         XCT LSTPLM      ;SET B'S SIGN; IF LISTING, JRST PSHLML.
 930 PSHLMN: EXCH A,RCHMOD   ;GET OLD MODE IN A
 931         DPB A,[360500,,B]       ;STORE IN 5 OF HIGH 6 BITS IN B
 932         PUSH F,B        ;SAVE RESULTANT CRUD
 933         CAMN A,RCHMOD   ;COMPARE NEW WITH OLD
 934         POPJ P,         ;SAME => SKIP OVERHEAD OF SETTING NEW MODE
 935         MOVE A,RCHMOD   ;NOW GET NEW MODE
 936         JRST PSHLM1     ;SET UP INSTRUCTIONS FOR NEW MODE
 937
 938 IFN LISTSW,[
 939 ;IF LISTING, LSTPLM HOLDS JRST PSHLML
 940 PSHLML: AOSN PNTSW
 941         JRST PSHLMM     ;LAST WAS BREAK CHR
 942         REPEAT 4,IBP PNTBP
 943         SOSA PNTBP
 944 PSHLMM: SETOM LISTBC
 945         TLO B,400000
 946         JRST PSHLMN
 947 ]
 948
 949                 ;UNDO A PSHLMB (NOTE: IN COMMENTS BELOW, "NEW" MODE IS ON PDL, OLD IN RCHMOD)
 950
 951 POPLMB: POP F,A         ;GET WORD THAT PSHLMB PUSHED
 952         HLRZS A         ;JUST INTERESTED IN LEFT HALF
 953         TRZE A,400000   ;SIGN BIT SET?
 954         TLOA FF,FLUNRD  ;YES, SET FLAG TO RE-INPUT LAST CHAR
 955         TLZA FF,FLUNRD  ;NO, CLEAR FLAG.
 956         XCT POPLML      ;JFCL\IDPB A,PNTBP ;THE LATTER IFF LISTING.
 957         SETZM LIMBO1    ;INITIALIZE FOR DPB
 958         DPB A,[700,,LIMBO1]     ;RESTORE LIMBO1
 959         LSH A,-<18.-6>  ;RIGHT JUSTIFY RCHMOD DESCRIPTOR
 960         CAMN A,RCHMOD   ;COMPARE NEW MODE WITH OLD
 961         POPJ P,         ;SAME => SKIP OVERHEAD OF SETTING NEW MODE
 962         JRST RCHSET     ;SET UP FOR NEW MODE AND RETURN
 963 ]
 964 \f
 965
 966 FOO==0          ;INITIALIZE COUNTER FOR FOLLOWING
 967
 968 DEFINE RCHBLT SIZE,ADR/
 969         MOVSI T,FOO(A)
 970         HRRI T,ADR
 971         BLT T,<SIZE>-1+ADR
 972 FOO==FOO+<SIZE>
 973 TERMIN
 974
 975 DEFINE RCHMOV ADR/
 976         MOVE T,FOO(A)
 977         MOVEM T,ADR
 978 FOO==FOO+1
 979 TERMIN
 980
 981                 ;SET UP FOR INPUT OF MODE TYPE SPECIFIED IN A, CLOBBER A ONLY
 982
 983 RCHSET: MOVEM A,RCHMOD  ;STORE NEW RCHMOD
 984 PSHLM1: TLZ FF,FLMAC\FLTTY      ;CLEAR FLAGS (MAYBE DEVICE ROUTINE SETS ONE)
 985         XCT RCHTBL(A)   ;GET IN A A POINTER TO A DESCRIPTOR TABLE (MAYBE ALSO SET FLAG)
 986         PUSH P,T        ;SAVE T, NEED IT FOR TEMP
 987         RCHBLT 3,RCH2   ;FIRST 3 WORDS RCH2
 988         TLNE FF,FLVOT
 989         JRST POPTJ      ;ALL RCH'S TO GO THROUGH RCH, DON'T DO ANYTHING ELSE
 990 MDSST1: RCHBLT 3,RR1    ;NEXT 3 RR1
 991         RCHMOV RRL1     ;NEXT WORD RRL1
 992 RCHPSN==FOO             ;# WORDS IN ALL TABLES BUT LAST (NOT OF CONSTANT LENGTH)
 993         RCHBLT 6,SEMIC  ;LAST N SEMIC
 994 POPTJ:  POP P,T
 995         POPJ P,
 996
 997 IFN LISTSW,[
 998                 ;SET UP TO "DISPLAY" (ALL RCH'S THROUGH RCH)
 999
1000 MDSSET: TLO FF,FLVOT    ;SET FLAG
1001         MOVEI A,MDSSTB-3        ;SET UP AC
1002         PUSH P,T        ;SAVE T FOR RESTORATION
1003         JRST MDSST1     ;NOW SET UP
1004
1005 MDSSTB: JRST RRL1       ;RR1
1006         HALT
1007         PUSHJ P,RCH     ;RREOF
1008
1009         PUSHJ P,RCH     ;RRL1
1010 IFN .-<MDSSTB-3>-RCHPSN,.ERR LOSSAGE AT MDSSTB.
1011         PUSHJ P,RCH     ;SEMIC
1012         CAIE A,15
1013         JRST SEMIC
1014         JRST SEMICR
1015
1016                 ;CLEAR OUT DISPLAY MODE
1017
1018 MDSCLR: TLZ FF,FLVOT    ;CLEAR FLAG
1019         MOVE A,RCHMOD
1020         JRST RCHSET     ;NOW SET UP FOR REAL IN CURRENT MODE
1021 ] ;END IFN LISTSW,
1022 \f
1023 IFN TS,[        ;TABLE FOR  RCHSET, INDEXED BY MODE
1024                 ;MAYBE THIS CONDITIONAL WANTS TO BE CHANGED TO SOMETHING ELSE
1025
1026 RCHTBL: MOVEI A,RCHFIL          ;0 => INPUT FROM FILE
1027 IFN MACSW,PUSHJ P,RCHMAC        ;1 => INPUT FROM MACRO (DO NOT CHANGE, USED BY MACRO PROCESSOR)
1028 IFN RCHASW,[IFE MACSW,HALT
1029         PUSHJ P,RCHTRC          ;2 => TTY, QUIT ON CR
1030         PUSHJ P,RCHARC          ;3 => TTY, DON'T QUIT ON CR
1031 ]
1032         ;TABLE FOR INPUTTING FROM FILE
1033                 ;MAYBE THIS CONDITIONAL ALSO WANTS TO BE CHANGED
1034
1035 RCHFIL: ILDB A,UREDP    ;GETCHR, GET CHARACTER
1036         CAIG A,14       ;SKIP IF TOO BIG TO BE SPECIAL
1037         XCT RPATAB(A)   ;SPECIAL, DO THE APPROPRIATE THING
1038
1039         JRST RRL1       ;RR1
1040         HALT
1041         PUSHJ P,INCHR3  ;RREOF
1042
1043         ILDB A,UREDP    ;RRL1
1044 IFN .-RCHPSN-RCHFIL,.ERR RCHFIL LOSES.
1045         LDB CH1,[360600,,UREDP] ;SEMIC; FIND WHERE IN ITS WORD UREDP POINTS
1046         IDIVI CH1,7
1047         JRST @SEMIC3(CH1)       ;AND ENTER THE CR-SCANNING LOOP AT THE APPROPRIATE
1048         JFCL                    ;PLACE (IT IS A WORD-BY-WORD LOOP).
1049
1050                 ;TABLE FOR ABOVE, EXECUTED INDEXED BY CHAR, 15 ONLY FROM SEMIC ELSE ANYTHING
1051
1052 RPATAB:
1053 IFN ITSSW,      JFCL            ;0, ON I.T.S. IS NORMAL CHARACTER
1054 .ELSE   CALL RPANUL     ;0, ON DEC SYSTEM, IGNORE IT.
1055         JFCL
1056         JFCL
1057 IFN .-RPATAB-EOFCH,.ERR EOFCH DOESN'T AGREE WITH ENTRY IN RPATAB.
1058         PUSHJ P,INCHR3  ;3, EOFCH
1059         REPEAT 6,JFCL
1060         CALL RPALF      ;LINE FEED
1061         JFCL            ;13
1062         PUSHJ P,RPAFF   ;FORM FEED
1063         JRST SEMICR     ;FROM SEMIC ONLY, EXIT FROM LOOP
1064
1065 RPAFF:  SKIPE ASMOUT    ;FORM FEED
1066          ETR [ASCIZ/Formfeed within <>, () or []/]
1067         AOS CH1,CPGN
1068         SETOM CLNN
1069 IFN ITSSW,[
1070         ADD CH1,[SIXBIT /P0/+1]
1071         MOVE CH2,A.PASS
1072         DPB CH2,[300200,,CH1]
1073         .SUSET [.SWHO3,,CH1]    ;PUT THE NEW PAGE # IN THE WHO-LINE.
1074 ]
1075 RPALF:  AOS CH2,CLNN
1076         CAME CH2,A.STPLN
1077          RET
1078         MOVE CH1,CPGN
1079         CAMN CH1,A.STPPG
1080          SETOM TTYBRF
1081         RET
1082
1083 IFN DECSW,[
1084 RPANUL: MOVE CH1,@UREDP ;SAW A NULL - IN A LINE NUMBER?
1085         TRNN CH1,1
1086          JRST RCHTRA    ;NO, JUST IGNORE IT.
1087         MOVEI CH1,010700
1088         HRLM CH1,UREDP  ;YES, SKIP THIS WHOLE WORD, THEN
1089         CALL RCH        ;SKIP THE 1ST CHAR AFTER THE LINE NUMBER
1090         JRST RCHTRA     ;RETURN THE NEXT CHAR FROM THIS CALL TO RCH.
1091 ]
1092 ] ;END IFN TS,
1093 \f
1094 VBLK
1095 LIMBO1: 0               ;LAST CHARACTER READ BY RCH
1096 RCHMOD: 0               ;CURRENT INPUT MODE, 0 => INPUT FROM FILE, 1 => MACRO, ETC.
1097 CLNN:   0       ;1 LESS THAN LINE # IN CURRENT INPUT FILE.
1098 CPGN:   0       ;1 LESS THAN PAGE # IN CURRENT INPUT FILE
1099 A.STPL: 0       ;1 LESS THAN LINE # TO STOP AT.
1100 A.STPP: 0       ;1 LESS THAN PAGE # TO STOP AT.
1101                 ;(STOPPING MEANS INSERTING THE TTY)
1102
1103 ;READ CHARACTER INTO A FROM INPUT FILE, MACRO, OR WHATEVER (RCH)
1104 ;CLOBBERS A,CH1,CH2.
1105
1106 RCH:    TLZE FF,FLUNRD
1107         JRST RCH1       ;RE-INPUT LAST ONE MAYBE GET HERE FROM RCH2+2
1108 RCH2:   HALT    ;ILDB A,UREDP   ;ILDB A,CPTR    ;GET CHAR
1109         0       ;CAIG A,14      ;TRZE A,200     ;CHECK FOR SPECIAL
1110         0       ;XCT RPATAB(A)  ;PUSHJ P,MACTRM ;SPECIAL, PROCESS
1111         MOVEM A,LIMBO1  ;GOT CHAR, SAVE AS LAST CHAR GOTTEN
1112 IFE TS,RCHLS1==JRST TYPCTL
1113 IFN TS,RCHLS1==RET      ;DEFAULT CONTENTS OF RCHLST (IF NOT LISTING)
1114 RCHLST: RCHLS1          ;AOSN PNTSW IF LISTING.
1115 IFN LISTSW,[
1116         PUSHJ P,PNTR
1117         CAIG A,15
1118         JRST RCHL1
1119 RCHL3:  IDPB A,PNTBP
1120 TYPCTL: POPJ P, ;OR JRST SOMEWHERE
1121 PBLK
1122
1123 RCHL1:  CAIE A,15
1124         CAIN A,12
1125         JRST RCHL2
1126         CAIE A,14
1127         JRST RCHL3
1128 RCHL2:  MOVEM A,LISTBC
1129         SETOM PNTSW
1130         JRST TYPCTL
1131
1132 VBLK
1133 RCH1:   MOVE A,LIMBO1
1134 RCH1LS: RET             ;OR CAILE A,15 IF LISTING.
1135         RET             ;NEEDED IN CASE LISTING.
1136         CAIE A,15
1137         CAIN A,12
1138         JRST RCHL2
1139         CAIE A,14
1140         POPJ P,
1141         JRST RCHL2
1142 PBLK
1143 ] ;END IFN LISTSW,
1144
1145 IFE LISTSW,[
1146 PBLK
1147 RCH1:   MOVE A,LIMBO1
1148         RET
1149 ] ;END IFE LISTSW,
1150 \f
1151 ;;GETSYL                ;VARIOUS SYLLABLE READING ROUTINES (BUT NOT ALL OF THEM)
1152
1153 GSYL:   CLEARB SYM,STRCNT
1154 GSYL1:  MOVEI D,6
1155         MOVE T,[440700,,STRSTO]
1156         MOVEM T,STRPNT
1157 GSYL3:  AOSG A,STRCNT
1158         JRST (F)
1159         PUSHJ P,RCH
1160         IDPB A,STRPNT   ;STORE CHAR IN STRING EVEN IF DELIMITER (MINIMUM STRCNT = 1)
1161 A.GSY2: CAIN A,".
1162         JRST GSYL1C
1163         HLRZ CH1,GDTAB(A)
1164         CAIN CH1,(JSP CH2,)
1165         JRST GSYL1A     ;NUMBER
1166         PUSHJ P,GSYL1B  ;RETURN ONLY ON SYL SEP
1167         HRRZ A,GDTAB(A)
1168         MOVE T,LIMBO1
1169 C%:     POPJ P,"%
1170
1171 GSYL1B: XCT GDTAB(A)    ;POPJ FOR SYL SEPS
1172         SUB P,[1,,1]
1173 GSYL1D: SOJGE D,GSYL3
1174         AOJA D,GSYL3
1175
1176 GSYL1C: ADD SYM,%.SQ(D)
1177         JRST GSYL1D
1178
1179 GSYL1A: XCT NSQTB-60(A)
1180         JRST GSYL1D
1181
1182                 ;VERSION OF GETSYL TO TRY UNTIL SYL OR WORD TERMINATOR FOUND
1183                 ;SKIPS IF NAME THERE (FOR .TYPE, SQUOZE)
1184
1185 GTSLD2: TLNN C,DWRD\DFLD
1186         JRST GTSLD3     ;DELIMITER IS WORD TERMINATOR, TOLERATE THE NULL SYLLABLE
1187 GETSLD: PUSHJ P,GETSYL  ;ENTRY, GET A SYL
1188         MOVE C,CDISP    ;GET CDISP
1189         TRNN I,IRSYL
1190         JRST GTSLD2     ;NO SYL
1191         AOS (P)         ;GOT SYL, CAUSE RETURN TO SKIP
1192 GTSLD3: TLNN C,DWRD\DFLD
1193         TLO FF,FLUNRD   ;CAUSE DELIMITER TO BE RE-INPUT
1194         POPJ P,
1195
1196 PASSPS: SKIPA A,LIMBO1
1197 GPASST:  CALL RCH
1198         CAIE A,40
1199          CAIN A,^I
1200           JRST GPASST
1201         RET
1202 \f
1203 GETSYL: TLZ I,ILUARI+ILNPRC+ILLSRT
1204 GTSL1:  CLEARB SYM,NUMTAB       ;RECUR HERE FOR RIGHT ARG TO ^ AND _.
1205         MOVE AA,[NUMTAB,,NUMTAB+1]
1206         AOSN NTCLF
1207         BLT AA,NUMTAB+10        ;NUMTAB NOT CLEAR, HAVE TO CLEAR IT
1208         MOVEI D,6       ;CHARACTER COUNTER FOR BUILDING UP SYM
1209         SETOM ESBK      ;NO SPECIFIC BLOCK DESIRED.
1210         TDZ I,[ILDECP+ILFLO+ILVAR+ILGLI,,IRPERI+IRLET+IRSYL]
1211 RRL2:   PUSHJ P,RR      ;CALL MAIN LOOP ROUTINE, READ UNTIL NON-SQUOZE CHAR
1212 SEMICR:         ;RETURN HERE FROM SEMIC WITH CR IN A
1213         MOVEM A,LIMBO1  ;SYLLABLE OPERATOR OR TERMINATOR IN A, SAVE
1214         HRRZ A,GDTAB(A) ;NOW GET RIGHT HALF OF POPJ, INDEX INTO DTB
1215         MOVE C,DTB-40(A)        ;GET DTB ENTRY (FLAGS,,JUMP ADR)
1216         MOVEM C,CDISP   ;STORE AS DISPATCH CODE FOR LAST CHAR (SORT OF AN INTERPRETED LIMBO1)
1217 RR8:    TLNE C,DSYL     ;NOW SEE IF SYL OPERATOR FLAG SET
1218         JRST (C)        ;SET => INTRA-SYLLABLE OPERATOR
1219 RR10:   TRNE I,IRLET    ;NOT SET => SYLLABLE TERMINATOR: SYL?
1220         POPJ P,         ;SYL HAS LETTERS
1221         TRNN I,IRSYL
1222         JRST CABPOP     ;NO SYL
1223         CAMN SYM,[SQUOZE 0,.]
1224         JRST PT1        ;SYM IS .
1225                 ;NUMBER
1226
1227 RR5:    TLNN I,ILNPRC
1228         PUSHJ P,NUMSL
1229         TLNN I,ILFLO
1230         JRST RR9        ;NOT FLOATING POINT
1231         MOVE A,B        ;FLOATING, HIGH IN AA,LOW IN A,EXP IN B
1232         ADDI A,306      ;201+105 TO ROUND
1233         ADDI AA,200     ;CAUSE EXPONENT TO BE ACCEPTABLE TO MACHINE
1234         JUMPGE AA,.+3   ;NOW CHECK FOR OVERFLOW ON ROUNDING
1235         LSH AA,-1       ;OVERFLOW, SHIFT BACK ONE
1236         AOS A           ;INCREMENT EXPONENT TO COMPENSATE FOR SHIFT
1237         EXCH A,AA       ;GET EXPONENT IN AA, REST IN A
1238         ASHC AA,-10     ;SHIFT TO MACHINE FLOATING POINT FORMAT
1239         SKIPE AA        ;NOW CHECK HIGH ORDER BITS OF EXPONENT NOT SHIFTED INTO NUMBER
1240         ETR [ASCIZ /Exponent overflow/]
1241 RR9:    TLZ I,ILGLI+ILVAR       ;NOT TRYING TO DEFINE NUMBER AS VARIABLE OR GLOBAL
1242 CLBPOP: TDZA B,B        ;CLEAR OUT B (RELOCATION BITS OF VALUE)
1243 CABPOP: SETZB A,B       ;DO JRST CABPOP TO RETURN ZERO AS VALUE
1244         POPJ P,
1245 \f
1246 RRU:    MOVE A,LIMBO1   ;GET HERE WHEN FLUNRD SET AT RR, RETRIEVE CHARACTER FROM LIMBO1
1247         CAIG A,14       ;IF TOO BIG,
1248         CAIGE A,12      ;OR IF TOO SMALL,
1249         JRST RR1B       ;THEN JUST FALL BACK IN
1250         TLNN FF,FLVOT\FLMAC\FLTTY       ;SKIP IF NOT HACKING CPGN/CLNN
1251         XCT RRUTAB-12(A)        ;HACKING, UNHACK FOR HACK COMING UP
1252         JRST RR1B       ;FALL BACK IN
1253
1254 RRUTAB: SOS CLNN        ;LINE FEED (TABLE FOR RRU)
1255         JRST RR1B       ;13
1256         SOS CPGN        ;FORM FEED
1257
1258                 ;MAIN LOOP ROUTINE FOR GETSYL, READ SYM OR NUMBER
1259 VBLK
1260 RR:     TLZE FF,FLUNRD  ;RE-INPUT LAST CHARACTER?
1261         JRST RRU        ;YES (SOMETIMES RETURN HERE FROM RREOF)
1262 RR1:    JRST RRL1       ;ILDB A,CPTR    ;GET CHAR (" " ")
1263         HALT            ;TRZE A,200     ;CHECK FOR END OF STRING
1264 RREOF:  PUSHJ P,RCH     ;PUSHJ P,MACTRM ;PROCESS CONDITION, GET NEXT CHAR OR JRST RR1 OR RR1-1
1265 RR1B:   XCT GDTAB(A)    ;GOT CHAR, DO SOMETHING APPROPRIATE (POPJ ON NOT SQUOZE)
1266         TROA I,IRLET\IRSYL      ;LETTERS RETURN, JUST UPDATED SYM, SET FLAGS
1267         TRO I,IRSYL     ;NUMBERS RETURN, SET FEWER FLAGS
1268         SOJGE D,RR1     ;DECREMENT SYM COUNTER AND LOOP
1269         AOJA D,RR1      ;COUNTER EXHAUSTED, INCREMENT BACK TO 0 AND LOOP
1270
1271 RRL1:   PUSHJ P,RCH     ;ILDB A,UREDP   ;GET CHAR
1272         XCT GDTAB(A)    ;NOW MAKE LIKE RR1B (EOFCH => JRST RREOF)
1273         TROA I,IRLET\IRSYL
1274         TRO I,IRSYL
1275         SOJGE D,RRL1
1276         AOJA D,RRL1
1277
1278                 ;SEMICOLON (GET HERE FROM RR8)
1279
1280         JRST SEMICL     ;RETURN HERE FROM SEMIC+2 WHEN FLUNRD SET
1281 ;NEXT 4 INSNS ALTERED IN DIFFERENT INPUT MODES. SEE RCHFIL, ETC.
1282 SEMIC:  PUSHJ P,RCH     ;GET CHAR
1283         CAIE A,15       ;SEE IF SPECIAL
1284         JRST SEMIC      ;SPECIAL => DO SOMETHING (JRST SEMICR ON CR)
1285         JRST SEMICR     ;IF NOT SPECIAL THEN GO BACK FOR NEXT CHAR
1286
1287 LOC SEMIC+6     ;LEAVE A LITTLE EXTRA ROOM FOR BIG ROUTINES
1288 PBLK
1289
1290 SEMICL: MOVE A,LIMBO1   ;HERE FROM SEMIC-1, RETRIEVE CHARACTER FROM LIMBO1
1291         CAIE A,15       ;SKIP IF SHOULD TERMINATE SCAN
1292         JRST SEMIC      ;NOT CR, FALL BACK IN
1293         JRST SEMICR     ;DONE
1294
1295 SEMIC2:
1296 REPEAT 5,[
1297         ILDB A,UREDP
1298         CAIG A,15
1299          XCT RPATAB(A)
1300 ]
1301         MOVE A,[ASCII /@@@@@/]
1302 SEMIC1: AOS CH1,UREDP
1303         MOVE CH1,(CH1)  ;ANY CONTROL CHARS IN THE WORD UREDP POINTS AT?
1304         MOVE CH2,CH1
1305         AND CH1,A
1306         AND CH2,[ASCII/     /]
1307         LSH CH2,1
1308         IOR CH1,CH2
1309         CAMN CH1,A
1310          JRST SEMIC1    ;NO, ADVANCE TO NEXT WORD AND TEST IT.
1311         MOVEI A,440700
1312         HRLM A,UREDP
1313         JRST SEMIC2     ;YES, LOOK AT EACH CHAR AND PROCESS IT.
1314
1315 SEMIC3: REPEAT 6,JRST SEMIC2+3*<5-.RPCNT>
1316
1317
1318 \f
1319                 ;JSP CH2,RR2 => DIGIT (FROM GDTAB)
1320                 ;THIS ROUTINE IS GROSSLY SLOW, AND SHOULD BE SPEEDED UP SOMETIME
1321
1322 RR2:    XCT NSQTB-"0(A) ;UPDATE SQUOZE.
1323         TRNE I,IRLET
1324         JRST 1(CH2)     ;SYL IS SYM, DON'T WASTE TIME.
1325         TRNE I,IRPERI
1326         TLO I,ILFLO     ;DIGIT AFTER . => FLOATING.
1327 MAKNUM: SETOM NTCLF     ;NUMTAB ABOUT TO NOT BE CLEAR, SET FLAG FOR GETSYL TO CLEAR IT OUT NEXT TIME
1328         MOVEI AA,2      ;INDEX INTO NUMTAB ETC., SOJGE'D TO GET ALL RADICES
1329 MAKNM1: MOVE T,ARADIX(AA)       ;GET THIS RADIX,
1330         CAMN T,ARADIX   ;REDUNDANT => SKIP THIS PASS.
1331          JUMPN AA,MAKNM4
1332         SKIPGE CH1,HIGHPT(AA)
1333         JRST MAKNM3
1334         MUL T,LOWPT(AA) ;TT HAS OLD LOW TIMES RADIX, T HAS OVFLO TO HIGH.
1335         ADDI TT,-"0(A)  ;ADD DIGIT TO LOW PART
1336         TLZE TT,400000
1337         AOJ T,          ;OVERFLOW, INCREMENT SPILLOVER FROM MUL OF LOWPT
1338         JUMPE CH1,MAKNM5        ;OLG HIGHPT WAS 0 => SAVE TIME.
1339         JFCL 17,.+1     ;NOW CLEAR OV, ETC.
1340         IMUL CH1,ARADIX(AA)     ;MULTIPLY HIGHPT BY RADIX
1341         ADD T,CH1       ;ADD HIGH PARTS
1342         JFCL 10,MAKNM2  ;JUMP ON OVERFLOW FROM IMUL OR ADD
1343 MAKNM5: TLNE I,ILFLO
1344         SOS NUMTAB(AA)  ;FLOATING, DECREMENT EXP TO COMPENSATE FOR MULT OF HIGHPT/LOWPT
1345         MOVEM T,HIGHPT(AA)      ;NOW STORE STUFF BACK
1346         MOVEM TT,LOWPT(AA)
1347 MAKNM4: SOJGE AA,MAKNM1 ;NOW DO ALL THIS FOR NEXT RADIX
1348         JRST 1(CH2)
1349
1350 MAKNM2: MOVSI B,400000  ;OVERFLOW FROM UPDATING HIGH PARTS
1351         IORM B,HIGHPT(AA)       ;SET SIGN BIT
1352 MAKNM3: TLNN I,ILFLO
1353         AOS NUMTAB(AA)  ;NOT FLOATING, INCREMENT EXP, MAY NOT WANT TRAILING BITS
1354         JRST MAKNM4
1355
1356 VBLK
1357 NUMTAB: 0       ;EXPONENT
1358         0
1359         0
1360 HIGHPT: 0       ;HIGH PART OF CURRENT NUMBER THIS RADIX
1361         0       ;4.9 => OVERFLOW, TRAILING DIGITS DROPPED
1362         0
1363 LOWPT:  0       ;LOW PART OF CURRENT NUMBER THIS RADIX
1364         0       ;HIGHPT/LOWPT TAKEN AS 70. BIT POSITIVE INTEGER EXCEPT 4.9(HIGHPT) IS FLAG INSTEAD OF
1365         0       ;EXPONENTIATE 70. BIT INTEGER BY NUMTAB (WHICH MAY BE NEGATIVE) TO GET ACTUAL VALUE
1366 ARADIX: 10      ;CURRENT RADIX
1367         12
1368         10
1369
1370 NTCLF:  -1      ;-1 => NUMTAB NOT CLEAR (TO SAVE BLT AT GETSYL WHEN CLEAR)
1371 PBLK
1372 \f
1373                 ;JRST POINT => . (FROM GDTAB)
1374
1375 POINT:  TLO I,ILDECP    ;PREFER DECIMAL
1376         TROE I,IRPERI   ;SET PERIOD FLAG
1377         TRO I,IRLET     ;2 POINTS => NAME
1378         ADD SYM,%.SQ(D) ;UPDATE SYM
1379         JRST 1(CH1)     ;RETURN
1380
1381 RBRAK:  SOSL SCNDEP     ;IF A CONDITIONAL TO TERMINATE,
1382         JRST RBRAK2     ;HAVE DONE SO, IGNORE CHAR.
1383         SETZM SCNDEP
1384 ;CLOSES OF ALL KINDS COME HERE.
1385 RPARN:
1386 GRTHN:  MOVE A,LIMBO1
1387         SKIPE CH1,ASMOUT        ;WHAT KIND OF OPEN ARE WE IN?
1388         CAIN CH1,4      ;WITHIN A .ASCII OR
1389          JRST RBRAK1    ;NOT WITHIN GROUPING => THIS CLOSE IS STRAY.
1390         CAME A,ASMOT1(CH1) ;RIGHT KIND OF CLOSE FOR THAT OPEN?
1391          ERJ RBRAK3
1392 RBRAK4: MOVE CH1,ASMOT2(CH1)
1393         MOVEM CH1,ASMDSP ;ARRANGE FOR THIS ASSEM1 LEVEL TO EXIT
1394 RBRAK5: SETZM CDISP
1395         JRST RR10       ;AND GO TERMINATE WORD.
1396
1397 RBRAK3: CALL TYOERR     ;COME HERE ON CLOSE WRONG FOR OPEN.
1398                 ;(EG, ")" MATCHING "<").
1399         TYPR [ASCIZ/ Seen when /]
1400         MOVE A,ASMOT1(CH1)
1401         CALL TYOERR
1402         TYPR [ASCIZ/ expected
1403 /]
1404         JRST RBRAK4
1405
1406 RBRAK1: CAIN CH1,4      ;CLOSE INSIDE A .ASCII =>
1407          JRST RBRAK5    ;TERMINATE WORD BUT DON'T CLOSE ANYTHING.
1408         SKIPN CONSML    ;COME HERE FOR STRAY CLOSE.
1409          JRST RRL2
1410         ERJ .+1
1411         TYPR [ASCIZ/Stray /]
1412         MOVE A,LIMBO1   ;GET THE CLOSE WE SAW.
1413         CALL TYOERR
1414         CALL CRRERR
1415         JRST RRL2
1416
1417 ;COME HERE FOR CLOSE-BRACE, AND CERTAIN CLOSE-BRACKETS.
1418 RBRAK2: SETOM A.SUCC    ;HAVE JUST ENDED SUCCESSFUL BRACKETED CONDIT,
1419         JRST RRL2       ;REMEMBER THAT MOST RECENT CONDITIONAL WAS TRUE.
1420
1421 FORMF:  TLNN FF,FLVOT\FLMAC\FLTTY       ;FORM FEED SYLLABLE OPERATOR ROUTINE
1422          PUSHJ P,RPAFF  ;UNLESS ALREADY DONE, INCREMENT PAGE #.
1423         JRST RR10
1424
1425 LINEF:  TLNN FF,FLVOT\FLMAC\FLTTY       ;LINE FEED SYLLABLE OPERATOR ROUTINE
1426          CALL RPALF
1427         JRST RR10
1428
1429 CTLAT:
1430 IFN DECSW,[
1431         TLNN FF,FLVOT\FLMAC\FLTTY       ;^@ SYLLABLE OPERATOR ROUTINE.
1432          CALL RPANUL
1433 ]
1434         JRST RRL2
1435 \f
1436                 ;DECIPHER A VALUE FROM NUMTABS
1437                 ;LEAVES HIGH PART IN AA, LOW PART IN A, BINARY EXPONENT IN B
1438                 ;AND RADIX USED IN D.
1439
1440 NUMSL:  TLNN I,ILVAR\ILDECP\ILFLO
1441          SKIPE B,HIGHPT
1442           JRST NUMSLS
1443         MOVE A,LOWPT    ;BE VERY FAST IN CASE OF SMALL FIXNUM IN CURRENT RADIX.
1444         MOVE D,ARADIX   ;SAVE RADIX AND HIGH PART FOR ^.
1445         SETZ AA,
1446         RET
1447
1448 NUMSLS: CLEARB TT,D     ;TT BIT EXPONENT, D INDEX INTO NUMTAB, ETC.
1449         TLNE I,ILDECP+ILVAR     ;NEITHER . NOR ', CURRENT RADIX.
1450         TLNE I,ILGLI    ;" => CURRENT RADIX DESPITE . OR '.
1451          JRST NUMSL0
1452         MOVEI D,1       ;DECIMAL UNLESS '
1453         TLNE I,ILVAR    ;WHICH FORCES OCTAL.
1454          MOVEI D,2
1455         MOVE A,ARADIX(D)
1456         CAMN A,ARADIX   ;IF REALLY SAME AS CURRENT RADIX,
1457          MOVEI D,0      ;COMPUTATION WASN'T DONE FOR THIS VALUE OF D,
1458                         ;SO USE COMPUTATIONS DONE FOR CURRENT RADIX.
1459 NUMSL0: MOVE AA,HIGHPT(D)       ;AA := HIGH PART
1460         MOVE B,LOWPT(D)         ;B := LOW PART
1461         MOVE T,NUMTAB(D)        ;T := EXPONENT
1462         MOVE D,ARADIX(D)        ;NO LONGER NEED IDX, GET RADIX VALUE.
1463         TLNN I,ILFLO
1464          JRST FIXNUM    ;NOT FLOATING
1465         TLZ AA,400000   ;FLOATING, DON'T NEED DIGITS LOST ON OVERFLOW
1466 NUMC1:  JUMPN AA,.+2    ;ENTRY FROM UPARR
1467         JUMPE B,FIX0    ;COMPLETELY ZERO => RETURN FIXED ZERO
1468         JUMPL T,NUMSL1  ;JUMP IF EXPONENT NEGATIVE
1469         JUMPE T,NUMSL2  ;JUMP (SKIP FOLLOWING) IF EXPONENT ZERO
1470                 ;EXPONENT POSITIVE, DO THE APPROPRIATE THING
1471 NUMSL5: MULI B,(D)      ;MULITIPLY LOW PART BY RADIX
1472         MULI AA,(D)     ;MULTIPLY HIGH PART BY RADIX
1473         ADD A,B         ;A := LOW PART OF HIGH + HIGH PART OF LOW
1474         TLZE A,400000
1475         ADDI AA,1       ;OVERFLOW ON ADDITION, INCREMENT HIGH PART OF HIGH
1476         MOVE B,C        ;NO LONGER NEED HIGH OF LOW, GET LOW OF LOW IN B
1477 NUMSL3: JUMPE AA,NUMSL4 ;NOW CHECK FOR OVERFLOW INTO HIGH OF HIGH, JUMP ON NONE
1478         ASHC A,-1       ;NEXT THREE INSTRUCTIONS TO DO ASH3 AA,-1
1479         ASH A,1
1480         ASHC AA,-1
1481         AOJA TT,NUMSL3  ;INCREMENT BIT EXPONENT AND TRY AGAIN
1482
1483 NUMSL4: MOVE AA,A       ;FLUSHED OVERFLOW, NOW GET (LOW PART OF) HIGH PART IN AA
1484         SOJG T,NUMSL5   ;COUNT DOWN
1485
1486 NUMSL2: TLNN I,ILFLO
1487          JRST NUMSL9    ;NOT FLOATING, DON'T WASTE TIME NORMALIZING.
1488         SKIPA A,B       ;EXPONENT NOW ZERO, GET LOW PART OF NUMBER IN A
1489 NUMSL7: ASHC AA,1       ;NOW NORMALIZE
1490         TLNN AA,200000
1491         SOJA TT,NUMSL7
1492         SKIPA B,TT      ;DONE NORMALIZING, RETURN BINARY EXPONENT IN B
1493 PT1:    TRO I,IRLET
1494         POPJ P,
1495
1496 NUMSL9: MOVE A,B
1497         MOVEI B,0
1498         ASHC AA,(TT)    ;SHIFT 2-WD NUM. BY EXPONENT,
1499         LSH A,1         ;PUT HIGH BIT IN WITH REST.
1500         JRST FIX1
1501 \f
1502 FIX0:   TLZ I,ILFLO
1503 FIXNUM: LSHC A,45
1504 FIX1:   LSHC AA,-1
1505         JUMPE AA,.+2
1506         ETR [ASCIZ /FIXNUM too big for 36 bits/]
1507         POPJ P,
1508
1509 NUMSL1: SKIPA A,B       ;EXPONENT NEGATIVE: NORMALIZE NOW
1510 NUMSL8: ASHC AA,1
1511 NUMSL6: TLNN AA,200000
1512         SOJA TT,NUMSL8  ;NOT NORMALIZED YET
1513         AOS T
1514         MOVEI TM,(D)
1515         TLNN TM,-1      ;GET CONVIENT POWER OF RADIX
1516         JUMPL T,[       IMULI TM,(D)
1517                         AOJA T,.-1]
1518         MOVE B,A        ;GET NORMALIZED LOW PART IN B
1519         IDIV AA,TM      ;DIVIDE HIGH PART BY APPROPRIATE RADIX
1520         DIV A,TM
1521         JUMPL T,NUMSL6
1522         MOVE B,A
1523         JRST NUMSL2
1524
1525 UPARR:  TRON I,IRSYL
1526          JRST UPCTRC    ;"UNARY UPARROW" => GOBBLE CHARS
1527         TRNE I,IRLET
1528          ETR [ASCIZ /Symbolic 1st arg to "^"/]
1529         PUSHJ P,NUMSL   ;DECIPHER NUMTABS
1530         PUSHJ P,UA3     ;GET RIGHT OPERAND IN T
1531         MOVE TT,B       ;EXPONENT
1532         MOVE B,A        ;LOW PART
1533         PUSHJ P,NUMC1   ;T EXP HIGH IN AA LOW IN B TT BIN EXP
1534         MOVE C,CDISP    ;IF A _ WAS DEFERRED WHILE ILUARI WAS SET,
1535         TLO I,ILNPRC
1536         CAME C,[DSYL,,BAKAR] ;DO IT NOW.
1537          JRST RR10
1538
1539 BAKAR:  TLNE I,ILUARI
1540         JRST RR5        ;RETURN TO UPARROW (WILL COME BACK HERE LATER)
1541         TRNE I,IRSYL
1542         TRNE I,IRLET
1543         JRST BAK1       ;NO SYL, OR SYL IS NAME
1544         CAMN SYM,[SQUOZE 0,.]
1545         JRST BAK1       ;. ALSO NAME
1546         TLZN I,ILNPRC
1547         PUSHJ P,NUMSL
1548         PUSHJ P,UA3
1549         ADD B,T
1550         ASHC AA,(B)
1551         LSH A,1
1552         LSHC AA,-1
1553         CLEARB B,AA
1554         TLZ I,ILFLO
1555         MOVE C,[DFLD,,CBAKAR]
1556         EXCH C,CDISP    ;IF 2ND ARG ENDED WITH A _, TURN INTO FIELD OP.
1557         CAME C,[DSYL,,BAKAR]
1558          EXCH C,CDISP
1559         POPJ P,
1560 \f
1561 UPCTRC: SETZ T,
1562 UPCTR1: JSP F,QOTCOM    ;UP ARROW TO GOBBLE SYL AND RETURN MASKED ASCII VALUE
1563         LSH T,7         ;SHIFT ACCUMULATED VALUE OVER 7
1564         ANDI A,77       ;NOW MASK CHARACTER IN TO TO BOTTOM 6 BITS
1565         ADD T,A         ;ADD TO ACCUMULATED
1566         POPJ P,
1567
1568 BAK1:   MOVE TT,[DFLD,,CBAKAR]
1569         MOVEM TT,CDISP
1570         JRST RR10
1571
1572 UA3:    HRLM D,(P)      ;SAVE RADIX (FOR UPARR)
1573         JSP LINK,SGTSY  ;PUSH I,AA,A,B
1574         TLO I,ILUARI    ;TELL _ TO WAIT TILL LATER (SEE UPARR, BAKARR)
1575         PUSHJ P,RCH
1576         CAIN A,"-
1577         TROA I,IRGMNS
1578         TLO FF,FLUNRD
1579         PUSHJ P,RCH
1580         CAIN A,"<
1581         JRST UAR1
1582         TLO FF,FLUNRD
1583 UA3L:   PUSHJ P,GTSL1   ;GOBBLE SYL, LOOP POINT FOR PSEUDO OR MACRO RETURNED WITHOUT VALUE
1584         TRNE I,IRLET
1585         JRST UA3S       ;NAME
1586         TLNE I,ILFLO
1587         ETR [ASCIZ /Floating point 2nd arg to "_"/]
1588 UAR2:   TRZN I,IRGMNS
1589         SKIPA T,A
1590         MOVN T,A
1591         JSP LINK,SGTSY1 ;RESTORE GETSYL TEMPS.
1592         HLRZ D,(P)
1593         POPJ P,
1594
1595 UA3S:   PUSHJ P,GETVAL  ;MAKE NUMBER_NAME WORK
1596         JRST UA3SR      ;GOT VALUE, PROCESS
1597         JRST UA3L       ;NO VALUE, TRY AGAIN
1598
1599 UAR1:   TLO I,ILLSRT
1600         TRZ I,IRSYL     ;(OR ELSE LSSTH GIVES NOS ERROR.)
1601         SETZB A,B
1602         PUSHJ P,LSSTH
1603 UA3SR:  JUMPN B,RLCERR  ;RELOC ERR
1604         JRST UAR2
1605
1606 ATSGN:  MOVSI A,20      ;ATSIGN
1607         IORM A,WRD
1608         TRO I,IRFLD     ;SET IRFLD FLAG EVEN THOUGH NOT DIRECTLY RETURNING VALUE
1609                 ; ^ CHANGED FROM SYL TO FIELD 9/6/70
1610         JRST RRL2       ;FALL BACK IN
1611 \f
1612 DQUOTE: TRON I,IRSYL
1613          JRST DQUOT8
1614         TRNN I,IRLET    ;AFTER NUMBER => CURRENT RADIX.
1615          JRST DQUOT7
1616         PUSHJ P,RCH
1617         TLO FF,FLUNRD   ;NEXT CHAR. SQUOZE?
1618         HLRZ A,GDTAB(A)
1619         CAIN A,(POPJ P,)
1620          JRST DQUOT7    ;NO => MAKE PREV. SYM. GLOBAL.
1621         CAMN SYM,[SQUOZE 0,.M]  ;SPECIAL BLOCK NAMES
1622          JRST DQUOTM    ;.M MEANS MAIN BLOCK,
1623         CAMN SYM,[SQUOZE 0,.U]
1624          JRST DQUOTU    ;.U MEANS SUPERIOR.
1625         CAMN SYM,[SQUOZE 0,.C]
1626          JRST DQUOTC    ;.C MEANS CURRENT BLOCK.
1627         SKIPGE A,ESBK   ;GET SPEC'D BLOCK OR CURRENT,
1628          HRR A,BKCUR    ;LOOK FOR SUBBLOCK OF THAT BLOCK.
1629         HLL A,BKTAB+1(A)
1630         ADD A,[1,,]     ;LH HAS LEVEL SUBBLOCK OUGHT TO HAVE.
1631         MOVEI T,0
1632         SETO D,         ;NO POSSIBLE ALTERNATE CHOICE YET.
1633 DQUOT0: CAME SYM,BKTAB(T)       ;LOOK AT ALL BLOCKS SEEN.
1634          JRST DQUOT1    ;HAS THE NAME WE'RE LOOKING FOR?
1635         SKIPGE ESBK     ;IF LOOKING FOR A SUBBLOCK OF A PARTICULAR BLOCK,
1636          JRST DQUOT4
1637         CAMN A,BKTAB+1(T)
1638          JRST DQUOT2    ;SUCH A BLOCK WINS;  ALL OTHERS LOSE.
1639         JRST DQUOT1
1640
1641 DQUOT4: SKIPN BKTAB+2(T) ;ELSE PREFER DEFINED BLOCKS TO UNDEFINED ONES.
1642          JUMPGE D,DQUOT1
1643         SKIPE BKTAB+2(T)
1644          JUMPL D,DQUOT5
1645         CAME D,[-1]     ;THAT'S THE SAME EITHER WAY => PREFER AN INFERIOR
1646          CAMN A,BKTAB+1(T)      ;OF THE CURRENT BLOCK TO ONE THAT'S NOT.
1647           JRST DQUOT5
1648         JRST DQUOT1
1649
1650 DQUOT5: HRROI D,(T)     ;FOUND A BLOCK WE LIKE BEST SO FAR.
1651         SKIPE BKTAB+2(T)
1652          ANDI D,-1      ;LEAVE SIGN OF D SET UNLESS THE BLOCK IS DEFINED.
1653 DQUOT1: ADDI T,BKWPB
1654         CAMGE T,BKTABP
1655          JRST DQUOT0
1656         HRRZI T,(D)     ;NOW USE THE BEST BLOCK FOUND, IF THERE WAS ONE.
1657         CAIE T,-1
1658          JRST DQUOT2
1659         MOVE T,BKTABP   ;NOT FOUND, GET IDX OF 1ST UNUSED ENTRY.
1660         CAIL T,BKTABS
1661          ETF ERRTMB     ;NO ROOM FOR MORE BLOCKS.
1662         MOVEM SYM,BKTAB(T)
1663         MOVEM A,BKTAB+1(T)      ;ADD BLOCK AT END.
1664         MOVEI A,BKWPB(T)
1665         MOVEM A,BKTABP  ;POINTS AFTER LAST USED ENTRY.
1666 DQUOT2: MOVEM T,ESBK
1667         SETZ SYM,
1668 DQUOT3: MOVEI D,6       ;NEXT CHAR GOES IN 1ST SQUOZE POS.
1669         JRST RRL2
1670
1671 DQUOTM: MOVEI T,BKWPB   ;.M - MAIN BLOCK FOLLOWS INITIAL SYMS BLOCK.
1672         JRST DQUOT2
1673
1674 DQUOTU: SKIPGE T,ESBK   ;.U SPEC'D - GET SPEC'D OR CURRENT BLOCK,
1675          MOVE T,BKCUR
1676         HRRZ T,BKTAB+1(T)
1677         JRST DQUOT2     ;SPEC. ITS SUPERIOR.
1678
1679 DQUOTC: SKIPGE T,ESBK   ;.C => SPEC THE CURRENT BLOCK.
1680          MOVE T,BKCUR
1681         JRST DQUOT2
1682 \f
1683 SQUOT1: TLOA I,ILVAR
1684 DQUOT7:  TLO I,ILGLI
1685         MOVE A,BKCUR    ;IF NO SPEC'D BLOCK,
1686         SKIPGE ESBK
1687          MOVEM A,ESBK   ;SPEC. CURRENT BLOCK.
1688         JRST RRL2
1689
1690 DQUOT8: SETZ T,
1691 DQUOT9: JSP F,QOTCON    ;DOUBLE QUOTE TO GOBBLE SYL AND RETURN ASCII VALUE
1692         LSH T,7         ;SHIFT ACCUMULATED VALUE OVER 7
1693         ADD T,A         ;ADD IN ASCII CHARACTER IN A
1694         POPJ P,         ;RETURN TO SOMETHING
1695
1696 SQUOTE: TROE I,IRSYL
1697          JRST SQUOT1
1698         SETZ T,
1699 SQUOT9: JSP F,QOTCON    ;SIXBIT SYL
1700         CAIGE A,40
1701          ETR ERRN6B     ;NOT SIXBIT
1702         CAIL A,140
1703          SUBI A,40      ;CONVERT TO UPPER CASE
1704         LSH T,6         ;SHIFT OVER ACCUMULATED VALUE
1705         ADDI T,-40(A)   ;ADD IN SIXBIT FOR CHARACTER IN A
1706         POPJ P,
1707
1708 ;COMMON ROUTINE FOR RIGHT JUSTIFIED TEXT SYLS
1709 ;CALLED WITH JSP F,; ROUTINE PUSHJ'S BACK W/ CHAR IN T, ACCUM VALUE IN A
1710 ;SYL FLAG EXPECTED TO BE ALREADY SET
1711 QOTCON: SKIPE QMTCH     ;' AND " COME HERE, BUT NOT ^: IF IN QUOTES-MATCHING MODE, USE A
1712          JRST QOTCO4    ;FAIL-LIKE ALGORITHM. HERE FOLLOWS THE OLD MIDAS WAY OF DOING IT
1713 QOTCOM: CALL RCH        ;USE AT LEAST 1 CHAR IN ANY CASE.
1714         JRST QOTCO1
1715
1716 QOTCO2: CALL RCH        ;USE SUCCEEDING CHARS IF SQUOZE CHARS.
1717         HLRZ CH1,GDTAB(A)
1718         CAIN CH1,(POPJ P,)
1719          JRST QOTCO3
1720 QOTCO1: CALL (F)
1721         JRST QOTCO2
1722
1723 QOTCO3: CAIN A,""       ;NONSQUOZE: IF IT IS A TEXT SYL INDICATOR,
1724          JRST DQUOT9    ;CONTINUE WITH WHATEVER TYPE OF TEXT
1725         CAIN A,"'
1726          JRST SQUOT9    ;IT INDICATES.
1727         CAIN A,"^
1728          JRST UPCTR1
1729 QOTCO6: TLO FF,FLUNRD
1730         JRST TEXT5
1731
1732 QOTCO4: MOVE B,LIMBO1   ;GET ' OR ", WHICHEVER STARTED THIS SYL, AS THE DELIMITER.
1733         MOVE SYM,[SQUOZE 0,TEXT]
1734         JSP TM,ERMARK
1735 QOTCO5: CALL RCH
1736         CAMN A,B        ;FOUND ANOTHER EXAMPLE OF THE DELIMITER?
1737          JRST [ CALL RCH        ;IF DUPLICATED, IT PUTS THE DELIMITER IN THE CONSTANT.
1738                 CAMN A,B
1739                  JRST .+1
1740                 JRST QOTCO6]    ;OTHERWISE UNREAD THE CHAR AFTER THE DELIMITER AND EXIT.
1741         CALL (F)        ;HAVE CHAR TO PUT IN STRING IN A; GO MERGE IT IN.
1742         JRST QOTCO5
1743
1744 ;RETURN A VALUE FROM A PSEUDO WHOSE ARGS CAN BE TERMINATED BY EITHER COMMA (GOBBLED)
1745 ;OR CR (NOT GOBBLED).
1746 VALRET: MOVE T,A        ;ROUTINE TO RETURN VALUE IN A AFTER LAST CHAR GOBBLED BY GETSYL
1747         MOVE B,CDISP    ;GET STORED DISPATCH CODE
1748         TLNN B,DWRD\DFLD
1749         JRST VALR1      ;WORD TERMINATOR
1750 ;COME HERE TO RETURN A VALUE, AND ALSO
1751 ;BARF IF THE NEXT CHARACTER ISN'T A SYLLABLE SEPARATOR
1752 TEXT5:  PUSH P,T        ;ENTRY FROM TEXT ROUTINES (NLAST CHAR NOT GOBBLED BY GETSYL) TO RETURN VALUE IN T
1753         PUSHJ P,GETSYL  ;SEE IF IMMEDIATELY FOLLOWED BY SYL
1754         TRNE I,IRSYL
1755         ETR ERRNOS      ;NO SEPARATOR BETWEEN TWO VALUES
1756         POP P,A         ;RESTORE VALUE TO RETURN
1757 VALR1:  TRO I,IRSYL
1758         JRST CLBPOP
1759 \f
1760                 ;VARIOUS PUSH AND POP ROUTINES, ALL CALLED W/ JSP LINK,
1761
1762 SGTSY:  PUSH P,I
1763         PUSH P,AA
1764         PUSH P,A
1765         PUSH P,B
1766         JRST (LINK)
1767
1768 SGTSY1: POP P,B
1769         POP P,A
1770         POP P,AA
1771         POP P,I
1772         JRST (LINK)
1773
1774 ;JSP LINK,SAVWD1 TO SAVE STUFF FOR < OR (, ETC.
1775
1776 SAVWD1: PUSH P,A        ;SYLL. BEFORE GROUPING NOW STARTING.
1777         PUSH P,B        ;AND ITS RELOC.
1778
1779 SAVWLD: PUSH P,FORMAT
1780         PUSH P,FORPNR
1781         PUSH P,FLDCNT
1782         PUSH P,GLSP2
1783         PUSH P,I
1784         PUSH P,WRD
1785         PUSH P,WRDRLC
1786         PUSH P,SYM
1787         PUSH P,PPRIME
1788         PUSHJ P,(LINK)
1789 SAVL1==.
1790
1791 ;POP OFF WHAT PUSHED BY SAVWLD.  CLEARS FLUNRD, IN CASE THE > OR ) WAS UN-READ.
1792
1793 USVWLD: POP P,SYM
1794         HRRZS SYM
1795         CAIE SYM,SAVL1
1796         HALT
1797         TLZ FF,FLUNRD
1798         POP P,PPRIME
1799         POP P,SYM
1800         POP P,WRDRLC
1801         POP P,WRD
1802         TDZ I,[-1-(ILWORD)]
1803         IOR I,(P)
1804         POP P,1(P)
1805         POP P,GLSP2
1806         POP P,FLDCNT
1807         POP P,FORPNR
1808         POP P,FORMAT
1809         JRST (LINK)
1810 \f
1811 ;;GETFD         ;GET FIELD (EXPRESSION); RETURN VALUE IN A, RELOC BITS IN B
1812
1813                 ;GET FIELD FOR PSEUDO
1814                 ;SYM SHOULD CONTAIN THE SQUOZE NAME OF THE PSEUDO
1815                 ;OR A POINTER TO AN INSN TO EXECUTE WHEN UNDEF
1816                 ;SYMBOL SEEN. SYM IS NOT CLOBBERED.
1817
1818 AGETFD: PUSH P,I        ;SAVE I
1819         TRO I,IRPSUD+IRNOEQ     ;SET FLAG TO GETVAL TO EXECUTE GTVER ON UNDEFINED SYM ON EITHER PASS
1820         SAVE GTVER      ;OLD VALUE OF GTVER
1821         MOVEM SYM,GTVER ;ERROR MSG SHOULD GIVE NAME OF PSEUDO.
1822         CALL YGETFD
1823         MOVE SYM,GTVER
1824         REST GTVER
1825         MOVEM I,ISAV    ;SAVE FLAGS FOR FIELD GOTTEN
1826 POPIJ:  POP P,I
1827         POPJ P,
1828
1829 ;READ A FIELD, NOT PART OF THE CURRENT WORD.
1830 YGETFD: PUSH P,WRD
1831         SETZM WRD
1832         CALL XGETFD
1833         TLNE I,ILMWRD
1834         PUSHJ P,IGTXT   ;SOAK UP MULTIPLE WORD
1835         ADD A,WRD       ;ADD IN INDEX, INDIRECT FIELDS
1836         POP P,WRD
1837         POPJ P,
1838
1839 IFN FASLP,[
1840 FAGTFD: PUSHJ P,AGETFD  ;DO AGETFD, COMPLAIN IF RELOCATABLE OR GLOBAL
1841         MOVE TM,GLSP1
1842         CAMN TM,GLSP2
1843          SKIPE B
1844           ETSM [ASCIZ /relocatable or external argument/]
1845         POPJ P,
1846 ]
1847 ;READ A FIELD PART OF CURRENT WORD (FOR XWD, ETC).
1848 XGETFD: SAVE PPRIME
1849 AGTFD3: PUSHJ P,GETFLD
1850         MOVE CH1,CDISP
1851         TLNN CH1,DWRD
1852          TLOA FF,FLUNRD ;DELIMITER IS WORD TERMINATOR => RE-READ IT.
1853           TRNE I,IRFLD  ;NON-NULL FIELD SUPPLIED => RETURN IT.
1854             JRST AGTFD4
1855         HRRZ C,CDISP    ;ELSE COMMA => RETURN NULL VALUE (0)
1856         CAIN C,SPACE    ;SPACE => TRY AGAIN TO READ A FIELD.
1857          JRST AGTFD3    ;NO FIELD, TRY AGAIN
1858 AGTFD4: REST PPRIME
1859         POPJ P,
1860
1861                 ;IN RELOCATABLE FORMAT
1862                 ;READ FIELD AND COPY OUT AS WORD
1863
1864 RGETFD: SETZM WRD       ;FIRST INITIALIZE SOME STUFF AS THOUGH AT GETWD
1865         SETZM WRDRLC
1866         MOVE A,GLSPAS
1867         MOVEM A,GLSP1
1868         MOVEM A,GLSP2
1869         CALL XGETFD
1870         ADDM A,WRD
1871         ADDM B,WRDRLC
1872         PUSHJ P,PWRDA   ;OUTPUT WORD
1873         TLNE I,ILMWRD
1874         JRST IGTXT      ;SOAK UP MULTI-WORD FIELD
1875         POPJ P,
1876 \f
1877 ;READ IN A FIELD, RETURN IN A,B SETTING IRFLD IF FIELD NOT NULL.
1878 GETFLD: SAVE GLSP1      ;REFERED TO AS GETFLB(P) WHEN ONLY 1 SYL PUSHED.
1879         MOVEM P,PPRIME
1880         TRZ I,IRFLD+IROP
1881 GETFD1: TLNE I,ILMWRD
1882         JRST GETFD9     ;MULTIPLE WORD, RE-CALL PSEUDO
1883         PUSHJ P,GETSYL
1884         TRNE I,IRLET
1885 GETFD9: PUSHJ P,GETVAL  ;GET OPERAND (MAYBE SKIPS)
1886 GETFD6: SKIPA C,CDISP   ;GET INFO ON SYLLABLE TERMINATOR
1887         JRST GETFD1     ;GETVAL SKIPPED => PSEUDO/MACRO WITH NO VALUE, TRY AGAIN
1888         TLNE C,DFLD
1889         JRST (C)        ;FIELD OPERATOR, GO PROCESS
1890         TRNE I,IRSYL    ;NO DISP MEANS FIELD TERMINATOR.
1891         TRO I,IRFLD
1892         CAME P,PPRIME   ;IF ANY OPERATORS PUSHED,
1893          JSP LINK,GETFD8 ;EVAL THEM.
1894         SUB P,[1,,1]    ;FLUSH GLSP1 SAVED AT GETFLD.
1895         RET
1896
1897 GETFD8: MOVEI TT,       ;END OF FIELD HAS VERY LOW PRIORITY.
1898         JRST GETFD7
1899
1900 ;PUSH AN OPERATOR, MAYBE EVALLING STUFF TO LEFT.
1901 ;A HAS LEFT OPERAND (IF ANY), B RELOCATION BITS,
1902 ;C ADR OF ROUTINE TO PERFORM OPERATION, LH OF TT HAS PRECEDANCE OF OPERATOR
1903
1904 GETFDL: MOVEI LINK,GETFD3       ;AFTER MAYBE EVALLING, GO PUSH OPERATOR.
1905         TRO I,IRFLD+IROP
1906         TRNN I,IRSYL
1907          JRST GETFD5    ;UNARY, EVAL NOTHING, JUST PUSH WITH HIGH PRIO.
1908 GETFD2: CAME P,PPRIME   ;NO OPS TO LEFT => NOTHING TO EVAL.
1909         CAMLE TT,GETFLP(P) ;COMPARE PRIO OF PREV. OP. AND CURRENT.
1910         JRST (LINK)     ;WAIT UNTIL LATER
1911 GETFD7: HRRZ T,GETFLP(P) ;EVAL THE LAST OP ON STACK.
1912         JRST (T)        ;GO DO IT NOW (ROUTINE RETURNS TO GETFD4)
1913 GETFD4: SUB P,[4,,4]
1914         JRST GETFD2
1915
1916 GETFD5: MOVSI TT,200    ;GIVE UNARY OP HIGH PRIO. TO DO BEFORE NEXT BINARY.
1917 GETFD3: PUSH P,B        ;GETFLR(P)
1918         PUSH P,A        ;GETFLV(P)
1919         HLL C,TT
1920         PUSH P,C        ;GETFLP(P)
1921         PUSH P,GLSP1    ;GETFLG(P)
1922         JRST GETFD1
1923
1924 GETFLB==,-4     ;PDL IDX OF GLSP1 BEFORE LEFT OPERAND.
1925 GETFLR==,-3     ;PDL IDX OF RELOC OF LEFT OPERAND.
1926 GETFLV==,-2     ;PDL IDX OF VALUE OF LEFT OPERAND.
1927 GETFLP==,-1     ;PDL IDX OF PRIO,,DISPATCH
1928 GETFLG==0       ;PDL IDX OF GLSP1 AFTER LEFT OPERAND (=BEFORE RIGHT)
1929 \f
1930 PLS:    MOVEI C,PLS1    ;PLUS SIGN, PLS1 IS ROUTINE TO PERFORM OPERATION
1931 MINUS2: MOVSI TT,10     ;SET UP PRECEDENCE OF 10 FOR +, -
1932         JRST GETFDL
1933
1934 MINUS:  JSP C,MINUS2    ;MINUS SIGN
1935         MOVNS A         ;NEGATE VALUE OF RIGHT OPERAND
1936         MOVNS B         ;ALSO RELOCATION
1937         JUMPGE FF,PLS1
1938         MOVE T,GETFLG(P)
1939         PUSH P,B
1940         HRLZI B,MINF
1941         PUSH P,C
1942         PUSHJ P,LNKTZ   ;COMPLEMENT THE MINUS FLAG ON GLOBALS IN RIGHT OPERAND
1943         POP P,C
1944         POP P,B
1945 PLS1:   ADD A,GETFLV(P) ;ADD VALUES
1946         ADD B,GETFLR(P) ;ADD RELOCATIONS
1947         JRST GETFD4
1948
1949 LNKTZ:  TDZA C,C
1950 LNKTC1: MOVE T,GLSP2
1951 LINKTC: CAML T,GLSP1
1952         POPJ P,
1953         SKIPL 1(T)
1954         XORM B,1(T)
1955         SKIPL 1(T)
1956         IORM C,1(T)
1957         AOJA T,LINKTC
1958 \f
1959 MULTP:  MOVEI C,MULTP1  ;ASTERISK, MULTP1 ROUTINE TO PERFORM MULTIPLICATION
1960 DIVID2: MOVSI TT,20     ;20 PRECEDENCE OF MULTIPLICATION, DIVISION
1961         JRST GETFDL
1962
1963 MULTP1: JUMPGE FF,MULTR         ;ON P1, DON'T CHECK THIS, SINCE UNDEF SYMS ARE EXTERNALS
1964         SKIPL CONTRL            ;ELSE IN DECREL ASSEMBLY, TEST FOR EXTERNALS.
1965          JRST MULTR
1966         MOVE D,GETFLB(P)        ;ACTUALLY, GET HERE FOR ABS ASSEMBLIES TOO, BUT SO WHAT?
1967         CAME D,GLSP1
1968          ETR [ASCIZ /Externals multiplied/]
1969 MULTR:  JUMPE B,MULTP3          ;JUMP ON RIGHT OPERAND NOT RELOCATED
1970         SKIPE GETFLR(P)
1971          JRST MULTP4            ;BOTH OPERANDS RELOCATED
1972         MOVE T,GETFLV(P)        ;GET VALUE OF LEFT OPERAND AND FALL IN
1973         JRST MULTP5
1974
1975 MULTP3: MOVE T,A                ;RIGHT OPERAND NOT RELOCATED, GET VALUE IN T
1976         MOVE B,GETFLR(P)        ;RELOCATION BITS OF LEFT OPERAND
1977 MULTP5: MOVE D,GETFLG(P)        ;GLOTB POINTER TO BETWEEN OPERANDS
1978         CAME D,GETFLB(P)
1979          JRST GMUL1             ;LEFT OPERAND HAS GLOBALS
1980         CAME D,GLSP1
1981          JRST GMUL2             ;RIGHT OPERAND HAS GLOBALS
1982                 ;AT THIS POINT, T HAS VALUE OF ABS OPERAND, B RELOC BITS OF OTHER
1983 GMUL4:  IMUL A,GETFLV(P)        ;MULTIPLY VALUES
1984         IMULB B,T               ;MULTIPLY RELOCATION OF ONE BY VALUE OF OTHER
1985         TRZ T,1
1986         SKIPL CONTRL            ;EXCEPT IN STINK ASSEMBLY, OBJECT TO RELOCATION
1987          JRST GETFD4            ;OTHER THAN 0 OR 1 (ONLY AFFECTS DECREL, SINCE
1988         JUMPE T,GETFD4          ;RELOCATION CAN'T BE NONZERO IN ABS ASSEMBLY).
1989 MULTP4: ETR [ASCIZ+Relocatable arg to * or / or Boolean+]
1990         JRST GETFD4
1991
1992 GMUL1:  TLNE FF,FLPPSS  ;LEFT OPERAND HAS GLOBALS, CHEK RIGHT OPERAND
1993         CAMN D,GLSP1
1994         SKIPA CH1,A     ;LOOKS OK, GET VALUE IN CH1
1995          ETR [ASCIZ /Multiplying two externals/]
1996         SKIPA D,GETFLB(P)       ;GET GLOTB POINTER TO BOTTOM OF LEFT OPERAND
1997 GMUL2:  MOVE CH1,GETFLV(P)      ;GLOBALS IN RIGHT OPERAND ONLY, GET LEFT OPERAND
1998 GMUL3:  CAML D,GLSP1
1999         JRST GMUL4      ;TABLE COUNTED OUT
2000         SKIPGE 1(D)
2001         AOJA D,GMUL3
2002         JUMPE CH1,GMUL5 ;MULTIPLYING BY ZERO, CLEAR OUT GLOTB ENTRY AND LOOP BACK
2003         LDB CH2,[221200,,1(D)]  ;PICK UP MULTIPLICATION FIELD THIS GLOBAL
2004         SKIPN CH2
2005         MOVEI CH2,1     ;0 => 1
2006         IMUL CH2,CH1
2007         CAIN CH2,1
2008         MOVEI CH2,0     ;IF ONE THEN USE ZERO
2009         DPB CH2,[221200,,1(D)]
2010         AOJA D,GMUL3
2011
2012
2013 GMUL5:  CLEARM 1(D)
2014         AOJA D,GMUL3
2015 \f
2016 DIVID:  JSP C,DIVID2    ;SLASH, PRECEDENCE = 20
2017 DIVID1: JUMPN B,MULTP4  ;JUMP IF RIGHT OPERAND RELOCATED
2018         SKIPE GETFLR(P)
2019         JRST MULTP4     ;LEFT OPERAND RELOCATED
2020         EXCH A,GETFLV(P)
2021         IDIV A,GETFLV(P)
2022         MOVEI B,0
2023         JUMPGE FF,GETFD4
2024         MOVE D,GETFLB(P)
2025         CAME D,GLSP1
2026          ETR [ASCIZ /Division involving externals/]
2027         JRST GETFD4
2028
2029                 ;LOGIC OPERATORS & (PREC = 40), # (PREC = 34), \ (PREC = 30)
2030
2031 ANDF:   MOVSI TT,40     ;&
2032         JSP C,GETFDL
2033         JSP D,LOGIC1    ;GO DO IT
2034         AND A,GETFLV(P) ;INSTRUCTION ARGUMENT TO LOGIC1
2035
2036 XORF:   MOVSI TT,34     ;#
2037         TRNN I,IRSYL    ;IF ABOUT TO BE UNARY,
2038         MOVNI A,1       ;THEN TURN LEFT OPERAND INTO -1
2039         JSP C,GETFDL
2040         JSP D,LOGIC1
2041         XOR A,GETFLV(P)
2042
2043 IORF:   MOVSI TT,30     ;\
2044         JSP C,GETFDL
2045         JSP D,LOGIC1
2046         IOR A,GETFLV(P)
2047
2048                 ;COMMON EXECUTION ROUTINE FOR LOGICAL OPERATORS
2049
2050 LOGIC1: JUMPN B,MULTP4  ;NO RELOCATION ALLOWED
2051         SKIPE GETFLR(P) ;NOW CHECK RELOCATION OF LEFT OPERAND
2052         JRST MULTP4
2053         XCT (D)         ;ALL TESTS PASSED, DO IT
2054         JUMPGE FF,GETFD4        ;DON'T CHECK FOR GLOBALS EXCEPT DURING PUNCHING PASS
2055         MOVE D,GETFLB(P)        ;PICK UP POINTER TO LEFT OPERAND GLOTB ENTRIES
2056         CAME D,GLSP1
2057          ETR [ASCIZ /External in arg to \, & or #/]
2058         JRST GETFD4
2059
2060 CBAKAR: MOVSI TT,100    ;BACKARROW AS FIELD OPERATOR, PREC = 100
2061         JSP C,GETFDL    ;RETURN TO GETFLD TO READ 2ND ARGUMENT.
2062         JSP D,LOGIC1    ;FOR EVALUATION, CALL LOGIC1
2063             JSP D,.+1   ;WHICH EXECUTES THIS INSTRUCTION,
2064         MOVE T,A        ;TO CALL THIS SUBROUTINE.
2065         MOVE A,GETFLV(P)
2066         LSH A,(T)
2067         JRST (D)
2068 \f
2069 ;D SHOULD HAVE 1 FOR <, 2 FOR (, 3 FOR [        ;]
2070 LSSTH9: JSP LINK,SAVAS1 ;SAVE ASSEM1 PDL LEVELS, .BYTE MODE, ETC.
2071         MOVEM D,ASMOUT  ;SAY WHAT KIND OF OPEN WE JUST DID
2072         JRST ASSEM3     ;REENTER ASSEM1 LOOP AT INNER LEVEL.
2073
2074 ;COME HERE TO EXIT FROM AN ASSEM1 LEVEL THAT WAS ENTERED BY LSSTH9.
2075 LSSTHA: SKIPE BYTM      ;IN BYTE MODE, DO .WALGN. SINCE ASMDSP
2076          JRST A.BY3     ;STILL POINTS HERE, WE'LL COME BACK.
2077         MOVE P,CONSTP
2078         JSP T,CONNDP    ;POP STUFF SAVED BY SAVAS1
2079         MOVE A,WRD      ;RETURN THE WORD IN THE GROUPING
2080         MOVE B,WRDRLC   ;(OUR CALLER WILL USVWLD, CLOBBERING WRD)
2081         POPJ P,
2082
2083 LSSTH:  MOVEI D,1       ;1 FOR <.
2084         JSP LINK,SAVWD1
2085         PUSHJ P,LSSTH9
2086 LSSTH3: JSP LINK,USVWLD ;POP OFF ALL BUTPREVIOUS SYLL.
2087
2088 ;GROUPINGS EXCEPT (PARENS THAT ADD TO WORD)
2089 ;SYLL IMMEDIATELY BEFORE OR AFTER IS ERROR.
2090 LSSTH2: ADDM A,-1(P)    ;SYLL BEFORE GROUPING, PUSHED BY SAVWD1.
2091         ADDM B,(P)
2092         TRNE I,IRSYL    ;IF WAS SYLL BEFORE GROUPING, ERROR.
2093          ETR ERRNOS
2094 LSSTH5: MOVE A,LIMBO1   ;CHECK FOR FOLLOWING SYLL.
2095         CAIE A,15
2096         CAIN A,12
2097         JRST LSSTH6     ;DELIMITER CR OR LF
2098         PUSHJ P,RCH     ;NOT CR OR LF, GET NEXT CHAR
2099         CAIN A,"!       ;IGNORE EXCLAMATION POINT
2100         JRST .-2
2101         TLO FF,FLUNRD   ;CAUSE IT TO BE RE-INPUT
2102         HLRZ CH1,GDTAB(A)
2103         CAIE CH1,(POPJ P,)
2104         JRST LSSTH4     ;SQUOZE CHAR. MEANS FOLLOWING SYLL.
2105         HRRZ CH1,GDTAB(A)
2106         MOVE CH1,DTB-40(CH1)    ;GET DISPATCH FOR CHAR.
2107         TLNE CH1,DSY1   ;MIGHT START SYL => NOS ERROR.
2108          JRST LSSTH4
2109 LSSTH7: PUSHJ P,GTSL1
2110 LSSTH6: TRO I,IRSYL
2111         POP P,B
2112         POP P,A         ;VALUE OF GROUPING WAS ADDM'ED INTO THESE.
2113         TLZE I,ILLSRT   ?.SEE UA3
2114          RET            ;IF CALLED BY ^ OR _ AS SYL OP, RETURN TO IT.
2115         JRST GETFD6
2116 \f
2117 LSSTH1: TLO I,ILWORD    ;A NUMBER IN PARENS BY ITSELF IS A NONNULL WORD.
2118         ADDM A,WRD
2119         ADDM B,WRDRLC
2120         TRNE I,IRSYL    ;IF SYLL BEFORE,
2121         JRST LSSTH5     ;ERROR IF SYL AFTER.
2122         JRST LSSTH8     ;ELSE NO ERROR.
2123
2124 LSSTH4: ETR ERRNOS      ;FOLLOWING SYLL WHEN THAT IS ERROR.
2125 LSSTH8: TLNE I,ILLSRT   ?.SEE UA3
2126          JRST LSSTH6
2127         SUB P,[2,,2]
2128         JRST GETFD1
2129
2130 ERRNOS: ASCIZ /Syllables not separated/
2131
2132 POP2J:  SUB P,[2,,2]
2133         POPJ P,
2134
2135 LEFTP:  MOVEI D,2       ;2 FOR ).
2136         JSP LINK,SAVWD1
2137         MOVEI C,0
2138         TRNE I,IROP
2139         TRNE I,IRSYL
2140         TLO C,400000    ;CAUSE IT TO GET ADDED INTO WORD STEAD HAVE VALUE AS SYL
2141         PUSH P,C
2142         PUSHJ P,LSSTH9
2143         POP P,C
2144         MOVSM A,T1      ;STORE SWAPPED VALUE
2145         ADDI B,400000   ;NOW WANT TO SWAP RELOCATION, MAKE LH CORRECT
2146         HLREM B,T2      ;STORE AS RH WITH SIGN EXTENDED
2147         MOVSI B,400000(B)       ;GET RIGHT HALF IN LEFT
2148         ADDM B,T2       ;FINISH RELOCATION SWAP (THIS IS PAINLESS COMPARED TO THE HAIR EVERYWHERE
2149                 ;ELSE WHEN KEEPING THE HALFWORDS SEPARATE)
2150         MOVSI B,SWAPF
2151         PUSHJ P,LNKTC1
2152         JSP LINK,USVWLD
2153         MOVE A,T1
2154         MOVE B,T2
2155         JUMPL C,LSSTH1  ;ADD TO WHOLE WORD
2156         JRST LSSTH2
2157
2158 ;VERSION OF GETWRD FOR PSEUDO,
2159 ;PSEUDO MUST EITHER SAVE I, PPRIME AND GTVER OR RETURN TO ASSEM1.
2160 ;SYM SHOULD HOLD NAME OF PSUEUDO.
2161
2162 AGETWD: MOVEM SYM,GTVER ;STORE NAME OF PSEUDO FOR UNDEF SYM MSGS.
2163         TRO I,IRPSUD\IRDEF\IRNOEQ
2164         PUSHJ P,GETWRD
2165         MOVE SYM,GTVER  ;RESTORE SYM.
2166         TLNE I,ILMWRD
2167         PUSHJ P,IGTXT   ;SOAK UP MULTIPLE WORD
2168         RET
2169 \f
2170 ;;GETWD         ;READ A WORD, LEAVE VALUE IN A AND WRD, RELOC IN WRDRLC AND B
2171
2172 GETWRD: MOVE T,GLSP1
2173         MOVEM T,GLSP2
2174         CLEARM FORMAT   ;CLEAR FORMAT, WILL ACCUMULATE FORMAT NUMBER BY IDPB
2175         CLEARM WRD      ;CLEAR WRD, WILL ACCUMULATE ABSOLUTE PART OF WORD
2176         CLEARM WRDRLC   ; " RELOCATION BITS, "
2177         TDZ I,[ILWORD,,IRIOINS]
2178         CLEARM FLDCNT   ;NO FIELDS YET
2179         MOVE T,[50100,,FORMAT]  ;SET UP BIT POINTER TO FORMAT
2180         MOVEM T,FORPNR
2181 GTWD1:  PUSHJ P,GETFLD  ;READ NEXT FIELD
2182 SPACE6: MOVEI T,1       ;SET T TO 1, AC FOR IDPB ON ROUTINE DISPATCHED TO
2183         SKIPA C,CDISP
2184 SPACE5: REST A
2185         TLNE C,DWRD
2186         JRST (C)        ;NO DISPATCH MEANS WD TERMINATOR
2187         MOVE C,GLSP1
2188         MOVEM C,LINKL   ;MARK END OF ACTIVE PART OF GLOTB
2189         TRNN I,IRFLD
2190         JRST GETWD2     ;LAST FIELD NULL, MAYBE HAVE TO POP STUFF OFF
2191         IDPB T,FORPNR   ;MARK NON-NULL FIELD IN FORMAT
2192 GTWD4A: TLO I,ILWORD    ;NON-NULL WORD
2193         MOVE TT,FORMAT
2194         SKIPN TT,FORTAB-10(TT)  ;PICK UP BYTE POINTER POSITION/SIZE FIELDS FOR FIELDS IN WORD
2195         ETR [ASCIZ /Undefined format/]
2196         MOVEM TT,FORMAT         ;STORE IN FORMAT
2197         MOVE T,[301400,,FORMAT]
2198         MOVEM T,FORPNR
2199                 ;AT THIS POINT, FLDCNT HAS 1 LESS THAN # FIELDS; PUT FIELDS TOGETHER TO FORM WORD
2200 GTWD3:  LDB T,FORPNR
2201         MOVE D,FLDCNT
2202         CAIG D,2
2203         IBP FORPNR      ;HAVEN'T BACKED UP TO THIRD FIELD YET, INCREMENT TO DESC FOR PREV
2204         TRNE I,IRIOINS
2205         PUSHJ P,INTIOW
2206         PUSHJ P,INTFLD  ;PUT FIELD WHERE IT BELONGS
2207         SOSGE FLDCNT
2208         JRST GTWD5      ;THIS WAS LAST (FIRST) FIELD
2209         POP P,GLSP2     ;NOT YET, POP OFF MORE
2210         POP P,GLSP1
2211         POP P,B
2212         POP P,A
2213         JRST GTWD3
2214
2215 GTWD5:  MOVE A,WRD
2216         MOVE B,WRDRLC
2217         MOVE C,LINKL
2218         MOVEM C,GLSP1
2219         TRZ I,IRIOINS
2220         POPJ P,
2221 \f
2222 COMMA:  TRNN I,IRFLD    ;FIELD DELIMITER WAS COMMA (T HAS 1)
2223          JRST COMMA1    ;NO FIELD
2224         IDPB T,FORPNR   ;MARK NON-NULL FIELD
2225 COMMA4: IDPB T,FORPNR   ;MARK FIELD TERMINATOR WAS COMMA
2226         MOVE TT,FLDCNT
2227         CAIL TT,2
2228          ETR [ASCIZ /Comma past the 3rd field of a word/]
2229 PUSHFD: PUSH P,A        ;DONE WITH THIS FIELD, NOW TO GET NEXT
2230         PUSH P,B
2231         PUSH P,GLSP1
2232         PUSH P,GLSP2
2233         AOS FLDCNT      ;ANOTHER FIELD
2234         MOVE TT,GLSP1
2235         MOVEM TT,GLSP2
2236         HRRZ T,FORPNR
2237         CAIE T,FORMAT
2238         HRRZS FORPNR    ;STABILIZE FORPNR
2239         TLO I,ILWORD    ;SAY WE HAVE A NON-NULL WORD IN PROGRESS (LOC, ETC. ILLEGAL).
2240         JRST GTWD1
2241
2242 GETWD2: SKIPN FORMAT    ;LAST FIELD OF WORD IS NULL
2243         JRST GTWD5      ;ENTIRE WORD NULL, MAYBE WERE PARENS.
2244         SOS FLDCNT
2245         POP P,GLSP2
2246         POP P,GLSP1
2247         POP P,B
2248         POP P,A
2249         JRST GTWD4A
2250
2251 COMMA1: LDB TT,FORPNR   ;COMMA TERMINATED NULL FOELD.
2252         SKIPE FORMAT
2253         JUMPE TT,COMMA2 ;NOT 1ST FIELD, JMP IF PREV WAS TERM BY SPACE.
2254         IBP FORPNR      ;ELSE MARK NULL FIELD IN FORMAT.
2255         JRST COMMA4
2256
2257 ;FIELD SPACE COMMA, PATHOLOGICAL CASE
2258 ;(EG MACRO STARTED WITH A COMMA)
2259 COMMA2: DPB T,FORPNR    ;REPLACE SPACE WITH COMMA.
2260         JRST GTWD1
2261
2262                 ;FIELD TERMINATOR IS SPACE (T HAS 1)
2263
2264 SPACE:  MOVE TT,LIMBO1
2265         CAIE TT,^I      ;HEURISTIC: REAL SPACES ARE LIKELY TO BE FOLLOWED BY SQUOZE,
2266          JRST SPACE4    ;WHILE TABS ARE LIKELY TO BE FOLLOWED BY COMMENTS.
2267         PUSH P,A
2268         MOVE TT,GDTAB+40
2269         PUSHJ P,RCH
2270         CAMN TT,GDTAB(A)
2271         JRST .-2        ;FLUSH OTHER LOGICAL SPACES
2272         CAIN A,";       ;TAB WAS FOLLOWED BY SEMICOLON:
2273          JRST [ SAVE B
2274                 TRZ I,IRSYL
2275                 CALL SEMIC      ;FLUSH THE COMMENT
2276                 MOVEI T,1
2277                 REST B
2278                 JRST SPACE5]    ;AND HANDLE THE C.R.
2279 SPACE3: POP P,A
2280         TLO FF,FLUNRD   ;CAUSE CHAR TO BE RE-READ NEXT TIME
2281 SPACE4: TRNN I,IRFLD
2282          JRST GTWD1     ;NO FIELD
2283         IDPB T,FORPNR   ;T HAS 1, MARK NON-NULL FIELD IN FORMAT
2284         IBP FORPNR      ;MARK FIELD TERMINATOR WAS SPACE
2285         JRST PUSHFD
2286 \f
2287 ;T HAS DESC BYTE, PUT FIELD IN ITS PLACE
2288 ;ALSO CALLED FROM PBYTE, MUSTN'T CLOBBER AA.
2289
2290 INTFLD: MOVE TT,GLSP2
2291         CAMN TT,GLSP1
2292          JUMPE B,INTFD1 ;NO GLOBALS, JUMP IF NO RELOCATION
2293         CAIN T,2222     ;LH
2294          JRST INTL
2295         CAIN T,22       ;RH
2296          JRST INTR
2297         CAIN T,44       ;WHOLE WORD
2298          JRST INTW
2299         SKIPE B
2300          ETR [ASCIZ/Relocation attempted in irrelocatable field/]
2301                 ;(ASSUME) NO RELOCATION, CHECK FOR GLOBAL AC FIELDS
2302         CAIN T,2704     ;HIGH AC
2303          JRST INTACH
2304         CAIN T,504      ;AC LOW
2305          JRST INTACL
2306         JUMPGE FF,INTFD1        ;JUMP ON NOT PUNCHING PASS
2307         CAME TT,GLSP1
2308          ETR [ASCIZ/Global symbol in illegal field/]
2309 INTFD1: MOVEI TT,C_12.
2310         ROTC T,-12.     ;SHIFT BYTE POINTER INTO TT
2311         MOVEI C,0       ;INITIALIZE C TO RECEIVE FIELD IN PROPER PLACE
2312         DPB A,TT
2313         CAMN TT,[2200,,C]
2314         JRST INTFD2     ;RIGHT HALF, DON'T ALLOW CARRY INTO LH
2315         ADDM C,WRD      ;ALLOW CARRY
2316 INTFD3: ADDM B,WRDRLC   ;ADD RELOCATIONS, WILL BE BROKEN BACK INTO HALF-WORDS LATER
2317         POPJ P,
2318
2319 INTFD2: ADD C,WRD       ;ADD RIGHT HALVES
2320         HRRM C,WRD
2321         JRST INTFD3
2322
2323 INTIOW: CAIE T,2704
2324         CAIN T,504
2325         TRZA A,3                ;IO DEVICE FIELD
2326         POPJ P,                 ;NOT "AC" FIELD
2327         ADDI T,611-504
2328         POPJ P,
2329 \f
2330 INTR:   HRRE D,B        ;RH
2331         MOVEI B,0
2332         PUSH P,T
2333         HRLZI C,HFWDF
2334         PUSHJ P,LNKTC1  ;THIS IS A BUG WHICH SHOULD BE FIXED SOMETIME
2335 PRTCL:  MOVE B,D        ;GET BACK MAPPED RELOCATION BITS
2336 PRTCL2: POP P,T
2337 INTW:   MOVE D,GLSP2    ;WHOLE WORD
2338         HRLOI LINK,377777
2339         CAML D,GLSP1
2340         JRST INTFD1
2341         ANDM LINK,1(D)
2342         AOJA D,.-3
2343
2344 INTL:   HRLZ D,B        ;LH
2345         MOVSI B,SWAPF
2346         MOVSI C,HFWDF
2347         PUSH P,T
2348         MOVE T,GLSP2
2349 INTL2:  CAML T,GLSP1
2350         JRST PRTCL
2351         SKIPGE 1(T)
2352         AOJA T,INTL2    ;INDEX FIELD, ETC => LEAVE ALONE
2353         IORM C,1(T)     ;SET HFWDF
2354         XORM B,1(T)     ;COMPLEMENT SWAP STATUS
2355         TDNN B,1(T)
2356         SETZM 1(T)      ;SWAPPED TO RH, FLUSH IT
2357         AOJA T,INTL2
2358
2359 INTACL: TDZA B,B        ;AC LOW
2360 INTACH: HRLZI B,SWAPF   ;AC HIGH
2361         HRLZI C,ACF
2362         PUSH P,T
2363         PUSHJ P,LNKTC1
2364         MOVEI B,0
2365         JRST PRTCL2
2366
2367 IOINST: HLLZ A,B        ;IO INSTRUCTION, GET WHICH ONE INTO A
2368         SKIPN FLDCNT    ;THIS FIRST FIELD OF WORD?
2369         TRO I,IRIOINS   ;YES
2370         JRST CLBPOP     ;RETURN VALUE
2371 \f
2372                 ;TOP LEVEL LOOP, ASSEMBLE STORAGE WORDS
2373                 ;LOTS OF PSEUDOS MEANINGLESS IN STORAGE WORDS
2374                 ;(E.G. BLOCK, CONSTA) DO JRST ASSEM1 WHEN DONE
2375                 ;THERE'S ALSO AN ERROR UUO WHICH RETURNS TO ASSEM1
2376
2377 ASSEM1: MOVE P,ASSEMP
2378         JRST @ASMDSP
2379
2380 ;COME HERE TO START THE NEXT EXPRESSION OR WHATEVER.
2381 ASSEM3: PUSHJ P,RCH
2382         CAIN A,^I
2383          JRST ASSEM2    ;PROBABLY NOT PROFITABLE TO SKIP AFTER SEE A TAB.
2384         CAIG A,40
2385          JRST ASSEM3    ;FLUSH LEADING GARBAGE
2386         TLO FF,FLUNRD   ;CAUSE NON-GARBAGE CHAR FOUND TO BE RE-INPUT
2387 ;ASMDSP POINTS HERE WITHIN ASCII, SIXBIT ETC.
2388 ASSEM2: TRZ I,IRFLD+IRSYL+IRLET+IRPSUD+IRCOM+IRCONT+IRGMNS+IROP+IRNOEQ+IREQL
2389         TLZ I,ILGLI+ILVAR+ILFLO+ILDECP+ILUARI+ILWORD+ILNPRC
2390         IOR I,ASMI      ;SET DEF AND RESTORE PSEUDF.
2391         MOVE A,GLSPAS
2392         SKIPL BYTM
2393         MOVEM A,GLSP1
2394                 ;GETWRD WILL COPY GLSP1 INTO GLSP2
2395 IFN TS,[AOSN TTYBRF     ;DO A ^H-BREAK IF REQUESTED.
2396          CALL TTYBRK]
2397         PUSHJ P,GETWRD
2398         TLZN I,ILWORD
2399         JRST @ASMDSP    ;NO WORD ASSEMBLED,TRY AGAIN
2400         SKIPGE BYTM
2401         JRST PBYTE      ;IN BYTE MODE, OUTPUT BYTE INSTEAD OF WORD, A,B MUST HAVE WRD,WRDRLC.
2402         MOVE AA,ASMOUT  ;OUTPUT WD AS APPRO. FOR GROUPING, IF ANY.
2403         JRST @ASMOT0(AA)
2404
2405 ASSEM6: SKIPE STGSW     ;ASMOT0 POINS HERE. COME IF NOT IN GROUPING.
2406          ETR ERRSWD     ;STORAGE WORD ASSEMBLED
2407         PUSHJ P,PWRD    ;OUTPUT THE WORD.
2408         AOS CLOC
2409         HRRZS CLOC      ;INCREM. POINT .
2410         JRST @ASMDSP    ;ASSEM3 OR ASSEM2
2411
2412 ERRSWD: ASCIZ /Storage word assembled/
2413
2414 ASSEM4: JSP T,PCONST    ;ASMOT0+3 POINTS HERE. COME IF IN CONSTANT.
2415         JRST @ASMDSP
2416
2417 ;ASMDSP POINTS HERE WITHIN GROUPING IF NOT IN MULTI-LINE MODE
2418 ;[ ;AND NO CLOSE (">)]") HAS BEEN SEEN.
2419 ASSEMC: MOVE AA,ASMOUT
2420         SKIPE CONSML    ;IN ERROR MODE, GIVE APPROPRIATE ERROR MSG.
2421          XCT ASMOT3(AA)
2422         JRST @ASMOT2(AA) ;CLOSE WHATEVER TYPE GRPING WE'RE IN.
2423 \f
2424 ;JUMP THRU THIS TABLE TO OUTPUT A WORD.
2425 ASMOT0: ASSEM6? ASSEM1? ASSEM1? ASSEM4? [HALT ]
2426
2427 ;THIS TABLE GIVES APPRO. CLOSE FOR EACH TYPE OF GROUPING. ;[
2428 ASMOT1:  "? ?    "> ?    ") ?    "] ?   "?
2429
2430 ;THIS TABLE SAYS WHERE TO GO TO END THE GROUPING.
2431 ASMOT2: [HALT ]?        LSSTHA? LSSTHA? CONND? [HALT ]
2432
2433 ;APPROPRIATE ERROR MESSAGE FOR MISSING CLOSE OF GROUPING. [
2434 ASMOT3: HALT
2435         ETR [ASCIZ /Missing >/]
2436         ETR [ASCIZ /Missing )/]
2437         ETR [ASCIZ /Missing ]/]
2438         HALT
2439
2440 ;THIS TABLE TELLS PBYTE HOW TO HANDLE BYTE MODE.
2441 ASMOT4: PBY4 ?  PBY5 ?  PBY5 ?  PBY3 ?  [HALT ]
2442
2443 ;TABLE SAYING WHAT CHAR MUST HAVE OPENED THE GROUPING.
2444 ASMOT5: "? ?     "< ?    "( ?    "[ ?   "?      ;]
2445 \f
2446 ;;GETVAL        ;GET VALUE OF SYM
2447                 ;SKIPS ON PSEUDO NOT RETURNING VALUE (E.G. MACRO STARTING TO BE EXPANDED)
2448                 ;ELSE RETURNS VALUE IN A, RELOCATION BITS IN B
2449
2450 VBLK
2451 GTVER:  0       ;SQUOZE NAME OF CALLING PSEUDO, OR POINTER
2452                 ;TO INSN TO EXECUTE WHEN IF SYM IS UNDEF.
2453 PBLK
2454
2455 GETVAL: PUSHJ P,ES
2456         JRST GVNF       ;NO STE.
2457 IFN CREFSW,XCT CRFINU   ;JFCL OR CALL TO CREF RTN.
2458         JRST @.+1(A)    ;FOUND, DISPATCH ON SQUOZE FLAGS
2459
2460 GVTAB:  GVCOM   ;COMMON (UNUSED)
2461         GVPSEU  ;PSEUDO OR MACRO.
2462         GVSYM   ;LOCAL SYMBOL.
2463         GVUL    ;LOCAL UNDEF (MAYBE STINK KNOWS VALUE)
2464         GVDLV   ;DEFINED LOCAL VAR.
2465         GVULV   ;UNDEF LOC VAR.
2466         GVDGV   ;DEF GLO VAR
2467         GVUGV   ;UNDEF GLO VAR
2468         GVDG    ;DEF GLOBAL
2469         GVUG    ;UNDEF GLOBAL
2470
2471 ;DEF LOCAL VAR.
2472 GVDLV:  PUSHJ P,GVDLGV  ;IF PASS2 AND HAS ' THIS TIME, SET 3VAS2 FOR AVARIAB
2473         TLZN I,ILGLI
2474         JRST GVDLV2
2475         MOVSI T,DEFGVR  ;NOW DEF GLO VAR.
2476         PUSHJ P,VSM2
2477         JRST GVDG1      ;MAYBE OUTPUT GLOBAL DEF. TO STINK.
2478
2479 GVDGV:  PUSHJ P,GVDLGV  ;DEF GLO VAR; IF PASS 2 AND ' THIS TIME, SET 3VAS2
2480         JRST GVDG2      ;MUSN'T PUNCH VALUE, AVARIAB WILL.
2481
2482 GVDLGV: TRNE FF,FRPSS2  ;IF PASS 2
2483         TLNN I,ILVAR    ;AND THIS TIME HAVE SINGLEQUOTE
2484         POPJ P,
2485         TLO C,3VAS2     ;TELL AVARIAB SEEN IN PASS 2 WITH '.
2486         3PUT C,D
2487         POPJ P,
2488
2489 GVULV:  TLZN I,ILGLI    ;UNDEF LOCAL VAR, MAYBE MAKE GLOBAL.
2490         JRST GVUNDF
2491         PUSHJ P,PLOGLO  ;IF SO, TELL STINK SYM IS GLOBAL,
2492         MOVSI T,UDEFGV  ;SYM NOW UNDEF GLO VAR
2493         PUSHJ P,VSM2
2494         JRST GVUNDF     ;IN EITHER CASE, HANDLE UNDEF SYM.
2495 \f
2496 GVUL:   TLZE C,3MACOK   ;UNDEF LOCAL, PRESUMED NUMERIC
2497          3PUT C,D       ;DON'T LET IT BECOME MACRO AND SCREW PASS2.
2498         TLNE C,3LLV
2499         JRST GVGLTB     ;(REALLY DEFINED BUT ONLY STINK KNOWS HOW)
2500         TLNE I,ILGLI    ;IF MAKING GLOBAL, TELL STINK.
2501         PUSHJ P,PLOGLO
2502 GVNF1:  TLZE I,ILVAR    ;IF ', MAKE VAR (WILL CHECK ILGLI)
2503         JRST GVUL1
2504         TLZN I,ILGLI    ;NOT MAKING VAR, MAYBE GLOBAL?
2505         JRST GVUNDF     ;NO, MAYBE ERROR, MAKE GLOTB ENTRY.
2506         MOVSI T,GLOEXT
2507         PUSHJ P,VSM2    ;NOW GLOBAL UNDEF,
2508         JRST GVGLTB     ;NO ERROR, JUST GLOTB ENTRY.
2509
2510 GVUL1:  TLZN I,ILGLI    ;UNDEF LOCAL BECOMES
2511         SKIPA T,[UDEFLV,,]      ;UNDEF LOC VAR OR
2512 GVGVAR: MOVSI T,UDEFGV  ;UNDEF GLO VAR.
2513 GVVAR:  AOS VARCNT
2514         HRR B,VARCNT
2515         PUSHJ P,VSM2    ;MAKE IT A VAR,
2516         JRST GVUNDF     ;PRETEND HAD ALREADY BEEN A VAR.
2517
2518 GVUG:   TLZE I,ILVAR    ;UNDEF GLOBAL: MAYBE MAKE UNDEF GLO VAR.
2519         JRST GVGVAR
2520 GVGLTB: SKIPGE CONTRL   ;UNDEF GLO IN ABS ASSEM =>
2521          JRST GVUND1     ;MAYBE TREAT AS UNDEF.
2522 GVGLT1: AOS GLSP1       ;DON'T KNOW SYM'S VALUE, MAKE GLOTB ENTRY.
2523         MOVEI T,ST(D)
2524         HRRZM T,@GLSP1
2525         JRST CABPOP     ;RETURN 0 AS VALUE.
2526
2527 GVNF:
2528 IFN CREFSW,XCT CRFINU   ;ONLY IF NOT FOUND WOULD NOT CREF AFTER ES.
2529         TLNE I,ILVAR+ILGLI      ;MAKING VAR OR GLOBAL FORCED CURRENTBLOCK ALREADY
2530         JRST GVNF1      ;AND WILL STORE NAME IN STE ANYWAY.
2531         SKIPGE ESBK     ;ELSE IF NO SPEC'D BLOCK,
2532          TRNN FF,FRNPSS ;FORCE .MAIN BLOCK SO DON'T GET LOTS OF UNDEF ENTRIES.
2533           CAIA          ;BUT CAN'T DO THAT FOR 1PASS OR WOULD MISS FWD REFS.
2534            HRRI C,BKWPB
2535         MOVSI T,LCUDF
2536         PUSHJ P,VSM2
2537         JRST GVUNDF     ;MAYBE ERROR, MAKE GLOTB ENTRY.
2538
2539 GVCOM:  TRO I,IRCOM     ;COMMON: SAY THIS WAS ONE.
2540         HRRZ A,B        ;RETURN RH OF VALUE, ABSOLUTE.
2541         JRST CLBPOP
2542
2543 GVPSEU: TLNN I,ILVAR+ILGLI      ;CAN'T MAKE PSEUD OR MACRO GLOBAL OR VAR.
2544          JRST (B)               ;OTHERWISE, DISPATCH TO IT.
2545         TLZE I,ILVAR
2546          ETSM ERRCBV
2547         TLZE I,ILGLI
2548          ETSM ERRCBG
2549         JRST (B)        ;DISPATCH TO PSEUDO (OR MACCL IF MACRO)
2550                         ;EXPECTS LH OF VALUE IN LH OF B.
2551
2552 ERRCBV: ASCIZ /Can't be a variable/
2553 ERRCBG: ASCIZ /Can't be global/
2554
2555 GTVL7B: TLNE C,3RLL     ;R(LH)
2556         TLO SYM,200000
2557         TLNE C,3RLR     ;R(RH)
2558         TLO SYM,100000
2559         POPJ P,
2560 \f
2561 GVSYM:  TLNN C,3REL
2562          TLNE I,ILVAR\ILGLI
2563           JRST GVSYM2
2564         MOVE A,B        ;THIS CODE DOES WHAT GVSYM2 WOULD DO, BUT FASTER.
2565         SETZ B,
2566         RET
2567
2568 GVSYM2: TLZE I,ILVAR    ;LOCAL SYM: CAN'T MAKE VARIABLE.
2569          ETSM ERRMDV
2570         TLZN I,ILGLI
2571         JRST GVSYM0     ;NOT MAKING GLOBAL, GET VALUE & RETURN.
2572 GVSYM1: MOVSI T,GLOETY  ;BECOMES DEF. GLOBAL.
2573         PUSHJ P,VSM2
2574         JRST GVDG1      ;HANDLE AS IF WAS DEF GLOBAL.
2575
2576 ERRMDV: ASCIZ /Multiply-defined variable/
2577
2578 GVDG:   TLZE I,ILVAR    ;GLOBAL ENTRY
2579          ETSM ERRMDV
2580 ;COME HERE FOR DEF GLOBAL
2581 GVDG1:  SKIPGE CONTRL
2582          JRST GVDLV2    ;DON'T PUNCH VALUE IF ABSOLUTE.
2583         TLNE C,3VP
2584          JRST GVDG2     ;VALUE PUNCHED ALREADY, NOT AGAIN.
2585         JUMPGE FF,GVDG2
2586         TLNN C,3LLV
2587          TRNE I,IRPSUD+IREQL
2588           JRST GVDG2
2589         TLO SYM,40000
2590         PUSH P,WRD
2591         PUSHJ P,OUTDE2
2592         POP P,WRD
2593 GVDG2:  TRNN I,IRPSUD\IREQL     ;IF INSIDE AN ORDINARY STORAGE WORD,
2594          TLNN C,3REL            ;GENERATE A GLOBAL REF IF GLOBAL IS RELOCATABLE (HEURISTIC).
2595 GVDLV2:   TLNE C,3LLV           ;IF VAL KNOWN ONLY BY STINK, MUST MAKE A GLOBAL REF.
2596            JRST GVGLTB
2597 GVSYM0: MOVE A,B        ;USED IN LBRAK
2598         LDB B,[.BP (3RLR),C]
2599         TLNE C,3RLL
2600          TLO B,1
2601         POPJ P,
2602
2603 GVUND1: MOVE A,CONTRL
2604         TRNE A,DECREL+FASL      ;DEC FMT OR FASL => UNDEF GLOBALS OK.
2605          JRST GVGLT1
2606 GVUGV:
2607 GVUNDF: TRZ I,IRDEF     ;UNDEFINED, MAYBE ERROR, MAKE GLOTB ENTRY.
2608         TRNE I,IRPSUD\IREQL
2609          JRST GVUND2    ;PSEUDO
2610         TRNN FF,FRPSS2
2611          JRST GVGLT1            ;PASS 1
2612         SKIPN CONDEP
2613          ETSM [ASCIZ/Undefined/]
2614         SKIPE CONDEP
2615          ETSM [ASCIZ/Undefined in literal/]
2616         JRST CABPOP
2617
2618 GVUND2: HLRZ A,GTVER    ;DOES GTVER POINT TO AN INSN?
2619         JUMPE A,[XCT @GTVER ? JRST CABPOP]
2620         ERJ .+1         ;NO, IT IS NAME OF PSEUDO.
2621         MOVE A,LINEL
2622         CAIGE A,75.     ;CR-LF-TAB NOW IF WHOLE MSG WON'T FIT ON A LINE.
2623          CALL CRRTBX
2624         TYPE2 SYM       ;TYPE NAME OF UNDEF SYM.
2625         TYPR [ASCIZ/    Undefined in /]
2626         TYPE2 GTVER
2627         CALL CRRERR
2628         JRST CABPOP
2629 \f
2630 ;EVALUATE SYMBOL, SQUOZE (FLAGS OFF) IN SYM
2631 ;IDX OF BLOCK TO DEFINE IN IN ESBK (OR -1 => ANY BLOCK NOW IN PROGRESS).
2632 ;DOESN'T CLOBBER F (FOR WRQOTE)
2633 ;RETURNS SKIPPING IF SYM FOUND, WITH SQUOZE FLAGS IN BOTTOM OF A,
2634 ;VALUE OF SYM IN B, STE IDX IN D, AND 3RDWD IN C.
2635 ;IF NOT FOUND, RETURNS IN D THE IDX OF A PLACE TO DEFINE SYM.
2636 ;CALL ESDCHK TO GET THE FOLLOWING EXTRA INFO (WHETHER SYM FOUND OR NOT):
2637 ;ESLAST -> LAST STE WITH DESIRED NAME SEEN, REGARDLESS OF WHAT BLOCK IT'S IN
2638 ;ESL1 HAS LEVEL OF BLOCK OF BEST STE SEEN, -1 IF NOT FOUND
2639 ;ESL2 HAS 3RDWRD OF BEST.
2640 ;ESXPUN HAS -1 OR IDX OF A STE WHICH MIGHT BE USED TO DEFINE THE SYM.
2641 ;RH(TM) GETS BLOCK IDX TO DEFINE IN IF DEFINE THE SYM.
2642 ;TT HAS -<# STE NOT LOOKED AT YET>
2643 ;THEN IF SYM IS FOUND IN A CONTAINING BLOCK AND YOU WANT TO DEFINE
2644 ;IT IN THE CURRENT BLOCK, YOU CAN CALL DEFCHK TO FIND AN STE TO DO IT IN.
2645 ;CALLING ESDEF IS AS GOOD AS CALLING ESDCHK AND DEFCHK, BUT DOESN'T
2646 ;LET YOU SEE WHAT YOU ARE GOING TO SHADOW.
2647
2648 ESDEF:  MOVE A,BKCUR    ;EVAL SYM IN ORDER TO DEFINE IT:
2649         SKIPGE ESBK     ;IF NO SPEC'D BLOCK, SPEC THE CURRENT BLOCK,
2650         MOVEM A,ESBK    ;SO DEFS IN CONTAINING BLOCKS WON'T BE SEEN
2651
2652 ESDCHK: SETOM ESLAST    ;CALL HERE IF WE MIGHT END UP CALLING DEFCHK,
2653         SETOM ESL1      ;SINCE IN THAT CASE WE'LL NEED THESE VARS EVEN IF SYM IS FOUND
2654         SETOM ESXPUN    ;RIGHT AWAY.
2655         MOVN TT,SYMLEN
2656 ES:     MOVE C,SYM      ;HASH AWAY
2657         TSC C,SYM       ;THIS MAKES SURE THAT THE FIRST FEW CHARS OF SYMBOL DON'T GIVE
2658                         ;A ZERO REMAINDER, IF SYMLEN IS A ROUND NUMBER.
2659         MOVMS C         ;THIS IS BECAUSE IDIV OF NEGATIVE NUMBER GIVES NEG. REMAINDER.
2660         IDIV C,SYMLEN
2661         IMUL D,WPSTE
2662         SKIPGE TM,ESBK  ;GET BKTAB IDX OF SPEC'D BLOCK
2663          HRR TM,BKCUR   ;OR -1,,BKTAB IDX OF CURRENT BLOCK.
2664 ;NOW CHECK FAST FOR AN IMMEDIATE MATCH - AVOID SETTING UP FLAGS NEEDED ONLY WHEN
2665 ;SYM APPEARS IN MULTIPLE BLOCKS OR ISN'T DEFINED.
2666         SKIPN B,ST(D)
2667          JRST ESEND0    ;SYM IS KNOWN NOT TO BE DEFINED.
2668         TLZ B,740000
2669         CAME B,SYM
2670          JRST ESBAD0    ;NOT FOUND IN 1ST ENTRY - MUST SET UP INFO AND LOOP
2671         3GET C,D
2672         MOVEI A,(C)
2673         CAIN A,(TM)
2674          JRST ESGOOD    ;IN THE DESIRED BLOCK => GOOD.
2675         TDNN C,[3MAS,,-1]       ;IN THE INITIAL SYMS BLOCK, NOT PRESENT IN ANY OTHER,
2676          JUMPL TM,ESGOOD        ;AND BLOCK WASN'T EXPLICITLY SPEC'D => GOOD.
2677         MOVN TT,SYMLEN  ;ELSE MUST KEEP LOOKING TO SEE IF THIS DEF IS REALLY ONE WE WANT.
2678         SETOM ESLAST
2679         SETOM ESL1
2680         SETOM ESXPUN
2681         JUMPGE TM,ESIGN
2682         JRST ESLP1
2683 \f
2684 ;LOOK AT THE NEXT STE, WHILE LOOPING.
2685 ESLP:   SKIPN B,ST(D)   ;GET SQUOZE IN THIS ST SLOT
2686          JRST ESEND     ;NOTHING WHERE SYM BELONGS, END SEARCH
2687         TLZ B,740000    ;CLEAR OUT FLAGS
2688         CAME B,SYM      ;COMPARE WITH WANTED
2689          JRST ESBAD     ;NO MATCH BUT MAYBE KEEP GOING
2690         3GET C,D        ;FOUND SYM, GET 3RDWRD
2691         MOVEI A,(C)
2692         CAIN A,(TM)     ;DEFINED IN DESIRED BLOCK
2693          JRST ESGOOD    ; => MUST BE GOOD.
2694 ESLP0:  JUMPGE TM,ESIGN ;BLOCK SPEC'D => ALLOW NO OTHERS.
2695         TDNE C,[3MAS,,-1]       ;IF IN INITIAL SYMS BLK, NO MORE DEFS,
2696          JRST ESLP1
2697         SKIPGE ESL1     ;AND NO PREVIOUS DEFS,
2698          JRST ESGOOD    ;UNREDEFINED INITL SYM MUST BE GOOD.
2699 ESLP1:  HLRZ B,BKTAB+1(C)       ;GET LEVEL OF BLOCK DEF. IS IN.
2700         CAMN A,BKPDL(B) ;SAME AS BLOCK WE'RE IN AT THAT LEVEL?
2701          CAMLE B,BKLVL  ;AND NOT A BLOCK WE'VE EXITED
2702           JRST ESIGN
2703         CAMG B,ESL1     ;OR HIGHER LEVEL THAN PREVIOUS BEST
2704          JRST ESIGN
2705         MOVEM C,ESL2    ;REPLACE BEST'S 3RDWRD, LEVEL, ADDR.
2706         MOVEM B,ESL1
2707         MOVEM D,SADR
2708 ESIGN:  HRRZM D,ESLAST  ;THIS ENTRY LAST SEEN WITH THIS NAME.
2709         TLNN C,3MAS     ;MORE STE'S FOR THIS SYM =>
2710          JRST ESEND1
2711         JRST ESNXT      ;KEEP LOOKING.
2712
2713 ;COME HERE IF 1ST SYM SEEN ISN'T THE SAME NAME. SET UP TO LOOP.
2714 ESBAD0: MOVN TT,SYMLEN
2715         SETOM ESLAST
2716         SETOM ESL1
2717         SETOB C,ESXPUN
2718 ;HERE WHILE LOOPING WHEN SYM WITH WRONG NAME IS SEEN.
2719 ESBAD:  JUMPN B,ESNXT
2720         SKIPGE A,ESXPUN ;IF THIS IS 1ST EXPUNGED ENTRY SEEN
2721          MOVEM D,ESXPUN ;REMEMBER IT FOR DEFINITION.
2722         SKIPGE A
2723          HRROS ESLAST   ;AND SET OLD ENTRY'S 3MAS.
2724 ESNXT:  ADD D,WPSTE
2725         CAML D,SYMSIZ   ;AT END => GO TO BEGINNING
2726          MOVEI D,0
2727         AOJN TT,ESLP
2728         JRST ESEND1     ;NOT FOUND.
2729 \f
2730 ESEND0: MOVEI C,(TM)    ;COME HERE IF 1ST PLACE LOOKED AT SHOWS THE SYM ISN'T DEFINED
2731         MOVEM D,ESXPUN
2732         POPJ P,
2733
2734 ESEND:  SKIPGE A,ESXPUN ;FREE ENTRY CAN BE USED TO DEFINE.
2735         MOVEM D,ESXPUN
2736         SKIPGE A
2737         HRROS ESLAST
2738 ESEND1: SKIPGE ESL1     ;NOT FOUND => FIND PLACE TO DEFINE IT.
2739         JRST DEFCH1
2740         MOVE D,SADR     ;IDX OF BEST FOUND.
2741         TRNN FF,FRNPSS
2742         JRST ES1PS      ;1-PASS, SPECIAL CHECK.
2743         MOVE C,ESL2     ;GET BEST'S 3RDWRD.
2744 ESGOOD: LDB A,[400400,,ST(D)]   ;GET SQUOZE FLAGS IN A.
2745 ES1POK: MOVE B,ST+1(D)  ;VALUE OF SYM. IN B.
2746                         ;D HAS IDX OF 1STWRD IN SYM TAB.
2747                         ;C HAS 3RDWRD
2748 POPJ1:  AOS (P)
2749 CPOPJ:  POPJ P,
2750
2751 ;ESDCHK THEN DEFCHK IS SAME AS CALLING ESDEF.
2752 DEFCHK: SKIPGE ESL1     ;IF WE DIDN'T TAKE TIME TO SET ESLAST BEFORE,
2753         HRRZM D,ESLAST  ;DO IT NOW. (SEE BEFORE ESLP1)
2754         JRST DEFCH1
2755
2756 ES1PS:  LDB A,[400400,,ST(D)]   ;1PASS & FOUND IN CONTAINING BLOCK:
2757         MOVE C,ESL2
2758         TRNN C,-1       ;INITIAL SYM, OK;
2759          JRST ES1POK
2760         CAIE A,1        ;PSEUDO OR MACRO
2761          TLNE C,3DOWN   ;OR .DOWN'D SYMBOL OK;
2762           JRST ES1POK   ;ELSE GET NEW STE TO DEF.
2763 DEFCH1: MOVEI C,(TM)    ;INITIALIZE NEW 3RDWRD WITH BLOCK TO DEF IN.
2764         SKIPL D,ESXPUN  ;IF FOUND EXPUNGED OR FREE ENTRY, USE IT.
2765         JRST DEFCH2
2766         SKIPGE D,ESLAST ;ELSE LOOK FOR ONE.
2767          ETF ERRSCE
2768 DEFCH4: MOVE B,ST(D)
2769         TLZ B,740000
2770         JUMPE B,DEFCH3  ;MUST RETURN 0 IN B IF DON'T SKIP.
2771         ADD D,WPSTE
2772         CAML D,SYMSIZ
2773         MOVEI D,0
2774         AOJL TT,DEFCH4  ;ASSUME TT LEFT AROUND FROM ES.
2775         ETF ERRSCE
2776 ERRSCE: ASCIZ /Symbol table full/
2777
2778 ;ESLAST HAS -1 IF NO ENTRY SEEN;  ELSE
2779 ;RH HAS IDX OF LAST SEEN, SIGN SET IF SEEN BEFORE PLACE TO DEFINE.
2780 DEFCH3: MOVEM D,ESXPUN  ;REMEMBER ADDR WHERE CAN DEFINE
2781         HRROS ESLAST    ;LAST PLACE SEEN MUST BE EARLIER.
2782 DEFCH2: SKIPL A,ESLAST
2783         JRST DEFCH5     ;LAST PLACE SEEN WAS SEEN AFTER PLACE TO DEFINE.
2784         CAMN A,[-1]
2785         POPJ P,         ;REALLY NEVER SEEN.
2786         MOVSI TM,3MAS
2787         IORM TM,ST+2(A) ;PLACE SEEN IS EARLIER, SET ITS 3MAS.
2788         POPJ P,
2789
2790 DEFCH5: TLO C,3MAS      ;PLACE TO DEF BEFORE EXISTING STES.
2791         POPJ P,
2792 \f
2793 ;ENTER A SYM IN SYMBOL TABLE
2794                 ;B HAS VALUE
2795                 ;C HAS 3RDWRD
2796                 ;D HAS INDEX INTO ST (PROBABLY SET UP BY ES)
2797                 ;T HAS SQUOZE FLAGS (ONLY) IN PLACE FOR IOR OF SQUOZE
2798                 ;SYM HAS SQUOZE, FLAGS OF WHICH ARE IGNORED
2799
2800 VSM2LV: TLOA C,3LLV     ;ENTRY FOR LINKING LOADER MUST SUPPLY VALUE
2801 VSM2W:  MOVE B,WRD      ;ENTRY TO ENTER VALUE OF WRD STEAD B
2802 VSM2:   MOVE CH1,SYM
2803         TLZ CH1,740000
2804         IOR CH1,T       ;CH1 := SQUOZE WITH FLAGS
2805         MOVEM CH1,ST(D) ;STORE SQUOZE
2806         MOVEM B,ST+1(D) ;STORE VALUE
2807 VSM3A:  3PUT C,D        ;STORE 3RDWRD
2808         POPJ P,
2809
2810 ;RETURN THE NUMBER OF SYMTAB SLOTS IN USE.
2811 A.SYMCN:MOVE D,SYMAOB
2812         SETZ A,
2813 A.SYC1: MOVE B,ST(D)
2814         TLZ B,740000
2815         SKIPE B
2816          AOS A
2817         ADD D,WPSTE1
2818         AOBJN D,A.SYC1
2819         JRST CLBPOP
2820 \f
2821 ;;EQUAL         ;EQUAL SIGN ENCOUNTERED, DO PARAMETER ASSIGNMENT
2822
2823 EQUAL:  TLZ FF,FLHKIL
2824         PUSHJ P,RCH
2825         CAIE A,"=       ;DECIDE WHETHER TO HALF-KILL THE SYM.
2826          TLOA FF,FLUNRD
2827           TLO FF,FLHKIL
2828         SETZM LABELF
2829         CALL RCH
2830         CAIE A,":       ;DECIDE WHETHER TO MARK SYM AS NOT REDEFINABLE.
2831          TLOA FF,FLUNRD
2832           SETOM LABELF
2833         CAMN SYM,[SQUOZE 0,.]   ;.=FOO, SAME AS LOC FOO
2834          JRST PTEQ
2835         TDNN I,[ILWORD,,IROP+IRNOEQ]
2836          TRNN I,IRLET
2837           ETR [ASCIZ/= With bad format or bad context/]
2838         PUSH P,SYM
2839         PUSH P,ESBK
2840         PUSH P,I
2841         MOVEI A,[ETSM [ASCIZ/Undefined in =/]]
2842         MOVEM A,GTVER
2843         TRO I,IRNOEQ+IRDEF+IREQL
2844         PUSHJ P,GETWRD
2845         MOVEI CH1,CRDF
2846         MOVEM CH1,PARBIT        ;SET FLAG TO TELL LOADER TO ALLOW REDEFINITION
2847         TRNN I,IRDEF
2848          JRST ASEM1A    ;UNDEFINED SYMS IN VALUE, IGNORE
2849 IFN LISTSW,[
2850         SKIPN LSTONP
2851          JRST EQUAL1    ;NOT LISTING.
2852         SKIPGE LISTPF
2853          PUSHJ P,PNTR
2854         MOVE SYM,WRD
2855         MOVEM SYM,LISTWD
2856         MOVE SYM,WRDRLC
2857         MOVEM SYM,LSTRLC
2858         SETOM LISTAD
2859         SETOM LISTPF
2860 EQUAL1:
2861 ] ;END IFN LISTSW,
2862         TDZ I,[-1-(ILMWRD)]
2863         IOR I,(P)
2864         TLZ FF,FLUNRD
2865         POP P,(P)
2866         POP P,ESBK
2867         POP P,SYM
2868         MOVE A,WRDRLC   ;GET RELOCATION
2869         TDNN A,[-2,,-2] ;SKIP ON NON-STANDARD RELOCATION BITS
2870         SKIPE LDCCC
2871         JRST EQG1       ;STRANGE RELOCATION OR IN LOAD TIME CONDITIONALS => HAND PROBLEM TO LOADER
2872         MOVE A,GLSP1
2873         CAMN A,GLSP2
2874         JRST EQL1       ;NO GLOBALS IN DEFINITION
2875 ;FALLS THROUGH.
2876 \f
2877 ;FALLS THROUGH.
2878 ;GLOBALS TO RIGHT OF = OR WITHIN LOADER CONDIT.
2879 EQG1:   IFN CREFSW, XCT CRFLBL  ;CREF DEF. OF NORMAL SYM,
2880         SKIPGE CONTRL
2881          JUMPL FF,[ETASM [ASCIZ /Externals in =/]]
2882         CALL ESDCHK             ;SEARCH SYM TAB.
2883          JRST EQL2      ;NOT FOUND IN CURRENT OR CONTAINING BLKS.
2884         HRRZI T,(C)     ;GET BKTAB IDX OF BLOCK FOUND IN.
2885         CAIE T,(TM)
2886          JRST EQG1A
2887         XCT EQG1TB(A)   ;FOUND IN DESIRED BLOCK.
2888         JRST ASSEM1
2889
2890 EQG1A:  JUMPN T,EQG2
2891         CAIN A,PSUDO_-16        ;FOUND AS INITIAL PSEUDO => ERROR.
2892          ETSM ERRQPA
2893 EQG2:   CALL DEFCHK     ;FIND FREE STE TO DEFINE IN DESIRED BLOCK.
2894         JRST EQL2       ;PRETEND WASN'T FOUND.
2895
2896 ERRQPA: ASCIZ /Shadowing a pseudo-op/
2897 ERRIPA: ASCIZ /Illegal =/
2898
2899 EQG1TB: ETSM ERRIPA     ;COMMON
2900         ETSM ERRIPA     ;PSEUDO OR MACRO
2901         JRST EQL2       ;SYM
2902         JRST EQGUL      ;LOCAL UNDEF
2903         ETSM ERRIPA     ;DEF LOC VAR
2904         ETSM ERRIPA     ;UNDEF LOC VAR
2905         ETSM ERRIPA     ;DEF GLO VAR
2906         ETSM ERRIPA     ;UNDEF GLO VAR
2907         JRST EQL7       ;GLO ENTRY
2908         JRST EQL8       ;GLO EXIT
2909
2910 EQL8:   PUSHJ P,GLKPNR
2911         TLZ C,3LABEL\3MULTI
2912 EQL7:   MOVSI T,GLOETY  ;GLOBAL PARA ASSIGN
2913         MOVEI B,0
2914         TLO SYM,40000
2915 LOPRA1: PUSH P,CASM1A   ;RETURN TO ASSEM1A AFTER FOLLOWING.
2916         TLNE C,3MULTI
2917          ETSM ERRMDT
2918         SKIPE LABELF
2919          TLO C,3LABEL
2920         TLNE FF,FLHKIL
2921         TLOA SYM,400000 ;SET FLAG TO HALF-KILL SYM
2922         TLZA C,3SKILL
2923         TLO C,3SKILL    ;SET CORRESPONDING FLAG IN 3RDWRD
2924         PUSHJ P,VSM2LV
2925         JUMPGE FF,CPOPJ ;JUMP ON NOT PUNCHING PASS
2926         SKIPN PARBIT    ;IF CAME FROM COLON ROUTINE,
2927         JRST PDEFPT     ;PUNCH "DEFINE SYM AS $.".
2928         TLO C,3VP       ;VALUE PUNCHED
2929         3PUT C,D        ;STORE UPDATED 3RDWRD
2930         PUSHJ P,EBLK
2931         MOVEI TT,LGPA
2932         DPB TT,[310700,,BKBUF]
2933         PUSHJ P,OUTSM0
2934         PUSHJ P,PWRDA
2935         JRST EBLK
2936
2937 EQGUL:  PUSHJ P,LKPNRO  ;LOCAL UNDEF, OUTPUT LINK REQUEST.
2938         TLZ C,3LABEL\3MULTI     ;CAN'T DETECT MDT'S WHEN ONLY STINK KNOWS FOR SURE.
2939 EQL2:   TLNE I,ILGLI
2940          JRST EQL7      ;MAKE IT GLOBAL
2941         MOVSI T,LCUDF   ;LOCAL UNDEFINED
2942         JRST LOPRA1
2943
2944 CASM1A: JRST ASEM1A
2945 \f
2946 ;MAYBE PUNCH OUT LINK REQUEST
2947 ;SYM HAS NAME OF SYM TO REQUEST, D STE IDX OF SYM, C 3RDWRD, B ADR OF REQUEST
2948 ;REQUEST WILL BE PUNCHED IF 3RLNK SET IN C OR IF ANYTHING SET IN LH(B)
2949
2950 GLKPNR: TLO SYM,40000   ;GLO BIT
2951 LKPNRO: TLNN C,3RLNK
2952         TLNE B,-1
2953         TROA I,IRCONT
2954         POPJ P,         ;DON'T PUNCH REQUEST
2955         MOVE A,CONTRL
2956         TRNE A,DECREL
2957          JRST LKPNDR    ;DIFFERENT WAY TO OUTPUT THIS INFO IN DECREL FMT
2958         MOVEI A,6
2959         PUSHJ P,PBITS
2960         PUSHJ P,OUTSM0  ;PUNCH SYM
2961         HLRZ A,B
2962         TLZE C,3RLNK    ;RELOC OF LINK PNR
2963         TLO A,100000
2964         HRRZS B         ;CLEAR OUT LH OF B
2965         TRZ I,IRCONT    ;OK TO END BLOCK NOW
2966         JRST $OUTPT     ;PUNCH OUT A AND RETURN
2967
2968 LKPNDR: MOVSI A,DECINT  ;WRITE AN "INTERNAL REQUEST" WITH ONE DATA WORD.
2969         CALL DECBLK
2970         SETZ TM,        ;COMPUTE RELOC OF ADDRESS AND DATA IN TM.
2971         TLNE C,3RLNK
2972          TRO TM,2
2973         SKIPE WRDRLC
2974          TRO TM,1
2975         MOVE A,WRD      ;ADDRESS TO LINK,,DATA
2976         HRL A,B
2977         CALL DECWR1
2978         JRST EBLK
2979
2980 ;THESE ASSUME STE IDX IN D, SQUOZE W/ FLAGS IN SYM.
2981 ;C HAS 3RDWRD, B OR WRD HAS VALUE TO DEF. WITH.
2982 ;CALL ONLY IN RELOCATABLE ASSEMBLY.
2983 OUTDE2: MOVEM B,WRD
2984 OUTDE1: TLNE FF,FLPPSS
2985         TLO C,3VP       ;VALUE PUNCHED
2986         3PUT C,D
2987         SKIPGE CONTRL
2988          RET
2989         TRO I,IRCONT
2990         PUSHJ P,P70     ;PUNCH OUT CODE BITS
2991         PUSHJ P,GTVL7B  ;SET RELOCATION BITS IN SQUOZE
2992         PUSHJ P,OUTSM0
2993         TRZ I,IRCONT
2994         JRST OUTWD      ;OUTPUT VALUE
2995
2996 ;PUNCH OUT LOCAL-GLOBAL RECOVERY BITS AND SYM
2997 ;I.E. TELL LOADER THAT SQUOZE IN SYM, FORMERLY CONSIDERED LOCAL, IS REALLY GLOBAL
2998 PLOGLO: SKIPGE CONTRL
2999          RET
3000         PUSH P,A
3001         TRO I,IRCONT    ;Don't end block between the two words
3002         PUSHJ P,PBITS7
3003         MOVEI A,CLGLO
3004         PUSHJ P,PBITS
3005         TLO SYM,400000  ;SAY THIS IS NEW STYLE RQ,
3006         PUSHJ P,OUTSM0  ;PUNCH "OLD NAME" = SYMTAB IDX,
3007         TLC SYM,440000  ;SAY MAKE GLOBAL, OUTPUT ACTUAL NAME OF SYM.
3008         TRZ I,IRCONT
3009         PUSHJ P,OUTSM
3010         JRST POPAJ
3011 \f
3012                 ;NO GLOBALS TO RIGHT OF EQUAL SIGN
3013
3014 EQL1:   PUSHJ P,ESDCHK
3015          JRST EQL1A     ;NOT FOUND
3016 IFN CREFSW,XCT CRFEQL   ;DEF. OCCUR. OF NORMAL SYM. OR INTSYM.
3017         MOVEI T,(C)     ;GET BKTAB IDX OF BLOCK FOUND IN.
3018         CAIE T,(TM)
3019          JRST EQL1F
3020         SKIPE LABELF    ;"=:" MEANS "SYM'S VALUE SHOULDN'T BE CHANGED".
3021          TLO C,3LABEL
3022         XCT EQL1TB(A)   ;FOUND IN DESIRED BLOCK => NOW REDEFINE.
3023         JRST ASSEM1
3024
3025 EQL1F:  JUMPN T,EQL10
3026         CAIE A,PSUDO_-16
3027          JRST EQL10
3028         MOVEI T,(B)     ;FOUND AS PSEUDO IN INITIAL SYMS BLOCK,
3029         CAIN T,INTSYM   ;SPECIAL WAY TO REDEFINE IF LIKE .MLLIT, ETC.
3030          JRST EQLINT
3031         ETSM ERRQPA     ;SHADOWING AN INITIAL PSEUDO, TELL USER.
3032 EQL10:  CALL DEFCHK     ;FOUND IN OUTER BLOCK, GET NEW STE,
3033         JRST EQL1A      ;DEFINE THERE AS IF NOT FOUND.
3034
3035 EQL1TB: ETSM ERRIPA     ;COMMON
3036         JRST EQL1B2     ;PSEUDO OR MACRO
3037         JRST EQL1B      ;SYM
3038         JRST EQL1C      ;LOCAL UNDEF
3039         ETSM ERRIPA     ;DEF LOC VAR
3040         ETSM ERRIPA     ;UNDEF LOC VAR
3041         ETSM ERRIPA     ;DEF GLO VAR
3042         ETSM ERRIPA     ;UNDEF GLO VAR
3043         JRST EQL1D      ;GLO ENTRY
3044         JRST EQL1E      ;GLO EXIT
3045
3046 EQL1E:  PUSHJ P,GLKPNR  ;DUMP LINKING POINTER
3047         CAIA
3048 EQL1D:   CALL MDTCHK
3049         PUSHJ P,RCHKT   ;GLO ENTRY
3050 EQLB2:  PUSHJ P,RMOVET
3051         TLNE FF,FLHKIL
3052         TLOA SYM,400000
3053         TLZA C,3SKILL
3054         TLO C,3SKILL
3055         HRLZI T,GLOETY
3056         SKIPE LDCCC     ;IF IN LOADER CONDITIONAL,
3057         TLO C,3LLV      ;THEN LOADER MUST SUPPLY VALUE
3058         PUSHJ P,VSM2W   ;DEFINE SYM
3059         TLO SYM,40000   ;SET GLOBAL BIT IN SQUOZE
3060 EQL1CE: JUMPGE FF,ASEM1A
3061         PUSHJ P,OUTDE1
3062 ASEM1A: TLNE I,ILMWRD
3063         PUSHJ P,IGTXT
3064         JRST ASSEM1
3065
3066 ;CHECK WHETHER DEFINING AN MDT, OR REDEFINING A LABEL (=> THIS IS AN MDT)
3067 MDTCHK: TLNN C,3LABEL
3068          JRST MDTCH1
3069         CALL GVSYM0     ;MOVE VALUE OF SYM TO A, GET RELOC (WRDRLC STYLE) IN B
3070         CAMN A,WRD
3071          CAME B,WRDRLC  ;IF WE'RE CHANGING THE VALUE, MARK SYM AS MDT
3072 MDTCHL:   TLO C,3MULTI
3073 MDTCH1: TLNE C,3MULTI   ;EVER ASSIGNING TO MDT, EVEN SAME VALUE, GIVES ERR MSG
3074          ETSM ERRMDT
3075         RET
3076 \f
3077 EQL1C:  TLNE I,ILGLI
3078         JRST EQL1CA     ;MAKE GLOBAL
3079         PUSH P,C
3080         PUSHJ P,LKPNRO  ;MAYBE OUTPUT LINK REQUEST
3081         PUSHJ P,RCHKT
3082         PUSHJ P,RMOVET  ;INITIALIZE 3RDWRD
3083         MOVSI T,SYMC    ;SYM
3084         PUSHJ P,EQA2A   ;ENTER DEF IN SYMTAB
3085         TLNE C,3SKILL
3086         TLO SYM,400000
3087         POP P,AA
3088         TLNE AA,3VCNT   ;USED IN CONSTANT
3089         PUSHJ P,CONBUG
3090         JRST EQL1CE
3091
3092                 ;PUNCH OUT CODE BIT PAIR, FIRST OF WHICH IS 7
3093
3094 P7X:    MOVEM A,PARBIT  ;ENTRY FOR SECOND BYTE IN A
3095 P70:    PUSHJ P,PBITS7  ;ENTRY FOR SECOND BITE IN PARBIT, PUNCH OUT THE 7
3096         SKIPA A,PARBIT  ;GET SECOND BYTE BACK
3097 PBITS7: MOVEI A,7       ;ENTRY TO JUST PUNCH OUT 7
3098         JRST PBITS
3099
3100 EQL1CA: PUSHJ P,PLOGLO
3101         JRST EQL1E
3102 EQA2:   PUSH P,CASM1A
3103 EQA2A:  TLNE FF,FLHKIL
3104         TLO C,3SKILL
3105         JRST VSM2W
3106
3107 EQL1B2: HRRZ A,B        ;ATTEMPT TO ASSIGN PSEUDO-OP, IS IT AN INTSYM?
3108         CAIN A,INTSYM
3109          JRST EQLINT    ;YES, GO SET WD IT POINTS TO.
3110         ETSM [ASCIZ /Pseudo or macro ='D/]
3111 EQL1B:  CALL MDTCHK
3112         PUSHJ P,RCHKT
3113         TLNE I,ILGLI
3114          JRST EQLB2     ;WAS LOCAL, MAKE IT GLOBAL
3115                 ;WAS LOCAL, LEAVE IT LOCAL
3116         PUSHJ P,RMOVET  ;PUT RELOCATION BITS IN BITS 0 AND 1 OF C (I.E. START SETTING UP 3RDWRD)
3117         MOVSI T,SYMC    ;SYM
3118         JRST EQA2
3119
3120 EQL1A1: PUSHJ P,RCHKT
3121         PUSHJ P,RMOVET
3122         HRLZI T,SYMC
3123         JRST EQA2
3124
3125 EQL1A:  SKIPE LABELF    ;"=:" MEANS "SYM'S VALUE SHOULDN'T BE CHANGED".
3126          TLO C,3LABEL
3127 IFN CREFSW,XCT CRFLBL   ;DEF. OCCUR. OF NORMAL SYM.
3128         TLNN I,ILGLI
3129         JRST EQL1A1
3130         JRST EQL1E
3131
3132 EQLINT: HLRZS B         ;GET ADDR OF WD HOLDING VALUE.
3133         MOVEMM (B),WRD  ;PUT NEW VALUE IN IT.
3134         JRST ASEM1A
3135 \f
3136 ;;.             ;ROUTINES DEALING WITH THE CURRENT LOCATION AND OFFSET
3137
3138 VBLK
3139 CLOC:   0       ;PUNCHING LOC
3140 CRLOC:  0       ;PUNCHING RELOC
3141 OFLOC:  0       ;OFSET VAL
3142 OFRLOC: 0       ;OFSET RELOC
3143 ;VAL OF PT=CLOC+OFLOC,CRLOC+OFLOC
3144 SYLOC:  0       ;VAL OF LAST TAG
3145 SYSYM:  0       ;LAST TAG
3146 SYLOC1: 0       ;VALUE OF NEXT TO LAST TAG
3147 SYSYM1: 0       ;NEXT TO LAST TAG
3148 GLOCTP: 0       ;4.9 => CURRENT LOCATION GLOBAL, 2.9 => OFFSET GLOBAL
3149                 ;FRGLOL (FLAG IN FF) IS IOR OF BITS 4.9 AND 2.9 OF GLOCTP
3150                 ;EXCEPT AFTER .=NON-GLOBAL WITH GLOBAL OFFSET
3151                 ;OTHER BITS USED ONLY WHEN IN LINK (NEVER SET IN GLOCTP):
3152                 ;400 => ARG GLOBAL
3153 PBLK
3154
3155
3156                 ;POINT (.) AS PSEUDO-OP
3157
3158 GTVLP:  TRNE FF,FRGLOL
3159         JRST GTVLP2     ;LOCATION GLOBAL
3160         MOVE B,OFRLOC   ;GET RELOCATION OF OFFSET
3161         ADD B,CRLOC     ;ADD CURRENT RELOCATION
3162         MOVE A,CLOC     ;GET CURRENT LOCATION
3163         SKIPGE BYTM1    ;IF IN BYTE MODE,
3164         HLL A,BYTWP     ;SET LEFT HALF TO BYTE POINTER LEFT HALF FOR ILDB
3165         ADD A,OFLOC     ;NOW ADD OFFSET
3166         TLZ I,ILFLO+ILDECP+IRPERI       ;CLEAR OUT FLAGS SET WHEN LOOKED LIKE FLOATING POINT NUMBER
3167         POPJ P,
3168
3169
3170 GTVLP2: MOVEI T,$.H     ;LOCATION GLOBAL
3171         AOS GLSP1
3172         HRRZM T,@GLSP1  ;PUT $. ON GLOBAL LIST (INCLUDES OFFSET, WHETHER GLOBAL OR NOT)
3173         SKIPL BYTM1     ;IN BYTE MODE?
3174         TDZA A,A        ;NO, CLEAR ABS PART OF VALUE
3175         HLLZ A,BYTWP    ;YES, USE LH(BP) AS ABS PART
3176         JRST CLBPOP
3177
3178 $.H:    (GLOETY)+SQUOZE 0,$.    ;CURRENT LOCATION + OFFSET IN LOADER
3179 $L.H:   (GLOETY)+SQUOZE 0,$L.   ;LOCATION BEING LOADED INTO BY LOADER, USED BY ABLOCK
3180 $O.H:   (GLOETY)+SQUOZE 0,$O.   ;LOADER OFFSET
3181 $R.H:   (GLOEXT)+SQUOZE 0,$R.   ;RELOCATION AS GLOBAL
3182 \f
3183 COLON:  TRNE I,IRLET
3184          TRNN I,IRSYL
3185           ETA [ASCIZ/Colon without preceding symbol/]
3186         TLNN I,ILWORD
3187          TRNE I,IROP+IRPSUD+IREQL+IRNOEQ
3188           ETSM [ASCIZ/Label inside an expression/]
3189         SKIPE ASMOUT
3190          ETSM [ASCIZ /Label inside <>, () or []/]
3191         TLZ FF,FLHKIL
3192         PUSHJ P,RCH     ;GET NEXT CHAR
3193         CAIN A,":       ;IF NEXT CHAR ANOTHER COLON,
3194         TLOA FF,FLHKIL  ;THEN SET FLAG TO HALF-KILL
3195         TLO FF,FLUNRD   ;NOT COLON, CAUSE IT TO BE RE-INPUT
3196         SKIPE HKALL     ;CHECK FOR HALF-KILL-ALL-LABELS MODE.
3197          TLO FF,FLHKIL
3198         MOVE T,CLOC     ;GET CURRENT LOCATION
3199         SKIPGE BYTM1
3200         HLL T,BYTWP     ;BYTE MODE, SET LEFT HALF OF VALUE TO LEFT HALF OF BYTE POINTER
3201         ADD T,OFLOC     ;ADD OFFSET
3202         MOVEM T,WRD     ;STORE RESULT AWAY FOR POSSIBLE PUNCHOUT
3203         EXCH T,SYLOC    ;NOW SET UP STUFF FOR ERROR PRINTOUT
3204         MOVEM T,SYLOC1
3205         EXCH SYM,SYSYM
3206         MOVEM SYM,SYSYM1
3207         MOVE SYM,SYSYM
3208         MOVE A,CRLOC    ;SET UP RELOCATION
3209         ADD A,OFRLOC
3210         MOVEM A,WRDRLC
3211         CLEARM PARBIT   ;SET FLAG SAYING COLON, FOR DEFINITION PUNCHING
3212         SETOM LABELF    ;SET FLAG CAUSING 3LABEL (DON'T REDEFINE) TO BE SET.
3213         SKIPN LDCCC
3214         TRNE FF,FRGLOL
3215         JRST GCOL1      ;LOCATION VIRTUAL OR IN LOAD TIME CONDITIONAL
3216         PUSHJ P,ESDCHK  ;TRY FINDING CURRENT ENTRY IN ST
3217         JRST EQL1A      ;NOT ALREADY DEFINED
3218 IFN CREFSW,XCT CRFLBL
3219 COLON1: MOVEI T,(C)     ;BKTAB IDX OF BLOCK FOUND IN,
3220         CAIE T,(TM)     ;FOUND IN DESIRED BLOCK => TRY REDEFINING.
3221          JRST COLON3
3222         TLO C,3LABEL    ;CAUSE REDEFINING SYMBOL TO BARF
3223         XCT COLON2(A)   ;BUT MAYBE PRINT ERR MSG FIRST.
3224         JRST EQL1B
3225
3226 CASSM1: JRST ASSEM1
3227
3228 COLON3: JUMPN T,EQL10   ;NOT INITIAL SYM => CAN SHADOW,
3229         CAIN A,SYMC_-14. ;INITIAL SYM => CAN SHADOW IF IT'S AN ORDINARY LOCAL SYM
3230          CAME B,WRD     ;AND NEW VALUE SAME AS OLD VALUE.
3231           CAIA
3232            SKIPE WRDRLC
3233             ETSM ERRRES ;ELSE GIVE ERROR MESSAGE BEFORE SHADOWING, TO WARN USER.
3234         JRST EQL10
3235
3236 ERRRES: ASCIZ /Pseudo, macro or initial sym as label/
3237 ERRMDT: ASCIZ /Multiply defined/
3238
3239 COLON2: TLO C,3MULTI    ;COMMON
3240         ETSM ERRRES     ;MACRO OR PSEUDO
3241         JRST EQL1B      ;SYM
3242         JRST EQL1C      ;LOCAL UNDEF
3243         TLO C,3MULTI
3244         TLO C,3MULTI
3245         TLO C,3MULTI
3246         TLO C,3MULTI    ;SETTING 3MULTI CAUSES EQL1B TO PRINT AN MDT ERROR.
3247         JRST EQL1D      ;GLOBAL ENTRY
3248         JRST EQL1E      ;GLO EXIT
3249 \f
3250 ;COLON WHEN LOCATION VIRTUAL, OR IN LOAD TIME CONDITIONAL
3251
3252 GCOL1:  IFN CREFSW,XCT CRFLBL   ;DEFINING ORDINARY SYM.
3253         SKIPGE CONTRL
3254          ETASM [ASCIZ /Virtual label in abs assembly/]
3255         PUSHJ P,ESDCHK  ;FIND ITS SLOT IN ST
3256          JRST EQL2      ;JUST LIKE EQG1 EXCEPT FOR ERROR MESSAGES.
3257         MOVEI T,(C)
3258         CAIE T,(TM)
3259          JRST COLON5
3260         XCT GCOL1T(A)   ;FOUND IN DESIRED BLOCK, REDEFINING.
3261         JRST EQL2
3262
3263 COLON5: JUMPN T,EQG2    ;SHADOWING, OK UNLESS INITIAL SYM.
3264         ETSM ERRRES
3265         JRST EQG2
3266
3267 GCOL1T: TLO C,3MULTI    ;COMMON
3268         ETSM ERRRES     ;PSEUDO.
3269         JRST EQL2       ;SYM.
3270         JRST EQGUL      ;LOCAL UNDEF.
3271         TLO C,3MULTI    ;VAR
3272         TLO C,3MULTI
3273         TLO C,3MULTI
3274         TLO C,3MULTI
3275         JRST EQL7       ;DEF GLO
3276         JRST EQL8       ;UNDEF GLO.
3277
3278
3279                 ;PUNCH OUT "DEFINE SYM AS $."
3280
3281 PDEFPT: MOVEI A,CDEFPT
3282         PUSHJ P,P7X     ;OUTPUT 7 THEN PDEFPT
3283         JRST OUTSM0     ;OUTPUT SYM, WITHOUT BITS
3284 \f
3285 ;LOC, BLOCK, .=
3286
3287 ALOC:   PUSHJ P,ALOCRG  ;LOC, GET ARG
3288 ALOC1:  SETZM SYLOC     ;CLEAR OUT LOC OF LAST TAG
3289         SETZM SYSYM     ;CLEAR OUT LAST TAG SO ERROR MESSAGES DON'T PRINT OBSCENE INCREMENTS
3290 IFN FASLP,[
3291         SKIPGE TM,CONTRL
3292         TRNN TM,FASL
3293         JRST .+2
3294         ETA [ASCIZ /LOC illegal in FASL assembly/]
3295 ]
3296         TRZE LINK,400   ;GLOBALS IN ARG?
3297         JRST ALOC2      ;YES
3298         HRRZM A,CLOC    ;STORE NEW ABSOLUTE PART OF CURRENT LOCATION
3299         CALL SLOCF      ;RE-INIT NEXT OUTPUT BLOCK'S HEADER; SET LOCF.
3300         MOVEI A,LCEGLO  ;=> RESET GLOBAL RELOCATION (BACK TO ORIGINAL NON-GLOBAL RELOCATION)
3301         TLZE LINK,400000        ;IS CURRENT LOCATION NOW GLOBAL?
3302         PUSHJ P,PLDCM   ;YES, RESET IT
3303         MOVE B,WRDRLC   ;GET BACK NEW RELOCATION
3304 ALOC2B: TRZE B,-2       ;NO BITS ALLOWED EXCEPT LOW ORDER
3305          ETR [ASCIZ *Illegal relocation in LOC/BLOCK/.=*]
3306         HRRZM B,CRLOC   ;STORE NEW RELOCATION
3307         SKIPGE CONTRL
3308          JRST ASSEM1    ;DON'T BOTHER WITH REST IF ABS.
3309         MOVEI B,2(B)    ;LABS OR LREL
3310         DPB B,[310700,,BKBUF]   ;STORE NEW BLOCK TYPE
3311         MOVEM B,CDATBC  ;ALSO STORE AS NORMAL BLOCK TYPE
3312 AOFSTX: TDNN LINK,[SETZ(SETZ)]  ;ENTRY FROM AOFFSET, SKIP IF FRGLOL SHOULD BE SET
3313         TRZA FF,FRGLOL  ;CURRENT LOCATION PLUS OFFSET NOT GLOBAL, CLEAR FLAG
3314         TRO FF,FRGLOL   ;GLOBAL, SET FLAG
3315         TRZ LINK,600    ;CLEAR OUT TEMPORARY FLAGS SO WON'T GET STORED IN GLOCTP
3316         MOVEM LINK,GLOCTP       ;STORE BACK STATUS FLAGS
3317         JRST ASSEM1
3318
3319 PTEQ:   MOVE SYM,[SQUOZE 0,LOC]
3320         PUSHJ P,ALOCRG  ;.=, GET ARG
3321         MOVE T,[MINF+HFWDF,,$O.H]       ;GLOTB ENTRY IF .+1 DOESN'T SKIP
3322         TRNE LINK,400000        ;OFFSET GLOBAL?
3323         JRST PTEQ2      ;YES, WANT TO DO LOC ARG-$O."
3324         PUSHJ P,SBWDOF  ;OFFSET IS LOCAL, SUBTRACT FROM ARG
3325         JRST ALOC1
3326 \f
3327 ABLOCK: PUSHJ P,ABLKRG  ;GET ARG TO "BLOCK" PSEUDOOP.
3328         TRNE LINK,400   ;GLOBALS IN ARG?
3329          JRST ABLKG     ;GLOBALS IN ARG
3330         TLNE LINK,400000
3331          JRST ABLKG     ;JUMP IF LOSER CHANGING RELOCATION WHILE CLOC GLOBAL
3332 IFN FASLP,[
3333         MOVE D,CONTRL
3334         TRNN D,FASL     ;IN FASL FORMAT, CAN'T SET LOC. CTR.,
3335          JRST ABLKF1
3336         SKIPE B
3337          ETA [ASCIZ /BLOCK size relocatable/]
3338         JUMPGE FF,ABLKF1
3339         CALL ABLKF      ;SO ON PASS 2 OUTPUT A BUNCH OF ZEROS.
3340         JRST ABLKF1
3341
3342 ;OUTPUT C(A) ZEROS, IN FASL FORMAT. NO-OP ON PASS 1.  DOESN'T SET THE LOCATION COUNTER.
3343 ABLKF:  JUMPE A,CPOPJ
3344         JUMPGE FF,CPOPJ
3345         SETZM WRD
3346         SETZM WRDRLC
3347         SAVE A
3348         SAVE A
3349 ABLKF2: CALL FASPW
3350         MOVEMM GLSP2,GLSP1
3351         SOSE (P)
3352          JRST ABLKF2
3353         JRST POPBAJ
3354 ]
3355
3356 ABLKF1: ADD A,CLOC      ;ARG TO BLOCK IS LOCAL, ADD DIRECTLY TO CLOC
3357         ADD B,CRLOC     ;ALSO ADD RELOCATIONS
3358         HRRZM A,CLOC    ;STORE NEW ABSOLUTE PART OF LOCATION
3359         CALL SLOCF      ;FALL INTO ALOC ROUTINE, MAKING SURE FRLOC GETS SET
3360         JRST ALOC2B
3361
3362
3363 SBWDOF: SUB A,OFLOC     ;SUBTRACT OFFSET FROM WRD, ETC. IN A,B
3364         HRRZM A,WRD     ;MAKE SURE RESULT GETS STORED IN WRD, AS WELL AS AC'S
3365         SUB B,OFRLOC    ;NOW DO RELOCATIONS
3366         HRRZM B,WRDRLC
3367         POPJ P,
3368
3369 ABLKG:  TRNE LINK,400000        ;GLOBAL BLOCK, IS OFFSET GLOBAL?
3370          JRST ABLKG2    ;YES, OK TO REFERENCE $L.
3371         PUSHJ P,SBWDOF  ;NO, FOR COMPATIBILITY, DON'T REFERENCE $L.
3372         SKIPA T,[HFWDF,,$.H]
3373 ABLKG2: MOVE T,[HFWDF,,$L.H]
3374 PTEQ2:  AOS GLSP1       ;STORE T IN GLOTB
3375         MOVEM T,@GLSP1
3376 ALOC2:  TLO LINK,400000 ;SET GLOBAL LOCATION FLAG
3377         MOVEI A,LCGLO   ;=> GLOBAL LOCATION ASSIGNMENT
3378         PUSHJ P,PLDCM   ;PUNCH OUT GLOBAL LOCATION ASSIGNMENT
3379         SETZM CLOC      ;CLEAR OUT CLOC, NEW RELOCATION NOW
3380         SETZB B,BKBUF   ;ALSO CLEAR OUT HEADER, JUST TO BE SURE
3381         AOJA B,ALOC2B   ;SET RELOCATION TO 1 AND FALL IN
3382
3383 AOFFSET:        PUSHJ P,AOFFS2  ;OFFSET, GET ARG
3384         MOVE A,T
3385         MOVEM A,WRD     ;RESTORE UNTRUNCATED ARG.
3386         TRZE LINK,400   ;GLOBALS IN ARG?
3387         TROA LINK,400000        ;GLOBALS IN ARG, SET GLOBAL OFFSET FLAG
3388         TRZ LINK,400000 ;NO GLOBALS IN ARG
3389         MOVEM A,OFLOC   ;STORE NEW OFFSET
3390         MOVEM B,OFRLOC  ;ALSO STORE RELOCATION BITS
3391         SKIPGE CONTRL   ;IN RELOCATABLE,
3392         JRST AOFSTX
3393         MOVEI A,LDOFS   ;LOADER OFFSET LOADER COMMAND TYPE
3394         PUSHJ P,PLDCM   ;PUNCH OUT LOADER COMMAND
3395         JRST AOFSTX
3396 \f
3397 ;GET ARG TO LOC, BLOCK, .=, OFFSET
3398
3399 ALOCRG:
3400 ABLKRG: MOVE A,CLOC
3401         SKIPN CRLOC
3402          JRST [ CAML A,DECBRA   ;IF ADDR BEFORE THE LOC WAS ABS,
3403                  MOVEM A,DECBRA ;UPDATE HIGHEST ABS ADDR IF NEC.
3404                 JRST ABLKR1]
3405         CAML A,DECTWO           ;IT WAS RELOCA; UPDATE HIGHEST
3406          JRST [ CAML A,DECBRH   ;ADDR OF APPROPRIATE SEG.
3407                  MOVEM A,DECBRH
3408                 JRST ABLKR1]
3409         CAML A,DECBRK
3410          MOVEM A,DECBRK
3411 AOFFS2:
3412 ABLKR1: SAVE SYM
3413         PUSHJ P,CONBAD  ;ERROR IF IN GROUPING
3414         REST SYM
3415         TRNE I,IRNOEQ\IRPSUD\IREQL
3416          ETSM [ASCIZ /Inside pseudo or =/]
3417         TDNE I,[ILWORD,,IRFLD]
3418          ETSM ERRNVL
3419         PUSHJ P,EBLK    ;MAYBE END CURRENT OUTPUT BLOCK
3420         PUSHJ P,AGETWD  ;GET ARG
3421         MOVE LINK,GLOCTP        ;GET GLOCTP FLAGS IN LINK, STAYS THERE UNTIL ALMOST DONE
3422         MOVE T,GLSP2
3423         CAME T,GLSP1
3424         TROA LINK,400   ;SIGNAL GLOBAL ARG
3425         TRZ LINK,400    ;LOCAL
3426         MOVE T,A        ;SAVE UNTRUNCATED FOR AOFFSET,
3427         HRRZS A,WRD     ;TRUNCATE FOR LOC, BLOCK, .=.
3428         TRNN I,IRDEF    ;ALL DEFINED?
3429          JRST ASSEM1
3430         SKIPGE CONTRL   ;YES, RETURN SKIPPING OVER ARG
3431          TRNN LINK,400
3432           RET
3433         MOVE SYM,GTVER
3434         ETASM [ASCIZ *Argument has externals*]
3435 \f
3436 ;;CONSTANTS AND VARIABLES
3437                 ;VARIABLES AREA
3438 VBLK
3439
3440 LCNGLO==CONMIN/4
3441 LCONTB==CONMIN
3442
3443 BLCODE [
3444 PCNTB:  BLOCK NCONS*3   ;CONSTANTS AREAS TABLE
3445 VARTAB: BLOCK NVARS
3446 ]
3447 CONTBA: CONTAB  ;ADDRESS OF BEGINNING OF CONSTANTS TABLE.
3448 CONTBE: CONTAB+LCONTB   ;ADDRESS OF WORD AFTER END OF CONSTANTS TABLE.
3449 PLIM:   0       ;POINTER TO FIRST UNUSED WORD IN CONSTANTS TABLE.
3450
3451 CONGLA: CONGLO  ;ADDRESS OF BEGINNING OF CONSTANT-GLOBALS TABLE.
3452 CONGLE: CONGLO+LCNGLO   ;ADDRESS OF WORD AFTER END OF CONSTANT GLOBALS TABLE.
3453 CONGOL: 0       ;HAS ADR OF FIRST WORD INACTIVE IN CONSTANT-GLOBALS TABLE.
3454
3455 CONBIA: CONBIT  ;ADDRESS OF BEGINNING OF CONSTANT-RELOCATION-BITS TABLE.
3456
3457 CONLEN: CONMIN  ;TOTAL SPACE ALLOCATED TO CONSTANTS TABLES.
3458                 ;ALL THE HOOKS ARE IN FOR DYNAMIC ALLOCATION OF THESE TABLES
3459                 ;(CONTAB, CONGLO, AND CONBIT). ALL THAT IS NEEDED IS TO GET
3460                 ;THE SPACE AND INITIALIZE CONTBA, CONTBE, CONGLA, CONGLE, CONBIA.
3461
3462                 ;PCNTB STUFF
3463
3464                 ;EACH ENTRY 3 WORDS; FIRST WORD SQUOZE, NAME OF AREA IF GLOBAL
3465 CSQZ:   0               ;SQUOZE COUNTER
3466                 ;SECOND WORD RH LOC OF AREA (WITH OFFSET), LH LOC FIRST AFTER AREA (WITHOUT OFFSET)
3467                 ;THIRD WORD LH FLAGS
3468
3469 CGBAL==100000   ;GLOBAL (INCLUDING OFFSET)
3470 CTRL==200000    ;RELOCATED ( " )
3471 CTDEF==400000   ;DEFINED (MUST BE SIGN)
3472
3473 PBCON:  0       ;POINTER INTO PCNTB, HAS ADR OF ENTRY FOR NEXT CONSTA
3474 PBCONL: 0       ;POINTER TO ABSOLUTE TOP OF PCNTB
3475 CONCNT: 0       ;NUMBER OF TIMES CONSTANTS CAN APPEAR (DECREMENTED BY CONSTA)
3476 CONDEP: 0       ;DEPTH IN CONSTANTS (0 TOP LEVEL)
3477 CONSAD: 0       ;ADDR IN CONSTANTS TABLE OF ENTRY FOR CURRENT CONST.
3478 CONSML: 0       ;VALUE OF .MLLIT INTSYM.
3479                 ;NEGATIVE => ERROR MODE (DEFAULT)
3480                 ;ZERO => OLD MODE.
3481                 ;POSITIVE => NEW (MULTI-LINE) MODE.
3482
3483 CONSTP: 0       ;PDL POINTER BELOW WDS FOR INNERMOST CONSTANT.
3484 CONSP1: 0
3485
3486                 ;VARIABLES FOR VARIABLES CODING
3487
3488 VARCNT: 0       ;NO OF VAR IN CURRENT VAR AREA SO FAR
3489 VARPNT: 0       ;POINTER TO CURRENT PLACE IN VARTAB
3490 VARCNR: 0       ;NO OF TIMES VARIABLES MAY APPEAR
3491 VCLOC:  0       ;TEM FOR VARIAB
3492 VECSIZ: 0       ;DEFAULT SIZE FOR .VECTOR.
3493
3494 PBLK
3495 \f
3496 ;LEFT-BRACKET ENCOUNTERED; HERE ON DISPATCH FROM GETFD
3497 ;SAVE WORLD, BYTE MODE, ASSEM1 PDL LEVELS.
3498 ;THEN SET ASSEM1 PDL LEVELS TO CURRENT LEVELS
3499 ;SO ASSEM1 WON'T FLUSH PAST LEVEL OF CONSTANT.
3500 ;SET CONSTP _ CURRENT PDL LEVEL. PCONS WILL PUT WORDS
3501 ;OF CONSTANT ABOVE CONSTP, AND SET ASSEMP ABOVE THEM.
3502
3503 LBRAK:  SKIPE LITSW
3504          ETR [ASCIZ /Literal/]
3505         TRO I,IRFLD     ;LEFT BRACKET
3506         JSP LINK,SAVWD1 ;SAVE CRUFT
3507         PUSH P,SCNDEP   ;SO THE NEXT RBRKT WON'T TRY TO CLOSE CONDIT.
3508         JSP LINK,SAVAS1
3509         MOVEIM ASMOUT,3
3510         SETZM SCNDEP    ;NOT WITHIN CONDITIONALS IN THIS LITERAL.
3511         AOS CONDEP      ;ONE DEEPER IN LITERALS.
3512         JRST ASSEM3     ;GO ASSEMBLE THE WORDS OF THE CONSTANT.
3513
3514 ;OUTPUT WORD TO CONSTANT. P MUST EQUAL ASSEMP HERE.
3515 PCONS:  SKIPL CONTRL    ;IF RELOCATABLE,
3516         PUSHJ P,$RSET   ;HANDLE STRANGE RELOCATIONS.
3517         MOVE B,GLSP1
3518         SUB B,GLSP2     ;NUM. GLOBAL ENTRIES FOR THIS WD.
3519         HLRZ A,WRDRLC   ;ONLY 1.1 AND 3.1 BITS MATTER.
3520         LSH A,1
3521         IOR A,WRDRLC    ;GET THEM INTO 1.1, 1.2 BITS.
3522         TLNE I,ILNOPT   ;REMEMBER ILNOPT ALSO.
3523         IORI A,4
3524         DPB B,[032200,,A]       ;AND # GLBLS.
3525         PUSH P,A        ;SAVE THEM ALL.
3526         HRLI B,(B)      ;GET # GLBLS,,# GLBLS .
3527         JUMPE B,PCONS1
3528         MOVE A,GLSP2
3529         MOVSI A,1(A)
3530         HRRI A,1(P)     ;SAVE THE GLBLS, IF ANY.
3531         ADD P,B
3532         JUMPGE P,CONFLP
3533         BLT A,(P)
3534 PCONS1: PUSH P,WRD
3535         MOVEM P,ASSEMP  ;ASSEMP -> ABOVE WDS FOR LIT.; CONSTP, BELOW.
3536         JRST (T)
3537 \f
3538 ;JSP LINK,SAVAS1  TO PUSH DATA ON ASSEM1 LEVEL AND CALL ASSEM1
3539 ;LOOP RECURSIVELY.
3540 .SEE CONNDP     ;WHICH IS WHERE THESE THINGS ARE POPPED.
3541 SAVAS1: SKIPN BYTM      ;IF IN BYTM NOW (WILL PUSH AND TURN OFF)
3542         JRST LBRAK1
3543         MOVSI A,BYBYT   ;SAVE ALL THE DETAILS.
3544         HRRI A,1(P)
3545         ADD P,[LBYBYT+BYTMCL,,LBYBYT+BYTMCL]
3546         JUMPGE P,CONFLP ;(SOFTWARE-DETECTED PDL-OV)
3547         BLT A,-BYTMCL(P)
3548         MOVSI A,BYTMC
3549         HRRI A,1-BYTMCL(P)
3550         BLT A,(P)
3551 LBRAK1: PUSH P,BYTM
3552         SETZM BYTM
3553         SAVE ASMOUT
3554         SAVE ASMDSP
3555         SAVE ASMI
3556         PUSH P,GLSPAS   ;SAVE ASSEM1 PDL LEVELS.
3557         PUSH P,ASSEMP
3558         PUSH P,CONSTP
3559         MOVE A,I
3560         ANDI A,IRPSUD+IREQL
3561         IORI A,IRDEF
3562         MOVEM A,ASMI    ;ASMI IOR'D INTO I AT ASSEM2 LOOP.
3563         HRRZ A,CPGN
3564         HRL A,CLNN      ;REMEMBER WHERE THIS LITERAL STARTS.
3565         INSIRP PUSH P,[A SYSYM SYLOC]
3566         MOVEM P,ASSEMP  ;SO ASSEM1 WON'T FLUSH WHAT WE PUSHED.
3567         MOVEM P,CONSTP  ;SO CONND CAN FIND 1ST WD OF CONSTANT.
3568         MOVEMM GLSPAS,GLSP1
3569 SAVAS2: MOVEI A,ASSEM3  ;IF NOT MULTI-LINE MODE, ARRANGE TO
3570         SKIPG CONSML    ;END THE CONSTANT AFTER 1 WORD.
3571          MOVEI A,ASSEMC
3572         MOVEM A,ASMDSP
3573         JRST (LINK)
3574 \f
3575 PCONST: MOVE CH1,ASMDSP ;OUTPUT TO CONST. FROM ASSEM1
3576         CAIN CH1,CONND  ;LAST WD OF CONST?
3577         CAME P,CONSTP   ;1ST WD?
3578         JRST PCONS      ;NO, DO THE GENERAL THING.
3579         SKIPL CONTRL    ;THIS MUST BE ONLY WORD OF CONST,
3580         PUSHJ P,$RSET   ;DON'T BOTHER PUSHING, END CONST. NOW.
3581         PUSH P,CONSTP
3582         TLZ I,ILMWRD+ILMWR1     ;THIS IS 1ST WD, NO MORE WDS.
3583         JRST CONND3     ;PRETEND JUST POPPED IT.
3584
3585 ;COME HERE FROM ASSEM1 TO END A CONSTANT.
3586 CONND:  SKIPE BYTM      ;IF IN BYTE MODE, LEAVE IT AND DO .WALGN
3587         JRST A.BY3      ;(WILL COME BACK SINCE ASMDSP STILL SET)
3588 CONNDW: MOVEMM CONSP1,CONSTP
3589         TLZ I,ILMWR1    ;THIS IS 1ST WORD COMING UP.
3590 CONND0: TLZ I,ILMWRD+ILNOPT
3591         SETZM WRDRLC
3592         MOVE F,CONSP1   ;ADDR IN IN PDL OF NEXT WD.
3593         CAMN F,ASSEMP
3594         JRST CONND2     ;J IF NO WORDS.
3595         MOVE A,1(F)     ;GET SAVED NUM GLBLS,,NUM GLBLS
3596         DPB A,[100,,WRDRLC]
3597         LSH A,-1        ;RESTORE WRDRLC BITS 1.1, 3.1
3598         DPB A,[220100,,WRDRLC]
3599         TRNE A,2
3600         TLO I,ILNOPT    ;RESTORE NOOPTF.
3601         LSH A,-2        ;GET # GLBLS.
3602         HRLI A,(A)      ;# GLBLS,,# GLBLS.
3603         AOBJN F,.+1
3604         HRRZM F,GLSP2   ;ADDR BEFORE 1ST GLOBAL ENTRY.
3605         ADD F,A
3606         HRRZM F,GLSP1   ;ADDR OF LAST GLOBAL ENTRY.
3607         MOVE A,1(F)
3608         MOVEM A,WRD
3609         AOBJN F,.+1     ;POINT TO NEXT CONST WD IF ANY,
3610         MOVEM F,CONSP1
3611         CAME F,ASSEMP   ;IF MORE WORDS SET ILMWRD
3612         TLO I,ILMWRD
3613         JRST CONND3
3614
3615 CONND2: INSIRP SETZM,[WRD,GLSP1,GLSP2]
3616 CONND3: MOVE F,GLSP1
3617         SUB F,GLSP2
3618         JUMPE F,SCON    ;JUMP IF NOTHING VIRTUAL
3619         MOVEI B,-1(F)
3620         MOVN TT,B
3621         JUMPE B,SCON    ;JUMP IF ONLY ONE GLOBAL
3622                 ;SORT GLOTB ENTRIES THIS CONSTANT
3623 LSORT:  HRL T,TT        ;SET UP AOBJN POINTER TO GLOBALS REMAINING
3624         HRR T,GLSP2
3625 LSORT2: MOVE A,1(T)
3626         CAMLE A,2(T)
3627         EXCH A,2(T)     ;INTERCHANGE
3628         MOVEM A,1(T)
3629         AOBJN T,LSORT2  ;INNER LOOP POINT
3630         SOJG B,LSORT    ;OUTER LOOP
3631                 ;DROPS THROUGH
3632 \f
3633                 ;DROPS THROUGH
3634 SCON:   PUSHJ P,RCHKT
3635         PUSHJ P,RMOVET  ;SET UP RELOACTION BITS.
3636         ROT T,2         ;ROTATE TO BOTTOM TWO BITS OF T
3637         TLNE I,ILMWRD+ILMWR1+ILNOPT
3638         JRST NOCON      ;MULTIPLE WORD OR OPTIMIZATION SUPPRESSED, DON'T TRY TO FIND MATCH
3639         MOVE A,CONTBA
3640 SCON1:  CAML A,PLIM     ;SEARCH CONSTANTS TABLE TO SEE IF ALREADY THERE
3641         JRST NOCON      ;END OF TABLE, NO MATCH
3642         MOVE B,WRD
3643         CAME B,(A)
3644 SCON2:  AOJA A,SCON1    ;VAL DISAGREES
3645         PUSHJ P,CPTMK   ;GET BP TO CONSTANTS-BIT TABLE IN C
3646         LDB F,C         ;GET RELOCATION BITS THIS CONSTANT
3647         CAME F,T
3648         JRST SCON2      ;RLC DIFFRS
3649         MOVE B,CONGLA   ;VALUE AND RELOCATION AGREE, NOW TO CHECK GLOBALS
3650         SKIPA C,GLSP2
3651 SCON2B: AOS B           ;SEARCH FOR GLOBAL POINTING TO CONSTANT WHICH HAS MATCHED SO FAR
3652         CAML B,CONGOL
3653         JRST SCON3      ;GLOBALS MATCH SO FAR
3654         CAME A,1(B)     ;SKIP IF ONE FOUND
3655 SCON7:  AOJA B,SCON2B   ;NOT YET
3656         MOVE D,(B)      ;FOUND ONE, GET GLOTB ENTRY
3657         CAME D,1(C)     ;COMPARE WITH THIS ENTRY IN GLOTB
3658         JRST SCON2      ;NO MATCH, FLUSH THIS CONSTANT
3659         AOJA C,SCON7    ;MATCH, TRY NEXT GLOBAL
3660
3661 SCON3:  CAME C,GLSP1    ;GLOBALS MATCH, BUT ARE WE EXACTLY AT END OF GLOTB?
3662         JRST SCON2      ;NO, BACK TO SEARCH
3663         JRST NOCON4
3664 \f
3665 NOCON:  AOS A,PLIM      ;CONSTANT NOT ALREADY IN TABLE
3666         CAMLE A,CONTBE
3667          ETF [ASCIZ/Literal table full/]
3668         MOVE AA,WRD
3669         MOVEM AA,-1(A)
3670         SOS A
3671         PUSHJ P,CPTMK
3672         TLNE I,ILNOPT
3673         TRO T,4         ;1.3 OF RELOCATION BITS => DON'T OPTIMIZE ON TOP OF ME
3674         DPB T,C
3675         MOVE B,GLSP2
3676 NOCON3: CAML B,GLSP1
3677         JRST NOCON4
3678         SKIPN C,1(B)
3679         AOJA B,NOCON3   ;THIS ENTRY NOT REALLY HERE
3680         MOVEM C,@CONGOL
3681         HRRZS C
3682         PUSHJ P,NOCON5
3683         MOVEM A,@CONGOL
3684         PUSHJ P,NOCON5
3685         SKPST C,        ;SKIP IF IN SYMBOL TABLE
3686         AOJA B,NOCON3
3687         3GET1 D,C       ;IN SYMBOL TABLE
3688         TLO D,3VCNT     ;THIS SYM USED IN CONSTANT
3689         3PUT1 D,C       ;UPDATE 3RDWRD TABLE ENTRY
3690         AOJA B,NOCON3
3691
3692 NOCON5: AOS AA,CONGOL
3693         CAML AA,CONGLE
3694          ETF [ASCIZ/Constants-global table full/]
3695         POPJ P,
3696
3697                 ;SET UP BYTE POINTER TO CONSTANTS-BIT TABLE
3698                 ;A SHOULD HAVE ADR OF CONSTANTS TABLE ENTRY
3699                 ;LEAVES ANSWER IN C
3700                 ;BITS IN CONSTANTS-BIT TABLE PER ENTRY:
3701                         ;1.2, 1.1 RELOCATION BITS
3702                         ;1.3 ILNOPT BIT => DON'T OPTIMIZE ON TOP OF ME
3703
3704 CPTMK:  PUSH P,A
3705         SUB A,CONTBA
3706         PUSH P,B
3707         IDIVI A,12.
3708         MOVEI C,(A)
3709         ADD C,CONBIA    ;SET UP ADDRESS PART
3710         IMULI B,3
3711         DPB B,[360600,,C]       ;STORE POSITION FIELD FROM REMAINDER
3712         TLO C,200       ;SET UP SIZE FIELD
3713 POPBAJ: POP P,B
3714         JRST POPAJ
3715 \f
3716 NOCON4: TLON I,ILMWR1
3717         MOVEM A,CONSAD  ;IF 1ST WD SAVE ADDR.
3718         TLNE I,ILMWRD   ;IF MORE WORDS, HANDLE NEXT.
3719         JRST CONND0
3720         MOVE P,CONSTP   ;VALUE OF CONSTP AT CONND.
3721         MOVE C,GLSPAS   ;TO RESTORE GLSP1
3722         JSP T,CONNDP    ;POP STUFF.
3723         HRRZ A,CONSAD   ;ADDR OF CONSTANTS TABLE ENTRY OF 1ST WD.
3724         MOVE B,PBCON    ;ADDR OF WDS DESCRIBING CONST. AREA.
3725         SKIPL 2(B)      ;CONST. AREA LOCATION DEFINITE?
3726         AOJA C,CONND6   ;NO, USE GLOBAL.
3727         MOVEM C,GLSP1
3728         HRRZ C,1(B)     ;ADD ACTUAL ADDR OF CONST. AREA.
3729         ADDI A,(C)      ;GET C(CONTBA) + ADDR OF CONSTANT.
3730         LDB B,[420100,,2(B)]
3731         JRST CONND7
3732
3733 CONND6: MOVEM C,GLSP1
3734         MOVEM B,(C)
3735         MOVEI B,0
3736 CONND7: SUB A,CONTBA
3737         JRST LSSTH3     ;POP OUT INTO OUTER WORD.
3738
3739 .SEE SAVAS1     ;WHICH IS WHAT PUSHES WHAT CONNDP POPS.
3740 CONNDP: SUB P,[3,,3]    ;FLUSH SAVED SYLOC AND SYSYM AND CLNN,,CPGN.
3741 CONFL2: HRL T,ASMOUT    ;REMEMBER IF POPPING A LITERAL OR NOT.
3742         INSIRP POP P,[CONSTP,ASSEMP,GLSPAS,ASMI,ASMDSP,ASMOUT,BYTM]
3743         SKIPN BYTM      ;IF IN BYTE MODE, POP DETAILS.
3744         JRST CONND5
3745         MOVSI A,1-BYTMCL(P)
3746         HRRI A,BYTMC
3747         BLT A,BYTMC+BYTMCL-1
3748         MOVSI A,1-BYTMCL-LBYBYT(P)
3749         HRRI A,BYBYT
3750         BLT A,BYBYT+LBYBYT-1
3751         SUB P,[LBYBYT+BYTMCL,,LBYBYT+BYTMCL]
3752 CONND5: HLRZ A,T
3753         CAIE A,3
3754          JRST (T)
3755         POP P,A
3756         ADDM A,SCNDEP   ;DON'T FORGET ABOUT ANY CONDITIONALS.
3757         SOS CONDEP      ;HAVE POPPED ONE CONSTANT.
3758         JRST (T)
3759
3760 CONFLS: MOVE P,ASSEMP   ;FLUSH ALL CONSTANTS.
3761         CAMN P,[-LPDL,,PDL] ;IF IN ANY,
3762          JRST (LINK)
3763         MOVE P,CONSTP   ;POINT AFTER ITS PDL ENTRY,
3764         JSP T,CONNDP    ;POP IT,
3765         JRST CONFLS     ;TRY AGAIN.
3766
3767 CONBAD: SKIPN ASMOUT    ;IF IN GROUPING, ERROR.
3768         POPJ P,
3769         ETSM [ASCIZ/Within <>, () or []/]
3770         JRST ASSEM1
3771 \f
3772 ;COME HERE FOR PDL-OV ON P.
3773 ;IF IN A CONSTANT, FLUSH ALL OF THEM, SAYING WHERE EACH STARTED.
3774 ;THEN TYPE A PDL ERROR MSG AND RETURN TO ASSEM1.
3775 ;OTHERWISE FATAL ERROR.
3776 CONFLP: MOVEI LINK,ASSEM1
3777         MOVEI CH1,ERRPDL
3778         SKIPE CONDEP
3779          JRST CONFL3    ;IN A CONSTANT.
3780         MOVEI P,PDL     ;RE-INIT PDL SO NO MORE PDL-OV.
3781         ETF ERRPDL
3782 ERRPDL: ASCIZ /PDL overflow/
3783
3784 ;JSP LINK,CONFLM TO FLUSH CONSTANTS, SAYING WHERE THEYY STARTED,
3785 ;AND GIVE ERROR MSG.
3786 CONFLM: MOVE CH1,ASMOUT
3787         SKIPA CH1,ASMOT3(CH1)
3788 CONFLZ: SETZ CH1,       ;LIKE CONFLM BUT NO ERR MSG AT END.
3789 CONFL3: SETO C,
3790 CONFL1: MOVE P,CONSTP   ;GET STACK ABOVE INNERMOST LITERAL.
3791         REST SYLOC
3792         REST SYSYM
3793         REST D          ;GET INFO ON WHERE STARTED
3794         AOSN C          ;THE 1ST TIME ONLY, SAY WHAT'S GOING ON.
3795         TYPR [ASCIZ/Within groupings: /]
3796         SKIPE C
3797         TYPR [ASCIZ/, /]
3798         MOVE A,ASMOUT   ;SAY WHAT KIND OF GROUPING IS BEING CLOSED
3799         MOVE A,ASMOT5(A)
3800         CALL TYOERR     ;BY SAYING WHAT CHAR OPENED IT.
3801         JSP T,CONFL2    ;POP REST OF WDS SAVED AT LBRAK.
3802         TYPR [ASCIZ/ at /]
3803         MOVEI A,1(D)    ;PAGE # GROUPING STARTED ON.
3804         CALL DPNT       ;PRINT IN DECIMAL.
3805         MOVEI A,"-
3806         CALL TYOERR
3807         HLRZ A,D        ;LINE NUMBER IT STARTED ON.
3808         ADDI A,1
3809         CALL D3PNT2     ;PRINT W/ AT LEAST 3 CHARS, NO ZERO SUPPR.
3810         MOVE A,ASSEMP
3811         CAME A,[-LPDL,,PDL] ;MORE GROUPINGS TO POP => DO.
3812          JRST CONFL1
3813         CALL CRRERR
3814         MOVE P,ASSEMP
3815         JUMPE CH1,(LINK) ;IF CALLED CONFLZ, NO ERR MSG (CALLER WILL GIVE ONE)
3816         ETR (CH1)       ;[   NO] OR PDL.
3817         CALL CRRERR
3818         JRST (LINK)
3819 \f
3820                 ;CONSTA
3821
3822 CNSTNT: NOVAL
3823         SKIPE ASMOUT    ;IF ANY GROUPNGS,
3824         JSP LINK,CONFLM ;FLUSH THEM, GIVE ERROR.
3825         PUSHJ P,CNSTN0
3826         JRST ASSEM1
3827
3828 CNSTN0: SOSGE CONCNT    ;ENTRY FROM AEND
3829         ETF [ASCIZ /Too many constants areas/]
3830         MOVE B,CLOC
3831         ADD B,OFLOC
3832         HRRZ T,PBCON
3833         TRNN FF,FRPSS2
3834         JRST CNST1      ;PASS 1
3835
3836         MOVSI A,CGBAL
3837         TDZ A,2(T)
3838         TRNE FF,FRGLOL
3839         TLC A,CGBAL
3840         SKIPN A
3841          ETR [ASCIZ /Constants globality phase error/]
3842         HRRZ B,1(T)
3843         SUB B,OFLOC
3844         HRRZS B
3845         CAME B,CLOC
3846          ETR [ASCIZ /Constants location phase error/]
3847         MOVE B,2(T)
3848         ROT B,2
3849         XOR B,CRLOC
3850         XOR B,OFRLOC
3851         TRNE B,1
3852          ETR [ASCIZ /Constants relocation phase error/]
3853                 ;DROPS THROUGH
3854 \f
3855                 ;DROPS THROUGH
3856 CNST2:  MOVEI D,(T)     ;STE IDX IN D FOR OUTSM0
3857         MOVE SYM,(T)    ;GET NAME OF AREA
3858         TLC SYM,400000#LCUDF    ;CLEAR LCUDF, SET HALF-KILL
3859         TRNE FF,FRGLOL
3860         PUSHJ P,PDEFPT  ;DEFINE SYM FOR BEGINNING OF CONSTANTS AREA
3861         MOVE A,CONTBA
3862 CNSTH:  CAML A,PLIM
3863          JRST CNSTA     ;THRU
3864         MOVE TT,(A)
3865         MOVEM TT,WRD
3866         PUSHJ P,CPTMK
3867         LDB F,C         ;GET THIS CONSTANT'S RELOCATION BITS
3868         TRZE F,2
3869          TLO F,1        ;RELOCATE LEFT HALF
3870         MOVEM F,WRDRLC  ;STORE RELOCATION
3871         MOVEI D,GLOTB   ;AND NOW TO SET UP GLOTB!
3872         MOVEM D,GLSP2
3873         MOVE C,CONGLA
3874 CNSTC:  CAML C,CONGOL
3875          JRST CNSTB     ;END OF CONSTANT-GLOBAL TABLE
3876         CAMN A,1(C)     ;POINTS TO THIS CONSTANT?
3877          PUSH D,(C)     ;YES, STORE ENTRY IN GLOTB
3878         AOS C
3879         AOJA C,CNSTC
3880
3881 CNSTB:  HRRZM D,GLSP1   ;MARK END OF ACTIVE PART OF GLOTB
3882         PUSH P,A
3883         PUSHJ P,PWRD    ;OUTPUT THIS CONSTANT
3884         AOS CLOC        ;INCREMENT CLOC TO NEXT
3885         HRRZS CLOC      ;MAKE SURE IT STAYS IN A HALF-WORD (IMPORTANT SINCE MAY BE LESS THAN RELOCATION)
3886         POP P,A         ;RESTORE POINTER INTO CONSTANTS TABLE
3887         AOJA A,CNSTH
3888
3889 CNST3:  HLRZ A,1(T)     ;GET POINTER TO TOP OF AREA STORED DURING PASS 1
3890         CAMN A,CLOC     ;SAME AS CURRENT?
3891         JRST CNSTE      ;YES, NO HAIR
3892         CAMGE A,CLOC    ;DIFFERENT; LOWER?
3893          ETR [ASCIZ /More constants on pass 2 than 1/]
3894                 ;INSUFFICIENT CONSTANT SPACE; CONSTANTS AREA TRYING TO BE BIGGER
3895                 ;IN PASS 2 THAN PASS 1; THE EXTRA CONSTANTS WERE BACKED OVER
3896         MOVEM A,CLOC    ;EITHER WAY, SET CLOC TO TOP OF AREA SO WON'T HAVE MDT TROUBLE
3897         PUSHJ P,EBLK    ;END CURRENT BLOCK
3898         CALL SLOCF      ;IF RELOCATABLE, MAKE SURE NEW VALUE OF $. GETS PUNCHED
3899         JRST CNSTE
3900
3901 ;CALL SLOCF WHENEVER "." IS CHANGED WITHOUT THE OUTPUTTING OF A STORAGE WORD.
3902 SLOCF:  MOVE A,CLOC     ;STORE NEW "." IN HEADER FOR NEXT BLOCK OF OUTPUT.
3903         SKIPGE TM,CONTRL
3904          TRNN TM,DECREL+FASL    ;BUT NOT IN DEC OR FASL OUTPUT FORMATS.
3905           HRRM A,BKBUF
3906         IORI FF,FRLOC   ;MAKE SURE NULL BLOCK IS OUTPUT IF NEC. TO TELL LOADER "." HAS CHANGED.
3907         RET
3908 \f
3909                 ;CONSTA DURING PASS 1
3910
3911 CNST1:  HRRM B,1(T)     ;STORE LOCATION OF AREA
3912         MOVEI D,0
3913         MOVE A,CRLOC
3914         ADD A,OFRLOC
3915         TRNE A,1
3916         TLO D,CTRL      ;RELOCATED
3917         TRNE FF,FRGLOL
3918         TLO D,CGBAL     ;GLOBAL
3919         IORM D,2(T)     ;STORE FLAGS DESCRIBING AREA
3920         JUMPL FF,CNST2  ;JUMP ON PUNCHING PASS, PUNCH OUT AREA NOW
3921         MOVE T,PLIM
3922         SUB T,CONTBA
3923         ADDM T,CLOC     ;PASS 1, JUST UPDATE CLOC
3924         HRRZS CLOC
3925
3926 CNSTA:  HRRZ T,PBCON
3927         TRNE FF,FRGLOL
3928         JRST CNSTD      ;LOCATION GLOBAL
3929         TRNN FF,FRNPSS
3930         SKIPGE 2(T)
3931         JRST CNSTDA     ;2 PASS ASSEMBLY OR AREA DEFINED
3932         TRO I,IRCONT    ;1PASS AND NOT DEFINED
3933         SETZM PARBIT
3934         PUSHJ P,P70     ;DEFINE SYM
3935         MOVE A,(T)
3936         TLC A,400000#LCUDF
3937         SKIPE CRLOC
3938         TLO A,100000    ;RELOCATE
3939         PUSHJ P,$OUTPT
3940         HRRZ A,1(T)
3941         TRZ I,IRCONT
3942         PUSHJ P,$OUTPT  ;OUTPUT VALUE, FIRST LOCATION IN AREA
3943 CNSTDA: MOVSI A,CTDEF
3944         IORM A,2(T)     ;CALL IT DEFINED
3945 CNSTD:  TRNE FF,FRPSS2
3946         JRST CNST3      ;PASS 2
3947         MOVE A,CLOC
3948         HRLM A,1(T)     ;MARK END OF AREA
3949
3950 CNSTE:  MOVE A,CONTBA
3951         MOVEM A,PLIM
3952         MOVE A,CONGLA
3953         MOVEM A,CONGOL
3954         MOVEI T,3
3955         ADDB T,PBCON
3956         CAML T,PBCONL
3957         MOVEM T,PBCONL
3958         AOS A,CSQZ
3959         MOVEM A,(T)
3960         POPJ P,
3961 \f
3962                 ;DEFINING SYM USED IN CONSTANT, DELETE REFERENCES FROM CONSTANT-GLOBAL TABLE
3963
3964 CONBUG: MOVE A,CONGLA   ;B VAL C FLAGS ST(D) SADR
3965         PUSH P,T
3966         PUSH P,C        ;SAVE FLAGS
3967 CONBG2: MOVE C,(P)      ;GET FLAGS
3968         CAML A,CONGOL   ;DONE WITH SCAN?
3969         JRST CONBG1     ;YES
3970         HRRZ F,(A)      ;NO, GET CONSTANT-GLOBAL TABLE ENTRY
3971         CAIE F,ST(D)    ;POINT TO THIS SYM?
3972         AOJA A,CONBG6
3973         PUSH P,B        ;YES, SAVE VALUE, ABOUT TO WORK WITH B
3974         MOVE T,(A)      ;GET ENTIRE CONSTANT-GLOBAL TABLE ENTRY
3975         LDB CH2,[221200,,T]     ;GET MULTIPLICATION FIELD
3976         SKIPE CH2
3977         IMUL B,CH2      ;NON-ZERO => MULTIPLY VALUE OF SYM
3978         TLNE T,MINF
3979         MOVNS B         ;NEGATE VALUE
3980         TLNE T,HFWDF
3981         HRRZS B         ;TRUNCATE TO HALFWORD
3982         TLNE T,ACF
3983         ANDI B,17       ;AC, MASK TO FOUR BITS
3984         TLNE T,SWAPF
3985         MOVSS B         ;SWAP VALUE
3986         TLNE T,ACF
3987         LSH B,5         ;AC, SHIFT FIVE
3988         ADD B,@1(A)     ;ADD ABS PART OF VALUE
3989         TLNN T,SWAPF
3990         HRRM B,@1(A)    ;NOT SWAPPED, STORE LH
3991         TLNE T,SWAPF
3992         HLLM B,@1(A)    ;SWAPPED, STORE LH
3993         TLNN T,HFWDF
3994         MOVEM B,@1(A)   ;FULL WORD, STORE VALUE
3995         LDB CH1,[420200+P,,-1]  ;GET HIGH BITS OF 3RDWRD, RELOCATION BITS
3996         TLNE T,HFWDF    ;NOW TO MAP RELOCATION BITS
3997         TRZ CH1,2
3998         TLNE T,SWAPF
3999         LSH CH1,1
4000         TRZE CH1,4
4001         TRO CH1,1
4002         PUSH P,A
4003         HRRZ A,1(A)     ;GET POINTER INTO CONSTANTS TABLE
4004         PUSHJ P,CPTMK
4005         LDB B,C         ;GET RELOCATION BITS
4006         TLNE T,MINF
4007         JRST CONBG8     ;NEGATE
4008         TRNE B,(CH1)
4009          ETA ERRCRI
4010                 ;ATTEMPTED MULTIPLE RELOCATION IN CONSTANT
4011                 ; ^ ABOVE SHOULD BE REPLACED WITH A $RSET LIKE ROUTINE
4012                 ;THAT ALSO SEARCHES CONSTANT-GLOBAL TABLE FOR $R. ALREADY THERE
4013         IOR B,CH1       ;LOOKS OK, IOR IN BITS FOR GLOBAL
4014 CONB8A: DPB B,C         ;STORE BACK NEW RELOCATION BITS FOR CONSTANT
4015         POP P,A
4016         CLEARM (A)      ;CLEAR OUT CONSTANT-GLOBAL TABLE ENTRY
4017         CLEARM 1(A)
4018         POP P,B
4019         AOS A
4020 CONBG6: AOJA A,CONBG2   ;BACK FOR NEXT CONSTANT, DON'T KNOW HOW MANY THIS SYM USED IN
4021 \f
4022 CONBG1: MOVE A,CONGLA
4023         PUSH P,B
4024         MOVE B,CONGLA
4025 CONBG7: CAML A,CONGOL
4026         JRST CONBG3
4027         SKIPN C,(A)
4028 CONBG5: AOJA A,CONBG4
4029         MOVEM C,(B)
4030         MOVE C,1(A)
4031         MOVEM C,1(B)
4032         AOS B
4033         AOJA B,CONBG5
4034
4035 CONBG4: AOJA A,CONBG7
4036 CONBG3: MOVEM B,CONGOL
4037         POP P,B
4038         POP P,C
4039         POP P,T
4040         POPJ P,
4041 CONBG8: XORI B,3
4042         TRNE B,(CH1)
4043          ETA ERRCRI
4044         ANDCB B,CH1
4045         JRST CONB8A
4046
4047 ERRCRI: ASCIZ /Multiple relocation in constant/
4048 \f
4049                 ;VARIAB
4050
4051 AVARIAB:        NOVAL
4052         SKIPE ASMOUT    ;FLUSH ANY GROUPINGS IN PROGRESS.
4053          JSP LINK,CONFLM
4054         PUSHJ P,AVARI0
4055         JRST ASSEM1
4056
4057 AVARI0: SOSG VARCNR     ;ENTRY FROM AEND
4058          ETF [ASCIZ /Too many variable areas/]
4059         MOVE D,SYMAOB   ;SET UP AOBJN POINTER TO ST
4060         MOVE T,CLOC
4061         MOVEM T,VCLOC   ;STORE AS LOCATION OF VARIABLE AREA
4062         ADD T,OFLOC
4063         MOVE C,CRLOC
4064         ADD C,OFRLOC
4065         TRNE FF,FRPSS2
4066         JRST AVAR1      ;PASS 2
4067         HRL T,VARCNT    ;SIZE OF AREA
4068         TRNE C,1
4069         TLO T,400000    ;RELOCATED
4070         MOVEM T,@VARPNT
4071         JRST AVAR2E
4072
4073 AVAR1:  HRRZ A,@VARPNT  ;VARIAB DURING PASS 2
4074         CAIE A,(T)
4075          ETR [ASCIZ /Variables location phase error/]
4076         HLRZ A,@VARPNT
4077         TRZE A,400000
4078         XORI C,1
4079         TRNE C,1
4080          ETR [ASCIZ /Variables relocation phase error/]
4081         SKIPE VARCNT
4082          ETR [ASCIZ /Variables area size phase error/]
4083
4084 AVAR2E: HLRZ T,@VARPNT
4085         TRNN T,377777
4086          JRST AVAR2C    ;IF THIS VAR AREA IS EMPTY, DON'T SCAN SYMTAB.
4087 AVAR2:  HLRZ LINK,ST(D) ;SCAN, CHECKING EACH SYM FOR WHETHER IT'S A VARIABLE
4088         CAIL LINK,DEFLVR
4089          JRST AVAR2B
4090         ADD D,WPSTE1
4091         AOBJN D,AVAR2
4092         JRST AVAR2C     ;ALL SCANNED.
4093
4094 AVAR2B: 3GET C,D        ;FOUND A VARIABLE; DECIDE WHAT TO DO WITH IT.
4095         MOVE B,ST+1(D)
4096         MOVE SYM,ST(D)
4097         TLZ SYM,740000
4098         LDB LINK,[400400,,ST(D)]
4099         CAIE LINK,UDEFLV_-14.
4100          CAIN LINK,UDEFGV_-14.
4101           JRST AVAR3            ;UNDEFINED VARIABLE
4102         CAIE LINK,DEFGVR_-14.
4103          CAIN LINK,DEFLVR_-14.
4104           JRST AVAR4            ;DEFINED VARIABLE
4105 AVAR2A: ADD D,WPSTE1
4106         AOBJN D,AVAR2   ;CHECK ENTIRE SYMTAB
4107 AVAR2C: HLRZ A,@VARPNT  ;NOW GET SIZE OF AREA
4108         TRZ A,400000    ;CLEAR OUT RELOCATION CHECK BIT
4109 IFN FASLP,[
4110         MOVE D,CONTRL
4111         TRNE D,FASL     ;IN FASL ASSEMBLY, CAN'T JUST SET LOC CTR; MUST OUTPUT 0'S.
4112          CALL ABLKF
4113 ]
4114         ADD A,VCLOC     ;ADD LOCATION OF BEGINNING OF VARIABLE AREA
4115         MOVEM A,CLOC    ;STORE AS NEW CURRENT LOCATION
4116         PUSHJ P,EBLK
4117         CALL SLOCF
4118         CLEARM VARCNT   ;INITIALIZE COUNT OF VARIABLES IN NEXT AREA
4119         AOS VARPNT      ;INCREMENT POINTER TO POINT TO NEXT AREA
4120         POPJ P,
4121 \f
4122                 ;UNDEFINED VARIABLE FOUND IN SYMTAB SCAN
4123
4124 AVAR3:  CAIN LINK,UDEFGV_-14.   ;GLOBAL?
4125         TLO SYM,40000   ;GLOBAL
4126         PUSHJ P,LKPNRO
4127         MOVSI T,DEFLVR
4128         CAIN LINK,UDEFGV_-14.
4129         MOVSI T,DEFGVR
4130         TRNE FF,FRGLOL
4131         JRST AVAR3A     ;LOCATION GLOBAL
4132         MOVEI B,-1(B)
4133         ADD B,VCLOC
4134         ADD B,OFLOC
4135         MOVE TT,CRLOC
4136         ADD TT,OFRLOC
4137         SKIPE TT
4138         TLO C,3RLR
4139         CAIE LINK,UDEFGV_-14.
4140         TLZN C,3VCNT
4141         SKIPA
4142         PUSHJ P,CONBUG
4143 AVAR4B: PUSHJ P,VSM2
4144         JUMPGE FF,AVAR2A        ;IF PUNCHING PASS, OUTPUT DEFINITION.
4145         PUSHJ P,OUTDE2
4146         JRST AVAR2A
4147
4148 AVAR4:  TLNE C,3VAS2    ;DEFINED VARIABLE FOUND DURING SYMTAB SCAN
4149         TLOE C,3VP
4150         JRST AVAR2A
4151         MOVSI T,(LINK)  ;CAUSE AVAR4B TO REDEFINE AS SAME TYPE.
4152         LSH T,14.
4153         TRNN FF,FRGLOL
4154         JRST AVAR4A
4155 AVAR3A: PUSHJ P,VSM2LV
4156         JUMPGE FF,AVAR2A
4157         PUSHJ P,PDEFPT
4158         MOVEI A,0
4159         PUSHJ P,PBITS
4160         PUSHJ P,$OUTPT
4161         AOS CLOC
4162         JRST AVAR2A
4163
4164 AVAR4A: CAIN LINK,DEFGVR_-14.   ;DEF VAR, 3VAS2, POINT NOT GLOBAL.
4165         JRST AVAR4B     ;VAR GLOBAL, MUST PUNCH DEF SINCE DIDN'T ON PASS1.
4166         3PUT C,D        ;LOCAL, JUST SET 3VP SO DON'T SEE IT NEXT VARIAB.
4167         JRST AVAR2A     ;NO NEED TO PUNCH DEF SINCE WAS DEF ON PASS1.
4168 \f
4169 ;;MAIN          ;"MAIN" MIDAS ROUTINES: INIT, PS1, PLOD, PS2, PSYMS
4170                 ;ALL CALLED WITH JSP A,; ALL GLOBAL
4171                 ;RETURN INSTRUCTION FROM JSP IN LOCATION RETURN
4172 PS1:    HRRM A,RETURN   ;PASS 1, (PASS 1 INITIALIZATION ALREADY DONE), SAVE RETURN
4173         SAVE [ASSEM1-1] ;SIMBLK WILL POPJ1.
4174 IFN A1PSW,[SKIPL PRGC
4175         JRST A1PAS1     ;THIS NOT FIRST PROGRAM THIS ASSEMBLY, SET MODE TO 1PASS
4176 ]
4177         TRO FF,FRNPSS
4178 IFN ITSSW,JRST SIMBLK   ;SELECT SBLK AND ASSEMBLE
4179 IFN DECSW\TNXSW,JRST A.DECRE    ;SELECT .DECREL AND ASSEMBLE.
4180
4181 PS2:    HRRM A,RETURN   ;PASS 2 (MAIN ROUTINE, PASS 2 INITIALIZATION NOT ALREADY DONE), SAVE RETURN
4182         JUMPL FF,PA2A   ;JUMP IF PASS 1 ENDED IN 1PASS MODE
4183         TDO FF,[FLPPSS,,FRPSS2] ;SET PUNCHING PASS AND PASS 2 FLAGS
4184         PUSHJ P,P2INI   ;INITIALIZE
4185         JRST ASSEM1     ;START ASSEMBLING
4186
4187 PA2A:   MOVE A,SYMAOB   ;PASS 2 OF 1PASS ASSEMBLY, CHECK FOR UNDEFINED LOCALS
4188 PA2C:   MOVE SYM,ST(A)  ;GET SQUOZE THIS SYMTAB ENTRY
4189         LDB B,[400400,,SYM]     ;GET FLAGS
4190         CAIE B,LCUDF_-14.       ;LOCAL UNDEFINED?
4191         JRST PA2B       ;NOT LOCAL UNDEFINED, DON'T COMPLAIN
4192         3GET C,A        ;LOCAL UNDEFINED, GET 3RDWRD ST ENTRY
4193         TLZ SYM,740000  ;CLEAR OUT FLAGS IN SYM IN ANTICIPATION OF TYPING OUT COMPLAINT
4194         TLNN C,3LLV     ;PROBLEM HANDED TO LINKING LOADER?
4195          ETSM [ASCIZ /Undefined/] ;NO
4196 PA2B:   ADD A,WPSTE1    ;NOW GO FOR NEXT ST ENTRY
4197         AOBJN A,PA2C
4198         JRST RETURN
4199
4200 $INIT:  HRRM A,RETURN   ;INITIALIZATION (BEFORE PASS 1 ONLY) ROUTINE, SAVE RETURN POINT
4201 IFN CREFSW,PUSHJ P,CRFOFF       ;DON'T CREF ON 1ST PASS.
4202 IFN LISTSW,CALL LSTOFF  ;DON'T LIST ON 1ST PASS.
4203         SKIPGE ISYMF
4204         JRST INIT1      ;SPREAD SYMS (RETURNS TO SP4)
4205         MOVE A,SYMAOB   ;ALREADY SPREAD, JUST FLUSH ALL BUT INITIAL SYMS
4206 INIT4:  SKIPN B,ST(A)
4207         JRST INIT2
4208         3GET C,A
4209         TRNE C,-1       ;INITIAL SYM?
4210         CLEARM ST(A)    ;NO
4211 INIT2:  ADD A,WPSTE1
4212         AOBJN A,INIT4
4213         SETZM BBKCOD
4214         MOVE A,[BBKCOD,,BBKCOD+1]
4215         BLT A,EBKCOD    ;CLEAR OUT BLANK CODE
4216
4217 SP4:    PUSH P,CRETN
4218 P1INI:  CLEARB I, LDCCC
4219         INSIRP SETZM,BKBUF ISYMF A.PASS
4220 IFN FASLP,[
4221         INSIRP SETZM,FASATP FASPCH
4222         CLEARM FASIDX
4223 ]
4224         MOVEMM DECTWO,[[MOVE]]
4225         TDZ FF,[-1-FLVOT-FLPTPF-FLTTY,,-1]      ;INITIALIZE MOST FF FLAGS
4226         MOVEIM A.PPASS,2        ;DEFAULT IS 2-PASS.
4227         PUSHJ P,MACINI  ;INITIALIZE MACRO STATUS
4228         MOVEI A,PCNTB
4229         MOVEM A,PBCONL
4230         MOVS A,[BKTAB,,P1INI1]
4231         BLT A,BKTAB+4
4232         MOVEIM BKTABP,BKWPB*2
4233 \f;DROPS IN.
4234 P2INI:  INSIRP SETZM,[CPGN,CLNN,GENSM,OFLOC,OFRLOC,CRLOC,BKPDL
4235 SYLOC,SYSYM,BYTW,BYTRLC,STGSW,DECBRK,DEFNPS,BYTM,BYTM1,HKALL,QMTCH]
4236         AOS B,A.PASS
4237 IFN ITSSW,[
4238         CALL SETWH2             ;SET UP .WHO2, PREPARE .WHO3 IN A WITH PAGENUM=1.
4239         .SUSET [.SWHO3,,A]      ;'P1 ',,PAGENUM OR 'P2 ',,PAGENUM
4240         .SUSET [.SWHO1,,[.BYTE 8 ? 166 ? 0 ? 165 ? 0]]
4241 ]
4242         TDZ FF,[FLUNRD,,FRGLOL]
4243 IRP X,,[BKWPB,BKCUR,,BKPDL+1,1,BKLVL,IRDEF,ASMI
4244 NCONS,CONCNT,VARTAB,VARPNT,NVARS,VARCNR,1,VECSIZ]
4245 IFE 1&.IRPCN,IFSN [X], MOVEI A,X
4246 IFN 1&.IRPCN, MOVEM A,X
4247 TERMIN
4248         MOVE A,CONTBA
4249         MOVEM A,PLIM
4250         MOVE A,CONGLA
4251         MOVEM A,CONGOL
4252         CLEARM VARCNT
4253         CLEARM PBITS2
4254         MOVE A,[440300,,PBITS1]
4255         MOVEM A,BITP
4256         MOVEI A,PBITS4
4257         HRRZM A,PBITS4
4258         CLEARB I,PBITS1
4259         MOVEI A,PCNTB
4260         MOVEM A,PBCON
4261         MOVE A,[(LCUDF)+<SQUOZE 0,$ >+1]        ;< AND > FOR COMPATIBILITY WITH OLD
4262         MOVEM A,PCNTB
4263         MOVEM A,CSQZ
4264         MOVEI A,8
4265         MOVEM A,ARADIX
4266 IFN ITSSW,[
4267         MOVEI A,100
4268         MOVEM A,CLOC
4269 ]
4270 .ELSE [ SETZM CLOC
4271         AOS CRLOC       ;CRLOC GETS 1
4272 ]
4273         SETZM GLOCTP
4274         MOVEI A,BKBUF+1
4275         MOVEM A,OPT1
4276         MOVE A,CONTRL   ;IN DEC FORMAT, OUTPUT PROGRAM NAME.
4277         TRNE A,DECREL
4278          CALL DECPGN    ;CLOBBERS A
4279 IFN FASLP,[
4280         SETOM FASBLC    ;LOSING BLOCK COUNT
4281         MOVE A,CONTRL   ;IN FASL FORMAT, OUTPUT FASL HEADER
4282         TRNE A,FASL
4283          CALL FASOIN    ;INITIALIZE FASL OUTPUT
4284 ]
4285         SETZM DECBRH
4286         TRO FF,FRSYMS+FRFIRWD
4287         MOVE A,[IFORTB,,FORTAB] ;INITIALIZE FORMAT TABLE ON EACH PASS
4288         BLT A,FRTBE
4289         MOVEIM GLSPAS,GLOTB     ;INIT. ASSEM1 PDL LEVELS TO BOTTOM.
4290         MOVEMM ASSEMP,[[-LPDL,,PDL]]
4291         MOVEIM ASMDSP,ASSEM3
4292         SETZM ASMOUT
4293         SETZM CONSTP
4294         SETZM SCNDEP    ;NOT IN CONDIT. OR CONSTANT.
4295         SETZM CONDEP
4296         HRRZM P,CONSML  ;START OUT IN MULTI-LINE MODE.
4297 IFN LISTSW,[
4298         MOVE A,[440700,,LISTBF]
4299         MOVEM A,PNTBP
4300         CLEARM LISTPF
4301         SETOM LISTBC
4302         SKIPG LISTP1    ;IF LIST ON PASS 1
4303          JUMPGE FF,CRETN        ;OR PUNCHING PASS,
4304         SKIPE LISTP     ;IF WANT LISTING,
4305          CALL LSTON     ;TURN ON OUTPUT OF LISTING.
4306 ]
4307 IFN CREFSW,[
4308         JUMPGE FF,CRETN
4309         SKIPE CREFP     ;IF C SWITCH WAS SEEN,
4310         PUSHJ P,CRFON   ;TURN ON CREFFING,
4311 ]
4312 CRETN:  POPJ P,RETURN
4313
4314 P1INI1: SQUOZE 0,.INIT ? 0 ? 3
4315         SQUOZE 0,.MAIN ? 1,,
4316 \f
4317 PLOD:   HRRM A,RETURN   ;MAIN ROUTINE TO PUNCH LOADER, CALLED BEFORE PASS 2 (PS2"), SAVE RETURN POINT
4318         PUSHJ P,PLOD1   ;PUNCH LOADER
4319         JRST RETURN     ;RETURN
4320
4321                 ;PUNCH OUT THE LOADER
4322
4323 PLOD1:  PUSHJ P,FEED1   ;LEAVE LOTS OF BLANK PAPER TAPE
4324         MOVE B,CONTRL
4325         TRNE B,ARIM10
4326         JRST PLOD2      ;RIM10 => PUNCH OUT SBLK LOADER FOR PDP10 READIN-MODE READIN
4327         TRNN B,SBLKS
4328         POPJ P,         ;NOT SBLK => DON'T PUNCH LOADER
4329 PLOD1A: MOVSI B,SLOAD-SLOADP    ;PUNCH SBLK LOADER IN RIM FORMAT
4330         MOVSI C,(DATAI PTR,)
4331 PLOAD1: MOVE A,C
4332         PUSHJ P,PPBA
4333         CAMN C,[DATAI PTR,13]
4334         HRRI C,27
4335         MOVE A,SLOAD(B)
4336         PUSHJ P,PPBA
4337         AOS C
4338         AOBJN B,PLOAD1
4339         MOVE A,[JRST 1]
4340         PUSHJ P, PPBA
4341         JRST FEED1
4342
4343 PLOD2:  MOVSI C,LDR10-ELDR10    ;PUNCH SBLK LOADER FOR PDP10 READIN
4344 PLOD3:  MOVE A,LDR10(C)
4345         PUSHJ P,PPBA
4346         AOBJN C,PLOD3
4347         JRST FEED1
4348
4349                 ;SBLK LOADER NORMALLY PUNCHED OUT IN RIM FORMAT
4350
4351 SLOAD:  CONO PTR,60     ;0 RESTART POINT (NEW BLOCK)
4352         JSP 14,30       ;1 START POINT, LOOP POINT FOR NEW BLOCK; WAIT FOR DATA WORD READY
4353         DATAI PTR,16    ;GET HEADER
4354         MOVE 15,16      ;INITIALIZE CHECKSUM
4355         JUMPGE 16,16    ;HEADER .GE. 0 => STARTING INSTRUCTION
4356         JSP 14,30       ;5 LOOP POINT FOR NEXT DATA WORD: WAIT FOR READY
4357         DATAI PTR,(16)  ;READ IN DATA WORD
4358         ROT 15,1        ;NOW UPDATE CHECKSUM
4359         ADD 15,(16)
4360         AOBJN 16,5      ;LOOP FOR ALL DATA WORDS THIS BLOCK
4361         MOVEI 14,33     ;30 TO RETURN TO 33
4362         JRST 30         ;WAIT FOR READY THEN GO TO 33
4363                 ;14 JSP AC FOR ROUTINE AT 30
4364                 ;15 CHECKSUM
4365                 ;16 AOBJN POINTER (UPDATED HEADER)
4366         CONSO PTR,10    ;30 ROUTINE TO WAIT FOR DATA WORD READY FOR DATAI
4367         JRST 30
4368         JRST (14)
4369         DATAI PTR,16    ;33 GET CHECKSUM
4370         CAMN 15,16      ;COMPARE WITH CALCULATED
4371         JUMPA 1         ;OK, GO GET NEXT BLOCK (DON'T CHANGE TO JRST OR REAL LOADERS WILL GET CONFUSED)
4372         JRST 4,         ;CHECKSUM ERROR
4373 SLOADP==.
4374 \f
4375 ;PDP10 SBLK LOADER
4376 ;FOLLOWING CODING ACTUAL WORDS TO BE OUTPUT
4377         ;BY ASSEMBLER, COMPILER, OR WHATEVER
4378 ;SHOULD BE EXECUTED BY PDP10 HARDWARE READIN FEATURE
4379 ;USES ONLY THE AC'S (BUT ALL OF THEM)
4380
4381 LDR10:
4382         -17,,0          ;BLKI POINTER FOR READ SWITCH
4383
4384 LDRC=0          ;CHECKSUM (OK, SO YOU'RE NOT ALLOWED TO LOAD
4385                 ;INTO IT DURING HARDWARE READIN, BUT WHO SAYS
4386                 ;YOUR PROGRAM CAN'T USE IT?)
4387 OFFSET -.+1             ;BEGIN LOADING INTO 1 AS PER HEADER
4388 LDRGO==.
4389         CONO PTR,60     ;START UP PTR (RESTART POINT)
4390 LDRRD==.
4391         HRRI LDRB,.+2   ;INITIALIZE INDEX
4392 LDRW==.
4393         CONSO PTR,10    ;WAIT FOR WORD TO BE AVAILABLE
4394         JRST .-1
4395         ROT LDRC,-LDRRD(LDRB)   ;BEFORE READING IN HEADER, ROTATE 2 BITS (THEN IGNORE)
4396                 ;BEFORE READING IN EACH DATA WORD, ROTATE 1 BIT (FOR UPDATING CHECKSUM)
4397                 ;BEFORE READING IN CHECKSUM, ROTATE NOT AT ALL (DON'T ROTATE CALCULATED CHECKSUM)
4398         DATAI PTR,@LDRT1-LDRRD(LDRB)    ;READ WORD INTO RIGHT PLACE
4399                 ;HEADER => READ INTO C
4400                 ;STORAGE WORD => READ INDEXED BY AOBJN POINTER IN A
4401                 ;CHECKSUM => READ INTO A FOR COMPARISON WITH C(C)
4402         XCT LDRT1-LDRRD(LDRB)   ;EXECUTE RELEVANT T1 ENTRY (MAYBE SKIPS)
4403         XCT LDRT2-LDRRD(LDRB)   ;EXECUTE RELEVANT T2 ENTRY (MAYBE JUMPS)
4404 LDRB==.
4405         SOJA .,         ;-RD(B) IS 2, 1, AND 0 FOR SUCCESSIVE ENCOUNTERS OF THIS INSTRUCTION
4406                         ;USED AS INDEX INTO TABLES, ETC.
4407
4408                 ;TABLE 1
4409                 ;INDIRECTED THROUGH FOR DATAI
4410                 ;THEN EXECUTED TO SEE WHAT TO DO WITH READ IN WORD
4411                 ;ENTRIES EXECUTED IN REVERSE ORDER
4412
4413 LDRT1==.
4414         CAME LDRC,LDRA  ;COMPARE CHECKSUM WITH CALCULATED, SKIP TO B IF THEY AGREE
4415         ADD LDRC,(LDRA) ;UPDATE CHECKSUM
4416         SKIPL LDRA,LDRC ;INITIALIZE HEADER AND SKIP UNLESS JUMP BLOCK
4417
4418                 ;TABLE 2
4419                 ;EXECUTED IF CORRESPONDING ENTRY IN TABLE 1 DIDN'T SKIP WHEN EXECUTED
4420
4421 LDRT2==.
4422         JRST 4,LDRGO    ;CHECKSUM ERROR
4423         AOBJN LDRA,LDRW ;UPDATE AOBJN POINTER AND GO BACK FOR NEXT STORAGE WORD IF NOT EXHAUSTED
4424 LDRA==.
4425         JRST LDRRD              ;WHEN INITIALLY LOADED IS JUMP BLOCK TO THIS LOADER
4426                 ;DURING LOADING USED TO HOLD HEADER (AOBJN POINTER), WHICH MAY BE LOADED JUMP BLOCK
4427
4428 OFFSET 0
4429 ELDR10==.
4430 \f
4431 ;FLAGS IN SQUOZE OF SYMS TO OUTPUT
4432
4433 ABSGLO==040000  ;SYM IS GLOBAL (IF RELOCA, SAYS THIS IS BLOCK NAME)
4434 ABSLCL==100000  ;LOCAL
4435 ABSDLI==200000  ;DELETE INPUT (DON'T RECOGNIZE IT IF TYPED IN)
4436 ABSDLO==400000  ;DELETE OUTPUT (DON'T TYPE IT OUT)
4437
4438 PSYMS:  HRRM A,RETURN   ;PUNCH OUT SYMBOL TABLE, CALLED AFTER EVERYTHING ELSE, SAVE RETURN POINT
4439         PUSH P,PSYMS    ;AT END, POPJ TO RETURN.
4440         TRNE FF,FRSYMS
4441         JRST SYMDMP     ;PUNCH SYMS IF NEC.
4442         SKIPL A,CONTRL
4443         JRST SYMDA      ;IF RELOCA, PUNCH PROGRAM NAME.
4444         TRNN A,DECREL
4445         POPJ P,
4446 PSYMSD: MOVSI A,DECEND
4447         PUSHJ P,DECBLK  ;START AN END-BLOCK.
4448         MOVE A,DECTWO   ;IN 2-SEG PROGRAMS,
4449         CAME A,[MOVE]
4450          JRST [ CAMG A,DECBRH   ;OUTPUT HISEG BREAK
4451                  MOVE A,DECBRH
4452                 MOVEM A,WRD
4453                 MOVEIM WRDRLC,1
4454                 CALL PWRD
4455                 MOVEMM WRD,DECBRK
4456                 CALL PWRD       ;FOLLOWED BY LOSEG BREAK
4457                 JRST EBLK]
4458         MOVEMM WRD,DECBRK       ;OUTPUT THE PROGRAM BREAK.
4459         MOVEIM WRDRLC,1
4460         PUSHJ P,PWRD
4461         MOVE A,DECBRA   ;OUTPUT HIGHEST ABS. ADDR
4462         CAIG A,140
4463          SETZ A,        ;IF IT'S ABOVE THE JOBDAT AREA.
4464         PUSHJ P,DECWRD
4465         JRST EBLK
4466
4467 SYMDA:  MOVEI A,LPRGN   ;NOW PUNCH PROGRAM NAME
4468         DPB A,[310700,,BKBUF]
4469         MOVE A,PRGNM
4470         TLO A,40000
4471         PUSHJ P,$OUTPT
4472         PUSHJ P,EBLK
4473         TLZ FF,FLOUT
4474         POPJ P,
4475
4476                 ;DUMP OUT THE SYMBOL TABLE
4477
4478 SYMDMP: TRZ I,IRCONT    ;OK TO END BLOCK
4479         CLEARM GLSP1
4480         CLEARM GLSP2
4481         CLEARM WRDRLC
4482         MOVE T,CONTRL
4483         MOVEI A,BKBUF+1
4484         MOVEM A,OPT1
4485         CLEARM CLOC
4486         CLEARM BKBUF
4487 IFN FASLP,[
4488         TRNE T,FASL
4489          JRST SYMDM1
4490 ]
4491         TRNE T,DECREL
4492          JRST SYMDMD
4493         JUMPL T,SSYMD   ;JUMP IF NOT RELOCATABLE
4494         MOVEI B,LDDSYM  ;LOCAL SYMS BLOCK TYPE
4495         DPB B,[310700,,BKBUF]   ;SET BLOCK TYPE
4496         MOVEM B,CDATBC
4497         MOVE B,SYMAOB   ;CAUSE SSYMD3 TO LOOK AT ENTIRE SYM TAB.
4498         JRST SSYMDR
4499
4500 SYMDMD: MOVSI A,DECSYM  ;IN DEC FMT, START SYMBOLS BLOCK.
4501         PUSHJ P,DECBLK
4502 SYMDM1: MOVE B,SYMAOB
4503         JRST SSYMDR
4504 \f
4505 ;AC ALLOCATIONS DURING PHASE 1 (COMPACTING THE SYMBOL TABLE):
4506         ;AA INITIALLY HAS -SMK,,; INPUT INDEX INTO ST
4507         ;A TEMP
4508         ;B SQUOZE
4509         ;D OUTPUT INDEX INTO SYMTAB
4510         ;CH1 VALUE OF SYM
4511         ;CH2 3RDWRD
4512 SSYMD:  MOVEI D,ST-1
4513         SETZB C,SMSRTF  ;SYMS SORTED => INITIAL SYMS CLOBBERED
4514         MOVE AA,SYMAOB
4515 SSYMD1: SKIPE B,ST(AA)  ;GET SYM NAME FROM TABLE
4516         TDNN B,[37777,,-1]      ;MAKE SURE NOT EXPUNGED
4517         JRST SSYMDL     ;NOT (REALLY) THERE, TRY NEXT
4518         MOVE CH1,ST+1(AA)       ;GET VALUE OF SYM
4519         3GET CH2,AA     ;GET 3RDWRD
4520         TRNE CH2,-1
4521         TLNE CH2,3KILL+3LLV
4522         JRST SSYMDL     ;DON'T PUNCH INITIAL OR KILLED SYMS.
4523         MOVEI A,0       ;INITIALIZE FOR SHIFTING IN FLAGS
4524         LSHC A,4        ;SHIFT FLAGS INTO A
4525         XCT SSYMDT(A)   ;DO THE APPROPRIATE THING THIS KIND OF SYMTAB ENTRY
4526         JRST SSYMDL
4527 SSYMD2: LSH B,-4        ;SHIFT SQUOZE BACK TO WHERE IT BELONGS
4528         TLO B,ABSLCL    ;SET LOCAL BIT
4529         TLNE CH2,3SKILL
4530         TLO B,ABSDLO    ;HALF-KILL SYM
4531         PUSH D,B        ;STORE NAME OF SYM IN OUTPUT SLOT
4532         PUSH D,CH1      ;STORE VALUE
4533         PUSH D,CH2      ;STORE 3RDWRD
4534 SSYMDL: ADD AA,WPSTE1
4535         AOBJN AA,SSYMD1 ;LOOP FOR ALL SYMS IN TABLE
4536         MOVSI CH2,4^5   ;1ST BIT TO SORT ON IS TOPO BIT,
4537         MOVEI A,ST      ;SORT FROM BOTTOM OOF SYMTAB
4538         MOVEI B,1(D)    ;TO WHERE WE FILLED UP TO.
4539         MOVE CH1,[TDNE CH2,1(A)] ;SORT ON 2ND WD, WDS WITH BIT ON COME FIRST.
4540         MOVE C,[TDNN CH2,1(B)]
4541         JSP AA,SSYMD9
4542         TLC C,(TDNE#TDNN)       ;ON BITS AFTER 1ST, ENTRIES WITH BIT OFF COME FIRST.
4543         TLC CH1,(TDNE#TDNN)
4544         MOVEI AA,SSRTX  ;NEED ONLY CHANGE C, CH1 THE FIRST TIME.
4545         JRST SSRTX
4546
4547 SSYMD9: PUSHJ P,SSRTX   ;SORT SYMS ARITHMETICALLY BY VALUE.
4548         MOVNI B,(B)
4549         ADDI B,ST       ;SIZE OF AREA OF SYMTAB STILL IN USE.
4550         IDIV B,WPSTE
4551         HRLZI B,(B)
4552         MOVE C,BKTABP
4553         IDIVI C,BKWPB   ;# BLOCKS (INCL. .INIT BLOCK).
4554         CAIN C,2
4555          MOVEI C,1      ;IF ONLY .INIT AND .MAIN, FILE WILL HAVE ONLY GLOBAL.
4556         MOVSI A,(C)
4557         SUBM B,A        ;-<# ENTRIES IN SYMTAB IN FILE>,,
4558         LSH A,1         ;-<# WDS IN SYMTAB IN FILE>,,
4559         MOVEM A,SCKSUM  ;SAVE THIS.
4560         PUSHJ P,PPB
4561         PUSHJ P,BKCNT   ;PUT -<# SYMS IN BLOCK> IN 3RD WD OF EACH BKTAB ENTRY.
4562
4563 ;DROPS THROUGH.
4564 \f
4565 ;DROPS IN IF ABS, JUMPS HERE IF RELOC.
4566 ;NOTE THAT IN ABS ASSEMBLY, B WILL CONTAIN THE CHECKSUM AND
4567 ;SHOULD NOT BE CLOBBERED.
4568 SSYMDR: PUSH P,B        ;-<# SYMS>,,0  ;IT WILL BE -1(P)
4569         PUSHJ P,BKSRT   ;SORT BLOCKS INTO BKTAB1
4570         MOVE B,SCKSUM   ;GET CHKSUM AFTER 1SS WD. (PPBCK WILL UPDATE)
4571         SETOM 1(D)      ;PUT A -1 AT END OF BKTAB1.
4572         PUSH P,[-1]     ;(P) WILL BE BKTAB1 IDX OF NEXT BLOCK TO OUTPUT.
4573 SSYMD3: AOS F,(P)       ;F HAS BKTAB1 IDX OF BLOCK.
4574         SKIPGE C,BKTAB1(F)      ;BKTAB1 ELT HAS BKTAB IDX OR
4575         JRST SSYMDX     ; -1 AFTER LAST BLOCK.
4576         SKIPL LINK,CONTRL
4577          JRST SSYMD7    ;DIFFERENT RTN TO OUTPUT BLOCK NAME IF RELOCA.
4578         TRNE LINK,DECREL+FASL
4579          JRST SSYMD6    ;NO BLOCKS IN DEC FMT. (OR FASL EITHER)
4580         SKIPGE BKTAB1+1
4581          JRST SSYMG1    ;ONLY 1 BLOCK, PUT ALL IN GLOBAL.
4582         MOVE A,BKTAB(C)
4583         PUSHJ P,PPBCK
4584         HLRZ A,BKTAB+1(C)
4585         HRL A,BKTAB+2(C)        ;PUT IN -2*<NUM SYMS>
4586         ADD A,[-2,,1]
4587 SSYMG2: PUSHJ P,PPBCK   ;FOLLOWED BY LEVEL.
4588         JRST SSYMD6
4589
4590 SSYMG1: MOVE A,[SQUOZE 0,GLOBAL]
4591         PUSHJ P,PPBCK
4592         HRLZ A,BKTAB+BKWPB+2
4593         ADD A,[-2,,]
4594         JRST SSYMG2
4595
4596 SSYMD7: MOVE A,BKTAB(C) ;OUTPUT BLOCK NAME IN RELOCATABLE.
4597         TLO A,ABSGLO    ;TELL STINK IT'S BLOCK NAME.
4598         PUSHJ P,$OUTPT
4599         HLRZ A,BKTAB+1(C)
4600         SUBI A,1
4601         PUSHJ P,$OUTPT
4602 SSYMD6: SKIPL C,-1(P)   ;AOBJN PTR TO SYMS.
4603          JRST SSYMD3     ;IN CASE NO SYMS.
4604 SSYMD4: HRRZ A,ST+2(C)  ;OUPUT ONLY THE SYMS IN THE BLOCK
4605         CAME A,BKTAB1(F)        ;NOW BEING HANDLED.
4606         JRST SSYMD5
4607         SKIPGE LINK,CONTRL
4608         TRNE LINK,DECREL+FASL
4609         JRST SYMD2      ;SPECIAL IF RELOCA.
4610         MOVE A,ST(C)
4611         PUSHJ P,PPBCK   ;1ST, SQUOZE WITH FLAGS.
4612         MOVE A,ST+1(C)
4613         PUSHJ P,PPBCK   ;2ND, VALUE.
4614 SSYMD5: ADD C,WPSTE1
4615         AOBJN C,SSYMD4  ;HANDLE NEXT SYM.
4616         JRST SSYMD3     ;ALL SYMS FORR THIS BLOCK DONE, DO NEXT BLOCK.
4617 \f
4618 ;PUNCH OUT LOCAL SYM (RELOCATABLE ASSEMBLY)
4619 ;NORMALLY OUTPUT SQUOZE W/ FLAGS  ?  VALUE,
4620 ;IF 3LLV SET OUTPUT  PHONY NAME (= STE ADDR) ? SQUOZE W/ FLAGS, STINK FIXES IT UP.
4621 SYMD2:  LDB A,[400400,,ST(C)]
4622         MOVE CH1,ST+1(C)        ;SSYMDT MAY CHANGE CH1.
4623         MOVE CH2,ST+2(C)
4624         XCT SSYMDT(A)   ;SKIPS IF SHOULD OUTPUT SYM.
4625         JRST SSYMD5
4626         TLNE CH2,3KILL
4627         JRST SSYMD5
4628         MOVE B,ST(C)
4629         TLZ B,740000
4630         JUMPE B,SSYMD5  ;UNUSED ENTRY.
4631         JUMPL LINK,SYMDEC       ;J IF DEC OR FASL FMT
4632         TLNE CH2,3RLL
4633         TLO B,200000    ;RELOCATE LEFT HALF
4634         TLNE CH2,3RLR
4635         TLO B,100000    ;RELOCATE RIGHT HALF
4636         TLNE CH2,3SKILL
4637         TLO B,400000    ;HALF-KILL
4638         MOVEI A,ST(C)
4639         TLNE CH2,3LLV   ;IF STINK HAS VALUE,
4640         PUSHJ P,$OUTPT  ;GIVE STINK NAME STINK KNOWS SYMBOL BY.
4641         TLNE CH2,3LLV   ;IF GIVING PHONY NAME, INSURE LOCAL FLAG SET
4642          TLO B,ABSLCL   ;(STINK WILL DO SO OTHERWISE)
4643         MOVE A,B
4644         PUSHJ P,$OUTPT  ;OUTPUT SYM
4645         MOVE A,CH1
4646         TLNN CH2,3LLV   ;DON'T OUTPUT VALUE IF DON'T KNOW IT.
4647         PUSHJ P,$OUTPT  ;OUTPUT VALUE
4648         JRST SSYMD5
4649
4650 SYMDEC: IFN FASLP,[
4651         TRNE LINK,FASL
4652         JRST SYMFSL     ;FASL ASSMBLY
4653 ]
4654         PUSHJ P,ASQOZR  ;RIGHT-JUSTIFY THE SQUOZE,
4655         TLNE CH2,3SKILL
4656         TLO B,ABSDLO    ;MAYBE HALFKILL,
4657         TLO B,ABSGLO
4658         LDB A,[400400,,ST(C)]
4659         CAIGE A,DEFGVR_-14.
4660          TLC B,ABSGLO+ABSLCL ;LOCAL SYM, CHANGE GLO TO LCL.
4661         MOVEM B,WRD
4662         PUSH P,C
4663         PUSHJ P,DECPW   ;FIRST, THE NAME,
4664         POP P,C
4665         LDB TM,[420200,,ST+2(C)]
4666         MOVE A,ST+1(C)  ;THEN THE VALUE AND RELOCATION BITS.
4667         PUSHJ P,DECWR1
4668         JRST SSYMD5
4669
4670 IFN FASLP,[
4671 SYMFSL: TLO B,400000    ;GET VALUE FROM SECOND WD
4672         TLNE CH2,3RLL
4673         TLO B,200000    ;RELOCATE LH
4674         TLNE CH2,3RLR
4675         TLO B,100000
4676         CAIL A,LGBLCB_<-18.+4>
4677         TLO B,40000     ;GLOBAL FLAG
4678         MOVE A,B
4679         MOVEI B,15      ;PUTDDTSYM
4680         PUSHJ P,FASO
4681         MOVE A,CH1
4682         PUSHJ P,FASO1
4683         JRST SSYMD5
4684 ]
4685 \f
4686 ;XCT INDEXED ON SQUOZE FLAGS; SHOULDN'T PUNCH SYM IF DOESN'T SKIP.
4687 SSYMDT: JFCL            ;COM
4688         JFCL            ;PSEUDO OR MACRO
4689         CAIA            ;SYM, PUNCH OUT
4690         TLNN CH2,3LLV   ;LOCAL UNDEFINED, OUTPUT IF STINK HAS VALUE TO TELL STINK WHERE TO PUT IT.
4691         TLZA CH1,-1     ;DEFINED LOCAL VARIABLE, CLEAR OUT LH(VALUE)
4692         JFCL            ;UNDEFINED LOCAL VARIABLE
4693         SKIPL CONTRL    ;DEFINED GLOBAL VARIABLE, PUNCH OUT IF ABS.
4694         JFCL            ;UNDEFINED GLOBAL VARIABLE
4695         SKIPL CONTRL    ;GLOBAL ENTRY, PUNCH OUT IF ABS ASSEM.
4696         JFCL            ;GLOBAL EXIT, DON'T PUNCH OUT
4697 IFN .-SSYMDT-NCDBTS,.ERR SSYMDT LOSES.
4698
4699 SSYMDX: SKIPGE LINK,CONTRL
4700         TRNE LINK,DECREL+FASL
4701          JRST SSYMG3
4702         SKIPGE BKTAB1+1 ;IF ABS ANND BLOCK STR,
4703          JRST SSYMG4
4704         MOVE A,[SQUOZE 0,GLOBAL]
4705         PUSHJ P,PPBCK   ;PUT A GLOBAL BLOCK WITH NO SYMS AT END.
4706         MOVSI A,-2
4707         PUSHJ P,PPBCK
4708 SSYMG4: MOVE A,B        ;ABS ASSEMBLY, OUTPUT CHKSUM.
4709         PUSHJ P,PPB
4710 SSYMG3: SUB P,[2,,2]
4711         PUSHJ P,EBLK    ;END CURRENT OUTPUT BLOCK
4712         SKIPL A,CONTRL  ;RELOCATABLE => OUTPUT PROG NAME.
4713         JRST SYMDA
4714 IFN FASLP,[
4715         TRNE A,FASL
4716         POPJ P,
4717 ]
4718         TRNE A,DECREL   ;DEC FMT => OUTPUT END BLOCK.
4719          JRST PSYMSD
4720         MOVE A,STARTA   ;NOW GET STARTING INSTRUCTION
4721         JRST PPB        ;PUNCH IT OUT AND RETURN
4722
4723 ;PUT INTO BKTAB1 THE BKTAB IDXS OF ALL THE BLOCKS IN THE ORDER THEIR
4724 ;SYMS SHOULD BE PUNCHED (A BLOCK'S SUBBLOCKS PRECEDE IT)
4725 BKSRT:  MOVEI D,BKTAB1-1        ;D IS FOR PUSHING INTO BKTAB1.
4726         MOVSI A,1       ;START WITH BLOCK 0 (OUTERMOST, .INIT).
4727 BKSR1:  SETZ C, ;HANDLE BLOCK IN A: LOOK FOR ITS SUBBLOCKS.
4728 BKSR2:  CAME A,BKTAB+1(C)
4729         JRST BKSR3      ;THIS BLOCK ISN'T A SUBBLOCK.
4730         ADD A,[1,,]     ;LH HAS SUBBLOCK'S LEVEL.
4731         HRRI A,(C)      ;RH HAS SUBBLOCK.
4732         PUSHJ P,BKSR1   ;HANDLE THE SUBBLOCK
4733         MOVE A,BKTAB+1(C)
4734 BKSR3:  ADDI C,BKWPB
4735         CAMGE C,BKTABP
4736         JRST BKSR2
4737         MOVEI C,(A)
4738         JUMPE C,CPOPJ   ;DON'T PUT .INIT BLOCK IN BKTAB1.
4739         PUSH D,C        ;PUT THE BLOCK IN BKTAB1 (AFTER SUBBLOCKS)
4740         POPJ P,
4741
4742 PPBCK:  ROT B,1 ;OUTPUT WD IN A, UPDATING CKSUM IN B.
4743         ADD B,A
4744         JRST PPB
4745 \f
4746 BKCNT:  PUSH P,B
4747         MOVEI C,0
4748 BKCNT0: SETZM BKTAB+2(C)        ;ZERO 3RD WD OF EACH BKTAB ENTRY.
4749         ADDI C,BKWPB
4750         CAMGE C,BKTABP
4751          JRST BKCNT0
4752 BKCNT1: MOVE C,ST+2(B)
4753         SOS BKTAB+2(C)  ;ADD -2 FOR EACH SYM IN THE BLOCK.
4754         SOS BKTAB+2(C)
4755         ADD B,WPSTE1
4756         AOBJN B,BKCNT1
4757 POPBJ:  POP P,B
4758         POPJ P,
4759
4760 SSRTX:  HRLM B,(P)      ;DO ONE PASS OF RADIX-EXCHANGE. SAVE END.
4761         CAIL A,@WPSTEB  ;ONLY 1 ENTRY, NOTHING TO DO.
4762          JRST SSRTX7
4763         PUSH P,A        ;SAVE START.
4764 SSRTX3: XCT CH1
4765          JRST SSRTX4    ;MOVE UP TO 1ST WITH BIT ON.
4766         SUB B,WPSTE
4767         XCT C           ;MOVE DOWN TO LAST WITH BIT OFF.
4768          JRST SSRTX5
4769         MOVE D,WPSTE
4770         CAIE D,MAXWPS
4771          JRST .+4
4772 REPEAT MAXWPS,[
4773         MOVE D,.RPCNT(A)        ;EXCHANGE THEM,
4774         EXCH D,.RPCNT(B)
4775         MOVEM D,.RPCNT(A)]
4776 SSRTX4: ADD A,WPSTE
4777 SSRTX5: CAME A,B        ;ALL DONE => DO NEXT BIT.
4778          JRST SSRTX3    ;MORE IN THIS PASS.
4779         ROT CH2,-1      ;NEXT BIT DOWN.
4780         POP P,A         ;A -> START, B -> END OF 1ST HALF.
4781         JUMPL CH2,SSRTX6        ;ALL BITS IN WD DONE, STOP.
4782         PUSHJ P,(AA)    ;DO NEXT BIT ON 1ST HALF.
4783         HLRZ B,(P)      ;A -> END OF 1ST HALF, B -> END OF ALL.
4784         PUSHJ P,(AA)    ;DO SECOND HALF.
4785 SSRTX6: ROT CH2,1       ;LEAVE CH2 AS FOUND IT.
4786 SSRTX7: HLRZ A,(P)      ;LEAVE A -> END OF AREA SORTED.
4787         POPJ P,
4788 \f
4789                 ;ARITHMETIC CONDITIONALS (B HAS JUMP<COND> A,)
4790
4791 COND:   PUSH P,B        ;SAVE CONDITIONAL JUMP
4792         PUSHJ P,AGETFD  ;GET FIELD TO TEST VALUE OF
4793 CONDPP: POP P,T         ;RESTORE CONDITIONAL JUMP INSTRUCTION
4794         HRRI T,COND2    ;HRRI IN JUMP ADDRESS, GO TO COND2 IF CONDITIONAL TRUE
4795         XCT T           ;JUMP IF COND T,ASSEMBLE STRING
4796 COND4:  SETZM A.SUCC    ;MOST RECENT CONDIT. FAILED.
4797 COND5:  JSP TM,ERMARK   ;ERROR MSGS SHOULD SAY WHAT PSEUDO WE'RE IN.
4798         CALL RCH
4799         JSP D,RARL4     ;INIT FOR THE CONDITIONALIZED STUFF.
4800          CAIA
4801         CALL RARFLS     ;READ AND IGNORE THE ARG.
4802         JRST MACCR
4803
4804 ANULL:  TLO FF,FLUNRD
4805         JRST COND5
4806
4807 ;.ELSE, .ALSO - B'S LH WILL HAVE SKIPE OR SKIPN.
4808 A.ELSE: HRRI B,A.SUCC
4809         XCT B
4810          JRST COND4     ;CONDITION FALSE.
4811         JRST COND2      ;TRUE.
4812
4813 ;IF1, IF2 - B'S LH WILL HAVE TRNE FF, OR TRNN FF,
4814 COND1:  HRRI B,FRPSS2
4815         XCT B
4816         JRST COND4      ;NO
4817                 ;CONDITION TRUE, ASSEMBLE STRING
4818 COND2:  SETOM A.SUCC    ;LAST CONDITIONAL SUCCEEDED.
4819 COND6:  PUSHJ P,RCH     ;GET NEXT CHAR
4820         CAIE A,LBRKT
4821          JRST [ CAIE A,LBRACE
4822                  TLO FF,FLUNRD
4823                 JRST MACCR]
4824         SKIPN SCNDEP    ;BRACKET TYPE CONDITIONAL.
4825         SKIPE CONDEP
4826         JRST COND7
4827         MOVEMM CONDLN,CLNN      ;AT TOP LEVEL, SAVE IN CASE THIS UNTERMINATED
4828         MOVEMM CONDPN,CPGN
4829 IFN TS, MOVEMM CONDFI,INFFN1
4830 COND7:  AOS SCNDEP      ;COUNT IT FOR RBRAK'S SAKE.
4831         JRST MACCR
4832 \f
4833                 ;IFB, IFNB
4834
4835 SBCND:  PUSH P,B        ;SAVE TEST JUMP
4836         SETZB B,C       ;C COUNTS SQUOZE CHARS FOR IFB/IFNB
4837                         ;B COUNTS NONSQUOZE FOR IFSQ/IFNSQ
4838         JSP D,RARG      ;INIT FOR READING OF ARG WHOSE BLANKNESS
4839          JRST CONDPP    ;IS TO BE TESTED.
4840         JSP D,RARGCH(T) ;READ 1 CHAR,
4841          JRST CONDPP    ;(NO MORE CHARS)
4842         HLRZ A,GDTAB(A) ;GET GDTAB ENTRY
4843         CAIE A,(POPJ P,)        ;POPJ => NOT SQUOZE
4844          AOJA C,RARGCH(T)
4845         AOJA B,RARGCH(T)
4846
4847                 ;IFDEF, IFNDEF
4848
4849 DEFCND: SAVE SYM
4850         PUSH P,B        ;SAVE CONDITIONAL JUMP
4851         PUSHJ P,GETSLD  ;GET NAME
4852          CALL NONAME
4853         PUSHJ P,ES
4854          MOVEI A,0      ;UNDEFINED
4855 IFN CREFSW,XCT CRFINU
4856         CAIN A,GLOEXT_-14.      ;GLOBAL EXIT...
4857          SKIPL CONTRL   ;DURING ABSOLUTE ASSEMBLY?
4858           CAIN A,3      ;NO, LOCAL UNDEF?
4859            MOVEI A,0    ;ONE OF THESE => UNDEF
4860         REST SYM
4861         EXCH SYM,(P)    ;POP SYM OUT FROM UNDER THE CONDITIONAL JUMP.
4862         JRST CONDPP
4863 \f
4864 ;;PWRD          ;ROUTINES TO OUTPUT ASSEMBLES WORDS AND PORTIONS THEREOF
4865
4866                 ;HERE FROM PBITS TO OUTPUT WORD OF CODE BITS
4867
4868 PBITS3: PUSH P,A
4869         MOVEI A,14
4870         MOVEM A,PBITS2  ;INITIALIZE PBITS2 FOR COUNTING DOWN THROUGH NEXT SET OF CODE BITS
4871         MOVE A,[440300,,PBITS1]
4872         MOVEM A,BITP    ;SET UP BITP FOR RELOADING PBITS1 WITH CODE BITS
4873         MOVE A,PBITS1   ;NOW GET ACCUMULATED WORD OF BITS
4874         MOVEM A,@PBITS4 ;STORE IN BKBUF
4875         AOS A,OPT1      ;RESERVE SPACE FOR NEW WORD
4876                 ;IF FRBIT7 SET (LAST CALL TO PBITS HAD 7) THEN NEXT WORD OF CODE BITS GOES
4877                 ;AFTER NEXT WORD OUTPUT (REALLY!), OTHERWISE BEFORE
4878         TRNN FF,FRBIT7
4879         SOSA A
4880         TRO FF,FRINVT
4881         HRRZM A,PBITS4
4882         POP P,A
4883         CLEARM PBITS1
4884                         ;DROPS THROUGH
4885                 ;OUTPUT RELOCATION CODE BITS IN A
4886
4887 PBITS:  SKIPGE CONTRL
4888         POPJ P,         ;NOT RELOCATABLE
4889         SOSGE PBITS2
4890         JRST PBITS3     ;NO MORE ROOM IN WORD, OUTPUT IT AND TRY AGAIN
4891         CAIN A,7
4892         TROA FF,FRBIT7
4893         TRZ FF,FRBIT7
4894         IDPB A,BITP
4895         POPJ P,
4896
4897                 ;FOLLOWING ROUTINES SAVE AC'S EXCEPT FOR A
4898
4899 OUTSM0: MOVE A,SYM      ;OUTPUT NAME STINK KNOWS SYMBOL BY.
4900         TLZ A,37777     ;FOR LOCALS, THAT'S THE STE ADDR,
4901         HRRI A,ST(D)
4902         TLNN SYM,40000  ;FOR GLOBALS, THAT'S THE SQUOZE.
4903          JRST $OUTPT
4904 OUTSM:  SKIPA A,SYM
4905 OUTWD:  MOVE A,WRD
4906 $OUTPT: SKIPGE CONTRL   ;DIRECTLY PUNCH OUT WORD IN A IN RELOCATABLE ASSEMBLY ONLY
4907         POPJ P,         ;DO NOTHING IF ABSOLUTE ASSEMBLY
4908         PUSH P,AA
4909         MOVE AA,OPT1
4910         TRZN FF,FRINVT  ;SKIP IF BEING HACKED FROM PBITS3, PUT WORD BEFORE WHERE IT NORMALLY BELONGS
4911         AOS AA
4912         MOVEM A,-1(AA)
4913         MOVE A,CLOC
4914         TRZE FF,FRFIRWD
4915         HRRM A,BKBUF
4916         POP P,AA
4917         AOS A,OPT1
4918         CAIL A,BSIZE+BKBUF
4919         TRNE I,IRCONT
4920         POPJ P,
4921                 ;MAY DROP THROUGH
4922 \f
4923                 ;END CURRENT OUTPUT BLOCK
4924
4925 EBLK:   PUSH P,T
4926         PUSH P,TT
4927         PUSH P,A
4928         PUSH P,B
4929         MOVE T,CONTRL
4930         JUMPGE T,EBLK3  ;JUMP IF RELOCATABLE ASSEMBLY
4931         TRNE T,ARIM10\SBLKS
4932         JRST ESBLK
4933 IFN FASLP,[
4934         TRNE T,FASL
4935         JRST FASLE      ;FASL HAS NO BLOCKS TO END - IGNORE
4936 ]
4937         TRNE T,DECREL
4938          JRST DECEBL
4939         JRST EBLK5
4940
4941 EBLK3:  MOVE T,PBITS1
4942         MOVEM T,@PBITS4
4943         MOVEI T,PBITS4
4944         MOVEM T,PBITS4
4945         MOVE T,[440300,,PBITS1]
4946         MOVEM T,BITP
4947         CLEARB TT,PBITS2
4948         CLEARM PBITS1
4949         MOVEI T,BKBUF
4950         MOVE B,OPT1     ;GET POINTER TO END OF BLOCK
4951         SUBI B,BKBUF+1  ;CONVERT TO # WORDS IN BLOCK (EXCLUDING HEADER)
4952         DPB B,[220700,,BKBUF]   ;SET COUNT FIELD IN HEADER
4953         TRZN FF,FRLOC
4954         JUMPLE B,EBLK5  ;IGNORE NULL BLOCK UNLESS FRLOC SET
4955         TLO FF,FLOUT    ;INDICATE THAT OUTPUT HAS OCCURED (FOR 1PASS MULTIPLE-ASSEMBLY HACKING)
4956         PUSHJ P,FEED
4957 EBK1:   CAML T,OPT1     ;DONE WITH BLOCK?
4958         JRST EBK2       ;YES
4959         MOVE A,(T)      ;NO, GET DATA WORD
4960         JFCL 4,.+1      ;UPDATE CHECKSUM
4961         ADD TT,A
4962         JFCL 4,[AOJA TT,.+1]
4963         PUSHJ P,PPB     ;OUTPUT WORD
4964         AOJA T,EBK1
4965 EBK2:   SETCM A,TT      ;DONE OUTPUTTING BLOCK, NOW GET CHECKSUM
4966         PUSHJ P,PPB     ;OUTPUT CHECKSUM
4967         MOVE T,CDATBC   ;GET BLOCK TYPE
4968         DPB T,[310700,,BKBUF]   ;SET NE T BLOCK TYPE TO STORAGE WORDS BLOCK TYPE
4969         MOVEI T,BKBUF+1
4970         MOVEM T,OPT1
4971 EBLK4:  TLO FF,FLOUT    ;INDICATE THAT OUTPUT HAS OCCURED (FOR 1PASS MULTIPLE-ASSEMBLY HACKING)
4972 EBLK5:  TRO FF,FRFIRWD
4973 FASLE:  POP P,B
4974         POP P,A
4975 PTT.TJ: POP P,TT
4976         POP P,T
4977         POPJ P,
4978 \f
4979                 ;PUNCH OUT WORD OF CODED DATA (E.G. STORAGE WORD); WRD, WRDRLC, GLOTB ENTRIES
4980
4981 PWRDA:  TROA FF,FRNLIK  ;SUPPRESS ADR LINKING
4982 PWRD:   TRZ FF,FRNLIK   ;PERMIT ADR LINKING
4983         JUMPGE FF,CPOPJ ;IGNORE IF NOT PUNCHING PASS
4984 IFN LISTSW,[
4985         SKIPN LSTONP
4986          JRST PWRDL     ;NOT MAKING LISTING NOW.
4987         SKIPGE LISTPF
4988         PUSHJ P,PNTR
4989         SETOM LISTPF
4990         MOVE LINK,WRD
4991         MOVEM LINK,LISTWD
4992         MOVE LINK,WRDRLC
4993         MOVEM LINK,LSTRLC
4994         MOVE LINK,CLOC
4995         MOVEM LINK,LISTAD
4996         MOVE LINK,CRLOC
4997         DPB LINK,[220100,,LISTAD]
4998 PWRDL:
4999 ] ;END IFN LISTSW,
5000         SKIPGE LINK,CONTRL
5001         JRST PWRD1      ;ABSOLUTE ASSEMBLY
5002                 ;RELOCATABLE ASSEMBLY
5003         PUSHJ P,$RSET   ;CHECK VALIDITY OF RELOCATION, STANDARDIZE IF NON-STANDARD
5004         MOVE A,GLSP2
5005         CAMN A,GLSP1
5006         JRST PWRD2      ;NO GLOBALS
5007
5008                 ;NOW TO SEE IF IT'S POSSIBLE OR DESIRABLE TO ADDRESS LINK
5009
5010         HRLZ B,WRD
5011         HRR B,WRDRLC
5012         JUMPN B,PWRD3   ;JUMP IF RH NON-ZERO
5013         TRNN FF,FRNLIK
5014         SKIPGE GLOCTP
5015         JRST PWRD3      ;ADR LINKING SUPPRESSED OR CLOC GLOBAL
5016         SKIPE LDCCC
5017         JRST PWRD3      ;IN LOAD TIME CONDITIONALS
5018         MOVNI T,1       ;INITIALIZE T FOR COUNTING
5019 PWRD4:  CAML A,GLSP1
5020         JRST PWRD5      ;DONE
5021         HRRZ TT,1(A)    ;GET GLOTB ENTRY
5022         JUMPE TT,PWRD7A
5023         LDB TT,[400400,,(TT)]   ;GET SQUOZE FLAGS FROM SYM
5024         CAIE TT,DEFGVR_-14.
5025         CAIN TT,GLOETY_-14.
5026         JRST PWRD3      ;DEFINED, BUT MUST BE HERE FOR A REASON (SEE $.H)
5027         HLRZ TT,1(A)
5028         TRNE TT,1777+MINF
5029         JRST PWRD3      ;NEGATED OR MULTIPLIED
5030         TRNE TT,HFWDF
5031         JRST PWRD7
5032         TRNE TT,ACF
5033         TRNN TT,SWAPF
5034         JRST PWRD3      ;NOT HIGH AC
5035 PWRD7A: AOJA A,PWRD4
5036 PWRD7:  TRNE TT,SWAPF
5037         AOJA A,PWRD4    ;LEFT HALF
5038         AOJN T,PWRD3    ;JUMP IF THIS NOT FIRST GLOBAL IN RIGHT HALF
5039         MOVEI D,1(A)    ;FIRST GLOBAL, SET UP POINTER TO GLOTB ENTRY
5040         AOJA A,PWRD4
5041 \f
5042 PWRD5:  AOJE T,PWRD3    ;NO GLOBALS LOOK BAD AND THERE AREN'T TOO MANY; JUMP IF NONE IN RH
5043         HRRZ T,(D)      ;GET ADR OF SQUOZE
5044         SKPST T,        ;SKIP IF IN SYMBOL TABLE
5045         JRST PWRD3      ;BELOW SYMBOL TABLE, DON'T ADDRESS LINK AFTER ALL
5046         PUSH P,T        ;HOORAY, WE CAN ADDRESS LINK
5047         SETZM (D)       ;CLEAR OUT GLOTB ENTRY, DON'T NEED IT ANY MORE
5048         PUSHJ P,PWRD31  ;DUMP OUT THE OTHER GLOBALS
5049         POP P,D         ;GET ST ADR OF THIS AGAIN
5050         3GET1 A,D
5051         LDB A,[.BP (3RLNK),A]
5052         MOVE B,WRDRLC
5053         TLNE B,1
5054         TRO A,2         ;RELOCATE LEFT HALF
5055         PUSHJ P,PBITS   ;PUNCH OUT APPROPRIATE BITS FOR LINK LIST ENTRY
5056         HLR A,1(D)      ;GET ADR OF LAST
5057         HLL A,WRD
5058         PUSHJ P,$OUTPT  ;OUTPUT WORD WITH RH = ADR OF LAST RQ FOR SYM TO PUT IN RH'S
5059         MOVE A,CLOC     ;NOW UPDATE ST ENTRY
5060         HRLM A,1(D)
5061         3GET1 B,D
5062         SKIPN CRLOC
5063         TLZA B,3RLNK    ;CLOC NOT RELOCATED LAST TIME THIS SYM USED
5064         TLO B,3RLNK     ;RELOCATED
5065         3PUT1 B,D
5066         POPJ P,
5067 \f
5068 PWRD31: MOVE T,GLSP2    ;DUMP ALL GLO S IN GENERAL FORMAT
5069 PWRD3A: CAML T,GLSP1
5070         POPJ P,
5071         MOVE B,1(T)
5072         TRNN B,-1
5073         AOJA T,PWRD3A
5074         TLNE B,1777
5075         JRST RPWRD      ;REPEAT
5076 RPWRD1: LDB A,[.BP (MINF),B]
5077         TRO A,4
5078         PUSHJ P,PBITS
5079         MOVE  A,(B)     ;CODEBITS +SQUOZE FOR SYM
5080         HLRZ C,A
5081         TLZ A,740000
5082         CAIL C,DEFGVR
5083         TLOA A,40000    ;SYM IS GLO
5084         JRST [  MOVEI C,(B)             ;IF WE ARE OUTPUTTING A REFERENCE TO THE
5085                 CAIL C,PCNTB            ;"LABEL" AT THE BEGINNING OF A CONSTANTS AREA
5086                 CAIL C,PCNTB+NCONS*3    ;(BECAUSE THIS IS A 1PASS ASSEMBLY) USE THE
5087                 MOVEI A,(B)             ;NAME, SINCE THE SYMBOL ISN'T IN THE
5088                 JRST .+1]               ;SYMTAB
5089         TLNE B,SWAPF
5090         TLO A,400000
5091         TLNE B,ACF
5092         JRST PWRD3E     ;AC HIGH OR LOW
5093         TLNN B,HFWDF
5094         JRST PWRD3F     ;ALL THROUGH
5095         TLO A,100000
5096         TLNE B,SWAPF
5097         TLC A,300000
5098 PWRD3F: PUSHJ P,$OUTPT
5099         AOJA T,PWRD3A
5100
5101
5102
5103 RPWRD:  PUSHJ P,PBITS7
5104         MOVEI A,CRPT
5105         PUSHJ P,PBITS
5106         LDB A,[221200,,B]
5107         PUSHJ P,$OUTPT
5108         JRST RPWRD1
5109
5110 PWRD3E: TLO A,300000
5111         JRST PWRD3F
5112
5113 PWRD3:  PUSHJ P,PWRD31
5114 PWRD2:  PUSHJ P,RCHKT
5115         HRRZ A,B
5116         DPB T,[10100,,A]
5117         PUSHJ P,PBITS
5118         JRST OUTWD
5119 \f
5120                 ;CHECK FOR VALIDITY OF RELOCATION BITS OF CURRENT WORD
5121                 ;LEAVE RELOC (RH) IN B, RELOC (LH) IN T
5122
5123 RCHKT:  HRRZ B,WRDRLC   ;CHECK FOR RELOC. OTHER THAN 0 OR 1.
5124         HLRZ T,WRDRLC
5125         TRZN B,-2
5126         TRZE T,-2
5127 RLCERR: ETSM [ASCIZ /Illegal relocation/]
5128         POPJ P,
5129
5130 RMOVET: ROT T,-1
5131         DPB B,[420100,,T]
5132         TLZ C,3DFCLR    ;SET RELOC BITS IN C
5133         IOR C,T         ;FROM B AND T.
5134         POPJ P,
5135
5136                 ;CHECK WRDRLC FOR VALIDITY (CAPABILITY OF BEING PUNCHED OUT)
5137                 ;IF STANDARD THEN JUST RETURN
5138                 ;IF NON-STANDARD BUT OTHERWISE OK, PUT $R. ON GLOBAL LIST, RESET WRDRLC, AND RETURN
5139                 ;LEAVES B AND C SET UP WITH RH, LH OF WRDRLC.
5140
5141 $RSET:  MOVE C,WRDRLC   ;GET RELOCATION
5142         ADDI C,400000   ;WANT TO SEPARATE HALFWORDS
5143         HLRE B,C        ;GET LH IN B
5144         HRREI C,400000(C)       ;GET RH IN C (WILL EXCHANGE LATER)
5145         MOVE A,[SWAPF+HFWDF,,$R.H]      ;PUT THIS ON GLOBAL LIST IF LH NEEDS $R.
5146         TRNE B,-2       ;CHECK LH
5147         PUSHJ P,$RSET1  ;LH NEEDS GLOBAL REFERENCE
5148         EXCH B,C
5149         HRLI A,HFWDF
5150         TRNE B,-2       ;CHECK RH
5151         PUSHJ P,$RSET1  ;RH NEEDS GLOBAL REFERENCE
5152         HRLZM C,WRDRLC  ;RELOC OF LH
5153         ADDM B,WRDRLC   ;COMPLETE SETTING UP WRDRLC
5154         POPJ P,
5155
5156 $RSET1: JUMPGE B,$RSET2 ;STRANGE RELOCATION IN B, JUMP IF NON-NEGATIVE
5157         MOVN T,B        ;NEGATIVE, GET MAGNITUDE
5158         TLOA A,MINF     ;SET FLAG TO NEGATE GLOBAL
5159 $RSET2: SOSA T,B        ;POSITIVE, GET ONE LESS THAN IT IN T
5160         TDZA B,B        ;NEGATIVE, CLEAR B, RELOCATION LEFT OVER
5161         MOVEI B,1       ;POSITIVE, SET RELOCATION LEFT OVER TO 1
5162         CAIN T,1
5163         MOVEI T,0       ;MULTIPLYING BY TWO OR SUBTRACTING TIMES 1
5164         TRNE T,-2000
5165          ETSM [ASCIZ /Relocation too large/]    ;TOO BIG EVEN FOR $RSET
5166         DPB T,[221200,,A]       ;LOOKS OK, STORE TIMES FIELD IN $R. REFERENCE
5167         AOS GLSP1       ;NOW PUT $R. ON GLOBAL LIST
5168         MOVEM A,@GLSP1
5169         POPJ P,
5170 \f
5171                 ;PWRD DURING ABSOLUTE ASSEMBLY
5172
5173 PWRD1:  TRNE LINK,DECREL        ;DEC FMT IS CONSIDERED ABSOLUTE.
5174          JRST DECPW
5175 IFN FASLP,[
5176         TRNE LINK,FASL
5177          JRST FASPW     ;SO IS FASL
5178 ]
5179         MOVE A,GLSP1
5180         CAME A,GLSP2
5181          ETR ERRILG     ;GLOBALS APPEARING ILLEGALLY
5182         SKIPE WRDRLC
5183          ETR ERRIRL     ;RELOCATION APPEARING ILLEGALLY
5184         TRNE LINK,ARIM
5185         JRST PRIM       ;RIM
5186 SBLKS1: MOVE A,WRD      ;SBLK
5187         MOVEM A,@OPT1   ;STORE WRD IN BKBUF
5188         MOVE A,CLOC
5189         TRZE FF,FRFIRWD
5190         MOVEM A,BKBUF   ;FIRST WORD OF BLOCK, SET UP HEADER
5191         AOS A,OPT1
5192         CAIGE A,BKBUF+BSIZE
5193         POPJ P,         ;BKBUF NOT FULL YET
5194
5195 SBLKS2: SUBI A,BKBUF+1
5196         JUMPE A,CPOPJ
5197         MOVNS A
5198         HRLM A,BKBUF
5199         PUSHJ P,FEED
5200         MOVEI T,BKBUF
5201         CLEARM SCKSUM
5202 SBLK1:  CAML T,OPT1
5203         JRST SBLK2
5204         MOVE A,SCKSUM
5205         ROT A,1
5206         ADD A,(T)
5207         MOVEM A,SCKSUM
5208         MOVE A,(T)
5209         PUSHJ P,PPB
5210         AOJA T,SBLK1
5211
5212 SBLK2:  TRO FF,FRFIRWD
5213         MOVEI A,BKBUF+1
5214         MOVEM A,OPT1
5215         MOVE A,SCKSUM
5216         JRST PPB
5217
5218 ESBLK:  MOVE A,OPT1
5219         CAIN A,BKBUF+1
5220          JRST EBLK5     ;AVOID SETTING FLOUT IF NULL BLOCK.
5221         PUSHJ P,SBLKS2
5222         JRST EBLK4
5223
5224 PRIM:   MOVSI A,(DATAI PTR,)
5225         HRR A,CLOC
5226         PUSHJ P,PPB
5227         MOVE A,WRD
5228         JRST PPB
5229 \f
5230 ;END A BLOCK IN DEC FMT. COME FROM EBLK.
5231 DECEBL: PUSH P,[EBLK5]
5232 DECEB1: MOVSI A,DECWDS  ;JUST INIT. AN ORDINARY BLOCK,
5233
5234 ;COME HERE TO OUTPUT PREVIOUS BLOCK AND START NEW BLOCK OF TYPE IN LH OF A.
5235 DECBLK: PUSH P,A
5236         HRRZ A,BKBUF    ;GET DATA-WORD COUNT OF CURRENT BLOCK.
5237         JUMPE A,DECB1   ;NO WORDS => CAN IGNORE.
5238         MOVEI TT,BKBUF+1
5239 DECB0:  MOVE A,-1(TT)   ;GET AND PUNCH NEXT WD OF BLOCK.
5240         PUSHJ P,PPB
5241         CAME TT,OPT1    ;STOP WHEN NEXT WD ISN'T IN BLOCK.
5242          AOJA TT,DECB0
5243 DECB1:  POP P,A
5244         HLLZM A,BKBUF   ;PUT BLOCK TYPE IN LH OF HEADER, DATA WD COUNT IN RH IS 0.
5245         MOVEI TT,BKBUF+2        ;ADDR OF PLACE FOR 1ST DATA WD
5246         MOVEM TT,OPT1           ;(LEAVE SPACE FOR WD OF RELOC BITS)
5247         MOVE TT,[440200,,BKBUF+1]
5248         MOVEM TT,BITP   ;BP FOR STORING PAIRS OF RELOC BITS.
5249         SETZM BKBUF+1   ;CLEAR THE WD OF RELOC BITS.
5250         TLO FF,FLOUT
5251         POPJ P,
5252
5253 ;COME HERE TO OUTPUT A WORD IN DEC FORMAT.
5254 DECPW:  MOVS A,BKBUF
5255         CAIE A,DECWDS   ;BEFORE THE 1ST STORAGE WD IN ORDINARY BLOCK,
5256          JRST DECPW0
5257         MOVE A,CRLOC    ;MUST GO THE LOCATION CTR.
5258         IDPB A,BITP
5259         MOVE A,CLOC
5260         MOVEM A,@OPT1
5261         AOS OPT1
5262         AOS BKBUF       ;IT COUNTS AS DATA WORD.
5263 DECPW0: MOVE A,BITP
5264         TLNE A,77^4     ;IF NO ROOM FOR MORE RELOC BITS,
5265          JRST DECPW1
5266         HLLZ A,BKBUF    ;START A NEW BLOCK.
5267         PUSHJ P,DECBLK
5268         JRST DECPW
5269
5270 DECPW1: PUSHJ P,$RSET   ;SET UP RELOC BITS OF HALVES IN B,C.
5271         LSH C,1
5272         IORI B,(C)      ;COMBINE THEM.
5273         MOVE A,GLSP1
5274         CAME A,GLSP2
5275         JRST DECPG      ;GO HANDLE GLOBALS.
5276 DECPW3: IDPB B,BITP     ;STORE THE RELOC BITS
5277         MOVE A,WRD
5278 DECPW2: MOVEM A,@OPT1   ;AND THE VALUE.
5279         AOS OPT1
5280         AOS BKBUF
5281         POPJ P,
5282 \f
5283 ;PUT A WORD DIRECTLY INTO DEC FMT BLOCK.
5284 DECWRD: SETZ TM,
5285 DECWR1: IDPB TM,BITP    ;SKIP A PAIR OF RELOC BITS,
5286         JRST DECPW2     ;STORE THE WORD.
5287
5288 ;HANDLE GLOBAL REFS IN DEC FMT.
5289 DECPG:  PUSHJ P,DECPW3  ;FIRST, OUTPUT THE WORD,
5290 DECPG0: MOVSI A,DECSYM
5291         PUSHJ P,DECBLK  ;THEN STRT A SYMBOLS BLOCK.
5292         MOVE C,GLSP2
5293         SAVE SYM
5294 DECPG1: CAMN C,GLSP1    ;ALL DONE =>
5295          JRST DECPG2    ;GO START AN ORDINARY BLOCK FOR NEXT WD.
5296         MOVE A,BITP
5297         TLNN A,77^4     ;BLOCK FULL => START ANOTHER.
5298          JRST DECPG0
5299         AOS C,GLSP2     ;GET ADDR OF NEXT GLOBAL REF.
5300         MOVE B,(C)
5301         MOVE B,(B)      ;GET NAME OF SYM.
5302         TLZ B,740000
5303         CAMN B,[SQUOZE 0,$R.]
5304          JRST DECPG3    ;(DEC'S LOADER HAS NO SUCH HACK.)
5305         CALL ASQOZR     ;RIGHT-JUSTIFY THE SQUOZE FOR DEC SYSTEM.
5306         MOVE A,B
5307         TLO A,600000    ;PUT IN FLAGS SAYING ADDITIVE GLOBAL RQ.
5308         PUSHJ P,DECWRD  ;OUTPUT NAME.
5309         HRRZ A,CLOC     ;GET ADDR OF RQ,
5310         TLO A,400000    ;MACRO-10 SETS THIS BIT SO I WILL.
5311         MOVE B,(C)
5312         TLNE B,SWAPF    ;SWAPPED => TELL LOADER..
5313          TLO A,200000
5314         TLNE B,ACF+MINF
5315          ETSM ERRILG    ;CAN'T NEGATE GLOBAL OR PUT IN AC.
5316         MOVE TM,CRLOC
5317         PUSHJ P,DECWR1  ;OUTPUT 2ND WD,
5318         JRST DECPG1     ;GO BACK FOR MORE GLOBAL REFS.
5319
5320 DECPG2: REST SYM
5321         JRST DECEB1
5322
5323 DECPG3: ETR ERRIRL      ;WE NEEDED $R. BUT DIDN'T HAVE IT.
5324         JRST DECPG1
5325
5326 ERRILG: ASCIZ /Illegal use of external/
5327 ERRIRL: ASCIZ /Illegal use of relocatables/
5328
5329
5330 ;OUTPUT PROGRAM NAME BLOCK (AT START OF PASS 2)
5331 ;IF 2-SEG PROGRAM, ALSO OUTPUT A TYPE-3 BLOCK (LOAD INTO HISEG)
5332 DECPGN: JUMPGE FF,CPOPJ ;ONLY ON PASS 2.
5333         SAVE [EBLK]
5334         MOVSI A,DECNAM
5335         CALL DECBLK
5336         MOVE B,PRGNM
5337         CALL ASQOZR
5338         MOVE A,B
5339         CALL DECWRD
5340         MOVSI A,14      ;IDENTIFY THIS REL FILE AS MADE BY MIDAS.
5341         CALL DECWRD
5342         MOVE A,DECTWO
5343         CAMN A,[MOVE]
5344          RET            ;NOT A 2-SEG PROGRAM.
5345 DECP2S: MOVSI A,DECHSG
5346         CALL DECBLK     ;START A LOAD-INTO-HISEG BLOCK.
5347         MOVE A,DECTWO
5348         HRL A,DECBRH    ;HISEG BRK,,TWOSEG ORIGIN.
5349         SKIPL A
5350          HRLI A,(A)
5351         MOVEI TM,1      ;RELOCATION IS 1.
5352         JRST DECWR1
5353 \f
5354 IFN FASLP,[
5355 ;INITIALIZE OUTPUT FOR FASL ASSEMBLY
5356 FASOIN: JUMPGE FF,CPOPJ ;ONLY ON PASS 2
5357         MOVE A,[SIXBIT /*FASL*/]
5358         PUSHJ P,PPB
5359         MOVE A,[MIDVRS]
5360         LSH A,-6
5361         TLO A,(SIXBIT /M/)
5362         PUSHJ P,PPB     ;"LISP" VERSION NUMBER (USE M AND MIDAS NUMBER)
5363         MOVE A,[440400,,FASB]   ;INITIALIZE FASL OUTPUT BUFFER
5364         MOVEM A,FASCBP
5365         MOVEI A,FASB+1
5366         MOVEM A,FASBP
5367         POPJ P,
5368
5369
5370 ;COME HERE TO OUTPUT A WORD IN FASL FORMAT
5371 FASPW:  MOVE C,FASPCH
5372         CAME C,FASATP
5373         PUSHJ P,FPATB   ;"PUNCH" OUT ATOM TBL (IF MORE HAS APPEARED)
5374         PUSHJ P,$RSET   ;GET RELOC
5375         PUSH P,C        ;SAVE LH RELOC
5376         MOVEM B,FASPWB  ;B HAS RELOC, WHICH IS ALSO FASL CODE FOR RELOC =1
5377         MOVE A,GLSP2
5378 FASPW3: CAME A,GLSP1
5379         JRST FASPW1     ;LOOK TO SEE ..
5380 FASPW2: MOVE A,WRD      ;B HAS RELOC, WHICH ALSO HAPPENS TO BE FASL CODE TYPE
5381         MOVE B,FASPWB
5382         PUSHJ P,FASO    ;OUTPUT WORD IN A WITH FASL CODE IN B
5383         POP P,TM
5384         JUMPE TM,FASPW5 ;NO LEFT HALF RELOC, OK
5385         MOVNI A,1       ;ACTIVATE FASL HACK FOR LH RELOC
5386         MOVEI B,7       ;WOULD OTHERWISE BE GETDDTSYM
5387         PUSHJ P,FASO
5388 FASPW5: MOVE C,GLSP2
5389 FASPW6: CAMN C,GLSP1
5390         POPJ P,
5391         HRRZ TM,1(C)
5392         JUMPE TM,[AOJA C,FASPW6]
5393         MOVE SYM,(TM)   ;GET SQUOZE OF SYM
5394         TLZ SYM,740000  ;CLEAR CODE BITS
5395         HLRZ D,1(C)
5396         TRZ D,400000    ;DONT WORRY ABOUT THAT BIT
5397         TRZE D,MINF
5398         TLO SYM,400000  ;NEGATE
5399         CAIN D,SWAPF
5400         JRST FSPWSW
5401         CAIN D,HFWDF
5402         JRST FSPWRH
5403         CAIN D,ACF+SWAPF
5404         JRST FSPWAC
5405         JUMPE D,FSPWWD
5406         ETSM [ASCIZ /Global in illegal FASL context/]
5407
5408 FSPWWD: TLOA SYM,140000
5409 FSPWAC: TLOA SYM,100000
5410 FSPWRH: TLO SYM,40000
5411 FSPWSW: MOVE A,SYM
5412         MOVEI B,7       ;DDT SYM
5413         PUSHJ P,FASO
5414         AOJA C,FASPW6
5415
5416 FASPW1: HRRZ TM,1(A)    ;GLOTB ENTRY
5417         JUMPE TM,FASPW4
5418         CAIL TM,AFDMY1
5419         CAIL TM,AFDMY2
5420 FASPW4: AOJA A,FASPW3
5421         MOVE C,1(A)     ;ITS A LIST STRUCTURE REF
5422         TLNN C,-1-HFWDF
5423         SKIPE FASPWB
5424         ETA [ASCIZ /Illegal LISP structure reference/]
5425         MOVE TM,AFDMY2-AFDMY1(TM)       ;GET FASL BITS
5426         MOVEM TM,FASPWB         ;FASL BITS
5427         CLEARM 1(A)             ;FLUSH THAT GUY
5428         AOJA A,FASPW3
5429
5430 FPATB:  CAMN C,FASATP   ;PUNCH OUT ATOM TBL, AMT ALREADY PUNCHED IN C
5431         POPJ P,         ;THRU
5432         MOVEI B,12      ;ATOM TBL INFO
5433         MOVE A,FASAT(C)
5434         TRNN A,-1
5435         AOJA C,FPATB3   ;LIST WORD .. SHOULD HAVE PUNCHED ITSELF
5436         PUSHJ P,FASO
5437         HRRZ D,FASAT(C) ;ATOM "LENGTH"
5438         AOS C
5439 FPATB1: SOJL D,FPATB2
5440         MOVE A,FASAT(C)
5441         PUSHJ P,FASO1
5442         AOJA C,FPATB1
5443
5444 FPATB3: ETR [ASCIZ /Internal loss at FPATB3/]
5445 FPATB2: MOVEM C,FASPCH  ;RECORD AMOUNT PUNCHED
5446         JRST FPATB      ;LOOP BACK IF MORE
5447
5448
5449 FASO:   PUSHJ P,FASBO   ;WRITE BITS
5450 FASO1:  MOVEM A,@FASBP  ;STORE A IN FASL OUTPUT BUFFER
5451         AOS TM,FASBP
5452         CAIL TM,FASB+FASBL
5453          ETF [ASCIZ /.FASL output block too long/]
5454         POPJ P,
5455
5456 FASBO:  MOVE TM,FASCBP  ;OUTPUT FASL CODEBITS IN B, WRITE PREV BLOCK IF NECC
5457         TLNN TM,770000
5458         PUSHJ P,FASBE   ;WRITE PREV FASL BLOCK
5459         IDPB B,FASCBP
5460         POPJ P,
5461
5462 FASBE:  PUSH P,A
5463         PUSH P,B
5464         MOVEI TT,FASB
5465 FASBO2: CAML TT,FASBP
5466         JRST FASBO3
5467         MOVE A,(TT)
5468         PUSHJ P,PPB
5469         AOJA TT,FASBO2
5470
5471 FASBO3: POP P,B
5472         POP P,A
5473         CLEARM FASB     ;NEW CODE WORD
5474         MOVEI TM,FASB+1
5475         MOVEM TM,FASBP
5476         SOS FASCBP
5477         POPJ P,
5478
5479 \f
5480 AFATOM: PUSH P,B        ;SAVE CODEBITS
5481         SKIPGE B,CONTRL
5482         TRNN B,FASL
5483         ETI [ASCIZ /.ATOM illegal except in FASL assembly/]
5484         PUSHJ P,AFRATM  ;READ "ATOM", RETURN INDEX IN A
5485         POP P,B
5486         HLRZS B
5487 AFLST1: AOS GLSP1
5488         MOVEI T,AFDMY1(B)       ;DUMMY (STORE THIS INFO IN SYM SO CONSTANTS WILL WIN
5489         HRRZM T,@GLSP1
5490         MOVEI B,0       ;NO RELOCATION
5491         POPJ P,
5492
5493 ;GLOBALS IN THIS TABLE KEEP TRACK OF LIST REFS
5494 ;UNDEF GLOBAL GODEBITS
5495 AFDMY1: SQUOZE 44,.%VCEL        ;EVENTUALLY POINT TO VALUE CELL
5496         SQUOZE 44,.%SCAL        ;EVENTUALLY BECOME "SMASHABLE CALL"
5497         SQUOZE 44,.%ATM         ;EVENTUALLY POINT TO ATOM
5498         SQUOZE 44,.%ARY         ;EVENTUALLY POINT TO ARRAY
5499 AFDMY2: 2                       ;CODE BITS FOR VALUE CELL REF
5500         3                       ;CODE BITS FOR SMASHABLE CALL
5501         4                       ;CODE BITS FOR POINTER TO ATOM
5502         10                      ;CODE BITS FOR POINTER TO ARRAY
5503
5504 AFRATM: PUSHJ P,AFRTKN          ;READ TOKEN, LEAVING IT AT END OF FASAT
5505         PUSHJ P,AFRITN          ;"INTERN" IT, SKIP IF NOT FOUND
5506         POPJ P,                 ;IF FOUND, INDEX IN A
5507         PUSHJ P,AFRENT          ;ENTER IN FASAT
5508         POPJ P,
5509
5510 AFRENT: MOVE A,FASAT1           ;STORE FASAT1 IN FASATP
5511         MOVEM A,FASATP
5512         AOS A,FASIDX            ;RETURN LOAD TIME ATOM INDEX
5513         POPJ P,
5514
5515 AFRTKN: MOVE A,FASATP
5516         ADD A,[700,,FASAT]
5517         MOVEM A,FASAT2          ;BYTE PNTR TO USE TO STORE ATOM
5518         CLEARM (A)
5519         CLEARM 1(A)             ;MAKE SURE ALL LOW BITS CLEARED
5520         PUSHJ P,RCH
5521         CAIN A,"#
5522         JRST AFRTK1             ;READ NUMBER INTO FIXNUM SPACE
5523         CAIN A,"&
5524         JRST AFRTK2             ;READ NUMBER INTO FLONUM SPACE
5525 AFRTKL: IDPB A,FASAT2           ;STORE CHAR
5526         HRRZ A,FASAT2
5527         CAIL A,FASAT+FASATL-1
5528 AFTERR: ETA [ASCIZ /LISP atom name table full/]
5529         CLEARM 1(A)
5530 AFRTL2: PUSHJ P,RCH
5531         CAIN A,12
5532         JRST AFRTL2             ;IGNORE LF IN ATOM NAMES (PRIMARILY SO /CR WINS WITH ONE
5533         CAIN A,"/               ;SLASH
5534         JRST AFRQT              ;QUOTE CHAR
5535         CAIE A,40
5536         CAIN A,15
5537         JRST AFREND
5538         CAIE A,";
5539         CAIN A,11
5540         JRST AFREND
5541         CAIE A,"(
5542         CAIN A,")
5543         JRST AFREN2
5544         JRST AFRTKL             ;THAT CHAR WINS, SALT IT
5545
5546 AFRQT:  PUSHJ P,RCH             ;TAKE NEXT CHR NO MATTER WHAT
5547         JRST AFRTKL
5548
5549 AFRTK1: SKIPA TM,[100000,,1]    ;PUT VAL IN FIXNUM SPACE
5550 AFRTK2: MOVE TM,[200000,,1]     ;PUT IT IN FLONUM SPACE
5551         PUSH P,TM
5552         MOVE SYM,[SQUOZE 0,ATOM]
5553         PUSHJ P,FAGTFD
5554         POP P,TM
5555         MOVE B,FASATP
5556         ADDI B,2
5557         CAIL B,FASAT+FASATL
5558         XCT AFTERR
5559         MOVEM TM,FASAT-2(B)
5560         MOVEM A,FASAT-1(B)
5561         MOVEM B,FASAT1
5562         POPJ P,
5563
5564 AFREN2: TLO FF,FLUNRD           ;SAVE ( OR ) AS WELL AS FLUSHING
5565 AFREND: MOVEI B,5               ;PAD END OF P.N. WITH 0 S
5566         MOVEI TM,0
5567 AFREN1: IDPB TM,FASAT2
5568         HRRZ A,FASAT2
5569         CAIL A,FASAT+FASATL-1
5570         XCT AFTERR
5571         CLEARM 1(A)
5572         SOJG B,AFREN1
5573         SUBI A,FASAT
5574         MOVEM A,FASAT1          ;STORE PNTR TO WORD BEYOND ATOM
5575                                 ; MAYBE PUT THIS IN FASATP
5576         MOVE B,FASATP           ;ADR OF START OF ATOM READ
5577         SUBI A,1(B)             ;COMPUTE LENGTH OF FASAT
5578         HRRZM A,FASAT(B)        ;PN ATOM 4.8-4.7 =0 STORE LENGTH IN HEADER WD
5579
5580         POPJ P,
5581
5582 AFRITN: MOVEI B,0               ;"INTERN" LAST ATOM READ IN
5583         MOVEI A,1               ;A CONTAINS RUNTIME ATOM TBL INDEX
5584                                 ;B INDEX WITHIN FASAT
5585 AFRIT1: CAML B,FASATP
5586         JRST POPJ1              ;NOT FOUND
5587         MOVE C,FASATP           ;POINTS AT HEADER OF WORD OF NEW (?) ATOM
5588         HRRZ D,FASAT(B)         ;HEADER WD OF GUY IN TBL(RIGHT HALF HAS LENGTH)
5589         JUMPE D,AFRIT4          ;JUMP ON RESERVED FOR LIST
5590 AFRIT2: MOVE TM,FASAT(C)
5591         CAME TM,FASAT(B)
5592         AOJA B,AFRIT3           ;THIS ONE LOSES
5593         SOJL D,CPOPJ                    ;THIS ONE WINS!
5594         AOS B
5595         AOJA C,AFRIT2
5596
5597 AFRIT3: SOJL D,[AOJA A,AFRIT1]          ;FINISH SPACING OVER THIS GUY
5598 AFRIT4: AOJA B,AFRIT3
5599
5600 AFENTY: SKIPGE B,CONTRL
5601         TRNN B,FASL
5602          ETI [ASCIZ /.ENTRY in NON-FASL/]
5603         SKIPN CRLOC
5604          ETI [ASCIZ /.ENTRY when . is absolute/]
5605         PUSHJ P,AFRATM          ;READ FUNCTION NAME
5606         HRLZS A
5607         PUSH P,A
5608         PUSHJ P,AFRATM          ;READ TYPE (SUBR, LSUBR, ETC)
5609         HRRM A,(P)
5610         MOVE SYM,[SQUOZE 0,.ENTRY]
5611         PUSHJ P,FAGTFD          ;READ ARGS PROP
5612         JUMPGE FF,ASSEM1        ;NOT PUNCHING PASS
5613         PUSH P,A
5614         MOVE C,FASPCH
5615         CAME C,FASATP
5616         PUSHJ P,FPATB           ;MAKE SURE ANY NEW ATOMS OUT
5617         POP P,C
5618         POP P,A
5619         MOVEI B,13
5620         PUSHJ P,FASO
5621         HRL A,C
5622         HRR A,CLOC
5623         PUSHJ P,FASO1
5624         JRST ASSEM1
5625
5626 AFLIST: HLRZM B,AFLTYP
5627         SKIPGE B,CONTRL
5628         TRNN B,FASL
5629         ETI [ASCIZ /.LIST illegal except in FASL assembly/]
5630         PUSHJ P,AFRLST  ;READ LIST, RTN ATM TBL INDEX IN A
5631         SKIPN AFLTYP
5632         JRST ASSEM1     ;JUST EVAL IN LISP AND THROW AWAY VALUE
5633         MOVEI B,AFDMAI  ;"ATOM" INDEX IN AFDMY1 TBL
5634         JRST AFLST1     ;TREAT AS ATOM
5635
5636 AFRLST: CLEARM AFRLD    ;"DEPTH"
5637         CLEARM AFRLEN   ;"LENGTH" OF LIST AT CURRENT LEVEL
5638         CLEARM AFRDTF   ;DOT CONTEXT FLAG
5639         JUMPGE FF,AFRLI1
5640         MOVE C,FASPCH
5641         CAME C,FASATP
5642         PUSHJ P,FPATB   ;MAKE SURE ALL ATOMS "PUNCHED"
5643         MOVE A,FASATP
5644         MOVEM A,AFRFTP  ;SAVED STATE OF FASAT POINTER
5645         MOVE C,AFLTYP
5646         MOVEI B,16      ;EVAL TYPE HACK
5647         CAIN C,1
5648         MOVEI B,5       ;LIST TYPE HACK
5649         PUSHJ P,FASBO   ;WRITE CODE BITS
5650 AFRLI1:
5651 AFRL1:  PUSHJ P,RCH
5652         CAIE A,40       ;PREV ATOM (OR WHATEVER) "DELIMITED", SO THESE MEANINGLESS
5653         CAIN A,15       ;UNLESS AT TOP LEVEL AND HAVE READ SOMETHING
5654         JRST AFRL1A
5655         CAIE A,11
5656         CAIN A,12
5657         JRST AFRL1A
5658         CAIN A,"(
5659         JRST AFRLO
5660         CAIN A,")
5661         JRST AFRLC
5662         CAIN A,".
5663         JRST AFRDT      ;DOT..
5664         TLO FF,FLUNRD
5665         SKIPE AFRLD
5666         JRST AFRNXT     ;READ NEXT GUY THIS LVL
5667         SKIPE AFRLEN
5668 AFRLO2: ETI [ASCIZ /LISP read context error/]
5669 AFRNXT: SKIPN TM,AFRDTF
5670         JRST AFRNX2     ;NOT HACKING DOTS, OK
5671         AOS TM,AFRDTF
5672         CAIE TM,2
5673         JRST AFRLO2     ;DIDNT JUST SEE THE DOT
5674 AFRNX2: PUSHJ P,AFRATM
5675         JUMPGE FF,AFRNX1        ;XFER ON NOT PUNCHING PASS
5676         PUSHJ P,FASO1   ;TELL LOADER TO PUSH THIS ON ITS STACK
5677 AFRNX1: AOS AFRLEN      ;LIST NOW ONE LONGER THIS LVL
5678         JRST AFRL1
5679
5680 AFRLO:  SKIPN TM,AFRDTF
5681         JRST AFRLO3     ;NOT HACKING DOTS
5682         SOJN TM,AFRLO2
5683         CLEARM AFRDTF
5684         JRST AFRL1      ;IGNORE BOTH . AND (
5685 AFRLO3: SKIPE AFRLD     ;(
5686         JRST AFRLO1
5687         SKIPE AFRLEN
5688         JRST AFRLO2
5689 AFRLO1: PUSH P,AFRLEN
5690         CLEARM AFRLEN   ;START NEW LVL
5691         AOS AFRLD       ;DEPTH NOW ONE GREATER
5692         JRST AFRL1
5693
5694 AFRLC:  SOSGE AFRLD     ;)
5695         JRST AFRLO2     ;AT TOP LEVEL, BARF
5696         MOVE A,AFRLEN
5697         SKIPN TM,AFRDTF
5698         JRST AFRLC2     ;NOT HACKING DOTS
5699         CAIE TM,2
5700         JRST AFRLO2
5701         SOS A           ;MAIN LIST NOW ONE SHORTER
5702         TLOA A,200000   ;DOT WITH LAST THING ON STACK
5703 AFRLC2: TLO A,100000    ;TELL LOADER TO MAKE LIST THIS LONG
5704         JUMPGE FF,AFRLC5
5705         PUSHJ P,FASO1
5706 AFRLC5: POP P,AFRLEN    ;LENGTH AT PREV LVL
5707         AOS AFRLEN      ;NOW ONE MORE
5708         CLEARM AFRDTF   ;NOT HACKING DOTS NOW
5709         SKIPE AFRLD     ;RETURNING TO TOP LEVEL?
5710         JRST AFRL1
5711         JRST AFRX1      ;YES THRU
5712
5713 AFRDT:  SKIPN AFRDTF
5714         SKIPN AFRLEN
5715         JRST AFRLO2     ;DOT IN FIRST POSITION OF LIST
5716         AOS AFRDTF      ;ENTER STATE 1 OF DOT HACKING
5717         JRST AFRL1
5718
5719 AFRL1A: SKIPN AFRLD     ;SPACER CHAR TERMINATES AT TOP LVL IF HAVE RD SOMETHING
5720         SKIPN AFRLEN
5721         JRST AFRL1
5722 AFRX1:  JUMPGE FF,AFRX2 ;NOT PUNCHING PASS
5723         MOVE A,AFRFTP
5724         CAME A,FASATP
5725         ETR [ASCIZ /Saw atoms in list on pass 2 for first time/]
5726         SKIPN B,AFLTYP  ;TYP LIST OP
5727         SKIPA A,[-1,,]
5728         MOVSI A,-2      ;PUT LIST OR VALUE OF LIST IN ATOM TBL
5729         PUSHJ P,FASO1   ;TERM OP AND PUT IT IN ATOM TBL
5730         MOVEI A,0
5731         MOVE B,AFLTYP
5732         JUMPE B,CPOPJ   ;JUST WANT VALUE OF LIST
5733         CAIN B,1        ;ONLY WANT THIS FOR STRAIGHT LIST
5734         PUSHJ P,FASO1   ;OUTPUT "SXHASH" WORD
5735         AOS A,FASATP
5736         CLEARM FASAT-1(A)       ;RESERVE SLOT IN FASAT TBL
5737         MOVEM A,FASPCH          ;SAY ALREADY PUNCHED OUT
5738         AOS A,FASIDX
5739         POPJ P,
5740
5741 AFRX2:  TLO I,ILNOPT    ;DONT TRY TO OPTIMIZE IF IN CONSTANT
5742         CLEARB A,B
5743         POPJ P,
5744 ]
5745 \f               ;.LIBRA, .LIFS, ETC.
5746
5747 A.LIB:  NOVAL ? NOABS
5748         HLRZM B,LIBTYP' ;STORE BLOCK TYPE TO OUTPUT
5749         CLEARM LIBOP    ;INITIALIZE SQUOZE FLAGS
5750         PUSHJ P,EBLK    ;END CURRENT OUTPUT BLOCK, MAKING SURE LOADER KNOWS $.
5751 LIB1:   PUSHJ P,GETSYL  ;GET NAME
5752         TRNN I,IRSYL
5753         JRST LIB2       ;NO SYL, DON'T OUTPUT
5754         IOR SYM,LIBOP
5755         TLO SYM,40000
5756         PUSHJ P,OUTSM
5757         MOVSI A,400000
5758         ANDCAM A,LIBOP
5759 LIB2:   MOVE B,CDISP    ;GET CDISP
5760         TLNN B,DWRD\DFLD        ;CHECK FOR WORD TERMINATOR
5761         JRST LIB3       ;WORD TERMINATOR => DONE
5762         MOVE A,LIBOP
5763         MOVE B,LIMBO1   ;RETRIEVE LAST CHAR READ
5764         CAIN B,",
5765         MOVSI A,400000
5766         CAIN B,"+
5767         TLZ A,200000
5768         CAIN B,"-
5769         TLO A,200000
5770         MOVEM A,LIBOP'  ;STORE SQUOZE FLAGS (LESS GLBL BIT) FOR NEXT SYM
5771         JRST LIB1
5772
5773 LIB3:   MOVE A,LIBTYP   ;GET BLOCK TYPE TO OUTPUT
5774         DPB A,[310700,,BKBUF]
5775         PUSHJ P,EBLK
5776         CAIN A,LLIB     ;.LIBRA?
5777         JRST ARELC1     ;.LIBRA, NOW PLAY LIKE RELOCA PSEUDO
5778         JRST LIB5       ;SOMETHING ELSE (.LIFS), INCREMENT DEPTH IN LOAD TIME CONDITIONALS
5779
5780 A.ELDC: NOVAL ? NOABS
5781         PUSHJ P,EBLK
5782         MOVEI A,ELTCB
5783         DPB A,[310700,,BKBUF]
5784         TRO FF,FRLOC    ;MAKE EBLK OUTPUT NULL BLOCK
5785         PUSHJ P,EBLK
5786         SOSGE LDCCC
5787         CLEARM LDCCC    ;LOADER CONDITIONAL UNDERFLOW
5788         JRST ASSEM1
5789
5790                 ;LOADER CONDITIONAL ON VALUE
5791
5792 A.LDCV: NOVAL ? NOABS
5793         LSH B,-27.
5794         PUSH P,B
5795         PUSHJ P,AGETWD
5796         POP P,B
5797         DPB B,[400300,,BKBUF]
5798         MOVEI A,LDCV
5799         PUSHJ P,PLDCM
5800         MOVEI A,0
5801         DPB A,[400300,,BKBUF]
5802 LIB5:   AOS LDCCC
5803 CCASM1: JRST ASSEM1
5804 \f
5805 ;.GLOBAL, .SCALAR, .VECTOR
5806 ;LH(B) HAS ILGLI, ILVAR, ILVAR+ILFLO RESPECTIVELY.
5807
5808 A.GLOB: NOVAL
5809         HLLZ LINK,B     ;REMEMBER WHICH OF THE THREE PSEUDO'S THIS IS.
5810 A.GLO2: MOVE A,GLSPAS
5811         MOVEM A,GLSP1
5812         SETOM FLDCNT
5813         PUSHJ P,GETSLD  ;GET NAME
5814          JRST MACCR     ;NO NAME => DONE
5815         CALL ES
5816          JRST A.GLO1
5817         CAIE A,PSUDO_-14.
5818          JRST A.GLO1
5819         JSP B,GVPSEU    ;TRYING TO .GLOBAL A PSEUDO => TYPE APPRO. ERR MSG AND RETURN.
5820         JRST A.GLO2     ;DON'T DO ANYTHING TO IT; MOVE ON TO NEXT ARG.
5821
5822 A.GLO1: IOR I,LINK      ;SET THE GLOBAL FLAG OR THE VARIABLE FLAG.
5823         TLNE LINK,ILFLO ;FOR .VECTOR, SAVE # VARS CREATED BEFORE CREATING THIS ONE.
5824          SAVE VARCNT    ;SO WE CAN TELL IF THIS CALL TO GETVAL ACTUALY CREATES IT.
5825         PUSHJ P,GETVAL  ;NOW GET VALUE (CLOBBERS SQUOZE FLAGS)
5826          CAIA
5827           HALT
5828         TLNN LINK,ILFLO
5829          JRST A.GLO2
5830         SAVE LINK       ;.VECTOR - READ THE SIZE.
5831         TLO FF,FLUNRD   ;RE-READ THE TERMINATOR AFTER THE SYM, SO "FOO(1)" AND "FOO," WIN
5832         MOVE SYM,[SQUOZE 0,.VECTOR]
5833         CALL AGETFD
5834         REST LINK
5835         REST B          ;GET PREV. VARCNT, SO WE CAN SEE IF IT WAS INCREMENTED.
5836         TRNN A,-1       ;MAKE (N) WORK AS SIZE BY USIN L.H. IF R.H. IS 0.
5837          HLRZS A
5838         SKIPE A
5839          MOVEM A,VECSIZ ;IF NONZERO SIZE SPEC'D, USE IT AND SET DEFAULT.
5840         MOVE A,VECSIZ   ;ELSE USE THE DEFAULT.
5841         SUBI A,1        ;1 WORD WAS ALLOCATED BY GETVAL - HOW MANY MORE WANTED?
5842         CAME B,VARCNT   ;(MAYBE SYM ALREADY DEFINED, MAYBE PASS2, ...)
5843          ADDM A,VARCNT  ;IF GETVAL REALLY ALLOCATED THE SPACE THIS TIME, ALLOCATE THE
5844         JRST A.GLO2     ;RIGHT AMOUNT.
5845
5846                 ;.LOP
5847
5848 A.LOP:  NOVAL ? NOABS
5849         PUSHJ P,EBLK    ;TERMINATE CURRENT BLOCK
5850         REPEAT 3,PUSHJ P,RGETFD ;GET THE FIELDS
5851         MOVEI A,LD.OP
5852         PUSHJ P,PLDCN
5853         JRST ASSEM1
5854
5855                 ;.LIBRQ
5856
5857 A.LIBRQ:        NOVAL ? NOABS
5858 A.LBR1: PUSHJ P,GETSLD
5859          JRST MACCR
5860         PUSHJ P,PBITS7
5861         MOVEI A,3
5862         PUSHJ P,PBITS
5863         TLO SYM,40000
5864         PUSHJ P,OUTSM
5865         JRST A.LBR1
5866 \f
5867 A.LNKOT:        AOS (P) ;THIS PSEUDO RETURNS NO VALUE.
5868         NOVAL
5869
5870 AEND5:  JUMPGE FF,CPOPJ ;IGNORE FOLLOWING ON NOT PUNCHING PASS
5871         MOVE D,SYMAOB
5872 AEND5A: MOVE SYM,ST(D)
5873         LDB T,[400400,,SYM]
5874         CAIE T,DEFLVR_-14.
5875         CAIN T,DEFGVR_-14.
5876         JRST AEND5E
5877         CAIE T,LCUDF_-14.
5878         CAIN T,GLOEXT_-14.
5879         JRST AEND5B
5880 AEND5C: ADD D,WPSTE1
5881         AOBJN D,AEND5A
5882         POPJ P,
5883
5884 AEND5E: 3GET C,D
5885         TLNN C,3LLV
5886         JRST AEND5C
5887 AEND5B: HLLZ B,ST+1(D)
5888         3GET C,D
5889         TLNN C,3RLNK
5890         JUMPE B,AEND5C
5891         TLZ SYM,740000
5892         CAIE T,LCUDF_-14.
5893         CAIN T,DEFLVR_-14.
5894         SKIPA
5895         TLO SYM,40000
5896         PUSHJ P,LKPNRO
5897         HRRZS ST+1(D)   ;CLEAR OUT LIST HEAD POINTER.
5898         TLZ C,3RLNK     ;INDICATE NO LIST.
5899         3PUT C,D
5900         JRST AEND5C
5901
5902                 ;PUNCH OUT COMPLETE LOADER COMMAND, PUNCHING OUT WRD AS ONLY CONTENTS
5903
5904 PLDCM:  PUSH P,LINK     ;SAVE LINK FOR ALOC AND FRIENDS (CLOBBERS OTHER AC'S)
5905         PUSH P,A        ;SAVE LOADER COMMAND TYPE
5906         PUSHJ P,EBLK    ;TERMINATE PREV BLOCK, MAKING SURE LOADER KNOWS $.
5907         PUSHJ P,PWRDA   ;PUNCH OUT THE WORD
5908         POP P,A         ;GET BACK LOADER COMMAND TYPE FOR PLDCN
5909         PUSHJ P,PLDCN   ;OUTPUT THE RESULTING BLOCK
5910 PLINKJ: POP P,LINK      ;RESTORE LINK
5911         POPJ P,
5912
5913 PLDCN:  HRRM A,BKBUF    ;STORE LOADER COMMAND TYPE IN BKBUF HEADER
5914         MOVEI A,LLDCM   ;LOADER COMMAND BLOCK TYPE
5915         DPB A,[310700,,BKBUF]   ;STORE BLOCK TYPE IN HEADER
5916         TRO FF,FRLOC    ;MAKE EBLK OUTPUT BLOCK EVEN IF EMPTY
5917         JRST EBLK
5918
5919 ;.RELP <ARG> RETURNS RELOCATION OF ARG
5920 A.RELP: CALL AGETFD
5921         MOVE A,B
5922         JRST VALRET
5923
5924 ;.ABSP <ARG> RETURNS ABSOLUTE PART OF ARG.
5925 A.ABSP: CALL AGETFD
5926         JRST VALRET
5927
5928 ;.RL1 IN RELOCATABLE ASSEMBLY RETURNS ZERO WITH RELOCATION FACTOR ONE.
5929 ;IN ABSOLUTE ASSEMBLY, IT RETURNS JUST ZERO.
5930 ;IFN <.RELP .RL1>, IS A TEST FOR A RELOCATABLE ASSEMBLY.
5931 A.RL1:  SKIPGE A,CONTRL
5932          TRNE A,DECREL\FASL
5933           SKIPA B,[1]
5934            SETZ B,
5935         SETZ A,
5936         RET
5937 \f
5938 AEND:   NOVAL
5939         SKIPE ASMOUT    ; ERROR IF IN GROUPING.
5940          JSP LINK,CONFLM        ;FLUSH CONSTANTS, GIVE ERROR MSG.
5941         SKIPE SCNDEP    ;IF THERE ARE UNTERMINATED SUCCESSFUL
5942          CALL AENDM1    ;CONDITIONALS, MENTION THEM.
5943         MOVE A,BKCUR
5944         CAIE A,BKWPB    ;NOT IN .MAIN BLOCK => ERROR.
5945          ETR ERRUMB
5946         MOVE A,CDISP
5947         TLNN A,DWRD
5948          TLO FF,FLUNRD  ;IF LAST TERM. WAS WORD TERM., RE-READ.
5949 IFN LISTSW,[
5950         MOVE A,[440700,,LISTBF]
5951         EXCH A,PNTBP
5952         MOVEM A,LISTTM
5953 ]
5954         PUSHJ P,AVARI0
5955         PUSHJ P,CNSTN0
5956         SKIPL A,CONTRL
5957          PUSHJ P,AEND5  ;RELOCATABLE => .LNKOT
5958         SKIPGE A,CONTRL
5959          TRNN A,DECREL
5960           JRST AEND6
5961         MOVE A,CLOC     ;IN DEC FMT, UPDATE HIGHEST ADDR SEEN,
5962         SKIPN CRLOC     ;UPDATE EITHER THE HIGHEST ABS ADDR
5963          JRST [ CAML A,DECBRA
5964                  MOVEM A,DECBRA
5965                 JRST AEND6]
5966         CAML A,DECTWO   ;OR THE HIGHEST REL ADDR IN THE
5967          JRST [ CAML A,DECBRH   ;APPROPRIATE SEG.
5968                  MOVEM A,DECBRH
5969                 JRST AEND6]
5970         CAML A,DECBRK
5971          MOVEM A,DECBRK
5972 AEND6:  JUMPL FF,AEND1  ;ON PUNCHING PASS, SPECIAL STUFF
5973         PUSHJ P,GETWRD  ;OTHERWISE EAT UP WORD,
5974         JRST RETURN     ;AND RETURN
5975
5976 AEND1:  PUSHJ P,EBLK
5977 IFN LISTSW,[
5978         SKIPGE LISTPF
5979          PUSHJ P,PNTR
5980         MOVE A,LISTTM
5981         MOVEM A,PNTBP
5982 ]
5983         MOVE SYM,[SQUOZE 0,END]
5984         TLZ I,ILWORD
5985         PUSHJ P,AGETWD
5986 IFN LISTSW,[
5987         MOVEM A,LISTWD
5988         MOVEM B,LSTRLC
5989         SETOM LISTAD
5990         SETOM LISTPF
5991         SKIPE LSTONP
5992         PUSHJ P,PNTR
5993         SKIPE LISTP
5994          PUSHJ P,LPTCLS ;DONE LISTING
5995         MOVE A,LISTWD
5996 ] ;END IFN LISTSW,
5997         SKIPL B,CONTRL
5998          JRST AEND3     ;RELOCATABLE
5999 IFN FASLP,[
6000         TRNE B,FASL
6001          JRST FASEN     ;FASL FORM
6002 ]
6003         TRNN B,DECREL   ;IF DEC FORMAT,
6004          JRST AEND1A
6005         TLNN I,ILWORD   ;THEN IF THERE7S A STARTING ADDRESS,
6006          JRST AEND2
6007         MOVSI A,DECSTA  ;OUTPUT START-ADDRESS BLOCK.
6008         PUSHJ P,DECBLK
6009         PUSHJ P,PWRD
6010         PUSHJ P,EBLK
6011         JRST AEND2
6012
6013 IFN FASLP,[
6014 FASEN:  JRST AEND2
6015 ]
6016
6017 AEND3:  HRRZ A,CLOC
6018         HRRM A,BKBUF    ;SET UP PROGRAM BREAK JUST IN CASE OUTPUTTING MORE NULL DATA BLOCKS
6019         MOVEI A,LCJMP
6020         PUSHJ P,PLDCM
6021         JRST AEND2
6022
6023 AEND1A: TLNN A,777000   ;CHECK INSTRUCTION PART
6024          TLO A,(JRST)   ;INSTRUCTION PART 0; HE WANTS JRST
6025         PUSHJ P,PPB
6026         JUMPG A,.+3
6027          ETR [ASCIZ /Start instruction negative/]
6028         HRLI A,(JRST)   ;END SYMTAB WITH POSITIVE WORD
6029         MOVEM A,STARTA  ;SAVE FOR PUNCHOUT AT END OF SYMTAB
6030         PUSHJ P,FEED1
6031 AEND2:  PUSH P,[RETURN]
6032 CNARTP:
6033 IFN DECSW,[
6034         SAVE TTYFLG
6035         SKIPE CCLFLG    ;IN DEC VERSION, IF RUN BY CCL, DON'T PRINT
6036          AOS TTYFLG     ;THIS STUFF ON THE TTY - ONLY IN ERROR FILE AND LISTING.
6037         CALL CNTPD
6038         REST TTYFLG
6039         RET
6040
6041 CNTPD:
6042 ]
6043         MOVNI D,1
6044         MOVEI TT,PCNTB
6045 CNTP1:  CAML TT,PBCONL
6046          RET
6047         HRRZ B,1(TT)
6048         HLRZ A,1(TT)
6049         CAMN A,B
6050          JRST CNTP2
6051         AOSN D
6052          TYPR [ASCIZ /Constants area inclusive
6053 From    To
6054 /]
6055         LDB B,[.BP (CGBAL),2(TT)]
6056         SKIPE B
6057          TYPR [ASCIZ /Global+/]
6058         HRRZ B,1(TT)
6059         PUSHJ P,OCTPNT
6060         PUSHJ P,TABERR
6061         HLRZ B,1(TT)
6062         SOS B
6063         PUSHJ P,OCTPNT
6064         PUSHJ P,CRRERR
6065 CNTP2:  ADDI TT,3
6066         JRST CNTP1
6067
6068 AENDM1: TYPR [ASCIZ /Unterminated successful bracketed conditionals
6069 The first was at /]
6070         AOS A,CONDPN
6071         CALL DPNT
6072         MOVEI A,"-
6073         CALL TYOERR
6074         AOS A,CONDLN
6075         CALL D3PNT2
6076 IFN TS,[
6077         TYPR [ASCIZ/ of file /]
6078         MOVE B,CONDFI
6079         CALL SIXTYO
6080 ]
6081         JRST CRRERR
6082
6083 \f
6084 AXWORD: CALL XGETFD     ;READ 1ST FIELD,
6085         TLNE I,ILMWRD
6086          CALL IGTXT     ;SOAK UP REST OF TEXT PSEUDO.
6087         HRLM A,WRD
6088         HRLM B,WRDRLC
6089         MOVSI C,HFWDF
6090         MOVSI B,SWAPF
6091         PUSHJ P,LNKTC1
6092         PUSH P,GLSP1
6093         CALL XGETFD     ;NOW THE SECOND FIELD
6094         HRRM A,WRD
6095         HRRES B
6096         ADDM B,WRDRLC
6097         MOVSI C,HFWDF
6098         MOVEI B,0
6099         POP P,T
6100         PUSHJ P,LINKTC
6101         JRST CABPOP
6102
6103 A.NTHWD:        CALL AGETFD     ;READ THE NUMBER OF THE WORD WE WANT.
6104         SOJL A,CABPOP           ;NEGATIVE OR 0 => RETURN 0.
6105         SOJL A,A.1STWD          ;1 => TURN INTO .1STWD.
6106                         ;ELSE SKIP APPRO. # OF WORDS, THEN DO .1STWD.
6107
6108 A.NTH1: SAVE A
6109         SAVE WRD
6110         CALL XGETFD
6111         TLZ FF,FLUNRD
6112         REST WRD
6113         REST A
6114         TLNN I,ILMWRD
6115          JRST CABPOP            ;IF STRING ENDS BEFORE DESIRED WORD, RETURN 0.
6116         SOJGE A,A.NTH1
6117
6118 A.1STWD:        CALL XGETFD     ;GET THE 1ST WD OF FOLLOWING TEXT PSEUDO,
6119         CALL IGTXT      ;THROW AWAY THE REST.
6120         MOVE T,A        ;RETURN THE VALUE
6121         JRST TEXT5      ;COMPLAINING IF FOLLOWED IMMEDIATELY BY SYLLABLE.
6122
6123 A.LENGTH:       CALL PASSPS
6124         PUSH P,[0]
6125         PUSH P,A
6126 A.LN1:  PUSHJ P,RCH
6127         AOS -1(P)
6128         CAME A,(P)
6129         JRST A.LN1
6130         SOS A,-1(P)
6131         SUB P,[2,,2]
6132         JRST VALRET     ;RETURN VALUE IN T
6133
6134 ARDIX:  NOVAL
6135         PUSHJ P,AGETFD          ;GET FIELD ARG
6136         MOVEM A,ARADIX
6137         JRST MACCR      ;RETURN WITHOUT CLOBBERING CURRENT VALUE
6138
6139 A.RADIX:        CALL AGETFD     ;READ THE TEMP. RADIX.
6140         SAVE ARADIX     ;LAMBDABIND RADIX TO THAT VALUE.
6141         MOVEM A,ARADIX
6142         CALL XGETFD     ;READ IN THE NEXT FIELD USING THAT RADIX.
6143         REST ARADIX
6144         JRST VALRET
6145 \f
6146 ;READ A BIT-MASK AS ARG, RETURN THE LH OF BP. FOR THAT BYTE.
6147 A.BP:   CALL YGETFD
6148         MOVEI C,SPACE
6149         SKIPE CDISP     ;IF ARG WAS ENDED BY A COMMA, TURN IT INTO A SPACE
6150          HRRM C,CDISP   ;SO THAT .BP FOO,BAR USES THE FLD SPACE FLD FORMAT.
6151         JUMPE A,VALR1
6152         SAVE A
6153         JFFO A,.+2
6154          MOVEI B,36.
6155         EXCH B,(P)      ;(P) HAS # LEADING ZEROS.
6156         MOVN A,B
6157         AND A,B         ;A HAS ONLY THE LOW BIT OF THE BYTE.
6158         JFFO A,.+2
6159          MOVNI B,1      ;B HAS 35.-<# TRAILING ZREROS.>
6160         MOVEI A,1(B)
6161         SUB A,(P)       ;A HAS SIZE OF BYTE
6162         LSH A,30        ;PUT IN S FIELD OF BP.
6163         SUB P,[1,,1]
6164         MOVNS B
6165         ADDI B,35.      ;B HAS # TRAILING ZEROS.
6166         DPB B,[360600,,A] ;PUT THAT IN P FIELD OF BP.
6167         JRST VALR1
6168
6169 ;READ IN BP, RETURN BIT MASK TO SPEC'D BYTE.
6170 ;THE ARG SHOULD BE JUST THE LH OF A BP, WHICH MAY BE IN EITHER HALF OF THE ARG.
6171 A.BM:   CALL GETBPT     ;READ IN A BYTE POINTER ARG, IN A, POINTING AT T.
6172         SETZ T,
6173         SETO C,
6174 A.DPB1: DPB C,A         ;PUT 1'S IN SPEC'D PART OF ACCUM T
6175         MOVE A,T
6176         JRST VALRET
6177
6178 ;READ IN A BYTE POINTER (REALLY JUST S AND P FIELDS) AND MAKE POINT AT AC T.
6179 ;RETURN IT IN AC A.
6180 GETBPT: CALL YGETFD
6181         TLNN A,-1       ;IF ARG ISN'T IN LH, USE RH.
6182         HRLI A,(A)
6183         TLZ A,77        ;MAKE BP. -> AC T
6184         HRRI A,T
6185         RET
6186
6187 ;RETURN # TRAILING ZEROS IN ARGUMENT.
6188 A.TZ:   CALL YGETFD
6189         MOVN B,A
6190         AND A,B         ;A HAS JUST LOW BIT OF ARG SET.
6191         JFFO A,.+2
6192          MOVNI B,1      ;# OF ZEROS BEFORE LOW BIT =
6193         MOVN A,B        ;35. - <# TRAILING ZEROS>
6194         ADDI A,35.
6195         JRST VALRET
6196
6197 ;RETURN # LEADING ZEROS IN ARG.
6198 A.LZ:   CALL YGETFD
6199         JFFO A,.+2
6200          MOVEI B,36.
6201         MOVE A,B
6202         JRST VALRET
6203
6204 ;.DPB STUFF,BP,WORD DOES A DPB OF STUFF INTO THE FIELD OF WORD SPEC'D BY BP,
6205 ;RETURNING THE RESULTING WORD.
6206 A.DPB:  CALL YGETFD     ;READ STUFF.
6207         SAVE A
6208         CALL GETBPT     ;READ BP AND TURN INTO ACTUAL BP POINTING AT T
6209         SAVE A
6210         CALL YGETFD     ;READ IN WORD AND PUT IN T.
6211         MOVE T,A
6212         REST A          ;A HAS BP
6213         REST C          ;C HAS STUFF
6214         JRST A.DPB1     ;GO DO THE DEPOSIT AND RETURN THE ALTERED WORD.
6215
6216 ;.LDB BP,WORD RETURNS THE CONTENTS OF THE BYTE IN WORD SELECTED BY BP
6217 A.LDB:  CALL GETBPT
6218         SAVE A
6219         CALL YGETFD
6220         MOVE T,A
6221         REST A
6222         LDB A,A
6223         JRST VALRET
6224 \f
6225 AWORD:  NOVAL
6226         PUSHJ P,EBLK
6227         PUSHJ P,GETWRD  ;ON UNDEFINED SYM, WYB UNDEFINED SYM IN "WORD"?
6228         PUSHJ P,PPB
6229         JRST ASSEM1
6230
6231 ;.BIND - MAKE SYMS BE DEFINED IN CURRENT (SPEC'D) BLOCK. LH(B) HAS 0.
6232 ;.KILL - FULLY KILL THE SYMS.LH(B) HAS 3KILL.
6233 ;.HKILL - HALFKILL THEM. LH(B) HAS 3SKILL.
6234 ;.XCREF - PREVENT CREFFING OF SYMS. LH(B) HAS 3NCRF.
6235 ;.DOWN - SET 3DOWN, MAKING SYM VISIBLE IN SUBBLOCKS IN 1 PASS ASSEMBLY.
6236 A.KILL: NOVAL
6237         HLLZ LINK,B     ;REMEMBER BIT TO SET.
6238 A.KIL1: CALL GETSLD     ;READ NEXT SYMBOL NAME.
6239          JRST MACCR     ;NO MORE, EXIT.
6240         SKIPE LINK      ;EXCEPT FOR .BIND, DO NOTHING ON PASS 1.
6241          JUMPGE FF,A.KIL1
6242         CALL ESDEF      ;DEFINE THE SYMBOL, D HAS STE IDX.
6243          JRST A.KIL2    ;SYMBOL NEVER SEEN.
6244         IORM LINK,ST+2(D)       ;SET THE BIT IN 3RDWRD..
6245         IOR C,LINK      ;(IF .XCREF, PREVENT CREFFING THIS TIME)
6246 IFN CREFSW,XCT CRFINU   ;CREF THE SYMBOL
6247         JRST A.KIL1
6248
6249 A.KIL2: MOVSI T,LCUDF   ;SYMBOL UNDEFINED, MAKE UNDEF LOCAL.
6250         IOR C,LINK      ;WITH THE DESIRED BIT SET.
6251         TLO C,3MACOK    ;SHOULDN'T BE ERROR IF IT BECOMES MACRO.
6252         CALL VSM2
6253 IFN CREFSW,XCT CRFINU
6254         JRST A.KIL1
6255
6256 ;EXPUNG SYM1,SYM2 ... ;UNDEFINE THOSE SYMS.
6257 AEXPUNG:        NOVAL
6258 AEXPU2: PUSHJ P,GETSLD  ;GET NAME
6259          JRST MACCR     ;NO MORE NAMES
6260         SAVE [AEXPU2]   ;AFTER THIS SYM, POPJ TO READ ANOTHER.
6261 ;EXPUNGE 1 SYMBOL, SQUOZE IN SYM.
6262 AEXPU1: PUSHJ P,ES
6263         JFCL            ;NOT FOUND, DON'T COMPLAIN, JUST CREF.
6264 IFN CREFSW,XCT CRFDEF
6265         HRLZI T,400000  ;EXPUNGED ZERO SYM
6266         SKIPE ST(D)
6267         MOVEM T,ST(D)
6268         SKIPL CONTRL    ;IF RELOCATABLE ANDLOCAL SYMBOL,
6269         CAIL A,DEFGVR_-33.
6270          RET
6271         TRO I,IRCONT    ;Don't end block between the two words
6272         PUSHJ P,PBITS7  ;TELL STINK TO EXPUNGE SYM.
6273         MOVEI A,CLGLO
6274         PUSHJ P,PBITS
6275         TLO SYM,400000  ;SAY IS NEW TYPE RQ,
6276         PUSHJ P,OUTSM0
6277         MOVSI A,400000  ;NEW NAME NULL => DELETE.
6278         TRZ I,IRCONT
6279         JRST $OUTPT
6280 \f
6281 ;EQUAL SYM1,SYM2        ;DEFINE SYM1 SAME AS SYM2.
6282 AEQUAL: NOVAL
6283         PUSHJ P,GETSLD
6284          ETR ERRTFA
6285         SAVE SYM        ;REMEMBER SYM NAME AND BLOCK TO DEF. IN.
6286         SAVE ESBK
6287         PUSHJ P,GETSLD
6288          ETR ERRTFA
6289 IFN CREFSW,XCT CRFINU   ;CREF SYM DEFINED AS.
6290         CALL ES         ;LOOK UP SYM TO EQUATE TO.
6291          JRST [ REST ESBK       ;NOT FOUND => EXPUNGE THE 1ST SYM.
6292                 REST SYM
6293                 JRST AEXPU1]
6294         REST ESBK
6295         REST SYM
6296 IFN CREFSW,XCT CRFDEF
6297         SAVE A
6298         SAVE B          ;SAVE INFO ON VALUE OF SYM TO EQUATE TO.
6299         SAVE C
6300         CALL ESDEF
6301          MOVEM SYM,ST(D)
6302         REST B          ;3RDWRD OF 2ND SYMBOL.
6303         REST ST+1(D)    ;(WHAT WAS PUSHED FROM B)
6304         REST A
6305         DPB A,[400400,,ST(D)]
6306         TLZ C,3DFCLR    ;SAVE OLD 3MAS, 3NCRF OF 1ST SYMBOL (AND ITS BLOCK #).
6307         AND B,[3DFCLR,,] ;SET REST OF 3RDWRD BITS FROM 2ND SYMBOL.
6308         IOR B,C
6309         3PUT B,D
6310         JRST MACCR
6311
6312 ERRTFA: ASCIZ /Too few args - EQUAL/
6313
6314 ;.SEE SYM1,SYM2,...     ;CREF THOSE SYMS.
6315 A.SEE:  CALL GETSLD     ;READ 1 SYMBOL.
6316          JRST MACCR     ;NONE TO BE READ.
6317 IFN CREFSW,[
6318         SKIPN CRFONP    ;IF CREFFING,
6319          JRST A.SEE
6320         CALL ES
6321          MOVEI A,SYMC_-33.
6322         XCT CRFINU      ;CREF THE SYMBOL.
6323 ]
6324         JRST A.SEE
6325 \f
6326                 ;UUO HANDLING ROUTINE
6327                 ;41 HAS JSR ERROR
6328
6329 VBLK
6330 IFE ITSSW,ERRTTL:       0       ; NUMBER OF ERRORS HIT
6331 ERRCCT: 0       ;NUM CHARS OUTPUT ON LINE, FOR MAKING MSGS LINE UP.
6332 ERRJPC: 0       ;JPC READ WHEN UUO.
6333 ERROR:  0
6334 IFN TS, .SUSET [.RJPC,,ERRJPC]
6335         JRST ERRH       ;GO HANDLE IT
6336 PBLK
6337 ERRH:   PUSH P,T
6338         PUSH P,B        ;NOT TYPR => ERROR OF SOME KIND
6339         PUSH P,A
6340         SAVE C
6341         LDB T,[331100,,40]      ;PICK UP OP CODE
6342         CAIN T,TYPR_-33 ;TYPR?
6343         JRST TYPR1      ;YES
6344                 ;ERROR OF SOME KIND
6345         CAIE T,ETASM_-33        ;CHECK FOR SPECIAL LOSSAGES AT COLON
6346          CAIN T,ETSM_-33
6347           CAME SYM,SYSYM        ;ARE WE ABOUT TO MENTIO THIS LOSING LABEL AS THE LAST ONE?
6348            JRST ERRH1
6349         MOVE T,SYSYM1
6350
6351         MOVEM T,SYSYM   ;COLON LOSSAGE, DE-MUNG TAG WORDS FOR PRINTOUT
6352         MOVE T,SYLOC1
6353         MOVEM T,SYLOC
6354 ERRH1:
6355 IFN TS,[
6356 IFN LISTSW,[
6357         CALL PNTR       ;FORCE OUT BUFFERED LISTING OUTPUT
6358         CALL PNTCRR     ;AND CR, SO USER CAN SEE WHERE ERROR WAS.
6359 ]
6360         PUSHJ P,ERRTFL  ;IF NOT SAME FILE AS LAST, PRINT FILE NAME.
6361 ]
6362         SETZM ERRCCT
6363 IFE ITSSW,[
6364         AOS ERRTTL      ; BUMP ERROR TOTAL
6365 IFE SAILSW,AOS .JBERR   ; BUMP ERROR MESSAGE COUNTER FOR LOADER TO ABORT
6366 .ELSE AOS JOBERR
6367 ] ; IFE ITSSW
6368         MOVE A,SYSYM    ;GET LAST TAG DEFINED
6369         JUMPE A,ERR1    ;SKIP PRINTOUT IF NONE THERE
6370         PUSHJ P,SYMTYP  ;THERE, TYPE IT OUT
6371         MOVE B,CLOC     ;NOW GET CURRENT LOCATION
6372         SUB B,SYLOC     ;SUBTRACT VALUE OF LAST TAG
6373         JUMPE B,ERR1    ;SKIP NUMERIC PRINTOUT IF RIGHT AT TAG
6374         MOVEI A,"+      ;NOT AT TAG,
6375         PUSHJ P,TYOERR  ;TYPE OUT PLUS SIGN,
6376         AOS ERRCCT      ;(1 MORE CHAR TYPED)
6377         PUSHJ P,OCTPNT  ;THEN TYPE OUT DIFFERENCE IN OCTAL
6378 ERR1:   PUSHJ P,TABERR  ;NOW SEPARATE WITH TAB
6379         MOVE A,ERRCCT
6380         CAIGE A,8       ;MAKE SURE MOVE TO COLUMN 16.
6381         PUSHJ P,TABERR
6382         MOVEI B,[ASCIZ/GL+/]
6383         SKIPGE GLOCTP   ;LOCATION GLOBAL?
6384         PUSHJ P,TYPR3   ;YES, TYPE OUT THAT FACT.
6385         MOVE B,CLOC     ;GET CURRENT LOCATION
6386         PUSHJ P,OCTPNT  ;TYPE OUT IN OCTAL
6387 ;DROPS THROUGH
6388 \f
6389 ;DROPS THROUGH.
6390         PUSHJ P,TABERR
6391         MOVE A,MDEPTH   ;NOW DEPTH IN MACRO (NOT IRP, REPEAT, ETC.) EXPANSIONS
6392         MOVSI T,-2
6393         CALL DPNT0      ;PRINT, IN 2-CHAR FIELD.
6394         MOVEI A,".
6395         CALL TYOERR     ;(USED TO BE OCTAL)
6396         MOVE A,CPGN     ;CURRENT PAGE NUMBER (FIRST PAGE OF FILE => 0)
6397         PUSHJ P,[AOJA A,D6PNT]  ;TYPE IT OUT IN DECIMAL
6398         MOVEI A,"-
6399         CALL TYOERR
6400         MOVE A,CLNN     ;ALSO CURRENT LINE NUMBER
6401         PUSHJ P,[AOJA A,D3PNT2]
6402         PUSHJ P,TABERR
6403         MOVEI A,48.     ;ASSUME ALL THE STUFF WE'VE PRINTED TAKES 48. CHARS
6404         MOVEM A,ERRCCT  ;MAYBE SOMEDAY TABERR, ETC. WILL REALLY UPDATE ERRCCT PROPERLY.
6405         LDB A,[331100,,40]      ;PICK UP OP CODE AGAIN
6406         CAIGE A,8       ;ERROR UUO MAX
6407          JRST .+1(A)
6408         JRST [HALT ? JRST .-1]  ;OPCODE 0, OR TOO BIG.
6409         JRST ERRSM      ;ETSM => TYPE SYM AND MESSAGE.
6410         JRST ERRR       ;ETR => JUST PRINT MESSAGE
6411         JRST ERRJ       ;ERJ => RH(40) HAS JUMP ADR
6412         JRST ERRI       ;ETI => IGNORE LINE RET TO ASSEM1
6413         JRST ERRA       ;ETA => RET TO ASSEM1
6414         JRST ERRASM     ;ETASM => TYPE SYM AND GO TO ASSEM1
6415         JRST IAE        ;ERF => FATAL.
6416
6417 ERRJ:   MOVE A,40       ;ERJ => RH(40) HAS JUMP ADR
6418         HRRM A,ERROR
6419         JRST ERRET1
6420
6421 ERRI:   PUSHJ P,RCH     ;ETI => IGNORE LINE, RETURN TO ASSEM1: EAT UP LINE
6422         CAIE A,12
6423         JRST .-2
6424 ERRA:   MOVEI A,ASSEM1  ;ETA => RETURN TO ASSEM1, DON'T TYPE SYM.
6425         MOVEM A,ERROR
6426         JRST ERRR
6427
6428 ERRASM: MOVEI A,ASSEM1  ;ETASM => TYPE SYM AND RETURN TO ASSEM1
6429         MOVEM A,ERROR
6430 ERRSM:  MOVEI C,56.     ;ETSM OR ETASM => TYPE OUT SYM THEN MESSAGE
6431         CALL TYPE37     ;CR NOW IF WHOLE MSG WON'T FIT ON ONE LINE.
6432         MOVE A,SYM
6433         PUSHJ P,SYMTYP
6434         PUSHJ P,TABERR
6435 ERRR:   CALL TYPE40     ;TYPE THE ERROR MESSAGE.
6436 ERRET1: REST C
6437         POP P,A         ;COMMON RETURN POINT FROM UUOS
6438         POP P,B
6439         POP P,T
6440         JRST 2,@ERROR
6441 \f
6442 ;FINISH UP AN ERROR UUO'S ERROR MESSAGE.  PRINT THE SPECIFIED STRING
6443 ;AND ALSO "IN DEFINE AT ..." IF NECESSARY, ALONG WITH APPROPRIATE CR'S.
6444 TYPE40: MOVE C,ERRCCT
6445         CALL TYPE37
6446         CALL TYPR4      ;PRINT THE ASCIZ STRING
6447         CALL CRRERR
6448         SKIPN A,DEFNPS  ;IF INSIDE A LONG PSEUDO,
6449          RET
6450         MOVE A,DEFNLN
6451         MOVE B,DEFNPN
6452         CAMN A,CLNN     ;WHICH DIDN'T START IN THIS VERY LINE,
6453          CAME B,CPGN
6454           JRST TYPE42
6455         MOVE A,DEFNFI
6456         CAMN A,INFFN1
6457          JRST TYPE43
6458 TYPE42: MOVEI B,[ASCIZ/ in /]
6459         CALL TYPR3
6460         MOVE A,DEFNPS
6461         CALL SYMTYP     ;SAY WHAT PSEUDO, AND WHERE IT STARTED.
6462         MOVEI B,[ASCIZ/ Starting at /]
6463         CALL TYPR3
6464         MOVE A,DEFNPN   ;PAGE # -1.
6465         CALL [AOJA A,DPNT] ;PRINT PAGE #.
6466         MOVEI A,"-
6467         CALL TYOERR
6468         AOS A,DEFNLN
6469         CALL D3PNT2     ;PRINT LINE #.
6470 IFN TS,[
6471         MOVE B,DEFNFI   ;PRINT FILE NAME IF IT ISN'T THE CURRENT FILE.
6472         CAMN B,INFFN1
6473          JRST TYPE41
6474         MOVEI B,[ASCIZ/ of file /]
6475         CALL TYPR3
6476         MOVE B,DEFNFI
6477         CALL SIXTYO
6478 ]
6479 TYPE41: CALL CRRERR     ;AND CRLF.
6480 TYPE43: MOVE A,ERROR
6481         CAIN A,ASSEM1   ;IF THIS ERROR IS EXITING THE PSEUDO,
6482          SETZM DEFNPS   ;SAY WE'RE NOT IN IT ANY MORE.
6483         RET
6484
6485 ;JSP TM,ERMARK  IN A PSEUDO, TO ARRANGE FOR ERROR MESSAGES TO MENTION
6486 ;THAT PSEUDO.  SYM SHOULD CONTAIN THE NAME OF THE PSEUDO.
6487 ;PUSHES A WORD ON THE STACK SO THAT WHEN THE PSEUDO RETURNS DEFNPS WILL BE CLEARED.
6488 ;IF DEFNPS IS SET UP ALREADY, DOES NOTHING (DOESN'T SET DEFNPS; DOESN'T PUSH THE WORD)
6489 ERMARK: SKIPE DEFNPS
6490          JRST (TM)
6491         MOVEM SYM,DEFNPS
6492         MOVE SYM,CLNN
6493         MOVEM SYM,DEFNLN
6494         MOVE SYM,CPGN
6495         MOVEM SYM,DEFNPN
6496         MOVE SYM,INFFN1
6497         MOVEM SYM,DEFNFI
6498         MOVE SYM,DEFNPS
6499         CALL (TM)
6500          CAIA
6501           AOS (P)
6502         SETZM DEFNPS
6503         RET
6504 \f
6505 ;C SHOULD HAVE CURRENT HORIZ POS.  IF TYPING THE STRING 40 POINTS AT
6506 ;WOULD OVERFLOW THE LINE, TYPE A CRLF AND TAB NOW ON THE TTY ONLY.
6507 TYPE37: HRRZ B,40
6508         HRLI B,440700   ;FIRST, FIGURE OUT HOW FAR ON LINE WE'LL TYPE IF WE DON'T CR.
6509         ILDB A,B
6510         CAIE A,         ;AND COUNT CHARS IN THE ERR MSG.
6511          AOJA C,.-2
6512         CAMGE C,LINEL
6513          RET
6514 CRRTBX: MOVEI A,10
6515         MOVEM A,ERRCCT  ;PREVENT THIS FROM BEING DONE TWICE.
6516         SKIPE TTYFLG
6517          RET
6518         MOVEI A,^M      ;IF THERE'S NO ROOM, CRLF ON THE TTY ONLY (NOT THE ERR FILE).
6519         PUSHJ P,TYOX
6520         MOVEI A,^J
6521         PUSHJ P,TYOX
6522         MOVEI A,^I
6523         JRST TYOX
6524
6525                 ;TYPE OUT SQUOZE (FLAGS OFF) IN A
6526
6527 SYMTYP: PUSHJ P,SQCCV   ;GET NEXT CHAR IN ASCII.
6528         AOS ERRCCT
6529         PUSHJ P,TYOERR  ;TYPE IT OUT.
6530         JUMPE B,CPOPJ   ;RETURN IF NOTHING LEFT (TYPED OUT AT LEAST ONE CHAR THOUGH)
6531         IMULI B,50      ;LEFT-JUSTIFY REMAINDER
6532         MOVE A,B        ;GET LEFT-JUSTIFIED REMAINDER IN A
6533         JRST SYMTYP     ;TYPE OUT REMAINDER OF SYM
6534
6535                 ;TYPE OUT SQUOZE CHARACTER (IN A)
6536
6537 SQCCV:  IDIV A,[50*50*50*50*50]
6538         CAIG A,10.
6539         SOJA A,SQCDTO   ;NUMBER (OR BLANK =>SLASH)
6540         CAIL A,45
6541         SKIPA A,SYTB-45(A)      ;SPECIAL
6542         ADDI A,"A-13    ;LETTER
6543         POPJ P,
6544
6545 SQCDTO: ADDI A,"0
6546         POPJ P,
6547
6548 SYTB:   ".
6549         "$
6550         "%
6551
6552 D3PNT2: MOVE T,[-3,,400000]     ;3 CHAR FIELD, NO ZERO SUPPRESSION.
6553         JRST DPNT0
6554
6555 DPNT:   TDZA T,T        ;ORDINARY DECIMAL PRINT.
6556 D6PNT:  MOVSI T,-6      ;6 CHAR FIELD, ZERO SUPPRESSION.
6557 DPNT0:  IDIVI A,10.
6558         HRLM B,(P)
6559         TRNE T,377777   ;IF NOT LAST DIGIT,
6560         TRNE T,400000   ;AND ZERO-SUPPR. WANTED,
6561          JRST DPNT2
6562         JUMPN A,DPNT2   ;IF THIS IS A LEADING 0,
6563         JUMPN B,DPNT2
6564         MOVEI B," -"0
6565         HRLM B,(P)      ;REPLACE WITH A SPACE.
6566 DPNT2:  AOBJN T,.+2     ;J IF NOT ENOUGH CHARS YET.
6567         JUMPE A,DPNT1   ;ENOUGH, DON'T MAKE MORE IF NOT NEEDED.
6568         CALL DPNT0
6569         JRST DPNT1
6570 \f
6571 ;TYPE HALFWORD IN B IN OCTAL.
6572 OCTPNT: HRRZ A,B
6573         IDIVI A,10
6574         HRLM B,(P)
6575         JUMPE A,.+2
6576         PUSHJ P,.-3
6577         AOS ERRCCT
6578 DPNT1:  HLRZ A,(P)
6579 ADGTYO: ADDI A,"0
6580         JRST TYOERR
6581
6582 ;TYPE OUT THE SIXBIT WORD IN B
6583
6584 SIXTYO: JUMPE B,CPOPJ
6585         MOVEI A,0
6586         ROTC A,6
6587         ADDI A,40
6588         PUSHJ P,TYOERR
6589         JRST SIXTYO
6590
6591                 ;TYPE CRLF
6592
6593 CRR:    MOVEI A,15
6594         PUSHJ P,TYO
6595         MOVEI A,12
6596         JRST TYO
6597
6598 ;OP CODE 0 => NO RECOVERY RETURN TO GO2
6599 IAE:    CALL TYPE40     ;PRINT THE ERROR MESSAGE.
6600         SKIPE ASMOUT
6601          JSP LINK,CONFLZ ;TELL USER ABOUT UNTERM. GROUPINGS.
6602         SKIPE SCNDEP    ;MENTION ANY UNTERMINATED SUCCESSFUL
6603          CALL AENDM1    ;CONDITIONALS.
6604 IFN ITSSW,.RESET TYIC,
6605         JRST GO2
6606
6607                 ;TYPR [ASCIZ /STRING/]  ;TYPE OUT STRING
6608
6609 TYPR1:  PUSH P,[ERRET1]
6610 TYPR4:  HRRZ B,40       ;GET ADR OF BEGINNING OF STRING
6611 TYPR3:  HRLI B,440700   ;CONVERT TO BYTE POINTER
6612 TYPR2:  ILDB A,B        ;GET NEXT CHAR
6613         JUMPE A,CPOPJ   ;JUMP IF ZERO, END OF STRING
6614         PUSHJ P,TYOERR  ;NON-ZERO, TYPE IT OUT
6615         JRST TYPR2
6616
6617 CRRERR: MOVEI A,^M      ;CRLF IN ERROR MESSAGE.
6618         CALL TYOERR
6619         SKIPA A,[^J]
6620 TABERR: MOVEI A,^I      ;TAB INN ERROR MESSAGE.
6621 TYOERR:
6622 IFN LISTSW,[
6623         SKIPE LSTTTY    ;OUTPUT TO LISTING UNLESS LSTTTY ZERO.
6624          CALL PILPTX
6625 ]
6626         SKIPG LSTTTY
6627          JRST TYO       ;TO TTY UNLESS LSTTTY POSITIVE.
6628         RET
6629 \f;OUTPUT-FORMAT SELECTING PSEUDOS:
6630
6631 ;.SLDR -- ON PASS 2, PUNCH OUT SBLK LOADER AND SELECT SBLK FORMAT
6632 A.SLDR: NOVAL
6633         JUMPGE FF,MACCR ;DO NOTHING ON PASS 1.
6634         PUSHJ P,FEED1   ;LEAVE LOTS OF BLANK PAPER TAPE FIRST
6635         PUSHJ P,PLOD1A  ;PUNCH OUT LOADER
6636 SIMBLK: MOVSI B,SBLKS   ;ENTRY FROM PS1, A.SLDR SELECT SBLK
6637         JRST SIMBL1
6638
6639 SRIM:   MOVE A,SYM      ;ENTRY FROM GETVAL, LH(B) HAS RH(CONTRL)
6640         SAVE B
6641         CALL SYMTYP
6642         TYPR [ASCIZ/ Encountered
6643 /]
6644         REST B
6645 SIMBL1: TRO FF,FRNPSS
6646         HRRI B,TRIV     ;SET UP TRIV FLAG FOR LH(CONTRL)
6647         MOVSS B
6648         CAME B,CONTRL   ;IF CHANGING MODES, END THE BLOCK IN THE OLD MODE
6649          CALL EBLK
6650         MOVE A,CONTRL   ;IF OLD MODE WAS RELOCATABLE OF SOME KIND,
6651         TRNN A,DECREL\FASL
6652          JUMPL A,SIMBL2
6653         SETZM CRLOC     ;INITIALIZE LOCATION COUNTER.
6654         MOVEI A,100
6655         MOVEM A,CLOC
6656 SIMBL2: MOVEM B,CONTRL  ;STORE NEW MODE.
6657         AOS (P)
6658
6659         ;ROUTINE TO SET VARIABLES FOR BENEFIT OF NED LOGIC
6660         ;CALLED BY OUTPUT SELECTING PSEUDOS
6661 OUTUPD: NOVAL
6662 IFN A1PSW,[
6663         TRNE FF,FRNPSS  ;IF PASS 1,
6664         TLNN FF,FLOUT
6665         JRST OUTCHK
6666         AOS OUTN1       ;INDICATE "OUTPUT" HAS OCCURED OTHER THAN IN 1PASS MODE
6667 OUTCHK: TLZE FF,FLOUT
6668         AOS OUTC        ;INDICATE "OUTPUT" HAS OCCURED DURING CURRENT ASSEMBLY
6669 ]
6670         RET
6671
6672 ANOSYMS:        NOVAL
6673         TRZ FF,FRSYMS
6674         JRST MACCR
6675
6676 A1PASS: PUSHJ P,OUTUPD
6677 A1PAS1: TLO FF,FLPPSS
6678         MOVEIM A.PPASS,1        ;SET .PPASS TO 1.
6679 IFN CREFSW,[    SKIPE CREFP     ;THIS NOW PUNCHING PASS,
6680         PUSHJ P,CRFON   ;MAYBE TURN ON CREFFING.
6681 ]
6682 IFN LISTSW,[
6683         SKIPE LISTP
6684          CALL LSTON     ;LIST NOW IF WANT LISTING AT ALL.
6685 ]
6686         MOVE A,CONTRL
6687         TRNE A,DECREL
6688          CALL DECPGN
6689         TRZA FF,FRNPSS
6690 ARELOC: PUSHJ P,OUTUPD
6691 ARELC1: PUSHJ P,EBLK    ;FINISH CURRENT OUTPUT BLOCK
6692         TRO FF,FRLOC    ;DOING LOCATION ASSIGNMENT, MAKE SURE NEXT GETS OUTPUT
6693         CLEARM CLOC
6694         MOVEI A,1
6695         MOVEM A,CRLOC
6696         CLEARM CONTRL
6697         SETZM BKBUF
6698         MOVEI A,LREL
6699         DPB A,[310700,,BKBUF]
6700         MOVEM A,CDATBC
6701         JRST MACCR
6702
6703 A.DECTWO:       CALL AGETFD     ;READ THE TWOSEG ORIGIN.
6704         TRNN FF,FRNPSS
6705          ETF [ASCIZ /.DECTWO follows 1PASS/]
6706         MOVE C,ISAV
6707         TRNN C,IRFLD    ;NO ARG => DEFAULT IT TO 400000
6708          MOVEI A,400000
6709         MOVEM A,DECTWO
6710
6711 A.DECREL:       PUSHJ P,OUTUPD
6712         TRZ FF,FRLOC
6713         PUSHJ P,EBLK    ;FORCE OUT BLOCK IN OTHER FMT.
6714         MOVE A,[SETZ DECREL]
6715         CAME A,CONTRL   ;SWITCHING TO .DECREL MODE FOR 1ST TIME
6716          TRNE FF,FRNPSS ;IN A 1PASS ASSEMBLY
6717           JRST A.FAS1
6718         CALL A.FAS1     ;DO THE SWITCH
6719          JFCL
6720         CALL DECPGN     ;THEN WRITE THE PROGRAM NAME
6721         JRST MACCR
6722
6723 A.FAS1: MOVEM A,CONTRL  ;DEC FMT COUNTS AS ABS ASSEMBLY.
6724         SETZM BKBUF     ;(SO EBLK W0N'T OUTPUT ANYTHING)
6725         SETZM CLOC      ;START ASSEMBLING FROM RELOCATABLE 0.
6726         MOVEI A,1
6727         MOVEM A,CRLOC
6728         PUSHJ P,EBLK    ;INITIALIZE AN ORDINARY (DECWDS) BLOCK.
6729         JRST MACCR
6730
6731 IFN FASLP,[
6732 A.FASL: PUSHJ P,OUTUPD
6733         PUSHJ P,EBLK
6734         MOVE A,[SETZ FASL]      ;FASL ALSO COUNTS AS ABS
6735         JRST A.FAS1
6736 ]
6737 \f
6738 ATITLE: NOVAL
6739         SAVE CASSM1     ;RETURN TO ASSEM1.
6740         PUSHJ P,GSYL
6741         SKIPE SYM
6742         MOVEM SYM,PRGNM
6743         MOVE T,[440700,,STRSTO]
6744 ATIT2:  ILDB A,T        ;GET CHAR FROM TITLE STRING
6745         SOSG STRCNT
6746         JRST ATIT3      ;CHAR IS SYLLABLE TERMINATOR
6747 IFE ITSSW,SKIPE CCLFLG ? TRNN FF,FRPSS2
6748         PUSHJ P,TYO     ;NOT TERMINATOR, TYPE OUT AND LOOP BACK
6749         JRST ATIT2
6750
6751 ATIT3:  CALL ATIT1      ;PRINT THE REST OF THIS LINE.
6752         MOVE A,CONTRL
6753         TRNE A,DECREL
6754          TRNE FF,FRNPSS
6755           CAIA
6756            ETF [ASCIZ /TITLE follows 1PASS/]
6757         MOVE A,TTYINS
6758         ADD A,A.PASS    ;SHOULD WE .INSRT TTY: THIS PASS (T SWITCH)
6759         JUMPG A,CPOPJ
6760 IFDEF GTYIPA,JRST GTYIPA        ;GO PUSH TO TTY IF CAN,
6761 IFNDEF GTYIPA,HALT      ;WHY DID YOU SET TTYINS IF CAN'T?
6762
6763 ATIT1:  CAIE A,15       ;CR?
6764         CAIN A,12       ;LF?
6765          JRST [IFE ITSSW,SKIPE CCLFLG ? TRNN FF,FRPSS2
6766                JRST CRR ;ONE OF THESE, FINISH TYPEOUT WITH CR
6767                 .ALSO RET
6768                 ]       ; AND RETURN IF PASS2 DEC CCL
6769 IFE ITSSW,SKIPE CCLFLG ? TRNN FF,FRPSS2
6770         PUSHJ P,TYO     ;NEITHER OF THESE, PRINT CHAR
6771 A.ERR1: PUSHJ P,RCH     ;GET NEXT CHAR IN TITLE
6772         JRST ATIT1
6773
6774 ;.ERR PSEUDO-OP -- FOLLOWED BY LINE WHICH IS ERROR MSG.
6775 A.ERR:  SAVE CASSM1     ;RETURN TO ASSEM1,
6776         ERJ A.ERR1      ;AFTER NUMBERS AND USER'S STRING.
6777
6778 A.FATAL:        SAVE [GO2]      ;.FATAL - CAUSE A FATAL ERROR.
6779         ERJ A.ERR1
6780
6781 APRINT: NOVAL
6782         HLRZS B         ;B SAYS WHETHER PRINTX, PRINTC OR COMMENT.
6783         JSP TM,ERMARK
6784         CALL PASSPS
6785         MOVE T,A
6786 APRIN1: PUSHJ P,RCH
6787         CAME A,T
6788          JRST (B)       ;GO TO APRIN1 FOR COMMENT,
6789         JRST MACCR
6790
6791 APRIN2: CAIE A,"!       ;COME HERE FOR PRINTX
6792 APRIN3: PUSHJ P,TYO     ;HERE FOR PRINTC
6793         JRST APRIN1
6794
6795 A.TYO:  NOVAL
6796         CALL AGETFD     ;PSEUDO TO TYPE A CHARACTER (AS NUMERIC ARG).
6797         CALL TYOERR
6798         JRST MACCR
6799
6800 A.TYO6: NOVAL
6801         CALL AGETFD     ;PSEUDO TO TYPE A WORD OF SIXBIT.
6802         MOVE B,A
6803         CALL SIXTYO
6804         JRST MACCR
6805 \f;.BEGIN - START NEW BLOCK WITH NAME = ARG, OR LAST LABEL DEFINED.
6806 A.BEGIN:        NOVAL
6807         SKIPE ASMOUT    ;IF IN GROUPING, FLUSH IT & ERROR.
6808         JSP LINK,CONFLM
6809         PUSHJ P,GETSLD  ;READ A NAME.
6810          MOVE SYM,SYSYM ;NO ARG, USE NAME OF LAST LABEL.
6811         MOVE A,SYM      ;NAME TO USE FOR BLOCK.
6812         MOVE B,BKLVL    ;CURRENT LEVEL + 1
6813         HRLZI B,1(B)    ;IS LEVEL OF NEW BLOCK.
6814         HRR B,BKCUR     ;ITS SUPERIOR IS CURRENT BLOCK.
6815         MOVEI C,0       ;SEE IF AN ENTRY EXISTS FOR THIS BLOCK.
6816         MOVE AA,A.PASS
6817 A.BEG0: CAMN A,BKTAB(C)
6818         CAME B,BKTAB+1(C)
6819         JRST A.BEG1     ;THIS ENTRY ISN'T FOR BLOCK BEING ENTERED.
6820         TDNE AA,BKTAB+2(C)      ;FOUND: DEFINED IN THIS PASS?
6821          ETSM [ASCIZ /Multiply defined BLOCK/]
6822         JRST A.BEG2     ;NO, SAY IT'S DEFINED.
6823
6824 A.BEG1: ADDI C,BKWPB    ;LOOK THRU ALL ENTRIES.
6825         CAMGE C,BKTABP
6826         JRST A.BEG0
6827         CAIL C,BKTABS   ;ALL ENTRIES USED => ERROR.
6828          ETF ERRTMB
6829         MOVEM A,BKTAB(C)        ;ALLOCATE NEW ENTRY
6830         MOVEM B,BKTAB+1(C)      ;STORE NAME, LEVEL, SUPPRO.
6831         MOVEI A,BKWPB(C)
6832         MOVEM A,BKTABP  ;POINTS TO 1ST UNUSED ENTRY.
6833 A.BEG2: IORM AA,BKTAB+2(C)      ;INDICATE BLOCK SEEN THIS PASS.
6834         MOVEM C,BKCUR   ;NEW BLOCK NOW CURRENT BLOCK,
6835         AOS A,BKLVL     ;ITS LEVEL NOW CURRENT LEVEL,
6836         CAIL A,BKPDLS   ;PUSH IT ON BLOCK PDL
6837          ETF [ASCIZ /.BEGIN nesting too deep/]
6838         MOVEM C,BKPDL(A)
6839         JRST ASSEM1
6840
6841 ERRTMB: ASCIZ /Too many symbol blocks/
6842 ERRUMB: ASCIZ /Unmatched .BEGIN - .END/
6843
6844 ;.END - POP CURRENT BLOCK.
6845 A.END:  NOVAL
6846         SKIPE ASMOUT    ;IN GROUPING => TERMINATE IT & ERROR.
6847         JSP LINK,CONFLM
6848         MOVE A,CDISP    ;IF FOLLOWED BY WORD TERM,
6849         TLNN A,DWRD     ;CAUSE IT TO BE RE-READ
6850         TLO FF,FLUNRD   ;SO ARG WILL BE NULL.
6851         PUSHJ P,GETSLD  ;READ ARG.
6852         JRST A.END0     ;NO ARG.
6853         MOVE C,BKCUR    ;ERROR UNLESS BLOCK BEING TERMINATED
6854         MOVE A,BKTAB(C) ;HAS SAME NAME AS ARG.
6855         EXCH A,SYM      ;(MAKE SURE SYM NAME TYPED IS BLOCK'S NAME)
6856         CAME A,SYM
6857          ETSM ERRUMB    ;ERROR, PRINT SYM (BLOCK'S NAME)
6858 A.END0: MOVE C,BKCUR    ;NOT OK TO END .MAIN BLOCK OR .INIT BLOCK.
6859         CAIG C,BKWPB
6860          ETA ERRUMB
6861         HRRZ C,BKTAB+1(C)
6862         MOVEM C,BKCUR   ;POP INTO FATHER OF PREV. CURRENT BLOCK.
6863         SOS BKLVL
6864         JRST ASSEM1
6865 \f
6866 ;BKTAB: 3-WORD ENTRIES, 1 PER BLOCK, IN NO PARTICULAR ORDER.
6867 ;1ST WD HAS SQUOZE NAME OF BLOCK, FLAGS CLEAR.
6868 ;2ND WD HAS LEVEL,,BKTAB IDX OF CONTAINING BLOCK("FATHER", "SUPERIOR")
6869 ;3RD WD BIT 1.N ON => BLOCK ENTERED ON PASS N.
6870 ;SYMBOL TABLE OUTPUT RTN PUTS -2*<NUM SYMS IN BLOCK> IN 3RD WD.
6871 ;THE FIRST BKTAB ENTRY IS THAT OF THE OUTERMOST BLOCK (.INIT)
6872 ;IN WHICH INITIAL SYMS ARE DEFINED.
6873 ;THAT ENTRY'S 2ND AND 3RD WDS ARE 0.
6874 ;THE NEXT IS THAT OF THE MAIN BLOCK (.MAIN) IN WHICH
6875 ;ALL SYMBOLS ARE NORMALLY DEFINED (THAT IS, YOU ARE IN THAT BLOCK
6876 ;BEFORE YOU DO ANY .BEGIN'S).
6877 ;THAT ENTRY'S 2ND WD IS 1,, ; ITS 3RD, 0.
6878
6879 ;THE BKPDL IS A TABLE OF BLOCKS CURRENTLY ENTERED & NOT ENDED.
6880 ;BKPDL'S 1ST ENTRY IS FOR OUTERMOST BLOCK.
6881 ;LAST ENTRY IS BKPDL+@BKLVL, FOR CURRENT BLOCK.
6882
6883 BKTABS==BKTABL*BKWPB
6884
6885 VBLK
6886 BLCODE [
6887 BKTAB:  BLOCK 3         ;ENTRY FOR .INIT BLOCK.
6888 PRGNM:  BLOCK BKTABS-BKWPB      ;PROGRAM NAME IS NAME OF MAIN BLOCK.
6889 ]
6890 BKTABP: 0       ;IDX IN BKTAB OF 1ST UNUSED ENTRY.
6891 BKPDL:  BLOCK BKPDLS    ;TABLE OF BLOCKS STARTED, NOT FINISHED.
6892 BKLVL:  0       ;CURRENT BLOCK LEVEL, IDX OF LAST USED IN BKPDL.
6893 BKCUR:  0       ;BKTAB IDX OF CURRENT BLOCK.
6894 ESBK:   0       ;-1 OR BLOCK TO EVAL SYM. IN.
6895 ESL1:   0       ;IN ES, LEVEL OF BLOCK OF BEST SYM SO FAR.
6896 ESL2:   0       ;3RDWRD OF BEST SO FAR.
6897 SADR:   0       ;SYM TAB IDX OF BEST SO FAR.
6898 ESLAST: 0       ;RH IDX OF LAST DEF (EVEN IF NO GOOD) -1 IF NONE
6899                 ;SIGN NEG. IF LAST DEF SEEN BEFORE @ESXPUN
6900 ESXPUN: -1      ;IF SEE EXPUNGED OR FREE ENTRY, PUT IDX HERE.
6901 BKTAB1: BLOCK BKTABL    ;USED BY SSYMD.
6902 PBLK
6903
6904 ;.SYMTAB ARG    ;SAY WANT AT LEAST ARG STE'S IN SYMTAB.
6905 A.SYMTAB:       NOVAL
6906         SAVE [0]        ;THIS WORD WILL BE SETOM'ED IF THERE IS REALLY ANY WORK NEEDED.
6907         PUSHJ P,AGETFD  ;GET DESIRED SYM TAB SIZE.
6908         CAMG A,SYMLEN   ;IF HAVE ENOGH ROOM ALREADY,
6909          JRST A.SYM1    ;NO NEED TO RE-INIT.
6910         CAILE A,SYMMAX  ;IF WANTS MORE THAN MAXIMUM, ERROR.
6911          ETF [ASCIZ/.SYMTAB 1st arg too big/]
6912         MOVEM A,SYMLEN  ;TELL INITS ABOUT NEW SIZE.
6913         SETOM (P)
6914 A.SYM1: CALL AGETFD     ;READ DESIRED CONSTANTS TABLE SPACE ALLOCATION.
6915         CAMG A,CONLEN   ;IF TABLE ALREADY BUG ENOUGH, NOTHING TO DO.
6916          JRST A.SYM2
6917         CAILE A,CONMAX
6918          ETF [ASCIZ/.SYMTAB 2nd arg too big/]
6919         MOVEM A,CONLEN  ;ELSE REMEMBER IT AND SAY REALLOCATION NECESSARY.
6920         SETOM (P)
6921 A.SYM2: CALL AGETFD     ;3RD ARG IS # WORDS PER SYMBOL - BUT ONLY 3 IS ALLOWED NOW.
6922         JUMPE A,A.SYM3  ;EVENTUALLY 4 WILL GET 12-CHARACTER SYMBOLS.
6923         CAIL A,MINWPS
6924          CAILE A,MAXWPS
6925           ETF [ASCIZ/.SYMTAB 3rd arg out of range/]
6926         CAME A,WPSTE
6927          SETOM (P)
6928         MOVEM A,WPSTE
6929 A.SYM3: REST A          ;IS THERE ANYTHING THAT ACTUALLY NEEDS TO BE CHANGED?
6930         JUMPE A,ASSEM1  ;IF NOT, NEVER GIVE ERROR - ELSE WOULD ALWAYS LOSE ON PASS 2.
6931         MOVE B,PLIM
6932         CAMN B,CONTBA   ;IF THERE HAVE BEEN ANY LITERALS
6933          SKIPE INICLB   ;OR ANY MACROS, IRPS, REPEATS, ETC., THEN ...
6934           ETF [ASCIZ/Too late to do .SYMTAB/]
6935         MOVE CH1,MACTAD ;SET UP AC -> START OF INIT CODE
6936         SUBI CH1,MACTBA ;SO IT CAN REFER TO ITSELF.
6937         PUSHJ P,INITS(CH1) ;RE-INIT, SET SYMSIZ, SYMAOB, ETC.
6938         PUSHJ P,MACINI  ;INIT PTRS TO END OF MACTAB.
6939         JRST ASSEM1
6940 \f
6941 A.OP:   PUSHJ P,A.OP1   ;.OP,
6942         JRST VALRET     ;RETURNS VALUE
6943
6944 A.AOP:  NOVAL
6945         AOS (P)         ;.AOP DOESN'T RETURN VALUE
6946 A.OP1:  PUSHJ P,AGETFD
6947         PUSH P,A
6948         PUSHJ P,AGETFD
6949         PUSH P,A        ;PDL NOW HAS FIELD 0 AND FIELD 1
6950         PUSHJ P,AGETFD
6951         POP P,B         ;B NOW HAS FIELD 1, A HAS FIELD 2, PDL HAS FIELD 0
6952         EXCH A,B
6953         POP P,T         ;T HAS FIELD 0, A HAS FIELD 1, B HAS FIELD 2
6954         TLNN T,(0 17,)  ;IF AC FIELD NOT PRESENT IN INSN, SUPPLY ONE.
6955          TLO T,(0 A,)
6956         TDNN T,[0 -1(17)] ;IF NO ADDR OR IDX FIELD IN INSTRUCTION,
6957          HRRI T,B       ;SUPPLY ONE.
6958         SETOM A.ASKIP'  ;.ASKIP WILL BE -1 IFF INSN SKIPPED, ELSE 0.
6959         TLNE T,74000    ;AVOID EXECUTING OPCODE ZERO.
6960          XCT T
6961           SETZM A.ASKIP
6962         MOVEM A,AVAL1'  ;STORE C(AC) AS .AVAL1
6963         MOVEM B,AVAL2'  ;STORE C(E) FOR .AVAL2
6964         POPJ P,         ;RETURN TO WHATEVER
6965
6966 AASCIZ: TDZA T,T
6967 A.ASCII:        MOVEI T,1
6968         MOVEM T,AASCF1  ;STORE TYPE
6969         MOVE D,[440700,,T]
6970         SETZM AASCFT
6971         JRST AASC1
6972
6973 AASCII: SKIPA D,[440700,,T]
6974 ASIXBI:  MOVE D,[440600,,T]
6975         SETZM AASCFT    ;INDICATE NOT .DECTXT
6976         SETOM AASCF1    ;INDICATE REGULAR (NOT ASCIZ)
6977         JRST AASC1
6978
6979 A.DCTX: NOVAL
6980         MOVE A,CONTRL
6981         TRNN A,DECREL
6982          ETA [ASCIZ /.DECTXT in non-DECREL assembly/]
6983         CALL EBLK
6984         SETZ B,
6985         SETOM AASCFT
6986         SETOM AASCF1    ;INDICATE ASCIZ-STYLE PADDING
6987         MOVE D,[440700,,T]
6988 AASC1:  TLZE I,ILMWRD
6989          JRST TEXT2     ;MULTIPLE WORD, FALL IN FOR NEXT SET OF CHARS
6990         MOVEMM ASMDS1,ASMDSP
6991         MOVEM SYM,DEFNPS ;REMEMBER LOCATION IN FILE OF PSEUDO
6992         MOVEMM DEFNLN,CLNN      ;IN CASE THE DELIMITER IS MISSING.
6993         MOVEMM DEFNPN,CPGN
6994 IFN TS, MOVEMM DEFNFI,INFFN1
6995         HLRZ T,B        ;GET FILL CHARACTER
6996         IMUL T,[REPEAT 5,[1_<.RPCNT*7>+]0] ;CONVERT TO ASCII FILL WORD SHIFTED -1 (IMUL SCREW)
6997         LSH T,1         ;SHIFT TO PROPER POSITION (EXTRA IN CASE WANT TO FILL W/ HIGH BIT SET)
6998         MOVEM T,AASEFW  ;STORE AS FILL WORD, T NOW SET UP TO ACCUMULATE VALUE
6999         CALL PASSPS
7000         MOVEM A,TEXT4   ;STORE TERMINATOR
7001 TEXT7:  PUSHJ P,RCH
7002 AASC8:  CAMN A,TEXT4
7003          JRST AASC1A    ;TERMINATOR
7004         TLNN D,760000
7005          JRST TEXT6     ;WORD FULL
7006 TEXT9:  TLNE D,100      ;CHECK BOTTOM BIT OF SIZE FIELD OF BP
7007          JRST AASC2     ;SET => NOT SIXBIT
7008         SUBI A,40
7009         CAILE A,77
7010          SUBI A,40      ;CONVERT LOWER CASE ASCII TO UPPER CASE
7011         JUMPGE A,.+2
7012          ETR ERRN6B
7013 AASC3:  IDPB A,D
7014         TRO I,IRSYL
7015         JRST TEXT7
7016
7017 ERRN6B: ASCIZ /Character not SIXBIT/
7018 \f
7019 ;TERMINATOR
7020
7021 AASC1A: TLNN D,760000   ;SKIP UNLESS END OF WORD
7022         SKIPGE AASCF1   ;SKIP UNLESS REGULAR
7023          JRST [ MOVE CH1,ASMDS1 ;REGULAR OR NOT END OF WORD
7024                 MOVEM CH1,ASMDSP ;RESTORE ASMDSP AS SAVED AT START OF PSEUDO.
7025                 JRST TEXTX]
7026         MOVEI CH1,1     ;END OF WORD AND NOT REGULAR
7027         JRST AASC1B     ;EXTRA 0 NEED FOR Z FLAVOR
7028
7029 AASC2:  CAIN A,"!
7030         SKIPG AASCF1
7031         JRST AASC3      ;NOT .ASCII OR NOT EXCL
7032         PUSH P,T        ;READ FIELD
7033         PUSH P,D
7034         PUSH P,SYM
7035         SAVE ASMOUT     ;PREVENT CLOSEBRACKETS FROM TRYING TO TAKE EFFECT.
7036         MOVEIM ASMOUT,4 ;NOTE THIS LOSES IF CALL PSEUDO THAT RETURNS TO ASSEM1.
7037         MOVEI SYM,[SETOM ASUDS1]        ;NOW TO SET UP UNDEFINED SYM CONDITION
7038         TLNE FF,FLPPSS
7039          MOVE SYM,[SQUOZE 0,.ASCII]     ;PUNCHING PASS, UNDEFINED => REAL ERROR
7040         CLEARM ASUDS1
7041         PUSHJ P,AGETFD
7042                 ;"UNDEFINED IN .ASCII" ERROR INSTR, ERROR MESSAGE BUT ONLY ON PASS 2
7043                 ;BUT NOTE THAT ON PASS 2 IT MIGHT ASSEMBLE DIFFERENT NUMBER OF WORDS,
7044                 ;CAUSING LOSSAGE IF NOT IN CONSTANT
7045         REST ASMOUT
7046         POP P,SYM
7047         POP P,D
7048         POP P,T
7049         SKIPGE ASUDS1
7050         MOVNI A,1       ;HAD UNDEFINED SYMS SO ASSUME MAX
7051         SKIPGE ASUDS1
7052         TLO I,ILNOPT    ;ALSO DON'T OPTIMIZE OVER IN CONSTANT
7053         MOVE CH1,[440700,,AASBF]
7054         MOVEM CH1,ASBP1
7055         MOVEM CH1,ASBP2
7056         PUSH P,[AASC5]
7057         MOVE CH1,A
7058 AASC6:  LSHC CH1,-35.
7059         LSH CH2,-1
7060         DIV CH1,ARADIX
7061         HRLM CH2,(P)
7062         JUMPE CH1,.+2
7063         PUSHJ P,AASC6
7064         HLRZ A,(P)
7065         ADDI A,"0
7066         IDPB A,ASBP1
7067         POPJ P,
7068
7069 AASC5:  MOVEI A,0
7070         IDPB A,ASBP1    ;END .ASCII NUMBER WITH ZERO
7071 AASC8A: TLNN D,760000
7072         JRST AASC7      ;END OF WORD
7073         ILDB A,ASBP2
7074         JUMPE A,AASC9
7075         IDPB A,D
7076         JRST AASC8A
7077
7078 AASC9:  TLO FF,FLUNRD
7079         JRST TEXT7
7080 \f
7081 AASC7:  TDZA CH1,CH1
7082 TEXT6:  MOVNI CH1,1     ;WORD FULL
7083 AASC1B: MOVEM CH1,AASCF2
7084         CLEARM CDISP
7085         MOVEM A,TEXT8
7086         MOVE A,T
7087         SKIPE AASCFT    ;FOR .DECTXT, OUTPUT WORD INSTEAD OF RETURNING IT.
7088          JRST [ CALL PPB
7089                 MOVE D,[440700,,T]
7090                 JRST TEXT2A]
7091         TLO I,ILMWRD    ;ELSE ARRANGE TO BE CALLED BACK TO RETURN NEXT WORD.
7092         MOVEI T,ASSEM2
7093         MOVEM T,ASMDSP
7094         SKIPLE CONSML   ;IF NOT MULTI-LINE MODE,
7095          JRST CLBPOP
7096         MOVE T,ASMOUT   ;IF THE TEXT IS IN <>'S OR ()'S,
7097         HRRZ T,ASMOT2(T)
7098         CAIE T,LSSTHA
7099          JRST CLBPOP
7100         CALL IGTXT      ;USE ONLY THE FIRST WORD.
7101         SKIPE CONSML    ;AND ERROR IF IN ERROR MODE.
7102          ETR [ASCIZ/Multi-word text pseudo in brackets/]
7103         JRST CLBPOP
7104
7105                 ;GET NEXT WORD
7106
7107 TEXT2:  TRO I,IRFLD
7108 TEXT2A: MOVE T,AASEFW   ;INITIALIZE T TO FILL WORD
7109         MOVE A,TEXT8    ;GET NEXT CHAR (ALREADY READ BY RCH)
7110         SKIPGE B,AASCF2
7111         JRST TEXT9      ;REG OR HAVEN'T READ SECOND DELIMITER, FALL BACK IN
7112         JUMPE B,AASC8A
7113 TEXTX:  SETZM DEFNPS
7114         SKIPN AASCFT
7115          JRST TEXT5     ;RETURNING FROM ASCIZ AFTER PUTTING THE TRAILING ZERO OUT.
7116         MOVE A,T
7117         CALL PPB        ;FOR .DECTXT, OUTPUT THE FILL WORD INSTEAD.
7118         JRST MACCR
7119
7120 VBLK
7121
7122 AASCF1: 0       ;-1 REG OR SIXBIT, 1 .ASCI 0 ASCIZ
7123 AASCF2: 0       ;MULTIPLE WORD RETURN FLAG -1 REG 0  FINISH ! HACK 1 OUTPUT FILL WORD FOR Z
7124 AASCFT: 0       ;0 REGULAR, -1 => .DECTXT (OUTPUT WORDS TO FILE INSTEAD OF RETURNING  THEM)
7125 TEXT4:  0       ;DELIMITER
7126 TEXT8:  0       ;SAVED NEXT CHAR WHILE RETURNING BETWEEN WORDS
7127 ASBP1:  0       ;IDPB TO AASBF ON .ASCII FIELD
7128 ASBP2:  0       ;ILDB FROM AASBF "
7129 AASBF:  BLOCK 8 ;ACCUMULATED TYPEOUT OF NUMBER FOR .ASCII, EXTRA LONG FOR HACKERS TYPING OUT BINARY
7130 ASUDS1: 0       ;UNDEFINED SYM FLAG FOR .ASCII DURING PASS 1
7131 AASEFW: 0       ;FILL WORD
7132
7133 PBLK
7134
7135 IGTXT:  TLNN I,ILMWRD
7136          RET
7137         PUSH P,A        ;ROUTINE TO EAT UP TEXT OF UNDESIRED MULTIPLE WORD
7138         SKIPLE AASCF2   ;DETECT SCREW CASE:  AFTER ASCIZ OF 5 CHARS, DELIMITER IS
7139          JRST IGTXT1    ;ALREADY GOBBLED, BUT SOME OF THE ASCIZ REMAINS.
7140         PUSHJ P,RCH
7141         CAME A,TEXT4
7142         JRST .-2
7143 IGTXT1: TLZ I,ILMWRD
7144         MOVEMM ASMDSP,ASMDS1
7145         SETZM DEFNPS
7146         JRST POPAJ
7147
7148 ;".ASCVL  /X" RETURNS THE ASCII VALUE OF "X".  NOTE THE DELIMITER IS NOT REPEATED
7149 ;AND SERVES ONLY TO ALLOW SPACES TO BE IGNORED WHILE WINNING IF X IS A SPACE.
7150 A.ASCV: CALL PASSPS     ;SKIP SPACES TO REACH THE DELIMITER.
7151         CALL RCH        ;READ THE CHAR AFTER THE DELIMITER
7152         MOVE T,A
7153         JRST TEXT5      ;AND RETURN ITS ASCII VALUE.
7154 \f
7155 ASQOZ:  HLLM B,(P)      ;SAVE FLAG THAT'S 0 FOR SQUOZE, -1 FOR .RSQZ .
7156         SAVE SYM
7157         PUSHJ P,AGETFD
7158         LSH A,36
7159         PUSH P,A
7160         PUSHJ P,GETSLD  ;GET SYM, SAVE DELIMITER FOR REINPUT
7161          CALL NONAME
7162         REST A
7163         LDB B,[4000,,SYM]       ;GET JUST THE SQUOZE.
7164         SKIPGE -1(P)
7165         PUSHJ P,ASQOZR  ;FOR .RSQZ, RIGHT-JUSTIFY IT.
7166         SUB P,[1,,1]
7167         ADD A,B
7168         JRST CLBPOP
7169
7170 ;RIGHT-JUSTIFY THE SQUOZE WORD IN B.
7171 ASQOZR: MOVE SYM,B
7172         IDIVI SYM,50
7173         JUMPN LINK,CPOPJ        ;LAST ISN'T BLANK, DONE.
7174         MOVE B,SYM      ;ELSE REPLACE BY WHAT'S SHIFTED RIGHT 1 CHAR.
7175         JRST ASQOZR
7176
7177                 ;COMMON PSEUDO ROUTINE TO RETURN MIDAS INTERNAL QUANTITY
7178                 ;ADR IN LH(B)) AS VALUE (EG. .RPCNT, .FNAM1, .AVAL2, ETC.
7179                 ;INTSYMS MAY APPEAR TO LEFT OF =
7180
7181 INTSYM: MOVE A,B        ;GET ADR IN LH(A)
7182         JRA A,CLBPOP    ;RETURN IT
7183
7184                 ;.YSTGW, .NSTGW ACCORDING TO WHAT'S IN LH(B)
7185
7186 STGWS:  HRLES B         ;.NSTGW INCREMENTS STGSW, .YSTGW DECREMENTS.
7187         ADDB B,STGSW
7188         SKIPGE B        ;BUT DON'T DECREMENT PAST 0.
7189          SETZM STGSW
7190         JRST MACCR      ;STORAGE WORDS ARE ALLOWED IF STGSW IS ZERO.
7191
7192                 ;.TYPE
7193
7194 A.TYPE: SAVE SYM
7195         SAVE SYM
7196         PUSHJ P,GETSLD  ;GET NAME
7197          CALL NONAME
7198         SUB P,[2,,2]
7199         TRNN I,IRLET    ;IF SYLLABLE IS A NUMBER,
7200          JRST [ SETO A, ;RETURN -1.
7201                 JRST CLBPOP]
7202         PUSHJ P,ES      ;EVALUATE SYM, INTERESTED IN SQUOZE FLAGS RETURNED IN A
7203         MOVEI A,17      ;DIDN'T SKIP, RETURN 17 => UNSEEN
7204 IFN CREFSW,XCT CRFINU
7205         JRST CLBPOP
7206
7207 NONAME: MOVE SYM,-2(P)
7208         ETSM [ASCIZ /No arg/]
7209         SETZ SYM,
7210         POPJ P,
7211
7212                 ;.FORMAT
7213
7214 A.FORMAT:       PUSHJ P,AGETFD  ;GET FIRST FIELD (FORMAT #)
7215         MOVE B,CDISP    ;WORD TERMINATOR ENDED 1ST ARG =>
7216         TLNN B,DWRD
7217          JRST A.FOR1    ;RETURN CURRENT SPEC FOR THAT FORMAT.
7218         PUSH P,A
7219         PUSHJ P,AGETFD  ;GET SECOND FIELD (TABLE ENTRY FOR FORMAT NUMBER)
7220         POP P,B
7221         MOVEM A,FORTAB-10(B)
7222         JRST ASSEM1
7223
7224 A.FOR1: MOVE A,FORTAB-10(A)
7225         JRST CLBPOP
7226 \f
7227 A.BYTE: NOVAL
7228         CLEARM NBYTS    ;# BYTES ASSEMBLED
7229         CLEARM BYTMT    ;TOTAL ACTIVE BYTES IN TABLE
7230         MOVE A,[440700,,BYBYT]  ;POINTER TO NEW TABLE
7231         MOVEM A,BYTMP
7232 A.BY1:  PUSHJ P,AGETFD  ;GET FIELD, .GE. 0 => BYTE, .LT. 0 => HOLE
7233         MOVE C,ISAV
7234         TRNN C,IRFLD
7235         JRST A.BY2      ;NO FIELD
7236         MOVM B,A
7237         SKIPGE A
7238         TRO B,100
7239         IDPB B,BYTMP
7240         AOS BYTMT
7241 A.BY2:  TLNE CH1,DWRD   ;CDISP LEFT IN CH1 BY AGETFD
7242         JRST A.BY1      ;NOT WORD TERMINATOR
7243         SKIPN BYTMT     ;WORD TERMINATOR, ANY FIELDS?
7244         JRST A.BY3      ;NO, DO .WALGN AND RESET TO WORD MODE
7245         SETOM BYTM      ;ENTERING BYTE MODE
7246         MOVE A,[-LPDL,,PDL]
7247         CAMN A,ASSEMP
7248         SETOM BYTM1
7249         PUSHJ P,BYSET
7250         MOVE A,GLSPAS
7251         MOVEM A,GLSP1
7252         JRST ASSEM1
7253
7254                 ;RESET THE BYTE DESCRIPTOR TABLE POINTERS TO POINT TO NEW WORD
7255
7256 BYSET:  CLEARM BYTMC    ;COUNT OF BYTES PROCESSED THIS TABLE SCAN
7257         MOVE A,[440700,,BYBYT]  ;POINTER TO DESCRIPTOR TABLE
7258         MOVEM A,BYTMP
7259         ILDB A,BYTMP    ;FIRST DESCRIPTOR BYTE
7260         AOS BYTMC
7261         DPB A,[300600,,BYTWP]   ;DEPOSIT AS FIRST BYTE SIZE
7262         POPJ P,
7263
7264 A.BY3:  CLEARM BYTM     ;NO LONGER IN BYTE MODE
7265         MOVE A,[-LPDL,,PDL]
7266         CAMN A,ASSEMP
7267         SETZM BYTM1
7268         JRST A.WAL1
7269
7270 A.WALGN:        NOVAL
7271 A.WAL1: LDB A,[360600,,BYTWP]
7272         CAIN A,44
7273         JRST ASSEM1     ;ALREADY AT BEGINNING OF WORD
7274         MOVEI A,44
7275         DPB A,[360600,,BYTWP]   ;MAKE IT POINT TO BEGINNING OF WORD
7276         PUSHJ P,BYSET
7277         CLEARM T1
7278         JRST PBY1
7279 \f
7280 BYTIN1: CLEARM BYTMC
7281         MOVE A,[440700,,BYBYT]
7282         MOVEM A,BYTMP
7283 BYTINC: AOS A,BYTMC
7284         CAMLE A,BYTMT
7285         JRST BYTIN1
7286         ILDB A,BYTMP
7287         DPB A,[300600,,BYTWP]
7288         MOVEM A,T1
7289         HLLZ A,BYTWP
7290         IBP A
7291         TRNN A,-1
7292         JRST BYTINR
7293                 ;NEXT BYTE GOES IN NEXT WORD
7294 PBY1:   MOVE P,ASSEMP   ;PCONS NEEDS THIS.
7295         MOVEI A,WRD-1
7296         PUSH A,BYTW     ;INTO WRD,
7297         PUSH A,BYTRLC   ;INTO WRDRLC
7298         CLEARM BYTW
7299         SETZM BYTRLC
7300         MOVEI A,44
7301         DPB A,[360600,,BYTWP]
7302         MOVE AA,ASMOUT
7303         JRST @ASMOT4(AA) ;TO PBY4 OR PBY5 OR PBY3
7304
7305 PBY4:   SKIPE STGSW
7306          ETR ERRSWD
7307         PUSHJ P,PWRD    ;NOT IN CONST., OUTPUT WORD.
7308         AOSA CLOC
7309 PBY3:   JSP T,PCONS     ;OUTPUT INTO CONST.
7310 PBY5:   MOVE A,GLSPAS
7311         MOVEM A,GLSP1
7312 BYTINR: MOVE A,T1       ;CURRENT BYTE SIZE
7313         TRNN A,100
7314         JRST @ASMDSP
7315         SETZB A,B       ;ASSEMBLE HOLE (BLANK BYTE) IMMEDIATELY AFTER PREVIOUS BYTE
7316         JRST PBY2
7317
7318 PBYTE:  AOS NBYTS
7319 PBY2:   MOVEI AA,WRD-1
7320         PUSH AA,BYTW    ;INTO WRD
7321         PUSH AA,BYTRLC  ;INTO WRDRLC
7322         IBP BYTWP
7323         LDB T,[301400,,BYTWP]
7324         PUSHJ P,INTFLD
7325         POP AA,BYTRLC   ;WRDRLC
7326         POP AA,BYTW     ;WRD
7327         JRST BYTINC
7328
7329                 ;VARIABLES FOR .BYTE, .BYTC, .WALGN
7330
7331 VBLK
7332 BYTM:   0       ;-1 FOR IN BYTE MODE, LAMBDA BOUND BY <'S, ('S, AND ['S  ;]
7333 BYTMC:  0       ;COUNT CORRESP WITH BYTMP
7334 BYTMP:  0       ;POINTER TO BYTE DESC TABLE
7335 BYTMT:  0       ;TOTAL ACTIVE BYTES IN TABLE
7336 BYTM1:  0       ;GLOBAL VALUE OF BYTM - WHAT IT WAS OUTSIDE THE OUTERMOST BRACKET
7337
7338 ;FORMAT OF BYTE DESC TABLE
7339 ;SEVEN BIT BYTES
7340 ;1.7=0 ASSEMBLE =1 BLANK
7341 ;1.1 - 1.6 NUMBER OF BITS
7342
7343 IFNDEF LBYBYT,LBYBYT==5 ;LENGTH OF BYBYT
7344 BLCODE [BYBYT:  BLOCK LBYBYT]   ;BYTE DESC TABLE, 7 BITS PER DESC
7345
7346 BYTWP:  440000,,BYTW    ;POINTER TO BYTW IDPB TO DEPOSIT CURRENT BYTE
7347 BYTW:   0       ;WORD BEING ASSEMBLED IN BYTE MODE
7348 BYTRLC: 0       ;RELOC OF BYTW.
7349 NBYTS:  0       ;NUMBER BYTES ASSEMBLED (FOR .BYTC)
7350 BYTMCL==.-BYTMC
7351 PBLK
7352 \f;;MACRO PROCESSOR
7353 IFN MACSW,[
7354                 ;GET IN B THE CHAR WHOSE ADR IS IN A, INCREMENT A
7355
7356 REDINC: MOVE CH1,A
7357         IDIVI CH1,4
7358         LDB B,PTAB(CH2)
7359         AOJA A,CPOPJ
7360
7361 VBLK    ;THIS STUFF ALL RELOCATED WHEN MACTAB ADDR CHANGED.
7362 PTAB:   (341000+CH1)MACTBA      ;BYTE TABLE
7363         (241000+CH1)MACTBA
7364         (141000+CH1)MACTBA
7365         (41000+CH1)MACTBA
7366         (341000+CH1)MACTBA+1
7367
7368         ;IN FOLLOWING MACROS, B = -1, 0, OR +1 (+ SIGN MUST BE GIVEN)
7369         ;0 => BP SAME AS CHAR ADR, -1 => BP FOR ILDB, 1 => BP ONE AHEAD
7370
7371                 ;CHAR ADR IN A, RETURNS BP IN A, CLOBBERS A+1
7372
7373 DEFINE BCOMP A,B/
7374         IDIVI <A>,4
7375         ADD <A>,(<A>+1)BCOMPT!B
7376 TERMIN
7377
7378 STOPPT: 041000,,MACTBA-1
7379 BCOMPT: 341000,,MACTBA
7380         241000,,MACTBA
7381 BCOMPU: 141000,,MACTBA
7382         041000,,MACTBA
7383         341000,,MACTBA+1
7384
7385 ;BP IN A RETURN CHAR ADR IN A, CLOBBERS A-1 (YES, A MINUS 1)
7386 ;2ND ARG IS SUBTRACTED - -1 GIVES ADDR OF THE NEXT CHAR.
7387 DEFINE CCOMP A,B/
7388         MOVEI <A>-1,0
7389         ASHC <A>-1,2
7390         SUB <A>,(<A>-1)CCOMPT!B
7391 TERMIN
7392
7393                 ;BP IN A RETURN CHAR ADR IN A+1, CLOBBERS A
7394
7395 DEFINE CCOMP1 A,B/
7396         MULI <A>,4
7397         SUB <A>+1,(A)CCOMPT!B
7398 TERMIN
7399
7400 ;FROM HERE THRU CCOMPE SET BY MACINI.
7401 CCOMPB: 0       ;4*<41000,,MACTBA>-4
7402 CCOMPT: REPEAT 5,0      ;4*<41000,,MACTBA>+.RPCNT-3
7403 CCOMPE::PBLK
7404
7405                 ;BP IN A, DECREMENT IT
7406
7407 DEFINE DBPM A
7408         ADD A,[100000,,]
7409         SKIPGE A
7410         SUB A,[400000,,1]
7411 TERMIN
7412 \f
7413                 ;SET UP CPTR FROM CHAR ADR IN A
7414
7415 ACPTRS: MOVEI CH1,(A)   ;GET CHAR ADR IN CH1
7416         BCOMP CH1,-1    ;CONVERT TO BYTE POINTER
7417         MOVEM CH1,CPTR  ;STORE COMPUTED CPTR
7418         POPJ P,
7419
7420 AFCOMP: HRRZM A,FREEPT  ;ENTRY TO STORE C(A) INTO FREEPT
7421 FCOMP:  MOVE CH1,FREEPT ;COMPUTE FREPTB FROM FREEPT
7422         BCOMP CH1,-1
7423         MOVEM CH1,FREPTB        ;STORE CALCULATED BYTE POINTER
7424         POPJ P,
7425
7426 STPWR:  MOVEI A,375
7427         JRST PUTREL
7428
7429 VBLK
7430 PUT377: MOVEI A,377
7431 PUTREL: JRST PUTRE1     ;IDPB A,FREPTB;STORE CHAR INTO FREE CHARACTER STORAGE
7432         AOS A,FREEPT    ;CLOBBERS ONLY A.
7433         AOS PUTCNT
7434         CAMGE A,MACHI
7435         POPJ P,
7436         JRST GCA
7437 PBLK
7438 PUTRE1: PUSH P,[IDPB A,FREPTB]
7439         POP P,PUTREL    ;COME HERE ONLY ON 1ST CALL TO PUTREL.
7440         SETOM INICLB    ;HAVE WRITTEN IN MACRO TAB & CLOBBERED INIT.
7441         JRST PUTREL     ;NOW GO BACK AND REALLY WRITE CHAR.
7442
7443 ;200 BIT SET ON CHAR READ FROM MACTAB, PROCESS SPECIAL CONDITION
7444 ;CLOBBERS A,CH1,CH2.
7445
7446 MACTRM: CAIN A,176      ;376?
7447         JRST RCHTRA     ;376 => IGNORE, CHARACTER USED TO CLOBBER UNDESIRED CHARACTERS IN MACRO STORAGE
7448         PUSH P,B        ;SAVE B
7449         CAIE A,177
7450         CAIN A,175
7451         JRST MRCH1      ;377, 375 => STOP
7452         ADD A,BBASE     ;DUMMY, RELOCATE TO POINT TO DUMMY TABLE
7453         MOVEI B,RCHSAV  ;RETURN TO RCHSAV ON END OF DUMMY
7454         PUSHJ P,PUSHEM  ;SAVE CURRENT STATUS
7455         HRRZ A,(A)      ;GET CHAR ADR OF DUMMY
7456         BCOMP A,-1      ;CONVERT TO BYTE POINTER
7457         MOVEM A,CPTR    ;STORE AS NEW CPTR
7458         MOVE A,TOPP
7459         MOVEM A,BBASE
7460 RCHTRB: POP P,B
7461 RCHTRA: POP P,A ;POP RETURN
7462         TLZN FF,FLUNRD
7463         JRST -3(A)
7464         JRST -4(A)
7465
7466 MRCH1:  MOVE B,MACP
7467 BPOPJ:  POPJ B,         ;RETURN AT END OF STRING EXPANSION
7468 \f
7469                 ;RCHSET ROUTINE TO CAUSE INPUT FROM MACRO PROCESSOR
7470
7471 RCHMAC: TLO FF,FLMAC    ;SET FLAG
7472         JSP A,CPOPJ
7473 RCHMC0: REPEAT 2,[      ;GETCHR, RR1
7474         ILDB A,CPTR     ;GET CHAR
7475         TRZE A,200      ;200 BIT...
7476         PUSHJ P,MACTRM  ;=> SPECIAL, PROCESS
7477 ]
7478         .VALUE
7479 IFN .-RCHPSN-RCHMC0,.ERR RCHMC0 LOSES.
7480         ILDB A,CPTR     ;SEMIC
7481         TRZE A,200
7482         PUSHJ P,MACTRM
7483         CAIE A,15
7484         JRST SEMIC      ;NOT YET
7485         JRST SEMICR     ;YET
7486
7487                 ;PUSH INPUT STATUS IN FAVOR OF MACRO
7488                 ;B HAS RETURN ADR FOR END OF MACRO (OR WHATEVER)
7489                 ;SEE ALSO PMACP
7490
7491 PUSHEM: PUSH P,A
7492         PUSH P,F
7493         MOVE F,MACP     ;GET MACRO PDL POINTER
7494         MOVE CH1,CPTR
7495         CCOMP1 CH1,-1   ;CONVERT TO CHARACTER ADDRESS
7496         HRL CH2,BBASE
7497         PUSH F,CH2      ;PUSH BBASE,,CPTR
7498         MOVEI A,1       ;=> EXPAND MACRO
7499         PUSHJ P,PSHLMB  ;SAVE LIMBO1 STATUS AND RETURN
7500         JRST PSHM1
7501
7502                 ;UNDO A PUSHEM
7503                 ;RETURNS BBASE,,CPTR IN B (CPTR RE-INITIALIZED, BBASE NOT)
7504
7505 POPEM:  PUSH P,A
7506         PUSH P,F
7507         MOVE F,MACP
7508         PUSHJ P,POPLMB  ;RESTORE LIMBO1 STATUS
7509         POP F,B         ;BBASE,,CPTR
7510         MOVEI CH1,(B)   ;GET CHAR ADR IN CH1
7511         BCOMP CH1,-1    ;CONVERT TO BYTE POINTER
7512         MOVEM CH1,CPTR  ;STORE NEW CPTR
7513 PSHM1:  MOVEM F,MACP    ;STORE BACK MACRO PDL POINTER
7514 POPFAJ: POP P,F
7515 POPAJ:  POP P,A
7516         POPJ P,
7517 \f
7518 PMACP:  MOVE B,MACP     ;POP MACRO PDL
7519         HRRZ A,(B)
7520         SUB B,[1,,1]
7521 IFN RCHASW,CAIE A,A.TYM8
7522         CAIN A,AIRR
7523         JRST A.GO6      ;IRP OR .TTYMAC
7524         CAIN A,REPT1
7525         JRST A.GO4      ;REPEAT
7526         CAIE A,RCHSV1   ;MACRO
7527         CAIN A,RCHSAV   ;ARG
7528         JRST A.GO6
7529         .VALUE          ;DON'T HAVE RETURN,
7530         JRST A.GO6      ;BUT TRY A.GO6 LIKE EVERYTHING BUT REPEAT
7531
7532 A.GO4:  HLLZS -1(B)     ;REPEAT, CLEAR OUT COUNT REMAINING
7533 A.GO6:  TRO FF,FRMRGO   ;EVERYTHING ELSE, SET FLAG TO QUIT
7534         JRST (A)
7535
7536                 ;4.9(B) => .STOP ELSE .ISTOP
7537
7538 A.STOP: HRRZ A,MACP
7539         JUMPL B,A.STP1
7540         HRRZ B,(A)      ;.ISTOP
7541         CAIN B,REPT1
7542         HLLZS -2(A)     ;REPEAT, STOP ALL INTERATIONS
7543         CAIN B,AIRR
7544         HRRZS -1(A)     ;IRP TYPE, CLEAR OUT # GROUPS, DON'T ALLOW RECYCLE
7545 A.STP1: MOVE A,STOPPT
7546         MOVEM A,CPTR    ;CAUSE STOP
7547         JRST POPJ1
7548
7549 A.QOTE: JFCL
7550 ATERMI: ETSM [ASCIZ/Not in macro/]
7551         JRST MACCR      ;MAYBE FLUSH MESSAGE IF PEOPLE HAVE PROBLEMS
7552 \f
7553         ;PDL STRUCTURE FOR REPEAT
7554         ;TWO TWO WORD ENTRIES
7555         ;BBASE,,CPTR
7556         ;LIMBO1 STATUS,,# TIMES LEFT
7557         ;OLD .RPCNT,,BEG OF BODY
7558         ;GARBAGE,,REPT1
7559
7560 AREPEAT:        PUSHJ P,AGETFD
7561         JUMPLE A,COND5  ;NO REPEAT PLAY LIKE STRING COND FALSE
7562         PUSH P,A
7563         MOVE A,FREEPT
7564         MOVEM A,PRREPT  ;CHAR ADR BEGINNING OF REPEAT
7565         MOVEI A,373     ;CHECK CHAR FOR REPEAT
7566         PUSHJ P,PUTREL  ;STORE AS FIRST CHR OF BODY
7567         JSP D,RARL1
7568          CAIA
7569         CALL RARGCP     ;READ THE ARG & COPY INTO MACRO STORAGE.
7570         MOVEI A,^M      ;IF THE ARG WASN'T BRACKETED,
7571         TLNE FF,FLUNRD
7572          CALL PUTREL    ;INCLUDE THE TERMINATING CR.
7573 SWRET1: PUSHJ P,STPWR   ;ALSO RETURN FROM STRING WRITE (.F .I)
7574         POP P,B         ;# TIMES TO GO THROUGH
7575         PUSHJ P,PUSHEM
7576         MOVE B,MACP     ;NOW GET MACRO PDL POINTER FOR PUSH OF SECOND ENTRY
7577         MOVNI T,1
7578         EXCH T,CRPTCT   ;GET OLD .RPCNT, INITIALIZE NEW ONE TO -1
7579 CREPT1: SETZI TT,REPT1
7580         EXCH TT,PRREPT  ;GET LOC BEGINNING OF BODY, CLEAR OUT PRREPT, DON'T NEED IT ANYMORE
7581         HRL TT,T
7582         PUSH B,TT       ;SAVE OLD .RPCNT,,ADDRESS OF BODY.
7583         PUSH B,CREPT1   ;PUSH CRUD,,REPT1 FOR RETURN
7584         MOVEM B,MACP    ;STORE BACK UPDATED MACRO POINTER
7585         MOVE A,STOPPT
7586         MOVEM A,CPTR    ;CAUSE IMMEDIATE CYCLE
7587         JRST MACCR
7588
7589 IFN .I.FSW,[    ;CODING FOR .I, .F
7590
7591 SWINI:  MOVE A,FREEPT   ;INITIALIZE, WILL EVENTUALLY PLAY LIKE REPEAT 1
7592         MOVEM A,PRREPT
7593         MOVEI A,373
7594         JRST PUTREL
7595
7596 SWRET:  PUSH P,[1]      ;REPEAT COUNT
7597         JRST SWRET1
7598
7599 SWFLS:  MOVE A,PRREPT   ;FLUSH RETURN
7600         PUSHJ P,AFCOMP
7601         JRST MACCR
7602 ]
7603 \f
7604                 ;RECYCLE AROUND REPEAT
7605
7606 REPT1:  PUSH P,A
7607         PUSH P,C
7608         HRRZ A,(B)      ;CHAR ADR BEG BODY
7609         PUSHJ P,REDINC
7610         CAIE B,373
7611          HALT           ;FIRST CHAR OF REPEAT BODY NOT 373
7612         HRRZ C,MACP
7613         HRRZ B,-2(C)    ;# TIMES LEFT
7614         SOJL B,REPT2    ;JUMP IF LAST TIME THROUGH WAS LAST TIME TO GO THROUGH
7615         AOS CRPTCT
7616         PUSHJ P,ACPTRS  ;SET UP CPTR (CHAR ADR IN A)
7617         HRRM B,-2(C)    ;STORE UPDATED COUNTDOWN
7618 REPT3:  POP P,C
7619         POP P,A
7620         JRST REPT6
7621
7622 REPT2:  SOS A   ;MOVE BACK TO BEG OF REPEAT
7623                         ;(IN CASE GETS STORED INTO FREEPT)
7624         MOVE CH2,CPTR
7625         CCOMP CH2,-1    ;CONVERT TO CHARACTER ADDRESS
7626         CAMN CH2,FREEPT
7627         PUSHJ P,AFCOMP
7628         MOVE A,[-3,,-2]
7629         ADDB A,MACP
7630         HLRZ A,1(A)
7631         MOVEM A,CRPTCT
7632         PUSHJ P,POPEM
7633         JRST REPT3
7634 \f
7635                 ;STRING CONDITIONALS (IFSE, IFSN)
7636
7637 SCOND:  MOVE A,FREEPT
7638         MOVEM A,PRSCND
7639         MOVEM A,PRSCN1
7640         SAVE SYM
7641         HRRI B,SCONDF
7642         SAVE B          ;REMEMBER TEST INSTRUCTION.
7643         SETOB C,SCONDF
7644         JSP D,RARG      ;COPY THE 1ST OF THE 2 STRINGS
7645          CAIA
7646         CALL RARGCP     ;INTO MACRO STORAGE, FOLLOWED BY 375.
7647         CALL STPWR
7648         JSP D,RARG      ;THEN START READING THE 2ND ARG,
7649          JRST SCOND3    ;GO TO SCOND3 WHEN REACH END OF 2ND ARG.
7650         JSP D,RARGCH(T) ;READ NEXT CHAR OF 2ND ARG,
7651          JRST SCOND3
7652         EXCH A,PRSCND
7653         PUSHJ P,REDINC  ;RE-FETCH NEXT CHAR OF 1ST ARG
7654         EXCH A,PRSCND
7655         CAMN B,A        ;COMPARE CHARACTERS
7656          JRST RARGCH(T) ;CHARS EQUAL, KEEP COMPARING.
7657         CAIL A,"A+40
7658          CAILE A,"Z+40  ;NOT EQUAL => CONVERT BOTH TO UPPER CASE.
7659           CAIA
7660            SUBI A,40
7661         CAIL B,"A+40
7662          CAILE B,"Z+40
7663           CAIA
7664            SUBI B,40
7665         CAMN B,A        ;ARE THEY SAME EXCEPT FOR CASE?
7666          JRST RARGCH(T) ;CHARS EQUAL, KEEP COMPARING.
7667         CLEARM SCONDF   ;STRINGS DIFFER
7668         CALL RARFLS     ;IGNORE REMAINDER OF 2ND ARG.
7669 SCOND3: CLEARB A,C      ;END OF (SECOND) STRING ARG ENCOUNTERED
7670         EXCH C,PRSCN1
7671         MOVEM C,FREEPT
7672         PUSHJ P,FCOMP
7673         EXCH A,PRSCND
7674         PUSHJ P,REDINC
7675         CAIE B,375
7676         CLEARM SCONDF
7677         REST B
7678         REST SYM
7679         XCT B           ;DO THE TEST.
7680         JRST COND4
7681         JRST COND2
7682 \f
7683 VBLK
7684 BLCODE [DMYDEF: BLOCK DMDEFL]   ;TABLE OF DUMMY NAMES FOR THING BEING DEFINED
7685 DMYTOP: DMYDEF          ;POINTER INTO DMYDEF, POINTS TO AVAILABLE WORD
7686                 ;SINCE ONLY ONE THING CAN BE DEFINED AT ONCE, IT IS NOT NECESSARY TO SAVE AND RESTORE DMYTOP
7687 DMYBOT: DMYDEF  ;-> 1ST DMYDEF WD USED AT THIS LEVEL.
7688         ;RIGHT NOW, ALWAYS -> DMYDEF SINCE CAN'T HAVE DEFINITION
7689         ;WITHIN A DEFINITION YET.
7690
7691 PBLK
7692
7693 PDEF:   PUSHJ P,GSYL    ;READ IN SYL
7694         CAIE T,",       ;IF DELIMITING CHR NOT ,
7695          JUMPE SYM,CPOPJ        ;AND SYM NULL, RETURN
7696 PDEF1:  MOVEM SYM,@DMYTOP       ;STORE SYM
7697         AOS D,DMYTOP            ;INCR PNTR
7698         CAIL D,DMYDEF+DMDEFL    ;CHECK FOR TABLE SIZE EXCEEDED
7699          ETF [ASCIZ/Too many dummies in DEFINE or IRP/]
7700         POPJ P,
7701
7702 VBLK
7703 BLCODE [DSTG:   BLOCK DSSIZ]    ;TABLE OF CHAR ADRS OF DUMMIES BEING DEFINED PRIOR TO MACRO EXPANSION
7704 RDWRDP: DSTG            ;POINTER TO DSTG, POINTS TO FREE WORD
7705                 ;NOTE THAT RDWRDP MUST BE SAVED AND RESTORED SINCE MORE MACROS CAN
7706                 ;BE EXPANDED DURING FIELD READ FOR DUMMY
7707 PBLK
7708
7709 ADDTR1: CLEARM PUTCNT
7710 ADDTRN: MOVE A,FREEPT
7711 ADDTR2: MOVEM A,@RDWRDP
7712         AOS A,RDWRDP
7713         CAIL A,DSTG+DSSIZ
7714          ETF [ASCIZ/Too many dummies in all macros & IRPs being expanded/]
7715         RET
7716
7717 VBLK
7718 BLCODE [DMYAGT: BLOCK DMYAGL]   ;TABLE OF CHAR ADRS OF DUMMYS OF MACROS BEING EXPANDED
7719                 ;DMYAGT TRACKS WITH THE MACRO PDL;
7720                 ;DMYAGT CAN'T BE COMBINED WITH DSTG SINCE DMYAGT CAN BE SHIFTING AROUND RANDOMLY DURING ARG SCAN
7721 BBASE:  DMYAGT          ;POINTER TO BEGINNING OF ACTIVE DUMMY LIST (FOR DEEPEST-NESTED MACRO BEING EXPANDED)
7722                 ;ADD TO DUMMY # TO GET LOCATION CONTAINING CHAR ADR OF DUMMY
7723 TOPP:   DMYAGT          ;POINTER TO TOP OF DMYAGT ACTIVE, POINTS TO FREE REGISTER
7724 PBLK
7725
7726                 ;ACTIVATE DUMMYS ON TOP OF DSTG TABLE
7727                 ;A -> FIRST (LOWEST) DUMMY IN DSTG TO ACTIVATE
7728
7729 DMYTRN: MOVE B,TOPP
7730         MOVEM B,BBASE
7731         PUSH P,A
7732 DMYTR2: CAML A,RDWRDP
7733         JRST DMYTR1
7734         MOVE B,(A)
7735         MOVEM B,@TOPP
7736         AOS B,TOPP
7737         CAIL B,DMYAGT+DMYAGL
7738          ETF [ASCIZ /Too many dummy args active/]
7739         AOJA A,DMYTR2
7740 DMYTR1: POP P,RDWRDP
7741         POPJ P,
7742 \f
7743 ;THE MACRO TABLE IS FILLED MAINLY WITH 8-BIT BYTES.
7744 ;THE FIRST WORD'S ADDR IS IN MACTAD; THE LAST+1'S IN MACTND.
7745 ;THE CHARACTER NUMBER OF THE LAST+1ST CHAR IS IN MACHI.
7746 ;MACHIB IS BP. TO HIGHEST BYTE OK TO FILL (LAST IN C(MACTND)-1)
7747
7748 ;IF A BYTE IN THE TABLE HAS ITS HIGH BIT OFF, IT IS AN ASCII CHARACTER.
7749 ;OTHERWISE, IT IS SPECIAL. IF THE 100 BIT IS OFF IT MEANS
7750 ;SUBSTITUTE A MACRO DUMMY ARG WHEN READ; THE CHAR IS THE NUMBER OF THE ARG+200 .
7751
7752 ;377 AND 375  ARE STOP CODES, CAUSING A POP OUT OF THE CURRENT STRING.
7753 ;GC CONSIDERS THE CHAR. AFTER A 375 TO START A NEW STRING.
7754
7755 ;376 IS IGNORED WHEN READ; USED TO CLOBBER UNWANTED CHARACTERS IN STRINHGS.
7756
7757 ;374 STARTS EVERY MACRO-DEFINITION.
7758 ;373 STARTS THE BODY OF A REPEAT.
7759
7760 ;370 STARTS A WORD STRING:
7761 ;THE WORD AFTER THAT WHICH CONTAINS THE 370
7762 ; HAS THE LENGTH IN WORDS OF THE STRING IN ITS LH,
7763 ; IN ITS RH, THE ADDRESS OF WD WHICH POINTS BACK TO THIS ONE.
7764 ; THEN FOLLOW RANDOM WDS HOLDING ANYTHING AT ALL.
7765 ; GC WILL MAKE SURE IT STAYS ON WD BOUNDARY.
7766 ; THE LENGTH INCLUDES THE WD HOLDING THE LENGTH.
7767 ; IF THE RH OF 1ST WD HAS 0, GC WILL FLUSH THE STRING
7768
7769 STRTYP: PUSHJ P,REDINC  ;DEBUGGING AID ONLY
7770         EXCH A,B
7771         TRZE A,200
7772         JRST STRTP1
7773 STRTP2: PUSHJ P,TYO     ;NORMAL CHAR, JUST TYPE OUT
7774         MOVE A,B
7775         JRST STRTYP
7776
7777 STRTP1: PUSH P,A
7778         MOVEI A,"*      ;SPECIAL CHAR, TYPE *
7779         PUSHJ P,TYO
7780         POP P,A
7781         TRNE A,100
7782         JRST STRTP3     ;CONTROL CHAR
7783         ADDI A,260      ;DUMMY, CONVERT TO #
7784         JRST STRTP2     ;TYPE OUT (SINGLE DIGIT) NUMBER
7785
7786 STRTP3: CAIN A,175
7787         SKIPA A,C%      ;STOP, TYPE %
7788         MOVEI A,"/      ;SOMETHING ELSE, TYPE /
7789         JRST STRTP2
7790
7791
7792                 ;.GSSET, SET GENERATED SYM COUNTER
7793
7794 A.GSSET:        CALL AGETFD
7795         MOVEM A,GENSM
7796         JRST ASSEM1
7797 \f
7798                 ;GSYL-LIKE ROUTINE, READ A SYL FOR WRQOTE
7799
7800 WRQRR:  PUSHJ P,RCH     ;GET CHAR (MAYBE WANT THIS TO BE FASTER YET)
7801         IDPB A,FREPTB   ;DEPOSIT IN MACRO TABLE
7802         CAMN F,FREPTB   ;WAS THIS LAST CHAR IN TABLE?
7803         JRST WRQRGC     ;YES, NEED GARBAGE COLLECTION
7804 WRQRR2: XCT GDTAB(A)    ;DISPATCH ON CHAR
7805         JFCL            ;(MAYBE SKIPS)
7806         SOJGE D,WRQRR   ;LOOP FOR FIRST SEVEN CHARS
7807         HRRI D,0
7808         JRST WRQRR
7809
7810                 ;HERE FROM WRQRR WHEN NEED GARBAGE COLLECTION OF MACRO TABLE
7811
7812 WRQRGC: MOVEM C,WRQTBP  ;PUT POINTER TO BEGINNING OF SYL WHERE IT WILL BE GC'D
7813         MOVE A,MACHI
7814         PUSHJ P,GCA     ;GARBAGE COLLECT
7815         MOVE F,MACHIB   ;RESET F TO POINT TO NEW LAST CHAR IN MACTAB
7816         MOVEI C,0
7817         EXCH C,WRQTBP   ;GET BACK POINTER TO CHAR BEFORE SYL
7818         MOVE A,LIMBO1   ;RETRIEVE LAST CHAR READ
7819         JRST WRQRR2     ;LOOP BACK, PROCESS CHAR
7820
7821                 ;HERE FROM WRQOTE IF .QUOTE SEEN
7822                 ;.QUOTE TAKES ARG LIKE ASCII, PRINTC, ETC.
7823
7824 A.QOT1: MOVE A,WRQBEG(P) ;GET BACK BP TO CHAR BEFORE .QUOTE
7825         PUSHJ P,A.QOTS  ;SET UP FREEPT AND FREPTB PROPERLY
7826         MOVE A,LIMBO1   ;NOW GET CHAR AFTER .QUOTE
7827         CAIE A,^I
7828         CAIN A,40       ;COMPARE WITH SPACE
7829         PUSHJ P,RCH     ;SPACE, GOBBLE NEXT CHAR FOR DELIMITER, ELSE THIS ONE
7830         MOVEM A,A.QOT2  ;STORE AS TERMINATOR OF STRING
7831 A.QOT3: PUSHJ P,RCH     ;GET CHAR TO QUOTE
7832         CAMN A,A.QOT2   ;TERMINATOR?
7833         JRST WRQOT1     ;TERMINATOR, BACK FOR MORE DEFINITION
7834         PUSHJ P,PUTREL  ;DEPOSIT CHAR
7835         JRST A.QOT3
7836 \f
7837                 ;READ IN BODY OF MACRO, IRP, OR WHATEVER
7838
7839 WRQOTE: SAVE [0]        ;USED FOR LENGTH OF SYMBOL (REALLY 6 MINUS IT).
7840 WRQLEN==,-2
7841         SAVE [0]        ;THIS WD USED FOR DEFINE/TERMIN COUNT.
7842 WRQLVL==,-1
7843         SAVE [0]        ;USED TO REMEMBER BEGINNING OF SYMBOL.
7844 WRQBEG==0
7845         SETOM INICLB    ;CLOBBERED INITS, .SYMTAB NOW ILLEGAL.
7846         PUSHJ P,RCH     ;MAYBE POP UP A LEVEL IN EXPANSIONS, SAVE MACTAB SPACE
7847         TLO FF,FLUNRD   ;CAUSE CHAR TO BE RE-INPUT
7848         MOVE F,MACHIB   ;POINTER TO LAST CHAR OK TO PUT IN MACTAB, STAYS IN F
7849         TRO I,IRSYL\IRLET       ;MAKE SURE FLAGS SET SO WON'T WASTE TIME AT MAKNUM, POINT
7850 WRQOT0:
7851 WRQOT1: MOVEI D,6       ;SQUOZE COUNTER
7852         MOVEI SYM,0     ;INITIALIZE SYM
7853         MOVE C,FREPTB   ;GET POINTER TO CHAR BEFORE SYL ABOUT TO READ
7854         PUSHJ P,WRQRR   ;READ SYL
7855         JUMPE SYM,.-2   ;LOOP UNTIL NON-NULL
7856                 ;NOW SEE IF DUMMY; **NOTE**: C STILL HAS BYTE POINTER, A SYL TERMINATOR
7857         MOVE B,DMYBOT
7858         CAML B,DMYTOP
7859         JRST WRQOT2     ;NOT DUMMY
7860         CAME SYM,(B)    ;COMPARE WITH DUMMY NAME
7861         AOJA B,.-3      ;LOOP ON NO MATCH
7862         SUB B,DMYBOT    ;DUMMY, CONVERT TO NUMBER + 200
7863         SUBI B,200
7864         LDB T,C         ;GET LAST CHAR BEFORE SYL
7865         CAIE T,"!       ; ^ NOTE THAT THIS CAN LOSE IF MACRO HAS 33. ARGS
7866         IDPB B,C        ;NOT EXCLAMATION POINT, LEAVE THERE, DEPOSITING DUMMY CHAR
7867         CAIN T,"!
7868         DPB B,C         ;EXCL, WIPE IT OUT
7869         MOVEM C,FREPTB  ;RESET FREPTB
7870         CAIE A,"!       ;A HAS DUMMY TERMINATOR, COMPARE WITH EXCL
7871         TLO FF,FLUNRD   ;NOT EXCLAMATION POINT, CAUSE IT TO BE RE-INPUT
7872         JRST WRQOT1     ;LOOP BACK FOR NEXT SYL
7873
7874 ;SYL ISN'T DUMMY, CHECK FOR PSEUDO
7875 WRQOT2: MOVEM D,WRQLEN(P) ;REMEMBER START OF AND LENGHTH OF THE SYMBOL.
7876         MOVEM C,WRQBEG(P)
7877         SETOM ESBK      ;EVAL IN CURRENT BLOCK.
7878         PUSHJ P,ES      ;EVALUATE SYM (DOESN'T CLOBBER F)
7879         JRST WRQOT0     ;NOT SEEN
7880         CAIE A,PSUDO/40000
7881         JRST WRQOT0     ;NOT PSEUDO
7882         TLZ B,-1        ;CLEAR OUT LH OF VALUE, ONLY INTERESTED IN RH
7883         CAIN B,A.QOTE
7884         JRST A.QOT1     ;.QUOTE
7885         CAIE B,ADEFINE
7886         CAIN B,AIRP
7887         AOS WRQLVL(P)   ;DEFINE OR IRP
7888 IFN RCHASW,[CAIN B,A.TTYM
7889         AOS WRQLVL(P)   ;.TTYMAC
7890 ]
7891         CAIE B,ATERMIN
7892          JRST WRQOT0
7893         SKIPGE WRQLEN(P)
7894          ETR [ASCIZ /TERMIN longer than 6 chars/]
7895         SOSL WRQLVL(P)  ;TERMIN, SKIP IF THE TERMINATING ONE
7896          JRST WRQOT0    ;NOT MATCHING TERMIN, BACK FOR NEXT SYL
7897         POP P,A         ;GET BACK BP TO LAST CHAR BEFORE TERMIN
7898         SUB P,[2,,2]    .SEE WRQLVL,WRQBEG
7899         MOVE T,DMYBOT   ;WE'RE NO LONGER USING SPACE IN DMYDEF.
7900         MOVEM T,DMYTOP
7901 A.QOTS: LDB T,A         ;HERE ALSO FROM A.QOT1, GET CHAR BEFORE .QUOTE OR TERMIN
7902         CAIE T,"!
7903         JRST A.QTS2     ;NOT EXCLAMATION POINT => OK
7904         DBPM A,         ;EXCLAMATION POINT, DECREMENT POINTER
7905 A.QTS2: MOVEM A,FREPTB  ;STORE AS NEW FREPTB
7906         CCOMP1 A,-1     ;CONVERT TO CHAR ADR
7907         MOVEM B,FREEPT  ;STORE CHAR ADR AS NEW FREEPT
7908         POPJ P,
7909 \f
7910 ;FORMAT OF A MACRO:
7911 ;IT STARTS WITH A 374.
7912 ;THEN COME ARGUMENT DESCRIPTORS, ONE PER ARGUMENT.
7913 MCF==777650     ;BITS AND FIELDS ARE:
7914 MCFDEF==200     ;ARG IS DEFAULTED. MCFDEF AND MCFGEN NEVER BOTH SET.
7915 MCFGEN==100     ;ARG SHOULD BE GENSYMMED IF NOT GIVEN IN CALL.
7916 MCFKWD==40      ;ARG IS A KEYWORD ARG, SELECTED BY <ARGNAME>= RATHER THAN POSITION.
7917 MCFSYN==7       ;FIELD THAT SPECIFIES THE ARGUMENT'S SYNTAX.
7918  MCFNRM==1      ;MCFSYN CONTAINS MCFNRM => NORMAL-SYNTAX ARG
7919  MCFLIN==2      ;MCFSYN CONTAINS MCFLIN => WHOLE LINE ARG
7920  MCFBAL==3      ;MCFSYN CONTAINS MCFBAL => BALANCED ARG
7921  MCFSTR==4      ;MCFSYN CONTAINS MCFSTR => ARG IS A DELIMITED STRING, AS IN "ASCIZ".
7922  MCFEVL==5      ;MCFSYN CONTAINS MCFEVL => ARG IS BY VALUE (PREEVALUATED).
7923 ;IF MCFKWD IS SET, THE DESCRIPTOR IS FOLLOWED BY THE NAME OF THE ARGUMENT,
7924 ;TERMINATED BY A 377.
7925 ;IF MCFDEF IS SET, THE DESCRIPTOR IS FOLLOWED BY THE DEFAULT VALUE OF THE ARG,
7926 ;TERMINATED BY A 377.
7927 ;IF MCFKWD AND MCFDEF ARE BOTH SET, THE ARG NAME COMES FIRST.
7928 ;A ZERO BYTE ENDS THE DESCRIPTOR LIST.
7929 ;THEN COMES THE BODY OF THE MACRO, FOLLOWED BY A 375.
7930
7931 ADEFINE:        NOVAL   ;ERROR IF CONTEXT WANTS A VALUE.
7932         SAVE CASSM1     ;RETURN TO ASSEM1 EVENTUALLY
7933         JSP TM,ERMARK   ;ERR MSGS SHOULD SAY WE'RE INSIDE A DEFINE.
7934         SAVE SYM        ;THESE 2 PUSHES ARE FOR NONAME'S SAKE.
7935         SAVE SYM
7936         CALL GETSLD
7937          CALL NONAME
7938         TLZ FF,FLUNRD
7939         SUB P,[2,,2]
7940         SAVE SYM
7941         SAVE ESBK       ;SAVE BLOCK TO DEFINE IN FOR ES'S SAKE.
7942 IFN CREFSW,XCT CRFMCD
7943         CALL A.TYM1
7944         POP P,ESBK
7945         REST SYM
7946         PUSHJ P,ESDEF   ;FIND SLOT IN SYMBOL TABLE FOR IT
7947          TLO C,3MACOK   ;NEVER SEEN, OK TO MAKE MACRO.
7948         TLON C,3MACOK   ;ELSE ERROR IF NUMERIC OR ALREADY USED.
7949          ETSM [ASCIZ/Non-macro made macro/]
7950         MOVEI B,MACCL   ;RH(VALUE) = MACCL
7951         HRL B,PRDEF     ;LH(VALUE) = CHAR ADR OF MACRO
7952         CLEARM PRDEF    ;NO LONGER NEED PRDEF
7953         MOVSI T,PSUDO   ;SYMBOL TABLE ENTRY LOOKS LIKE PSEUDO
7954         JRST VSM2
7955
7956 IFN RCHASW,[
7957         ;.TTYMAC NAME
7958         ;BODY
7959         ;TERMIN
7960
7961         ;NAME DUMMY, CAUSES READIN OF CRUD FROM TTY -> CR (NOT INCLUSIVE)
7962
7963 A.TTYM: JSP TM,ERMARK   ;ERROR MSGS SHOULD SAY WE'RE INSIDE A .TTYMAC
7964         CALL A.TYM1     ;READ IN A MACRO-DEFINITION.
7965         MOVEI A,40      ;DON'T LET THE CHAR ENDING THE TERMIN
7966         MOVEM A,LIMBO1  ;MAKE MACCL THINK THERE ARE NO ARGS.
7967         CALL GTYIP1     ;PUSH INTO TTY FOR INPUT
7968         HRLZ B,PRDEF    ;PHONY UP A MACRO WHOSE DEFN IS WHAT WE READ.
7969         SETZM PRDEF
7970         MOVEI A,A.TYM8
7971         JRST A.TYM2     ;CALL THE MACRO:
7972                 ;READ THE ARGS, POP OUT OF TTY, EXPAND THE MACRO
7973                 ;AND THEN EXIT TO A.TYM8
7974 ]
7975 \f
7976 A.TYM1: MOVE A,FREEPT
7977         MOVEM A,PRDEF
7978         MOVEI LINK,MCFNRM       ;INITIALLY, DUMMIES ARE NORMAL.
7979         MOVEI A,374
7980         PUSHJ P,PUTREL  ;MARK BEGINNING OF MACRO
7981 DEFNI:  MOVE T,LIMBO1
7982         MOVE A,LINK
7983 DEFNC:  CAIE T,12
7984          CAIN T,15
7985           JRST DEFNA    ;NO MORE ARGS (DONE WITH LINE)
7986         CAIE T,LBRACE
7987          CAIN T,LBRKT
7988           JRST DEFNB1
7989         CAIE T,RBRACE
7990          CAIN T,RBRKT
7991           JRST DEFNB2
7992         CAIE T,"<       ;OPENS TURN ON BALANCEDNESS.
7993          CAIN T,"(
7994           JRST DEFNB1
7995         CAIE T,">       ;CLOSES TURN OFF BALANCEDNESS.
7996          CAIN T,")
7997           JRST DEFNB2
7998         CAIN T,"?       ;? TURNS BALANCEDNESS ON OR OFF.
7999          JRST DEFBAL
8000         CAIN T,"+       ;+ COMPLEMENTS KEYWORDNESS
8001          XORI LINK,MCFKWD
8002         CAIN T,"\       ;\ COMPLEMENTS GENSYMMEDNESS
8003          XORI LINK,MCFGEN
8004         CAIN T,"-       ;- TURNS WHOLELINENESS ON OR OFF.
8005          JRST DEFWHL
8006         CAIN T,"*       ;* TURNS ASCIZ-STYLE-NESS ON OR OFF.
8007          JRST DEFASC
8008         CAIN T,"#       ;# TURNS EVALUATEDNESS ON OR OFF.
8009          JRST DEFEVL
8010         CAIN T,":       ;: MAKES FOLLOWING ARGS NORMAL
8011          MOVEI LINK,MCFNRM      ;IN ALL RESPECTS
8012         CAIN T,";
8013          JRST DEFNSM    ;ALLOW DEFINE LINE TO BE COMMENTED
8014 DEFND:  SAVE A
8015         CALL GSYL       ;READ IN SYMBOL AS SQUOZE IN SYM.
8016         REST A
8017         CAIN T,"/       ;/ MEANS PREVIOUS ARG IS WHOLE-LINE.
8018          XORI LINK,MCFLIN#MCFNRM
8019         JUMPE SYM,DEFNC ;JUMP IF SYMBOL NAME WAS NULL.
8020         CALL PDEF1      ;ELSE PUSH IT ON LIST OF DUMMIES.
8021         MOVE A,LINK
8022         CAIE T,"=
8023          JRST DEFNL
8024         IORI A,MCFDEF   ;ONE ARG, WITH DEFAULT VALUE.
8025         ANDCMI A,MCFGEN ;NOT TO BE GENSYMMED.
8026 DEFNL:  CALL PUTREL     ;OUTPUT A DESCRIPTOR FOR THIS ARG
8027         TRNE LINK,MCFKWD
8028          CALL DEFNM     ;PUT OUT ARG NAME IF KWD ARG
8029         CAIE T,"=       ;THEN DEFAULT VALUE IF DEFAULTED.
8030          JRST DEFNI
8031         JSP D,RARG      ;INIT. FOR READING THE DEFAULT VALUE.
8032          CAIA
8033         CALL RARGCP     ;COPY THE ARG INTO MACRO SPACE,
8034         CALL PUT377     ;TERMINATED BY A 377.
8035         JRST DEFNI      ;NOW FOR THE NEXT ARG.
8036
8037 DEFNM:  MOVE D,[440700,,STRSTO]
8038 DEFNM1: ILDB A,D
8039         CAMN D,STRPNT
8040          JRST PUT377
8041         CALL PUTREL
8042         JRST DEFNM1
8043
8044 DEFEVL: SKIPA A,[MCFEVL]        ;TURN EVALUATEDNESS ON OR OFF.
8045 DEFASC: MOVEI A,MCFSTR          ;TURN ASCIINESS ON OR OFF.
8046         JRST DEFN9
8047
8048 DEFBAL: SKIPA A,[MCFBAL]        ;TURN ON BALANCEDNESS, BUT IF ALREADY ON TURN OFF.
8049 DEFWHL:  MOVEI A,MCFLIN         ;SIMILAR FOR WHOLELINENESS.
8050 DEFN9:  LDB B,[.BP MCFSYN,LINK]
8051         CAMN A,B                ;IF CURRENT STATE IS SAME AS IN A,
8052          MOVEI A,MCFNRM         ;SWITCH TO NORMAL MODE INSTEAD.
8053         DPB A,[.BP MCFSYN,LINK]
8054         JRST DEFND
8055
8056 DEFNB2: SKIPA A,[MCFNRM]        ;TURN OFF BALANCEDNESS
8057 DEFNB1: MOVEI A,MCFBAL          ;TURN ON BALANCEDNESS
8058         DPB A,[.BP MCFSYN,LINK]
8059         JRST DEFND
8060
8061 DEFNSM: PUSHJ P,RCH     ;SEMICOLON IN DEFINE LINE
8062         CAIE A,15
8063         CAIN A,12
8064 DEFNA:  SKIPA A,LINK    ;END OF DEFINE LINE, GET COUNT
8065         JRST DEFNSM
8066         MOVEI A,0
8067         PUSHJ P,PUTREL  ;DEPOSIT END-OF-DESCRIPTORS MARK
8068         PUSHJ P,RCH
8069         CAIE A,12
8070         TLO FF,FLUNRD   ;CHAR AFTER CR NOT LF
8071         PUSHJ P,WRQOTE  ;READ IN BODY
8072         JRST STPWR
8073 \f
8074 ;COME HERE TO EXPAND MACRO; LH OF B POINTS TO STRING.
8075 ;SYM HOLDS NAME OF MACRO (USED BY CALL TO AGETFD IN MACEVL).
8076 MACCL:  JSP TM,ERMARK   ;ERROR MESSAGE DURING ARG SCAN SHOULD SAY WE'RE IN IT.
8077         MOVEI A,RCHSV1
8078 A.TYM2: SAVE I
8079         AOS PRCALP
8080         AOS MDEPTH
8081         SAVE RDWRDP
8082         SAVE A          ;RCHSV1 FOR MACRO, A.TYM8 FOR .TTYMA
8083         MOVEI LINK,0
8084         HLRZ A,B
8085         PUSHJ P,REDINC
8086         CAIE B,374
8087          HALT
8088         MOVEM A,@PRCALP
8089         PUSHJ P,REDINC
8090         JUMPE B,[TLO FF,FLUNRD  ;SAVE CHR FOLLOWING MACRO W/NO ARGUEMENTS
8091                 TLZ I,ILPRN     ;SUCH MACROS
8092                 SKIPE B,ASMOUT  ;IF WITHIN A GROUPING,
8093                  CAIN B,4
8094                   JRST MACNX0
8095                 JSP LINK,SAVAS2 ;RESTORE ASMDSP TO NORMAL IN CASE
8096                 JRST MACNX0]    ;THE CHAR BEING REREAD IS A CLOSE.
8097         TLZ I,ILPRN
8098         MOVE A,LIMBO1
8099         CAIE A,15
8100          CAIN A,12
8101           JRST MACCLD   ;NO ARGS IN THIS CALL; NULLIFY ALL ARGS.
8102         CAIE A,"<
8103          CAIN A,"(
8104           TLO I,ILPRN   ;BUT MAYBE THERE IS A (. IF SO, IT'S A PAREN'D CALL,
8105         CAIN A,LBRKT    ;AND WON'T END TILL THE MATCHING CLOSE.
8106          TLO I,ILPRN
8107         CAIE A,40       ;IF THE CHAR ENDING THE MACRO NAME ISN'T AN OPENPAREN,
8108          CAIN A,^I      ;EOL, OR SPACE, RE-READ IT AS PART OF 1ST MACRO ARG.
8109           JRST MACNX0
8110         TLNN I,ILPRN
8111          TLO FF,FLUNRD
8112 MACNX0: TDZ LINK,LINK
8113 MACNXD: CALL MACDES     ;FETCH NEXT DESCRIPTOR
8114          JRST MACPUS    ;NO MORE => THIS IS END OF THE CALL
8115         TRNE LINK,MCFKWD
8116          JRST MACK      ;KEYWORD PARAM => SPECIAL SCANNER
8117 ;READ IN THE VALUE OF THE NEXT ARG, WHICH IS NORMAL (NOT KEYWORD)
8118 MACNRM: CALL ADDTRN     ;PUSH WORD TO HOLD VALUE OF ARG ONTO DSTG,
8119                         ;INITIALIZED -> FREEPT, WHERE WE WILL NOW WRITE THE ARG.
8120         SOS C,A         ;TELL MACRED WHERE THAT WORD IS.
8121         CALL MACRED     ;READ IN THE ARGUMENT VALUE.
8122          JRST MACNXD    ;THEN HANDLE ANOTHER ARG
8123          .VALUE
8124         JRST MACCLD     ;END OF ARG LIST => NULLIFY REMAINING ARGS.
8125 \f
8126 ;READ IN THE NEXT MACRO ARGUMENT ACC TO SYNTAX FLAGS IN LINK.
8127 ;C HAS ADDRESS OF WORD ON THE RDWRDP STACK WHICH HOLDS THE POINTER TO THIS ARG
8128 ;IN CASE WE WISH TO SET THE ARG TO THE NULL STRING.  B AND LINK NOT CLOBBERED.
8129 ;RETURNS SKIPPING TWICE IF NO ARG BECAUSE END OF MACRO CALL SEEN.
8130 MACRED: MOVEI D,MACNXR  ;RARL3, RARB, RARGBR RETURN TO MACNXR
8131         CALL RCH
8132         CAIE A,^M
8133          CAIN A,^J
8134           JRST MACEND   ;MAYBE WE HAVE REACHED THE END OF THE MACRO CALL.
8135         LDB B,[.BP MCFSYN,LINK]
8136         CAIN B,MCFLIN
8137          JRST RARL3     ;ELSE, IF WHOLELINE ARG, NOTHING ELSE TO CHECK,
8138                         ;SO INIT FOR READING IT IN.
8139         CAIN A,",
8140          JRST MACNUL    ;NON-WHOLELINE ARG IS NULL IF NEXT CHAR IS COMMA
8141         CAIN A,";       ;SEMICOLON ENDS ARG LIST UNLESS INSIDE WHOLELINE ARG
8142          JRST MACEND
8143         CAIN B,MCFBAL
8144          JRST RARB      ;FOR BALANCED ARG, NOTHING ELSE SPECIAL, SO INIT.
8145         CAIN B,MCFSTR
8146          JRST MACSTR
8147         CAIN B,MCFEVL   ;FOR EVALUATED ARG, READ FIELD AND EXPRESS AS NUMERAL.
8148          TLOA FF,FLUNRD  ;AND THE CHAR WE JUST READ WAS THE 1ST CHAR OF THE FIELD.
8149         CAIN A,"\       ;NORMAL ARG STARTING WITH "\" TREATED THE SAME WAY, BUT FIELD
8150          JRST MACEVL     ;STARTS WITH NEXT CHAR.
8151         CAIN A,LBRKT
8152          JRST RARGBR    ;FOR ORDINARY ARG, OPEN-BRACKET MAKES IT SPECIAL
8153 IFN BRCFLG,[
8154         CAIN A,LBRACE
8155          JRST RARGRR
8156 ]
8157         MOVEI T,RARGN   ;OTHERWISE IT'S A NORMAL ARG
8158         TLOA FF,FLUNRD  ;AND THE CHAR WE RCH'ED IS THE 1ST CHAR OF IT
8159 MACNXR:  JRST MACEN1    ;NON-SKIP RETURN FROM RARB, RARL3 OR RARGBR => ARG NULL
8160         CALL RARGCP     ;ARG NON-NULL => COPY IT INTO STRING SPACE
8161         CAIE A,";
8162 CSTPWR:  JRST STPWR     ;AND TERMINATE IT
8163 MACSC:  MOVE A,(C)      ;EXCEPT THAT SEMICOLONS INVALIDATE ALL THE SPACES
8164         CAME A,FREEPT   ;AND TABS THAT PRECEDE THEM.
8165          JRST STPWR     ;IF, AS A RESULT OF THAT, THE ARG IS NULL, END THE ARGLIST.
8166 ;COME HERE WHEN THE END OF THE MACRO'S WHOLE ARGLIST IS SEEN.
8167 MACEND: TLO FF,FLUNRD
8168 MACEN1: AOS (P)         ;2-SKIP RETURN FROM MACRED INDICATES END OF ARGLIST
8169         AOS (P)         ;END OF ARGLIST => THIS ARG IS NULL.
8170 ;COME HERE TO NULLIFY CURRENT ARG (WHERE C POINTS)
8171 MACNUL: TRZE LINK,MCFDEF
8172          JRST MACDEF    ;MAYBE DEFAULT IT
8173         TRNE LINK,MCFGEN
8174          JRST MACGEN    ;MAYBE GENSYM IT
8175         SETZM (C)       ;ELSE SET TO NULL STRING.
8176         RET
8177
8178 MACST1: CALL RCH
8179         CAIN A,",
8180          JRST MACNUL
8181 MACSTR: CAIE A,40       ;HERE FOR ARG DELIMITED LIKE TEXT STRINGS: /TEXT/.
8182          CAIN A,^I      ;SKIP ALL SPACES AND TABS BEFORE THE ARG.
8183           JRST MACST1
8184         JSP D,RARB      ;FIND END OF LINE, COMMENT, OR CLOSEBRACKET =>
8185          JRST MACEND     ;NULLIFY ARG AND END MACRO CALL.
8186         MOVE T,A        ;ELSE SAVE THIS CHAR;  IT'S THE DELIMITER.
8187         TLZA FF,FLUNRD
8188 MACST2:  CALL PUTREL
8189         CALL RCH        ;READ ANOTHER CHARACTER.  IF IT ISN'T THE DELIMITER,
8190         CAME A,T
8191          JRST MACST2    ;STORE IT AND READ ANOTHER.
8192         CALL STPWR
8193 MACST3: CALL RCH        ;PASS BY SPACES AFTER THE CLOSING DELIMITER
8194         CAIE A,40
8195          CAIN A,^I
8196           JRST MACST3
8197         CAIE A,",       ;COMMA HERE ENDS THE ARG BUT NOT THE MACRO CALL.
8198          JSP D,RARB     ;ELSE CHECK FOR OTHER TERMINATORS.
8199           RET           ;WE FOUND AN ACCEPTABLE ARG TERMINATOR.
8200         ETR [ASCIZ /Garbage in ASCIZ-style macro arg/]
8201         JRST RARFLS     ;IF THERE'S ANYTHING ELSE, COMPLAIN AND SKIP IT.
8202 \f
8203 ;COME HERE TO GIVE AN ARG ITS DEFAULT VALUE.
8204 ;MCFDEF WAS CLEARED SO MACDES WILL KNOW THE DEFAULT VALUE HAS
8205 ;ALREADY BEEN PASSED OVER AND WON'T TRY TO SKIP OVER IT.
8206 ;IF MCFKWD IS SET, WE MUST SKIP OVER THE KWD ARG'S NAME FIRST.
8207 MACDEF: MOVE A,@PRCALP  ;COPY THE DEFAULT VALUE FROM THE MACRO BODY
8208         TRZN LINK,MCFKWD
8209          JRST MACDF1
8210 MACDF0: CALL REDINC
8211         CAIE B,377
8212          JRST MACDF0
8213 MACDF1: CALL REDINC     ;AS THE ARGUMENT STRING.
8214         CAIN B,377
8215          JRST MACDF2    ;END OF THE DEFAULT VALUE.
8216         EXCH A,B
8217         CALL PUTREL
8218         EXCH A,B
8219          JRST MACDF1
8220
8221 MACDF2: MOVEM A,@PRCALP
8222         JRST STPWR
8223
8224 ;COME HERE IF GENSYMMABLE ARG IS SPEC'D AS NULL.
8225 MACGEN: MOVEI A,5
8226         MOVEM A,SCKSUM
8227         MOVEI A,"G
8228         PUSHJ P,PUTREL
8229         SAVE CSTPWR
8230         AOS A,GENSM
8231         IDIVI A,10
8232         HRLM B,(P)
8233         SOSLE SCKSUM
8234         PUSHJ P,.-3
8235         JRST MACEV2
8236
8237 ;PROCESS ARG THAT STARTS WITH \, OR #-TYPE ARG.
8238 MACEVL: CALL RCH        ;FIRST, CHECK FOR IMMEDIATE END OF MACRO CALL.
8239         JSP D,RARB
8240          JRST MACEN1
8241         SAVE C
8242         PUSH P,LINK     ;SAVE LINK, NEED FLAGS
8243         PUSHJ P,AGETFD  ;GET THE FIELD
8244         SKIPE B
8245          ETR [ASCIZ /Relocatable \'d macro arg/]
8246         POP P,LINK
8247         REST C          ;IF AGETFD EXPANDED A MACRO, FREEPT HAS CHANGED, SO
8248         MOVE CH1,FREEPT ;PUT NEW VALUE INTO THE POINTER TO THIS DUMMY.
8249         MOVEM CH1,(C)
8250         MOVE CH1,A      ;SAVE VALUE OF FIELD FROM CLOBBERAGE
8251         SAVE CSTPWR
8252 MACEV1: LSHC CH1,-35.   ;NOW "TYPE OUT" VALUE OF FIELD IN CURRENT RADIX
8253         LSH CH2,-1
8254         DIV CH1,ARADIX
8255         HRLM CH2,(P)
8256         JUMPE CH1,.+2
8257         PUSHJ P,MACEV1
8258 MACEV2: HLRZ A,(P)
8259         ADDI A,60
8260         JRST PUTREL     ;OUTPUT TO MACTAB STRING BEING DEFINED
8261 \f
8262 ;HANDLE KEYWORD PARAMETERS. COME HERE WHEN A DESCRIPTOR IS SEEN
8263 ;THAT SPECIFIES A KEYWORD PARAMETER.
8264 MACK:   SAVE RDWRDP
8265         SAVE @PRCALP
8266         SAVE LINK
8267 ;FIRST, PUSH A "NOT SET" MARKER FOR EACH OF THE KEYWORD PARAMS IN THIS RUN OF SUCH.
8268 MACK2:  SETO A,
8269         CALL ADDTR2
8270         CALL MACDES     ;NOTE THAT THERE IS ONLY ONE PARAM PER DESCRIPTOR
8271          JRST MACK1     ;FOR KEYWORD PARAMS, SO NO NEED TO COUNT DOWN.
8272         TRNE LINK,MCFKWD
8273          JRST MACK2
8274 MACK1:  REST LINK
8275         REST @PRCALP    ;NOW GO BACK TO THE DESCRIPTOR OF THE FIRST KEYWORD PARAM.
8276 MACKLP: CALL GPASST     ;NOW SEE IF THERE'S AN ARGUMENT TO BE FOUND
8277         CAIE A,^M       ;IF SO, IT SHOUDL START WITH A KEYWORD.
8278          CAIN A,^J
8279           JRST MACKND   ;CR OR LF => NO KEYWORD, AND END SCAN.
8280         CAIN A,";
8281          JRST MACKND
8282         CAIN A,",
8283          JRST MACKN1    ;NULL ARG => NO KEYWORD, BUT DON'T END SCAN.
8284         CAIE A,")
8285          CAIN A,">
8286           JRST MACKND   ;DETECT END OF PARENTHESIZED CALLS, ETC.
8287         CAIE A,RBRKT
8288          CAIN A,RBRACE
8289           JRST MACKND
8290         TLO FF,FLUNRD
8291         CALL GSYL       ;THERE SHOULD BE ANOTHER ARG, SO TRY READING KEYWORD NAME
8292         CALL PASSPS
8293         MOVE C,(P)      ;NOW SCAN THROUGH THIS RUN OF KEYWORD PARAMS FOR THE
8294         SAVE @PRCALP    ;ONE WHOSE NAME MATCHES WHAT GSYL READ.
8295         SAVE LINK
8296         CAIE A,"=
8297          JRST MACKL5    ;NOT FOLLOWED BY "="??
8298         DPB A,STRPNT
8299 MACKL4: MOVE D,[440700,,STRSTO]
8300         MOVE A,@PRCALP
8301 MACKL1: CALL REDINC
8302         ILDB AA,D
8303         CAIN B,377      ;IF REACHED END OF KEYWORD'S NAME, AND EQUAL SO FAR
8304          JRST MACKL2    ;SEE IF ARG'S NAME ALSO OVER.
8305         CAMN B,AA
8306          JRST MACKL1    ;ELSE KEEP COMPARING IF NAMES STILL SAME SO FAR.
8307 MACKL6: MOVEM A,@PRCALP
8308         CALL MACDES     ;THIS KEYWORD DOESN'T MATCH SO FIND THE NEXT
8309          JRST MACKL3    ;THERE ARE NO MORE; LOSE - ARG WITH BAD KEYWORD.
8310         TRNN LINK,MCFKWD
8311          JRST MACKL3
8312         AOJA C,MACKL4
8313
8314 MACKL5: ETR [ASCIZ /Bad format keyword argument/]
8315         TLOA FF,FLUNRD  ;INCLUDE THE BAD NON-"=" AS PART OF WHAT WE DISCARD
8316 MACKL3:  ETR [ASCIZ /Arg with undefined keyword/]
8317         MOVEI T,RARGN
8318         CALL RARFLS     ;SKIP AN ORDINARY-SYNTAX MACRO ARG TO TRY TO RECOVER.
8319         JRST MACK1
8320
8321 ;COME HERE AFTER FINDING THE PARAM THAT MATCHES THIS ARG.
8322 ;C POINTS TO THE WORD IN DSTG FOR THAT ARG (DSTG IS WHAT ADDTRN PUSHES IN)
8323 MACKL2: TRZ LINK,MCFKWD ;(IN CASE WE GO TO MACKL6, SINCE KWD NAME SKIPPED ALREADY)
8324         CAIE AA,"=
8325          JRST MACKL6    ;KWD NAME OVER BUT SPEC'D NAME NOT => MISMATCH
8326         MOVEMM (C),FREEPT
8327         CALL MACRED     ;READ IN THE VALUE OF THE ARG, THUS SETTING THIS PARAM.
8328          JRST MACK1     ;THERE ARE MORE ARGS => HANDLE THEM
8329          .VALUE
8330         REST LINK
8331         REST @PRCALP
8332 MACKND: TLO FF,FLUNRD   ;MACRO CALL TERMINATOR SEEN.
8333 ;NULL ARG SEEN; ENDS THIS RUN OF KEYWORD ARGS BUT NOT THE CALL.
8334 MACKN1: REST C          ;GET PTR TO 1ST KWD ARG'S VALUE-WORD
8335 MACKN2: MOVE A,(C)
8336         AOJN A,MACKN4   ;IF THIS ARG WASN'T SPECIFIED,
8337         MOVEMM (C),FREEPT
8338         CALL MACNUL     ;NULLIFY IT (MAYBE DEFAULT OR GENSYM)
8339 MACKN4: CALL MACDES     ;NOW SKIP OVER THE DESCRIPTORS OF THIS RUN OF KEYWORD PARAMS
8340          JRST MACPUS     ;EXHAUSTED ALL THE DESCR'S => END OF MACRO CALL.
8341         TRNE LINK,MCFKWD ;SAME IF REACH A NON-KWD ARG.
8342          AOJA C,MACKN2
8343         TLNN FF,FLUNRD  ;REACHED A NON-KEYWORD PARAM: IF TERMINATOR WAS A NULL ARG,
8344          JRST MACNRM    ;GO ON TO READ THE VALUE OF THE NON-KEYWORD PARAM.
8345         JRST MACCLS     ;ELSE CALL WAS REALLY ENDED, SO NULLIFY REMAINING ARGS.
8346 \f
8347 ;COME HERE TO FIND THE NEXT DESCRIPTOR.
8348 ;SKIPS OVER THE NAME AND DEFAULT VALUE OF THE PREVIOUS DESCRIPTOR, IF ANY.
8349 ;THE CONTENTS OF LINKK SAY WHETHER THEY EXIST TO BE SKIPPED OVER.
8350 MACDES: MOVE A,@PRCALP
8351         CALL REDINC     ;READ NEXT CHAR OF MACRO
8352         MOVEM A,@PRCALP
8353         TRNE LINK,MCFKWD\MCFDEF
8354          JRST [ CAIE B,377      ;IF THERE'S NAME OR DEFAULT TO SKIP, GO PAST TERMINATOR
8355                  JRST MACDES
8356                 TRZN LINK,MCFKWD ;AND SAY WE FOUND ONE
8357                  TRZ LINK,MCFDEF ;NOTE THERE MAY BE ANOTHER, IN WHICH CASE WE WILL
8358                 JRST MACDES]    ;SKIP TILL ANOTHER 377
8359         JUMPE B,CPOPJ   ;THIS DESC IS TERMINATOR => RETURN NO SKIP.
8360         MOVEI LINK,(B)  ;ELSE PUT FLAGS IN LINK.
8361         JRST POPJ1
8362
8363 ;COME HERE WHEN A MACRO CALL TERMINATOR IS ENCOUNTERED, TO NULLIFY ALL
8364 ;THE REMAINING PARAMS THAT THE MACRO WANTS, THEN ENTER THE MACRO.
8365 ;ENTER AT MACCLS IF HAVE JUST READ A DESCRIPTOR AND NOT NULLIFIED THE ARG,
8366 ;OR AT MACCLD IF HAVE JUST PROCESSED AN ARG, TO READ THE NEXT DESCRIPTOR.
8367 MACCLS: TRNE LINK,MCFDEF\MCFGEN
8368          JRST MACCL2
8369         SETZ A,         ;NULLIFY NON-GENSYMMED, NON-DEFAULTED ARGS QUICKLY
8370         CALL ADDTR2
8371 MACCLD: CALL MACDES     ;THEN READ THE NEXT DESCRIPTOR.
8372          JRST MACPUS    ;IF NO MORE ARGS, ENTER THE MACRO.
8373         JRST MACCLS
8374
8375 MACCL2: CALL ADDTRN     ;FOR GENSYMMED OR DEFAULTED ARG, PUSH PTR TO FREE STG
8376         SOS C,A
8377         CALL MACNUL     ;THEN WRITE THE DESIRED VALUE THERE
8378         JRST MACCLD     ;THEN HANDLE NEXT DESCRIPTOR.
8379
8380 ;COME TO MACPUS WHEN ALL THE PARAMS HAVE HAD VALUES PUT IN DSTG (USING ADDTRN)
8381 ;TO ENTER THE MACRO.
8382 MACPUS: TLZE I,ILPRN    ;SPECIAL PARENTHESIZED CALL?
8383          CALL MACPRN     ;YES, SKIP PAST THE CLOSING PAREN.
8384         MOVE B,(P)      ;IS THIS A .TTYMAC?
8385         CAIN B,A.TYM8
8386          CALL A.INEO    ;YES, POP OUT OF TTY AFTER READING ARGS.
8387         JFCL
8388         REST B          ;RCHSV1 OR A.TYM8
8389         PUSHJ P,PUSHEM
8390         MOVE A,@PRCALP
8391         PUSHJ P,ACPTRS  ;SET UP CPTR
8392         POP P,A
8393         PUSHJ P,DMYTRN
8394         SOS PRCALP
8395         REST I
8396 MACCR:  AOS (P)         ;COMMON RETURN FROM PSEUDOS TO RETURN FROM GETVAL WITHOUT VALUE
8397 CMACCR: POPJ P,MACCR
8398
8399 MACPRN: MOVEI TT,1      ;START PAREN-DEPTH AT 1
8400         JSP D,RARBC     ;AND READ CHARS, UPDATING THE DEPTH, UNTIL
8401          HALT
8402         JUMPN TT,.-2    ;THE DEPTH GETS TO BE 0.
8403         RET
8404 \f
8405 A.GOMC: ILDB B,A        ;.GO ROUTINE TO SKIP PAST DESCRIPTORS
8406         JUMPN B,A.GOMC  ;IN HEADER OF MACRO DEFINITION.
8407         JRST A.GORT
8408
8409 RCHSV1: SOS MDEPTH      ;END OF MACRO EXPANSION, DECREMENT DEPTH IN MACRO EXPANSIONS
8410 A.TYM8: PUSH P,A        ;ENTRY FROM .TTYMAC END OF EXPANSION
8411         MOVE B,TOPP
8412 RCHSV3: CAMG B,BBASE
8413         JRST RCHSV2
8414         HLRZ A,-1(B)
8415         ADD A,-1(B)
8416         MOVEI A,1(A)
8417         CAME A,FREEPT
8418         JRST RCHSV2
8419         HRRZ A,-1(B)    ;GET NEW FREEPT
8420         SOJA B,RCHSV3
8421
8422 RCHSV2: POP P,A
8423                 ;RETURN ROUTINE FOR END OF DUMMY
8424 RCHSAV: MOVE B,BBASE
8425         MOVEM B,TOPP
8426         PUSHJ P,POPEM
8427         HLRM B,BBASE
8428 REPT6:  TRZE FF,FRMRGO
8429         POPJ P,         ;RETURN TO .GO
8430         JRST RCHTRB
8431 \f
8432 ;IRP, IRPS, IRPC, IRPW, IRPNC ALL CALL HERE.
8433 ;ALL USE 2 FRAMES ON THE MACRO PDL:
8434 ; <OLD BBASE>,,<OLD CPTR>
8435 ; <SAVED LIMBO1 STATUS>,,<OUTER .IRPCNT>
8436 ; <IRP TYPE>\<# GROUPS>,,<CHAR ADDR START OF IRP BODY>
8437 ; <SAVED TOPP>,,AIRR
8438 ;THE 3RD WORD HAS IN BITS 4.1-4.3 THE IRP TYPE CODE
8439 ;   (NIRPO, NIRPC, ETC)
8440 ;AND IN THE REST OF THE LH, THE NUMBER OF GROUPS
8441 ;   (TRIPLES OF TWO DUMMIES AND A LIST)
8442
8443 .SEE NIRPO      ;FOR DEFINITIONS OF IRP TYPE CODES.
8444
8445 AIRP:   JSP TM,ERMARK   ;ERROR MESSAGES SHOULD SAY WE'RE INSIDE IT.
8446         SAVE I
8447         SAVE RDWRDP
8448         HLRZ LINK,B     ;GET IRP TYPE CODE TO INDEX BY.
8449         CAIE LINK,NIRPN
8450          JRST AIRP0
8451         CALL AGETFD     ;IRPNC, READ THE 3 NUMERIC ARGS.
8452         SAVE A
8453         CALL AGETFD
8454         SAVE A
8455         CALL AGETFD
8456         MOVEM A,AIRPN2  ;THE LAST ARG,
8457         REST AIRPN1     ;THE MIDDLE,
8458         REST AIRPN0     ;THE FIRST.
8459         MOVEI LINK,NIRPN
8460 AIRP0:  SETZM IRPCR     ;NO GROUPS SEEN YET.
8461
8462 ;FALLS THROUGH.
8463 \f
8464 ;FALLS THROUGH.
8465
8466 ;TRY TO READ IN ANOTHER GROUP.
8467 AIRP1:  CALL PDEF       ;READ IN DUMMY NAME, PUSH ON DMYTOP.
8468         CAIE T,",       ;TERMINATOR WASN'T COMMA AND NAME WAS NULL
8469          JUMPE SYM,AIRP2 ;=> NO MORE GROUPS.
8470         CALL PDEF       ;NONNULL GROUP, READ & PUSH 2ND NAME.
8471         CAIN T,"[       ;] TRY TO DETECT "IRP X,[", ETC.  ]
8472          CALL [ETR [ASCIZ/Comma missing in IRP/]
8473                 TLO FF,FLUNRD   ;GENERATE A COMMA.
8474                 RET]
8475         CALL ADDTRN     ;PUSH CHAR ADDR OF 1ST DUMMY,
8476         CAIE LINK,NIRPS
8477         CAIN LINK,NIRPC ;LEAVE SPACE FOR IRPC'S 1ST ARG, IRPS'S 2ND.
8478          CALL PUT377
8479         MOVE A,RDWRDP
8480         CAIN LINK,NIRPS
8481          AOS -1(A)      ;IRPS - 1ST ARG GOES AFTER NEXT 377.
8482         CALL ADDTRN     ;PUSH CHAR ADDR OF 2ND DUMMY.
8483         CALL PUT377
8484         MOVE A,RDWRDP
8485         XCT AIRP1T-1(LINK)      ;MAYBE INCREMENT THAT ADDR.
8486         AOS IRPCR       ;ONE MORE GROUP SEEN.
8487         JSP D,RARG      ;INITIALIZE READING LIST.
8488          JRST AIRP3      ;NO LIST.
8489         JRST @.(LINK)
8490         OFFSET 1-.
8491 NIRPO:: AIRPO   ;IRP
8492 NIRPC:: AIRPC   ;IRPC
8493 NIRPS:: AIRPS   ;IRPS
8494 NIRPW:: AIRPW   ;IRPW
8495 NIRPN:: AIRPN   ;IRPNC
8496         OFFSET 0
8497
8498 AIRP1T: AOS -1(A)
8499         AOS -1(A)       ;INCR. THE 2ND DUMMY ADDR FOR IRP, IRPC.
8500         SOS -1(A)
8501         JFCL            ;DECR. FOR IRPS, NOTHING FOR IRPW.
8502         AOS -1(A)       ;INCR. FOR IRPNC.
8503 \f
8504 ;READ LIST FOR IRPC OR IRP AND STUFF INTO STRING.
8505 AIRPC:
8506 AIRPO:  CALL RARGCP     ;COPY UP TO END OF ARG INTO MACRO SPACE.
8507         JRST AIRP3
8508
8509 AIRPW3: CALL PUT377     ;END A LINE,
8510         CAIGE C,
8511          CALL PUT377    ;IF NO ; YET, MAKE NULL 2ND ARG.
8512 ;COME HERE FOR IRPW, LOOP BACK FOR NEXT LINE.
8513 AIRPW:  SETO C,         ;NO ; SEEN YET IN LINE.
8514 AIRPW1: JSP D,RARGCH(T)
8515          JRST AIRP3     ;END OF LIST, GO WRITE 375.
8516         CAIE A,^M
8517         CAIN A,^J
8518          JRST AIRPW1    ;IGNORE NULL LINES.
8519 AIRPW4: CAIN A,";
8520          AOJE C,AIRPW2  ;ON 1ST SEMI, SWITCH TO 2ND ARG.
8521         CAIE A,^J
8522         CAIN A,^M
8523          JRST AIRPW3    ;END OF LINE => END BOTH ARGS, START OVER.
8524 AIRPW5: CALL PUTREL
8525         JSP D,RARGCH(T)
8526          JRST AIRP3     ;END OF LIST.
8527         JRST AIRPW4
8528
8529 AIRPW2: MOVEI A,377
8530         JRST AIRPW5
8531
8532 AIRPS:  SETO C,         ;NO SQUOZE CHAR SEEN YET.
8533 AIRPS2: JSP D,RARGCH(T)
8534          JRST AIRP3
8535         HLRZ CH1,GDTAB(A)
8536         CAIN CH1,(RET)
8537         CAIN A,"!
8538          AOJA C,AIRPS0  ;A SQUOZE CHAR OR !.
8539         JUMPL C,AIRPS2  ;NON SQUOZE FOLLOWING ANOTHER, FLUSH.
8540         DPB A,AIRPSP    ;NONSQUOZE ENDING NONNULL SYL, PUT BEFORE SYL.
8541         SETZM AIRPSP
8542         CALL PUT377     ;FOLLOW SYL WITH 377.
8543         JRST AIRPS
8544
8545 AIRPS0: JUMPN C,AIRPS3  ;NOT 1ST CHAR IN SYL?
8546         SAVE A
8547         CALL PUT377     ;1ST, LEAVE A SPACE FOR THE SYL'S TERMINATOR.
8548         MOVE A,FREPTB
8549         MOVEM A,AIRPSP  ;REMEMBER WHERE THE SPACE IS.
8550         REST A
8551 AIRPS3: CALL PUTREL
8552         JRST AIRPS2
8553 \f
8554 AIRPN:  SKIPG C,AIRPN0  ;ANY CHARS TO IGNORE?
8555          JRST AIRPN4
8556         JSP D,RARGCH(T)
8557          JRST AIRP3
8558         SOJG C,.-2
8559 AIRPN4: SKIPN C,AIRPN2  ;GET MAX # GRPS OF CHARS.
8560          JRST AIRPN7     ;0 => IGNORE THE REST.
8561 AIRPN5: MOVE B,AIRPN1   ;DO NEXT GRP, GET # CHARS/GRP.
8562 AIRPN6: JSP D,RARGCH(T)
8563          JRST AIRP3
8564         CALL PUTREL     ;STORE THE NEXT CHAR.
8565         SOJG B,RARGCH(T) ;COUNT CHARS IN GRP.
8566         MOVEI A,376
8567         CALL PUTREL     ;FOLLOW GRP BY 376.
8568         SOJN C,AIRPN5   ;MAYBE CAN DO MORE GRPS.
8569 AIRPN7: CALL RARFLS     ;DID AS MANY GRPS AS CAN DO,
8570                         ;IGNORE REMAINDER OF LIST.
8571
8572 ;COME HERE WHEN EXHAUST THE LIST.
8573 AIRP3:  CALL STPWR
8574         JRST AIRP1      ;READ ANOTHER GROUP.
8575
8576 ;ALL GROUPS READ IN; NOW READ IN BODY.
8577 AIRP2:  CAIE T,";       ;IF A SEMICOLON ENDED THE ARGS, SKIP THE COMMENT.
8578          JRST AIRP4
8579 AIRP5:  CALL RCH
8580         CAIE A,^M
8581          JRST AIRP5
8582 AIRP4:  SAVE LINK
8583         MOVE A,FREEPT   ;SAVE CHAR ADDR START OF BODY
8584         MOVEM A,PRIRP   ;WHERE GC WILL RELOCATE IT.
8585         PUSHJ P,RCH     ;IF NEXT CHAR LF, THEN FLUSH IT
8586         CAIE A,12
8587         TLO FF,FLUNRD
8588         PUSHJ P,WRQOTE  ;READ BODY OF IRP
8589         PUSHJ P,STPWR   ;WRITE STOP
8590         PUSHJ P,PUSHEM  ;SAVE WORLD
8591         REST LINK
8592         POP P,A         ;RESTORE RDWRDP FROM LONG AGO
8593         PUSH P,TOPP     ;NOW SAVE TOPP
8594         PUSHJ P,DMYTRN  ;ACTIVATE DUMMYS
8595         MOVE B,MACP     ;NOW GET MACRO PDL POINTER
8596         MOVE A,CIRPCT   ;GET .IRPCNT
8597         HRRM A,(B)      ;CLOBBER "RETURN" ON PDL TO OLD IRPCNT
8598         SETOM CIRPCT    ;INITIALIZE IRPCNT
8599         MOVS A,IRPCR    ;GET # GROUPS
8600         HRR A,PRIRP     ;CHAR ADR OF BEGINNING OF BODY
8601         SETZM PRIRP
8602         DPB LINK,[410300,,A] ;PUT IN TYPE OF IRP.
8603         PUSH B,A        ;PUSH <SPECIFICATION BITS\# GROUPS>,,CHAR ADR BEGINNING
8604         POP P,A         ;NOW GET OLD TOPP
8605         HRLS A          ;MOVE TO LEFT HALF
8606         HRRI A,AIRR     ;RETURN TO AIRR ON END OF BODY
8607         PUSH B,A        ;PUSH OLD TOPP,,AIRP4
8608         MOVEM B,MACP    ;STORE BACK UPDATED MACRO PDL POINTER
8609         MOVE A,STOPPT
8610         MOVEM A,CPTR    ;CAUSE STOP RIGHT AWAY TO CAUSE CYCLING
8611         REST I
8612         JRST MACCR
8613 \f
8614                 ;RECYCLE THROUGH IRP
8615
8616                 ;AC ALLOCATIONS:
8617 AIRR:   PUSH P,A        ;A GETS BP ILDBING THRU ARG LIST.
8618         PUSH P,C        ;C # GROUPS LEFT
8619         PUSH P,T        ;T ADR OF PAIR OF CHAR ADR'S OF DUMMYS
8620         PUSH P,TT       ;TT TYPE OF IRP (NIRPO, NIRPC, ETC)
8621         AOS CIRPCT      ;INCREMENT .IRPCNT
8622         HRRZ A,(B)      ;GET CHARACTER ADR BEG BODY FROM PDL
8623         PUSHJ P,ACPTRS  ;SET UP CPTR
8624         SETOM AIRPT
8625         TRNE FF,FRMRGO
8626         JRST AIRR9      ;RETURN TO .GO
8627         HLRZ T,1(B)     ;DUMMY TAB ADR
8628         LDB C,[220600,,(B)]     ;# GROUPS
8629         JUMPE C,AIRR9   ;JUMP IF NO GROUPS
8630         LDB TT,[410300,,(B)]    ;GET TYPE OF IRP (NIRPO, ETC)
8631 AIRR6:  JRST @.+1(TT)
8632 AIRRER ? AIRRO ? AIRRC ? AIRRS ? AIRRW ? AIRRN ? AIRRER ? AIRRER
8633 AIRRER: .VALUE
8634
8635 ;MOVE 1 ARG THRU 1 GROUP OF IRP.
8636 AIRRO:  HRRZ A,1(T)     ;THE 1ST ARG WILL START THIS TIME
8637         HRRZM A,(T)     ;WHERE THE "REST OF STRING" STARTED LAST TIME.
8638         BCOMP A,-1      ;GET BP THAT'LL ILDB THAT CHAR.
8639         SETO CH1,       ;COUNT [-] DEPTH.
8640 AIRRO1: ILDB B,A
8641         CAIN B,375
8642          JRST AIRRO4    ;END OF STRING IS END OF ARG.
8643         SETZM AIRPT     ;THIS GROUP NOT NULL.
8644         CAIN B,"[
8645          AOJE CH1,AIRRO3        ;FLUSH OUTERMOST [-] PAIRS.
8646         CAIN B,"]
8647          SOJL CH1,AIRRO3
8648         JUMPGE CH1,AIRRO1       ;DON'T LOOK FOR , WITHIN [-].
8649         CAIE B,^J
8650         CAIN B,",
8651          JRST AIRRO2    ;END OF ARG.
8652         CAIE B,^M       ;^M IS IGNORED (FLUSHED.)
8653          JRST AIRRO1
8654 AIRRO3: MOVEI B,376     ;FLUSH A CHAR BY REPLACING WITH 376
8655         DPB B,A
8656         JRST AIRRO1
8657
8658 AIRRC4: SUB P,[1,,1]
8659 AIRRC3: SETZM (T)       ;NULLIFY BOTH ARGS PERMANENTLY.
8660 AIRRO4: SETZM 1(T)      ;NULLIFY 2ND ARG PERMANENTLY
8661         JRST AIRR8      ;DONE WITH THIS GROUP.
8662
8663 AIRRO2: MOVEI B,377     ;REPLACE CHAR THAT ENDED ARG WITH TERMINATOR.
8664         DPB B,A
8665 AIRRW3: CCOMP1 A,-1     ;GET ADDR OF CHAR AFTER.
8666         HRRZM B,1(T)    ;"REST OF STRING" STARTS THERE.
8667         JRST AIRR8
8668
8669 AIRRN:  MOVE A,1(T)     ;NEW 1ST DUMMY STARTS AT OLD "REST OF STRING".
8670         MOVEM A,(T)
8671         BCOMP A,-1      ;NEW "REST OF STRING" STARTS AFTER 376,
8672         JRST AIRRW2     ;WHICH WILL BECOME A 377.
8673 \f
8674 AIRRW:  MOVE A,1(T)     ;GET CHAR ADDR START OF 2ND HALF OF PREV LINE.
8675         CALL AIRRM      ;SET 1ST DUMMY -> AFTER NEXT 376 OR 377 .
8676 AIRRW2: ILDB B,A        ;MOVE UP TO NEXT 377 OR END OF STRING.
8677         CAIN B,375      ;END OF STRING ENDS 1ST DUMMY'S ARG =>
8678          JRST AIRRO4    ;NULLIFY THE 2ND DUMMY.
8679         SETZM AIRPT     ;THIS GROUP NOT NULL.
8680         CAIGE B,376
8681          JRST AIRRW2
8682         JRST AIRRO2     ;SET UP 2ND DUMMY -> NEXT CHAR.
8683
8684
8685 ;MOVE UP IN 1 GROUP OF IRPS.
8686 AIRRS:  MOVE A,(T)      ;MOVE FROM 1ST DUMMY,
8687         CALL AIRRM      ;PUT 1ST DUMMY AFTER NEXT 377,
8688         AOS (T)         ;MOVE IT PAST THE SYL'S TERMINATING CHAR,
8689         ILDB CH1,A      ;GET THAT CHAR,
8690         MOVE A,1(T)
8691         JRST AIRRS2     ;STORE AS 2ND DUMMY.
8692
8693 AIRRM:  BCOMP A,-1      ;A HAS CHAR ADDR; WILL ILDB THAT CHAR.
8694 AIRRM1: ILDB B,A
8695         CAIN B,375      ;END OF STRING => NULLIFY BOTH ARGS
8696          JRST AIRRC4    ;AND FINISHED WITH GROUP.
8697         CAIE B,377
8698          JRST AIRRM1
8699         MOVE CH1,A
8700         CCOMP1 CH1,-1   ;GET CHAR ADDR OF CHAR AFTER 377
8701         MOVEM CH2,(T)   ;PUT 1ST DUMMY THERE.
8702         RET             ;NOTE A NOT CLOBBERED, CAN GO ON ILDB'ING.
8703
8704 ;MOVE UP IN ONE GROUP OF IRPC.
8705 AIRRC:  AOS A,1(T)      ;DELETE 1ST CHAR FROM "REST OF STRING".
8706         BCOMP A,-1      ;GET BP -> THAT CHAR.
8707         LDB CH1,A       ;GET THE CHAR.
8708         MOVE A,(T)      ;GET CHAR ADDR OF PLACE TO PUT IT.
8709 AIRRS2: CAIN CH1,375    ;REACHED END OF STRING =>
8710          JRST AIRRC3    ;NULLIFY BOTH ARGS.
8711         BCOMP A,0
8712         DPB CH1,A       ;STORE IT IN THE 1-CHAR ARG.
8713 AIRR7:  SETZM AIRPT     ;THIS GROUP NOT EXHAUSTED YET.
8714 AIRR8:  ADDI T,2
8715         SOJG C,AIRR6    ;MORE GROUPS => DO THE NEXT.
8716 AIRR9:  POP P,TT        ;RETURN FROM AAIRPC
8717         POP P,T
8718         SKIPL AIRPT
8719         JRST REPT3
8720         MOVN A,[2,,2]   ;ARGS EXHAUSTED, RETURN
8721         ADDB A,MACP
8722         HRRZ A,(A)
8723         MOVEM A,CIRPCT
8724         POP P,C
8725         POP P,A
8726         JRST RCHSAV
8727 \f
8728 ;IRP ARG-STRING READING COROUTINES: CALL WITH JSP D,
8729 ;INITIALIZE FOR READIN OF ARG BUT DON'T GET A CHAR.
8730 ;SKIPS IF NONNULL ARG AVAILABLE.
8731 ;COROUTINES REMEMBER INFO IN T AND TT BETWEEN CALLS.
8732 ;THE CALLER SHOULDN'T CLOBBER THEM.
8733 RARG:   CALL RCH        ;DECIDE WHAT TYPE OF ARG FOLLOWS, IF ANY.
8734         CAIN A,LBRKT    ;RARG ALLOWS [-] AND MAYBE {-} ARGS AS WELL AS SIMPLE ONES.
8735          JRST RARGBR
8736 IFN BRCFLG,[
8737         CAIN A,LBRACE
8738          JRST RARGRR
8739 ]
8740         TLO FF,FLUNRD
8741         JSP T,RARGXT    ;CAUSE FAILURE RETURN ON SEMI, CR, LF.
8742 RARGN:  CALL RCH        ;RARGCH RTN FOR NORMAL ARG.
8743 RARGX1: CAIN A,",
8744          JRST (D)       ;COMMA ENDS ARG.
8745 RARGXT: CAIN A,";
8746          JRST RARGSM    ;SEMI ENDS SCAN.
8747 RARGX2: CAIE A,^M
8748         CAIN A,^J       ;CR, LF END SCAN.
8749 RARGSM:  TLOA FF,FLUNRD
8750         JRST 1(D)
8751         JRST (D)
8752
8753 RARGBR: SETZ TT,        ;TT USED AS BRACKET COUNTER.
8754         JSP T,1(D)      ;RETURN, WITH RARGCH RTN IN T.
8755 ;READ-CHAR RTN FOR [-] TYPE ARGS.
8756 RARGBC: CALL RCH        ;READ NEXT CHAR OF ARG.
8757         CAIN A,LBRKT
8758          AOJA TT,1(D)
8759         CAIN A,RBRKT
8760          SOJL TT,(D)
8761         JRST 1(D)       ;SKIP-RETURN UNLESS JUST READ THE FINAL CLOSEBRACKET.
8762
8763 RARGRR: SETZ TT,        ;TT USED AS BRACE COUNTER.
8764         JSP T,1(D)      ;RETURN, WITH RARGCH RTN IN T.
8765 ;READ-CHAR RTN FOR {-} TYPE ARGS.
8766 RARGRC: CALL RCH        ;READ NEXT CHAR OF ARG.
8767         CAIN A,LBRACE
8768          AOJA TT,1(D)
8769         CAIN A,RBRACE
8770          SOJL TT,(D)
8771         JRST 1(D)       ;SKIP-RETURN UNLESS JUST READ THE FINAL CLOSEBRACE.
8772
8773 ;TO GET THE NEXT CHAR OF THE ARG IN A, DO JSP D,RARGCH(T).
8774 ;SKIPS UNLESS NO MORE CHARS TO GET.
8775 ;NO SKIP AND  SET => SCAN SHOULD BE TERMINATED.
8776 ;RARG SHOULD NOT BE CALLED AGAIN IN THAT CASE.
8777 RARGCH==0       ;THIS SYMBOL IS FOR CREF'S SAKE.
8778
8779 ;COPY THE ARG BEING READ INTO MACRO SPACE.
8780 ;ON RETURN, A WILL HOLD "; IF ARGUMENT WAS ENDED BY ";".
8781 RARGCP: JSP D,RARGCH(T)
8782          JRST RARGC1
8783         CALL PUTREL
8784         JRST RARGCH(T)
8785
8786 RARGC1: CAIE A,";       ;IF SEMI ENDED THE ARG, FLUSH THE
8787          RET            ;SPACES AND TABS BEFORE IT.
8788 RARGC2: LDB A,FREPTB
8789         CAIN A,^I
8790          JRST RARGC3
8791         CAIE A,40
8792          JRST [ MOVEI A,";      ;LAST CHAR OF ARG ISN'T SP OR TAB.
8793                 RET]            ;MAKE SURE A HAS ";" IF ARG WAS ENDED BY ";".
8794 RARGC3: SOS FREEPT      ;IT IS ONE; BACK OVER IT.
8795         MOVE A,FREPTB
8796         DBPM A
8797         MOVEM A,FREPTB
8798         JRST RARGC2
8799
8800 ;IGNORE THE REST OF THE ARG NOW BEING READ.
8801 RARFLS: JSP D,RARGCH(T)
8802          RET
8803         JRST RARGCH(T)
8804 \f
8805 ;COME HERE TO SET UP TO READ A BALANCED ARG.
8806 ;IF THERE'S NO ARG, RETURNS WOTH JRST (D).
8807 ;ELSE RETURNS WITH JRST 1(D) SETTING UNRCHF.
8808 RARB:   TLO FF,FLUNRD
8809         SETZ TT,        ;TT USED AS BRACKET COUNTER.
8810         CAIE A,RBRACE
8811          CAIN A,")      ;IF 1ST CHAR IS A CLOSE,
8812           JRST RARB4    ;THERE'S NO ARG.
8813         CAIE A,">
8814          CAIN A,RBRKT
8815           JRST RARB4
8816         JSP T,RARGXT    ;CHECK FOR CR, LF, SEMI, AND RETURN.
8817 ;1-CHAR RTN FOR READING BALANCED ARG.
8818 RARBC:  CALL RCH
8819         CAIE A,RBRACE
8820          CAIN A,">      ;FOR CLOSES, MAYBE END ARG.
8821           JRST RARB2
8822         CAIE A,")
8823          CAIN A,RBRKT
8824           JRST RARB2
8825         CAIE A,LBRACE
8826          CAIN A,"<      ;FOR OPEN BRACKETS, INCR. THE COUNT.
8827           AOJA TT,1(D)  ;OPENS CAN'T END THE ARG.
8828         CAIE A,"(
8829          CAIN A,LBRKT
8830           AOJA TT,1(D)
8831         JUMPN TT,1(D)
8832         JRST RARGX1     ;NOT WITHIN BRACKETS, TEST FOR COMMA, ETC.
8833
8834 RARB2:  SOJGE TT,1(D)   ;COME HERE FOR CLOSEBRKTS.
8835 RARB4:  TLO FF,FLUNRD
8836         JRST (D)
8837
8838 ;COME HERE TO INIT FOR AN ARG FOR REPEAT, ETC.
8839 ;THAT IS, EITHER A BRACKETED ARG OR A 1-LINE ARG.
8840 RARL1:  CALL RCH
8841 RARL2:
8842 IFN BRCFLG,[
8843 RARL4:  CAIN A,LBRACE
8844          JRST RARGRR    ;1ST CHAR A BRACE => BRACED ARG.
8845 ]
8846         CAIN A,LBRKT    ;1ST CHAR A BRKT => BRKT ARG.
8847          JRST RARGBR
8848         TLO FF,FLUNRD
8849
8850 ;INIT FOR A 1-LINE ARG.
8851 RARL:   JSP T,1(D)
8852 ;1-CHAR RTN FOR 1-LINE ARGS.
8853 RARLC:  CALL RCH
8854         JRST RARGX2
8855
8856 IFE BRCFLG,[
8857 ;IF BRACES AREN'T USED BY MOST THINGS, THE NORMAL ROUTINE RARL1 DOESN'T
8858 ;CHECK FOR THEM, BUT RALR4 (CALLED BY CONDITIONALS) STILL MUST.
8859 RARL4:  CAIN A,LBRACE
8860          JRST RARGRR
8861         JRST RARL2
8862 ]
8863
8864 ;1-LINE ARGS TO MACROS: DON'T TERMINATE THE SPEC,
8865 ;AND SKIP OVER THE CR AND LF.
8866 RARL3:  TLO FF,FLUNRD
8867         JSP T,1(D)
8868         CALL RCH
8869         CAIN A,^J
8870          JRST (D)       ;LF IS THE END - SKIP IT.
8871         CAIE A,^M
8872          JRST 1(D)
8873         CALL RCH        ;CR => SKIP FOLLOWING LF, END ARG.
8874         CAIE A,^J
8875          TLO FF,FLUNRD
8876         JRST (D)
8877 \f
8878                 ;PUSHJ P,A.GST SEARCH CURRENT MACRO STRING FOR TAG (IN A.GST4)
8879                 ;SKIP IF FOUND, RETURN ON END OF STRING ANYWAY
8880                 ;BYTE POINTER (ILDB TO GET FIRST CHARACTER) IN A
8881
8882 A.GST:  MOVEM A,A.GST3  ;SAVE BYTE POINTER
8883 A.GST1: ILDB B,A.GST3   ;GET CHAR
8884         CAIL B,300
8885         POPJ P,         ;END OF STRING => STOP
8886         CAIE B,".
8887         JRST A.GST1     ;WAIT FOR POINT
8888         PUSHJ P,A.GSYL  ;FOUND POINT, GET REST OF NAME
8889         JUMPL T,CPOPJ   ;RETURN ON END OF STRING
8890         CAME SYM,[SQUOZE 0,TAG] ;TAG?
8891         JRST A.GST1     ;NO, KEEP GOING
8892         PUSHJ P,A.GSYL  ;GET THE TAG
8893         JUMPL T,CPOPJ   ;RETURN ON END OF STRING (THERE MUST BE BREAK CHAR AFTER TAG BEFORE STOP)
8894         CAME SYM,A.GST4
8895         JRST A.GST1     ;NOT THE ONE BEING LOOKED FOR
8896         MOVE A,A.GST3
8897         LDB B,A         ;GET DELIMITER
8898         CAIE B,15       ;CR?
8899         JRST POPJ1
8900         ILDB B,A        ;CR, GET NEXT CHAR
8901         CAIE B,12       ;LINE FEED?
8902         MOVE A,A.GST3   ;NO, DON'T FLUSH
8903         JRST POPJ1
8904
8905                 ;LOOK BACKWARD FOR BEGINNING OF STRING, BYTE POINTER AN A
8906                 ;LEAVES  POINTER POINTING AT STOP CHAR (NOT BEFORE); ALSO LEAVES STOP CHAR IN B
8907
8908 AG.SP:  MOVE B,(A)      ;GET WORD FROM MACTAB
8909         XOR B,[300_28.+300_20.+300_12.+300_4]   ;DO XOR TO ANITIALLY SET UP
8910         LDB CH1,[400400,,A]     ;PICK UP 4 HIGH ORDER BITS OF POSITION FIELD
8911         JRST A.GSP2-1(CH1)      ;DISPATCH ON POSITION FIELD (-1  SINCE BIT SET IN POSITION FIELD)
8912
8913 AG.SP3: MOVE B,(A)
8914         XOR B,[300_28.+300_20.+300_12.+300_4]
8915
8916 A.GSP2: TRNN B,300_4
8917         JSP CH1,AG.SF
8918         TLNN B,3
8919         JSP CH1,AG.SF
8920         TLNN B,300_2
8921         JSP CH1,AG.SF
8922         TLNN B,300_10.
8923         JSP CH1,AG.SF
8924         SOJA A,AG.SP3
8925
8926 AG.SF:  SUBI CH1,A.GSP2-1       ;GET HERE WHEN STOP CHAR FOUND
8927         DPB CH1,[400400,,A]     ;CLOBBER POSITION FIELD OF BYTE POINTER AGAIN
8928         ILDB B,A        ;INCREMENT TO UNIVERSALLY ACCEPTABLE POINTER, GETTING STOP CHAR IN B AT SAME TIME
8929         POPJ P,         ;THAT'S ALL
8930 \f
8931 A.TAG:  PUSHJ P,GSYL
8932         CAIE T,15
8933         JRST MACCR
8934         PUSHJ P,RCH
8935         CAIE A,12
8936         TLO FF,FLUNRD
8937         JRST MACCR
8938
8939 A.GO:   PUSHJ P,GSYL    ;DOESN'T WORK RELIABLY FROM DUMMY
8940         MOVEM SYM,A.GST4
8941
8942 A.GO1:  TLNN FF,FLMAC
8943         JRST MACCR      ;NOT GETTING CHARS FROM MACRO => STOP
8944         MOVE A,CPTR
8945         PUSHJ P,AG.SP   ;BACK TO BEGINNING
8946         CAIN B,374
8947         JRST A.GOMC     ;MACRO, SKIP PAST HEADER
8948 A.GORT: PUSHJ P,A.GST
8949         JRST A.GO2      ;END OF STRING, TRY POPPING UP ONE
8950         MOVEM A,CPTR
8951         JRST MACCR
8952
8953 A.GO2:  PUSHJ P,PMACP
8954         JRST A.GO1
8955
8956 A.GSYL: MOVNI D,100000  ;GET SYL FOR .GO WHILE LOOKING FOR TAG
8957         MOVEM D,STRCNT  ;STRCNT .LT. 0 SIGNAL FOR GSYL TO JRST (F)
8958         MOVEI SYM,0
8959         JSP F,GSYL1
8960 A.GSY3: ILDB A,A.GST3   ;GET CHAR
8961         TRZN A,200      ;CHECK FOR SPECIAL
8962         JRST A.GSY2     ;NO, FALL BACK IN
8963         CAIG A,100      ;BIG ENOUGH TO BE SPECIAL?
8964         JRST A.GSY3     ;NO, MUST BE DUMMY, IGNORE
8965         HRROI T,(A)     ;SPECIAL => ASSUME STOP: T .LT. 0 SIGNAL TO CALLING ROUTINE
8966         POPJ P,         ;RETURN TO CALLING ROUTINE
8967 \f
8968                 ;INITIALIZE MACRO STATUS
8969
8970 MACINI: MOVEI A,3
8971         MOVEM A,FREEPT  ;FORGET ALL STRINGS IN MACTAB
8972         PUSHJ P,FCOMP
8973         MOVE A,MACTAD
8974         HRLI A,41000    ;SET UP CCOMPB THRU CCOMPE
8975         LSH A,2         ;(THEIR VALUES CAN'T BE ASSEMBLED IN BECAUSE
8976         SUBI A,4        ;THEY ARE MUTLTIPLY RELOCATABLE, AND IN DEC
8977         MOVSI AA,CCOMPB-CCOMPE  ;VERSION THAT CAN'T BE DONE)
8978 MACIN0: MOVEM A,CCOMPB(AA)
8979         AOJ A,
8980         AOBJN AA,MACIN0
8981         MOVE A,MACTAD
8982         ADDI A,MACL+1777
8983         ANDI A,-2000    ;ADDR OF 1ST WD AFTER MACTAB.
8984         CALL MACIN2     ;SET UP PTRS TO END OF MACTAB.
8985         SETZM GCCNT     ;CLEAR OUT GC COUNT SO WILL GET MORE CORE FIRST THREE
8986 MACIN1: SETZM MDEPTH    ;NOW INITIALIZE MACRO EXPANSION STATUS
8987         SETZM PRSTG     ;NOW TO CLEAR OUT BYTE POINTERS
8988         MOVE A,[PRSTG,,PRSTG+1]
8989         BLT A,EPRSTT-1
8990         MOVEI A,DSTG
8991         MOVEM A,RDWRDP
8992         MOVEI A,DMYAGT
8993         MOVEM A,TOPP
8994         MOVEM A,BBASE
8995         MOVE A,[-MPDLL,,MACPDL]
8996         MOVEM A,MACP
8997         POPJ P,
8998
8999 ;A -> 1ST WD AFTER MACTAB, SET UP ALL POINTERS TO END OF MACTAB.
9000 MACIN2: MOVEM A,MACTND
9001         SUB A,MACTAD
9002         LSH A,2         ;1ST BYTE MACTAB DOESN'T HAVE.
9003         MOVEM A,MACHI
9004         SUBI A,MACRUM*4
9005         MOVEM A,GCRDHI
9006         MOVE A,STOPPT
9007         HRR A,MACTND
9008         SOS A           ;LAST WD IN MACTAB.
9009         MOVEM A,MACHIB  ;INITIALIZE BYTE POINTER TO HIGHEST BYTE OK TO FILL
9010         RET
9011
9012                 ;MACRO VARIABLE AREA (MOST THEREOF)
9013
9014 VBLK
9015 MACP:   0       ;MAC PDL POINTER
9016 BLCODE [MACPDL: BLOCK MPDLL+1]  ;MACRO PDL
9017 FREEPT: 0       ;MACRO STG PNTR POINTS TO FREE CHAR
9018 FREPTB: 0       ;FREEPT IN BYTE POINTER FORM
9019 MACTAD: MACTBA  ;ADDR OF START OF MACRO TABLE.
9020 MACTND: 0       ;ADDR OF 1ST WD AFTER MACTAB.
9021 MACHI:  0       ;CHAR ADR ONE ABOVE ACTIVE MACTAB
9022 MACHIB: 0       ;POINTS TO LAST BYTE IN MACTAB
9023 \f
9024 SCONDF: 0       ;STRING CONDITIONAL FLAG, -1 => IDENTICAL, 0 DIFFERENT
9025 GENSM:  0       ;GENERATED SYM COUNT
9026 DEFNPS: 0       ;NONZERO => NAME OF PSEUDO NOW READING ITS ARG.
9027                 ;A FATAL ERROR WILL TYPE THE PSEUDO'S NAME.
9028 DEFNPN: 0       ;PAGE # -1 OF THAT PSEUDO. ALSO TYPED BY FATAL ERRORS.
9029 DEFNLN: 0       ;LINE # -1.
9030 DEFNFI: 0       ;SIXBIT FN1 OF FILE CONTAINING PSEUDO THAT DEFNPS REFERS TO.
9031 MDEPTH: 0       ;DEPTH IN MACRO (NOT IRP OR REPEAT) EXPANSIONS
9032 PUTCNT: 0       ;AOS'D BY PUTREL, USED BY CALLING ROUTINE, USUALLY TO COUNT ACTIVE CHARS (DURING DEFINITION)
9033 IRPCR:  0       ;COUNT OF A,B,[LIST] GROUPS IN IRP IRPC IRPS, " " "
9034 AIRPT:  0       ;IRP EXPANSION TEMP, -1 => NO NON-NULL DUMMYS YET, ELSE 0
9035 AIRPN0: 0       ;1ST NUMERIC ARG TO IRPNC
9036 AIRPN1: 0       ;2ND,
9037 AIRPN2: 0       ;3RD.
9038 A.QOT2: 0       ;DELIMITER FOR .QUOTE
9039 CRPTCT: -1      ;COUNT THROUGH CURRENT REPEAT (FOR .RPCNT)
9040 CIRPCT: -1      ;COUNT THOUGH CURRENT IRP (FOR .IRPCNT)
9041 A.GST3: 0       ;ON .GO, NAME (IN SQUOZE) OF TAG BEING SEARCHED FOR
9042 A.GST4: 0       ;BYTE POINTER FOR ILDB WHILE SEARCHING FOR TAG
9043 PRCALP: PRCAL-1 ;POINTER INTO PRCALP, POINTS TO LAST ACTIVE ENTRY
9044
9045 PRSTG:                  ;BEGIN WORDS GARBAGE COLLECTED: FIRST BYTE POINTERS ILDB'D
9046
9047 CPTR:   0       ;ILDB TO GET NEXT CHAR FROM MACRO OR WHATEVER
9048 IFE WRQTSW-1,WRQTBP:    0       ;POINTS TO LAST CHAR BEFORE CURRENT SYL AT WRQOTE
9049 AIRPSP: 0       ;-> PLACE TO STORE SYL-TERMINATOR, IN IRPS READIN.
9050 GCBPL==.-PRSTG  ;END BYTE POINTERS, BEGIN CHARACTER ADDRESSES
9051 PRSCND: 0       ;CHARACTER ADDRESS OF CURRENT LOCATION IN FIRST STRING OF IFSE,IFSN WHILE COMPARING WITH SECOND
9052 PRSCN1: 0       ;CHAR ADR BEG OF FIRST STRING IFSE, IFSN
9053 PRREPT: 0       ;CHAR ADR BEG OF BODY OF REPT
9054 PRIRP:  0       ;CHAR ADR BEG OF IRP BODY
9055 PRDEF:  0       ;CHAR ADR BEG OF MACRO BEING DEFINED
9056 PRCAL:  REPEAT 10,0     ;TEMP STORAGE FOR CHAR ADR BEG MACRO BODY, USED TO READ DUMMY SPECS
9057 EPRSTT:         ;END CHAR ADR WORDS GARBAGE COLLECTED
9058
9059                 ;BEGIN GARBAGE COLLECTOR VARIABLES
9060
9061 GCCNT:  0       ;CNT OF GC'S
9062 SYMSTR: 0       ;PNTR TO CHAIN OF MACRO PNTRS IN SYM TABLE (DURING GC), LINKED THROUGH RH'S OF "VALUE"
9063 REDPT:  0       ;CHAR ADR READING FROM WHEN MOVING STRING DOWN
9064 REDPTB: 0       ;REDPT IN BYTE POINTER FORM
9065         ;GC WRITES WITH FREEPT/FREPTB
9066 COFST:  0       ;AMOUNT CHARS MOVED DOWN BY, SUBTRACTED FROM CHAR ADR TO RELOCATE
9067 SVF:    0       ;FLAG, .GE. 0 => NO POINTERS FOUND POINTING TO CURRENT STRING
9068 FREPTS: 0       ;-> BEGINNING OF CURRENT STRING BEING COPIED DOWN
9069 FRPTBS: 0       ;FREPTS IN BYTE POINTER FORM
9070 GCENDF: 0       ;-1 => END OF LAST STRING FOUND, AFTER RELOCATING POINTERS, MSTG2 SHOULD EXIT
9071 GCHI:   0       ;GC HIGH POINTER, CHAR ADR FIRST NOT TO GARBAGE COLLECT
9072 GCRDHI: <MACL-MACRUM>*4 ;GC DROPS DEAD (MACTAB FULL) IFWRITING INTO THIS CHAR ADR
9073 BLCODE [GCSV:   BLOCK 16]       ;AC SAVE AREA FOR GC
9074 PBLK
9075 \f
9076                 ;GARBAGE COLLECT THE MACRO TABLE
9077
9078 GCA1:   MOVE A,FREEPT   ;GC ALL IN MACTAB.
9079 GCA:    MOVEM A,GCHI    ;ENTRY TO STORE A IN GCHI -> FIRST CHAR NOT TO GARBAGE COLLECT
9080 GC:     MOVEM 17,GCSV+15
9081         MOVE 17,[2,,GCSV]
9082         BLT 17,GCSV+14
9083 IFN TS,[AOS A,GCCNT
9084         CAIGE A,4
9085         PUSHJ P,GCCORQ  ;EXPAND CORE ON FIRST THREE GC'S
9086 ]       CLEARB T,GCENDF
9087         MOVEI A,3
9088         MOVEM A,REDPT   ;SET UP FOR READING
9089         MOVEM A,FREEPT  ;ALSO FOR WRITING
9090         MOVE A,BCOMPU   ;ALSO SET UP CORRESPINDING BYTE POINTERS
9091         MOVEM A,FREPTB
9092         MOVEM A,REDPTB
9093         MOVE C,[-GCBPL,,PRSTG]
9094 GCLP1:  SKIPN B,(C)     ;NOW CONVERT BYTE POINTERS...
9095         JRST GCLP1B     ;(INACTIVE)
9096         CCOMP B,-1      ;TO CHARACTER ADDRESSES
9097         MOVEM B,(C)     ;STORE BACK CHARACTER ADDRESS
9098 GCLP1B: AOBJN C,GCLP1   ;LOOP FOR ALL SUCH BYTE POINTERS
9099         MOVE A,SYMAOB   ;NOW SET UP MACRO LIST; T INITIALLY HAS 0 => END OF LIST DURING COMPUTATION
9100 SYMMG:          ;POINTS TO FIRST MACRO SYMTAB ENTRY ON LIST
9101         LDB B,[400400,,ST(A)]   ;GET SQUOZE FLAGS THIS SYM
9102         CAIN B,PSUDO_-14.       ;PSEUDO? (=> MAYBE MACRO)
9103         JRST SYMMG1     ;YES, MAYBE PUT ON LIST (RETURNS TO SYMMG2)
9104 SYMMG2: ADD A,WPSTE1
9105         AOBJN A,SYMMG   ;LOOP FOR ENTIRE SYMTAB
9106         MOVEM T,SYMSTR  ;STORE INITIAL LIST ENTRY FOR MACROS
9107                 ;DROPS THROUGH
9108         ;GC DEALS WITH "UNIT STRINGS", EACH STRING ENDS WITH 375
9109         ;GENERAL PROCEDURE IS TO COPY A STRING DOWN THEN SEARCH FOR POINTERS TO WHERE STRING USED TO BE
9110         ;IF POINTERS FOUND THEY ARE RELOCATED TO POINT TO COPIED DOWN STRING
9111         ;IF POINTERS ARE NOT FOUND THE STRING IS WIPED OUT
9112                 ;DROPS THROUGH
9113
9114 MSTG:   MOVE C,REDPT    ;SET UP C TO POINT TO BEG OF STRING BEING READ
9115                 ;(FOR EVENTUALLY SEARCHING FOR POINTERS TO STRING, NOTE C STAYS AROUND FOR AWHILE)
9116         MOVE TT,FREEPT
9117         MOVEM TT,FREPTS ;-> BEGINNING OF WRITTEN STRING
9118         MOVE TT,FREPTB
9119         MOVEM TT,FRPTBS ;BYTE POINTER -> BEGINNING OF WRITTEN STRING
9120         PUSHJ P,RDTRNS  ;COPY CHARACTER
9121         CAIN B,370
9122          JRST MSTGB     ;THAT WAS NO STRING, THAT WAS MY IO-BUFFER!
9123         MOVE TT,B       ;SAVE CHARACTER JUST COPIED
9124 MSTG1:  CAML LINK,GCHI
9125         JRST GCEND      ;JUST READ LAST CHAR IN PART OF MACTAB TO GARBAGE COLLECT => DONE
9126         CAIN B,375
9127         JRST MSTG2      ;END THIS STRING, NOW SEARCH FOR POINTERS, RETURNS TO MSTG
9128         PUSHJ P,RDTRNS  ;STRING NOT EXHAUSTED, COPY NEXT CHAR
9129         JRST MSTG1
9130 \f
9131 SYMMG1: HRRZ B,ST+1(A)  ;PSEUDO FOUND IN SYMTAB, GET "VALUE"
9132         CAIE B,MACCL    ;MACCL? (=> MACRO, CHAR ADR OF BODY IN LH)
9133         JRST SYMMG2     ;NO, JUST FALL BACK INTO LOOP
9134         HRRM T,ST+1(A)  ;MACRO, REPLACE MACCL PART OF VALUE WITH POINTER TO NEXT
9135         MOVEI T,ST+1(A) ;UPDATE T (INITIAL LIST ENTRY) TO POINT TO WORD JUST CLOBBERED
9136         PUSH P,A
9137         HLRZ A,ST+1(A)
9138         PUSHJ P,REDINC
9139         CAIE B,374
9140         HALT
9141         POP P,A
9142         JRST SYMMG2
9143
9144                 ;COPY CHARACTER DOWN (REDPTB -> FREPTB)
9145         ;LEAVE INCREMENTED REDPT IN LINK, FREEPT IN A, CHAR IN B
9146
9147 RDTRNS: ILDB B,REDPTB
9148         IDPB B,FREPTB
9149         AOS LINK,REDPT
9150         AOS A,FREEPT
9151         POPJ P,
9152
9153 MSTGB:  ADDI A,3        ;COPY AN IO-BUFFER:
9154         TRZ A,3
9155         MOVEM A,FREEPT  ;WRITE INTO WORD BOUNDARY.
9156         ADDI LINK,3
9157         TRZ LINK,3
9158         MOVEM LINK,REDPT        ;READ FROM WORD BOUNDARY.
9159         MOVEI B,041000
9160         HRLM B,REDPTB
9161         HRLM B,FREPTB
9162         MOVE B,FREPTB
9163         MOVE A,REDPTB
9164         ADDI B,1        ;NEW ADDR OF 1ST WD.
9165         HRRZ LINK,1(A)  ;GET ADDR OF POINTER TO STRING.
9166         MOVEM LINK,SVF  ;REMEMBER WHETHER TO FLUSH STRING.
9167         SKIPE LINK
9168         HRRM B,(LINK)   ;RELOCATE THAT POINTER (IF ANY)
9169         HRLI B,1(A)     ;SET UP AC FOR BLT.
9170         HLRZ LINK,1(A)  ;GET LENGTH OF STRING.
9171         ADDM LINK,REDPTB
9172         LSH LINK,2
9173         ADDM LINK,FREEPT
9174         ADDM LINK,REDPT
9175         LSH LINK,-2
9176         ADDB LINK,FREPTB
9177         BLT B,(LINK)
9178         MOVE LINK,REDPT
9179         CAML LINK,GCHI  ;IF THIS IO-BUFFER IS LAST THING IN MACRO SPACE,
9180          SETOM GCENDF   ;DON'T LOOK FOR ANYTHING FOLLOWING IT.
9181         JRST MSTGB1     ;NOW MAYBE FLUSH THIS STRING,  COPY NEXT.
9182 \f
9183                 ;GET HERE WHEN MSTG2 FINISHES WITH FLAG SET TO EXIT: UNDO INITIALIZATION AND RETURN
9184
9185 GCEND1: IFN TS,[
9186         MOVE A,FREEPT
9187         ADDI A,2000*4
9188         CAML A,MACHI
9189         PUSHJ P,GCCORQ
9190 ]       MOVE A,FREEPT
9191         CAML A,GCRDHI
9192          ETF [ASCIZ /Macro space full/]
9193         SKIPN T,SYMSTR
9194         JRST USYMG1     ;EMPTY LIST
9195         MOVEI C,MACCL   ;SET UP C FOR HRRM'ING
9196 USYMG:  HRRZ TT,(T)     ;GET ADR ON LIST
9197         HRRM C,(T)      ;CLOBBER RH JUST GOT NEXT POINTER FROM TO MACCL
9198         HLRZ A,(T)
9199         PUSHJ P,REDINC
9200         CAIE B,374
9201         HALT
9202         SKIPE T,TT      ;MAKE NEXT POINTER CURRENT, SKIP IF END OF LIST
9203         JRST USYMG
9204
9205 USYMG1: MOVE C,[-GCBPL,,PRSTG]
9206 GCLP2:  MOVE A,(C)      ;NOW CONVERT CHARACTER ADDRESSES...
9207         BCOMP A,-1      ;BACK TO BYTE POINTERS
9208         MOVEM A,(C)
9209         AOBJN C,GCLP2
9210         MOVS 17,[2,,GCSV]
9211         BLT 17,17
9212         POPJ P,         ;EXIT FROM GARBAGE COLLECTOR
9213
9214                 ;GC ROUTINE TO SCAN TABLE AREA FOR POINTERS TO CURRENT STRING
9215                 ;CH1 -> BEGINNING OF TABLE, 4.9 => LOOK AT PAIRS SKIPPING SECOND OF EACH PAIR
9216                 ;T POINTS TO LAST WORD IN TABLE + 1
9217                 ;RELOCATE POINTERS IN TABLE POINTED TO
9218                 ;C POINTS TO BEGINNING OF STRING, B -> END + 1
9219
9220 MSCN:   CAIG T,(CH1)
9221         POPJ P,         ;TABLE EXHAUSTED
9222         HRRZ TT,-1(T)   ;GET LAST ENTRY IN TABLE (UPPER POINTER UPDATED TO COUNT DOWN)
9223         CAML TT,C
9224         CAML TT,B
9225         JRST MSCN1      ;DOESN'T POINT TO CURRENT STRING
9226         SUB TT,COFST    ;POINTS TO STRING, RELOCATE
9227         HRRM TT,-1(T)   ;STORE BACK RELOCATED POINTER
9228         SETOM SVF       ;SET FLAG TO SAVE STRING
9229 MSCN1:  SKIPGE CH1
9230         SOS T           ;CH1 NEGATIVE => SKIP A WORD
9231         SOJA T,MSCN
9232 \f
9233 GCEND:  SETOM GCENDF    ;DONE READING FROM MACTAB, BUT FIRST HAVE TO RELOCATE POINTERS TO LAST STRING
9234 MSTG2:  CLEARM SVF      ;NO POINTERS FOUND TO STRING YET
9235         MOVE D,REDPT
9236         SUB D,FREEPT
9237         MOVEM D,COFST   ;STORE AMOUNT CHARS COPIED DOWN BY FOR CHAR ADR RELOCATION
9238         MOVE B,REDPT
9239         CAIE TT,374
9240         JRST MSTG3      ;NOT A MACRO
9241         MOVE T,SYMSTR
9242         JUMPE T,MSTG3   ;JUMP IF NO MACROS ON LIST
9243 MSTG5:  HLRZ TT,(T)     ;GET CHAR ADR THIS MACRO
9244         CAML TT,C       ;SKIP IF POINTS BELOW BEGINNING THIS STRING
9245         CAML TT,B       ;SKIP UNLESS POINTS TO OR ABOVE FIRST CHAR NOT YET READ
9246         JRST MSTG4      ;DOESN'T POINT TO THIS STRING
9247         SETOM SVF       ;POINTS TO THIS STRING, SET FLAG TO SAVE STRING
9248         SUB TT,COFST    ;RELOCATE
9249         HRLM TT,(T)     ;STORE BACK UPDATED CHAR ADR THIS MACRO
9250 MSTG4:  HRRZ T,(T)      ;NOW GET POINTER TO NEXT MACRO
9251         JUMPN T,MSTG5   ;LOOP FOR ALL MACROS ON LIST
9252
9253 MSTG3:  MOVE T,TOPP
9254         MOVEI CH1,DMYAGT
9255         PUSHJ P,MSCN    ;RELOCATE POINTERS IN DUMMY ARG TABLE
9256         HRRZ T,MACP
9257         HRROI CH1,MACPDL
9258         PUSHJ P,MSCN    ;RELOCATE POINTERS IN MACRO PDL
9259         HRRZ T,PRCALP
9260         AOS T
9261         MOVEI CH1,PRSTG
9262         PUSHJ P,MSCN    ;RELOCATE POINTERS IN PRSTG
9263         HRRZ T,RDWRDP
9264         MOVEI CH1,DSTG
9265         PUSHJ P,MSCN    ;RELOCATE DUMMY ARGS READ (OR BEING READ) IN BUT NOT YET ACTIVATED
9266         SKIPGE GCENDF
9267          JRST GCEND1    ;EXIT
9268 MSTGB1: SKIPE SVF
9269          JRST MSTGB2    ;FOUND POINTERS TO THIS STRING, DON'T FLUSH
9270         MOVE TT,FREPTS  ;NO POINTERS FOUND, FLUSH STRING
9271         MOVEM TT,FREEPT
9272         MOVE TT,FRPTBS
9273         MOVEM TT,FREPTB
9274 MSTGB2: SKIPGE GCENDF   ;IF WE JUST HACKED AN I-O BUFFER, MAYBE IT'S THE LAST
9275          JRST GCEND1    ;THING IN MACRO SPACE.
9276         JRST MSTG
9277
9278 ]               ;END MACSW CONDITIONAL (AND MACRO PROCESSOR ROUTINES)
9279 \f
9280 IFN .I.FSW,[    ;;.I.F          ;ALGEBRAIC COMPILER ROUTINE
9281 ;               'ALGEBRAIC' CRUFT MARO DEFINITIONS
9282
9283 DEFINE MOAN ARG/
9284         MOVEI D,[SIXBIT /ARG!!/]
9285         JRST ERRCON
9286 TERMIN
9287
9288 DEFINE RETLIN
9289         MOVEI A,15      ;CARRIAGE RETURN
9290         PUSHJ P,PUTREL
9291         MOVEI A,12      ;LINE FEED
9292         PUSHJ P,PUTREL
9293 TERMIN
9294
9295 DEFINE NUMBER
9296         MOVE A,BTPNT
9297         ILDB I,A
9298         CAIE I,"#
9299         CAIGE I,"@
9300 TERMIN
9301
9302 DEFINE RESTOR
9303         MOVE D,BTPNT
9304         SETZM STRING
9305         SETZM STRING+1
9306         SETZM STRING+2
9307 TERMIN
9308
9309
9310 DEFINE SPECN
9311         POP P,RANDM
9312         MOVE A,ENN
9313         SUB A,RANDM
9314         MOVEM A,ENN
9315 TERMIN
9316
9317 DEFINE GET
9318         EXCH I,ACSAV+1
9319         PUSHJ P,RCH
9320         EXCH I,ACSAV+1
9321 TERMIN
9322
9323 DEFINE GETT
9324         EXCH I,ACSAV+1
9325         PUSHJ P,RCH
9326         EXCH I,ACSAV+1
9327         IDPB A,TPN
9328 TERMIN
9329 \f
9330 ;               START OF COMPILER PROPER
9331
9332 OPDL:   CH?CH?CH?CH?CH?CH?CH?CH ;COMMUTATOR
9333         CH?SP?CH?CH?CH?CR?CH?CH
9334         CH?CH?CH?CH?CH?CH?CH?CH
9335         CH?CH?CH?CH?CH?CH?CH?CH
9336         SP?CH?CH?CH?DL?CH?CH?CH
9337         LP?RP?TX?PL?CM?MN?CH?DV
9338         CH?CH?CH?CH?CH?CH?CH?CH
9339         CH?CH?CH?KL?LB?EQ?RB?CH
9340
9341 ;       CH?CH?CH?CH?CH?CH?CH?CH
9342 ;       CH?CH?CH?CH?CH?CH?CH?CH
9343 ;       CH?CH?CH?CH?CH?CH?CH?CH
9344 ;       CH?CH?CH?CH?CH?CH?UP?CH
9345 ;       CH?CH?CH?CH?CH?CH?CH?CH
9346 ;       CH?CH?CH?CH?CH?CH?CH?CH
9347 ;       CH?CH?CH?CH?CH?CH?CH?CH
9348 ;       CH?CH?CH?CH?CH?CH?CH?CH
9349
9350 VBLK
9351
9352 ENN:    60      ;ACCUMULATOR NUMBER - TROUBLE IF GOES PAST 9
9353
9354 BTPNT:  440700,,STRING  ;D
9355 STRING: BLOCK 10        ;CHARACTER ASSEMBLY (D) - TROUBLE IF OVERFLOWS
9356
9357 TPN:    0
9358 DIRPNT: 440700,,DIROUT  ;TPN
9359 DIROUT: BLOCK 40        ;COPY OF LINE IN PROGRESS (TPN) - TROUBLE IF OVERFLOWS
9360
9361 OPSTKL==40
9362         0
9363 OPSTK:  BLOCK OPSTKL    ;OPERATOR STACK (R) - TROUBLE IF OVERFLOWS
9364         0
9365
9366
9367
9368 ENDSTT: 0       ;ON IF END OF STATEMENT ENCOUNTERED
9369 CHARF:  0       ;LAST WAS NOT OPERATOR
9370 NUMFL:  0       ;STRING IS NUMERIC CONSTANT (NEEDS [ AND ])
9371 R1SV:   0       ;SAVED A
9372 R2SV:   0       ;SAVED I, CALLED V EARLIER ON
9373
9374 INTEGR: 0       ;INTEGER ARITHMETIC
9375 WARN:   0       ;ON AFTER ) TO STOP NON-OPERATOR
9376 RANDM:  0       ;DUMP COMMA COUNT HERE
9377 ACSAV:  BLOCK 7
9378 TEMP:   440600,,(D)     ;INDIRECT VIA D
9379 BYTPNT: 0
9380 PBLK
9381 \f
9382 ;               ENTRANCE TO 'ALGEBRAIC' TRANSLATOR
9383
9384 A.I:    SETOM INTEGR
9385         SKIPA
9386 A.F:    SETZM INTEGR
9387         PUSHJ P,SWINI   ;INITIALISE PASSAGE TO MIDAS ASSEMBLER
9388         MOVE TM,[P,,ACSAV]
9389         BLT TM,ACSAV+6
9390         SETZM ENDSTT    ;RESET END OF STMNT FLAG
9391         SETZM EQHIT'    ;RESET LAST CHAR WAS= FLAG
9392         SETZM WARN      ;SET OFF ERROR DETECTOR
9393         MOVEI A,"0      ;INITIALISE POINTERS
9394         MOVEM A,ENN
9395         MOVE A,DIRPNT
9396         MOVEM A,TPN     ;POINTER TO SAVED INPUT
9397         MOVE SYM,[-OPSTKL,,OPSTK]
9398         PUSH SYM,[0,,ENDSAT]
9399         PUSH P,[0]      ;INITIALISE COMMA-COUNTER
9400         SETZM CHARF
9401 CLSTR:  RESTOR
9402 RDITTS: SKIPE ENDSTT
9403         JRST BDEND
9404 RDITA:  GETT
9405         CAIGE A,100     ;FOR ABBREVIATED DISPATCH TABLE
9406         JRST @OPDL(A)
9407         CAIN A,"\
9408         JRST AB
9409         CAIN A,"^
9410         JRST UP
9411
9412 CH:     SETZM EQHIT
9413         SKIPE WARN
9414         JRST CHBRT
9415 CHEY:   IDPB A,D
9416         SETOM CHARF     ;NON UNARY FLAG
9417         JRST RDITA
9418
9419 GAMB:   RESTOR
9420 COMMT:  MOVE I,R2SV
9421         JRST GOPURT
9422
9423 SHORT:  ;DECIDES IF STRING CAN BE USED IN IMMEDIATE TYPE OPS
9424         SETZM IMMED'
9425         SKIPN STRING
9426         POPJ P,         ;NO STRING
9427         MOVE A,BTPNT
9428         ILDB I,A
9429         CAIN I,"#
9430         JRST APUPJ      ;YEPE HE ASKED FOR IT
9431         SKIPE STRING+1
9432         POPJ P,         ;STRING IS LONG
9433         SKIPA
9434 \f
9435 TSTSHL: ILDB I,A
9436         JUMPE I,APUPJ   ;ITS OK FOUND ONLY NUMBERS
9437         CAILE I,"@
9438         POPJ P,         ;NON-NUMBER IN STRING
9439         CAIE I,".
9440         JRST TSTSHL
9441         ILDB I,A
9442         SKIPN I         ;ANYTHING FOLLOW '.' QST
9443 APUPJ:  SETOM IMMED'    ;INDICATE IMMEDIATE USAGE IS POSSIBLE
9444         POPJ P,
9445
9446 SZPRT:  SETZM CHARF
9447 GOPRT:  SETZM WARN
9448 GOPART: MOVEM I,R2SV
9449 GOPURT: HLRZ B,I
9450         HLRZ C,(SYM)
9451         CAMLE B,C
9452         JRST PSOPR      ;GO PUSH OPERATOR
9453         SKIPN INTEGR
9454         SETOM IMMED     ;FOR ARITH OPS ONLY FIXED WILL DO IMMEDIATE
9455         PUSHJ P,SHORT   ;ESTABLISH IF STRING CAN BE IMMEDIFIED
9456         POP SYM,A       ;POP AN OPERATOR
9457         JUMPN A,(A)
9458
9459         MOAN OVERPOPPED OPERATOR STACK
9460
9461 CHEX:   MOVE A,R1SV
9462         JRST CHEY
9463
9464 RP:     SKIPE EQHIT
9465         AOS ENN         ;TAKE CARE OF UNSATISFIED = AT END
9466         SKIPN CHARF
9467         JRST RTONOP
9468         SETOM CHARF
9469 BUDDY:  SETOM WARN
9470         MOVEI I,RPAR
9471         JRST GOPART
9472
9473 RTONOP: MOVE I,(SYM)
9474         CAIN I,FUNCT
9475         JRST BUDDY      ;NO ARGUMENT FUNCTION
9476
9477         MOAN ) FOLLOWS OPERATOR
9478
9479 BDEND:  MOAN TOO MANY ('S
9480
9481 CHBRT:  MOAN NON-OPERATOR FOLLOWS )
9482
9483 \f
9484 CR:     SKIPE EQHIT
9485         AOS ENN ;HANDLES UNSATISFIED = AT END
9486         SETOM ENDSTT
9487         MOVEI I,RCAR
9488         JRST GOPRT
9489
9490 LP:     SETZM EQHIT
9491         SKIPE WARN
9492         JRST LFRHT
9493         SETZM CHARF
9494         SKIPE STRING
9495         JRST INDX
9496         PUSH P,[0]      ;INITIALISE COMMA-COUNTER
9497         PUSH SYM,[0,,LFTPR]
9498         JRST RDITA
9499
9500 INDX:   NUMBER
9501         JRST NUSTRB
9502         GETT
9503         CAIG A,"9
9504         JRST NMRINX
9505         MOVEI I,"(
9506         IDPB I,D
9507 INDY:   IDPB A,D
9508         GETT
9509         CAIN A,"+       ;IS IT COMPOUND SUBSCRIPT
9510         JRST CMPNDN
9511         CAIN A,"-
9512         JRST CMPNDN
9513         CAIE A,")       ;SEARCH FOR NEXT RP
9514         JRST INDY
9515         IDPB A,D
9516 CMBAN:  SETOM CHARF     ;MAKE BELIEVE CHARATER LAST
9517         SETOM WARN      ;YET SET ) TRAP
9518         JRST RDITA
9519
9520 NMRINX: CAIN A,"-       ;IS IT A MINUS
9521         JRST INDZ
9522         CAIN A,"+
9523         JRST INDZ
9524         MOVEI I,"+      ;NUMERICAL SUBSCRIPT
9525         IDPB I,D
9526 INDZ:   IDPB A,D
9527         GETT
9528         CAIN A,"+       ;IS IT COMPOUND SUBSCRIPT
9529         JRST CMPNDC
9530         CAIE A,")
9531         JRST INDZ
9532         JRST CMBAN
9533
9534 CMPNDN: MOVEI I,")
9535         IDPB I,D
9536         JRST INDZ
9537
9538 CMPNDC: MOVEI I,"(
9539         IDPB I,D
9540         JRST INDY
9541
9542 LFRHT:  MOAN ( FOLLOWS DIRECTLY ON )
9543 \f
9544 SP=RDITA        ;USE FOR NON ARITH STATS
9545
9546 CM:     MOVE I,[1,,COMMX]
9547         SKIPN CHARF
9548         AOS ENN
9549         JRST SZPRT
9550
9551 EQ:     SETOM EQHIT
9552         SETZM WARN
9553         SKIPN CHARF     ;TEST FOR EXISTANCE OF  L H S
9554         JRST EQFLOP
9555         NUMBER          ;IS  L H S A NUMBER
9556         JRST EQNUMB
9557         MOVEI I,EQAAL
9558 EQVAL:  SETZM CHARF
9559         PUSH SYM,I
9560         PUSH P,STRING
9561         PUSH P,STRING+1
9562         PUSH P,STRING+2
9563         PUSH P,[0]
9564         JRST CLSTR
9565
9566 PL:     MOVE I,[2,,PLUS]
9567         SKIPN CHARF
9568         JRST RDITA      ;UNARY PLUS
9569         JRST SZPRT
9570
9571 MN:     MOVE I,[2,,MINUX]
9572         SKIPN CHARF
9573         MOVE I,[5,,UMINU]
9574         JRST SZPRT
9575
9576 AB:     SKIPE CHARF     ;ABSOLUTE VALUE
9577         JRST ABERR      ;NOT UNARY
9578         MOVE I,[5,,UABS]
9579         JRST SZPRT
9580
9581 LB:     SKIPN CHARF
9582         JRST LP ;TREAT LIKE (
9583         NUMBER
9584         JRST NUBRST
9585         MOVEI I,FUNCT
9586         JRST EQVAL
9587
9588 RB=RP
9589
9590 NUBRST: MOAN '<' FOLLOWS NUMBER
9591
9592 NUSTRB: MOAN '(' FOLLOWS NUMBER
9593
9594 EQFLOP: MOAN '=' FOLLOWS OPERATOR
9595
9596 EQNUMB: MOAN '=' FOLLOWS NUMBER
9597
9598 ABERR:  MOAN NON-UNARY ABS
9599 \f
9600 TX:     MOVE I,[4,,TIMES]
9601         SKIPN CHARF
9602         JRST RDITA      ;UNARY TIMES
9603         JRST SZPRT
9604
9605 DL:     GET     ;CONTINUE STATEMENT RC
9606         GET     ;LF
9607         GET     ;.
9608         CAIE A,".       ;DOT
9609         JRST BDCONT
9610         GET     ;F OR I
9611         GET     ;CONTROL I OR SPACE
9612         MOVE A,DIRPNT
9613         MOVEM A,TPN     ;RESET SAVED INPUT POINTER TO AVOID FILLING ITS BUFFER
9614         MOVEI A,"$
9615         IDPB A,TPN
9616         MOVEI A,40
9617         IDPB A,TPN
9618         JRST RDITA
9619
9620 ERRCON: TRNE FF,FRPSS2  ;NO OUTPUT ON SECOND PASS
9621         JRST CONRBT
9622 ;MAY ALSO WANT TO USE STATEMENT PLUS LINE NUMBER TYPE TACTIC
9623         MOVE B,DIRPNT
9624 OUTRR:  ILDB A,B
9625         PUSHJ P,TYO
9626         CAME B,TPN
9627         JRST OUTRR
9628         SKIPE ENDSTT
9629         JRST CONERT
9630 DORSTL: MOVEI A,40
9631         PUSHJ P,TYO
9632         MOVEI A,"?      ;POINT AT ERROR
9633         PUSHJ P,TYO
9634         MOVEI A,40
9635         PUSHJ P,TYO
9636 DORSAL: GET             ;COPY UP TO LINE FEED
9637         PUSHJ P,TYO
9638         CAIE A,12       ;LF
9639         JRST DORSAL
9640 CONERT: PUSHJ P,TIPIS
9641         PUSHJ P,CRR
9642 CONRAT: MOVE TM,[ACSAV,,P]
9643         BLT TM,P+6
9644         JRST SWFLS      ;GO BACK AND FLUSH
9645
9646
9647 CONRBT: GET
9648         CAIE A,12       ;LF
9649         JRST CONRBT
9650         JRST CONRAT
9651
9652 \f
9653 UP:     SKIPN WARN      ;FOR (NUMBER)^N
9654         SKIPN STRING
9655         JRST ITSEX
9656         MOVEM A,R1SV    ;SAVE THE ARROW
9657         NUMBER
9658         JRST CHEX       ;ITS PART OF A NUMBER
9659 ITSEX:  MOVE I,[6,,STRSTR]
9660         SKIPN CHARF
9661         JRST EXMB
9662         JRST SZPRT
9663
9664 EXMB:   MOAN UNARY ^
9665
9666 BDCONT: MOAN BAD CONTINUATION
9667
9668 KL=CR   ;SEMICOLON ACTS LIKE CR IN TERMINATING
9669
9670 STRSTR: SKIPN STRING
9671         JRST EXLS
9672         NUMBER
9673         SKIPA
9674         JRST EXLS
9675         SUBI I,61
9676         TDNE I,[-1,,777774]
9677         JRST EXLS
9678         MOVE A,STRING
9679         TDNE A,[3777,,-1]
9680         JRST EXLS
9681         ADDI I,POWR
9682         JRST @(I)
9683
9684 EXLS:   PUSH P,[ASCII !EXPLO!]
9685         PUSH P,[ASCII !G    !]
9686         PUSH P,[0]
9687         PUSH P,[1]
9688         SETOM EXRET'
9689         JRST FUNET
9690
9691 DV:     MOVE I,[4,,DIVIX]
9692         SKIPN CHARF
9693         MOVE I,[5,,UDIVI]
9694         JRST SZPRT
9695
9696 PSOPR:  PUSH SYM,I      ;PUSH OPERATOR FOR LATER EXCECUTION
9697         SKIPN STRING
9698         JRST RDITTS
9699         PUSHJ P,SHORT   ;CAN WE IMMEDIFY
9700         PUSHJ P,MVOI    ;AND MOVE OPERAND INTO STACK
9701         JRST CLSTR
9702
9703 \f
9704 PRODB:  NUMBER          ;OUTPUT WHAT IS IN STRING
9705         SKIPE IMMED     ;NO [ & ] IF IMMEDIATE USE
9706         JRST OVNM
9707         PUSH P,A
9708         MOVEI A,"[      ;[ FOR CONSTANT
9709         PUSHJ P,PUTREL
9710         POP P,A
9711         SETOM NUMFL
9712 OVNM:   CAIN I,"#
9713         JRST PRDOC
9714
9715         EXCH A,I
9716         PUSHJ P,PUTREL
9717         MOVE A,I
9718 PRDOC:  ILDB I,A
9719         JUMPN I,OVNM
9720         SKIPN NUMFL
9721         POPJ P,
9722         MOVEI A,"]      ;] FOR CONSTANT
9723         PUSHJ P,PUTREL
9724         SETZM NUMFL
9725         POPJ P,
9726
9727 PRODC:  HRLI A,440700   ;MAKE BYTE POINTER
9728         JRST PRDOC
9729
9730 LFTPR:  SPECN
9731         JRST RDITTS     ;IGNORE LP ON STACK
9732 \f
9733 RCAR:   HALT    ;IMPOSSIBLE FOR THESE TO BE ON STACK
9734 RPAR:   HALT
9735
9736 EQAAL:  SPECN
9737         SKIPE STRING
9738         PUSHJ P,MVOI
9739         MOVEI A,[ASCIZ !        MOVEM A!]
9740         PUSHJ P,PRODC
9741         POP P,STRING+2
9742         POP P,STRING+1
9743         POP P,STRING
9744         MOVE A,ENN
9745         SOS A
9746         PUSHJ P,FINOF
9747         JRST GAMB
9748
9749 ENDSAT: SPECN
9750         SKIPN ENDSTT
9751         JRST TOEARL
9752         SKIPE STRING
9753         PUSHJ P,MVOI
9754 GETLF:  GET
9755         CAIE A,12       ;LF
9756         JRST GETLF
9757         MOVE TM,[ACSAV,,P]
9758         BLT TM,P+6
9759         JRST SWRET      ;GO BACK
9760
9761 MVOI:   MOVE A,BTPNT
9762         ILDB I,A
9763         CAIN I,"&
9764         JRST MVOALR     ;OPERAND ALREADY THERE
9765         MOVEI A,[ASCIZ !        MOVE A!]
9766         SKIPE IMMED
9767         MOVEI A,[ASCIZ !        MOVEI A!]
9768 MVOIK:  PUSHJ P,PRODC
9769         MOVE A,ENN
9770         AOS ENN
9771 FINOF:  PUSHJ P,PUTREL
9772         MOVEI A,",
9773         PUSHJ P,PUTREL
9774         PUSHJ P,PRODB
9775         RETLIN
9776         POPJ P,
9777
9778 MVOALR: AOS ENN
9779         POPJ P,
9780
9781 TOEARL: MOAN TOO MANY )'S
9782 \f
9783 PLUS:   MOVEI A,[ASCIZ !        FADR A!]
9784         SKIPE INTEGR
9785         MOVEI A,[ASCIZ !        ADD A!]
9786         SKIPE IMMED
9787         MOVEI A,[ASCIZ !        ADDI A!]
9788 OPERT:  PUSHJ P,PRODC
9789         SKIPE STRING
9790         JRST GAINS
9791         SOS ENN
9792 OPRTE:  MOVE A,ENN
9793         SOS A
9794         PUSHJ P,PUTREL
9795         PUSHJ P,COMMAA
9796         MOVE A,ENN
9797         PUSHJ P,PUTREL
9798         RETLIN
9799         JRST COMMT
9800
9801 COMMAA: MOVEI A,",
9802         PUSHJ P,PUTREL
9803         MOVEI A,"A
9804         JRST PUTREL
9805
9806 GAINS:  MOVE A,ENN
9807         SOS A
9808         PUSHJ P,FINOF
9809         JRST GAMB
9810
9811 MINUX:  MOVEI A,[ASCIZ !        FSBR A!]
9812         SKIPE INTEGR
9813         MOVEI A,[ASCIZ !        SUB A!]
9814         SKIPE IMMED
9815         MOVEI A,[ASCIZ !        SUBI A!]
9816         JRST OPERT
9817
9818 TIMES:  PUSHJ P,TMSTR
9819         SKIPE IMMED
9820         MOVEI A,[ASCIZ !        IMULI A!]
9821         JRST OPERT
9822
9823 DIVIX:  MOVEI A,[ASCIZ !        FDVR A!]
9824         SKIPE INTEGR
9825         MOVEI A,[ASCIZ !        IDIV A!]
9826         SKIPE IMMED
9827         MOVEI A,[ASCIZ !        IDIVI A!]
9828         JRST OPERT
9829
9830 \f
9831 UMINU:  CAMN B,C
9832         JRST BAKWD              ;THESE HAVE TO BE STACKED REVERSE
9833         SKIPE STRING
9834         JRST MOABC
9835         MOVEI A,[ASCIZ !        MOVNS A!]
9836 UMINUC: PUSHJ P,PRODC
9837         MOVE A,ENN
9838         SOS A
9839         PUSHJ P,PUTREL
9840         RETLIN
9841         JRST COMMT
9842
9843 MOABC:  MOVEI A,[ASCIZ !        MOVN A!]
9844         SKIPE IMMED
9845         MOVEI A,[ASCIZ !        MOVNI A!]
9846         PUSHJ P,MVOIK
9847         JRST GAMB
9848
9849 UABS:   CAMN B,C
9850         JRST BAKWD
9851         SKIPE STRING
9852         JRST MOABS
9853         MOVEI A,[ASCIZ !        MOVMS A!]
9854         JRST UMINUC
9855
9856 MOABS:  MOVEI A,[ASCIZ !        MOVM A!]
9857         SKIPE IMMED
9858         MOVEI A,[ASCIZ !        MOVMI A!]
9859         PUSHJ P,MVOIK
9860         JRST GAMB
9861
9862 MVONT:  MOVEI A,[ASCIZ !        MOVE A!]
9863         PUSHJ P,PRODC
9864         MOVE A,ENN
9865         JRST ONMVS
9866
9867 TMSTR:  MOVEI A,[ASCIZ !        FMPR A!]
9868         SKIPE INTEGR
9869         MOVEI A,[ASCIZ !        IMUL A!]
9870         POPJ P,
9871 \f
9872 BAKWD:  PUSH SYM,A
9873         JRST PSOPR
9874
9875 UDIVI:  CAMN B,C
9876         JRST BAKWD      ;THESE HAVE TO BE STACKED REVERSE
9877         SKIPE INTEGR
9878         JRST UINDV
9879         SKIPN STRING
9880         PUSHJ P,MVONT
9881         MOVEI A,[ASCIZ !        HRLZI A!]
9882         PUSHJ P,PRODC
9883         MOVE A,ENN
9884         SKIPN STRING
9885         SOS A
9886         PUSHJ P,PUTREL
9887         MOVEI A,[ASCIZ !,201400!]
9888         PUSHJ P,PRODC
9889         RETLIN
9890         AOS ENN
9891         JRST DIVIX
9892
9893 ONTMS:  PUSHJ P,TMSTR
9894         PUSHJ P,PRODC
9895         MOVE A,ENN
9896         SOS A
9897 ONMVS:  PUSHJ P,PUTREL
9898         PUSHJ P,COMMAA
9899         MOVE A,ENN
9900         SOS A
9901 LSTCHX: PUSHJ P,PUTREL
9902         RETLIN
9903         POPJ P,
9904
9905 POWR:   GAMB?POWR2?POWAA?POWR4
9906
9907 POWR4:  PUSHJ P,ONTMS
9908 POWR2:  PUSHJ P,ONTMS
9909         JRST GAMB
9910
9911 POWAA:  PUSHJ P,MVONT
9912         AOS ENN
9913         PUSHJ P,ONTMS
9914         SOS ENN
9915         PUSHJ P,TMSTR
9916         PUSHJ P,PRODC
9917         RESTOR
9918         JRST OPRTE
9919
9920 COMMX:  AOS (P)
9921         SKIPE STRING
9922         PUSHJ P,MVOI
9923         JRST GAMB
9924 \f
9925 UINDV:  MOAN INTEGER UNARY DIVIDE
9926
9927 FUNCT:  SETZM EXRET
9928 FUNET:  SKIPE STRING
9929         PUSHJ P,MVOI
9930         SPECN
9931         PUSHJ P,MORFMC
9932         MOVEI A,[ASCIZ !        PUSHJ P,!]
9933         POP P,STRING+2
9934         POP P,STRING+1
9935         POP P,STRING
9936         PUSHJ P,PRODC
9937         PUSHJ P,PRODB
9938         RESTOR
9939         RETLIN
9940         PUSHJ P,MORFNC
9941         SKIPN EXRET
9942         JRST RDITTS     ;AS USED FROM FUNCT
9943         JRST COMMT      ;AS USED FROM  STRSTR
9944
9945 MORFMC: MOVE A,RANDM
9946         MOVEM A,RANSV'
9947         SKIPN CHARF     ;NO ARGUMENTS
9948         AOS ENN
9949         SETOM CHARF
9950         MOVEI A,"1
9951         CAMN A,ENN      ;ARE ARGUMENT ALREADY IN A0 AND UP
9952         POPJ P,
9953         SETZM CORDM
9954 MORYLP: PUSHJ P,ZENBD
9955         AOS CORDM
9956         SOSL RANSV
9957         JRST MORYLP
9958         POPJ P,
9959
9960 MORFNC: MOVEI A,"1
9961         CAMN A,ENN
9962         POPJ P,
9963         MOVE A,RANDM
9964         MOVEM A,CORDM'
9965 MORXLP: PUSHJ P,ZENBD
9966         SOSL CORDM
9967         JRST MORXLP
9968         POPJ P,
9969
9970 ZENBD:  MOVEI A,[ASCIZ !        EXCH A!]
9971         PUSHJ P,PRODC
9972         MOVE A,CORDM
9973         ADDI A,"0
9974         PUSHJ P,PUTREL
9975         PUSHJ P,COMMAA
9976         MOVE A,ENN
9977         SOS A
9978         ADD A,CORDM
9979         JRST LSTCHX
9980 \f
9981 TIPIS:  MOVE A,TEMP
9982         MOVEM A,BYTPNT
9983 MORTP:  ILDB A,BYTPNT
9984         CAIN A,1        ;EXCLAMATION
9985         POPJ P,
9986         ADDI A,"        ;SPACE
9987         PUSHJ P,TYO
9988         JRST MORTP
9989
9990 ]               ;END .I.FSW CONDITIONAL
9991 \f
9992 IFN LISTSW,[
9993
9994 ;LISTING ROUTINES.
9995
9996 PNTR:   MOVEM 17,PNTSA+17
9997         MOVEI 17,PNTSA
9998         BLT 17,PNTSA+16
9999         SKIPL LSTONP
10000         JRST PNTR5
10001         AOSE LISTPF
10002         JRST PNTR1
10003         SKIPGE T,LISTAD
10004         JRST PNTR2
10005         PUSHJ P,P6OD
10006         HLRZS T
10007         PUSHJ P,PSOS    ;PRINT SPACE OR '
10008         PUSHJ P,PILPTS
10009 PNTR3:  HLRZ T,LISTWD
10010         PUSHJ P,P6OD
10011         MOVS T,LSTRLC
10012         TLNE T,400000
10013         AOJ T,
10014         PUSHJ P,PSOS
10015         HRRZ T,LISTWD
10016         PUSHJ P,P6OD
10017         HRRZ T,LSTRLC
10018         PUSHJ P,PSOS
10019         PUSHJ P,PILPTS
10020         PUSHJ P,PILPTS
10021 PNTR4:  MOVE TT,[440700,,LISTBF]
10022 PNTR6:  CAMN TT,PNTBP
10023         JRST PNTR5A
10024         ILDB A,TT
10025         PUSHJ P,PILPT
10026         JRST PNTR6
10027
10028 PNTR5A: CALL PNTCR
10029         MOVE A,LISTBC
10030         CAIE A,14
10031          JRST PNTR7
10032 PNTR5C: CALL PILPT      ;OUTPUT THE ^L,
10033         CALL PNTHDR     ;AND THE PAGE NUMBER.
10034         JRST PNTR5D
10035
10036 PNTR7:  MOVEI A,12
10037         PUSHJ P,PILPT
10038 PNTR5D: SETOM LISTBC
10039 PNTR5:  MOVNI A,LISTBS*5-1
10040         MOVEM A,PNTSW   ;DETECT OVERFLOW OF LISTBF
10041         MOVE TT,[440700,,LISTBF]
10042         MOVEM TT,PNTBP
10043         MOVSI 17,PNTSA
10044         BLT 17,17
10045         POPJ P,
10046 \f
10047 PNTR5B: MOVE A,LISTBC
10048         CAIN A,14
10049         JRST PNTR5C
10050         JRST PNTR5D
10051
10052 PNTR2:  MOVEI T,8
10053         MOVEI A,40
10054         PUSHJ P,PILPT
10055         SOJG T,.-1
10056         JRST PNTR3
10057
10058 PNTR1:  MOVE TT,[440700,,LISTBF]
10059         CAMN TT,PNTBP
10060         JRST PNTR5B
10061         MOVEI T,25.
10062         MOVEI A,40
10063         PUSHJ P,PILPT
10064         SOJG T,.-1
10065         JRST PNTR4
10066
10067 PSOS:   MOVEI A,"'
10068         TRNN T,-1
10069 PILPTS: MOVEI A,40
10070         JRST PILPT
10071
10072 P6OD:   MOVE TT,[220300,,T]
10073 P6OD1:  ILDB A,TT
10074         ADDI A,"0
10075         PUSHJ P,PILPT
10076         TLNE TT,770000
10077         JRST P6OD1
10078         POPJ P,
10079
10080 PNTCR:  MOVEI A,^M      ;OUTPUT ^M TO LST IF OPEN.
10081 PILPTX: SKIPE LSTONP;OUTPUT CHAR TO LST IF LSTING.
10082          JRST PILPT
10083         RET
10084
10085 PNTHDR: MOVEI A,^I
10086         MOVEI B,10.     ;MOVE TO COLUMN 80.,
10087         CALL PILPT
10088         SOJG B,.-1
10089         SAVE LSTTTY
10090         HLLOM B,LSTTTY  ;POSITIVE SO TYOERR GOES ONLY TO LST.
10091         TYPR [ASCIZ/Page /]
10092         MOVE A,CPGN
10093         CALL [AOJA A,DPNT]
10094         REST LSTTTY
10095 PNTCRR: CALL PNTCR      ;OUTPUT CRLF TO LST IF OPEN.
10096 PNTLF:  MOVEI A,^J
10097         JRST PILPTX
10098 \f
10099 DEFINE LSTM %A,B,C
10100 IF1 [   [B] ? [C]   ]
10101 IF2 [   MOVE A,[B]
10102         MOVEM A,%A
10103 .=.+LSTM0-2
10104         MOVE A,[C]
10105         MOVEM A,%A
10106 .=.-LSTM0
10107 ]
10108 TERMIN
10109
10110 A.LSTFF:        AOS (P) ;RETURN NO VALUE.
10111 ;          ADDR, CONTENTS IF NOT LISTING, CONTENTS IF LISTING.
10112 LSTOFF: LSTM LSTONP,0,-1
10113         LSTM LSTPLM,[TLO B,4^5][JRST PSHLML]
10114         LSTM RCHLST,RCHLS1,AOSN PNTSW
10115         LSTM RCH1LS,RET,[CAILE A,^M]
10116         LSTM POPLML,JFCL,[IDPB A,PNTBP]
10117         JRST MDSCLR
10118 LSTM0==.-LSTOFF
10119
10120 LSTON:  BLOCK LSTM0-1
10121         JRST MDSSET
10122
10123 A.LSTN: SKIPN LISTP1    ;IF SHOULD LIST THIS PASS
10124          JUMPGE FF,MACCR
10125         SKIPE LISTP     ;AND WANT LISTING,
10126          CALL LSTON     ;TURN ON LISTING OUTPUT.
10127         JRST MACCR
10128
10129 IFNDEF LISTBS,LISTBS==50.       ;LISTBF SIZE IN WORDS.
10130
10131 VBLK            ;LISTING FEATURE VARIABLES
10132
10133 PNTBP:  0       ;POINTER TO LISTING LINE BUFFER
10134 LSTONP: 0       ;NONZERO WHEN OUTPUTTING TO LISTING FILE.
10135 LISTP:
10136 LISTON: 0       ;-1 IF LISTING ON
10137 PNTSW:  0       ;-1 IF LAST CHR CR OR LF, OR -<# CHARS SPACE LEFT IN LISTBF>
10138 LISTBF: BLOCK LISTBS
10139 LISTAD: 0       ;ADDRESS OR -1 NONE 3.1 RELOC
10140 LISTWD: 0       ;WORD
10141 LSTRLC: 0       ;RELOCATION
10142 LISTPF: 0       ;-1 OTHERS CONTAIN SOMETHING
10143 LISTBC: 0       ;BREAK CHR CR LF OR FF OR -1 IF NONE SINCE LAST PNTR
10144 LISTTM: 0       ;TEMP AT AEND
10145 PNTSA:  BLOCK 20        ;AC SAVE AREA FOR LISTING FEATURE
10146 LISTP1: 0       ;POSITIVE => WANT TO LIST EVEN ON PASS 1.
10147 ] ;END IFN LISTSW,
10148
10149 IFE LISTSW,VBLK
10150
10151 ;THESE VARIABLES ARE REFERENCED EVEN IF LISTSW IS 0.
10152 LSTTTY: 0       ;TYOERR TYPES ON TTY IFF LE 0, ON LST IF NOT 0.
10153 LSTPLM: TLO B,4^5       ;OR JRST PSHLML         ;XCT'D BY PSHLMB.
10154 POPLML: JFCL            ;OR IDPB A,PNTSW        ;XCT'D IN POPLMB.
10155
10156 PBLK
10157 IFE LISTSW, A.LSTN: A.LSTF:     RET
10158 \f
10159 VBLK
10160 IFN CREFSW,[
10161 CREFP:  0       ;SET BY C SWITCH TO REQUEST CREFFING.
10162 CRFONP: 0       ;SET WHILE CREFFING.
10163 CRFLFL: 0       ;LAST PAGNUM,,LINENUM OUTPUT.
10164 CRFINU: JFCL\PUSHJ P,CRFUSE     ;XCT THIS TO CREF NON-DEF OCCUR.
10165 CRFLBL: JFCL\PUSHJ P,CRFLB1     ;XCT FOR DEF. OF NORMAL SYM.
10166 CRFEQL: JFCL\PUSHJ P,CRFEQ1     ;   FOR DEF. OF NORMAL SYM. OR INTSYM.
10167 CRFMCD: JFCL\PUSHJ P,CRFMC1     ;     FOR DEF. OF MACRO.
10168 CRFDEF: JFCL\PUSHJ P,CRFDF1     ;       FOR RANDOM DEF, CHECK FLAGS.
10169 ]
10170 CRFILE: 0       ;SET => SHOULDN'T OUTPUT PAGNUM,,LINENUM'S
10171 ;USED BY .CRFILE INTSYM SO CAN'T BE IN CONDIT.
10172 PBLK
10173 IFN CREFSW,[
10174 CRFEQ1: MOVEI T,(B)
10175         CAIN A,1        ;IF NOT PSEUDO OR NOT INTSYM,
10176         CAIE T,INTSYM
10177         JRST CRFLB1     ;IS NORMAL SYM.
10178 CRFOD1: MOVSI T,600000  ;ELSE DEFINING INSN.
10179         JRST CRFEQ2
10180
10181 CRFDF2: MOVEI T,(B)     ;DECIDE WHETHER DEFINING MACRO OR PSEUDO.
10182         CAIE T,MACCL
10183         JRST CRFOD1
10184 CRFMC1: SKIPA T,[500000,,]      ;DEFINING MACRO.
10185 CRFLB1: MOVSI T,440000  ;DEFINING NORMAL SYM.
10186 CRFEQ2: PUSH P,A
10187         MOVE A,T
10188         JRST CRFMA1
10189
10190 ;COME HERE FOR NON-DEF; MUST DECIDE WHAT TYPE SYM.
10191 CRFUSE: TLNE C,3NCRF    ;SYM MAY HAVE CREFFING SUPPRESSED.
10192         POPJ P,
10193         PUSH P,A
10194         CAIN A,1
10195         JRST CRFMAC     ;PSEUDOS, MACROS.
10196         MOVSI A,40000   ;FLAG FOR NORMAL SYM.
10197         TRNN C,-1
10198         MOVSI A,200000  ;FLAG FOR INSNS.
10199 CRFMA1: PUSH P,A
10200         MOVE A,CLNN
10201         HRL A,CPGN
10202         AOBJN A,.+1     ;A HAS PAGNUM,,LINENUM .
10203         SKIPGE CRFILE   ;IF SHOULD OUTPUT IT,
10204         JRST CRFUS1
10205         CAME A,CRFLFL   ;AND HAS CHANGED, DO SO.
10206         PUSHJ P,CRFOUT
10207         MOVEM A,CRFLFL
10208 CRFUS1: POP P,A
10209         IOR A,SYM       ;COMBINE SYM AND CREF FLAG.
10210         PUSHJ P,CRFOUT
10211         JRST POPAJ
10212
10213 CRFMAC: MOVEI A,(B)
10214         CAIN A,MACCL
10215         SKIPA A,[100000,,]      ;MACRO
10216         MOVSI A,200000          ;PSEUDO-OP.
10217         JRST CRFMA1
10218 \f
10219 ;DEFINING OCCURRENCE, MIGHT BE ANY TYPE SYM.
10220 CRFDF1: CAIN A,1        ;TYPE 1 => MACRO OR PSEUDO.
10221         JRST CRFDF2
10222         TRNE C,-1       ;ELSE INSN OR NORMAL SYM.
10223         JRST CRFLB1
10224         JRST CRFOD1
10225
10226 DEFINE CRFM %A,B,C
10227 IF1 [   [B]
10228         [C] ]
10229 IF2 [   MOVE A,[B]
10230         MOVEM A,%A
10231 .=.+CRFM0-2
10232         MOVE A,[C]
10233         MOVEM A,%A
10234 .=.-CRFM0]
10235 TERMIN
10236
10237
10238 A.CRFFF:        AOS (P) ;.CRFOFF - STOP CREFFING. NO VAUE.
10239 ;               LOCATION, NORMAL VALUE, VALUE WHILE CREFFING
10240 CRFOFF: CRFM    CRFONP,0,-1
10241         CRFM    CRFLBL,JFCL,[PUSHJ P,CRFLB1]
10242         CRFM    CRFEQL,JFCL,[PUSHJ P,CRFEQ1]
10243         CRFM    CRFMCD,JFCL,[PUSHJ P,CRFMC1]
10244         CRFM    CRFINU,JFCL,[PUSHJ P,CRFUSE]
10245         CRFM    CRFDEF,JFCL,[PUSHJ P,CRFDF1]
10246         POPJ P,
10247 CRFM0==.-CRFOFF
10248
10249 CRFON:  BLOCK CRFM0-1
10250         POPJ P,
10251
10252 A.CRFN: JUMPGE FF,MACCR
10253         SKIPE CREFP     ;.CRFON, IF HAVE CREF FILE, START CREFFING.
10254         PUSHJ P,CRFON
10255         JRST MACCR
10256 ] ;END IFN CREFSW,
10257 \f
10258 IFN TS,[        ;;TS            ;TIME-SHARING ROUTINES
10259
10260 IFNDEF TYPDLC,TYPDLC==7 ;MAXIMUM TOTAL DEPTH OF .INSRT (INCLUDING TTY)
10261 IFNDEF MX.INS,MX.INS==5 ;MAXIMUM DEPTH .INSRT FILES ONLY
10262 IFNDEF MAXIND,MAXIND==6 ;MAXIMUM # @: TABLE ENTRIES FOR .INSRT
10263 IFN DECSW,[
10264         UTOBFL==203
10265         CRFBSZ==203
10266         UTIBFL==410
10267         LSTBSZ==203
10268         ERRBSZ==203
10269 ]
10270 IFNDEF UTIBFL,UTIBFL==400       ;INPUT BUFFER SPACE.
10271 IFNDEF UTOBFL,UTOBFL==200
10272 IFNDEF CMBFL,CMBFL==50          ;COMMAND BUFFER LENGTH.
10273 IFNDEF CRFBSZ,CRFBSZ==200       ;# WDS CREF OUTPUT BUFFER.
10274 IFNDEF LSTBSZ,LSTBSZ==200
10275 IFNDEF ERRSW,ERRSW==1   ;1 FOR ERROR FILE OUTPUT CAPABILITY.
10276 IFNDEF ERRBSZ,ERRBSZ==1 ;ERROR FILE BUFFER SIZE.
10277
10278 ERRC==0 ;ERR DEVICE CHANNEL.
10279 TYIC==1         ;TTY INPUT CHANNEL
10280 TYOC==2         ;TTY OUTPUT CHANNEL
10281 CREFC==3        ;CREF OUTPUT.
10282 UTYOC==4        ;OUTPUT FILE
10283 LPTC==5         ;LISTING (LPT)
10284 ERRFC==6        ;ASSEMBLY ERROR OUTPUT FILE.
10285 UTYIC==7        ;1ST INPUT CHANNEL, UTYIC+N USED FOR NTH .INSRT LEVEL IN DEC VERSION.
10286
10287 VBLK
10288 INTJPC: 0       ;SAVES .JPC AT INTERRUPT.
10289 INTSVP: 0       ;SAVES P ON INTERRUPT FOR DEBUGGING
10290
10291 ;NOTE THAT ONLY PDL OV IS NOW ENABLED.
10292
10293 IFN ITSSW,[
10294 .JBCNI:
10295 TSINT:  0               ;1ST WD INTERRUPTS (AT PRESENT) ARE CONSIDERED FATAL ERRORS
10296 .JBTPC: 0               ;ERROR PROCESSOR RE-ENABLES INTERRUPTS
10297         .SUSET [.RJPC,,INTJPC]
10298         SKIPGE TSINT
10299          JRST TTYINT    ;SECOND-WORD INTS.
10300         JRST TSINT1     ;JUMP INTO PURE CODING AND PROCESS INTERRUPT
10301 ]
10302 .ELSE   CCLFLG:0        ; FLAG TO INDICATE CCL ENTRY FROM COMPIL
10303
10304 PBLK
10305 TSINT1: MOVEM P,INTSVP  ;SAVE P FOR POSSIBLE DEBUGGING
10306         .SUSET [.SPICL,,[-1]]
10307 IFE SAILSW,MOVE A,.JBCNI        ;GET INTERRUPT REQUEST WORD
10308 .ELSE MOVE A,JOBCNI
10309         TRNE A,200000   ;PDL OVERFLOW?
10310          JRST CONFLP
10311         MOVE B,[TYPR [ASCIZ/Unknown interrupt - Fatal/]]
10312         MOVEM B,40
10313 IFE SAILSW,MOVE A,.JBTPC        ;SO ERROR ROUTINE WILL PRINT OUT PROPERLY
10314 .ELSE MOVE A,JOBTPC
10315         JSA A,ERROR
10316 \f
10317 ;MIDAS STARTS HERE.
10318 BEG:
10319 IFN DECSW,[
10320         TDZA A,A
10321          SETO A,
10322         MOVEM A,CCLFLG          ; REMEMBER TYPE OF START-UP
10323         RESET
10324         MOVEI A,600000
10325         APRENB A,
10326 ]
10327 IFN ITSSW,[
10328         .SUSET [.RSNAM,,RSYSNM] ;GET SYSTEM NAME
10329         .SUSET [.SMASK,,[%PIPDL]]       ;PDL OVERFLOW ONLY.
10330         .SUSET [.SMSK2,,[1_TYIC]]
10331         SYSCAL TTYSET,[1000,,TYIC
10332                 [232020,,202020]
10333                 [232020,,220220]]
10334         .SUSET [.SPICL,,[-1]]   ;PERMIT INTERRUPTS (IN CASE RESTARTED DURING INTERRUPT)
10335 ]
10336         MOVEI FF,0              ;INITIALIZE FLAGS
10337         MOVE P,[-LPDL,,PDL]     ;INITIALIZE P
10338         AOSN NVRRUN
10339          JRST BEG9
10340         TYPR [ASCIZ /Can't restart MIDAS/]
10341         JRST TSRETN
10342
10343 BEG9:   MOVEI D,SYMDSZ  ;GET DEFAULT SYMTAB SIZE
10344 IFN ITSSW,[
10345         .SUSET [.RXJNAM,,A]
10346         CAME A,['MMIDAS]        ;OR LARGER FOR MMIDAS
10347          CAMN A,[SIXBIT/MM/]
10348           MOVEI D,SYMMSZ
10349 ]
10350         SKIPGE ISYMF    ;THE FIRST TIME THROUGH,
10351          MOVEM D,SYMLEN ;MAKE THAT THE SIZE TO USE.
10352         CALL JCLINI     ;NOW TRY TO FETCH JCL.
10353 IFN ITSSW,[SKIPGE ISYMF ;SKIP IF SYMS SPREAD
10354          CALL TSYMGT    ;GET TS SYMS FROM SYSTEM
10355 ]
10356         SKIPGE CMPTR    ;IF NO CMD FROM DDT,
10357         JRST GO2A       ;ANNOUNCE MIDAS'S NAME AND VERSION.
10358 IFG PURESW-DECSW,[
10359         SKIPGE PURIFG
10360          TYPR [ASCIZ /NOTPUR /]
10361 ]
10362         MOVE B,[SIXBIT /MIDAS./]
10363         PUSHJ P,SIXTYO
10364         MOVE B,[MIDVRS]
10365         PUSHJ P,SIXTYO
10366 ;       JRST GO2A
10367 \f
10368 GO2A:   SETOM FATAL
10369         SETZM TTYFLG
10370 IFE ITSSW,SETZM ERRTTL  ; INITIALIZE ERROR COUNTER
10371         MOVEI FF,0      ;INITIALIZE FLAGS
10372         SKIPLE CMPTR
10373         SETZM CMPTR
10374 IFN RUNTSW,[    PUSHJ P,RNTTMA  ;GET INITIAL RUN TIME.
10375                 MOVEM A,IRUNTM']
10376         SETZM LSTTTY
10377         PUSHJ P,CMD     ;GET TYPED IN COMMAND
10378         SKIPGE SMSRTF
10379          JRST GO21
10380         TYPR [ASCIZ/SYMTAB clobbered
10381 /]
10382         JRST GO2A
10383
10384 GO21:   PUSHJ P,GINIT   ;INITIALIZE STUFF
10385         PUSHJ P,OPNRD   ;OPEN INPUT FILE
10386         PUSHJ P,WINIT   ;OPEN OUTPUT FILE, CREF FILE.
10387 IFN DECSW,[
10388         SKIPGE CCLFLG
10389          OUTSTR [ASCIZ /MIDAS:  /]
10390 ]
10391 GO3:    MOVEMM TTYFLG,WSWCNT ;TURN OFF TYPEOUT IF THERE WERE (W) SWITCHS.
10392         SETOM LSTTTY
10393         JSP A,$INIT     ;INITIALIZE FOR ASSEMBLY
10394         JSP A,PS1       ;DO PASS 1
10395         TRNE FF,FRNPSS  ;IF 2 PASS ASSEMBLY,
10396          PUSHJ P,OPNRD  ;THEN RE-OPEN INPUT FILE
10397         JSP A,PLOD      ;MAYBE PUNCH OUT SBLK LOADER IN SOME FORMAT
10398         JSP A,PS2       ;DO PASS 2
10399         JSP A,PSYMS     ;MAYBE PUNCH OUT SYMBOL TABLE
10400 IFN A1PSW,[
10401         TLZ FF,FLOUT
10402         AOS PRGC        ;INDICATE END STATEMENT ENCOUNTERED
10403         SETOM OUTC      ;" " "
10404         TRNN FF,FRNPSS  ;IF 1 PASS ASSEMBLY,
10405          SKIPGE CONTRL
10406           CAIA
10407         JRST GO3        ;THEN TRY TO ASSEMBLE ANOTHER PROGRAM
10408 ]
10409 IFN FASLP,[
10410         SKIPGE A,CONTRL
10411         TRNN A,FASL
10412          JRST GO4
10413         MOVE A,[SIXBIT /*FASL*/]        ;"FINISH" FASL FILE
10414         MOVEI B,17
10415         PUSHJ P,FASO    ;IGNORE END FROB, BUT OUTPUT FASL END CODE
10416         MOVE A,[.BYTE 7 ?3 ? 3 ? 3? 3? 3]
10417         PUSHJ P,FASO1   ;RANDOMNESS
10418         PUSHJ P,FASBE   ;WRITE OUT LAST BLOCK
10419 ]
10420 GO4:    SETZM FATAL     ;THERE WAS NO FATAL ERROR: OUTPUT FILES GET RENAMED.
10421 GO2:
10422 RETN2:  PUSHJ P,.FILE
10423         SETZM LSTTTY
10424 IFN RUNTSW,[
10425         PUSHJ P,RNTTYO  ;TYPE OUT RUN TIME USED SINCE GO2A
10426 ];IFN RUNTSW
10427         CALL ERRCLS     ;FILE AWAY ERROR FILE.
10428         JRST TSRETN
10429
10430                 ;INITIALIZATION ROUTINE CALLED ONCE PER (COMMANDED) ASSEMBLY
10431
10432 GINIT:  IFN A1PSW,[
10433         SETOM PRGC
10434         SETOM OUTC
10435 ]
10436 IFN DECSW,[ IFE SAILSW,[
10437         SETZM V.SITE    ;; CODE TO SET UP .SITE'S VALUE, ON DEC SYSTEM.
10438         MOVE A,[V.SITE,,V.SITE+1]
10439         BLT A,V.SITE+4
10440         MOVE B,[440600,,V.SITE]
10441         MOVSI C,-5      ;PROCESS 5 WORDS F .GTCNF
10442 GINIT1: HRLZ A,C
10443         HRRI A,11       ;11 = .GTCNF
10444         GETTAB A,       ;GET 1 WORD
10445          SETZ A,
10446 GINIT2: SETZ AA,        ;EXTRACT THE ASCII CHARS AND STORE THEM.
10447         ROTC AA,7
10448         TRCE AA,140     ;SWAP BIT 40 WITH BIT 100, THUS TURNING
10449          TRCE AA,140    ;"A TO 'A, "a TO 'A, "1 TO '1, ETC, AND ^@ TO ' .
10450           TRCE AA,140
10451         IDPB AA,B       ;STORE THE SIXBIT INTO .SITE'S VALUE STRING.
10452         JUMPN A,GINIT2  ;WHEN NOTHING LEFT OF THIS WORD OF .GTCNF, GET THE NEXT.
10453         AOBJN C,GINIT1
10454 ]];END DECSW
10455         MOVE A,[MAXIND,,FDSOFS]
10456         MOVEM A,INDDP   ;INITIALIZE POINTER INTO INDIRECT FILE TABLE
10457 IFDINI: MOVE A,[DNAM,,IFDS]
10458         BLT A,IFDS+LFDSE-1      ;SET UP INPUT FILE NAMES FROM DNAM ETC.
10459         POPJ P,
10460 \f
10461 IFN RUNTSW,[    ;TYPE OUT RUN TIME USED
10462
10463 RNTTYO:
10464 IFE ITSSW,[     ; NOBODY WANTS THIS ON ITS, BUT OTHER PEOPLE DO...SIGH...
10465         SKIPE A,ERRTTL  ; ANY ASSEMBLY ERRORS?
10466          JRST [ TYPR [ASCIZ/? /]        ; YES, ERROR MESSAGE FOR BATCH CONTROLLERS
10467                 CALL DPNT
10468                 TYPR [ASCIZ/ error(s) detected
10469 /]
10470                 JRST .+1]
10471 IFN DECSW,[
10472         SKIPE CCLFLG                    ; CALLED VIA CCL?
10473          RET
10474 ] ; IFN DECSW
10475 ] ; IFE ITSSW
10476         TYPR [ASCIZ /Run time = /]
10477         CALL A.MRUNT    ;GET RUNTIME IN MILLISEC. IN A.
10478         IDIVI A,10.
10479         IDIVI A,100.    ;GET SECS AND HUNDREDTHS.
10480         HRLM B,(P)      ;SAVE REMAINDER
10481         PUSHJ P,HMSTYO  ;TYPE OUT SECS
10482         MOVEI A,".
10483         CALL TYO
10484         HLRZ A,(P)
10485         CALL RNTYO3     ;TYPE OUT HUNDREDTHS
10486         CALL CRR
10487         CALL A.SYMC
10488         CALL DPNT
10489         TYPR [ASCIZ/ Symbols including initial ones
10490 /]
10491         RET
10492
10493                 ;TYPE OUT H:MM:SS TIME IN A
10494                 ;DOESN'T WORK FOR TIMES .GE. 60. HOURS
10495
10496 HMSTYO: IDIVI A,60.
10497         JUMPE A,HMSTY2
10498         HRLM B,(P)
10499         PUSHJ P,HMSTYO
10500         MOVEI A,":
10501 RNTYO2: PUSHJ P,TYO     ;TYPE DELIMITING CHAR
10502         HLRZ A,(P)
10503 RNTYO3: IDIVI A,10.
10504         PUSHJ P,ADGTYO  ;TYPE OUT DIGIT IN A
10505         MOVEI A,"0(B)
10506         JRST TYO
10507
10508 HMSTY2: MOVE A,B
10509         JRST DPNT
10510
10511 RNTTMA: .SUSET [.RRUNT,,A]
10512 IFN DECSW,[SETZ A,
10513         RUNTIM A,]
10514         POPJ P,
10515
10516 A.MRUNT:        PUSHJ P,RNTTMA  ;GET CURRENT RUN TIME
10517         SUB A,IRUNTM'   ;SUBTRACT RUN TIME AS OF GO2
10518 IFN ITSSW,[MULI A,4069. ;CONVERT TO NANOSECONDS
10519         DIV A,[1.^6]    ;THEN TO MILLISECONDS.
10520 ]
10521         JRST CLBPOP
10522 ]
10523 \f
10524                 ;TS OUTPUT ROUTINES
10525
10526 PPB:    JUMPGE FF,CPOPJ
10527 PPBA:
10528 TPPB:   SOSGE UTYOCT
10529          JRST TPPB1
10530         IDPB A,UTYOP
10531         RET
10532
10533 TPPB1:  CALL TPPBF      ;OUTPUT THE BUFFER,
10534         JRST TPPB
10535
10536 TPPBF:  SAVE C
10537         MOVE C,[0 UTYOC,UTOHDR]
10538         CALL OBUFO      ;OUTPUT & RE-INIT BUFFER.
10539         REST C
10540         RET
10541
10542 WINIT:
10543 IFN ERRSW,[
10544         SKIPN ERRFP     ;IF WANT ERROR OUTPUT FILE,
10545          JRST WINIT2
10546         CALL OINIT      ;OPEN IT.
10547          0 ERRFC,ERRDEV
10548          SIXBIT/ERROUT/
10549          ERRHDR,,ERRBUF
10550         SETOM ERRFOP    ;ERROR FILE NOW OPEN.
10551 WINIT2: ]
10552         PUSHJ P,OINIT   ;OPEN OUTPUT FILE, FN2=OUTPUT.
10553          13^9 UTYOC,ONAM        ;<DEC-MODE> CHNL,NAME-BLOCK.
10554          SIXBIT/OUTPUT/
10555          UTOHDR,,UTOBUF
10556 IFN ITSSW,[
10557         TLZ FF,FLPTPF   ;INITIALLY ASSUME DEVICE NOT PAPER TAPE PUNCH
10558         .STATUS UTYOC,A ;GET STATUS OF OUTPUT CHANNEL
10559         ANDI A,77       ;MASK TO DEVICE CODE
10560         CAIN A,7        ;IF PAPER TAPE PUNCH,
10561         TLO FF,FLPTPF   ;THEN SET FLPTPF
10562 ]
10563 IFN LISTSW,[
10564         SKIPN LISTP
10565          JRST WINIT1
10566         CALL OINIT
10567          0 LPTC,LSTDEV  ;OPEN LISTING FILE IF DESIRED.
10568          SIXBIT/LSTOUT/
10569          LSTHDR,,LSTBUF
10570 WINIT1:
10571 ]
10572 IFN CREFSW,[
10573         SKIPN CREFP     ;IF CREF REQUESTED,
10574          RET
10575         PUSHJ P,OINIT   ;OPEN CREF FILE, FN2=CRFOUT
10576          13^9 CREFC,CRFDEV
10577          SIXBIT/CRFOUT/
10578          CRFHDR,,CRFBUF
10579         MOVE A,[.BYTE 7 ? 177 ? "B ? ^W]
10580         PUSHJ P,CRFOUT  ;OUTPUT HEADER TO INDICATE IMAGE INPUT.
10581         PUSHJ P,CRFSSF  ;OUTPUT SET-SOURCE-FILE BLOCK.
10582 ]
10583         RET
10584 \f
10585 IFN ITSSW,RELEAS==.CLOSE
10586
10587 ;CLOSE INPUT, BIN, CREF AND LIST FILES.
10588 .FILE:  RELEAS UTYIC,
10589         MOVNI A,1
10590         SKIPL B,CONTRL  ;IF RELOCATABLE,
10591         PUSHJ P,TPPB    ;OUTPUT A -1 SO STINK WILL SEE EOF
10592         SETZ A,         ;IN DEC FMT, OUTPUT A 0 AT END.
10593         TRNE B,DECREL
10594          CALL TPPB
10595         SKIPE ONAM+2
10596         JRST .FILE2     ;OUTPUT FNAM2 WAS EXPLICITLY SPECIFIED
10597         SKIPL B,CONTRL
10598         SKIPA A,[IFN DECSW,['STK,,] .ELSE ['REL,,]]
10599         MOVSI A,(SIXBIT /BIN/)
10600         TRNE B,DECREL   ;THE DEFAULT DEPENDS ON OUTPUT TYPE.
10601          MOVSI A,'REL
10602 IFN FASLP,[
10603         TRNE B,FASL
10604         MOVE A,[IFN ITSSW,[SIXBIT /FASL/] .ELSE ['FAS,,]]
10605 ]
10606         MOVEM A,ONAM+2
10607 .FILE2: JSP A,OCLOSE
10608          0 UTYOC,UTOHDR ;WRITE OUT BUFFER, RENAME AND CLOSE OUTPUT FILE.
10609          ONAM
10610 IFN LISTSW,[
10611         SKIPN LISTP     ;LISTING FILE OPEN =>
10612          JRST .FILE3
10613         CALL PNTCR      ;END WITH CR AND FF.
10614         MOVEI A,^L
10615         CALL PILPT
10616         JSP A,OCLOSE
10617          0 LPTC,LSTHDR  ;OUTPUT BUFFER, RENAME & CLOSE IT.
10618          LSTDEV
10619 .FILE3:
10620 ] ;END IFN LISTSW
10621 IFN CREFSW,[
10622         SKIPN CREFP     ;IF CREF FILE OPEN,
10623         POPJ P,
10624         MOVEI A,0
10625         PUSHJ P,CRFOUT  ;OUTPUT EOF BLOCK,
10626         JSP A,OCLOSE    ;WRITE BUFFER, CLOSE.
10627          0 CREFC,CRFHDR ; 0 CHNL,HEADER
10628          CRFDEV
10629 ]
10630         RET
10631
10632 ;FILE OUT ERROR OUTPUT FILE.
10633 ERRCLS: SETZM FATAL     ;ERR FILE RENAMED EVEN AFTER FATAL ERROR.
10634 IFN ERRSW,[
10635         SKIPN ERRFOP
10636          RET            ;THERE IS NONE.
10637         MOVEI A,^M
10638         CALL ERRCHR     ;PUT CRLF AT ENND.
10639         MOVEI A,^J
10640         CALL ERRCHR
10641         JSP A,OCLOSE    ;RENAME AND CLOSE.
10642          0 ERRFC,ERRHDR
10643          ERRDEV
10644         SETZM ERRFOP
10645 ]
10646         RET
10647 \f;      PUSHJ P,OINIT   ;OPEN OUTPUT FILE
10648 ;        MODE CHNL,NAME-BLOCK-ADDR
10649 ;       SIXBIT/DESIRED-TEMPORARY-FN2/
10650 ;       HEADER,,BUFFER SPACE    ;USED ONLY IN DEC VERSION.
10651 ;THE MODE SHOULD BE 13^9 FOR BINARY, 0 FOR ASCII.
10652 IFN ITSSW,[
10653 OINIT:  MOVE A,(P)
10654         HLRZ B,2(A)     ;GET ADDR OF HEADER,
10655         SETOM 2(B)      ;SET BUFFER BYTE COUNT TO -1 => NOT INITTED.
10656         MOVE AA,1(A)    ;GET 2ND ARG,
10657         MOVS A,@(P)     ;COPY OUTPUT FILE'S EVENTUAL NAMES INTO DNAM, ETC.
10658         CALL A.IMP1
10659         .CALL OINITR    ;TRANSLATE THEM AS IF OPENING THAT FILE,
10660          JRST OINITL    ;(TOO MANY TRANSLATIONS)
10661         .CALL OINITB    ;DELETE OLD TEMP NAME FILE.
10662          JFCL           ;THERE WAS NONE.
10663         LDB A,[270400,,@(P)]    ;GET CHANNEL NUM.
10664         HRLI A,7        ;OPEN MODE.
10665         LDB B,[331100,,@(P)]
10666         CAIN B,0        ;BUT MAYBE WANT ASCII MODE.
10667          HRLI A,3
10668         .CALL OINITO
10669         JRST OINITL
10670         HRRZ A,@(P)
10671         MOVEI B,3(A)    ;SUCCESSFUL OPEN, COPY TRANSLATED NAMES INTO NAME-BLOCK FOR FILE
10672         HRLI A,DNAM
10673         BLT A,(B)       ;FOR EVENTUAL RENAME.
10674 POPJ3:  AOS (P) ;SKIP OVER 3 ARGS.
10675 POPJ2:  AOS (P)
10676         JRST POPJ1
10677
10678 ;       JSP A,OCLOSE
10679 ;       0 CHNL,HEADER
10680 ;       NAMEBLOCKADDR
10681 ;WRITE OUT LAST BUFFER, RENAME TO NAMES IN NAMEBLOCK AND CLOSE.
10682 OCLOSE: MOVE C,(A)      ;1ST WD OF ARGS IS WHAT OBUFO WANTS.
10683         LDB B,[360600,,1(C)]    ;JUST IN CASE THIS IS ASCII FILE,
10684         DPB B,[300600,,OCLOSP]  ;GET BP TO UNUSED PART OF LAST WD OF BUFFER,
10685         MOVE B,[ASCIC//]
10686         DPB B,OCLOSP    ;AND PAD WITH ^C'S.
10687         SOS 2(C)        ;OBUFO ASSUMES BYTE COUNT WAS SOS'D.
10688         CALL OBUFO      ;WRITE OUT LAST PARTIAL BUFFER
10689         MOVE B,1(A)
10690         LDB C,[270400,,(A)]     ;GET CHNL NUM.
10691         SKIPE FATAL
10692          JRST OCLOS1    ;AFTER FATAL ERROR, DON'T RENAME OUTPUTFILES.
10693         .CALL ORENMB    ;RENAME (B HAS NAMEBLOCK ADDR)
10694          HALT
10695 OCLOS1: .CALL OCLOSB    ;CLOSE
10696          HALT
10697         JRST 2(A)
10698 \f
10699 ORENMB: SETZ ? SIXBIT/RENMWO/
10700         C ? 1(B) ? SETZ 2(B)    ;[CHNL] ? [FN1] ? [FN2] ((SETZ))
10701
10702 OCLOSB: SETZ ? SIXBIT/CLOSE/
10703         SETZ C
10704
10705 OINITB: SETZ ? SIXBIT/DELETE/
10706         DNAM ? ['_MIDAS] ? AA ? SETZ SNAM
10707
10708 OINITR: SETZ ? SIXBIT/TRANS/
10709         REPEAT 4,DNAM+.RPCNT
10710         REPEAT 4,[? 2000,,DNAM+.RPCNT ] ((SETZ))
10711
10712 OINITO: SETZ ? SIXBIT/OPEN/ ? A
10713         DNAM ? ['_MIDAS] ? AA ? SETZ SNAM
10714
10715 ;WRITE OUT AND REINITIALIZE BUFFER FOR FILE.
10716 ;ASSUMES BYTE COUNT (HEADER 3RD WD) WAS SOS'D.
10717 ;C HAS <0 CHNL,HEADER>
10718 ;IN ITS VERSION, HEADER 1ST WD HAS <SIZE IN BYTES>,,<BUFFER ADDR>-1
10719 OBUFO:  SAVE A
10720         SAVE AA
10721         AOSGE 2(C)      ;WAS COUNT SOS'D FROM -1?
10722          JRST OBUFO1     ;YES, BUFFER HADN'T BEEN INITTED, DON'T WRITE IT.
10723         MOVN A,1(C)
10724         ADD A,(C)       ;RH(A) HAS -<# WDS USED IN BUFFER>.
10725         MOVSI A,(A)
10726         HRR A,(C)
10727         AOS A           ;A HAS AOBJN -> USED PART OF BUFFER.
10728         HLLZ AA,C
10729         IOR AA,[.IOT A]
10730         SKIPGE A
10731         XCT AA          ;WRITE IT IN FILE.
10732 OBUFO1: MOVE A,1(C)
10733         HRR A,(C)       ;POSITION THE B.P. BEFORE START OF BUFFER,
10734         TLZ A,770000    ;AFTER LAST BYTE IN WD (IDPB WILL USE 1ST BUFFER WD)
10735         MOVEM A,1(C)
10736         HLRE A,(C)
10737         MOVEM A,2(C)    ;SET UP BYTE COUNT.
10738         REST AA
10739         JRST POPAJ
10740
10741 TFEED:  TLNN FF,FLPTPF  ;IF OUTPUT DEVICE NOT PTP,
10742         POPJ P,         ;THEN DO NOTHING
10743         PUSHJ P,TPPBF   ;OTHERWISE OUTPUT THE BUFFER,
10744 TFEED1: .FEED UTYOC,    ;FEED A LINE,
10745         TLZA FF,FLPTPF  ;IF THIS IS EXECUTED, UTYOC DOESN'T HAVE PTP AFTER ALL
10746         SOJG B,TFEED1   ;FEED THE SPECIFIED NUMBER OF LINES,
10747         POPJ P,         ;AND RETURN
10748
10749 TSRETN:
10750 IFN PURESW,[
10751         SKIPGE PURIFG   ;IF NOT YET PURIFIED, ASSUME BEING DEBUGGED.
10752          .VALUE
10753 ]
10754         .LOGOUT ;COME HERE TO COMMIT SUICIDE.
10755         .BREAK 16,160000
10756
10757 A.SITE: CALL AGETFD     ;.SITE N, RETURNS NTH WORD OF SIXBIT MACHINE NAME.
10758         CAIE A,0        ;ON ITS, ONLY WORD 0 IS NONZERO. IT'S THE "MACHINE NAME".
10759          JRST CABPOP
10760         SYSCAL SSTATU,[MOVEM A ? MOVEM A ? MOVEM A ? MOVEM A ? MOVEM A ? MOVEM A]
10761          .LOSE 1000
10762         JRST CLBPOP
10763 ] ;END IFN ITSSW
10764 \f
10765 OINITL: IFN ITSSW,[
10766         HLLZ A,@(P)     ;GET CHNL NUM,
10767         TLZ A,777037    ;MASK TO JUST AC FIELD (CHNL NUM)
10768         IOR A,[.STATUS A]
10769         XCT A           ;READ ITS STATUS,
10770 ]
10771         PUSHJ P,OPNER   ;TYPE OUT REASON FOR OPEN FAILURE,
10772         TYPR OINITS
10773         PUSHJ P,GTYIP   ;GET TYPEIN
10774         HRLZ A,@(P)     ;REPLACE '_MIDAS' WHATEVER BY ACTUAL NAMES.
10775         PUSHJ P,A.IMP1
10776         PUSHJ P,RFD     ;GET NEW FILE DESCRIPTION
10777         HRRZ A,@(P)     ;GET NAME BLOCK ADDR,
10778         MOVEI B,3(A)
10779         HRLI A,DNAM     ;COPY NAMES JUST READ INTO IT.
10780         BLT A,(B)
10781         JRST OINIT
10782
10783 OINITS: ASCIZ/Use what filename instead? /
10784
10785 IFN DECSW,[
10786 OINIT:  MOVE AA,(P)
10787         MOVS A,(AA)     ;GET NAME-BLOCK ADDR IN LH,
10788         HRLZ TT,A       ;GET CHNL NUM IN LH.
10789         TLZ TT,#(0 17,) ;MASK TO AC FIELD (CHANNEL NUM)
10790         HRRI A,DNAM
10791         BLT A,SNAM      ;COPY NAMES INTO DNAM THRU SNAM.
10792         HRRZ D,2(AA)    ;GET BUFFER SPACE ADDR.
10793         HLLZ C,2(AA)    ;GET HEADER ADDR.
10794         HLRZ A,C
10795         SETZM (A)       ;CLEAR OUT ITS-VERSION CONTENTS OF 1ST HEADER WD.
10796         LDB A,[331100,,(AA)]    ;GET MODE TO OPEN IN (WILL BE ASCII OR IMAGE BINARY)
10797         CALL OPNRD2     ;DO OPEN.
10798          JRST OINITL
10799 IFE SAILSW,[SAVE .JBFF
10800         MOVEM D,.JBFF]
10801 .ELSE [SAVE JOBFF
10802         MOVEM D,JOBFF]
10803         XOR TT,[<OPEN A>#<OUTBUF 1>]
10804         XCT TT
10805 IFE SAILSW,REST .JBFF
10806 .ELSE REST JOBFF
10807         MOVE A,[SIXBIT /000MD /]
10808         PJOB B,         ;GET JOB NUMBER, TO MAKE SIXBIT /<NNN>MD<E, O, OR L>/
10809          JFCL           ;CAN IT SKIP?
10810         IDIVI B,10.
10811         DPB C,[220400,,A]
10812         IDIVI B,10.
10813         DPB C,[300400,,A]       ;PUT THE DIGITS OF THE JOB NUMBER INTO THE SIXBIT WORD.
10814         DPB B,[360400,,A]
10815         MOVE AA,(P)
10816         LDB B,[360600,,1(AA)]   ;GET 1ST CHAR OF 'OUTPUT, 'LSTOUT, 'CRFOUT, 'ERROUT.
10817         IOR A,B                 ;USE IT AS LAST CHAR OF TEMP FILE NAME.
10818         MOVSI B,'TMP
10819         SETZ C,
10820         MOVE D,SNAM
10821         XOR TT,[<OUTBUF 1>#<ENTER A>]
10822         XCT TT          ;DO ENTER UTYOC,A
10823          JRST OINITL
10824 POPJ3:  AOS (P)
10825 POPJ2:  AOS (P)
10826         JRST POPJ1
10827 \f
10828 ;CLOSE AN OUTPUT FILE, SEE NON-DEC VERSION FOR ARGS.
10829 OCLOSE: MOVE AA,1(A)    ;NAME BLOCK ADDR.
10830         SKIPGE FATAL
10831          JRST OCLOS2
10832         MOVE C,(AA)     ;DELETE ANY FILE WITH NAMES
10833         SETZB B,D       ;WE WANT TO RENAME TO.
10834         OPEN ERRC,B
10835          JRST OCLOS1
10836         MOVE B,1(AA)
10837         HLLZ C,2(AA)
10838         SETZ D,
10839         MOVE T,3(AA)
10840         LOOKUP ERRC,B
10841          JRST OCLOS1    ;THERE IS NONE, JUST RENAME.
10842         SETZ B,
10843         MOVE T,3(AA)
10844         RENAME ERRC,B
10845          JFCL
10846         RELEAS ERRC,
10847 OCLOS1: MOVE B,1(AA)    ;DESIRED FN1.
10848         HLLZ C,2(AA)    ;DESIRED FN2.
10849         SETZ D,
10850         MOVE T,3(AA)    ;SNAME (THAT IS, PPN)
10851         HLLZ AA,(A)     ;GET JUST CHNL NUM.
10852         IOR AA,[CLOSE]
10853         XCT AA
10854         XOR AA,[CLOSE#<RENAME B>]
10855         XCT AA
10856          JFCL
10857 OCLOS2: HLLZ B,(A)      ;GET CHNL IN AC FIELD.
10858         IOR B,[RELEAS]
10859         XCT B
10860         JRST 2(A)
10861
10862 ;WRITE OUT BUFFER OF OUTPUT FILE, C HAS <0 CHNL,HEADER>
10863 OBUFO:  AND C,[0 17,]   ;GET JUST CHNL NUM.
10864         TLO C,(OUT)
10865         XCT C
10866          RET
10867         SAVE A          ;ERROR RETURN FROM OUT UUO.
10868         XOR C,[OUT#<GETSTS A>]
10869         XCT C           ;READ FILE STATUS.
10870         TRZ A,74^4      ;CLEAR ERROR BITS.
10871         ETR [ASCIZ /Output data error/]
10872         XOR C,[<GETSTS A>#<SETSTS (A)>]
10873         XCT C
10874         JRST POPAJ
10875 \f
10876 TFEED:  RET
10877
10878 TSRETN: MOVE C,[SIXBIT /MIDAS/]
10879         SKIPE MORJCL
10880          JRST RFDRUN
10881         EXIT
10882
10883 A.SITE:
10884 IFE SAILSW,[
10885         CALL AGETFD     ;.SITE ON DEC SYSTEM; VALUE HAS BEEN PRECOMPUTED NTO V.SITE.
10886         CAIL A,
10887          CAIL A,5
10888           JRST CABPOP
10889         MOVE A,V.SITE(A)
10890         JRST CLBPOP
10891 ];END IFE SAILSW
10892 .ELSE   JRST CABPOP     ;SAIL DOESN'T HAVE GETTAB USED IN SETTING UP V.SITE.
10893
10894 ;DEVICE NAME IN B, MODE IN A,
10895 ;HEADER ADDR IN C, BUFFER SPACE ADDR IN D,
10896 ;CREAT DEC-STYLE BUFFER RING LEAVING 1 WD BETWEEN BUFFERS.
10897 BUFINI: MOVEI AA,A
10898 IFE SAILSW,DEVSIZ AA,
10899          SKIPA AA,[204] ;DEFAULT BUFFER SIZE IS THAT FOR DSK.
10900         AOJLE AA,.-1    ;GET SIZE INCLUDING EXTRA WD.
10901         MOVEI T,1(D)    ;ADDR OF WD 2 OF 1ST BUFFER.
10902         HRLI AA,T       ;@AA IS ADDR OF 2ND WD OF NEXT BUFFER.
10903         SUBI D,(AA)     ;FACILITATE TEST FOR END OF BUFFER SPACE.
10904         HRLI T,400000
10905         MOVEM T,(C)     ;HEADER -> A BUFFER, SIGN SET.
10906         HRRM T,1(C)     ;MAKE RH OF BP -> BUFFER 1ST WD.
10907         MOVSI T,440000  ;SET UP P-FIELD OF B.P.
10908         IORM T,1(C)
10909         HRRZ T,1(C)
10910         AOS 1(C)
10911         HRLI T,-3(AA)   ;DATA-AREA-SIZE +1,,ADDR-OF-2ND-WD
10912 BUFIN1: CAIGE D,-410(T) ;ROOM FOR ANOTHER AFTER THIS BUFFER?
10913          JRST BUFIN2    ;NO, ASSUMING 410 WDS BUFFERRrSPACE.
10914         MOVEM T,@AA     ;YES, MAKE NEXT BUFFER -> THIS ONE,
10915         HRRI T,@AA      ;POINT TO NEXT ONE.
10916         JRST BUFIN1
10917
10918 BUFIN2: ADDI D,1(AA)    ;-> 2ND WD OF 1ST BUFFER.
10919         MOVEM T,(D)     ;1ST BUFFER -> LAST, MAKING RING.
10920         RET
10921
10922 ;CLOSE ALL INPUT CHANNELS - EQUIVALENT TO ITS .IOPDL.
10923 $IOPDL: MOVEI A,UTYIC
10924         EXCH A,UTICHN   ;SET INPUT CHNL NUM. TO LOWEST.
10925         LSH A,27
10926         IOR A,[RELEAS]  ;SET UP TO RELEAS THE HIGHEST IN USE FIRST.
10927 IOPDL1: XCT A           ;RELEAS ONE INPUT CHANNEL,
10928         CAMN A,[RELEAS UTYIC,]
10929          RET            ;ALL DONE.
10930         SUB A,[0 1,]
10931         JRST IOPDL1     ;RELEAS THE NEXT ONE DOWN.
10932
10933 .IOPDL==CALL $IOPDL
10934 ] ;END IFNN DECSW,
10935 \f
10936                 ;TS INPUT ROUTINES
10937
10938                 ;OPEN MAIN INPUT FILE FOR READING
10939
10940 OPNRD:  .IOPDL          ;RE-INITIALIZE IO PDL
10941         INSIRP SETZM,INFCNT INFCUR INFERR
10942         MOVE A,[-TYPDLS-1,,TTYPDL]
10943         MOVEM A,ITTYP   ;INITIALIZE "TTY PDL"
10944         PUSHJ P,MACIN1  ;CLOBBER MACRO EXPANSION STATUS
10945         MOVS A,IFDS     ;GET DEVICE NAME
10946         CAIN A,(SIXBIT /TTY/)   ;TTY?
10947         JRST OPNRDT     ;YES, TREAT SPECIAL
10948         MOVSI A,IFDS    ;NOT TTY, TRY OPENING FILE
10949         PUSHJ P,A.IMP1  ;SET UP DNAM, ETC.
10950         PUSHJ P,OPNRD1  ;TRY OPENING FILE
10951         JRST OPNRDL     ;LOSE
10952         MOVEM A,INFERR  ;ERR MSG IN MAIN FILE SHOULDN'T TYPE NAMES.
10953         MOVEI A,0       ;=> INPUT FROM FILE
10954 OPNRT2: MOVE T,[IFNM1,,RFNAM1]
10955         BLT T,RFNAM2    ;SET UP .FNAM1, .FNAM2
10956         SETOM NEDCRL
10957         JRST RCHSET     ;SET UP TO READ FROM FILE OR TTY. (ARG IN A)
10958
10959 OPNRDT: MOVE A,[IFDS+1,,IFNM1]  ;TTY SPECIFIED, TREAT SPECIAL
10960         BLT A,IFNM2     ;CLOBBER .IFNM1, .IFNM2 TO SPECIFIED
10961         TYPR [ASCIZ /Reading from TTY:
10962 /]
10963         MOVEI A,3       ;=> INPUT FROM TTY, DON'T QUIT ON CR
10964         JRST OPNRT2
10965
10966 OPNRDL: PUSHJ P,IOPNER  ;.OPEN LOST, TYPE OUT MESSAGE
10967         JRST GO2A       ;READ NEW COMMAND
10968
10969
10970 ;COMMON STUFF FOR OPNRD1 IN DEC AND ITS VERSIONS.
10971 OPNRD3: HRRZM A,UTIBED  ;SAY BUFFER EMPTY,
10972         MOVSI A,^C_13
10973         MOVEM A,@UTIBED ;CAUSE IMMEDIATE RELOAD.
10974         MOVE A,[INFDEV+1,,IFNM1]
10975         BLT A,IFNM2     ;SET UP .IFNM1, .IFNM2.
10976         AOS A,INFCNT    ;ASSIGN THIS FILE A NUMBER.
10977         MOVEM A,INFCUR  ;OPNRD EXPECTS THIS LEFT IN A.
10978         JRST POPJ1
10979
10980                 ;EOF WHILE TRYING TO READ CHARACTER
10981
10982 RPAEOF: PUSH P,B        ;SAVE B
10983 RPAEO1: MOVE B,ITTYP    ;GET PDL POINTER
10984         PUSHJ P,BPOPJ   ;CALL POP ROUTINE (MAYBE NED'S OUT)
10985         JRST RCHTRB     ;RETURN TO GET CHARACTER
10986
10987                 ;EOF FROM MAIN FILE
10988
10989 NEDCHK: TRNE FF,FRCMND  ;^C READ IN COMMANND, :KILL SELF.
10990          JRST TSRETN
10991         SKIPE RCHMOD
10992          JRST NEDCH1
10993         AOSN NEDCRL     ;INVENT ONE CRLF AFTER END OF MAIN FILE.
10994          JRST [ MOVE B,[440700,,[.BYTE 7 ? ^M ? ^J ? ^C]]
10995                 MOVEM B,UREDP
10996                 RET]
10997 NEDCH1:
10998 IFN A1PSW,[     PUSHJ P,OUTCHK
10999         MOVSI A,-LNEDT
11000         XCT NEDT(A)     ;SKIPS IF NED CONDITION TO BE COMPLAINED ABOUT
11001         AOBJN A,.-1
11002         JUMPGE A,GO4
11003 ]
11004         ETF [ASCIZ /No END statement/]
11005
11006 IFN A1PSW,[     ;HOLLER "NED" IF ANY OF THE FOLLOWING:
11007 NEDT:   SKIPL PRGC      ;NO END STATEMENTS HAVE BEEN ENCOUNTERED
11008         SKIPGE OUTC     ;OUTPUT HAS OCCURED NOT MATCHED BY AN END STATEMENT
11009         SKIPGE OUTN1    ;OUTPUT HAS OCCURED OTHER THAN IN 1PASS MODE
11010         TRNN FF,FRPSS2  ;CURRENTLY IN PASS 2
11011 LNEDT==.-NEDT   ;LENGTH OF TABLE
11012 ]
11013 \f
11014 IFN ITSSW,[
11015                 ;TRY .OPENING INPUT FILE (DESCRIPTION IN DNAM, ETC.) SKIPS IF SUCCESSFUL
11016
11017 OPNRD1: MOVE A,[2,,UTYIC] ;MODE,,CHANNEL.
11018         .CALL OPENB
11019         JRST OPNRD2     ;CAN'T OPEN INPUT FILE.
11020         MOVE AA,[UTYIC,,A]
11021         .RCHST AA,
11022         SKIPN B         ;GET SYSTEM FILE NAME 1
11023         MOVE B,FNAM1    ;SYSTEM DOESN'T KNOW, USE SPEC'D.
11024         SKIPN C         ;NOW SAME FOR FN2.
11025         MOVE C,FNAM2
11026         MOVE AA,[A,,INFDEV]
11027         BLT AA,INFDEV+3 ;REMEMBER NAMES OF CURRENT INPUT FILE.
11028         HRLZS INFDEV    ;MAKE THE DEV NAME BE LEFT-JUST.
11029         MOVE A,IUREDP   ;SET UP READING PTR,
11030         MOVEM A,UREDP
11031         JRST OPNRD3     ;SET UP ^C AFTER BUFFER, INFCUR, ETC.
11032
11033 OPNRD2: .STATUS UTYIC,IFSTS     ;.OPEN LOST, GET CHANNEL STATUS NOW BEFORE POSSIBLE .IOPOP
11034         POPJ P,
11035
11036 OPENB:  SETZ ? SIXBIT/OPEN/
11037         A               ;SHOULD HOLD MODE,,CHANNEL.
11038         DNAM ? DNAM+1 ? DNAM+2 ? SETZ SNAM
11039
11040 IUREDP: 440700,,UTIBUF
11041
11042                 ;EOFCH ENCOUNTERED ON READ, RELOAD AND JUMP BACK FOR NEXT CHAR
11043
11044 INCHR3: HRRZ A,UREDP    ;GET BYTE POINTER
11045         CAME A,UTIBED   ;END OF COMPLETELY READ BLOCK?
11046         JRST RPAEOF     ;NO => REALLY EOF
11047         MOVE A,IUREDP
11048         MOVEM A,UREDP
11049         MOVE A,[-UTIBFL,,UTIBUF]
11050         .IOT UTYIC,A    ;READ IN BLOCK
11051         TLZ A,377777    ;CLEAR OUT @, INDEX FIELDS, ALSO ALL BUT SIGN JUST FOR LAUGHS
11052         MOVEM A,UTIBED  ;STORE RH (UPDATED POINTER) FOR EOF CHECK AT INCHR3
11053         MOVSI A,EOFCH_<18.-7>
11054         MOVEM A,@UTIBED ;STORE EOF WORD
11055         JRST RCHTRA     ;NOW TRY NEXT CHAR
11056 ] ;END IFN ITSSW
11057 \f
11058 IFN DECSW,[
11059 OPNRD1: MOVEI C,UTIHDR  ;OPEN THE INPUT FILE W/ NAMES IN DNAM ... SNAM.
11060         SETZ A,         ;MODE ASCII.
11061         MOVEI D,UTIBUF
11062         MOVE TT,UTICHN  ;GET CHANNEL NUM. TO USE.
11063         LSH TT,27       ;PUT IN AC FIELD.
11064         CALL OPNRD2     ;DO OPEN.
11065          RET            ;FAILED.
11066         CALL BUFINI     ;INITIALIZE THE INPUT BUFFERS AND HEADER.
11067         MOVE D,SNAM
11068         MOVE A,FNAM1
11069         HLLZ B,FNAM2
11070         TLC TT,(OPEN#LOOKUP)
11071         XCT TT          ;LOOKUP CHANNEL,A
11072          RET            ;FAILED.
11073 IFE SAILSW,[
11074         MOVE A,DNAM
11075         DEVNAM A,       ;GET REAL NAME OF DEVICE.
11076          CAIA
11077         MOVEM A,DNAM
11078 ]
11079         MOVE A,[DNAM,,INFDEV]
11080         BLT A,INFDEV+3
11081         MOVE A,UREDP
11082         JRST OPNRD3
11083
11084 ;TAKE C -> HEADER, D -> BUFFER SPACE, A HAS MODE, TT HAS CHNL IN AC FLD.
11085 ;OPEN FILE IN DNAM ... SNAM, INIT BUFFERS,
11086 ;THEN SET UP FOR LOOKUP OR ENTER.
11087 ;SKIP IF SUCCEED.
11088 OPNRD2: IOR TT,[OPEN A]
11089         MOVE B,DNAM
11090         XCT TT          ;OPEN CHANNEL,A
11091          RET
11092         JRST POPJ1
11093
11094 ;RELOAD BUFFER, DEC STYLE.
11095 INCHR3: HRRZ A,UREDP    ;EOF AT END OF BUFFER?
11096         CAME A,UTIBED
11097          JRST RPAEOF    ;NO, EOF, ^C IN FILE.
11098         SAVE B
11099         MOVE A,UTICHN
11100         LSH A,27        ;CHANNEL NUM. N AC FLD.
11101         TLO A,(IN)
11102         XCT A           ;GET NEXT BUFFERFULL.
11103          CAIA           ;SUCCEED.
11104         JRST INCHR4     ;ERROR.
11105 INCHR5: MOVE A,UTICNT
11106         ADDI A,9
11107         IDIVI A,5
11108         ADD A,UREDP     ;-> 1ST WD NOT READ INTO.
11109         HRRZM A,UTIBED
11110         HRRZ A,UREDP
11111         AOS A
11112         MOVEI B,1       ;SCAN THE FILE AND REPLACE ALL LINE NUMBERS WITH NULLS.
11113 INCHR6: CAMN A,UTIBED
11114          JRST INCHR7
11115         TDNE B,(A)
11116          MOVEM B,(A)
11117         AOJA A,INCHR6
11118
11119 INCHR7: MOVSI B,^C_13
11120         MOVEM B,(A)     ;PUT EOF CHAR AFTER BUFFER.
11121         JRST RCHTRB     ;RETRY RCH.
11122
11123 INCHR4: XOR A,[<GETSTS B>#IN]
11124         XCT A
11125         TRZE B,74^4
11126          ETR [ASCIZ /Input data error/]
11127         XOR A,[<GETSTS B>#<SETSTS (B)>]
11128         XCT A           ;CLEAR ERROR BITS IN STATUS.
11129         TRNN B,2^4
11130          JRST INCHR5
11131         JRST RPAEO1     ;EOF.
11132 ] ;END IFN DECSW,
11133 \f
11134                 ;IO PDL ROUTINES FOR INPUT FILE
11135                 ;PUSH THE INPUT FILE
11136
11137 IPUSH:  AOSN CMEOF      ;WANT TO POP OUT OF TTY? (^C  TYPED IN)
11138          CALL POPTT     ;YES, DO NOW BEFORE FORGET.
11139         MOVE D,UREDP    ;GET INPUT BYTE POINTER
11140 IFN ITSSW,[
11141         .IOPUS UTYIC,
11142         TLNN D,760000   ;AT END OF WORD?
11143         ADD D,[430000,,1]       ;YES, MAKE IT POINT TO BEGINNING OF NEXT WORD
11144         MOVEM D,UREDP
11145         MOVNI A,-2(D)
11146         ADD A,UTIBED    ;GET # WDS WE'LL NEED IN MACTAB.
11147         HLR D,UTIBED    ;REMEMBER WHETHER EOF ON LAST .IOT.
11148         HRRZS UTIBED    ;NOW CLEAR OUT LEFT HALF FOR FOLLOWING
11149 ]
11150 IFN DECSW,[
11151         AOS A,UTICHN    ;DO ".IOPUSH" - USE NEXT CHANNEL.
11152         LSH A,27
11153         ADD A,[WAIT-<0 1,>]
11154         XCT A           ;DON'T MOVE BUFFERS WHILE IO GOING ON!
11155         MOVEI A,UTIBFL+2 ;ASSUME MUST SAVE ALL BUFFER SPACE.
11156 ]
11157         SAVE A
11158         ADD A,FREPTB
11159         ANDI A,-1
11160         CAML A,MACTND   ;NO ROOM IN MACTAB => GC IT.
11161          CALL GCA1
11162         MOVEI A,370
11163         CALL PUTREL     ;INDICATE START OF SAVED BUFFER.
11164         REST A
11165         AOS B,FREPTB
11166         SUBI A,1
11167         MOVE C,ITTYP    ;GET ADDR OF TTY PDL WD THAT'LL POINT TO SAVED BUFFER.
11168         ADDI C,1
11169         HRRZM C,(B)     ;STORE IN RH OF 1ST WD,
11170         MOVEI C,(B)     ;REMEMBER ADDR OF SAVED BUFFER TO PUSH ON TTYPDL.
11171         HRLM A,(B)      ;PUT LENGTH IN LH.
11172         AOS B
11173 IFN ITSSW,HRL B,UREDP   ;ILH _ ADDR OF 1ST WD TO SAVE.
11174 IFN DECSW,HRLI B,UTIBUF
11175         ADDI A,-2(B)    ;ADDR OF LAST WD TO BLT INTO.
11176         BLT B,(A)
11177         HRLI A,041000
11178         MOVEM A,FREPTB  ;MAKE FREE BP -> LAST BYTE JUST USED.
11179         SUB A,MACTAD
11180         ANDI A,-1
11181         LSH A,2
11182         ADDI A,4        ;GET CHAR ADDR OF NEXT FREE BYTE.
11183         MOVEM A,FREEPT
11184         MOVE B,ITTYP    ;GET LOCAL VERSION OF IOPDL
11185 IPSHP:  PUSH B,C        ;PUSH -> SAVED BUFFER (GC WILL RELOCATE)
11186 IFN DECSW,PUSH B,UTIBED
11187 IFN DECSW,PUSH B,UTIHDR
11188 REPEAT 4,PUSH B,INFDEV+.RPCNT   ;SAVE NAMES OF INPUT FILE.
11189         PUSH B,INFCUR   ;SAVE NUMBER OF INPUT FILE.
11190         PUSH B,D        ;LH=LH(OLD UREDP), RH=LH(OLD UTIBED)
11191                 ;FOLLOWING TWO MUST BE LAST PUSHED
11192         INSIRP PUSH B,[IFNM1 IFNM2]     ;CLOBBERED ON PDL IF .OPEN SUCCESSFUL
11193 INPDEL==.-IPSHP         ;LENGTH OF EACH ENTRY ON PDL
11194         MOVE A,FREEPT   ;W MUST USE SAME GC CONVENTION AS PUTREL;
11195         CAML A,MACHI    ;NAMELY, GC AFTER USING UP THE LAST BYTE.
11196          CALL GCA1
11197         MOVEI A,0       ;=> INPUT FROM FILE
11198         MOVEM B,ITTYP   ;STORE BACK UPDATED POINTER
11199         JSP B,PUSHTT    ;SAVE STUFF, ADDRESS MODIFY AND RETURN
11200                 ;POP INTO THE INPUT FILE
11201 IPOP:
11202 IFN CREFSW,[ MOVEI A,2  ;IF CREFFING, OUTPUT POP-FILE BLOCK.
11203         SKIPE CRFONP
11204          PUSHJ P,CRFOUT]
11205 IPOPL:  PUSHJ P,POPTT   ;COME HERE IF .INSRT'S OPEN FAILED.
11206         SAVE C
11207         MOVE B,ITTYP    ;GET POINTER
11208         INSIRP POP B,[IFNM2 IFNM1 A]    ;POP STUFF
11209         POP B,INFCUR
11210 REPEAT 4,POP B,INFDEV+3-.RPCNT
11211 IFN DECSW,[
11212         POP B,C
11213         SAVE C          ;OLD UTIHDR
11214         POP B,UTIBED
11215 ]
11216         POP B,C
11217         MOVEM B,ITTYP   ;SAVED UPDATED PDL POINTERR.
11218         HLRZ B,(C)      ;GET LENGTH OF SAVED BUFFER,
11219 IFN ITSSW,[
11220         SAVE A
11221         CALL SETWH2
11222         REST A
11223         .IOPOP UTYIC,
11224         MOVEI AA,UTIBUF-1(B)    ;GET ADDR OF 1ST WD WON'T BLT INTO IN UTIBUF,
11225         HRLI AA,(A)     ;GET SAVED LH OF UTIBED,
11226         MOVEM AA,UTIBED
11227         HRRI A,UTIBUF   ;MAKE A -> 1ST WD IN BUFFER,
11228 ]
11229 IFN DECSW,[
11230         MOVE AA,UTICHN
11231         LSH AA,27
11232         IOR AA,[RELEAS]
11233         XCT AA          ;THIS CODE EQUIVALENT TO .IOPOP.
11234         SOS UTICHN
11235         REST UTIHDR
11236 ]
11237         MOVEM A,UREDP
11238         MOVSI A,^C_13
11239         MOVEM A,@UTIBED ;PUT EOF CHAR AFTER BUFFER.
11240         MOVSI A,1(C)    ;GET ADDR OF 1ST DATA WD OF SAVED BUFFER,
11241         HRRI A,UTIBUF
11242         CAIE B,1
11243          BLT A,UTIBUF-2(B)
11244         HLLZS (C)       ;TELL GC TO RECLAIM SAVED BUFFER.
11245 POPCJ:  REST C
11246         RET
11247 \f
11248                 ;SAVE INTERNAL POINTERS CONCERNING INPUT MODE
11249
11250 TYPDEL==2               ;NUMBER OF WORDS IN RELEVANT PDL ENTRY
11251
11252 PUSHTT: PUSH P,A
11253         PUSH P,F
11254         AOSN CMEOF      ;IF SUPPOSED TO POP OUT OF TTY SOON,
11255          CALL POPTT     ;DO IT NOW BEFORE CMEOF CLOBBERED.
11256         MOVE F,ITTYP    ;GET RELEVANT PDL POINTER
11257         MOVEI A,0
11258         EXCH A,CLNN     ;SET UP NEW LINE NUMBER
11259         HRL A,CPGN      ;SAVE CURRENT PAGE NUMBER
11260         SETZM CPGN      ;NOW RE-INITIALIZE
11261         SKIPGE CRFILE   ;SAVE CREF-ALL-ON-ONE-LINE FLAG.
11262         TLO A,400000
11263         PUSH F,A        ;SAVE CPGN,,CLNN
11264         MOVE A,-1(P)    ;RETRIEVE NEW MODE
11265         PUSHJ P,PSHLMB  ;SAVE LIMBO1 AND SET UP INSTRUCTIONS FOR NEW MODE
11266 IFN ITSSW,[
11267         CALL SETWH2
11268         .SUSET [.SWHO3,,A]
11269 ]
11270         MOVEM F,ITTYP   ;STORE BACK UPDATED POINTER
11271         JRST POPFAJ
11272
11273                 ;RESTORE INTERNAL POINTERS CONCERNING INPUT MODE
11274
11275 POPTT:  PUSH P,A
11276         PUSH P,F
11277         MOVE F,ITTYP    ;GET PDL POINTER
11278         PUSHJ P,POPLMB  ;POP INTO LIMBO1, SET UP NEW MODE
11279         POP F,A         ;GET CPGN,,CLNN
11280         SETZM CRFILE    ;RESTORE ALL-ON-ONE-LINE FLAG.
11281         TLZE A,400000
11282          SETOM CRFILE
11283         HLRZM A,CPGN
11284         HRRZM A,CLNN
11285 IFN ITSSW,[
11286         CALL SETWH2
11287         ADD A,CPGN
11288         .SUSET [.SWHO3,,A]
11289 ]
11290         MOVEM F,ITTYP   ;STORE BACK UPDATED POINTER
11291         JRST POPFAJ
11292
11293 IFN ITSSW,[
11294 SETWH2: MOVE A,RCHMOD
11295         CAIL A,2
11296          SKIPA A,[SIXBIT /TTY:/]
11297           MOVE A,INFFN1
11298         .SUSET [.SWHO2,,A]
11299         MOVE A,A.PASS
11300         LSH A,30
11301         ADD A,[SIXBIT /P0/+1]
11302         RET
11303 ]
11304 \f
11305                 ;TTY ROUTINES
11306
11307                 ;CAUSE INPUT FROM TTY (MAIN ROUTINES)
11308
11309 GTYIPA:         ;PUSH TO TTY, DON'T STO@ AT CR.
11310         SETZM A.TTYF
11311 IFN ITSSW,[     TYPR [ASCIZ/TTY: .INSRTed, end input with ^C
11312 /]      ]
11313 .ELSE [ IFE SAILSW,[ TYPR [ASCIZ/TTY: .INSRTed, end input with ^Z
11314 /]      ]
11315         .ELSE [ TYPR [ASCIZ /TTY: .INSRTed, end input with CTL-META-LF
11316 /] ]]
11317 GTYIP1: SKIPA A,[3]
11318 GTYIP:   MOVEI A,2      ;INPUT FROM TTY, STOP AFTER 1 LINE.
11319         SETZM CMPTR     ;FORCE RELOAD ON 1ST READ.
11320         JSP B,PUSHTT    ;SET UP VARIABLES AND RETURN
11321 GTYIPR: SETZM CMPTR     ;RETURN ON .INEOF OR CR
11322         JRST POPTT
11323
11324 ;CALL HERE FROM ASSEM1 LOOP WHEN A ^H INTERRUPT IS DETECTED.
11325 TTYBRK: SETZM A.TTYF
11326         ETR [ASCIZ/^H - break /]        ;TYPE FILENAME, PAGE AND LINE #.
11327         SKIPE ASMOUT
11328          TYPR [ASCIZ/within a <>, () or []
11329 /]
11330         JRST GTYIPA
11331
11332                 ;RCHSET ROUTINES FOR READING FROM TTY
11333                 ;RCHMOD=3 => DON'T QUIT ON CR
11334                 ;2 => QUIT ON CR.
11335
11336 RCHTRC:
11337 RCHARC: TLO FF,FLTTY    ;SET FLAG
11338         JSP A,CPOPJ
11339 RCHAC1: REPEAT 2,[      ;RCH2, RR1
11340         ILDB A,CMPTR    ;GET CHAR
11341         CAIN A,0        ;END OF STRING MARKED WITH 0
11342         PUSHJ P,TYRLDR  ;RELOAD, JUMP BACK FOR NEXT CHAR
11343 ]
11344         HALT    ;RRL1
11345 IFN .-RCHAC1-RCHPSN,.ERR RCHAC1 LOSES.
11346         ILDB A,CMPTR    ;SEMIC
11347         CAIN A,15
11348         JRST SEMICR
11349         JUMPN A,SEMIC
11350         PUSHJ P,TYRLD
11351         JRST SEMIC
11352 \f
11353 TYRLD:  MOVEI A,3       ;RETURN AFTER THE CALL, NOT BEFORE.
11354         ADDM A,(P)
11355
11356                 ;READ IN STRING
11357
11358 ;RELOAD BUFFER IF RAN OUT IN CALL TO RCH.
11359 TYRLDR: AOSN CMEOF      ;EOF DETECTED AFTER LAST RELOAD =>
11360          JRST RPAEOF    ;POP OUT OF TTY.
11361         SAVE A
11362         SAVE B
11363         MOVE B,RCHMOD
11364         PUSH P,F
11365         SAVE A.TTYF     ;IF CHARS RUBBED OUT THEY SHOULD BE PRINTED.
11366         SETZM A.TTYF
11367         MOVE F,[10700,,CMBUF-1] ;INITIAL BYTE POINTER TO BUFFER
11368         MOVEM F,CMPTR   ;STORE AS BYTE POINTER FOR READ
11369 TYRLD2: PUSHJ P,TYI     ;GET CHARACTER
11370         CAIN A,177      ;RUBOUT?
11371         JRST TYRLD3     ;YES
11372         CAIE A,^C
11373         CAIN A,^Z
11374          JRST TYRLD7    ;^C, ^Z => EOF.
11375         CAIN A,^U
11376         JRST TYRLD5     ;RUB OUT ALL
11377         CAIE B,2        ;FOR .TTYMAC HANDLING, CONVERT LOWER CASE TO UPPER.
11378          JRST TYRLD6
11379         CAIL A,"A+40
11380          CAILE A,"Z+40
11381           CAIA
11382            SUBI A,40
11383 TYRLD6: IDPB A,F        ;STORE CHARACTER IN BUFFER
11384         CAIE A,^M       ;CR?
11385         JRST TYRLD2     ;NO, GO BACK FOR NEXT
11386         CAIN B,2        ;.TTYMAC (MODE 2) => CR ENDS INPUT, SO FAKE EOF.
11387          SETOM CMEOF
11388         MOVEI A,^J      ;FOLLOW THE CR WITH A LF.
11389         IDPB A,F
11390         SAVE F          ;OUTPUT THE ENTIRE LINE TO THE ERROR FILE
11391         MOVE F,[10700,,CMBUF-1]
11392 TYRLD8: CAMN F,(P)
11393          JRST TYRLD9
11394         ILDB A,F
11395         CAIN A,^M       ;IF LINE WAS ENDED BY A ^C OR ^Z, PUT THAT IN ERROR
11396          SKIPL CMEOF    ;FILE, WHICH NEEDS HAIR SINCE THAT CHAR IS NOT
11397           JRST TYRLD0   ;IN THE STRING WE STORED.
11398         MOVEI A,"^
11399         CALL ERRCHR
11400         MOVEI A,IFN DECSW,["Z] .ELSE "C
11401         CALL ERRCHR
11402         LDB A,F
11403 TYRLD0: CALL ERRCHR
11404         JRST TYRLD8
11405
11406 TYRLD9: REST F
11407         MOVEI A,0
11408         IDPB A,F        ;MARK END OF STRING
11409         IDPB A,F
11410         REST A.TTYF
11411         REST F
11412         REST B
11413         REST A
11414         JRST RCHTRA
11415
11416 TYRLD7: SETOM CMEOF     ;^C, ^Z FORCE EOF,
11417         CALL TYRLCR     ;AFTER TURNING INTO ^M.
11418         MOVEI A,^M
11419         JRST TYRLD6
11420
11421 TYRLCR: MOVEI A,^M
11422         CALL TYOX
11423         MOVEI A,^J
11424         JRST TYOX
11425
11426 TYRLD3: CAMN F,[10700,,CMBUF-1] ;RUBOUT, BEGINNING OF BUFFER?
11427         JRST TYRLD4     ;YES
11428         LDB A,F         ;GET LAST CHARACTER IN BUFFER
11429         CALL TYOX       ;TYPE IT OUT, DON'T WRITE IN ERROR FILE.
11430         ADD F,[70000,,] ;DECREMENT POINTER
11431         JUMPGE F,TYRLD2 ;JUMP IF VALID
11432         SUB F,[430000,,1]       ;WAS 440700,,SOMETHING, BACK IT UP
11433         JRST TYRLD2
11434
11435 TYRLD5: MOVE F,[10700,,CMBUF-1] ;^U, BACK TO BEGINNING OF LINE
11436 TYRLD4: PUSHJ P,TYRLCR  ;RUBOUT WHEN AT BEGINNING OF BUFFER, TYPE CR
11437         JRST TYRLD2
11438 \f
11439 IFN ITSSW,[     ;GET (JUST TYPED IN) CHAR IN A
11440 OUTCHR==.IOT TYOC,
11441
11442 TYI:    SKIPN TTYOP
11443          CALL TTYINI    ;OPEN THE TTY IF NOT ALREADY DONE.
11444         .IOT TYIC,A
11445         JUMPE A,TYI
11446         CAIN A,^L
11447          JRST TYI
11448         POPJ P,
11449
11450                 ;INITIALIZE TTY
11451
11452 TTYINI: SAVE A
11453         .OPEN TYIC,[SIXBIT /   TTYMIDAS TYI/]   ;INPUT, CONVERT LOWER CASE TO UPPER
11454          .LOSE
11455         .OPEN TYOC,[21,,SIXBIT /   TTYMIDAS TYO/]       ;DISPLAY MODE OUTPUT
11456          .LOSE
11457         SYSCAL CNSGET,[1000,,TYOC ? 2000,,A ? 2000,,A]
11458          MOVSI A,1      ;TTY: IS TRANSLATED TO SOMETHING ELSE => ASSUME INFINITE LINEL
11459         MOVEM A,LINEL   ;ELSE LINEL GETS WIDTH OF TTY.
11460         SETOM TTYOP     ;SAY THE TTY IS NOW OPEN.
11461         JRST POPAJ
11462
11463 JCLINI: .SUSET [.ROPTIO,,A]
11464         TLNN A,40000            ;HAS OUR SUPERIUOR SAID IT HAS A CMD?
11465          RET                    ;NO.
11466         MOVE A,[CMBUF,,CMBUF+1]
11467         BLT A,CMBUF+CMBFL-2     ;ZERO ALL BUT LAST WD,
11468         MOVEM A,CMBUF+CMBFL-1   ;NONZERO LAST WD.
11469         .BREAK 12,[5,,CMBUF]    ;TRY TO READ COMMAND STRING.
11470         MOVE A,[440700,,CMBUF]
11471         SKIPE CMBUF     ;IF READ A CMD-STRING,
11472          MOVEM A,CMPTR  ;TELL TYRLD, GO2 IT'S THERE.
11473         POPJ P,
11474
11475 ;JRST HERE FROM TSINT FOR 2ND WD INTERRUPTS.
11476 TTYINT: SAVE A
11477         MOVEI A,TYIC    ;THE TTY CHNL IS THE ONLY ONE ENABLED.
11478         .ITYIC A,
11479          JRST TTYINX    ;NO INT. CHAR.
11480         CAIN A,^W
11481          AOS A,TTYFLG   ;^W SILENCES,
11482         CAIN A,^V
11483          SOS A,TTYFLG   ;^V UNSILENCES,
11484         CAIN A,^H
11485          SETOM TTYBRF   ;^H SAYS BREAK NEXT TIME THRU ASSEM1 LOOP.
11486 TTYINX: REST A
11487         .DISMIS .JBTPC
11488 ]       ;END IFN ITSSW
11489 \f
11490 IFN DECSW,[
11491 TYI:    SKIPN TTYOP     ;OPEN THE TTY, IF NOT ALREADY DONE.
11492          CALL TTYINI
11493         INCHWL A
11494 IFN SAILSW,[
11495         CAIN A,612      ;SAIL => EOF IS 612. SO TURN INTO NORMAL EOF.
11496          MOVEI A,^Z
11497 ]
11498         CAIE A,^M       ;THROW AWAY THE LF AFTER A CR
11499          RET
11500         INCHWL A
11501         MOVEI A,^M      ;NOTE THAT TYRLDR WILL PUT IT BACK IN.
11502         RET
11503
11504 TTYINI: OPEN TTYINB
11505          JRST TTYINI
11506         INSIRP PUSH P,AA A B
11507 IFE SAILSW,[
11508         PJOB A,
11509         TRMNO. A,
11510          JRST TTYIN1
11511         MOVEI AA,1012   ;.TOWID
11512         MOVE B,[2,,AA]
11513         TRMOP. B,               ;READ WIDTH OF TTY LINE INTO B.
11514 ]
11515 TTYIN1:  MOVEI B,80.            ;TRMOP. FAILED OR NOT TRIED => ASSUME WIDTH IS 80.
11516         MOVEM B,LINEL
11517         INSIRP POP P,B A AA
11518         SETOM TTYOP
11519         RET
11520
11521 TTYINB: 1
11522         'TTY,,
11523         0
11524
11525 TTYREN: IFE SAILSW,LOC .JBREN
11526 .ELSE LOC JOBREN
11527 TTYREN
11528 LOC TTYREN
11529         SETOM TTYBRF    ;"REENTER" COMMAND COMES HERE
11530 R: G:   IFE SAILSW,JRST @.JBOPC ;TO REQUEST A ^H-BREAK.
11531 .ELSE JRST @JOBOPC
11532 ]
11533
11534 TAB:    MOVEI A,^I
11535 TYO:    SKIPG A.TTYF
11536          CALL TYOX
11537 ERRCHR: IFN ERRSW,[
11538         SKIPN ERRFOP    ;OUTPUT CHAR IN A TO ERROR FILE IF ONE IS OPEN.
11539          RET
11540         SOSGE ERRCNT
11541          JRST ERRCH1    ;OUTPUT BUFFER.
11542         IDPB A,ERRPNT
11543         RET
11544
11545 ERRCH1: SAVE C
11546         MOVE C,[0 ERRFC,ERRHDR]
11547         CALL OBUFO
11548         REST C
11549         JRST ERRCHR
11550 ]IFE ERRSW,RET
11551
11552 TYOX:   SKIPN TTYOP
11553          CALL TTYINI
11554         OUTCHR A
11555         RET
11556 \f
11557 IFN DECSW,[
11558
11559 JCLINI: SKIPN CCLFLG            ; WAS MIDAS CALLED FROM CCL LEVEL?
11560          RET                    ; NO, DO NOT SNARF TEMPCORE
11561         SETZM CCLFLG            ; IF TMPCOR LOSES WANT THIS 0 (WILL RE-SETOM BELOW)
11562         SETZM CMBUF             ; ZERO FIRST COMMAND WORD
11563         MOVE A,[CMBUF,,CMBUF+1] ; LOAD BLT POINTER
11564         BLT A,CMBUF+CMBFL-2     ; ZERO ALL BUT LAST WORD
11565         MOVEM A,CMBUF+CMBFL-1   ; NON-ZERO LAST WORD
11566         MOVE A,[2,,['MID,, ? -CMBFL,,CMBUF-1]]
11567         TMPCOR A,               ; READ COMPIL-GENERATED COMMAND
11568          RET                    ; NO COMMAND, PUNT
11569         MOVE A,[440700,,CMBUF]  ; LOAD A BYTE POINTER TO THE COMMAND
11570         SKIPN CMBUF             ; ONE LAST CHECK FOR IT TO BE THERE
11571          RET                    ; ALAS, THERE IS NONE
11572         SETOM CCLFLG
11573         MOVEM A,CMPTR           ; THERE IS, SET COMMAND POINTER
11574         SAVE B
11575 JCLIN1: ILDB B,A
11576         CAIE B,^J               ;SEE IF OUR COMMAND FILE HAS ANYTHING AFTER 1ST LINE.
11577          JRST JCLIN1
11578         ILDB B,A
11579         JUMPE B,POPBJ
11580         SETOM MORJCL            ;IT DOES; SET FLAG SO AFTER HANDLING 1ST LINE WE'LL
11581         SAVE C
11582         MOVE C,[440700,,UTIBUF+2]
11583 JCLIN2: IDPB B,C
11584         ILDB B,A
11585         JUMPN B,JCLIN2
11586         SUBI C,UTIBUF+1         ;GET # WORDS WRITTEN IN UTIBUF. OPERAND IS RELOCATABLE!
11587         HRLOI C,-1(C)           ;THESE 2 INSNS TURN SIZE INTO -SIZE,,UTIBUF+1
11588         EQVI C,UTIBUF+1
11589         MOVEM C,(C)
11590         MOVSI C,'MID
11591         MOVEM C,UTIBUF
11592         MOVE C,[3,,UTIBUF]
11593         TMPCOR C,
11594          JFCL
11595         REST C
11596         REST B
11597         RET
11598 ];END IFN DECSW
11599 \f
11600                 ;TS DATA STORAGE
11601
11602 VBLK
11603
11604 TYPDLS==TYPDLC*TYPDEL+INPDEL*MX.INS
11605                 ;"TTY PDL", STORES INFORMATION ABOUT CURRENT INPUT MODE
11606                 ;(SIMILAR TO MACRO PDL BUT NOT GARBAGE COLLECTED)
11607
11608 ITTYP:  -TYPDLS-1,,TTYPDL       ;PDL POINTER (TYPDEL=LENGTH OF EACH ENTRY)
11609 TTYPDL: NEDCHK          ;ACTUAL PDL: INITIAL ENTRY TO OVERPOP ROUTINE
11610         BLOCK TYPDLS    ;PDL PROPER
11611
11612                 ;INPUT BUFFER AND VARIABLES
11613
11614 UTIBUF: BLOCK UTIBFL
11615 UTIHDR: 0               ;INPUT BUFFER HEADER (DEC VERSION)
11616 UREDP:  440700,,UTIBUF  ;INPUT BYTE POINTER
11617 UTICNT: 0               ;INPUT BYTE COUNT (DEC VERSION)
11618 UTIBED: UTIBUF          ;EOF COMPARISON WITH RH(UREDP), 4.9 => EOF ON .IOT
11619 IFSTS:  0               ;.STATUS WORD STORED BY OPNRD1 WHEN .OPEN LOSES
11620 IFN DECSW,UTICHN:       UTYIC
11621
11622                 ;FILE DESCRIPTION STORAGE
11623
11624 INDDP:  MAXIND,,FDSOFS  ;POINTER INTO TABLE
11625 FDSBEG==.               ;BEGINNING OF TABLE AREA
11626 DNAM:   0               ;DEVICE NAME
11627 FNAM1:  0               ;FILE NAME 1
11628 FNAM2:  0               ;" " 2
11629 SNAM:   0               ;SYSTEM NAME
11630 LFDSE==.-FDSBEG         ;LENGTH OF TABLE ENTRY
11631 IFDS:   BLOCK LFDSE     ;SPECIFIED INPUT FILE
11632         0               ;FOR .FDELE AT .FILE TIME
11633 ONAM:   BLOCK 3         ;OUTPUT DEVICE/FILENAMES SPECIFIED
11634 OFNM1==ONAM+1
11635 OFNM2==ONAM+2
11636 OSYSNM: -1              ;SPECIFIED OUTPUT SYSTEM NAME
11637 IFN CREFSW,[    0
11638 CRFDEV: BLOCK 3         ;CREF DEV, FN1, FN2.
11639 CRFSNM: 0               ;CREF SNAME.
11640 ]
11641 IFN ERRSW,ERRDEV:       BLOCK 4 ;ERROR OUTPUT FILE NAMES.
11642 IFN LISTSW,[
11643 LSTDEV: BLOCK 3         ;LISTING FILE NAMES.
11644 LSTSNM: 0
11645 ]
11646 FNMEND::
11647 INFDEV: 0
11648 INFFN1: BLOCK 3         ;FILENAMES OF INPUT FILE BEING READ NOW.
11649 INFCNT: 0       ;# INPUT FILE OPENED.
11650 INFCUR: 0       ;WHAT INFCNT WAS WHEN CURRENT FILE OPENED.
11651 INFERR: 0       ;WHAT INFCUR HELD AT LAST ERROR MSG.
11652 FDSOFS==.-FDSBEG        ;OFFSET TO BEGINNING OF NON-DEDICATED AREA
11653         BLOCK LFDSE*MAXIND      ;OPEN NAMES @: FILES (AND FNF'S)
11654 SFSFDS=.-FDSOFS         ;SOURCE SPECIFIED NAMES @: FILES
11655         BLOCK LFDSE*MAXIND      ;STORAGE FOR "
11656
11657 RFNAM1: 0               ;.FNAM1
11658 RFNAM2: 0
11659 IFNM1:  0               ;.IFNM1
11660 IFNM2:  0
11661 RSYSNM: 0               ;INITIAL SYSTEM NAME
11662
11663 IFN CMUSW, PPNBUF: BLOCK 4      ;FOR CONVERTING CMU PPNs
11664
11665 IFN DECSW,IFE SAILSW, V.SITE:   BLOCK 5         ;SYSTEM NAME IN SIXBIT, FOR .SITE.
11666 \f
11667                 ;TTY VARIABLES
11668
11669 CMBUF:  BLOCK CMBFL     ;TYPEIN BUFFER
11670 CMPTR:  0       ;BYTE POINTER TO CMBUF, CLEARED AT GO2 IF >0.
11671 CMEOF:  0       ;-1 => POPTT INSTEAD RELOAD AFTER THIS BUFFERFULL.
11672 IFN DECSW,MORJCL: 0     ;-1 => THERE ARE MORE LINES OF CCL COMMANDS
11673                         ;SO DO A RUN SYS:MIDAS WHEN FINISHED.
11674 TTYOP:  0       ;-1 => THE TTY IS ALREADY OPEN.
11675 LINEL:  0       ;WIDTH OF TTY (MAY BE 1,, MEANING ASSUME INFINITE).
11676 A.TTYFLG:       ;VALUE OF .TTYFLG:
11677 TTYFLG: 0       ;TTY TYPEOUT PERMITTED IFF >= 0.
11678 WSWCNT: 0       ;THE NUMBER OF W-SWITCHES IN THE LAST CMD STRING.
11679 TTYBRF: 0       ;-1 => ^H BREAK HAS BEEN REQUESTED BUT NOT DONE.
11680 FATAL:  0       ;AT END OF ASSEMBLY, NOT 0 IFF FATAL ERROR OCCURRED.
11681 NEDCRL: 0       ;-1 => HAVEN'T YET SUPPLIED A CRLF AT EOF OF MAIN FILE.
11682 NVRRUN: -1      ;0 => MIDAS WAS RUN; ERROR TO START OR PURIFY.
11683
11684                 ;OPNER VARIABLES
11685
11686 ERRDNM: (SIXBIT /ERR/)
11687         3
11688 ERRNM2: 0               ;.STATUS WORD
11689
11690 IFN ITSSW,OCLOSP: @1(C) ;TURNED INTO BP TO UNUSED PART OF LAST BFFER WD USED.
11691
11692                 ;OUTPUT VARIABLES
11693
11694 UTOBUF: BLOCK UTOBFL    ;OUTPUT BUFFER
11695 UTOHDR: UTOBFL,,UTOBUF-1
11696 UTYOP:  444400,,        ;OUTPUT (36. BIT) BYTE POINTER
11697 UTYOCT: 0               ;# WORDS LEFT IN UTOBUF
11698
11699 IFN CREFSW,[    ;CREF OUTPUT VARS.
11700 CRFBUF: BLOCK CRFBSZ
11701 CRFHDR: CRFBSZ,,CRFBUF-1        ;HEADER, ASSEMBLED VALUE USED ONLY IFN ITSSW
11702 CRFPTR: 444400,,        ;BP FOR FILLING BUFFER
11703 CRFCNT: 0               ;NUM. CHARS. EMPTY IN BUFFER
11704 ]
11705
11706 IFN LISTSW,[
11707 LSTBUF: BLOCK LSTBSZ
11708 LSTHDR: 5*LSTBSZ,,LSTBUF-1
11709 LSTPTR: 440700,,
11710 LSTCNT: 0
11711 ]
11712
11713 IFN ERRSW,[
11714 ERRBUF: BLOCK ERRBSZ
11715 ERRHDR: 5*ERRBSZ,,ERRBUF-1
11716 ERRPNT: 440700,,
11717 ERRCNT: 0
11718 ERRFP:  0       ;NON-0 IF WANT ERROR OUTPUT FILE.
11719 ERRFOP: 0       ;NON-0 IF ERROR FILE OPEN (IE TRY OUTPUTTING TO IT)
11720 ]
11721 PBLK
11722 \f
11723         ;.INSRT FILEDESCRIPTION<CR>
11724         ;INSERT FILE HERE
11725         ;TTY: => OK, READS LINE AT A TIME, RUBOUT ALLOWED WITHIN LINE
11726         ;PUSHES MACRO EXPANSION, OTHER .INSRT'S
11727         ;IN FILEDESCRIPTION, ^R => RESET FILE NAME COUNTER
11728
11729 A.INSR: NOVAL
11730         MOVEI F,IFDS-DNAM       ;SET UP POINTER TO INPUT FILE NAMES
11731         PUSHJ P,A.IMAP  ;DEFAULT NAMES = INPUT NAMES
11732         MOVSI A,(SIXBIT /DSK/)
11733         MOVS B,DNAM
11734         CAIN B,(SIXBIT /TTY/)   ;IF INPUTTING FROM TTY,
11735         MOVEM A,DNAM    ;THEN SET DEFAULT DEVICE TO DSK INSTEAD
11736 IFN ITSSW,MOVSI A,(SIXBIT/>/)
11737 IFN DECSW,MOVSI A,'MID
11738         MOVEM A,FNAM2   ;USE > AS THE DEFAULT FN2.
11739         TLO FF,FLUNRD
11740 A.IN1:  PUSHJ P,RFD     ;READ FILE DESCRIPTION
11741         MOVS A,DNAM     ;GET SPECIFIED DEVICE NAME
11742         CAIE A,(SIXBIT /@/)     ;ATSIGN?
11743         PUSHJ P,A.ITRY  ;NO, TRY OPENING FILE
11744         MOVE A,DNAM(F)
11745         AOJE A,A.INT1   ;ALREADY TRYING TO SET UP TABLE ENTRY
11746         SKIPA F,[MAXIND,,FDSOFS]        ;ATSIGN, OR FNF, SEARCH TABLE
11747 A.IN2:  SUBI F,-LFDSE   ;LOOP POINT SEARCHING TABLE, INCREMENT TO NEXT ENTRY, COUNT DOWN LH
11748         CAMN F,INDDP    ;COMPARE WITH POINTER TO TOP OF TABLE
11749         JRST A.IN3      ;AGREE => THIS FILE NOT IN TABLE
11750         MOVE A,F        ;-> SFSFDS
11751         MOVSI B,-LFDSE  ;-> DNAM, LH FOR COUNT
11752         MOVE T,SFSFDS(A)        ;GET SPECIFICATION NAME THIS ENTRY
11753         CAMN T,DNAM(B)  ;COMPARE WITH THAT JUST SPECIFIED
11754         AOBJN B,[AOJA A,.-2]    ;CHECK ALL NAMES THIS ENTRY
11755         JUMPL B,A.IN2   ;LOOP IF NAMES DON'T ALL AGREE
11756                 ;FILE IS IN TABLE
11757         PUSHJ P,A.IMAP  ;SET NEW FILE DESCRIPTION FROM THAT IN TABLE ENTRY
11758         PUSHJ P,A.ITRY  ;TRY OPENING FILE
11759         MOVSI A,SFSFDS(F)       ;SET UP LH(BLT POINTER),
11760         PUSHJ P,A.IMP1  ;UNMAP TO ORIGINAL NAMES
11761         PUSHJ P,TYPFIL  ;TYPE OUT SPECIFIED NAMES
11762         TYPR [ASCIZ / -> /]     ;TYPE OUT POINTER
11763         PUSHJ P,A.IMAP  ;RE-MAP INTO TRANSLATION ENTRY IN TABLE
11764         SETOM DNAM(F)   ;"HALF-KILL" ENTRY
11765 A.INT1: PUSHJ P,IOPNR1  ;TYPE OUT ALL KINDS OF STUFF
11766 A.INT2: PUSHJ P,GTYIP   ;PREPARE TO READ ONE LINE FROM TTY
11767         JRST A.IN1      ;TRY AGAIN WITH WHAT HE TYPES IN
11768
11769                 ;FILE NOT IN TABLE
11770
11771 A.IN3:  TLNN F,-1       ;MORE ROOM FOR ANOTHER ENTRY IN TABLE?
11772          ETF [ASCIZ /Too many @: files/]
11773         MOVEI A,SFSFDS(F)
11774         HRLI A,DNAM
11775         BLT A,SFSFDS+LFDSE-1(F) ;SET UP KEY OF NEW ENTRY
11776         SETOM DNAM(F)   ;DOCUMENT FACT THAT ENTRY HAS ONLY KEY, NOT TRANSLATION
11777         MOVNI A,-LFDSE
11778         ADDM A,INDDP    ;UPDATE POINTER INTO TABLE
11779         MOVS A,DNAM     ;GET SPECIFIED DEVICE NAME
11780         CAIE A,(SIXBIT /@/)     ;ATSIGN?
11781         JRST A.INT1     ;NO, TYPE OUT GARBAGE AND TRY AGAIN, READING FROM TTY
11782         MOVE A,IFDS     ;YES, CLOBBER FROM INPUT DEVICE NAME
11783         MOVEM A,DNAM
11784         JRST A.INT2
11785 \f
11786                 ;TRY OPENING INPUT FILE FOR .INSRT, RETURN IF UNSUCCESSFUL
11787
11788 A.ITRY: MOVS A,DNAM     ;GET SPECIFIED DEVICE NAME
11789         CAIN A,(SIXBIT /TTY/)   ;TTY?
11790          JRST A.ITRT    ;YES, TREAT SPECIAL
11791         TLO FF,FLUNRD
11792         PUSHJ P,IPUSH   ;SAVE CURRENT STATUS
11793         PUSHJ P,OPNRD1  ;TRY OPENING FILE
11794          JRST IPOPL     ;LOSE, POP AND RETURN
11795 IFN ITSSW,CALL SETWH2
11796         MOVE B,ITTYP
11797         MOVEI A,-1-TYPDEL(B)
11798         HRLI A,IFNM1
11799         BLT A,-TYPDEL(B) ;INTRODUCE HYSTERESIS SO .INSRT'ING FILE CAN REFERENCE .IFNM1, .IFNM2
11800 IFN CREFSW,[
11801         SKIPE CRFONP    ;IF CREFFING, OUTPUT PUSH-FILE BLOCK.
11802         PUSHJ P,CRFPSH  ;(POP-FILE BLOCK OUTPUT AT IPOP)
11803 ]
11804 A.ITR2:
11805         MOVE A,DNAM(F)  ;PUSH SUCCESSFUL, NOW CHECK TO SEE IF TABLE ENTRY SHOULD BE FINISHED
11806         AOJN A,ASSEM1
11807         PUSHJ P,A.OMAP  ;YES, DO IT
11808         JRST ASSEM1     ;NOW ASSEMBLE FROM FILE (ASSEM1 CLOBBERS PDL)
11809
11810                 ;.INSRT TTY:
11811
11812 A.ITRT: PUSHJ P,GTYIPA  ;READ FROM TTY, DON'T QUIT UNTIL .INEOF
11813         JRST A.ITR2     ;FALL BACK IN (DOESN'T TOUCH .IFNM1, .IFNM2)
11814
11815                 ;.INEOF         ;EOF PSEUDO (MAINLY USEFUL FROM TTY)
11816
11817 A.IEF2: PUSHJ P,PMACP   ;LOOP POINT, POP ENTRY OFF MACRO PDL
11818 A.INEO: TLNE FF,FLMAC   ;INPUTTING FROM MACRO?
11819         JRST A.IEF2     ;YES, POP IT OFF
11820         PUSH P,CMACCR   ;BACK TO INPUTTING FROM FILE OR TTY, CAUSE RETURN TO MACCR
11821         MOVE B,ITTYP    ;GET PDL POINTER
11822         POPJ B,         ;RETURN TO POP ROUTINE
11823
11824                 ;MISC .INSRT
11825
11826 A.IMAP: MOVSI A,DNAM(F) ;CLOBBER DNAM ETC. FROM TABLE TRANSLATION ENTRY POINTED TO BY F
11827 A.IMP1: HRRI A,DNAM     ;ENTRY FOR LH(BLT POINTER) ALREADY SET UP
11828         BLT A,DNAM+LFDSE-1      ;DO IT
11829         POPJ P,
11830
11831 A.OMAP: MOVEI A,DNAM(F) ;CLOBBER TRANSLATION OF TABLE ENTRY POINTED TO BY F FROM DNAM ETC.
11832         HRLI A,DNAM
11833         BLT A,DNAM+LFDSE-1(F)
11834         POPJ P,
11835
11836 ;CALL FROM ERRH; TYPE INPUT FILE'S NAMES IF CHANGED SINCE LAST ERR MSG.
11837 ERRTFL: MOVE C,INFCUR
11838         EXCH C,INFERR   ;SAY LAST ERROR MSG IN THIS FILE.
11839         CAMN C,INFERR   ;IF PREV. MSG WAS IN OTHER FILE,
11840         POPJ P,
11841         MOVE C,[-4+DECSW,,INFDEV-DNAM]
11842         PUSHJ P,TYPF1   ;TYPE THIS FILE'S NAMES.
11843         JRST CRRERR
11844 \f
11845                 ;MISC TS
11846
11847 IOPNR1: PUSHJ P,IOPNER  ;TYPE OUT CRUFT
11848         TYPR OINITS
11849         RET
11850
11851                 ;TYPE OUT DNAM ETC. AS FILE SPECIFICATION
11852
11853 TYPFIL: MOVSI C,-4+DECSW
11854 TYPF1:  MOVE B,DNAM(C)  ;GET NEXT NAME
11855         PUSHJ P,SIXTYO  ;TYPE OUT NAME
11856         HLRZ A,C
11857         MOVE A,FILSPC+4-DECSW(A)        ;NOW GET DELIMITING CHARACTER
11858         PUSHJ P,TYOERR  ;TYPE OUT
11859         AOBJN C,TYPF1   ;LOOP FOR ALL NAMES
11860 IFN ITSSW, POPJ P,
11861 .ELSE,[ SKIPN B,DNAM(C) ;ON DEC SYSTEM PPN IS A SPECIAL CASE
11862          POPJ P,
11863         MOVEI A,"[ ;]
11864         CALL TYOERR
11865 IFN CMUSW,[
11866         MOVE A,[B,,PPNBUF]
11867         DECCMU A,
11868          JRST OCTPPN
11869         MOVEI B,PPNBUF
11870         PUSHJ P,TYPR3
11871         JRST PPNRB
11872 ];IFN CMUSW
11873 IFE SAILSW,[
11874 OCTPPN: HLRZ B,DNAM(C)  ;LH IS PROJ,
11875         CALL OCTPNT
11876 ]
11877 .ELSE [ HLLZ B,DNAM(C)
11878         CALL SIXTYO
11879 ]
11880         MOVEI A,",
11881         CALL TYOERR
11882 IFE SAILSW,[
11883         HRRZ B,DNAM(C)
11884         CALL OCTPNT     ;RH IS PROG.
11885 ]
11886 .ELSE [ HRLZ B,DNAM(C)
11887         CALL SIXTYO
11888 ]
11889 PPNRB:                  ;[
11890         MOVEI A,"]
11891         JRST TYOERR
11892 ];IFN DECSW
11893
11894 FILSPC: ":
11895 IFN ITSSW, 40 ? 40 ? ";
11896 IFN DECSW, ". ? 0
11897
11898                 ;OPENLOSS DOCUMENTATION ROUTINE
11899 IOPNER: MOVE A,IFSTS    ;INPUT
11900 OPNER:  MOVEM A,ERRNM2  ;SAVE .STATUS WORD
11901         PUSHJ P,TYPFIL  ;TYPE OUT FILE DESCRIPTION
11902         PUSHJ P,CRRERR  ;NOW CRLF TO ENSURE ROOM FOR FOLLOWING
11903 IFN DECSW,[
11904         TYPR [ASCIZ/OPEN failed/]
11905         JRST CRRERR
11906 ]
11907 IFN ITSSW,[
11908         .OPEN ERRC,ERRDNM       ;NOW GET THE SYSTEM TO SAY WHAT'S WRONG
11909         .VALUE          ;CAN'T OPEN ERR DEVICE?
11910 IOPNR2: .IOT ERRC,A     ;GET CHARACTER FROM SYSTEM
11911         CAIN A,14       ;ENDS WITH FORM FEED
11912         POPJ P,
11913         PUSHJ P,TYOERR  ;TYPE OUT CHARACTER
11914         JRST IOPNR2     ;LOOP BACK FOR NEXT
11915 ]       ;END IFN ITSSW
11916 \f
11917 ;READ SINGLE FILE DESCRIPTION INTO DNAM ... SNAM .
11918 ;FRNNUL 1 IFF SPEC WAS NONNULL.
11919 ;FRMRGO 1 IFF "." WAS SEEN IN DEC VERSION - FORCE NULL FN2.
11920 ;FRCMND 1 IFF SHOULD RECOGNIZE -, COMMA, / AND ( AS SPECIAL CHARACTERS.
11921 RFD:    TRZ FF,FRNNUL+FRMRGO
11922 RFD8:   SETZ D,         ;D COUNTS FILENAMES. 0 BEFORE 1ST.
11923 RFD1:   MOVEI C,0       ;INITIALIZE SIXBIT NAME.
11924         MOVE B,[440600,,C]      ;SET UP BP FOR INPUT
11925 RFD2:   PUSHJ P,RCH     ;GET CHARACTER IN A
11926         CAIN A,":       ;IF COLON...
11927          JRST RFDCOL    ;THEN PROCESS AS SUCH
11928         CAIN A,";       ;SIMILARLY FOR SEMICOLON
11929          JRST RFDSEM
11930 IFN DECSW,[
11931         CAIN A,"!       ; FOO! MEANS RUN SYS:FOO WITH OFFSET 1
11932          JRST RFDRUN
11933 ]
11934         CAIN A,^Q       ;IF CONTROL Q...
11935          JRST RFDCQ     ;THEN GET NEXT CHARACTER AND TREAT AS NON-SYNTACTICAL
11936         TRNN FF,FRCMND  ;IF READING COMMAND, _, COMMA, / AND ( ARE SPECIAL.
11937          JRST RFD3
11938         CAIN A,"(
11939          JRST CMDSW     ;READ SWITCHES.
11940         CAIN A,"/
11941          JRST CMDSL     ;READ 1 SWITCH
11942 IFN DECSW,CAIN A,"=
11943 .ALSO      JRST RFD6    ;ON DEC SYS, "=" = "_"
11944         CAIE A,",
11945          CAIN A,"_
11946           JRST RFD6     ;COMMA AND _ END SPEC.
11947 RFD3:
11948 IFN DECSW,[
11949         CAIE A,"[       ;]
11950          CAIN A,".      ;. LIK SPACE ON DEC SYS.
11951           JRST RFD6]
11952         CAILE A,40      ;LOGICAL SPACE? (INCLUDING CR)
11953          JRST RFDC      ;NO
11954 RFD6:   TRZN FF,FRMRGO  ;EXCEPT AFTER ".",
11955          JUMPE C,RFD5   ;IGNORE NULL FILENAMES
11956         XCT RFDTAB(D)   ;STORE THE NAME (MAY SKIP)
11957          ADDI D,1       ;NEXT NAME PUT ELSEWHERE
11958 IFN DECSW,[
11959         CAIN A,".
11960          IORI FF,FRMRGO
11961 ]
11962         TRO FF,FRNNUL   ;SPEC NOT NULL.
11963 RFD5:   IFN DECSW,[CAIN A,"[    ;] READ PPN FOR DEC SYS.
11964                  JRST RFD7]
11965         CAIN A,^R       ;CONTROL R,
11966          JRST RFD8      ;RESETS FILENAME COUNT
11967 IFN DECSW,[
11968         CAIN A,"=       ;ON DEC SYS, "=" = "_".
11969          MOVEI A,"_
11970 ]
11971         CAIN A,",
11972          RET
11973         CAIE A,"_       ;RETURN IF SPEC TERMINATOR,
11974          CAIN A,^M
11975           RET
11976         JRST RFD1       ;ELSE NEXT NAME.
11977
11978 RFDCQ:  PUSHJ P,RCH     ;CONTROL Q EATS UP THE NEXT CHARACTER
11979         CAIN A,15
11980         JRST RFD6       ;BUT NOT IF CR
11981 RFDC:   CAIL A,140      ;CONVERT LOWER CASE TO UPPER.
11982         SUBI A,40
11983         SUBI A,40       ;CONVERT CHARACTER TO SIXBIT
11984         TLNE B,770000   ;TOO MANY CHARACTERS?
11985         IDPB A,B        ;NO
11986         JRST RFD2       ;LOOP
11987
11988 RFDTAB: MOVEM C,FNAM1   ;1ST NAME.
11989         MOVEM C,FNAM2   ;2ND NAME.
11990         MOVEM C,DNAM    ;3RD NAME IS DEV.
11991         MOVEM C,SNAM    ;4TH IS SNAME.
11992         CAIA            ;5TH AND ON IGNORED, DON'T INCR. D.
11993 \f
11994 RFDCOL: TRO FF,FRNNUL
11995         JUMPE C,RFD1    ;IF HE WANTS THE NULL DEVICE HE GETS TO TYPE IT IN
11996         MOVEM C,DNAM    ;MOVE TO RH OF DEVICE LOCATION
11997         JRST RFD1       ;LOOP
11998
11999 IFN DECSW,[
12000 RFD7:   PUSHJ P,RFDPPN  ;READ PPN, USE AS "SNAME".
12001 ]
12002 RFDSEM: TRO FF,FRNNUL
12003         JUMPE C,RFD1    ;NO NULL SYSTEM NAMES PLEASE
12004         MOVEM C,SNAM    ;MOVE TO SYSTEM NAME LOCATION
12005         JRST RFD1       ;LOOP
12006
12007 IFN DECSW,[
12008 RFDPPN: PUSHJ P,RFDOCT  ;READ PROJECT NUM,
12009 IFN CMUSW, JUMPE C,RCMUPP       ;AT CMU WATCH FOR OUR FUNNY PPNs
12010         HRLM C,(P)
12011         PUSHJ P,RFDOCT  ;READ PROGRAMMER NUM.
12012         HLL C,(P)
12013         POPJ P,
12014
12015 IFE SAILSW,RFDOCL=="0 ? RFDOCH=="8      ;READ OCTAL NUMBERS.
12016 .ELSE RFDOCL==40 ? RFDOCH==140  ;READ SIXBIT (RIGHT-JUSTIFIED).
12017
12018 RFDOCT: SETZ C, ;READ OCTAL NUM, RETURN IN C.
12019 RFDOC1: PUSHJ P,RCH
12020         CAIL A,140
12021          SUBI A,40
12022 IFN SAILSW,[ ;[         ;EVEN IF READING SIXBIT NAMES (FOR SAIL),
12023         CAIE A,",       ;COMMA AND CLOSEBRACKET ARE STILL SPECIAL.
12024          CAIN A,"]
12025           POPJ P,
12026 ]
12027         CAIL A,RFDOCL
12028         CAIL A,RFDOCH
12029          POPJ P,        ;NOT OCTAL OR NOT 6BIT, RETURN.
12030         IMULI C,RFDOCH-RFDOCL
12031         ADDI C,-RFDOCL(A)
12032         JRST RFDOC1
12033
12034 IFN CMUSW,[     ;[
12035 RCMUPP: CAIN A,"]       ;WATCH OUT FOR []
12036          POPJ P,
12037 REPEAT 4, SETZM PPNBUF+.RPCNT
12038         MOVE C,[440700,,PPNBUF]
12039 RCMUPL: CAIE A,^M               ;Don't look too far
12040          SKIPE PPNBUF+3
12041           JRST RCMUPD
12042         IDPB A,C
12043         PUSHJ P,RCH     ;[
12044         CAIE A,"]
12045          JRST RCMUPL
12046 RCMUPD: MOVE A,[C,,PPNBUF]
12047         CMUDEC A,
12048          SETZ C,
12049         POPJ P,
12050 ];IFN CMUSW
12051 ];IFN DECSW
12052 \f
12053 IFN DECSW,[
12054
12055 ;PROCESS "FOO!", WHICH MEANS "RUN SYS:FOO WITH AN OFFSET OF 1".
12056
12057 RFDRUN: MOVSI A,'SYS    ;DEV NAME
12058         MOVE B,C        ;FN1
12059         SETZB C,D       ;DEFAULT THE FN2.  4TH WORD NOT USED.
12060         SETZB T,TT      ;DEFAULT THE PPN (UNUSED ANYWAY).  DON'T SPECIFY CORE SIZE.
12061         MOVE AA,[1,,A]  ;<START OFFSET>,,<ADDRESS OF ARG BLOCK>
12062         JRST RFDRU1
12063 VBLK
12064 RFDRU1: MOVE F,[1,,RFDRUE]
12065         CORE F,         ;FLUSH AS MUCH CORE AS POSSIBLE, SINCE RUN UUO CAN LOSE
12066          HALT           ;BECAUSE OF HOW MUCH WE HAVE.
12067         RUN AA,
12068          HALT
12069 RFDRUE:
12070
12071 PBLK
12072 ];END IFN DECSW,
12073
12074 ;COMMAND SWITCH PROCESSING.
12075
12076 CMDSL:  CALL RCH        ;COME HERE AFTER A SLASH. READ ONE SWITCH.
12077         CAIN A,^M
12078          JRST RFD6
12079         CALL CMDSW1
12080         JRST RFD2
12081
12082 CMDSW:  PUSHJ P,RCH
12083         CAIN A,")
12084          JRST RFD2
12085         CAIN A,^M
12086          JRST RFD6      ;DON'T CRASH IF USER PUTS CR IN SWITCH LIST.
12087         CALL CMDSW1
12088         JRST CMDSW
12089
12090 CMDSW1: CAIL A,140      ;LOWER CASE TO UPPER.
12091          SUBI A,40
12092         CAIN A,"T
12093          SOS TTYINS     ;COUNT # T-SWITCHES.
12094 IFN LISTSW,[
12095         CAIN A,"L
12096          JRST CMDLST
12097 ]
12098         CAIN A,"W       ;W - PREVENT TTY MESSAGES, AND RQ ERROR OUTPUT FILE IF POSSIBLE.
12099 IFE ERRSW,AOS WSWCNT
12100 .ELSE [
12101         AOSA WSWCNT
12102         CAIN A,"E       ;E - RQ ERROR LOG FILE.
12103          SETOM ERRFP
12104 ]
12105 IFN CREFSW,[
12106         CAIN A,"C       ;C - RQ CREF OUTPUT.
12107         SETOM CREFP
12108 ]
12109         RET
12110 \f
12111 ;READ COMMAND, DEFAULT FILENAMES.
12112 CMD:    SKIPN CMPTR
12113         CALL CRR
12114         SKIPN CMPTR     ;UNLESS HAVE DDT COMMAND STRING, PROMPT.
12115 CMDB:   TYPR [ASCIZ/*/]
12116         MOVEI A,3       ;READ FROM TTY (OR STRING <- CMPTR)
12117         CALL RCHSET
12118         TRO FF,FRCMND+FRARRO    ;TELL RFD ABOUT COMMA, _ AND (.
12119         CALL RFD        ;NOW SEE IF COMMAND NULL, AND WHETHER HAS _.
12120         TRNN FF,FRNNUL
12121         CAIE A,^M
12122          CAIA
12123         JRST CMDB       ;JUST A CR WITH NOTHING SIGNIFICANT BEFORE IT.
12124 CMD0:   CAIN A,"_
12125          TRZ FF,FRARRO  ;FRARRO WILL BE ON IFF NO _ IN STRING.
12126         CAIN A,^M
12127          JRST CMD1      ;READ THRU THE WHOLE COMMAND.
12128         CALL RFD
12129         JRST CMD0
12130
12131 ;NOW RE-READ THE STRING, FOR REAL THIS TIME.
12132 CMD1:   MOVE F,[440700,,CMBUF]
12133         MOVEM F,CMPTR   ;START FROM BEGINNING OF STRING.
12134 IFN CREFSW,SETZM CREFP  ;CLEAR ALL SWITCHES BEFORE DECODING THEM.
12135 INSIRP SETZM 0,ERRFP TTYINS WSWCNT
12136 IFN LISTSW,[
12137         SETZM LISTP
12138         SETOM LISTP1    ;WILL BE AOSED BY EACH (L) SWITCH.
12139 ]
12140         SETZM DNAM      ;CLEAR OUT ALL FILENAMES.
12141         MOVE T,[DNAM,,DNAM+1]
12142         BLT T,FNMEND-1
12143         MOVSI T,'DSK    ;DEFAULT DEV IS DSK
12144         MOVEM T,DNAM    ;EXCEPT PERHAPS IF OUTPUT SPEC NULL.
12145         MOVE T,RSYSNM
12146         MOVEM T,SNAM    ;DEFAULT SNAME IS INITIAL SNAME.
12147         TRZ FF,FRNNUL
12148         TRNN FF,FRARRO  ;DON'T GOBBLE INPUT SPEC AS OUTPUT!
12149          CALL RFD               ;READ BIN FILE SPEC.
12150         MOVE F,FF       ;REMEMBER WHETHER NULL
12151         MOVE T,[DNAM,,ONAM]
12152         BLT T,OSYSNM
12153         MOVS T,DNAM
12154         CAIN T,'NUL     ;IF BIN WENT TO NUL:,
12155          MOVEI T,'DSK   ;CREF GOES TO DSK.
12156         MOVSM T,DNAM    ;ELSE DEFAULT DEV FOR CREF IS BIN'S DEV.
12157 IFN DECSW,MOVSI T,'CRF
12158 IFN ITSSW,MOVE T,[SIXBIT/CREF/]
12159         MOVEM T,FNAM2   ;DEFAULT THE CREF FILE'S NAMES.
12160         TRNE FF,FRARRO
12161          MOVEI A,"_
12162         CAIN A,"_
12163          JRST CMD2      ;RAN OUT OF OUTPUT SPECS => JUST USE DEFAULTS.
12164         CALL RFD        ;READ CREF FILE SPEC.
12165 IFN CREFSW,[
12166         TRNN FF,FRNNUL  ;IF SPEC NOT NULL OR ENDED BY _,
12167         CAIN A,"_
12168          SETOM CREFP    ;WE MUST WANT TO CREF.
12169 CMD2:   MOVE T,[DNAM,,CRFDEV]
12170         BLT T,CRFSNM
12171 ]IFE CREFSW,CMD2:
12172         MOVSI T,'ERR    ;DEFAULT THE ERROR OUTPUT FILE'S NNAMES.
12173         MOVEM T,FNAM2
12174         CAIN A,"_
12175          JRST CMD6      ;NO MORE OUTPUT SPECS.
12176         CALL RFD        ;READ ERROR FILE SPPEC.
12177 IFN ERRSW,[
12178         TRNN FF,FRNNUL  ;NONNULL SPEC OR LAST SPEC =>
12179         CAIN A,"_
12180          SETOM ERRFP    ;MUST WAANT ANN ERROR FILE.
12181 CMD6:   MOVE T,[DNAM,,ERRDEV]
12182         BLT T,ERRDEV+3
12183 ]
12184 IFE ERRSW,CMD6:
12185 IFN LISTSW,[
12186 IFN DECSW,MOVSI T,'LST
12187 IFN ITSSW,MOVE T,[SIXBIT/LIST/]
12188         MOVEM T,FNAM2   ;DEFAULT LST FILE FN2.
12189         CAIN A,"_       ;ANY OUTPUT SPEC REMAINING?
12190          JRST CMD3
12191         CALL RFD        ;YES, READ ONE.
12192         SETOM LISTP     ;LIST SPEC GIVEN IMPLIES WANT LISTING.
12193 CMD3:   MOVE T,[DNAM,,LSTDEV]
12194         BLT T,LSTSNM
12195 ] ;END IFN LISTSW,
12196 CMD5:   CAIN A,"_
12197          JRST CMD4
12198         CALL RFD        ;IGNORE ANY OUTPUT SPECS NOT NEEDED.
12199         JRST CMD5
12200
12201 CMD4:   MOVSI T,'DSK    ;DEFAULT THE INPUT NAMES.
12202         MOVS A,DNAM
12203         CAIE A,'PTP     ;DON'T LEAVE DEV NAME SET TO COMMON OUTPUT-ONLY DEVS.
12204          CAIN A,'NUL
12205           MOVEM T,DNAM
12206 IFN DECSW,MOVSI T,'MID
12207 IFN ITSSW,MOVSI T,'>_14
12208         MOVEM T,FNAM2
12209         MOVE T,[SIXBIT/PROG/]
12210         SKIPN FNAM1     ;THE FN1 ALONE IS STICKY ACROSS THE _.
12211         MOVEM T,FNAM1
12212         TRO FF,FRARRO   ;IF ONLY 1 NAME IT SHOULD BE FNAM1.
12213         CALL RFD        ;READ INPUT SPEC.
12214         MOVE T,[DNAM,,IFDS]
12215         BLT T,IFDS+3
12216         MOVE T,FNAM1    ;DEFAULT OUTPUT FN1'S TO INPUT.
12217         SKIPN ONAM+1
12218         MOVEM T,ONAM+1
12219 IFN CREFSW,[
12220         SKIPN CRFDEV+1
12221          MOVEM T,CRFDEV+1
12222 ]
12223 IFN LISTSW,[
12224         SKIPN LSTDEV+1
12225          MOVEM T,LSTDEV+1
12226 ]
12227 IFN ERRSW,[SKIPN ERRDEV+1
12228         MOVEM T,ERRDEV+1
12229 ]
12230         MOVSI A,'NUL    ;THE OUTPUT DEV DEFAULTS TO NUL:
12231         MOVS T,DNAM     ;IF THE INPUT IS FROM TTY:
12232         CAIN T,'TTY
12233         TRNE F,FRNNUL   ;AND THE BIN SPEC WAS NULL.
12234          CAIA
12235         MOVEM A,ONAM
12236         TRZ FF,FRARRO   ;DON'T LOUSE UP .INSRT'S READING.
12237         RET
12238 \f
12239 IFN CREFSW,[
12240
12241 CRFOUT: SOSGE CRFCNT
12242         JRST CRFOU1     ;NO ROOM, OUTPUT AND INIT BUFFER.
12243         IDPB A,CRFPTR
12244         POPJ P,
12245
12246 CRFOU1: SAVE C
12247         MOVE C,[0 CREFC,CRFHDR]
12248         CALL OBUFO
12249         REST C
12250         JRST CRFOUT
12251
12252 CRFSSF: SKIPA A,[1]     ;OUTPUT SET-SOURCE-FILE BLOCK.
12253 CRFPSH: MOVEI A,3       ;OUTPUT PUSH-SOURCE-FILE BLOCK.
12254 REPEAT 4,[ CALL CRFOUT
12255         MOVE A,INFDEV+.RPCNT
12256 ]
12257         JRST CRFOUT
12258 ]
12259
12260 IFN LISTSW,[
12261                 ;PRINTING ROUTINES
12262
12263 ;L SWITCH TYPED IN DURING COMMAND, SET UP FOR LISTING
12264 CMDLST: SETOM LISTP     ;SAY WANT LISTING.
12265         AOS LISTP1      ;(STARTS AS -1, WILL BE POS. AFTER 2ND (L))
12266         RET
12267
12268 ;PRINT CHARACTER IN A
12269 PILPT:  SOSGE LSTCNT
12270          JRST PILPT1
12271         IDPB A,LSTPTR
12272         RET
12273
12274 PILPT1: SAVE C
12275         MOVE C,[0 LPTC,LSTHDR]
12276         CALL OBUFO
12277         REST C
12278         JRST PILPT
12279
12280 LPTCLS==CPOPJ
12281 ] ;END IFN LISTSW,
12282 \f;GET ANOTHER K OF MACTAB SPACE.
12283
12284 CORRQB: IFN ITSSW,.VALUE                ;LOOP POINT FOR DON'T PROCEED
12285 IFN DECSW,EXIT 1,
12286         TLZ AA,400000
12287 CORRQA: POP P,D
12288         POP P,C
12289         MOVE A,(P)      ;RESTORE A FROM PDL
12290         JRST CORRQ1
12291
12292 GCCORQ: MOVE A,MACHI
12293         LSH A,-2        ;CONVERT TO WORD #
12294         CAIL A,MXMACL   ;WANT MORE THAN ALLOWED?
12295          POPJ P,
12296         MOVE A,MACTND   ;NO, GET ADDR OF BLOCK WE WANT TO GET.
12297         PUSH P,A        ;ENTRY, SAVE A IN CASE HAVE TO TRY AGAIN
12298 CORRQ1:IFN ITSSW,[
12299         HRLI A,10001    ;(CODE FOR FRESH PAGE, _1)
12300         LSH A,-1
12301         .CBLK A,        ;TRY GETTING BLOCK
12302 ]
12303 IFN DECSW,[
12304         IORI A,1777
12305         CORE A,
12306 ]
12307         JRST CORRQL     ;LOSE
12308         REST A
12309         ADDI A,2000
12310         JRST MACIN2     ;UPDATE POINTERS TO END OF MACTAB.
12311
12312 CORRQL: PUSH P,C
12313         PUSH P,D
12314         TLOE AA,400000
12315         JRST CORQL1
12316         TYPR [ASCIZ /
12317 No core for macro table./]
12318 CORQL1: TYPR [ASCIZ /
12319 Try again?   /]
12320 CORQL2: PUSHJ P,TYI     ;GET CHAR
12321         TRZ A,"
12322         CAIN A,"Y       ;Y,
12323         JRST CORRQA     ;=> TRY AGAIN
12324         CAIN A,"N       ;N,
12325         JRST CORRQB     ;=> BACK TO DDT THEN TRY AGAIN
12326         CAIN A,"?       ;?,
12327         ERJ CORQL1      ;=> TYPE OUT ERROR-TYPE BLURB
12328         TYPR [ASCIZ /?   /]     ;SOMETHING ELSE
12329         JRST CORQL2
12330
12331 ]               ;END TS CONDITIONAL
12332 \f
12333 FEED1:  SKIPA B,[40]
12334 FEED:   MOVEI B,5
12335         JRST TFEED
12336
12337 VBLK
12338
12339 IFG PURESW-DECSW,[      ;PURIFICATION ROUTINE
12340
12341 PURIFG: -1              ;-1 IF NOT (YET) PURIFIED
12342 ]
12343         VARIAB
12344 VPAT:
12345 VPATCH: BLOCK 20
12346 VPATCE=.-1
12347
12348 PBLK
12349
12350 CONSTANTS
12351
12352 PAT:
12353 PATCH:  BLOCK 100
12354 PATCHE: -1
12355
12356 IFG PURESW-DECSW,[LOC <.+1777>&-2000    ;SKIP TO NEXT PAGE
12357         MAXPUR==./2000  ;FIRST PAGE ABOVE PURE PAGES
12358 PRINTA Pure pages = ,\MAXPUR-MINPUR
12359 ]
12360
12361 VBLK
12362 PDL:    BLOCK LPDL+1
12363
12364 IFN DECDBG, DECDBB:     BLOCK 8000.     ;SPACE FOR DEC DDT'S SYMS.
12365
12366 .NSTGW
12367 BBKCOD==.       ;BEGIN BLANK CODING, CLEARED OUT DURING INITIALIZATION
12368 IFG PURESW-DECSW,MINBNK==<.+1777>/2000  ;FIRST PAGE OF BLANK CODE
12369 BNKBLK          ;DUMP OUT ACCUMULATED BLANK CODING
12370
12371                 ;NOW MORE BLANK CODING
12372
12373 BKBUF:  BLOCK BSIZE+5   ;CURRENT BLOCK TO OUTPUT
12374 GLOTB:  BLOCK 20        ;GLOBAL TABLE, EACH ENTRY FLAGS,,ADR OF SQUOZE (SEE COMMENTS NEAR BEGINNING)
12375 STRSTO: BLOCK STRL      ;STRING STORAGE FOR GSYL AND FRIENDS
12376 IFN FASLP,[
12377 FASB:   BLOCK FASBL     ;OUTPUT BUFFER FOR FASL MODE
12378                         ;FIRST WD 9 FOUR BIT CODE GROUPS, REST ASSOC STUFF
12379 FASAT:  BLOCK FASATL    ;ATOM TABLE FOR FASL MODE
12380                         ;EACH ENTRY CONSISTS OF ATOM IN FORMAT DESIRED BY FASLOAD,
12381                         ;NAMELY:
12382                         ;  HEADER WD. RH LENGTH IN WDS
12383                         ;  4.8-4.7 TYPE 0-PN 1 FIX 2 FLO 3 BIG (NOT IMPLEMENTED)
12384                         ;  FOLLOWED BY PN OR VALUE
12385                         ;-EXCEPT-  IF RH OF HEADER =0, THIS SLOT RESERVED FOR LIST
12386
12387 ]
12388
12389 EBKCOD==.               ;END BLANK CODING
12390 .YSTGW
12391
12392 PRINTA ST = ,\.-RL0
12393
12394 ST:     ;SYMBOL TABLE 3 WORDS/SYM FIRST SQUOZE, SECOND "VALUE", 3RD FLAGS,,BLOCK.
12395         BLOCK NRMWPS*SYMDSZ
12396
12397 ;LITERALS TABLES - CAN MOVE AND GROW. THESE TAGS & LENGTHS ARE JUST THE DEFAULTS
12398 .SEE CONTBA ;ETC, WHICH CONTAIN THE ACTUAL ADDRESSES.           SO DON'T USE THEM!
12399 CONTAB: BLOCK LCONTB    ;CONSTANTS TABLE, VALUES OF CONSTANTS THIS CONSTANTS AREA
12400 CONGLO: BLOCK LCNGLO    ;CONSTANTS GLOBAL TABLE, EACH ENTRY TWO WORDS
12401         ;FIRST WD GLOTB ENTRY.  SECOND WD ADR IN CONTAB OF CONSTANT TO WHICH IT REFERS
12402 CONBIT: BLOCK LCONTB/12.+1      ;RELOCATION BITS AND ILNOPT BIT(SEE CPTMK)
12403                                 ;3 BITS FOR EACH WORD OF CONTAB.
12404 \f
12405 ;;INIT          ;INITIALIZATION ROUTINES (IN MACRO TABLE, GET WIPED OUT)
12406 IFN ITSSW,MINMAC==./2000        ;# OF 1ST PAGE HOLDING PART OF MACTAB.
12407 ;NOTE THAT THIS CODE IS COPIED UPWARD WHEN MACTAB IS MOVED
12408 ;DUE TO SYMTAB EXPANSION. THEREFOR IT MUST REFER TO ITSELF
12409 ;INDEXED BY THE OFFSET OF WHERE IT IS FROM WHERE IT WAS ASSEMBLED.
12410 ;THAT IS KEPT IN CH1. ALL LITERALS MUST BE USED INDEX OF CH1, TOO.
12411
12412 ;MAC PROC TABLES
12413 MACTBA: 773767750000    ;MACRO CHARACTER STORAGE (FIRST WORD 3 375'S)
12414 INIT1:  MOVE CH1,MACTAD ;GET ADDR THIS COODE REALLY STARTS AT.
12415         SUBI CH1,MACTBA ;GET OFFSET FROM WHERE ASSEMBLED.
12416         SETZM BBKCOD
12417         MOVE A,[BBKCOD,,BBKCOD+1](CH1)
12418         BLT A,EBKCOD-1  ;CLEAR OUT BLANK CODING
12419         PUSH P,[SP4](CH1)       ;NOW INIT THE SYMTAB & FINISHED.
12420
12421 ;INITIALIZE THE SYMTAB, EXPECT SIZE IN SYMLEN.
12422 INITS:  MOVE AA,SYMLEN  ;SET UP THE OTHER VARS
12423         IMUL AA,WPSTE   ;DEALING WITH SYMTAB SIZE.
12424         MOVEM AA,SYMSIZ
12425         ADDI AA,ST      ;ADDR OF START OF CONTAB.
12426         MOVEM AA,CONTBA
12427         MOVEM AA,PLIM
12428         ADD AA,CONLEN   ;ADD LENGTH OF CONTAB TO GET ADDR OF CONGLO TAB.
12429         MOVEM AA,CONTBE ;WHICH IS ALSO THE END OF CONTAB.
12430         MOVEM AA,CONGLA
12431         MOVEM AA,CONGOL
12432         MOVE A,CONLEN   ;ADD IN LENGTH OF CONGLO (1/4 OF CONLEN)
12433         LSH A,-2
12434         ADD AA,A
12435         MOVEM AA,CONGLE ;TO GET END OF CONGLO, AND START OF CONBIT TABLE.
12436         MOVEM AA,CONBIA
12437         MOVE A,CONLEN
12438         ADDI A,11.
12439         IDIVI A,12.
12440         ADD AA,A        ;ADD LENGTH OF CONBIT (1/12 OF CONLEN) GETTING ADDR OF MACTAB.
12441 IFN DECSW,[
12442         SAVE AA
12443         ADDI AA,MACL-1
12444         IORI AA,1777    ;FIX ALLOCATION PROBLEMS ON KI-10
12445         CORE AA,
12446          ETF [ASCIZ /No core for symbols/](CH1)
12447         REST AA
12448 ]
12449         MOVN A,SYMLEN
12450         HRLZM A,SYMAOB  ;AOBJN -> SYMTAB.
12451         MOVE A,WPSTE
12452         SUBI A,1
12453         MOVEM A,WPSTE1
12454         MOVN A,WPSTE
12455         HRRM A,WPSTEB
12456         CAMG AA,MACTAD  ;MOVED MACTAB UP?
12457          JRST INITS1(CH1)
12458 IFN ITSSW,[             ;YES, GET CORE FOR INCREASE.
12459         SAVE AA
12460         MOVEI AA,MACL+1777(AA)
12461         LSH AA,-10.     ;1ST PAGE NOT NEEDED BY MACTAB.
12462         MOVEI A,MACL+1777+MACTBA(CH1)
12463         LSH A,-10.      ;1ST PAGE MACTAB DOESN'T YET HAVE.
12464         SUBM A,AA       ;# PAGES NEEDED.
12465         HRLZI AA,(AA)
12466         HRRI AA,(A)     ;-<# PAGES>,,<1ST NEEDED>
12467         JUMPGE AA,.+3(CH1)      ;DON'T CALL IF NEED 0 PAGES, WOULD GET ONE.
12468         .CALL INITSB(CH1)
12469          .VALUE
12470         REST AA
12471 ]
12472         SUBM AA,MACTAD  ;MACTAD _ SHIFT IN START OF MACTAB.
12473         EXCH AA,MACTAD  ;MACTAD GETS NEW START, AA HAS SHIFT.
12474         MOVSI A,PTAB-CCOMPB
12475         ADDM AA,PTAB(A) ;RELOCATE BYTE-PTRS INTO MACTAB.
12476         AOBJN A,.-1(CH1)
12477         MOVNI B,INITS2(CH1)
12478         HRROI A,@EISYMP(CH1)
12479         ADDI B,1(A)     ;GET # WDS IN SECOND HALF OF INIT CODE.
12480         HRRM AA,.+1(CH1)        ;COPY 2ND HALF UPWARD WITH POP-LOOP.
12481         POP A,(A)       ;THIS INSN IMPURE.
12482         SOJG B,.-1(CH1)
12483         ADDI CH1,(AA)   ;CHANGE OFFSET TO PT. TO NEW LOCATIONN OF INIT CODE.
12484         JRST INITS2(CH1)        ;JUMP INTO 2ND HALF, WHERE IT'S BEEN COPIED TO.
12485 INITS2: HRROI A,INITS2-1(CH1)   ;THEN COPY 1ST HALF (WHICH ENNDS BEFORE INITS2)
12486         SUBI A,(AA)             ;GET WHERE NOW ENDS, NOT WHERE WILL END.
12487         MOVEI B,INITS2-MACTBA   ;UP UNDERNEATH THE 2ND HALF.
12488         HRRM AA,.+1(CH1)        ;(THIS TWO-STEP COPYING HANDLES ALL OVERLAPS)
12489         POP A,(A)
12490         SOJG B,.-1(CH1)
12491 INITS1: MOVE AA,SYMSIZ
12492         SETZM ST
12493         MOVE A,[ST,,ST+1](CH1)
12494         BLT A,ST-1(AA)  ;CLEAR OUT SYMBOL TABLE
12495         SETZM ESBK      ;DEFINE THEM IN OUTER BLOCK.
12496         MOVEI AA,ISYMTB(CH1)
12497         MOVS F,ISMTBB(CH1)      ;GET SWAPPED VALUE OF FIRST INSTRUCTION
12498 SP3:    CAIL AA,EISYM1(CH1)
12499         JRST SP1(CH1)   ;DONE WITH INSTRUCTIONS
12500         MOVE SYM,(AA)
12501         JUMPE SYM,SP2(CH1)
12502         TLZ SYM,740000
12503         PUSHJ P,ES      ;WON'T SKIP
12504         HRLZI T,SYMC
12505         HRLZ B,F
12506         MOVSI C,3KILL
12507         PUSH P,CH1
12508         PUSHJ P,VSM2
12509         POP P,CH1
12510 SP2:    ADDI F,1000
12511         AOJA AA,SP3(CH1)
12512 EISYMP:         ;MAY BE MUNGED
12513 SP1:    CAIL AA,EISYMT(CH1)
12514         POPJ P,
12515         MOVE SYM,(AA)
12516         LDB T,[400400,,SYM](CH1)
12517         ROT T,-4
12518         TLZ SYM,740000
12519         PUSHJ P,ES
12520         MOVE B,1(AA)
12521         MOVSI C,3KILL
12522         CAME T,[GLOETY,,](CH1)  ;GLOBAL ENTRIES REALLY EXITS, HACKED TO DEFEAT ADDRESS LINKING
12523         CAMN T,[GLOEXT,,](CH1)
12524         TLO C,3LLV
12525         PUSH P,CH1
12526         PUSHJ P,VSM2
12527         POP P,CH1
12528         AOS AA
12529         AOJA AA,SP1(CH1)
12530 \f
12531 IFN ITSSW,[
12532 INITSB: SETZ ? 'CORBLK
12533         1000,,600000    ;BOTH READ AND WRITE.
12534         1000,,-1 ? AA   ;INTO SELF, AA IS AOBJN -> PAGES.
12535         SETZI 400001    ;FRESH PAGES.
12536
12537         ;GOBBLE SYMS FROM SYSTEM
12538         ;TABLE AREA IN SYSTEM:
12539         ;FIRST LOC SYSYMB
12540         ;LAST (AS OPPOSED TO LAST + 1) SYSYME
12541
12542 TSYMGT: MOVE AA,[MXICLR-MXIMAC,,MXICLR]
12543         .CALL INITSB    ;GET MACTAB PAGES NNOT LOADED INTO.
12544          .VALUE
12545 IFN PURESW,[
12546         MOVE AA,[MINBNK-MINMAC,,MINBNK]
12547         .CALL INITSB    ;GET PAGES FOR BLANK CODE & SYMTAB.
12548          .VALUE
12549         SKIPN PURIFG
12550          JRST TSYMG3
12551         JSP F,PURIFD    ;NOT PURIFIED => FLUSH PAGES
12552          MINPUR-MXIMAC  ;OF MACTAB CREATED BY LOADING BUT NOT NEEDED.
12553          MXIMAC*1001
12554 TSYMG3:
12555 ]
12556         MOVEI A,EISYMT  ;EISYMT FIRST LOC FOR ITS SYMS
12557         MOVE B,[SIXBIT /CALLS/] ;SYSTEM CALLS
12558         .GETSYS A,      ;READ IN SYSTEM CALLS (SHOULD SKIP)
12559         .VALUE
12560         SKIPGE A
12561         .VALUE          ;.GETSYS DIDN'T UPDATE AOBJN POINTER
12562         HRRM A,SP1      ;MARK END OF SYMS
12563         ANDI A,-1
12564         CAIL A,MACTBA+MACL
12565          .VALUE         ;MACL TOO SMALL!  INITS MIGHT LOSE.
12566         MOVEI B,EISYMT
12567         MOVEI AA,SYMC_<-18.+4>  ;SQUOZE FLAG FOR SYM
12568 TSYMG2: DPB AA,[400400,,(B)]
12569         ADDI B,2
12570         CAIE B,(A)
12571         JRST TSYMG2
12572         POPJ P,
12573 \f
12574 IFN PURESW,[    ;HERE ARE THE GUTS OF THE PURIFY ROUTINE
12575
12576 PURIFY: SKIPL NVRRUN
12577          .VALUE [ASCIZ /:\eAlready run\e
12578 /]
12579 PURIF1: MOVEI P,17      ;START PDL AT 20
12580         JSP F,PURIFD    ;CALL .CBLK ROUTINE
12581          MINMAC-MINBNK  ;FLUSH BLANK CODE PAGES (INCL. SYM TAB)
12582          MINBNK*1001
12583          MINPUR-MXICLR  ;FLUSH MACTAB PAGES CREATED BY LOAD BUT NOT NNEEDED.
12584          MXICLR*1001
12585          MAXPUR-MINPUR  ;PURIFY PURE PAGES.
12586          400000+MINPUR*1001
12587         SETZM PURIFG    ;SET "PURIFIED" FLAG
12588         MOVE [1,,2]     ;NOW CLEAR OUT REMAINS OF DATA OF SELF
12589         MOVEI 1,0
12590         BLT 40
12591         .VALUE [ASCIZ /:\ePurified\epdump\17 SYS;TS MIDAS\16\e/]
12592
12593 GAPFLS: JSP F,PURIFD    ;FLUSH GAP PAGES CREATED ON INITIAL LOAD.
12594          MINPUR-MXIMAC
12595          MXIMAC*1001
12596         .BREAK 16,300000
12597
12598                 ;JSP F,PURIFD   ;DO A SEQUENCE OF .CBLKS
12599                 ;FOLLOW WITH AN ARBITRARY NUMBER OF PAIRS OF ARGUMENTS
12600                 ;FIRST ARG OF PAIR # PAGES TO PROCESS, MAY BE ZERO
12601                 ;SECOND INITIAL .CBLK AC CONTENTS
12602
12603 PURIFD: MOVE C,(F)      ;GET COUNT
12604         TLNE C,777000   ;CHECK INSTRUCTION PART
12605         JRST (F)        ;INSTRUCTION => RETURN TO IT
12606         JUMPE C,PURID2  ;JUMP IF NO PAGES IN COUNT
12607         MOVE A,1(F)     ;GET INITIAL .CBLK ARG
12608 PURID1: .CBLK A,
12609         .VALUE
12610         ADDI A,1001     ;INCREMENT .CBLK ARG TO NEXT PAGE
12611         SOJG C,PURID1   ;DO IT THE APPROPRIATE NUMBER OF TIMES
12612 PURID2: ADDI F,2
12613         JRST PURIFD
12614
12615 ]               ;END PURESW CONDITIONAL
12616 ]               ;END ITSSW, CONDITIONAL
12617
12618 IFN DECDBG,[
12619 DECDBM: 0
12620 IFE SAILSW,HRLZ A,.JBSYM        ;GET ADDR OF START OF DDT SYMS,
12621 .ELSE HRLZ A,JOBSYM
12622         HRRI A,DECDBB+200       ;LEAVE 200 WD SPACE BEFORE THEM.
12623 IFE SAILSW,[HRRM A,.JBSYM               ;MOVE THEM INTO SPACE PROVIDED
12624         HLRE B,.JBSYM]
12625 .ELSE [HRRM A,JOBSYM
12626         HLRE B,JOBSYM]
12627         MOVMS B
12628         BLT A,DECDBB+177(B)     ;SO THEY WON'T GET IN MACTAB'S WAY.
12629         JRST @DECDBM
12630 ]
12631
12632 CONSTANTS
12633 \f
12634 ;;ISYMS         ;INITIAL SYMBOL TABLE
12635
12636 ADJSP=105_33    ;ALLOW FOR BOOTSTRAP, EVENTUALLY FLUSH, MAYBE
12637
12638 ISMTBB: ADJSP   ;FIRST OP. CODE IN ISYMTB
12639
12640 ISYMTB:
12641
12642 SQUOZE 10,ADJSP
12643         0
12644         0
12645 SQUOZE 10,DFAD
12646 SQUOZE 10,DFSB
12647 SQUOZE 10,DFMP
12648 SQUOZE 10,DFDV
12649 SQUOZE 10,DADD
12650 SQUOZE 10,DSUB
12651 SQUOZE 10,DMUL
12652 SQUOZE 10,DDIV
12653 SQUOZE 10,DMOVE
12654 SQUOZE 10,DMOVN
12655 SQUOZE 10,FIX
12656 SQUOZE 10,EXTEND
12657 SQUOZE 10,DMOVEM
12658 SQUOZE 10,DMOVNM
12659 SQUOZE 10,FIXR
12660 SQUOZE 10,FLTR
12661 SQUOZE 10,UFA
12662 SQUOZE 10,DFN
12663 SQUOZE 10,FSC
12664 SQUOZE 10,IBP
12665 SQUOZE 10,ILDB
12666 SQUOZE 10,LDB
12667 SQUOZE 10,IDPB
12668 SQUOZE 10,DPB
12669 SQUOZE 10,FAD
12670 SQUOZE 10,FADL
12671 SQUOZE 10,FADM
12672 SQUOZE 10,FADB
12673 SQUOZE 10,FADR
12674 SQUOZE 10,FADRL
12675 SQUOZE 10,FADRM
12676 SQUOZE 10,FADRB
12677 SQUOZE 10,FSB
12678 SQUOZE 10,FSBL
12679 SQUOZE 10,FSBM
12680 SQUOZE 10,FSBB
12681 SQUOZE 10,FSBR
12682 SQUOZE 10,FSBRL
12683 SQUOZE 10,FSBRM
12684 SQUOZE 10,FSBRB
12685 SQUOZE 10,FMP
12686 SQUOZE 10,FMPL
12687 SQUOZE 10,FMPM
12688 SQUOZE 10,FMPB
12689 SQUOZE 10,FMPR
12690 \fSQUOZE 10,FMPRL
12691 SQUOZE 10,FMPRM
12692 SQUOZE 10,FMPRB
12693 SQUOZE 10,FDV
12694 SQUOZE 10,FDVL
12695 SQUOZE 10,FDVM
12696 SQUOZE 10,FDVB
12697 SQUOZE 10,FDVR
12698 SQUOZE 10,FDVRL
12699 SQUOZE 10,FDVRM
12700 SQUOZE 10,FDVRB
12701 SQUOZE 10,MOVE
12702 SQUOZE 10,MOVEI
12703 SQUOZE 10,MOVEM
12704 SQUOZE 10,MOVES
12705 SQUOZE 10,MOVS
12706 SQUOZE 10,MOVSI
12707 SQUOZE 10,MOVSM
12708 SQUOZE 10,MOVSS
12709 SQUOZE 10,MOVN
12710 SQUOZE 10,MOVNI
12711 SQUOZE 10,MOVNM
12712 SQUOZE 10,MOVNS
12713 SQUOZE 10,MOVM
12714 SQUOZE 10,MOVMI
12715 SQUOZE 10,MOVMM
12716 SQUOZE 10,MOVMS
12717
12718 SQUOZE 10,IMUL
12719 SQUOZE 10,IMULI
12720 SQUOZE 10,IMULM
12721 SQUOZE 10,IMULB
12722 SQUOZE 10,MUL
12723 SQUOZE 10,MULI
12724 SQUOZE 10,MULM
12725 SQUOZE 10,MULB
12726 SQUOZE 10,IDIV
12727 SQUOZE 10,IDIVI
12728 SQUOZE 10,IDIVM
12729 SQUOZE 10,IDIVB
12730 SQUOZE 10,DIV
12731 SQUOZE 10,DIVI
12732 SQUOZE 10,DIVM
12733 SQUOZE 10,DIVB
12734 SQUOZE 10,ASH
12735 SQUOZE 10,ROT
12736 SQUOZE 10,LSH
12737 SQUOZE 10,JFFO  ;PDP10 INSTRUCTION
12738 SQUOZE 10,ASHC
12739 SQUOZE 10,ROTC
12740 SQUOZE 10,LSHC
12741 SQUOZE 10,CIRC  ;CIRCULATE: ROTC WITH AC+1 GOING THE WRONG WAY
12742 SQUOZE 10,EXCH
12743 SQUOZE 10,BLT
12744 SQUOZE 10,AOBJP
12745 SQUOZE 10,AOBJN
12746 SQUOZE 10,JRST
12747 SQUOZE 10,JFCL
12748 SQUOZE 10,XCT
12749 0
12750 \fSQUOZE 10,PUSHJ
12751 SQUOZE 10,PUSH
12752 SQUOZE 10,POP
12753 SQUOZE 10,POPJ
12754 SQUOZE 10,JSR
12755 SQUOZE 10,JSP
12756 SQUOZE 10,JSA
12757 SQUOZE 10,JRA
12758 SQUOZE 10,ADD
12759 SQUOZE 10,ADDI
12760 SQUOZE 10,ADDM
12761 SQUOZE 10,ADDB
12762 SQUOZE 10,SUB
12763 SQUOZE 10,SUBI
12764 SQUOZE 10,SUBM
12765 SQUOZE 10,SUBB
12766 SQUOZE 10,CAI
12767 SQUOZE 10,CAIL
12768 SQUOZE 10,CAIE
12769 SQUOZE 10,CAILE
12770 SQUOZE 10,CAIA
12771 SQUOZE 10,CAIGE
12772 SQUOZE 10,CAIN
12773 SQUOZE 10,CAIG
12774
12775 SQUOZE 10,CAM
12776 SQUOZE 10,CAML
12777 SQUOZE 10,CAME
12778 SQUOZE 10,CAMLE
12779 SQUOZE 10,CAMA
12780 SQUOZE 10,CAMGE
12781 SQUOZE 10,CAMN
12782 SQUOZE 10,CAMG
12783 SQUOZE 10,JUMP
12784 SQUOZE 10,JUMPL
12785 SQUOZE 10,JUMPE
12786 SQUOZE 10,JUMPLE
12787 SQUOZE 10,JUMPA
12788 SQUOZE 10,JUMPGE
12789 SQUOZE 10,JUMPN
12790 SQUOZE 10,JUMPG
12791 SQUOZE 10,SKIP
12792 SQUOZE 10,SKIPL
12793 SQUOZE 10,SKIPE
12794 SQUOZE 10,SKIPLE
12795 SQUOZE 10,SKIPA
12796 SQUOZE 10,SKIPGE
12797 SQUOZE 10,SKIPN
12798 SQUOZE 10,SKIPG
12799 SQUOZE 10,AOJ
12800 SQUOZE 10,AOJL
12801 SQUOZE 10,AOJE
12802 SQUOZE 10,AOJLE
12803 SQUOZE 10,AOJA
12804 SQUOZE 10,AOJGE
12805 SQUOZE 10,AOJN
12806 SQUOZE 10,AOJG
12807 SQUOZE 10,AOS
12808 SQUOZE 10,AOSL
12809 SQUOZE 10,AOSE
12810 \fSQUOZE 10,AOSLE
12811 SQUOZE 10,AOSA
12812 SQUOZE 10,AOSGE
12813 SQUOZE 10,AOSN
12814 SQUOZE 10,AOSG
12815 SQUOZE 10,SOJ
12816 SQUOZE 10,SOJL
12817 SQUOZE 10,SOJE
12818 SQUOZE 10,SOJLE
12819 SQUOZE 10,SOJA
12820 SQUOZE 10,SOJGE
12821 SQUOZE 10,SOJN
12822 SQUOZE 10,SOJG
12823 SQUOZE 10,SOS
12824 SQUOZE 10,SOSL
12825 SQUOZE 10,SOSE
12826 SQUOZE 10,SOSLE
12827 SQUOZE 10,SOSA
12828 SQUOZE 10,SOSGE
12829 SQUOZE 10,SOSN
12830 SQUOZE 10,SOSG
12831
12832 SQUOZE 10,SETZ
12833 SQUOZE 10,SETZI
12834 SQUOZE 10,SETZM
12835 SQUOZE 10,SETZB
12836 SQUOZE 10,AND
12837 SQUOZE 10,ANDI
12838 SQUOZE 10,ANDM
12839 SQUOZE 10,ANDB
12840 SQUOZE 10,ANDCA
12841 SQUOZE 10,ANDCAI
12842 SQUOZE 10,ANDCAM
12843 SQUOZE 10,ANDCAB
12844 SQUOZE 10,SETM
12845 SQUOZE 10,SETMI
12846 SQUOZE 10,SETMM
12847 SQUOZE 10,SETMB
12848 SQUOZE 10,ANDCM
12849 SQUOZE 10,ANDCMI
12850 SQUOZE 10,ANDCMM
12851 SQUOZE 10,ANDCMB
12852 SQUOZE 10,SETA
12853 SQUOZE 10,SETAI
12854 SQUOZE 10,SETAM
12855 SQUOZE 10,SETAB
12856 SQUOZE 10,XOR
12857 SQUOZE 10,XORI
12858 SQUOZE 10,XORM
12859 SQUOZE 10,XORB
12860 SQUOZE 10,IOR
12861 SQUOZE 10,IORI
12862 SQUOZE 10,IORM
12863 SQUOZE 10,IORB
12864 SQUOZE 10,ANDCB
12865 SQUOZE 10,ANDCBI
12866 SQUOZE 10,ANDCBM
12867 SQUOZE 10,ANDCBB
12868 SQUOZE 10,EQV
12869 SQUOZE 10,EQVI
12870 \fSQUOZE 10,EQVM
12871 SQUOZE 10,EQVB
12872 SQUOZE 10,SETCA
12873 SQUOZE 10,SETCAI
12874 SQUOZE 10,SETCAM
12875 SQUOZE 10,SETCAB
12876 SQUOZE 10,ORCA
12877 SQUOZE 10,ORCAI
12878 SQUOZE 10,ORCAM
12879 SQUOZE 10,ORCAB
12880 SQUOZE 10,SETCM
12881 SQUOZE 10,SETCMI
12882 SQUOZE 10,SETCMM
12883 SQUOZE 10,SETCMB
12884
12885 SQUOZE 10,ORCM
12886 SQUOZE 10,ORCMI
12887 SQUOZE 10,ORCMM
12888 SQUOZE 10,ORCMB
12889 SQUOZE 10,ORCB
12890 SQUOZE 10,ORCBI
12891 SQUOZE 10,ORCBM
12892 SQUOZE 10,ORCBB
12893 SQUOZE 10,SETO
12894 SQUOZE 10,SETOI
12895 SQUOZE 10,SETOM
12896 SQUOZE 10,SETOB
12897 SQUOZE 10,HLL
12898 SQUOZE 10,HLLI
12899 SQUOZE 10,HLLM
12900 SQUOZE 10,HLLS
12901 SQUOZE 10,HRL
12902 SQUOZE 10,HRLI
12903 SQUOZE 10,HRLM
12904 SQUOZE 10,HRLS
12905 SQUOZE 10,HLLZ
12906 SQUOZE 10,HLLZI
12907 SQUOZE 10,HLLZM
12908 SQUOZE 10,HLLZS
12909 SQUOZE 10,HRLZ
12910 SQUOZE 10,HRLZI
12911 SQUOZE 10,HRLZM
12912 SQUOZE 10,HRLZS
12913 SQUOZE 10,HLLO
12914 SQUOZE 10,HLLOI
12915 SQUOZE 10,HLLOM
12916 SQUOZE 10,HLLOS
12917 SQUOZE 10,HRLO
12918 SQUOZE 10,HRLOI
12919 SQUOZE 10,HRLOM
12920 SQUOZE 10,HRLOS
12921 SQUOZE 10,HLLE
12922 SQUOZE 10,HLLEI
12923 SQUOZE 10,HLLEM
12924 SQUOZE 10,HLLES
12925 SQUOZE 10,HRLE
12926 SQUOZE 10,HRLEI
12927 SQUOZE 10,HRLEM
12928 SQUOZE 10,HRLES
12929 SQUOZE 10,HRR
12930 \fSQUOZE 10,HRRI
12931 SQUOZE 10,HRRM
12932 SQUOZE 10,HRRS
12933 SQUOZE 10,HLR
12934 SQUOZE 10,HLRI
12935 SQUOZE 10,HLRM
12936 SQUOZE 10,HLRS
12937
12938 SQUOZE 10,HRRZ
12939 SQUOZE 10,HRRZI
12940 SQUOZE 10,HRRZM
12941 SQUOZE 10,HRRZS
12942 SQUOZE 10,HLRZ
12943 SQUOZE 10,HLRZI
12944 SQUOZE 10,HLRZM
12945 SQUOZE 10,HLRZS
12946 SQUOZE 10,HRRO
12947 SQUOZE 10,HRROI
12948 SQUOZE 10,HRROM
12949 SQUOZE 10,HRROS
12950 SQUOZE 10,HLRO
12951 SQUOZE 10,HLROI
12952 SQUOZE 10,HLROM
12953 SQUOZE 10,HLROS
12954 SQUOZE 10,HRRE
12955 SQUOZE 10,HRREI
12956 SQUOZE 10,HRREM
12957 SQUOZE 10,HRRES
12958 SQUOZE 10,HLRE
12959 SQUOZE 10,HLREI
12960 SQUOZE 10,HLREM
12961 SQUOZE 10,HLRES
12962 SQUOZE 10,TRN
12963 SQUOZE 10,TLN
12964 SQUOZE 10,TRNE
12965 SQUOZE 10,TLNE
12966 SQUOZE 10,TRNA
12967 SQUOZE 10,TLNA
12968 SQUOZE 10,TRNN
12969 SQUOZE 10,TLNN
12970 SQUOZE 10,TDN
12971 SQUOZE 10,TSN
12972 SQUOZE 10,TDNE
12973 SQUOZE 10,TSNE
12974 SQUOZE 10,TDNA
12975 SQUOZE 10,TSNA
12976 SQUOZE 10,TDNN
12977 SQUOZE 10,TSNN
12978 SQUOZE 10,TRZ
12979 SQUOZE 10,TLZ
12980 SQUOZE 10,TRZE
12981 SQUOZE 10,TLZE
12982 SQUOZE 10,TRZA
12983 SQUOZE 10,TLZA
12984 SQUOZE 10,TRZN
12985 SQUOZE 10,TLZN
12986 SQUOZE 10,TDZ
12987 SQUOZE 10,TSZ
12988 SQUOZE 10,TDZE
12989 SQUOZE 10,TSZE
12990 \f
12991 SQUOZE 10,TDZA
12992 SQUOZE 10,TSZA
12993 SQUOZE 10,TDZN
12994 SQUOZE 10,TSZN
12995
12996 SQUOZE 10,TRC
12997 SQUOZE 10,TLC
12998 SQUOZE 10,TRCE
12999 SQUOZE 10,TLCE
13000 SQUOZE 10,TRCA
13001 SQUOZE 10,TLCA
13002 SQUOZE 10,TRCN
13003 SQUOZE 10,TLCN
13004 SQUOZE 10,TDC
13005 SQUOZE 10,TSC
13006 SQUOZE 10,TDCE
13007 SQUOZE 10,TSCE
13008 SQUOZE 10,TDCA
13009 SQUOZE 10,TSCA
13010 SQUOZE 10,TDCN
13011 SQUOZE 10,TSCN
13012 SQUOZE 10,TRO
13013 SQUOZE 10,TLO
13014 SQUOZE 10,TROE
13015 SQUOZE 10,TLOE
13016 SQUOZE 10,TROA
13017 SQUOZE 10,TLOA
13018 SQUOZE 10,TRON
13019 SQUOZE 10,TLON
13020 SQUOZE 10,TDO
13021 SQUOZE 10,TSO
13022 SQUOZE 10,TDOE
13023 SQUOZE 10,TSOE
13024 SQUOZE 10,TDOA
13025 SQUOZE 10,TSOA
13026 SQUOZE 10,TDON
13027 SQUOZE 10,TSON
13028
13029 EISYM1:
13030 SQUOZE 4,BLKI
13031 BLKI IOINST
13032 SQUOZE 4,DATAI
13033 DATAI IOINST
13034 SQUOZE 4,BLKO
13035 BLKO IOINST
13036 SQUOZE 4,DATAO
13037 DATAO IOINST
13038 SQUOZE 4,CONO
13039 CONO IOINST
13040 SQUOZE 4,CONI
13041 CONI IOINST
13042 SQUOZE 4,CONSZ
13043 CONSZ IOINST
13044 SQUOZE 4,CONSO
13045 CONSO IOINST
13046 \f
13047 SQUOZE 10,APR
13048 0
13049 SQUOZE 10,PI
13050 4
13051 SQUOZE 10,PTP
13052 100
13053 SQUOZE 10,PTR
13054 104
13055 SQUOZE 10,TTY
13056 120
13057 SQUOZE 10,LPT
13058 124
13059 SQUOZE 10,DIS
13060 130
13061 SQUOZE 10,DC
13062 200
13063 SQUOZE 10,UTC
13064 210
13065 SQUOZE 10,UTS
13066 214
13067
13068
13069 SQUOZE 10,LDBI  ;REALLY ILDB,
13070 LDBI
13071 SQUOZE 10,DPBI  ;AND IDPB
13072 DPBI
13073 SQUOZE 10,CLEAR
13074 CLEAR
13075 SQUOZE 10,CLEARI
13076 CLEARI
13077 SQUOZE 10,CLEARM
13078 CLEARM
13079 SQUOZE 10,CLEARB
13080 CLEARB
13081 SQUOZE 10,ADJBP
13082 IBP
13083 IRPS INST,,FAD FSB FMP FDV
13084 SQUOZE 10,INST!RI
13085 INST!RL
13086 TERMIN
13087 \f
13088 IFN DECSW\TNXSW,[
13089 IFE TNXSW,[
13090 DEFINE DECDF1 FOO/
13091 IRPS X,,FOO
13092 SQUOZE 10,X
13093 X
13094 .ISTOP TERMIN TERMIN
13095 ]
13096 IFN TNXSW,[;; RESET IS BOTH A JSYS AND A CALLI!!
13097 DEFINE DECDF1 FOO/
13098 IRPS X,,FOO
13099 IFSN X,RESET,[SQUOZE 10,X
13100 X]
13101 .ISTOP TERMIN TERMIN
13102 ]
13103 .DECUU DECDF1
13104 .DECTT DECDF1
13105 IFE SAILSW,.DECMT DECDF1
13106 .DECCL DECDF1
13107 IFN SAILSW,.DECMS DECDF1
13108 IFE SAILSW,.DEC.J DECDF1
13109 IFN SAILSW,.DECJB DECDF1
13110 .DECJH DECDF1
13111
13112 IFN TNXSW,[;; DEFINE JSYS'S ON TENEX VERSION
13113 DEFINE TNXDF1 FOO/
13114 IRPS X,,FOO
13115 SQUOZE 10,X
13116 X
13117 .ISTOP TERMIN TERMIN
13118 .TNXJS TNXDF1
13119 ]]
13120 SQUOZE 10,.OSMID
13121 OSMIDAS
13122 SQUOZEE 4,.SITE
13123 A.SITE
13124 SQUOZE 4,RIM10
13125 ARIM10,,SRIM
13126 SQUOZE 4,SBLK
13127 SBLKS,,SRIM
13128 SQUOZE 4,RIM
13129 ARIM,,SRIM
13130 SQUOZE 4,SQUOZE
13131 ASQOZ
13132 SQUOZE 4,.RSQZ
13133 -1,,ASQOZ
13134 SQUOZE 4,XWD
13135 AXWORD
13136 SQUOZE 4,CONSTA
13137 CNSTNT
13138 SQUOZE 4,ASCIC
13139 EOFCH,,AASCIZ
13140 SQUOZE 4,RADIX
13141 ARDIX
13142
13143 SQUOZE 4,END
13144 AEND
13145 SQUOZE 4,TITLE
13146 ATITLE
13147 SQUOZE 4,.BEGIN
13148 A.BEGIN
13149 SQUOZE 4,.END
13150 A.END
13151 SQUOZE 4,VARIAB
13152 AVARIAB
13153 SQUOZE 4,SIXBIT
13154 ASIXBIT
13155 SQUOZE 4,ASCII
13156 AASCII
13157 SQUOZE 4,ASCIZ
13158 AASCIZ
13159 SQUOZE 4,.ASCII
13160 A.ASCII
13161 SQUOZE 4,.ASCVL
13162 A.ASCV
13163 SQUOZE 4,BLOCK
13164 ABLOCK
13165 SQUOZE 4,LOC
13166 ALOC
13167 SQUOZE 4,OFFSET
13168 AOFFSET
13169 SQUOZE 4,.SBLK
13170 SIMBLK
13171 SQUOZE 4,RELOCA
13172 ARELOCA
13173 SQUOZE 4,1PASS
13174 A1PASS
13175 SQUOZE 4,.DECRE
13176 A.DECRE
13177 SQUOZE 4,.DECTX
13178 A.DCTX
13179 \f
13180 SQUOZE 4,.DECTW
13181 A.DECTW
13182 SQUOZE 4,NOSYMS
13183 ANOSYMS
13184 SQUOZE 4,EXPUNGE
13185 AEXPUNGE
13186 SQUOZE 4,EQUALS
13187 AEQUALS
13188 SQUOZE 4,NULL
13189 ANULL
13190 SQUOZE 4,SUBTTL
13191 ANULL
13192 SQUOZE 4,WORD
13193 AWORD
13194 SQUOZE 4,.SYMTAB
13195 A.SYMTAB
13196 SQUOZE 4,.SEE
13197 A.SEE
13198 SQUOZE 4,.AUXIL
13199 MACCR
13200 SQUOZE 4,.MRUNT
13201 A.MRUNT
13202 SQUOZE 4,.SYMCN
13203 A.SYMC
13204 SQUOZE 4,.TYPE
13205 A.TYPE
13206 SQUOZE 4,.FORMAT
13207 A.FORMAT
13208 SQUOZE 4,.OP
13209 A.OP
13210 SQUOZE 4,.AOP
13211 A.AOP
13212 SQUOZE 4,.RADIX
13213 A.RADIX
13214 SQUOZE 4,.FATAL
13215 A.FATAL
13216 SQUOZE 4,.BP
13217 A.BP
13218 SQUOZE 4,.BM
13219 A.BM
13220 SQUOZE 4,.LZ
13221 A.LZ
13222 SQUOZE 4,.TZ
13223 A.TZ
13224 SQUOZE 4,.DPB
13225 A.DPB
13226 SQUOZE 4,.LDB
13227 A.LDB
13228 SQUOZE 4,.1STWD
13229 A.1STWD
13230 SQUOZE 4,.NTHWD
13231 A.NTHWD
13232
13233 IRPS X,,[.BIND=0,.KILL=3KILL,.HKILL=3SKILL,.XCREF=3NCRF,.DOWN=3DOWN]
13234 IFE 1&.IRPCN, SQUOZE 4,X
13235 IFN 1&.IRPCN, X,,A.KILL
13236 TERMIN
13237
13238 SQUOZE 4,.LSTON
13239 A.LSTN
13240 SQUOZE 4,.LSTOF
13241 A.LSTF
13242
13243 IRPS X,,[.MLLIT=CONSML,.PASS=A.PASS,.PPASS=A.PPASS,.SUCCESS=A.SUCCESS
13244 .HKALL=HKALL,.STGSW=STGSW,.LITSW=LITSW,.AVAL1=AVAL1,.AVAL2=AVAL2
13245 .ASKIP=A.ASKIP,.CURLN=CLNN,.CURPG=CPGN,.QMTCH=QMTCH,.STPLN=A.STPLN,.STPPG=A.STPPG]
13246 IFE 1&.IRPCN, SQUOZE 4,X
13247 IFN 1&.IRPCN, X,,INTSYM
13248 TERMIN
13249 \f
13250         ;CONDITIONALS (SEE ALSO IFSE, IFSN)
13251 SQUOZE 4,IFG
13252 JUMPG A,COND
13253 SQUOZE 4,IFGE
13254 JUMPGE A,COND
13255 SQUOZE 4,IFE
13256 JUMPE A,COND
13257 SQUOZE 4,IFLE
13258 JUMPLE A,COND
13259 SQUOZE 4,IFL
13260 JUMPL A,COND
13261 SQUOZE 4,IFN
13262 JUMPN A,COND
13263 SQUOZE 4,.ELSE
13264 SKIPE A.ELSE
13265 SQUOZE 4,.ALSO
13266 SKIPN A.ELSE
13267
13268 SQUOZE 4,IF1
13269 TRNE FF,COND1
13270 SQUOZE 4,IF2
13271 TRNN FF,COND1
13272 SQUOZE 4,IFDEF  ;ASSEMBLE IF SYM DEFINED
13273 JUMPG A,DEFCND
13274 SQUOZE 4,IFNDEF ;ASSEMBLE IF SYM NOT DEFINED
13275 JUMPE A,DEFCND
13276 SQUOZE 4,IFB    ;ASSEMBLE IF STRING BLANK (HAS NO SQUOZE CHARS)
13277 JUMPLE C,SBCND
13278 SQUOZE 4,IFNB   ;ASSEMBLE IF STRING NOT BLANK
13279 JUMPG C,SBCND
13280 SQUOZE 4,IFSQ   ;ASSEMBLE IF STRING ARG IS ALL SQUOZE
13281 JUMPLE B,SBCND
13282 SQUOZE 4,IFNSQ  ;ASSEMBLE IF STRING ARG IS NOT ALL SQUOZE.
13283 JUMPG B,SBCND
13284
13285 SQUOZE 4,PRINTX
13286 APRIN2,,APRINT
13287 SQUOZE 4,PRINTC
13288 APRIN3,,APRINT
13289 SQUOZE 4,COMMEN
13290 APRIN1,,APRINT
13291 SQUOZE 4,.TYO
13292 A.TYO
13293 SQUOZE 4,.TYO6
13294 A.TYO6
13295 SQUOZE 4,.ERR
13296 A.ERR
13297
13298 SQUOZE 4,.RELP
13299 A.RELP
13300 SQUOZE 4,.ABSP
13301 A.ABSP
13302 SQUOZE 4,.RL1
13303 A.RL1
13304 SQUOZE 4,.LIBRA
13305 LLIB,,A.LIB
13306 SQUOZE 4,.LENGTH
13307 A.LENGTH
13308 SQUOZE 4,.LIFS
13309 LTCP,,A.LIB
13310 SQUOZE 4,.ELDC
13311 A.ELDC
13312 IRPS A,,E N G LE GE L
13313 SQUOZE 4,.LIF!A
13314 JUMP!A A.LDCV
13315 TERMIN
13316 SQUOZE 4,.SLDR
13317 A.SLDR
13318 \f
13319 SQUOZE 4,.
13320 GTVLP
13321 SQUOZE 4,.LOP
13322 A.LOP
13323 SQUOZE 40,$.
13324 0
13325 SQUOZE 44,$R.
13326 0
13327 SQUOZE 40,$O.   ;(OH) GLOBAL OFFSET
13328 0
13329 SQUOZE 40,$L.   ;REAL LOCATION (WITHOUT OFFSET)
13330 0
13331 SQUOZE 40,.LVAL1
13332 0
13333 SQUOZE 40,.LVAL2
13334 0
13335 SQUOZE 4,.LNKOT
13336 A.LNKOT
13337 SQUOZE 4,.NSTGW
13338 1,,STGWS
13339 SQUOZE 4,.YSTGW
13340 -1,,STGWS
13341 SQUOZE 4,.LIBRQ
13342 A.LIBRQ
13343 SQUOZE 4,.GLOBAL
13344 ILGLI,,A.GLOB
13345 SQUOZE 4,.SCALAR
13346 ILVAR,,A.GLOB
13347 SQUOZE 4,.VECTOR
13348 ILVAR\ILFLO,,A.GLOB
13349
13350 SQUOZE 4,.BYTC
13351 NBYTS,,INTSYM
13352 SQUOZE 4,.BYTE
13353 A.BYTE
13354 SQUOZE 4,.WALGN
13355 A.WALGN
13356
13357 ;CREF PSEUDO-OPS.
13358 SQUOZE 4,.CRFON
13359 A.CRFN          ;START CREFFING.
13360 SQUOZE 4,.CRFOFF
13361 A.CRFFF ;STOP CREFFING.
13362 SQUOZE 4,.CRFIL
13363 CRFILE,,INTSYM
13364
13365 IFE CREFSW,[
13366         A.CRFN==ASSEM1  ;THESE DO NOTHING IF CAN'T CREF.
13367         A.CRFFF==ASSEM1
13368 ]
13369 \f
13370 IFN MACSW,[     ;MACRO PROCESSOR PSEUDOS
13371 ;MACROS GET DEFINED AS
13372 ;SQUOZE 4, <MACRO NAME>
13373 ;<CHAR ADR>,, MACCL
13374
13375 SQUOZE 4,REPEAT
13376 AREPEAT
13377 SQUOZE 4,DEFINE
13378 ADEFINE
13379 SQUOZE 4,IRP
13380 NIRPO,,AIRP
13381 SQUOZE 4,IRPC
13382 NIRPC,,AIRP
13383 SQUOZE 4,IRPS
13384 NIRPS,,AIRP
13385 SQUOZE 4,IRPW
13386 NIRPW,,AIRP
13387 SQUOZE 4,IRPNC
13388 NIRPN,,AIRP
13389 SQUOZE 4,TERMIN
13390 ATERMIN
13391 SQUOZE 4,.QUOTE
13392 A.QOTE
13393 SQUOZE 4,.STOP
13394 (400000)A.STOP
13395 SQUOZE 4,.ISTOP
13396 A.STOP
13397 SQUOZE 4,.RPCNT
13398 CRPTCT,,INTSYM
13399 SQUOZE 4,.GSSET
13400 A.GSSET
13401 SQUOZE 4,.GSCNT
13402 GENSM,,INTSYM
13403 SQUOZE 4,.GO
13404 A.GO
13405 SQUOZE 4,.TAG
13406 A.TAG
13407 SQUOZE 4,.IRPCNT
13408 CIRPCT,,INTSYM
13409 IFN RCHASW,[SQUOZE 4,.TTYMAC
13410 A.TTYM
13411 ]
13412 SQUOZE 4,IFSE
13413 SKIPN SCOND
13414 SQUOZE 4,IFSN
13415 SKIPE SCOND
13416 ]
13417
13418 IFN FASLP,[
13419 SQUOZE 4,.FASL
13420 A.FASL
13421 SQUOZE 4,.ARRAY ;3 INDEX TO AFDMY1 TBL
13422 AFATOM(3)
13423 SQUOZE 4,.ATOM
13424 AFATOM(AFDMAI)  ;2 INDEX TO AFDMY1 TBL
13425 AFDMAI==2       ;INDEX OF ATOM IN AFDMY1 TBL
13426 SQUOZE 4,.FUNCT
13427 AFATOM(1)       ;1   "   "    "     "
13428 SQUOZE 4,.SPECI
13429 AFATOM(0)       ;0   "   "    "     "
13430 SQUOZE 4,.SX
13431 AFLIST(1)       ;NORMAL LIST
13432 SQUOZE 4,.SXEVA
13433 AFLIST          ;EVAL LIST AND THROW VALUE AWAY
13434 SQUOZE 4,.SXE
13435 AFLIST(2)       ;EVAL LIST AND "RETURN" VALUE
13436 SQUOZE 4,.ENTRY
13437 AFENTY          ;DECLARE LISP ENTRY POINT  (SUBR ETC)
13438 ]
13439 \f
13440 IFN TS,[
13441 SQUOZE 4,.FNAM1
13442 RFNAM1,,INTSYM
13443 SQUOZE 4,.FNAM2
13444 RFNAM2,,INTSYM
13445 SQUOZE 4,.INSRT
13446 A.INSRT
13447 SQUOZE 4,.INEOF
13448 A.INEO
13449 IRPS X,,I O
13450 IRPS Y,,1 2
13451 SQUOZE 4,.!X!FNM!Y
13452 X!FNM!Y,,INTSYM
13453 TERMIN TERMIN
13454 SQUOZE 4,.TTYFLG
13455 A.TTYFLG,,INTSYM
13456 ]
13457 IFN .I.FSW,[
13458 SQUOZE 4,.F
13459 A.F
13460 SQUOZE 4,.I
13461 A.I
13462 ]
13463 IFN TSSYMS,[
13464 IRPS X,,UAI UAO BAI BAO UII UIO BII BIO
13465 SQUOZE 10,.!X
13466 .IRPCN
13467 TERMIN
13468
13469 IRPS X,Y,START LFILE STP+SYM JCL PFILE STB CONV+XUNAME
13470         SQUOZE 10,..R!X
13471         .IRPCN+1
13472 IFSN Y,+,[
13473         SQUOZE 10,..S!X
13474         400000+.IRPCN+1
13475 ] TERMIN
13476 ]
13477
13478 EISYMT: PRINTA \.-MACTBA-1, words initialization coding.
13479 IFN DECSW,[
13480 IFNDEF MACL,MACL=.+5-MACTBA
13481 IFGE .-MACTBA-MACL,.ERR MACL TOO SMALL
13482 ]
13483
13484 IFN ITSSW,[
13485 IFGE .+2400-MACTBA-MACL,.ERR MACL TOO SMALL
13486         LOC <.+1777>&-2000
13487 MXICLR==./2000  ;FIRST PAGE ABOVE INITIALIZING CODING
13488         LOC <MACTBA+MACL+1777>&-2000
13489 MXIMAC==./2000  ;FIRST PAGE ABOVE INITIAL MACTBA
13490 MAXMAC==<CONMAX+CONMAX/4+CONMAX/12+1+MXMACL+SYMMAX*MAXWPS+ST+1777>/2000
13491         ;1ST PAGE MACRO TABLE CAN'T POSSIBLY USE.
13492 IFLE MINPUR-MAXMAC,.ERR PURE TOO LOW.
13493 PRINTA MINPUR-MAXMAC = ,\MINPUR-MAXMAC
13494 ]
13495
13496 IFN TS,END BEG  ;MUST BE BEFORE RELOCATABLE END STATEMENT,
13497                 ;SINCE TS MIDAS NOW TRIES TO DO MULTIPLE 1PASS ASSEMBLIES FROM SAME FILE.
13498                 ;PUTTING RELOCABLE END STATEMENT FIRST CAUSES IT TO ENCOUNTER OTHER
13499                 ;END STATEMENT IN NEW ASSEMBLY CAUSING CONFUSION
13500
13501 END 100