<mdl.int>/stink.2

   1 TITLE TSTINKING ODOR
   2
   3 ITS==1                  ; FLAG SAYING WHETHER FOR ITS OR 20
   4
   5 IFE ITS,.INSRT MUDSYS;STENEX >
   6
   7 ZR=0
   8 P=1
   9 A=2
  10 B=3
  11 C=4     ;FOR L.OP
  12 D=5
  13 T=6
  14 TT=7
  15 ADR=10
  16 BOT=11
  17 CKS=12
  18 LL=13
  19 RH=14
  20 MEMTOP=15
  21 NBLKS=16
  22 FF=17
  23
  24 ;I/O CHANNELS
  25
  26 TPCHN==1
  27 TYOC==2
  28 TYIC==3
  29 ERCHN==4        ;CHANNEL FOR ERROR DEVICE
  30
  31 ;RIGHT HALF FLAGS
  32
  33 ALTF==1
  34 LOSE==2
  35 ARG==4
  36 UNDEF==10       ;COMPLAIN ABOUT UNDEF
  37 INDEF==20       ;GLOBAL LOC
  38 GLOSYM==40      ;ENTER GLOBAL SYMS INTO DDT TABLE
  39 SEARCH==100     ;LIBRARY
  40 CODEF==200      ;SPECIAL WORD LOADED
  41 GPARAM==400     ;ENTER GPA LOCALS
  42 COND==1000      ;LOAD TIME CONDITIONAL
  43 NAME==2000      ;SET JOB NAME TO PROGRAM NAME
  44 LOCF=4000       ;LOCAL IN SYM PRT
  45 JBN==10000      ;JOB NAME SET BY JCOMMAND
  46 GOF==20000      ;LEAVING LDR BY G COMMAND
  47 GETTY==40000    ;GE CONSOLE
  48 MLAST==100000   ;LAST COMMAND WAS AN "M"
  49 NOTNUM==200000  ;USED FOR DUMMY SYMBOL LOGIC
  50 SETDEV==400000  ;DEVICE SET LAST TIME
  51
  52
  53 HSW==1
  54
  55 ;MISCELLANEOUS CONSTANTS
  56
  57 LOWLOD==0       ;LOWEST LOCATION LOADED
  58 LPDL==20
  59 CBUFL==2000     ;COMMAND BUFFER LENGTH (MOBY LONG!)
  60 DOLL==44        ;REAL DOLLAR SIGN (NOT ALT MODE ETC.)
  61 INHASH==151.    ; HASH TABLE LENGTH
  62 ICOMM==10000    ;INITIAL COMMON
  63
  64 PPDL==60        ;POLISH PUSH DOWN LENGTH
  65 SATPDL==5       ;SATED PUSH DOWN LENGTH
  66 MNLNKS==20      ;MAXIMUM NUMBER OF LINKS
  67 STNBLN==200     ;STINK INPUT BUFFER SIZE
  68
  69 ;REFERECNE WORD FLAGS
  70
  71 FIXRT==1
  72 FIXLT==2
  73 POLREQ==200000  ;MARKS GLOGAL REQUEST AS POLISH REQUEST
  74 DEFINT==400000  ;DEFERED INTERNAL
  75
  76
  77 MFOR==101000    ; FOR .CBLK
  78 MBLKS==301000
  79
  80 BUCK==2         ; OFFSETS INTO SYMBOL BLOCKS
  81 LIST==3
  82
  83 \f
  84         LOC 41
  85         JSR TYPR
  86         0       ;TSINT
  87
  88 IF2,COMLOD=TPOK ;IS YOUR TAPE OK?
  89
  90 DEFINE INFORM A,B
  91 IF1,[PRINTX / A = B
  92 /]
  93 TERMIN
  94
  95 DEFINE CONC69 A,B,C,D,E,F,G,H
  96 A!B!C!D!E!F!G!H!TERMIN
  97
  98 DMCGSW==0
  99
 100 DEFINE DMCG
 101 IFN DMCGSW!TERMIN
 102
 103 DEFINE NODMCG
 104 IFE DMCGSW!TERMIN
 105 \fLOC 200
 106 REL:    ADDI@ T,FACTOR
 107 ABS:    HRRZ ADR,T
 108 DATABK: HRRZS ADR
 109         PUSHJ P,GETBIT
 110         TRZE TT,4
 111         JRST DATBK1
 112         PUSHJ P,RRELOC
 113 COM1:   ADDB T,AWORD
 114         ADD T,RH
 115         HLL T,AWORD
 116         CLEARB RH,AWORD
 117 IFN LOWLOD,[CAIGE ADR,LOWLOD
 118         AOJA ADR,DATABK
 119 ]GCR2:  CAMLE ADR,MEMTOP
 120         JRST GCR1
 121         TRNE FF,CODEF
 122         MOVEM T,(ADR)
 123         TRNN FF,CODEF
 124         MOVEM T,@ADRPTR
 125         AOJA ADR,DATABK
 126 ERR1:
 127 DATBK1: PUSHJ P,RLKUP
 128         TRNE TT,2
 129         JRST DECODE     ;LINK OR EXTEND
 130 USE:    ROTC T,3
 131         HRL ADR,TT
 132         SKIPE C,TIMES
 133         CLEARM TIMES
 134         DPB C,[(261200)ADR]
 135         JUMPGE D,USE1A
 136         TLNE B,200000
 137         JRST USE2       ;PREV DEFINED
 138         TRNE FF,UNDEF
 139         JRST ERR2
 140         PUSHJ P,DOWN
 141         MOVEM ADR,(D)
 142 CDATABK:        JRST DATABK
 143
 144 GCR1:   TRNE    ADR,400000      ; PURE?
 145         JRST    HIGHSG          ; YES, USE HIGH SEG
 146         PUSHJ P,GETMEM
 147         JRST GCR2
 148
 149 HIGHSG: CAMLE   ADR,HIGTOP      ; WITHIN HIGH BOUND?
 150         PUSHJ   P,GETHI         ; NO, GROW
 151         MOVEM   T,(ADR) ; STORE
 152         AOJA    ADR,DATABK
 153 \f
 154 ; ROUTINE TO GROW HIGH SEGMENT
 155
 156 GETHI:
 157 DMCG,[
 158         PUSH    P,A
 159         SKIPE   TT,USINDX       ; DO WE KNOW USER INDEX
 160         JRST    GETHI1          ; YES, CONTINUE
 161
 162 IFN ITS,        .SUSET  [.RUIND,,USINDX]
 163         MOVE    TT,USINDX
 164
 165 GETHI1: MOVEI   A,200001        ; FOR SEG #1 FROM CORE JOB
 166         DPB     TT,[MFOR,,A]    ; STORE USER POINTER
 167         MOVEI   TT,(ADR)        ; GET WHERE TO POINTER
 168         SUBI    TT,400000-2000  ; ROUND UP AND REMOVE HIGH BIT
 169         ASH     TT,-10.         ; TO BLOCKS
 170         DPB     TT,[MBLKS,,A]   ; STORE IT ALSO
 171 IFN ITS,[
 172         .CBLK   A,              ; GOT TO SYSTEM
 173         PUSHJ   P,SCE
 174 ]
 175         MOVE    A,HIBLK         ; GET NO. OF HIGH BLOCKS
 176         SUBM    TT,A            ; GET NEW BLOCKS
 177         MOVEM   TT,HIBLK        ; AND STORE
 178         ASH     TT,10.          ; NOW COMPUTE NEW HIGTOP
 179         TRO     TT,400000       ; WITH HIGH BIT
 180         SUBI    TT,1
 181         MOVEM   TT,HIGTOP
 182         JRST    POPAJ
 183 ];DMCG
 184
 185 NODMCG,[
 186         PUSH P,A
 187         MOVEI TT,(ADR)
 188         SUBI TT,400000-2000
 189         ASH TT,-10.
 190         SUB TT,HIBLK    ;NUMBER OF BLOCKS TO GET
 191         ADDM TT,HIBLK   ;NUMBER OF BLOCKS WE ARE GOING TO HAVE
 192         SKIPG TT
 193 IFN ITS,        .VALUE
 194 IFE ITS,        HALTF
 195         MOVE A,CWORD1
 196         ADDI A,1000
 197 IFN ITS,[
 198         .CBLK A,
 199         PUSHJ P,SCE
 200         SOJG TT,.-3
 201 ]
 202         MOVEM A,CWORD1
 203         MOVE TT,HIBLK
 204         ASH TT,10.
 205         ADDI TT,400000-1
 206         MOVEM TT,HIGTOP
 207         JRST POPAJ
 208 ];NODMCG
 209 \f
 210 USE2:   MOVE T,1(D)     ;FILL REQUEST
 211         PUSHJ P,DECGEN
 212         ADDM T,AWORD
 213         ADDM TT,RH
 214         JRST DATABK
 215
 216 USE1A:  MOVE T,ADR
 217 USE1:   TLO A,400000
 218         TRNN FF,UNDEF
 219         JRST DEF1A      ;ENTER DEF
 220 ERR2:   (5000+SIXBIT /UGA/)
 221         JRST DATABK
 222
 223
 224 DEF1:   TLO A,600000
 225         TRNN FF,INDEF+GPARAM    ;DEFINE ALL SYMBOLS
 226         TLNE A,40000    ;OTHERWISE, FLUSH LOCALS
 227         JRST ENT
 228         JRST DEF4
 229 \f
 230 RDEF:   TRO TT,10       ;SET FLAG FOR REDEFINITION
 231 DEF:    ROTC T,3
 232         PUSHJ P,RRELOC
 233 DFSYM1: PUSH P,CDATABK
 234 DEFSYM: MOVEM T,T1
 235 DFSYM2: MOVEM A,CGLOB   ;SAVE SQUOOZE IN CASE WE SATISFY POLISH
 236         JUMPGE D,DEF1   ;NOT PREV SEEN
 237         TLNN B,200000   ;PREVIOUSLY DEFINED
 238         JRST PATCH5     ;PREVIOUSLY NEEDED
 239
 240 DEF2:   TRNE TT,100     ;REDEFINE NOT OK
 241 DEF3:   MOVEM T,1(D)
 242         CAME T,1(D)
 243         (5000+SIXBIT /MDG/)
 244 DEF4:   TRZ FF,GPARAM
 245         POPJ P,
 246
 247 PATCH3: PUSH    P,PATCH6
 248 PATCH:  PUSH    P,A             ; SAVE SYMBOL
 249         HRRZ    D,T2            ; DELETE REFERENCES FROM TABLE
 250         MOVE    A,(D)           ; SQUOOZE
 251         TLNE    A,200000        ; CHECK FOR DEFINED SYMBOL
 252         JRST    PATCH2          ; DON'T DELETE REFERENCES
 253         HRRZ    A,1(D)          ; FIRST REFERENCE
 254         SETZM   1(D)
 255         HRRZ    D,(A)
 256         PUSHJ   P,PARRET
 257         SKIPE   A,D
 258         JRST    .-3
 259 PATCH2: HRRZ    A,T2            ; POINT TO SYMBOL TO BE FLUSHED(REFS ARE GONE)
 260         HRRZ    B,LIST(A)       ; GET LIST POINTER LEFT
 261         HLRZ    C,LIST(A)       ; AND RIGHT
 262         SKIPE   B               ; END?
 263         HRLM    C,LIST(B)       ; NO, SPLICE
 264         SKIPE   C
 265         HRRM    B,LIST(C)
 266         HRRZ    C,BUCK(A)       ; NOW GET BUCKET POINTERS
 267         HLRZ    B,BUCK(A)
 268         CAMG    B,HTOP          ; SEE IF POINTS TO HASH TABLE
 269         CAMGE   B,HBOT
 270         JRST    .+3             ; NO, SKIP
 271         HRRM    C,(B)           ; IT IS, CLOBBER IN
 272         JRST    .+2
 273         HRRM    C,BUCK(B)       ; SPLICE BUCKET
 274         SKIPE   C
 275         HRLM    B,BUCK(C)       ; SPLICE IT ALSO
 276         CAIN    A,(BOT)         ; RESET BOT?
 277         HRRZ    BOT,LIST(BOT)   ; YES
 278         SETZM   LIST(A)         ; CLEAR FOR DEBUGGING
 279         PUSHJ   P,QUADRT        ; RETURN BLOCK
 280         POP     P,A             ; RESTORE SYMBOL
 281         SKIPE   SATED
 282         JRST    UNSATE          ;DELETE THEM
 283 PATCH6: POPJ    P,.+1
 284 \fPATCH7:        PUSHJ   P,LKUP1A
 285         JUMPGE  D,DEF1
 286 PATCH5: HRRZM   D,T2
 287
 288         HRRZ    B,1(D)          ; POINT TO REF CHAIN
 289         MOVEI   D,(B)
 290 PATCH1: MOVE    T,T1
 291         JUMPE   D,PATCH3
 292         MOVE    B,1(D)          ; GET REF WORD
 293         HRRZ    D,(D)
 294         HLL     ADR,B
 295         HRRZS   B
 296         TLZE    ADR,DEFINT
 297         JRST    DEFIF           ;DEFERED INTERNAL
 298         TLZE    ADR,POLREQ
 299         JRST    POLSAT          ;POLISH REQUEST
 300         CAIGE   B,LOWLOD
 301         JRST    PATCH1
 302         TLZN    ADR,100000
 303         JRST    GEN             ;GENERAL REQUEST
 304         PUSH    P,CPTCH1
 305 UNTHR:  TRNN    B,400000        ; HIGH SEG?
 306         MOVEI   B,@BPTR         ; NO FUDGE
 307         HRL     T,(B)
 308         HRRM    T,(B)
 309         HLRZ    B,T
 310         JUMPN   B,UNTHR
 311 CPTCH1: POPJ    P,PATCH1
 312 \fDEFIF: SKIPGE (B)
 313         JRST DEFIF1             ;MUST SATISFY DEFERRED INTERNAL
 314         TLNE ADR,FIXRT+FIXLT
 315         JRST 4,.
 316 DEFIF6: EXCH A,B
 317         PUSHJ P,PARRET
 318         MOVE A,B                ;GET THE SYMBOL BACK
 319         JRST PATCH1
 320
 321 DEFIF1: TLNN ADR,FIXRT+FIXLT
 322         JRST 4,.                ;SYMBOL FIXED UP BUT NOT EXPUNGED FROM TABLE
 323         TLC ADR,FIXRT+FIXLT
 324         TLCN ADR,FIXRT+FIXLT
 325         JRST 4,.                ;BOTH BITS TURNED ON!!
 326         PUSH P,D
 327         PUSH P,B                ;POINTS TO VALUE PAIR
 328         MOVE T,1(B)             ;SQUOOZE FOR DEFERRED INTERNAL
 329         PUSHJ P,LKUP
 330         JUMPGE D,DEFIF4         ;PERHAPS ITS'S IN DDT TABLE
 331         TLNE B,200000
 332         JRST 4,.                ;LOSER
 333         PUSHJ P,GLOBS3          ;FIND THE VALUE
 334         JUMPE B,[JRST 4,.]
 335         TLNE ADR,FIXRT
 336         JRST DEFIFR             ;RIGHT HANDED
 337         TLNN ADR,FIXLT
 338         JRST DEFIF2             ;LEFT HANDED FIXUP
 339         TLZN A,FIXLT
 340         JRST 4,.
 341         HLRE T,1(A)
 342 DEFIF2: ADD T,T1
 343         TLZE ADR,FIXRT
 344         HRRM T,1(A)
 345         TLZE ADR,FIXLT
 346         HRLM T,1(A)
 347         MOVEM A,1(B)            ;WRITE THE REFERENCE WORD BACK
 348         MOVE T,1(A)             ;SAVE VALUE OF THIS GLOBAL IN CASE
 349         MOVE B,A
 350         POP P,A                 ;POINTS TO VALUE PAIR
 351         PUSHJ P,PARRET
 352         TLNE B,FIXLT+FIXRT
 353         JRST DEFIF3             ;STILL NOT COMPLETELY DEFINED
 354         MOVE B,(D)              ;SIMULATE CALL TO LKUP
 355         MOVE A,B
 356         TLZ A,700000
 357         PUSH P,T1
 358         PUSH P,T2
 359         PUSH P,CGLOB
 360         PUSHJ P,DEFSYM          ;HOLD YOUR BREATH
 361         POP P,CGLOB
 362         POP P,T2
 363         POP P,T1
 364 DEFIF3: POP P,D
 365         MOVE A,CGLOB
 366         JRST PATCH1
 367
 368 DEFIFR: TLZN A,FIXRT
 369         JRST 4,.
 370         HRRE T,1(A)
 371         JRST DEFIF2
 372
 373 DEFIF4: POP P,B
 374         POP P,D
 375         PUSH P,B
 376         PUSH P,T1       ;VALUE TO BE ADDED
 377         PUSH P,[DEFIF5] ;WHERE TO RETURN
 378         TLZ T,200000    ;ASSUME RIGHT HALF FIX
 379         TLZE ADR,FIXLT
 380         TLO T,200000    ;ITS LEFT HALF FIX
 381         TLZ ADR,FIXRT
 382         JRST GLST2
 383 DEFIF5: POP P,B
 384         MOVE A,CGLOB
 385         JRST DEFIF6
 386 \f
 387 GEN:    PUSHJ P, DECGEN
 388         TRNN    B,400000        ; HIGH SEG
 389         MOVEI   B,@BPTR         ; NO GET REAL LOC
 390         ADD T,(B)
 391         ADD TT,T
 392         HRR T,TT
 393         MOVEM T,(B)
 394         JRST PATCH1
 395
 396 DECGEN: MOVEI TT,0
 397         TLNE ADR,10
 398         MOVNS T
 399         LDB C,[(261200)ADR]
 400         SKIPE C
 401         IMUL T,C
 402         LDB C,[(220200)ADR]
 403         TLNE ADR,4
 404         MOVSS T
 405         XCT WRDTAB(C)
 406
 407 WRDTAB: POPJ P,         ;FW
 408         EXCH T,TT       ;RH
 409         HLLZS T         ;LH
 410         ROT T,5         ;AC
 411
 412
 413 DECODE: TRNN TT,1
 414         JRST THRDR      ;6 > LINK REQ
 415         PUSHJ P,GETBIT
 416         JRST @.+1(TT)
 417         DEF     ;DEFINE SYMBOL (70)
 418         COMMON  ;COMMON RELOCATION (71)
 419         LOCGLO  ;LOCAL TO GLOBAL RECOVERY (72)
 420         LIBREQ  ;LIBRARY REQUEST (73)
 421         RDEF    ;REDEFINITION (74)
 422         REPT    ;GLOBAL MULTIPLIED BY 1024>N>0 (75)
 423         DEFPT   ;DEFINE AS POINT (76)
 424
 425 \f
 426 RLKUP:  PUSHJ P,RPB
 427
 428 LKUP:   MOVE A,T
 429 LKUP1B: MOVE D,BOT
 430 LKUP3:  MOVEI B,0(ADR)  ;CONTAINS GLOBAL OFFSET
 431         TRNN FF,CODEF
 432         MOVEM B,CPOINT+1        ;$.
 433         TLZ A,700000
 434 LKUP1A: PUSH    P,A
 435         MOVE    B,HTOP
 436         SUB     B,HBOT          ; COMP LENGTH
 437         IDIVI   A,(B)           ; HASH THE SYMBOL
 438         ADD     B,HBOT          ; POINT TO THE BUCKET
 439         HRRZ    D,(B)           ; SKIP IF NOT EMPTY
 440         MOVE    A,(P)           ; RESTORE SYMBOL
 441         JRST    LKUP7
 442 LKUP1:  MOVE    B,(D)           ; GET A CANDIDATE
 443         TLZ     B,600000
 444         CAMN    A,B             ; SKIP IF NOT FOUND
 445         JRST    LKUP5
 446         HRRZ    D,BUCK(D)       ; GO TO NEXT IN BUCKET
 447 LKUP7:  JUMPE   D,LKUP6         ; FAIL, GO ON
 448         HRROI   D,(D)
 449         JRST    LKUP1
 450
 451 LKUP6:  TROA    FF,LOSE
 452 LKUP5:  MOVE    B,(D)           ; SYMBOL WITH ALL FLAGS TO B
 453         JRST    POPAJ
 454
 455 RRELOC: PUSHJ P,RPB
 456 RELOC:  HLRZ C,T
 457         TRNE TT,1
 458         ADD T,FACTOR
 459         TRNE TT,2
 460         ADD C,FACTOR
 461         HRL T,C
 462         POPJ P,
 463
 464 DOWN:   PUSH    P,A
 465         PUSHJ   P,PAIR          ; GET A REF PAIR
 466         HRRZ    ZR,1(D)         ; SAVE OLD REF
 467         MOVEM   A,1(D)          ; CLOBBER IT
 468         MOVEM   ZR,(A)          ; AND PATCH
 469         MOVEI   D,1(A)          ; POINT D TO DESTINATION OF REF WRD
 470         JRST    POPAJ
 471 \f
 472 ;HERE TO CREATE NEW TABLE ENTRY
 473 ;A/     SQUOZE
 474 ;T/     VALUE
 475
 476 DEF1A:  PUSH    P,CDATABK
 477 DEF2A:  PUSH    P,A             ; SAVE SYMBOL
 478         PUSHJ   P,PAIR          ; GET PAIR FOR REF CHAIN
 479         MOVEM   T,1(A)          ; SAVE REF WORD
 480         MOVEI   T,(A)           ; USE POINTER AS VALUE
 481         SKIPA   A,(P)
 482 ENT:    PUSH    P,A
 483         PUSH    P,C
 484         TLZ     A,700000
 485         MOVEM   A,GLBFS
 486         PUSHJ   P,QUAD          ; GET A QUADRAD FOR SYMBOL
 487         MOVE    D,A             ; POINT WITH C
 488         MOVE    A,-1(P)         ; RESTORE SYMBOL FOR HASHING
 489         MOVE    B,HTOP          ; -LNTH OF TABLE
 490         SUB     B,HBOT
 491         TLZ     A,600000        ; CLOBBER FLAGS
 492         IDIVI   A,(B)           ; GET HASH
 493         ADD     B,HBOT          ; POINT TO BUCKET
 494         HRRZ    C,(B)           ; GET CONTENTS THEREOF
 495         HRROM   D,(B)           ; PUT NEW ONE IN
 496         HRRM    C,BUCK(D)       ; PUT OLD ONE IN
 497         HRLM    B,BUCK(D)       ; POINT BACK TO TABLE
 498         SKIPE   C               ; SKIP IF NO NEXT
 499         HRLM    D,BUCK(C)
 500         SKIPE   BOT
 501         HRLM    D,LIST(BOT)
 502         HRRZM   BOT,LIST(D)     ; INTO LIST OF ALL SYMBOLS
 503         MOVEI   BOT,(D)         ; AND RESET
 504         MOVE    A,-1(P)
 505         MOVEM   A,(D)
 506         MOVEM   T,1(D)
 507         POP     P,C
 508         JRST    POPAJ
 509 \fTHRDR: PUSHJ P,RPB
 510         TLNE T,100000
 511         ADD T,FACTOR
 512         HRLI T,100000
 513         JUMPGE D,USE1
 514         MOVE B,(D)
 515         TLNE B,200000
 516         JRST THRD2      ;PREV DEFINED
 517         PUSHJ P,DOWN    ;ENTER LINK REQUEST
 518         MOVEM T,(D)
 519         JRST DATABK
 520
 521 THRD2:  HRRZ B,T
 522         MOVE T,1(D)
 523         PUSHJ P,UNTHR
 524         JRST DATABK
 525
 526 LOCGLO: JUMPGE T,LG2    ;JUMP FOR NORMAL LOCAL TO GLOBAL RECOVERY
 527
 528 ;HERE TO EXPUNGE OR RENAME LOCAL IN LOADER TABLE
 529
 530         JUMPGE D,[JRST 4,.]     ;NO SYMBOL THERE
 531         HRRZM D,T2              ;TABLE ENTRY TO DELETE
 532         PUSHJ P,RPB             ;SOAK UP ANOTHER WORD
 533         JUMPGE T,LG1            ;JUMP TO RENAME LOCAL
 534         TLNN B,200000           ;MAKE SURE THING IS DEFINED
 535         JRST 4,.                ;CANNOT HACK UNDEFINED SYMBOL
 536         PUSHJ P,PATCH
 537         JRST DATABK
 538
 539 ;HERE TO RENAME LOCAL IN LOADER TABLE
 540
 541 LG1:    PUSH P,(D)              ;SQUOZE
 542         PUSH P,1(D)             ;VALUE
 543         MOVSI B,200000          ;MARK AS DEFINED SO THAT . . .
 544         IORM B,(D)              ;PATCH WILL NOT HACK REFERENCES
 545         PUSHJ P,PATCH
 546         MOVE A,T                ;NEW NAME
 547         POP P,T                 ;VALUE
 548         POP P,B                 ;OLD NAME
 549         TDZ B,[37777,,-1]       ;CLEAR SQUOZE
 550         TLZ A,700000            ;CLEAR FLAGS OF NEW NAME
 551         IOR A,B                 ;FOLD FLAGS, NEW NAME
 552         MOVEI B,DATABK          ;ASSUME IT WILL BE LOCAL
 553         TLZE A,40000            ;SEE IF WE MUST RECOVER TO GLOBAL
 554         MOVEI B,.+3             ;MUST RECOVER TO GLOBAL
 555         PUSH P,B                ;RETURN ADDRESS
 556         JRST ENT                ;ENTER IT
 557         MOVE B,(D)              ;SQUOZE AND FLAGS
 558         MOVE A,B                ;SQUOZE WITH . . .
 559         TLZA A,740000           ;FLAGS CLEARED
 560
 561
 562 ;HERE FOR NORMAL LOCAL TO GLOBAL RECOVERY
 563
 564 LG2:    JUMPGE D,DATABK ;LOCAL-GLOBAL RECOVERY
 565         MOVE T,D        ;D POINTS TO LOCAL
 566         TLO A,40000     ;GLOBAL
 567         PUSHJ P,LKUP1B  ;FIND OCCURANCE OF GLOBAL
 568         IORM A,(T)      ;SMASH OLD LOCAL OCCURENCE
 569         JUMPGE D,DATABK
 570         TLNN B,200000
 571         JRST DATABK
 572         MOVE B,1(D)     ;ALREADY DEFINED
 573         MOVEM B,T1
 574         HRRZM D,T2
 575         ADDI D,2
 576         PUSHJ P,PATCH   ;CLOBBER DEFINITION
 577         MOVE D,BOT
 578         PUSH P,CDATABK
 579         JRST PATCH7     ;FILL IN OLD LOCAL REQ
 580
 581 LIBREQ: JUMPL D,DATABK  ;ALREADY THERE
 582         MOVEI T,0
 583         JRST USE1
 584
 585 REPT:   MOVEM T,TIMES
 586         JRST DATABK
 587
 588 COMMON: ADD RH,COMLOC
 589         JRST COM1
 590
 591 DEFPT:  MOVEI T,@LKUP3
 592         TRO FF,GPARAM
 593         JRST DFSYM1
 594
 595
 596 \f
 597 LDCND:  TRO FF,COND
 598         JRST LIB
 599
 600 LIB6:   CAIN A,12       ;END OF CONDITIONAL
 601         JRST .OMIT1
 602         HRRZS T
 603         CAIN A,1
 604         CAIE T,5        ;LOADER VALUE CONDITIONAL
 605         CAIN A,11       ;COUNT MATCHING CONDITIONALS
 606         AOS FLSH
 607         JRST OMIT
 608
 609 LIB2:   TRNE FF,COND
 610         JRST LIB6
 611         CAIN A,5
 612         JRST LIB7
 613         PUSHJ P,RPB
 614         CAIN A,4        ;PRGM NAME
 615         TLNN T,40000    ;REAL END
 616         JRST OMIT
 617         JRST OMIT1      ;LEAVE LIB SEARCH MODE
 618
 619 LIB1:   TRO FF,SEARCH
 620         PUSHJ P,RPB
 621         JUMPGE T,.-1
 622         TRZ FF,SEARCH
 623 LIB4:   PUSHJ P,LKUP
 624         JUMPGE D,LIB3   ;NOT ENTERED
 625         TRNE FF,COND
 626         JRST LIB5
 627         TLNE B,200000   ;RQST NOT FILLED
 628 LIB3:   TLC T,200000    ;"AND NOT" BIT
 629 LIB5:   TLNE T,200000
 630         JRST LIB1       ;THIS ONE LOSES
 631 LIB:    CLEARM FLSH
 632 LIB7:   PUSHJ P,RPB
 633         JUMPGE T,LIB4
 634 .OMIT1: SOSGE FLSH
 635 OMIT1:  TRZ FF,SEARCH+COND;END OF SEGMENT,LOAD THIS PROG
 636 OMIT:   PUSH P,.
 637
 638 \f
 639 RPB:    SOSL TC
 640         JRST GTWD
 641         PUSHJ P,GTWD    ;SOAK UP CKSUM
 642         AOJN CKS,RCKS
 643
 644 LOAD:   JRST (LL)       ;READ SWITCH
 645 LOAD2:  PUSHJ P,GTWD
 646         LDB A,[(220700)T]
 647         MOVEM A,TC
 648         MOVSI A,770000
 649         ANDCAM A,BITPTR
 650         LDB A,[(310700)T]
 651 LOAD1:  MOVE P,SAVPDL
 652         JUMPLE T,OUT
 653         CAIL A,LOADTE-LOADTB
 654         JRST TPOK
 655         TRNE FF,SEARCH
 656         JRST LIB2
 657         TRZ FF,COND     ;FUDGE FOR IMPROPER USE OF .LIBRA
 658         JRST @.+1(A)
 659 LOADTB: TPOK
 660         LDCMD   ;LOADER COMMAND (1)
 661         ABS     ;ABSOLUTE (2)
 662         REL     ;RELOCATABLE (3)
 663         PRGN    ;PROGRAM NAME (4)
 664         LIB     ;LIBRARY (5)
 665         COMLOD  ;COMMON LOADING (6)
 666         GPA     ;GLOBAL PARAMETER ASSIGNMENT (7)
 667 SYMSW:  DDSYMS  ;LOCAL SYMBOLS (10)
 668         LDCND   ;LOAD TIME CONDITIONAL (11)
 669 SYMFLG: SETZ OMIT       ;END LDCND (12)
 670         HLFKIL  ;HALF KILL A BLOCK OF SYMBOLS
 671         OMIT    ;OMIT BLOCK GENERATED BY LIBRARY CREATOR
 672         OMIT    ;LATER WILL BE .ENTRY
 673         AEXTER  ;BLOCK OF STUFF FOR SDAT OR USDAT
 674         OMIT    ;FOR .LIFND
 675         GLOBS   ;GLOBAL SYMBOLS BLOCK TYPE 20
 676         FIXES   ;FIXUPS BLOCK TYPE 21
 677         POLFIX  ;POLISH FIXUPS BLOCK TYPE 22
 678         LINK    ;LINK LIST HACK (23)
 679         OMIT    ;LOAD FILE (24)
 680         OMIT    ;LOAD LIBRARY (25)
 681         OMIT    ;LVAR (26) OBSOLETE
 682         OMIT    ;INDEX (27) NEW DEC STUFF
 683         OMIT    ;HIGH SEG(30)
 684 LOADTE:
 685
 686 OUT:    MOVE P,SAVPDL
 687 ADRM:   POPJ P,
 688 \f
 689 ;HERE TO PROCESS AN .EXTERN
 690
 691 AEXTER: PUSHJ P,RPB     ;READ AND LOOK UP SYMBOL
 692         TLO T,40000     ;TURN ON GLOBAL BIT
 693         PUSHJ P,LKUP    ;NOW LOOK IT UP
 694         JUMPGE D,.+3    ;NEVER APPEARED, MUST ENTER
 695         TLNE B,200000   ;SKIP IF NOT DEFINED
 696         JRST AEXTER     ;THIS ONE EXISTS, GO AGAIN
 697         MOVE B,USDATP   ;GET POINTER TO USDAT
 698         PUSH P,A        ;SAVE SYMBOL
 699         TLZ A,740000    ;KILL ALL FLAGS
 700         MOVE T,B        ;SAVE A COPY OF THIS
 701         ADD T,[3,,3]    ;ENOUGH ROOM?
 702         JUMPGE T,TMX    ;NO, BARF AT THE LOSER
 703         MOVEM T,USDATP  ;NOW SAVE
 704         TRNN    B,400000        ; HIGH SEG?
 705         MOVEM   A,@BPTR         ; NO GET REAL LOC
 706         TRNE    B,400000        ; SKIP IF LOW SEG
 707         MOVEM A,(B)     ;STORE INTO CORE IMAGE BEING BUILT
 708         POP P,A ;RESTORE SYMBOL
 709         MOVEI T,1(B)    ;ALSO COMPUTE 'VALUE' OF SYMBOL
 710         PUSHJ P,DEFSYM
 711         JRST AEXTER
 712
 713
 714 ;USDAT HAS OVERFLOWN
 715
 716 TMX:    (3000+SIXBIT /TMX/)
 717 \fGPA:   PUSHJ P,RPB
 718         MOVEM T,T2
 719         MOVEI T,0
 720
 721 LDCMD:  ADDI T,LDCMD2+1
 722         HRRM T,LDCMD2
 723         ROT T,4
 724         DPB T,[(330300)LDCVAL]
 725         TRO FF,UNDEF+CODEF
 726         HRRM ADR,ADRM
 727         MOVEI B,@LKUP3
 728         MOVEM B,CPOINT+1
 729         MOVEI ADR,T1
 730         JSP LL,DATABK
 731
 732 LDCMD1: TRZ FF,UNDEF+CODEF
 733         HRRZ ADR,ADRM
 734         CLEARB RH,AWORD
 735         MOVE D,T1
 736 LDCMD2: JRST @.
 737         GPA1
 738         JMP     ;JUMP BLOCK (1)
 739         GLOBAL  ;GLOBAL LOCATION ASSIGNMENT (2)
 740         COMSET  ;COMMON ORIGIN (3)
 741         RESPNT  ;RESET GLOBAL RELOCATION (4)
 742         LDCVAL  ;LOADER VALUE CONDITIONAL (5)
 743         .OFFSET ;GLOBAL OFFSET (6)
 744         L.OP    ;LOADER EXECUTE (7)
 745         .RESOF  ;RESET GLOBAL OFFSET\f
 746 JMP:    JUMPE D,JMP1
 747         TRNN FF,JBN
 748         TLO FF,NAME
 749         MOVEM D,SA
 750 JMP1:   MOVEI LL,LOAD2
 751         JRST LOAD2
 752
 753 GLOBAL: TRO FF,INDEF
 754         HRRM D,RELADR
 755         MOVE ADR,D
 756         MOVEI D,RELADR
 757 GLOB1:  HRRM D,REL
 758         JRST JMP1
 759
 760 RESPNT: TRZ FF,INDEF
 761         MOVEI D,FACTOR
 762         HRRZ ADR,FACTOR
 763         JRST GLOB1
 764
 765 LDCVAL: JUMP D,JMP1
 766         TRO FF,SEARCH+COND
 767         CLEARM FLSH
 768         JRST JMP1
 769
 770 .OFFSET:        HRRM D,LKUP3
 771         JRST JMP1
 772
 773 L.OP:   MOVE B,T1       ;B=3 C=4 D=5
 774         MOVE 4,T1+1
 775         MOVE 5,T1+2
 776         TDNN B,[(757)777777]
 777 IFN 0,[ JRST L.OP2
 778         HRRM ADR,ADRM
 779         HRRZ ADR,ADRPTR
 780         MOVEM 4,4(ADR)
 781         MOVEM 5,5(ADR)
 782         MOVEM B,20(ADR)
 783         HRLZI B,(.RETUUO)
 784         MOVEM B,21(ADR)
 785         MOVEM B,22(ADR)
 786         .XCTUUO NBLKS,
 787         MOVE 4,4(ADR)
 788         MOVE 5,5(ADR)
 789         HRRZ ADR,ADRM
 790         JRST .+2
 791 L.OP2:] IOR B,[0 4,5]
 792         XCT B
 793         MOVEM 4,.VAL1
 794         MOVEM 5,.VAL2
 795         JRST JMP1
 796 .RESOF: MOVEI   D,0
 797         JRST    .OFFSET
 798 \f
 799 SETJNM: MOVEI A,SJNM1
 800         HRRM A,SPTY
 801         SETZM A
 802         MOVE B,[(600)A-1]
 803         PUSHJ P,SPT
 804         MOVEM A,JOBNAM
 805         MOVEI A,TYO
 806         HRRM A,SPTY
 807         MOVE A,PRGNAM
 808         POPJ P,
 809
 810 SJNM1:  TRC T,40
 811 DDT4:   IDPB T,B
 812         POPJ P,
 813
 814
 815 GPA1:   MOVE T,T2
 816         PUSHJ P,LKUP
 817         MOVE T,T1
 818         MOVEI TT,100    ;DON'T GENERATE MDG
 819         TRO FF,GPARAM
 820         PUSHJ P,DEFSYM
 821         JRST JMP1
 822
 823 DDLUP:
 824 DDSYMS: PUSHJ P,RPB
 825         LDB TT,[(410300)T]
 826         TLNE T,40000
 827         JRST DDLUP2
 828         TLZ T,240000
 829         TLO T,100000
 830 DDLUP1: MOVE    A,T
 831         PUSHJ P,RRELOC
 832         PUSHJ   P,ADDDDT
 833         JRST DDLUP
 834
 835 DDLUP2: TLZ T,740000    ;MARK AS BLOCK NAME
 836         JRST DDLUP1
 837 \f;HERE TO HANDLE GLOBAL BLOCK -- BLOCK TYPE #20
 838
 839 GLOBS:  PUSHJ   P,GETBIT                ;CODE BITS
 840         PUSHJ   P,RPB                   ;SQOOZE
 841         MOVEM   T,CGLOB
 842         PUSHJ   P,GETBIT                ;CODE BITS
 843         PUSHJ   P,RRELOC                ;VALUE
 844         MOVEM   T,CGLOBV
 845         MOVE    T,CGLOB
 846         TLO     T,40000                 ;GLOBAL FLAG
 847         PUSHJ   P,LKUP                  ;SYMBOL LKUP
 848         LDB     C,[400400,,CGLOB]       ;FLAGS
 849         CAIN    C,60_-2
 850         JRST    GLOBRQ                  ;GLOBAL REQUEST
 851
 852 ;HERE TO HANDLE SYMBOL TABLE FIX UPS OR GLOBAL DEFINITION
 853
 854         TRNN    C,10_-2         ;TEST FOR VALID FLAGS
 855         TRNN    C,4_-2          ;FORMAT IS XX01
 856         JRST    4,.
 857         LSH     C,-2            ;SHIFT OUT GARBAGE
 858         JUMPE   C,GLBDEF        ;FLAGS 04=> GLOBAL DEFINITION
 859         CAIN    C,40_-4         ;*****JUST A GUESS
 860         JRST    GLBDEF          ;*****JUST A GUESS
 861
 862 ;DUMP A DEFERRED INTERNAL INTO LOADER TABLE
 863
 864         JUMPL   D,GDFIT         ;JUMP IF IN LOADER TABLE
 865         PUSHJ   P,PAIR          ;GET VALUE PAIR
 866         MOVSI   T,DEFINT(C)
 867         HRR     T,A             ;REFERENCE WORD POINTS TO PAIR
 868         MOVE    A,CGLOBV
 869         SETZM   (T)             ;MARK AS VALUE
 870         MOVEM   A,1(T)          ;SECOND WORD IS VALUE
 871 GLOBS0: MOVE    A,CGLOB         ;SQUOOZE
 872         TLZ     A,300000        ;FIX THE FLAGS
 873         TLO     A,440000
 874         PUSHJ   P,DEF2A         ;PUT IT INTO LOADER TABLE
 875         JRST    GLOBS
 876
 877 ;HERE FOR DEFERRED INTERNAL ALREADY IN TABLE
 878
 879 GDFIT:  TLNE    B,200000
 880         JRST    4,.             ;ALREADY DEFINED
 881         PUSHJ   P,GLOBS3        ;RETURNS REFERENCE WORD IN A
 882         JUMPE   B,GDFIT1        ;MUST ADD DEFERRED VALUE
 883         HLRZ    B,A
 884         CAIE    B,DEFINT(C)
 885         JRST    4,.             ;REFERENCE WORDS DON'T MATCH
 886         MOVE    B,CGLOBV
 887         CAME    B,1(A)
 888         JRST    4,.             ;VALUES DON'T MATCH
 889         JRST    GLOBS           ;ALL'S WELL THAT ENDS WELL
 890
 891 GDFIT1: PUSHJ   P,DOWN
 892         PUSHJ   P,PAIR
 893         MOVSI   T,DEFINT(C)
 894         HRR     T,A
 895         MOVEM   T,(D)
 896         SETZM   (T)             ;MARK AS VALUE
 897         MOVE    A,CGLOBV
 898         MOVEM   A,1(T)          ;VALUE
 899         JRST    GLOBS
 900 \f;HERE TO HANDLE GLOBAL REQUEST -- FLAGS=60
 901
 902 GLOBRQ: SKIPGE  T,CGLOBV        ;SKIP IF THREADED LIST
 903         JRST    GLOBR1          ;SINGLE WORD FIX UP MUST WORK HARDER
 904
 905 ;SIMPLE REQUEST
 906
 907         JUMPE   T,GLOBS         ;IGNORE NULL REQUEST
 908         JUMPGE  D,GLOBNT        ;JUMP IF SYMBOL NOT IN TABLE
 909         TLNE    B,200000        ;TEST TO SEE IF DEFINED
 910         JRST    GLOBPD          ;PREVIOUSLY DEFINED
 911         PUSHJ   P,DOWN          ;NOT DEFINED, ENTER REQEST INTO TABLE
 912         MOVE    C,CGLOBV
 913         HRLI    C,100000        ;THIS IS A LINK LIST
 914         MOVEM   C,(D)
 915         JRST    GLOBS
 916
 917 ;HERE TO DEFINE GLOBAL SYMBOL, FLAGS=04
 918
 919 GLBDEF: MOVE    T,CGLOBV        ;VALUE
 920         MOVEI   TT,0            ;REDEFINE NOT OKAY, SEE DEF2
 921         PUSHJ   P,DEFSYM        ;SQUOOZE+FLAGS ALREADY IN B BECAUSE OF EARLIER LOOK UP
 922         JRST    GLOBS
 923 \f; HERE IF GLOBAL DEFINED, UNTHREAD THE CHAIN
 924
 925 GLOBPD: MOVE    T,1(D)          ;VALUE
 926         MOVE    B,CGLOBV        ;POINTER TO CHAIN
 927         PUSHJ   P,UNTHR
 928         JRST    GLOBS
 929
 930 ; ENTER NEW SYMBOL WITH LINK REQUEST
 931
 932 GLOBNT: MOVEI   C,44_-2         ;PROPER FLAGS, GLOBAL AND THIS HERE SQUOZ
 933         DPB     C,[400400,,A]
 934         HRLI    T,100000        ;SET LINK BIT IN REQUEST
 935         PUSHJ   P,DEF2A
 936         JRST    GLOBS
 937
 938 ; SINGLE WORD FIX UP -- FLAGS=60
 939
 940 GLOBR1: TLNE    T,100000        ;TEST FOR SYMBOL TABLE FIX
 941         JRST    GLOBST          ;SYMBOL TABLE FIX
 942         JUMPGE  D,GLOBR2        ;JUMP IF NOT IN TABLE
 943         TLNN    B,200000
 944         JRST    GLOBR3          ;NOT PREVIOUSLY DEFINED
 945         HRRZ    B,T             ;FIX UP LOCATION
 946         PUSHJ   P,MAPB          ;DO THE RIGHT THING IF B IN HIGH SEGMENT
 947         TLNE    T,200000        ;LEFT OR RIGHT?
 948         JRST    HWAL            ;LEFT
 949 HWAR:   HRRE    C,(B)           ;HALF WORD ADD RIGHT
 950         ADD     C,1(D)
 951         HRRM    C,(B)
 952         JRST    GLOBS
 953
 954 HWAL:   HLRE    C,(B)           ;HALF WORD ADD LEFT
 955         ADD     C,1(D)
 956         HRLM    C,(B)
 957         JRST    GLOBS
 958
 959 ; HERE FOR SINGLE WORD FIX, SYMBOL UNDEFINED
 960
 961 GLOBR3: PUSHJ   P,DOWN          ;MAKE ROOM IN TABLE
 962         MOVE    C,T
 963         HRLI    T,40001         ;ASSUME RIGHT HALF
 964         TLNE    C,200000        ;RIGHT OR LEFT?
 965         HRLI    T,40002         ;LEFT
 966         MOVEM   T,(D)
 967         JRST    GLOBS
 968
 969 ;HERE TO MAPPING ON AC B SO THAT SECOND SEGMENT LOADING WORKS
 970
 971 MAPB:   TRNN    B,400000        ;SECOND SEGMENT
 972         HRRI    B,@BPTR         ;NO, RELOCATE THE ADDRESS
 973         POPJ    P,
 974 \f; HERE FOR SINGLE WORD FIXUP, SYMBOL NOT IN TABLE
 975
 976 GLOBR2: TLO     A,400000        ;SYMBOL FLAG
 977         MOVE    C,T
 978         HRLI    T,1             ;ASSUME RIGHT HALF FIX
 979         TLNE    C,200000        ;LEFT OR RIGHT?
 980         HRLI    T,2             ;LEFT
 981         PUSHJ   P,DEF2A
 982         JRST    GLOBS
 983
 984 ; HERE FOR SYMBOL TABLE FIX
 985
 986 GLOBST:
 987 ;       MOVE    A,CGLOBV
 988 ;       TLZ     A,700000        ;MAKE SURE WE ARE STILL FIXING SAME SYMBOL
 989 ;       CAME    A,GLBFS
 990 ;       JRST    4,.             ;DON'T AGREE
 991         JUMPGE  D,GLOBS5        ;JUMP IF FIXUP NOT SEEN
 992         TLNN    B,200000
 993         JRST    GLOBS6          ;FIXUP NOT EVEN DEFINED
 994         PUSH    P,1(D)          ;SAVE POINTER TO OLD SYMBOL
 995         PUSH    P,T
 996         MOVE    T,CGLOBV
 997         PUSHJ   P,LKUP
 998         JUMPGE  D,GLST1
 999         TLNE    B,200000
1000         JRST    4,.
1001         PUSHJ   P,GLOBS3        ;FIND THE GLOBAL VALUE
1002         SKIPE   B
1003         SKIPN   (A)
1004         JRST    4,.
1005         POP     P,T
1006         EXCH    B,(P)           ;GET BACK VALUE OF FIXUP SYMBOL
1007         TLNE    T,200000        ;LEFT OR RIGHT?
1008         JRST    GLOBS1          ;LEFT
1009         HRRE    C,1(A)          ;RIGHT
1010         ADD     C,B
1011         HRRM    C,1(A)
1012         TLZN    A,FIXRT         ;DID WE REALLY WANT TO DO THIS
1013         JRST    4,.             ;NO
1014         JRST    GLOBS2          ;YES
1015
1016 GLOBS1: HLRE    C,1(A)          ;LEFT HALF FIX
1017         ADD     C,B
1018         HRLM    C,1(A)
1019         TLZN    A,FIXLT         ;DID WE REALLY WANT TO DO THIS
1020         JRST    4,.             ;NOPE
1021
1022 ; HERE TO FINISH UP SYMBOL TABLE FIX
1023
1024 GLOBS2: POP     P,B
1025         MOVEM   A,1(B)          ;STORE BACK REFERENCE WORD
1026         TLNE    A,FIXLT+FIXRT   ;DO WE HAVE MORE FIXING
1027         JRST    GLOBS           ;NO
1028         MOVE    T,1(A)          ;FIXED VALUE
1029         MOVEI   TT,100          ;OKAY TO REDEFINE, TT USED AT DEF2
1030         PUSHJ   P,DEFSYM
1031         JRST    GLOBS
1032
1033 ;HERE TO FIND POINTER TO VALUE OF DEFERRED INTERNAL
1034
1035 GLOBS3: MOVE    B,1(D)          ;FIRST REFERENCE WORD
1036 GLOBS4: SKIPGE  A,1(B)
1037         JRST    GLOBS8
1038 GLOBS9: HRRZ    B,(B)
1039         JUMPN   B,GLOBS4
1040         POPJ    P,              ;REFERENCE WORD NOT FOUND
1041 GLOBS8: SKIPGE  (A)
1042         JRST    GLOBS9          ;DEFERED INTERNAL FOR ANOTHER SYMBOL
1043         POPJ    P,
1044
1045 GLOBS5: PUSHJ P,GLOBS7
1046         JRST GLOBS0
1047
1048 GLOBS6: PUSHJ P,GLOBS7
1049         PUSHJ P,DOWN
1050         MOVEM T,(D)
1051 CGLOBS: JRST GLOBS
1052
1053 GLOBS7: PUSHJ P,PAIR
1054         MOVE B,T
1055         TLZ T,700000
1056         MOVEM T,1(A)
1057         MOVSI T,DEFINT+FIXRT
1058         TLNE B,200000
1059         TLC T,FIXRT+FIXLT
1060         HRR T,A
1061         MOVSI B,400000
1062         MOVEM B,(T)     ;MARK AS SQUOOZE
1063         MOVE B,CGLOBV
1064         MOVEM B,1(T)    ;SQUOOZE
1065         POPJ P,
1066
1067 GLST1:  POP P,(P)       ;VALUE TO ADD ON TOP OF STACK
1068         PUSH P,CGLOBS
1069
1070 ;HERE TO FIX UP DIFFERED INTERNAL
1071 ;THAT MIGHT BE A LOCAL   CALL WITH STACK
1072 ;       -1(P)   VALUE TO ADD
1073 ;         (P)   RETURN ADDRESS
1074 ;          T    SQUOZE FOR FIXUP (20,XXX=>LEFT HALF FIX)
1075
1076 GLST2:  PUSH P,A
1077         PUSH P,T
1078         TLNE T,40000
1079         JRST 4,.        ;ITS GLOBAL, THERE'S NO HOPE
1080         MOVEI B,0       ;BLOCK NAME
1081         MOVE C,T        ;SYMBOL TO FIX
1082         TLZ C,740000
1083         PUSHJ P,FSYMT2
1084         JRST 4,.        ;CROCK
1085         MOVE B,1(T)     ;VALUE TO FIX
1086         HLRZ C,B        ;THE LEFT HALF
1087         POP P,A
1088         TLNN A,200000
1089         ADD B,-2(P)
1090         TLNE A,200000
1091         ADD C,-2(P)
1092         HRL B,C
1093         MOVEM B,1(T)
1094         POP P,A
1095         POP P,-1(P)
1096         POPJ P,
1097 \f; HERE TO HANDLE FIXUPS -- BLOCK TYPE #21
1098
1099 FIXES:  SKIPE   LFTFIX
1100         JRST    FIXESL          ;LEFT HALF FIXUP LEFT OVER FROM PREVIOUS BLOCK
1101         PUSHJ   P,GETBIT        ;CODE BITS
1102         PUSHJ   P,RRELOC        ;FIX UP WORD
1103         CAMN    T,[-1]          ;SKIPS ON RIGHT HALF FIX
1104         JRST    FIXESL          ;LEFT HALF FIX
1105         HLRZ    B,T             ;C(T) = POINTER,,VALUE  C(B)=POINTER
1106         PUSHJ   P,UNTHR
1107         JRST    FIXES
1108
1109 FIXESL: SETOM   LFTFIX          ;IN CASE RRELOC GETS US OUT OF BLOCK
1110         PUSHJ   P,GETBIT
1111         PUSHJ   P,RRELOC
1112         SETZM   LFTFIX          ;OFF TO THE RACES
1113         HLRZ    B,T
1114         PUSHJ   P,UNTHL
1115         JRST    FIXES
1116
1117 UNTHL:  PUSHJ   P,MAPB
1118         HLL     T,(B)   ;CALL IS POINTER IN B
1119         HRLM    T,(B)   ;        VALUE IN T
1120         HLRZ    B,T
1121         JUMPN   B,UNTHL
1122         POPJ    P,
1123
1124 UNTHF:  PUSHJ   P,MAPB
1125         HRL     B,(B)
1126         MOVEM   T,(B)
1127         HLRZS   B
1128         JUMPN   B,UNTHF
1129         POPJ    P,
1130 \f;POLISH FIXUPS <BLOCK TYPE 22>
1131
1132 PDLOV:  SKIPE POLSW     ;PDL OV ARE WE DOING POLISH?
1133         JRST COMPOL     ;YES
1134         (3000+SIXBIT /POV/)
1135 COMPOL: (3000+SIXBIT /PTC/)
1136 LOAD4A: (3000+SIXBIT /IBF/)
1137
1138
1139 ;READ A HALF WORD AT A TIME
1140
1141 RDHLF:  TLON FF,HSW     ;WHICH HALF
1142         JRST NORD
1143         PUSHJ P,RWORD   ;GET A NEW ONE
1144         TLZ FF,HSW      ;SET TO READ OTEHR HALF
1145         MOVEM T,SVHWD   ;SAVE IT
1146         HLRZS T         ;GET LEFT HALF
1147         POPJ P,         ;AND RETURN
1148 NORD:   HRRZ T,SVHWD    ;GET RIGHT HALF
1149         POPJ P,         ;AND RETURN
1150
1151 RWORD:  PUSH P,C
1152         PUSHJ P,GETBIT
1153         PUSHJ P,RRELOC
1154         POP P,C
1155         POPJ P,
1156
1157 ;HERE TO ENTER POLISH TOKEN INTO GLOBAL TABLE
1158 ;       C/      TOKEN TYPE
1159 ;       T/      VALUE (IGNORED IF OPERATOR)
1160
1161 SYM3X2: PUSH P,A
1162         PUSHJ P,PAIR    ;GET TWO WORDS
1163         MOVEM T,1(A)    ;VALUE
1164         EXCH T,POLPNT   ;POINTER TO CHAIN
1165         MOVEM T,(A)     ;INTO NEW NODE
1166         HRLM C,(A)      ;TOKEN TYPE INTO LEFT HALF OF FIRST WORD
1167         EXCH T,A
1168         EXCH T,POLPNT   ;RESTORE T, POINTER TO NEW NODE
1169         JRST POPAJ
1170 \f;THIS ROUTINE SEARCHES TO SEE IF GLOBAL DEFINED (SKIPES IF UNDEFINED)
1171 ;CALL WITH SQUOOZE IN C AND RETURNS WITH POINTER IN A IF DEFINED
1172
1173 SDEF:   PUSH P,A
1174         PUSH P,B
1175         PUSH P,C
1176         PUSH P,D
1177         PUSH P,T
1178         MOVE T,C
1179         PUSHJ P,LKUP
1180         SKIPGE D
1181         TLNN B,200000   ;SKIP IF DEFINED
1182         AOS -5(P)       ;INCREMENT ADDRESS
1183         MOVEM D,-4(P)   ;SET POINTER IN A
1184         POP P,T
1185         POP P,D
1186         POP P,C
1187 POPBAJ: POP P,B
1188 POPAJ:  POP P,A
1189         POPJ P,
1190
1191 ;START READING THE POLISH
1192
1193 POLFIX: MOVE D,PPDP     ;SET UP THE POLISH PUSHDOWN LIST
1194         MOVEI B,100     ;IN CASE OF ON OPERATORS
1195         MOVEM B,SVSAT
1196         SETOM POLSW     ;WE ARE DOING POLISH
1197         TLO FF,HSW      ;FIX TO READ A WORD THE FIRST TIME
1198         SETOM GLBCNT    ;NUMBER OF GLOBALS IN THIS FIXUP
1199         SETZM POLPNT    ;NULL POINTER TO POLISH CHAIN
1200         PUSH D,[15]     ;FAKE OPERATOR SO STORE WILL NOT HACK
1201
1202 RPOL:   PUSHJ P,RDHLF   ;GET A HALF WORD
1203         TRNE T,400000   ;IS IT A STORE OP?
1204         JRST STOROP     ;YES, DO IT
1205         CAIGE T,3       ;0,1,2 ARE OPERANDS
1206         JRST OPND
1207         CAILE T,14      ;14 IS HIGHEST OPERATOR
1208         JRST LOAD4A     ;ILL FORMAT
1209         PUSH D,T        ;SAVE OPERATOR IN STACK
1210         MOVE B,DESTB-3(T)       ;GET NUMBER OF OPERANDS NEEDED
1211         MOVEM B,SVSAT   ;ALSO SAVE IT
1212         JRST RPOL       ;BACK FOR MORE
1213
1214 \f;HANDLE OPERANDS. THIS GETS COMPLICATED BECAUSE OF THE PRESENCE OF
1215 ;GLOBAL REQUESTS
1216
1217 OPND:   MOVE A,T        ;GET THE OPERAND TYPE HERE
1218         PUSHJ P,RDHLF   ;THIS IS AT LEAST PART OF THE OPERAND
1219         MOVE C,T        ;GET IT INTO C
1220         JUMPE A,HLFOP1  ;0 IS HALF-WORD OPERAND
1221         PUSHJ P,RDHLF   ;NEED FULL WORD, GET SECOND HALF
1222         HRL C,T         ;GET HALF IN RIGHT PLACE
1223         MOVSS C         ;WELL ALMOST RIGHT
1224         SOJE A,HLFOP1   ;1 IS FULL WORD, 2 IS GLOBAL REQUEST
1225
1226         LDB A,[400400,,C]
1227         TLNE C,40000    ;CHECK FOR FUNNY LOCAL
1228         PUSHJ P,SQZCON  ;CONVERT TO STINKING SQUOOZE
1229         DPB A,[400400,,C]
1230         PUSHJ P,SDEF    ;SEE IF IT IS ALREADY DEFINED
1231         JRST OPND1      ;YES, WE WIN
1232         AOSN GLBCNT     ;NO, INCREMENT NUMBER OF GLOBALS THIS FIXUP
1233         AOS HEADNM      ;INCREMENT FIXUP NUMBER IF FIRST GLOBAL
1234         PUSH P,C        ;SAVE GLOBAL REQUESTS FOR LATER
1235         MOVEI T,0       ;MARK AS SQUOOZE
1236         EXCH C,T
1237         PUSHJ P,SYM3X2  ;INTO THE LOADER TABLE
1238         HRRZ C,POLPNT   ;NEW "VALUE"
1239         SKIPA A,[400000];SET UP GLOBAL FLAG
1240 HLFOP:  MOVEI A,0       ;VALUE OPERAND FLAG
1241 HLFOP1: SOJL B,CSAT     ;ENOUGH OPERANDS SEEN?
1242         PUSH D,C        ;NO, SAVE VALUE(OR GLOBAL NAME)
1243         HRLI A,400000   ;PUT IN A VALUE MARKER
1244         PUSH D,A        ;TO THE STACK
1245         JRST RPOL       ;GET MORE POLISH
1246
1247 ;HERE TO CONVERT TO STINKING SQUOOZE, CAVEAT:  THE FLAG BITS ARE CLEARED
1248
1249 SQZCON: TLZ C,740000
1250         JUMPE C,CPOPJ
1251 SQZ1:   CAML C,[50*50*50*50*50]
1252         POPJ P,
1253         IMULI C,50
1254         JRST SQZ1
1255
1256 ; HERE IF GLOBAL SYMBOL DEFINED AT POLISH BLOCK READ TIME
1257
1258 OPND1:  MOVE C,1(A)     ;SYMBOL VALUE
1259         JRST HLFOP
1260 \f;HAVE ENOUGH OPERANDS FOR THE CURRENT OPERATOR
1261
1262 CSAT:   HRRZS A         ;KEEP ONLY THE GLOBAL-VALUE HALF
1263         SKIPN SVSAT     ;IS IT UNARY
1264         JRST UNOP       ;YES, NO NEED TO GET 2ND OPERAND
1265         HRL A,(D)       ;GET GLOBAL VALUE MARKER FOR 2ND OP
1266         POP D,T
1267         POP D,T         ;VALUE OR GLOBAL NAME
1268 UNOP:   POP D,B         ;OPERATOR
1269         JUMPN A,GLOB    ;IF EITHER IS A GLOBAL HANDLE SPECIALLY
1270         XCT OPTAB-3(B)  ;IF BOTH VALUES JUST XCT
1271         MOVE C,T        ;GET THE CURRENT VALUE
1272 SETSAT: SKIPG B,(D)     ;IS THERE A VALUE IN THE STACK
1273         MOVE B,-2(D)    ;YES, THIS MUST BE THE OPERATOR
1274         MOVE B,DESTB-3(B)       ;GET NUMBER OF OPERANDS NEEDED
1275         MOVEM B,SVSAT   ;SAVE IT HERE
1276         SKIPG (D)       ;WAS THERE AN OPERAND
1277         SUBI B,1        ;HAVE 1 OPERAND ALREADY
1278         JRST HLFOP1     ;GO SEE WHAT WE SHOULD DO NOW
1279
1280 ;HANDLE GLOBALS
1281
1282 GLOB:   TRNE A,-1       ;IS IT IN RIGHT HALF
1283         JRST TLHG       ;NO NEED TO SAVE THIS VALUE IF ITS GLOBAL
1284         PUSH P,T        ;SAVE FOR A WHILE
1285         MOVE T,C        ;THE VALUE
1286         MOVEI C,1       ;MARK AS VALUE
1287         PUSHJ P,SYM3X2
1288         HRRZ C,POLPNT   ;POINTER TO VALUE
1289         POP P,T         ;RETRIEVE THE OTHER VALUE
1290 TLHG:   SKIPE SVSAT     ;WAS THIS A UNARY OPERATOR
1291         TLNE A,-1       ;WAS THERE A GLOBAL IN LEFT HALF
1292         JRST GLSET
1293         PUSH P,C
1294         MOVEI C,1       ;SEE ABOVE
1295         PUSHJ P,SYM3X2
1296         HRRZ T,POLPNT   ;POINTER TO VALUE
1297         POP P,C
1298
1299 GLSET:  EXCH C,B        ;OPERATOR INTO RIGHT AC
1300         SKIPE SVSAT     ;SKIP ON UNARY OPERATOR
1301         HRL B,T         ;SECOND,,FIRST
1302         MOVE T,B        ;SET UP FOR CALL TO SYM3X2
1303         PUSHJ P,SYM3X2
1304         MOVEI A,400000  ;SET UP AS A GLOBAL VALUE
1305         HRRZ C,POLPNT   ;POINTER TO "VALUE"
1306         JRST SETSAT     ;AND SET UP FOR NEXT OPERATOR
1307 \f;FINALLY WE GET TO STORE THIS MESS
1308
1309 STOROP: MOVE B,-2(D)    ;THIS SHOULD BE THE FAKE OPERATOR
1310         CAIE B,15       ;IS IT
1311         JRST LOAD4A     ;NO, ILL FORMAT
1312         HRRZ B,(D)      ;GET THE VALUE TYPE
1313         JUMPN B,GLSTR   ;AND TREAT GLOBALS SPECIAL
1314         MOVE A,T        ;THE TYPE OF STORE OPERATOR
1315         CAIGE A,-3
1316         PUSHJ P,FSYMT   ;SYMBOL TABLE FIXUP, MUST WORK HARDER
1317         PUSHJ P,RDHLF   ;GET THE ADDRESS
1318         MOVE B,T        ;SET UP FOR FIXUPS
1319         POP D,T         ;GET THE VALUE
1320         POP D,T         ;AFTER IGNORING THE FLAG
1321         PUSHJ P,@STRTAB+6(A)    ;CALL THE CORRECT FIXUP ROUTINE
1322
1323 COMSTR: SETZM POLSW     ;ALL DONE WITH POLISH
1324         MOVE B,HEADNM
1325         CAILE B,477777
1326         JRST COMPOL     ;TOO BIG, GIVE ERROR
1327         PUSHJ P,RWORD   ;THIS SHOULD GET US OUT (I.E RUN OUT COUNT)
1328         JRST LOAD4A     ;IF NOT, SOMETHING IS WRONG
1329
1330 GLSTR:  MOVE A,T
1331         CAIGE A,-3
1332         JRST 4,.        ;PUSHJ P,FSYMT  ;SYMBOL TABLE FIXUP
1333         PUSHJ P,RDHLF   ;GET THE STORE LOCATION
1334         SUB D,[2,,2]    ;VALUE AND MARKER ON STACK MEANINGLESS
1335         MOVE C,A        ;STORE OP
1336         PUSHJ P,SYM3X2  ;STORE LOC ALREADY IN T
1337         AOS T,GLBCNT    ;WE STARTED AT -1 REMEMBER?
1338         HRRZ C,HEADNM   ;GET HEADER #
1339         TLO C,440000    ;MARK FIXUP AS GLOBAL BEASTIE
1340         PUSHJ P,SYM3X2  ;LAST OF POLISH FIXUP
1341         HRRZ T,POLPNT   ;POINTER TO POLISH BODY
1342         MOVE A,C        ;FIXUP NAME
1343         PUSHJ P,ENT
1344 GLSTR1: SOSGE GLBCNT    ;MUST PUT GLOBAL REQUESTS IN TABLE
1345         JRST COMSTR     ;AND FINISH
1346         POP P,T         ;SQUOOZE
1347         PUSHJ P,LKUP
1348         MOVE A,HEADNM   ;SETUP REQUEST WORD
1349         TLO A,POLREQ    ;MARK AS POLISH REQUEST
1350         JUMPGE D,GLSTR2 ;JUMP IF NOT SEEN
1351         PUSHJ P,DOWN
1352         MOVEM A,(D)
1353         JRST GLSTR1
1354
1355 GLSTR2: EXCH A,T        ;NOT PREVIOUSLY SEEN ENTER FULL REQUEST
1356         TLO A,400000    ;MARK AS NEW TABLE ENTRY
1357         PUSHJ P,DEF2A
1358         JRST GLSTR1
1359 \fSTRTAB:        ALSYM   ;-6 FULL SYMBOL TABLE FIXUP
1360         LFSYM   ;-5 LEFT HALF SYMBOL FIX
1361         RHSYM   ;-4 RIGHT HALF SYMBOL FIX
1362         UNTHF   ;-3 FULL WORD FIXUP
1363         UNTHL   ;-2 LEFT HALF WORD FIXUP
1364         UNTHR   ;-1 RIGHT HALF WIRD FIXUP
1365         CPOPJ   ;0
1366
1367 DESTB:  1
1368         1
1369         1
1370         1
1371         1
1372         1
1373         1
1374         1
1375         0
1376         0
1377         100
1378
1379 OPTAB:  ADD T,C
1380         SUB T,C
1381         IMUL T,C
1382         IDIV T,C
1383         AND T,C
1384         IOR T,C
1385         LSH T,(C)
1386         XOR T,C
1387         SETCM T,C
1388         MOVN T,C
1389
1390 ;HERE TO LOOK UP LOCAL IN SYMBOL TABLE
1391
1392 FSYMT:  PUSHJ P,FSYMT1  ;BLOCK NAME
1393         MOVE B,C        ;SAVE SYMBOL
1394         PUSHJ P,FSYMT1  ;SYMBOL NAME
1395         EXCH B,C        ;BLOCK NAME IN B, SYMBOL NAME IN C
1396 FSYMT2: PUSH P,A        ;SAVE IT
1397         MOVE T,DDPTR    ;AOBJN POINTER TO LOCALS
1398 SLCL:   MOVE A,(T)      ;SQUOZE
1399         TLZN A,740000   ;CLEAR FLAGS FOR COMPARE
1400         JRST SLCL3      ;BLOCK NAME
1401         CAMN A,C        ;IS THIS THE SYMBOL WE SEEK
1402         JRST SLCL1      ;YES, WE MUST STILL VERIFY THE BLOCK
1403 SLCL4:  ADD T,[1,,1]    ;NO KEEP LOOKING
1404         AOBJN T,SLCL
1405         JRST 4,.        ;SYMBOL NOT FOUND
1406
1407 SLCL1:  JUMPE B,POPAJ1  ;SYMBOL IS IN THIS BLOCK
1408         PUSH P,T        ;THIS POINTER POSSIBLY A WINNER
1409         ADD T,[2,,2]    ;NEXT SYMBOL
1410         JUMPGE T,[JRST 4,.]     ;WE HAVE RUN OUT OF TABLE
1411         MOVE A,(T)      ;SQUOZE
1412         TLNE A,740000   ;SKIP ON BLOCK NAME
1413         JRST .-4
1414
1415 ; HERE WHEN WE FIND BLOCK NAME
1416
1417         CAME A,B        ;DOES THE BLOCK NAME MATCH
1418         JRST SLCL2      ;NO KEEP LOOKING
1419         POP P,T         ;WINNING SYMBOL TABLE ENTRY
1420 POPAJ1: POP P,A         ;RESTORE A
1421         AOS (P)         ;SKIP THE PUSHJ P,RDHLF THAT FOLLOWS THIS CALL
1422         POPJ P,
1423
1424 SLCL3:  JUMPN B,SLCL4
1425         JRST 4,.        ;SYMBOL SHOULD BE IN THIS BLOCK
1426
1427 SLCL2:  SUB P,[1,,1]    ;FLUSH THE LOSING SYMBOL POINTER
1428         JRST SLCL
1429
1430 FSYMT1: PUSHJ P,RDHLF
1431         HRL C,T
1432         PUSHJ P,RDHLF
1433         HRR C,T
1434         JRST SQZCON
1435 \f;HERE TO SATISFY GLOBAL REQUEST FOR POLISH
1436
1437 POLSAT: PUSH P,D                ;POINTER TO CURRENTLY PROCESSED GLOBAL REQUEST
1438         HRRZ T,B                ;LOOK UP POLISH TO BE FIXED
1439         TLO T,440000
1440         PUSHJ P,LKUP
1441         JUMPGE D,[JRST 4,.]     ;CANNOT FIND POLISH
1442         MOVE T,CGLOB            ;SQUOOZE (SET UP AT DFSYM2)
1443         MOVE B,1(D)             ;COUNT
1444         MOVE B,(B)              ;STORE OP
1445         MOVE B,(B)              ;FIRST TOKEN
1446         PUSHJ P,FIXPOL
1447         MOVE B,1(D)
1448         SOSG 1(B)               ;UPDATE UNDEFINED GLOBAL COUNT
1449         JRST PALSAT             ;COUNTED OUT FINISH THIS FIXUP
1450 POLRET: MOVE A,CGLOB
1451         POP P,D
1452         JRST PATCH1
1453
1454 ;HERE TO FIXUP A SINGLE GLOBAL REQUEST IN POLISH
1455
1456 FIXPOL: HLRZ A,(B)      ;TOKEN TYPE
1457         JUMPN A,FXP1    ;JUMP IF NOT SQUOZE
1458         CAME T,1(B)
1459         JRST FXP1       ;SQUOOZE DOES NOT MATCH
1460         HRRI A,1        ;MARK AS VALUE
1461         MOVE T,T1       ;VALUE
1462         HRLM A,(B)      ;NEW TOKEN TYPE
1463         MOVEM T,1(B)    ;NEW VALUE
1464         POPJ P,
1465
1466 FXP1:   HRRZ B,(B)      ;POINTER TO NEXT TOKEN
1467         JUMPN B,FIXPOL
1468         JRST 4,.        ;DID NOT FIND SYMBOL
1469 \f;HERE TO FINISH THE POLISH AFTER ALL REQUESTS ARE SATISFIED
1470
1471 PALSAT: AOS SATED               ;NUMBER OF FIXUPS SATISFIED
1472         PUSH P,(D)              ;SAVE THE NAME OF THIS FIXUP FOR LATER DELETION
1473         MOVE A,1(D)             ;POINTS TO COUNT
1474         MOVE A,(A)              ;STORE OP
1475         MOVE D,PPDP
1476         HLLZ B,(A)              ;STORE OP
1477         HRRZ T,1(A)             ;PLACE TO STORE
1478         PUSH D,B                ;STORE OP
1479         PUSH D,T                ;STORE ADDRESS
1480         MOVEI T,-1(D)           ;POINTER TO STORE OP
1481         PUSH D,T
1482         MOVE A,(A)              ;POINTS TO FIRST TOKEN
1483
1484 PSAT1:  HLRE B,(A)      ;OPERATOR
1485         JUMPL B,ENDPOL  ;FOUND STORE OP
1486         CAIGE B,15
1487         CAIGE B,3
1488         JRST 4,.        ;NOT OPERATOR
1489         MOVE T,1(A)     ;OPERANDS (SECOND,,FIRST)
1490         HLRZ C,(T)      ;FIRST OPERAND
1491         JUMPE C,[JRST 4,.]      ;SQUOZE NEVER DEFINED
1492         CAIE C,1        ;SKIP IF DEFINED
1493         JRST PSDOWN     ;GO DOWN A LEVEL IN TREE
1494         SKIPN DESTB-3(B)
1495         JRST PSAT2      ;IF UNARY OP WE ARE DONE
1496         MOVSS T
1497         HLRZ C,(T)      ;SECOND OPERAND
1498         JUMPE C,[JRST 4,.]
1499         CAIE C,1
1500         JRST PSDOWN
1501         MOVSS T
1502
1503 ;HERE TO PERFORM OPERATION
1504
1505 PSAT2:  MOVE C,1(T)     ;VALUE FIRST OPERAND
1506         MOVSS T
1507         SKIPE DESTB-3(B)
1508         MOVE T,1(T)     ;GET SECOND OPERAND ONLY IF NECESSARY
1509         XCT OPTAB-3(B)  ;WOW!
1510         MOVEM T,1(A)    ;NEW VALUE
1511         MOVEI C,1
1512         HRLM C,(A)      ;MARK AS VALUE
1513         POP D,A         ;GO UP A LEVEL IN TREE
1514         JRST PSAT1
1515
1516 ;HERE TO GO DOWN LEVEL IN TREE
1517
1518 PSDOWN: PUSH D,A        ;SAVE THE OLD NODE
1519         HRRZ A,T        ;NEW NODE
1520         JRST PSAT1
1521 \f;HERE TO END PROCESSING OF POLISH IN SYMBOL TABLE (VALUE IN T)
1522
1523 ENDPOL: POP D,B         ;STORE ADDRESS
1524         MOVS A,(D)      ;STORE OP
1525         PUSHJ P,@STRTAB+6(A)
1526         POP P,D         ;NAME OF THIS FIXUP
1527         EXCH P,SATPDP   ;SAVE THIS NAME FOR LATER DELETION FROM TABLE
1528         PUSH P,D
1529         EXCH P,SATPDP
1530         JRST POLRET
1531
1532 ; HERE TO DO SYMBOL TABLE FIXUPS
1533 ;       T/      VALUE
1534 ;       B/      SYMBOL TABLE POINTER
1535
1536 RHSYM:  HRRM T,1(B)     ;RIGHT HALF FIX
1537         POPJ P,
1538
1539 LFSYM:  HRLM T,1(B)     ;LEFT HALF FIX
1540         POPJ P,
1541
1542 ALSYM:  MOVEM T,1(B)    ;FULL WORD FIX
1543         POPJ P,
1544
1545
1546 ;HERE TO REMOVE POLISH FIXUPS FROM SYMBOL TABLE
1547
1548 UNSATE: PUSH P,T2
1549         MOVE A,[-SATPDL,,SATPDB-1]
1550         EXCH A,SATPDP   ;SET UP PUSH DOWN POINTER
1551         MOVE B,SATED    ;# FIXUPS TO BE DELETED
1552         SETZM SATED
1553         CAILE B,SATPDP  ;LIST LONG ENOUGH?
1554         JRST 4,.        ;TIME TO REASSEMBLE
1555 UNSAT1: SOJL B,UNSAT3
1556         POP A,T         ;FIXUP
1557         PUSH P,A
1558         PUSH P,B
1559         PUSHJ P,LKUP    ;LOOK IT UP
1560         HRRZM D,T2
1561 UNSAT2: PUSHJ P,PATCH   ;REMOVE IT FROM TABLE
1562         POP P,B
1563         POP P,A
1564         JRST UNSAT1
1565
1566 UNSAT3: POP P,T2        ;POINTS TO TABLE ENTRY
1567         MOVE T,T1       ;SYMBOL VALUE
1568         MOVE A,CGLOB    ;SQUOOZE
1569         POPJ P,
1570 \f; HERE TO HANDLE LINKS (BLOCK TYPE 23)
1571
1572 LINK:   SETOM LINKDB    ;LINKS BEING HACKED
1573         PUSHJ P,GETBIT  ;RELOCATION BITS INTO TT
1574         PUSHJ P,RRELOC  ;LINK #
1575         MOVE A,T
1576         JUMPE A,LOAD4A  ;ILLEGAL LINK #
1577         PUSHJ P,GETBIT
1578         PUSHJ P,RRELOC  ;STORE ADDRESS
1579         HRRZ B,T
1580         JUMPL A,LNKEND  ;JUMP ON LINK END
1581         CAILE A,MNLNKS
1582         JRST LOAD4A     ;ILLEGAL LINK #
1583
1584         HRRZ C,LINKDB(A)        ;LINK VALUE
1585         PUSH P,B
1586         PUSHJ P,MAPB
1587         HRRM C,(B)              ;VALUE INTO STORE ADDRESS
1588         POP P,B
1589         HRRM B,LINKDB(A)        ;NEW VALUE
1590         JRST LINK
1591
1592 ;END LINK
1593
1594 LNKEND: MOVNS A                 ;LINK #
1595         CAILE A,MNLNKS
1596         JRST LOAD4A             ;ILLEGAL LINK #
1597         HRLM B,LINKDB(A)        ;LINK END ADDRESS
1598         JRST LINK
1599
1600 ;HERE AFTER ALL LOADING TO CLEAN UP LINKS
1601
1602 LNKFIN: PUSH P,A
1603         PUSH P,B
1604         MOVEI A,MNLNKS
1605
1606 LNKF1:  MOVS B,LINKDB(A)        ;VALUE,,STORE ADDRESS
1607         TRNN B,-1               ;DON'T STORE FOR ZERO STORE ADDRESS
1608         JRST .+3
1609         PUSHJ P,MAPB
1610         HLRM B,(B)
1611         SOJG A,LNKF1
1612         JRST POPBAJ
1613 \f;HERE TO HALF KILL LOCAL SYMBOLS DEFINED BY LOADER
1614
1615 HLFKIL: MOVE D,DDPTR    ;RESTORE POINTER TO LOCAL TABLE
1616         ADD D,[2,,2]    ;BUMP IT
1617 NXTKIL: MOVE B,D        ;PUT POINTER ALSO IN B
1618         PUSHJ P,RPB     ;GET A WORD
1619         TLZ T,740000    ;MAKE SURE NO FLAGS
1620 NXTSYK: MOVE A,(B)      ;GET A SYMBOL
1621         TLZN A,740000   ;IF PROG NAME HIT, TIME TO QUIT
1622         JRST NXTKIL
1623         CAME T,A        ;IS THIS ONE
1624         JRST NOKIL      ;NO TRY AGAIN
1625         TLO A,400000    ;TURN ON HALF KILL BIT IN DDT
1626         IORM A,(B)      ;RESTORE SYMBOL TO TABLE
1627         JRST NXTKIL
1628
1629 NOKIL:  AOBJN B,.+1
1630         AOBJN B,NXTSYK  ;TRY ANOTHER
1631         JRST NXTKIL     ;TRY ANOTHER ONE
1632
1633
1634
1635 \f
1636 PRGN:   PUSHJ P,RPB
1637         MOVE A,T
1638         MOVEM A,PRGNAM
1639         TLZE FF,NAME
1640         PUSHJ P,SETJNM
1641         MOVE T,FACTOR
1642         HRL T,ADR
1643         TLNE A,40000
1644         PUSHJ P,PRGEND          ;REAL PRGM END
1645         TLO A,740000
1646         PUSHJ P,ENT
1647         PUSHJ P,SYMS
1648         MOVE    A,(BOT)         ; GET CURRENT PRG NAME
1649 NODMCG, MOVSI   T,1             ; WANT NON-ZERO, BUT POSITIVE LEFT HALF
1650 DMCG,   MOVE    T,1(BOT)        ; POINTS TO TOP AND BOTTOM OF PROGRAM
1651         TLZ     A,740000        ; MARK AS PROGNAME
1652         SKIPL   SYMSW
1653         PUSHJ   P,ADDDDT        ; TO DDT TABLE
1654         SKIPL SYMSW
1655         PUSHJ P,SHUFLE  ;PUT THE SYMBOLS IN THE RIGHT ORDER
1656         HLLZS LKUP3
1657         PUSHJ P,RESETT
1658         JRST OMIT
1659
1660 PRGEND: HRRZM ADR,FACTOR
1661         SETZM LFTFIX
1662         POPJ P,
1663
1664
1665 ;WE DO ALL OF THE FOLLOWING HACKING TO INSURE THAT THE
1666 ;THE SYMBOLS ARE GIVEN TO DDT IN EXACTLY THE SAME ORDER
1667 ;THAT THE TRANSLATOR GAVE THEM TO STINK
1668
1669 SHUFLE: MOVE    B,DDPTR
1670         ADD B,[2,,2]    ;IGNORE THIS PROGRAM NAME
1671         JUMPGE B,CPOPJ  ;NO LOCALS IN DDT'S TABLE
1672
1673 SHUF1:  MOVE A,(B)      ;SQUOOZE
1674         TLNN A,740000
1675         JRST SHUF2      ;FOUND A BLOCK NAME
1676 SHUF3:  ADD B,[1,,1]
1677         AOBJN B,SHUF1
1678
1679 SHUF4:  HRRZ A,DDPTR    ;EXTENT OF THE SYMBOLS IS KNOWN
1680                         ;A/POINTER TO BOTTOM SYMBOLS
1681                         ;B/POINTER TO TOP OF SYMBOLS
1682 SHUF5:  ADDI A,2        ;SYMBOL AT BOTTOM
1683         HRRZI B,-2(B)   ;SYMBOL AT TOP
1684         CAMG B,A
1685         POPJ P,         ;WE HAVE MET THE ENEMY AND THEY IS US!
1686
1687         MOVE C,(A)      ;SWAP THESE TWO ENTRIES
1688         EXCH C,(B)
1689         MOVEM C,(A)
1690
1691         MOVE C,1(A)     ;VALUE
1692         EXCH C,1(B)
1693         MOVEM C,1(A)
1694         JRST SHUF5
1695
1696 ;HERE WHEN WE FIND A BLOCK NAME
1697
1698 SHUF2:  MOVE A,1(B)     ;VALUE
1699         TLNE A,-1       ;PROGRAM NAME?
1700         JRST SHUF4      ;YES
1701         JRST SHUF3      ;IGNORE BLOCK NAME
1702 \f
1703 GTWD:   PUSHJ P,RDWRD   ;GOBBLE A WORD FROM THE BUFFER
1704         JFCL 4,.+1
1705         ADD CKS,T
1706         JFCL 4,[AOJA CKS,.+1]
1707 RELADR: POPJ P,
1708
1709 GETBIT: ILDB TT,BITPTR
1710         SKIPL BITPTR
1711         POPJ P,
1712         EXCH T,BITS
1713         SOS BITPTR
1714         PUSHJ P,RPB
1715         EXCH T,BITS
1716         LDB TT,BITPTR
1717         POPJ P,
1718
1719 ;SUBROUTINE TO GET A WORD FROM BUFFER (GETS NEW ONE IF NEC.)
1720
1721 RDWRD:  PUSH P,TT       ;SAVE TT
1722         MOVE TT,INPTR   ;GOBBLE POINTER
1723         MOVE T,(TT)     ;GOBBLE DATUM
1724         AOBJN TT,RDRET  ;BUFFER EMPTY?
1725 DOREAD: MOVE TT,[-STNBLN,,STNBUF]       ;YES, READ A NEW ONE
1726 IFN ITS,        .IOT TPCHN,TT   ;GOBBLE IT
1727 IFE ITS,[
1728         MOVEM 1,JSYS1
1729         MOVEM 2,JSYS2
1730         MOVEM 3,JSYS3
1731
1732         MOVE 2,TT
1733         HLRE 3,TT
1734         HRLI 2,444400
1735         MOVE 1,IJFN
1736         SIN
1737         SKIPE 3
1738         CLOSF
1739         JFCL
1740         MOVE 1,JSYS1
1741         MOVE 2,JSYS2
1742         MOVE 3,JSYS3
1743 ]
1744         MOVE TT,[-STNBLN,,STNBUF]       ;RE GOOBBLE
1745 RDRET:  MOVEM TT,INPTR  ;SAVE IT
1746         POP P,TT
1747         POPJ P,
1748
1749 ;HERE TO START FIRST READ
1750
1751 RDFRST: PUSH P,TT
1752         JRST DOREAD     ;READ A NEW BUFFER
1753
1754 RCKS:   (3000+SIXBIT /CKS/)
1755 \f
1756 ;LOADER INTERFACE
1757
1758 TYPR:   0
1759         PUSH P,C
1760         PUSH P,T
1761         PUSH P,TT
1762         LDB C,[(330300)40]
1763         MOVEI TT,LI3
1764         TRON C,4
1765         HRRM TT,TYPR
1766         ORCMI C,7
1767         HRLZ TT,40
1768 TYPR2:  PUSHJ P,SIXTYO
1769         AOJE C,TYPR1
1770         PUSHJ P,SPC
1771         HRRZ T,ADR
1772         PUSHJ P,OPT
1773         AOJE C,TYPR1
1774         PUSHJ P,SPC
1775         PUSHJ P,ASPT
1776 TYPR1:  PUSHJ P,CRL
1777         POP P,TT
1778         POP P,T
1779         POP P,C
1780         JRST 2,@TYPR
1781
1782 ASPT:   MOVE T,A
1783 SPT:    TLNN T,40000
1784         TRO FF,LOCF
1785 SPT2:   TLZ T,740000
1786 SPT1:   IDIVI T,50
1787         HRLM TT,(P)
1788         JUMPE T,SPT3
1789         PUSHJ P,SPT1
1790 SPT3:   TRZE FF,LOCF
1791         PUSH P,["*-"0+1,,.+1]
1792         HLRE T,(P)
1793         ADDI T,"0-1
1794         CAILE T,"9
1795         ADDI T,"A-"9-1
1796         CAILE T,"Z
1797         SUBI T,"Z-"#+1
1798         CAIN T,"#
1799         MOVEI T,".
1800         CAIN T,"/
1801 SPC:    MOVEI T,40
1802 SPTY:   JRST TYO
1803
1804
1805 ;0    1-12 13-44 45 46 47
1806 ;NULL 0-9   A-Z  .  $  %
1807 \f
1808 LI4:    CAMN A,[(10700)CBUF-1]
1809         JRST LI3
1810         LDB T,A
1811         ADD A,[(70000)]
1812         SKIPGE A
1813         SUB A,[(430000)1]
1814 IFN ITS,        .IOT TYOC,T
1815 IFE ITS,[
1816 IFN T-1,[
1817         MOVEM   1,JSYS1
1818         MOVE    1,T
1819 ]
1820         PBOUT
1821 IFN T-1,        MOVE    1,JSYS1
1822 ]
1823         JRST LI1
1824
1825 TYI:
1826 IFN ITS,        .IOT TYIC,T
1827 IFE ITS,[
1828 IFN T-1,[
1829         MOVEM   1,JSYS1
1830 ]
1831         PBIN
1832 IFN T-1,[
1833         MOVE    T,1
1834         MOVE    1,JSYS1
1835 ]
1836 ]
1837         CAIE T,15
1838         CAIN T,12
1839         JRST TYO
1840         CAIN T,^R
1841         JRST TYO
1842         POPJ P,
1843
1844 LIS:    ANDI FF,GETTY
1845 LI3:    MOVE A,[(10700)CBUF-1]
1846         MOVEM A,CPTR
1847         MOVE P,[(,-LPDL)PDL-1]
1848         PUSHJ P,CRLS
1849         TRZ FF,LOCF
1850 LI1:    TRZ FF,ALTF
1851 LI2:    PUSHJ P,TYI
1852         CAIN T,33
1853         MOVEI T,"\e
1854         CAIN T,7
1855         JRST LI3
1856         CAIN T,177      ;RUBOUT
1857         JRST LI4
1858         IDPB T,A
1859         CAMN A,[(10700)CBUF+CBUFL]
1860         JRST LI4
1861
1862 \f
1863 LIS1:   CAIE T,"\e
1864         JRST LI1
1865         TRON FF,ALTF
1866         JRST LI2
1867         PUSHJ P,CRL
1868 CD:     MOVEI D,0
1869 CD3:    TRZ FF,ARG
1870 CD2:    ILDB T,CPTR
1871         CAIL T,"0
1872         CAILE T,"9
1873         JRST CD1
1874         LSH D,3
1875         ADDI D,-"0(T)
1876 VALRET: TRO FF,ARG
1877         JRST CD2
1878
1879 CD1:    CAIE T,33
1880         CAIN T,DOLL     ;CHECK FOR A REAL DOLLAR SIGN
1881         JRST LI3
1882         CAIL T,"<
1883         CAILE T,"[
1884         JRST CD
1885         IDIVI T,4
1886         LDB T,DTAB(TT)
1887         MOVEI A,SLIS(T) ;WHERE TO?
1888         CAIE    A,DUMPY ;IS IT A DUMP
1889         TRZ FF,MLAST+SETDEV     ;NO, KILL FUNNY FLAGS
1890         CAIE    A,HASHS ; HASH SET?
1891         PUSHJ   P,HASHS1        ; MAYBE DO IT
1892         PUSHJ P,SLIS(T)
1893         JRST CD
1894         JRST VALRET
1895
1896
1897 \f
1898 SLIS:   TDZA C,C
1899 MLIS:   MOVEI C,2
1900         TRNE FF,GETTY
1901         PUSHJ P,FORMF
1902         TRNE FF,ARG
1903         JUMPL D,LISTER
1904         MOVE D,BOT
1905         JRST LISTER
1906
1907 LISTER: MOVE A,(D)
1908         LDB TT,[(410300)A]
1909         ORCMI   TT,7            ; -1 -> PROGNAME, -2 DEFINED , -4 UNDEFINED
1910         AOJN    TT,LIST2        ; NOT PROG NAME
1911 LIST4:  PUSHJ P,ASPT
1912 LIST5:  PUSHJ   P,VALPT
1913         JRST    LIST6
1914
1915 LIST2:  XOR     TT,C            ; TT/ -1 IF S AND DEF, OR ? AND UNDEF
1916         AOJE    TT,LIST7        ; PRINT VALUES
1917 LIST6:  HRRZ    D,LIST(D)       ; NEXT SYMBOL
1918         JUMPN   D,LISTER        ; MORE, GO ON
1919         JRST    CRL             ; DONE
1920
1921 LIST7:  PUSHJ   P,SPC           ; PRINT UNDEFINED SYMBOL
1922         PUSHJ   P,ASPT          ; PRINT SYMBOL
1923         PUSH    P,D
1924         TRNE    FF,ARG          ; SKIP IF 1?
1925         JUMPN   C,LIST9         ; JUMP IF ?
1926         PUSHJ   P,VALPT
1927         JRST    LIST8
1928 LIST9:  MOVE    D,1(D)          ; POINT TO CHAIN
1929         PUSHJ   P,VALPT
1930         HRRZ    D,(D)
1931         JUMPN   D,.-2
1932 LIST8:  POP     P,D
1933         JRST    LIST6
1934
1935 VALPT:  PUSHJ   P,TAB
1936         HRRZ    T,1(D)          ; SMALL VAL
1937         TRNN    FF,ARG          ; ARG GIVEN?
1938         SKIPN   C               ; OR SS COMM
1939         MOVE    T,1(D)          ; USE FULL WORD
1940         JRST    OPTCR           ; PRINT
1941 \f
1942 ; INITIALIZES ALL AREAS OF CORE
1943
1944 HASHS:  MOVE    A,D             ; SIZE TO A
1945         TRNN    FF,ARG          ; SKI IF ARG GIVEN
1946 HASHS1: MOVEI   A,INHASH        ; USE INITIAL
1947         SKIPE   HBOT            ; SKIP IF NOT DONE
1948         POPJ    P,
1949         PUSH    P,A             ; NOW SAVEE IT
1950         PUSH    P,T
1951         PUSH    P,B
1952
1953         MOVEI   B,LOSYM ; CURRENT TOP
1954         ADDI    A,LOSYM
1955         CAIG    A,<INITCR*2000> ; MORE CORE NEEDED?
1956         JRST    HASHS3          ; NO, OK
1957         SUBI    A,<INITCR*2000>+1777
1958         ASH     A,-10.
1959 HASHS2: PUSHJ   P,CORRUP                ; UP THE CORE
1960         SOJN    A,.-1           ; FOR ALL BLOCKS
1961
1962 HASHS3: MOVEM   B,HBOT          ; STORE AS BOTTOM OF HASH TABLE
1963         ADD     B,-2(P)         ; ADD LENGTH
1964         MOVEM   B,HTOP          ; INTOTOP
1965
1966         ADDI    B,1             ; BUMP
1967         MOVEM   B,PARBOT        ; SAVE AS BOTTOM OF LOADER TABLE AREA
1968         MOVEM   B,PARCUR        ; ALSO AS  CURRENT PLACE
1969
1970         MOVE    B,LOBLKS        ; CURRENT TOP OF CORE
1971         PUSHJ   P,CORRUP
1972         ASH     B,10.           ; WORDS
1973         SUBI    B,1
1974         MOVEM   B,PARTOP
1975         ADDI    B,1             ; NOW DDT TABLE
1976         MOVEM   B,DDBOT
1977         ADDI    B,1777
1978         MOVEM   B,DDPTR
1979         MOVEM   B,DDTOP         ; TOP OF DDT TABLE
1980         ADDI    B,1
1981         HRRM    B,ADRPTR        ; INTO CORE SLOTS
1982         HRRM    B,BPTR
1983         HRRM    B,DPTR
1984
1985         PUSHJ   P,CORRUP        ; INITIAL CCORE BLOCK
1986
1987         PUSHJ   P,GETMEM
1988
1989 ; SET UP INIT SYMBOLS
1990
1991         MOVE    C,[EISYM-EISYME,,EISYM]
1992
1993 SYMINT: MOVE    A,(C)
1994         TLZ     A,600000
1995         MOVE    B,HTOP
1996         SUB     B,HBOT
1997         IDIVI   A,(B)           ; HASH IT
1998         ADD     B,HBOT
1999         HRRZ    A,(B)           ; GET CONTENTS
2000         HRROM   C,(B)
2001         HRRM    A,BUCK(C)
2002         HRLM    B,BUCK(C)
2003         SKIPE   A
2004         HRLM    C,(A)
2005         ADD     C,[3,,3]
2006         JUMPL   C,SYMINT
2007
2008
2009         POP     P,B
2010         POP     P,T
2011         POP     P,A
2012         POPJ    P,
2013
2014 CORRUP: PUSHJ P,GETCOR
2015 IFN ITS,[
2016         PUSHJ   P,SCE
2017         SKIPE   KEEP
2018         PUSHJ   P,WINP          ; WE HAVE THE CORE, TELL LOSER
2019 ]
2020         JFCL
2021         AOS     NBLKS
2022         AOS     LOBLKS
2023 CCRL:   POPJ    P,CRL
2024
2025 IFN ITS,TMSERR: JRST    SCE
2026 \f
2027
2028 EQLS:   MOVE T,D
2029 OPTCR:  PUSH P,CCRL
2030 OPT:    MOVEI TT,10
2031         HRRM TT,OPT1
2032 OPT2:   LSHC T,-43
2033         LSH TT,-1
2034 OPT1:   DIVI T,10
2035         HRLM TT,(P)
2036         JUMPE T,.+2
2037         PUSHJ P,OPT2
2038         HLRZ T,(P)
2039         ADDI T,260
2040 TYOM:   JRST TYO
2041
2042 TAB:    PUSHJ P,SPC
2043         PUSHJ P,TYO
2044         JRST TYO
2045
2046 CRLS:   TRNE FF,GETTY
2047         PUSH P,[CRLS1]
2048 CRL:    MOVEI T,15
2049         PUSHJ P,TYO
2050 CRT:    SKIPA T,C.12
2051 FORMF1: MOVEI T,"C
2052 TYO:    IFN ITS,        .IOT TYOC,T
2053 IFE ITS,[
2054 IFN T-1,[
2055         MOVEM   1,JSYS1
2056         MOVE    1,T
2057 ]
2058         PBOUT
2059 IFN T-1,        MOVE    1,JSYS1
2060 ]
2061 C.12:   POPJ P,12
2062
2063 CRLS1:  MOVEI T,"*
2064         JRST TYO
2065
2066 FORMF:  POPJ    P,12
2067 \f
2068 TDDT:   SKIPE LINKDB    ;TEST FOR LINK HACKAGE
2069         PUSHJ P,LNKFIN  ;CLEAN UP LINKS
2070         PUSH P,[TDDTEX] ;MAKE SURE 1ST SYM IS A PROGRAM NAME, FOR DDT'S SAKE.
2071         HRRZ D,BOT
2072         TRO FF,GLOSYM
2073
2074 SYMS:   JUMPE   D,SYMS5         ; DONE, QUIT
2075         MOVE    A,(D)           ; GET SYMBOL
2076         TLNN    A,200000        ; SKIP IF DEFINED
2077         JRST    SYMS6
2078         TLNE    A,40000         ; SKIP IF LOCAL
2079         TRNE    FF,GLOSYM       ; SKIP IF GLOBALS NOT ACCEPTABLE
2080         TLNE    A,100000        ; HERE IF LOCAL OR WINNING GLOBAL, SKIP IF NOT PROG NAME
2081         JRST    SYMS6           ; LOSER, OMIT
2082         TRNN    FF,GLOSYM       ; SKIP IF GLOBAL
2083         SKIPL   SYMSW           ; SKIP IF NO LOCALS
2084         JRST    SYMS3           ; WINNER!!!, MOVE IT OUT
2085
2086 SYMS8:  HRRZ    A,LIST(D)       ; POINT TO NEXT
2087         PUSH    P,A             ; AND SAVE
2088         MOVEM   D,T2            ; SAVE FOR PATCH
2089         PUSHJ   P,PATCH         ; FLUSH FROM TABLE
2090         POP     P,D             ; POINT TO NEXT
2091         JRST    SYMS
2092
2093 SYMS6:  HRRZ    D,LIST(D)       ; POINT TO NEXT SYMBOL
2094         JRST    SYMS            ; AND CONTINUE
2095
2096 SYMS3:  TRZ FF,NOTNUM   ;ASSUME ALL NUMERIC
2097         TLZ A,740000
2098         MOVE T,A        ;SEE IF IT IS A FUNNY SYMBOL
2099         IDIVI T,50      ;GET LAST CHAR IN TT
2100         JUMPE TT,OKSYM
2101 DIVSYM: CAIG TT,12      ;IS THE SYMBOL > 9
2102         CAIGE TT,1      ;AND LESS THAN OR EQUAL TO 0
2103         TRO FF,NOTNUM   ;NO, SAY NOT A NUMBER
2104         IDIVI T,50      ;CHECK NEXT
2105         JUMPE TT,SYMS8  ;NULL IN THE MIDDLE LOSES
2106         JUMPN T,DIVSYM  ;DIVIDE UNTIL T IS 0
2107         CAIN TT,21      ;IS THIS A "G"
2108         TRNE FF,NOTNUM  ;YES, SKIP IF SYMBOL OF FORM "GXXXXX" X IS A DIGGIT
2109         JRST  OKSYM     ;WIN
2110         JRST SYMS8      ;LOSE
2111 OKSYM:  MOVE T,1(D)
2112         HRRZ    C,LIST(D)       ; POINT TO NEXT
2113         PUSH    P,C
2114         MOVEM   D,T2
2115         PUSHJ   P,PATCH         ; FLUSH IT
2116         POP     P,D
2117         TLO A,40000
2118         TRNN FF,GLOSYM
2119         TLC A,140000    ;DDT LOCAL
2120         TLNN A,37777    ;IF SQUOZE "NAME" < 1000000,
2121         PUSHJ P,ADDDD2  ;TREAT SPECIALLY (IT IS MIDAS'S SYMTAB IDX)
2122         TLNE A,37777
2123         PUSHJ   P,ADDDDT
2124         JRST SYMS
2125
2126 SYMS5:  POPJ    P,
2127 \fGO:    TRNE FF,ARG
2128         MOVEM D,SA
2129         TRO FF,GOF
2130         JRST DDT
2131
2132 EXAM:   CAMLE D,MEMTOP
2133         JRST    TRYHI           ; COULD BE IN HIGH SEG
2134         MOVE T,@DPTR
2135         JRST OPTCR
2136
2137 TRYHI:  TRNE    D,400000        ; SKIP IF NOT HIGH
2138         CAMLE   D,HIGTOP        ; SKIP IF OK
2139         (3000+SIXBIT /NEM/)
2140         MOVE    T,(D)           ; GET CONTENTS
2141         JRST    OPTCR
2142
2143 C.CD2:  POPJ P,CD2
2144
2145 GETCOM: MOVE A,[10700,,CBUF-1]
2146         MOVEM A,CPTR
2147         MOVE P,[(,-LPDL)PDL-1]
2148         PUSH P,C.CD2
2149         MOVEM P,SAVPDL
2150 IFN ITS,[
2151         MOVEI T,0       ;REOPEN CHANNEL IN ASCII MODE
2152         HLLM T,DEV
2153         .OPEN TPCHN,DEV ;RE OPEN
2154         JRST FNF2       ;LOSE
2155 ]
2156 IFE ITS,[
2157         MOVEM   1,JSYS1
2158         MOVEM   2,JSYS2
2159         MOVEM   3,JSYS3
2160         MOVSI   1,100001
2161         HRROI   2,FILSTR
2162         GTJFN
2163         JRST    .+3
2164         MOVE    2,[070000,,200000]
2165         OPENF
2166         MOVEI   1,0
2167         MOVEM   1,IJFN
2168         MOVE    1,JSYS1
2169         MOVE    2,JSYS2
2170         MOVE    3,JSYS3
2171         SKIPN   IJFN
2172         JRST    FNF
2173 ]
2174 GTCM1:
2175 IFN ITS,        .IOT TPCHN,T
2176 IFE ITS,[
2177         MOVEM 1,JSYS1
2178         MOVEM 2,JSYS2
2179         MOVEM 3,JSYS3
2180
2181         MOVE 1,IJFN
2182         MOVE 2,[070700,,T]
2183         MOVNI 3,1
2184         SIN
2185
2186         SKIPGE 3
2187         MOVNI T,1
2188         MOVE 1,JSYS1
2189         MOVE 2,JSYS2
2190         MOVE 3,JSYS3
2191 ]
2192         JUMPL T,FIXOPN  ;JUMP IF EOF
2193         CAIN T,3        ;CHECK FOR EOF
2194         JRST FIXOPN     ;IF SO QUIT
2195         CAIL T,"a
2196         CAILE T,"z
2197         CAIA
2198         SUBI T,40
2199         IDPB T,A        ;DEPOSIT CHARACTER
2200         CAME A,[10700,,CBUF+CBUFL]
2201         JRST GTCM1
2202 TPOK:   SKIPA T,BELL
2203 ERR:    MOVE T,"?
2204 IFN ITS,        .IOT TYOC,T
2205 IFE ITS,[
2206         MOVEM 1,JSYS1
2207         MOVE 1,T
2208         PBOUT
2209         MOVE 1,JSYS1
2210 ]
2211         PUSHJ P,FIXOPN  ;FIX UP OPEN CODE
2212         JRST LI3
2213
2214 ;HERE TO RESET OPEN
2215
2216 FIXOPN: MOVEI T,6
2217         HRLM T,DEV
2218         POPJ P,
2219
2220 FNF2:   PUSHJ P,FIXOPN
2221         JRST FNF
2222
2223 \f
2224 PAPER:  MOVEI A,(SIXBIT /PTR/)
2225         HRRM A,DEV
2226         POPJ P, ;REAL OPEN WILL OCCUR LATER
2227
2228 UTAP:   TRZN FF,ARG
2229         JRST OPNTP
2230         TRO FF,SETDEV   ;SETTING DEVICE
2231         MOVE A,DEVTBL(D)
2232         HRRM A,DEV
2233 OPNTP:  TRO FF,MLAST    ;SET M LAST COMMAND
2234         PUSHJ P,FRD
2235 IFN ITS,        .SUSET [.SSNAM,,SNAME]
2236         MOVEM B,NM1
2237         MOVEM C,NM2
2238         POPJ P, ;REAL OPEN WILL OCCUR LATER
2239
2240 OPNPTR:
2241 IFN ITS,[
2242         .OPEN TPCHN,DEV
2243         JRST FNF
2244         JRST RDFRST     ;STAART UP THE READ ING
2245 ]
2246 IFE ITS,[
2247         MOVEM   1,JSYS1
2248         MOVEM   2,JSYS2
2249         MOVEM   3,JSYS3
2250         MOVSI   1,100001
2251         HRROI   2,FILSTR
2252         GTJFN
2253         JRST    .+3
2254
2255         MOVE    2,[440000,,200000]
2256         OPENF
2257         MOVEI   1,0
2258         MOVEM   1,IJFN
2259         MOVE    1,JSYS1
2260         MOVE    2,JSYS2
2261         MOVE    3,JSYS3
2262         SKIPN   IJFN
2263         JRST    FNF
2264         JRST    RDFRST
2265 ]
2266 NTS:    (3000+SIXBIT /NTS/)
2267
2268 DEV:    6,,(SIXBIT /DSK/)
2269 NM1:    SIXBIT /BIN/
2270 NM2:    SIXBIT /BIN/
2271 0
2272 SNAME:  0               ;SYSTEM NAME
2273 JSYS1:  0
2274 JSYS2:  0
2275 JSYS3:  0
2276 IJFN:   0
2277 OUTJFN: 0
2278
2279 SIXTYO: JUMPE TT,CPOPJ
2280         MOVEI T,0
2281         LSHC T,6
2282         ADDI T,40
2283         PUSHJ P,TYO
2284         JRST SIXTYO
2285
2286 JOB:    PUSHJ P,FRD
2287         MOVEM B,JOBNAM
2288         TRO FF,JBN
2289         POPJ P,
2290
2291 JOBNAM: 0
2292
2293
2294 DEVTBL: IRPS DEV,,[DSK UT1 UT2 UT3 UT4 UT5 UT6 UT7 UT8]
2295         (SIXBIT /DEV/)
2296         TERMIN
2297
2298 FNF:    PUSHJ P,TYPFIL
2299         REPEAT 2,PUSHJ P,SPC
2300 IFN ITS,[
2301         .OPEN ERCHN,ERRBL       ;OPEN ERROR DEVICE
2302         JRST .-1        ;DON'T TAKE NO FOR AN ANSWER
2303
2304 ERLP:   .IOT ERCHN,A    ;READ A CHAR
2305         CAIE A,14       ;IF FORM FEED
2306         CAIN A,3        ;OR ^C
2307         JRST ERDON      ;STOP
2308
2309         .IOT TYOC,A     ;PRINT
2310         JRST ERLP
2311
2312 ERDON:  .CLOSE ERCHN,
2313 ]
2314
2315         JRST LI3
2316
2317
2318 ERRBL:  (SIXBIT /ERR/)  ;ERROR DEVICE
2319         2
2320         TPCHN
2321
2322
2323 TYPFIL:
2324 IFN ITS,[
2325         MOVSI A,-4
2326         HRLZ TT,DEV
2327         JRST .+3
2328 TYPF2:  SKIPN TT,DEV(A)
2329         AOJA    A,.-1
2330         PUSHJ P,SIXTYO
2331         MOVE T,TYPFTB(A)
2332         PUSHJ P,TYO
2333         AOBJN A,TYPF2
2334         POPJ P,
2335
2336 TYPFTB: ":
2337         40
2338         40
2339         0
2340         ";
2341 ]
2342 IFE ITS,[
2343         MOVE A,[440700,,FILSTR]
2344
2345         ILDB T,A
2346         JUMPE T,.+3
2347         PUSHJ P,TYO
2348         JRST .-3
2349         POPJ P,
2350 ]
2351
2352
2353
2354 \f
2355 LOADN:  SKIPA C,SYMFLG
2356 LOADG:  MOVEI C,DDSYMS
2357         PUSHJ P,OPNPTR  ;DO THE REAL OPEN (AND FIRST READ)
2358
2359         MOVEM C,SYMSW
2360
2361 RESTAR: MOVEM P,SAVPDL
2362         CLEARB CKS,TC
2363         CLEARB RH,AWORD
2364         PUSH P,CJMP1
2365 RESETT: MOVEI A,FACTOR  ;LEAVE GLOBAL LOCATION MODE
2366         HRRM A,REL
2367         TRZA FF,UNDEF+GPARAM+INDEF+GLOSYM+SEARCH+CODEF+COND
2368 SFACT:  MOVEM D,FACTOR
2369 CJMP1:  POPJ P,JMP1
2370
2371 KILL:   POPJ    P,
2372 COMVAL: SKIPA   COMLOC
2373 SADR:   HRRZ D,SA
2374 POPJ1:  AOSA (P)
2375 COMSET: MOVEM D,COMLOC
2376 BELL:   POPJ P,7
2377
2378 LBRAK:  MOVEM D,T1
2379         TRZ FF,LOSE
2380         PUSHJ P,ISYM
2381         MOVE T,T1
2382         TRO FF,GPARAM
2383         TRZE FF,ARG
2384         JRST DFSYM2
2385         TLNN B,200000
2386         (3000+SIXBIT /UND/)
2387         MOVE D,1(D)
2388         TRZN FF,LOSE
2389         JRST POPJ1
2390         (2000+SIXBIT /UND/)
2391
2392 SOFSET: HRRM D,LKUP3
2393 CPOPJ:  POPJ P,
2394 \f
2395
2396 BEG:    MOVE D,FACTOR
2397         JRST POPJ1
2398
2399 DDT:    SKIPN JOBNAM
2400         JRST NJN
2401         PUSHJ P,TDDT
2402         MOVE A,JOBNAM
2403         HRR B,BPTR
2404         ADDI B,30
2405         HRRM B,YPTR
2406         HRLI B,440700
2407         MOVEI D,^W
2408         IDPB D,B
2409         MOVE C,[(000600)A-1]
2410         MOVEI T,6
2411 DDT2:   ILDB D,C
2412         JUMPE D,DDT1
2413         ADDI D,40
2414         IDPB D,B
2415         SOJG T,DDT2
2416 \fDMCG,[
2417 DDT1:   MOVEI C,[CONC69 ASCIZ \\e\eJ,\SA,[/\e9B!\eQ\r],\DDPTR,[/\eQ\e\19:VP \]]
2418         HRLI C,440700
2419 DDT6:   ILDB T,C
2420         IDPB T,B
2421         JUMPN T,DDT6    ;END OF STRING MARKED WITH ZERO BYTE
2422         MOVE T,SA       ;GET STARTING ADDRESS
2423         TLNN T,777000   ;IF INSTRUCTION PART ZERO,
2424         TLO T,(JRST)    ;THEN TURN INTO JRST
2425         MOVEM T,SA      ;USE AS STARTING ADDRESS
2426         TRNE FF,GOF     ;IF G COMMAND,
2427         MOVEM T,EXIT    ;THEN USE AS LOADER EXIT
2428         MOVE B,LOBLKS   ;GET CURRENT CORE ALLOCATION+1
2429         SUBI B,1(NBLKS) ;REDUCE TO PROGRAM CORE ALLOCATION
2430         HRRM B,PALLOC   ;SAVE IN EXIT ROUTINE
2431         LSH B,10.       ;SHIFT TO MEMORY LOCATION
2432         SUBI B,1        ;REDUCE TO TOP LOCATION IN CORE OF PROGRAM
2433         HRRM B,PMEMT    ;SAVE FOR MAIN PROGRAM BLT (DON'T LET NON-ZERO CORE ABOVE PROGRAM STAY AROUND)
2434         HRLZ 17,BPTR    ;GET LOCATION OF BEGINNING OF PROGRAM IN LH(17)
2435         ADDM 17,PSV17   ;17 BLT POINTER FOR AC'S, TURN SV17 INTO BLT POINTER FOR PROGRAM
2436         MOVE B,EXBLTP   ;GET EXIT ROUTINE BLT POINTER
2437 YPTR:
2438 IFN ITS,        .VALUE          ;ADDRESS POINTS TO VALRET STRING
2439 IFE ITS,        HALTF
2440                 ;DON'T TRY TO STOP THEN START STINK AFTER HERE (AFTER BREAKPOINT OR WITH $G)
2441         BLT B,LEXEND    ;BLT IN EXIT ROUTINE
2442         BLT 17,17       ;BLT IN PROGRAM AC'S
2443         EXCH 17,SV17    ;SAVE PROGRAM LOCATION 17, SET UP BLT POINTER
2444 IFN ITS,[
2445         .CLOSE TYOC,
2446         .CLOSE TYIC,
2447         .CLOSE TPCHN,
2448 ]
2449 IFE ITS,[
2450         MOVEM 1,JSYS1
2451         MOVE 1,IJFN
2452         CLOSF
2453         JFCL
2454         MOVE 1,JSYS1
2455 ]
2456         JRST LEXIT
2457
2458                 ;EXIT ROUTINE FROM LOADER
2459                 ;BLT'ED INTO 30 - 30+N
2460
2461 EXBLTP: .+1,,LEXIT      ;BLT POINTER
2462         OFST==30-.      ;LEXIT=30
2463 LEXIT=.+OFST
2464 PMEMT:  BLT 17,         ;BLT DOWN MAIN PROGRAM
2465         MOVE 17,SV17    ;GIVE USER HIS LOCATION 17
2466 PALLOC:
2467 IFN ITS,        .CORE           ;REDUCE CORE ALLOCATION TO WHAT REQUIRED BY PROGRAM
2468 IFE ITS,        SKIPA
2469 PSV17:  SV17=.+OFST
2470         40,,40          ;40 FIRST PROGRAM ADDRESS LOADED INTO
2471 EXIT:
2472 IFN ITS,        .VALUE LEXEND
2473 IFE ITS,        HALTF
2474 LEXEND=.+OFST
2475         0               ;END OF EXIT ROUTINE
2476 ];DMCG
2477 \fNODMCG,[
2478 DDT1:   MOVE T,SA       ;GET STARTING ADDRESS
2479         TLNN T,777000   ;IF INSTRUCTION PART ZERO,
2480         TLO T,(JRST)    ;THEN TURN INTO JRST
2481         MOVEM T,SA      ;USE AS STARTING ADDRESS
2482         TRNE FF,GOF     ;IF G COMMAND,
2483         MOVEM T,EXIT    ;THEN USE AS LOADER EXIT
2484         MOVEI T,DDT4    ;MAKE OPT GO TO DDT4
2485         HRRM T,TYOM     ;INSTEAD OF TYO
2486         MOVEI C,[ASCIZ \\e\eJ\e9B/#0\r#1\e\19\eP\16\]     ;# CAUSES FOLLOWING DIGIT TO BE INTERPRETED AS INDEX INTO DDTST
2487         HRLI C,440700
2488         PUSHJ P,DDTSG   ;GENERATE REST OF STRING
2489         MOVE B,LOWSIZ   ;GET CURRENT CORE ALLOCATION
2490         SUBI B,(NBLKS)  ;REDUCE TO PROGRAM CORE ALLOCATION
2491         MOVE C,B        ;SAVE OUR SIZE
2492         LSH B,10.       ;SHIFT TO MEMORY LOCATION
2493         SUBI B,1        ;REDUCE TO TOP LOCATION IN CORE OF PROGRAM
2494         HRRM B,PMEMT    ;SAVE FOR MAIN PROGRAM BLT (DON'T LET NON-ZERO CORE ABOVE PROGRAM STAY AROUND)
2495         SUB C,LOWSIZ
2496         MOVNM C,PALL0   ;NUMBER OF BLOCKS TO FLUSH
2497         MOVE C,CWORD0
2498         TRZ C,400000    ;DELETE PAGE
2499         HRRZM C,PALL1
2500         HRLZ 17,BPTR    ;GET LOCATION OF BEGINNING OF PROGRAM IN LH(17)
2501         ADDM 17,PSV17   ;17 BLT POINTER FOR AC'S, TURN SV17 INTO BLT POINTER FOR PROGRAM
2502         MOVE B,EXBLTP   ;GET EXIT ROUTINE BLT POINTER
2503 YPTR:
2504 IFN ITS,        .VALUE          ;ADDRESS POINTS TO VALRET STRING
2505 IFE ITS,        HALTF
2506                 ;DON'T TRY TO STOP THEN START STINK AFTER HERE (AFTER BREAKPOINT OR WITH $G)
2507         BLT B,LEXEND    ;BLT IN EXIT ROUTINE
2508         BLT 17,17       ;BLT IN PROGRAM AC'S
2509         EXCH 17,SV17    ;SAVE PROGRAM LOCATION 17, SET UP BLT POINTER
2510 IFN ITS,[
2511         .CLOSE TYOC,
2512         .CLOSE TYIC,
2513         .CLOSE TPCHN,
2514 ]
2515 IFE ITS,[
2516         MOVEM 1,JSYS1
2517         MOVE 1,IJFN
2518         CLOSF
2519         JFCL
2520         MOVE 1,JSYS1
2521 ]
2522         JRST LEXIT
2523
2524 DDTST:  MOVE T,SA       ;#0
2525         MOVE T,DDPTR    ;#1
2526
2527 DDTSN:  ILDB T,C        ;GET DIGIT AFTER NUMBER SIGN
2528         XCT DDTST-"0(T) ;GET VALUE IN T
2529         PUSHJ P,OPT     ;"TYPE OUT" INTO VALRET STRING IN OCTAL
2530 DDTSG:  ILDB T,C        ;GET CHAR FROM INPUT STRING
2531         CAIN T,"#       ;NUMBER SIGN?
2532         JRST DDTSN      ;NUMBER SIGN, INTERPRET FOLLOWING DIGIT
2533         IDPB T,B        ;DEPOSIT IN OUTPUT STRING
2534         JUMPN T,DDTSG   ;LOOP ON NOT DONE YET
2535         POPJ P,
2536
2537                 ;EXIT ROUTINE FROM LOADER
2538                 ;BLT'ED INTO 20 - 20+N
2539
2540 EXBLTP: .+1,,LEXIT              ;BLT POINTER
2541         OFST==20-.              ;OFFSET, THIS CODE DESTINED FOR LEXIT
2542 LEXIT=.+OFST                    ;LEXIT=20
2543
2544 PMEMT:  BLT 17,                 ;BLT DOWN MAIN PROGRAM
2545         MOVE 17,PALL1+OFST
2546 IFN ITS,        .CBLK 17,
2547 IFE ITS,        SKIPA
2548 PSV17:  40,,40                  ;40 FIRST PROGRAM ADDRESS LOADED INTO
2549         SUBI 17,1000
2550         SOSLE PALL0+OFST
2551         JRST .+OFST-4
2552         MOVE 17,PSV17+OFST      ;GIVE USER HIS LOCATION 17
2553 EXIT:
2554 IFN ITS,        .VALUE .+OFST+1
2555 IFE ITS,        HALTF
2556 PALL0:  0
2557 PALL1:  0
2558
2559 LEXEND=.+OFST-1                 ;END OF EXIT ROUTINE
2560 SV17=PSV17+OFST                 ;LOCATION TO SAVE 17
2561 ];NODMCG
2562 \f
2563 NJN:    TRZ FF,GOF
2564         (3000+SIXBIT /NJN/)
2565
2566 ZERO:   MOVEI A,(NBLKS)
2567         MOVEM A,LOBLKS
2568         PUSHJ P,GETCOR
2569 IFN ITS,[
2570         PUSHJ P,SCE     ;GO TO ERROR
2571         SKIPE   KEEP
2572         PUSHJ   P,WINP
2573 ]
2574         JFCL
2575         SETOM MEMTOP
2576         MOVEI A,1(NBLKS)
2577         MOVEM A,LOBLKS
2578 GETMEM: PUSHJ P,GETCOR
2579 IFN ITS,[
2580         PUSHJ P,SCE
2581         SKIPE   KEEP
2582         PUSHJ   P,WINP
2583 ]
2584         JFCL
2585
2586         ADDI MEMTOP,2000
2587         AOS LOBLKS
2588         POPJ P,
2589
2590 GETCOR:
2591 DMCG,[
2592 IFN ITS,[
2593         .CORE @LOBLKS
2594         POPJ P,
2595 ]
2596         JRST POPJ1
2597 ];DMCG
2598
2599 NODMCG,[
2600         PUSH P,A
2601         PUSH P,B
2602         MOVE B,LOBLKS
2603         SUB B,LOWSIZ    ;NUMBER OF BLOCKS WE WANT
2604         JUMPE B,GETC2
2605         SKIPG B
2606 IFN ITS,        .VALUE
2607 IFE ITS,        HALTF
2608         MOVE A,CWORD0
2609 GETC1:  ADDI A,1000
2610 IFN ITS,[
2611         .CBLK A,
2612         JRST POPBAJ
2613 ]
2614         MOVEM A,CWORD0
2615         AOS LOWSIZ
2616         SOJG B,GETC1
2617 GETC2:  AOS -2(P)       ;SKIP RETURN
2618         JRST POPBAJ
2619 ];NODMCG
2620
2621 IFN ITS,[
2622 SCE:    SOS (P) ;MAKE POPJ BE A "JRST .-1"
2623         SOS (P)
2624         PUSHJ P,COREQ   ;ASK LOSER
2625         POPJ P, ;HE SAID YES
2626         (2000+SIXBIT /SCE/)
2627
2628 COREQ:  PUSH P,A        ;SAVE SOME ACS
2629         SKIPE   KEEP    ; SKIP IF NOT LOOPING
2630         JRST    COREQ3
2631 COREQ0: MOVEI A,[ASCIZ /NO CORE:
2632         TYPE C TO TRY INDEFINITELY
2633         TYPE Y TO TRY ONCE
2634         TYPE N TO LOSE/]
2635
2636         PUSHJ P,LINOUT
2637         .IOT TYIC,A     ;READ A CHARACTER
2638         .RESET  TYIC,
2639         CAIN    A,"N    ; WANTS LOSSAGE?
2640         JRST    COREQ2
2641         CAIN    A,"Y
2642         JRST    POPAJ
2643         CAIE    A,"C
2644         JRST    COREQ0
2645         AOSA    KEEP
2646 COREQ2: AOS     -1(P)
2647         JRST    POPAJ
2648
2649 COREQ3: MOVEI   A,1
2650         .SLEEP  A,
2651         JRST    POPAJ
2652 ]
2653 ;ROUTINE TO PRINT A LINE
2654
2655 LINOUT: PUSH P,C
2656         PUSH P,B
2657         MOVSI B,440700+A        ;BYTE POINTER TO INDEX OF A
2658
2659 LINO1:  ILDB C,B        ;GET CHAR
2660         JUMPE C,LINO2   ;ZERO, END
2661 IFN ITS,        .IOT TYOC,C
2662 IFE ITS,[
2663         EXCH C,1
2664         PBOUT
2665         EXCH C,1
2666 ]
2667         JRST LINO1
2668
2669 LINO2:  MOVEI A,15      ;PUT OUT CR
2670 IFN ITS,        .IOT TYOC,A
2671 IFE ITS,[
2672         EXCH A,1
2673         PBOUT
2674         EXCH A,1
2675 ]
2676         POP P,B
2677         POP P,C
2678         POPJ P,
2679
2680 WINP:   PUSH    P,A
2681         MOVEI   A,[ASCIZ /WIN!!!/]
2682         PUSHJ   P,LINOUT
2683         SETZM   KEEP
2684         JRST    POPAJ
2685 \f
2686 DEFINE FOUR A,B,C,D
2687         (<<A-SLIS>_9>+B-SLIS)<<C-SLIS>_9>+D-SLIS
2688         TERMIN
2689
2690 DTAB:   (331100+T)DTB-74/4
2691         (221100+T)DTB-74/4
2692         (111100+T)DTB-74/4
2693         (1100+T)DTB-74/4
2694
2695 DTB:    FOUR LBRAK,EQLS,ERR,MLIS,       ;< = > ?
2696         FOUR GETCOM,ERR,BEG,COMSET,     ;@ A B C
2697         FOUR DDT,NTS,NTS,GO,            ;D E F G
2698         FOUR HASHS,ERR,JOB,KILL,        ;H I J K
2699         FOUR LOADG,UTAP,LOADN,SOFSET,   ;L M N O
2700         FOUR PAPER,COMVAL,SFACT,SLIS,   ;P Q R S
2701         FOUR CPOPJ,ERR,ERR,ERR,         ;T U V W
2702         FOUR SADR,DUMPY,ZERO,EXAM,      ;X Y Z [
2703
2704 IFLE 1000-DDT+SLIS,[PRINTX /DISPATCH OVERFLOW
2705 /]
2706 INFORM [DISPATCH ROOM]\<1000-DDT+SLIS>
2707
2708 \f
2709 ;THIS CODE DUMPS THE LOADED CORE IMAGE INTO A DISK FILE AND THEN CAUSES
2710 ;STINK TO KILL ITSELF.
2711
2712 DUMPY:
2713 IFN ITS,[
2714         TRZN FF,MLAST   ;WAS "M" THE LAST COMMAND?
2715         PUSHJ P,FIXFIL  ;FIX UP THE FILE NAME
2716         MOVEI A,(SIXBIT /DSK/)
2717         TRZN FF,SETDEV  ;WAS DEVICE SET?
2718         HRRM A,DEV      ;NO, SET IT
2719
2720         .OPEN TPCHN,DEV ;SEE IF IT EXISTS
2721         JRST OPNOK      ;NO, WIN
2722
2723         .CLOSE TPCHN,   ;CLOSE IT
2724         .FDELE DEV      ;DELETE IT
2725         JFCL    ;IGNORE LOSSAGE
2726
2727 OPNOK:  MOVSI A,7       ;SET DEVICE SPEC TO BE WRITE/IMAGE/BLOCK
2728         HLLM A,DEV
2729         .OPEN TPCHN,DEV ;OPEN THE CHANNEL
2730         JRST FNF
2731 ]
2732 IFE ITS,[
2733         MOVEM   1,JSYS1
2734         MOVEM   2,JSYS2
2735         MOVEM   3,JSYS3
2736         MOVSI   1,1
2737         HRROI   2,FILSTR
2738         GTJFN
2739         JRST    .+3
2740         MOVE    2,[440000,,300000]
2741         OPENF
2742         MOVEI   1,0
2743         MOVEM   1,OUTJFN
2744         MOVE    1,JSYS1
2745         MOVE    2,JSYS2
2746         MOVE    3,JSYS3
2747         SKIPN   OUTJFN
2748         JRST    FNF
2749 ]
2750         PUSHJ P,TDDT    ;MOVE ALL SYMBOLS TO DDT TABLE
2751 IFN ITS,[
2752         MOVE B,[JRST 1] ;START FILE WITH "JRST 1"
2753         PUSHJ P,OUTWRD  ;PUT IT OUT
2754 ]
2755         MOVE B,LOWSIZ   ;GET CURRENT CORE ALLOCATION
2756         SUBI B,(NBLKS)  ;REDUCE TO PROGRAM CORE ALLOCATION
2757         LSH B,10.       ;SHIFT TO MEMORY LOCATION
2758         SUBI B,1        ;REDUCE TO TOP LOCATION IN CORE OF PROGRAM
2759         MOVEI ADR,20    ; GET TOP OF LOW SEG IN USER'S LOC 20
2760         HRRZM B,@ADRPTR
2761
2762         MOVN ADR,MEMTOP ;GET -<LENGTH OF CORE IMAGE>
2763         HRLZS ADR       ;AOBJN POINTER
2764
2765 DMP2:   SKIPN B,@ADRPTR ;LOOK FOR THE FIRST NON-ZERO WORD
2766         AOBJN ADR,.-1   ;UNTIL THE WORLD IS EXHAUSTED
2767         JUMPGE ADR,CHKHI        ;DROPPED THROUGH, JUMP IF CORE EMPTY
2768
2769         MOVEI C,(ADR)   ;SAVE POINTER TO NON ZERO WORD
2770         MOVEI A,(C)     ;AND ANOTHER COPY
2771
2772 DMP1:   SKIPE B,@ADRPTR ;NOW LOOK FOR END OF NON ZERO BLOCK
2773         AOBJN ADR,.-1   ;UNTIL WORLD EXHAUSTED
2774         JUMPGE ADR,DMPLST       ;IF WORLD EMPTY, QUIT
2775
2776         AOBJP ADR,DMPLST        ;CHECK NEXT WORD
2777         SKIPE B,@ADRPTR ;FOR BEING ZERO
2778         JRST DMP1       ;ONE LONE ZERO, DON'T END BLOCK
2779
2780 DMPLST: MOVEI D,(ADR)   ;POINT TO END
2781         SUB C,D ;C/ -<LENGTH OF BLOCK>
2782         HRL A,C ;A/ AOBJN TO BLOCK
2783         MOVE B,A        ;COPY TO B FOR OUTWRD
2784 IFE ITS,        SUBI    B,1
2785         PUSHJ P,OUTWRD  ;PUT IT OUT
2786 IFE ITS,        ADDI    B,1
2787         HRRI B,@BPTR    ;NOW POINT TO REAL CORE
2788 IFN ITS,        .IOT TPCHN,B    ;BARF IT OUT
2789 IFE ITS,[
2790         MOVEM 1,JSYS1
2791         MOVEM 2,JSYS2
2792         MOVEM 3,JSYS3
2793
2794         MOVE 2,B
2795         HLRE 3,B
2796         HRLI 2,444400
2797         MOVE 1,OUTJFN
2798         SOUT
2799         MOVE 1,JSYS1
2800         MOVE 2,JSYS2
2801         MOVE 3,JSYS3
2802 ]
2803
2804 IFN ITS,[
2805         MOVE B,A        ;GET POINTER BACK IN B
2806         MOVE C,B        ;FIRST WORD IN CHECK SUM
2807         HRRI B,@BPTR    ;POINT TO REAL CORE
2808
2809         ROT C,1 ;ROTATE CKS
2810         ADD C,(B)       ;ADD
2811         AOBJN B,.-2     ;AND DO FOR ENTIRE BLOCK
2812
2813         MOVE B,C        ;CKS TO B
2814         PUSHJ P,OUTWRD  ;AND PUT IT OUT
2815 ]
2816         JUMPL ADR,DMP2  ;IF MORE, GO DO IT
2817
2818 CHKHI:  SKIPN   MEMTOP,HIGTOP   ; ANY HIGH SEG
2819         JRST    DMPSYMS         ; NO, GO ON TO SYMS
2820         SETZM   HIGTOP          ; RESET IT
2821         HLLZS   ADRPTR          ; FIX UP POINTERS
2822         HLLZS   BPTR
2823         LDB     ADR,[2100,,MEMTOP]      ; GET NO. OF WORDS
2824         MOVNS   ADR             ; NEGATE
2825         MOVSI   ADR,(ADR)
2826         HRRI    ADR,400000      ; START OF HIGH SEG
2827         JRST    DMP2
2828
2829
2830 ;HERE TO DO START ADDRESS
2831
2832 DMPSYMS:        HRRZ B,SA       ;GET START ADR
2833 IFN ITS,        HRLI B,(JUMPA)  ;USE "JUMPA" TO MAKE DDT HAPPY
2834 IFE ITS,        HRLI B,1
2835         PUSHJ P,OUTWRD
2836
2837 ;HERE TO DO SYMBOLS
2838
2839 IFE ITS,[
2840 ; ON TENEX/20 CLOSE FILE AND CREATE SEPARATE SYMBOL FILE
2841
2842         MOVEM   1,JSYS1
2843         MOVEM   2,JSYS2
2844         MOVEM   3,JSYS3
2845
2846         MOVE    1,OUTJFN
2847         CLOSF
2848         JFCL
2849
2850         MOVE    1,[440700,,FILSTR]
2851
2852 FNDNMX: ILDB    2,1
2853         CAIE    2,"<
2854         JRST    FNDNM2
2855
2856         ILDB    2,1
2857         CAIE    2,">
2858         JRST    .-2
2859         ILDB    2,1
2860
2861 FNDNM2: JUMPE   2,.+3
2862         CAIE    2,".
2863         JRST    FNDNMX
2864
2865         MOVEI   2,".
2866         DPB     2,1
2867
2868         MOVE    3,[440700,,[ASCIZ /SYMBOLS/]]
2869         ILDB    2,3
2870         IDPB    2,1
2871         JUMPN   2,.-2
2872
2873         MOVSI   1,1
2874         HRROI   2,FILSTR
2875         GTJFN
2876         JRST    .+3
2877         MOVE    2,[440000,,300000]
2878         OPENF
2879         MOVEI   1,0
2880         MOVEM   1,OUTJFN
2881         MOVE    1,JSYS1
2882         MOVE    2,JSYS2
2883         MOVE    3,JSYS3
2884         SKIPN   OUTJFN
2885         JRST    FNF
2886 ]
2887 IFN ITS,[
2888         HLLZ B,DDPTR    ;GET NUMBER
2889         PUSHJ P,OUTWRD  ;PUT IT OUT
2890
2891         MOVE C,DDPTR    ;FOR CKS
2892         .IOT TPCHN,DDPTR        ;OUT GOES THE WHOLE TABLE
2893 ]
2894
2895 IFE ITS,[
2896         MOVE A,DDPTR
2897         MOVEI B,0               ; WILL COUNT SYMS
2898
2899 TWNTY1: MOVE T,(A)
2900         TLZ T,740000            ; KILL SQUOZE BITS
2901
2902         MOVE D,T
2903         IDIVI T,50              ; CONVERT TO 10X/20 SQUOZE
2904         JUMPN TT,.+3
2905         MOVE D,T
2906         JRST .-3
2907
2908         HLLZ  T,(A)
2909         TLZ  T,37777            ; JUST GET SQUOZE BITS
2910         JUMPN T,TWNTY2          ; JUMP UNLESS PROG NAME
2911         ADDI B,1
2912 TWNTY2: ADDI B,1
2913         IOR D,T
2914         MOVEM D,(A)
2915         ADD A,[2,,2]
2916         JUMPL A,TWNTY1
2917
2918 ; HAVE COUNTED SYMS AND FIXED UP SYMBOLS, START OUTPUTTING
2919
2920         ASH B,1
2921         MOVNS B
2922         MOVSS B
2923         PUSHJ P,OUTWRD          ; PUT OUT COUNT
2924
2925         MOVE A,DDPTR
2926
2927 TWNTY3: MOVE D,A
2928         MOVEI C,0
2929 TWNTY5: MOVE T,(A)              ; SEARCH FOR A PROG NAME (OR END)
2930         TLNN T,740000
2931         JRST TWNTY4
2932         ADD A,[2,,2]
2933         ADDI C,2
2934         JUMPL A,TWNTY5
2935
2936 TWNTY6: JUMPE C,TWNTY7
2937         MOVNS C
2938         HRL D,C
2939         MOVEM 1,JSYS1
2940         MOVEM 2,JSYS2
2941         MOVEM 3,JSYS3
2942
2943         MOVE 1,OUTJFN
2944         MOVE 2,D
2945         HRLI 2,444400
2946         HLRE 3,D
2947         SOUT
2948         MOVE 1,JSYS1
2949         MOVE 2,JSYS2
2950         MOVE 3,JSYS3
2951 TWNTY7: ADD A,[2,,2]
2952         JUMPL A,TWNTY3
2953 ]
2954 IFN ITS,[
2955         ROT B,1
2956         ADD B,(C)       ;ADD IT
2957         AOBJN C,.-2
2958
2959         PUSHJ P,OUTWRD  ;PUT OUT THE CKS
2960
2961         MOVSI B,(JRST)  ;FINISH WITH "JRST 0"
2962         PUSHJ P,OUTWRD
2963
2964         MOVNI B,1       ;FINISH WITH NEGATIVE
2965         PUSHJ P,OUTWRD
2966
2967         .CLOSE TPCHN,   ;CLOSE THE FILE
2968 ]
2969 IFE ITS,[
2970         EXCH 1,OUTJFN
2971         CLOSF
2972         JFCL
2973         EXCH 1,OUTJFN
2974 ]
2975
2976 IFN ITS,        .VALUE [ASCIZ /:KILL /] ;KILL
2977 IFE ITS,[
2978         HALTF
2979
2980 TWNTY4: MOVE B,T
2981         PUSHJ P,OUTWRD
2982         MOVEI B,0
2983         PUSHJ P,OUTWRD
2984         MOVEI B,0
2985         PUSHJ P,OUTWRD
2986         MOVEI B,0
2987         PUSHJ P,OUTWRD
2988         JRST TWNTY6
2989 ]
2990
2991 ;SUBROUTINE TO PUT OUT ONE WORD
2992
2993 OUTWRD: HRROI T,B       ;AOBJN POINTER TO B
2994 IFN ITS,        .IOT TPCHN,T
2995 IFE ITS,[
2996         MOVEM 1,JSYS1
2997         MOVEM 2,JSYS2
2998         MOVEM 3,JSYS3
2999         MOVE 2,B
3000         MOVE 1,OUTJFN
3001         BOUT
3002         MOVE 1,JSYS1
3003         MOVE 2,JSYS2
3004         MOVE 3,JSYS3
3005 ]
3006         POPJ P,
3007
3008
3009
3010 \f
3011 ;HERE TO BUILD DEFAULT OUTPUT FILE NAME
3012
3013 FIXFIL: MOVE A,[SIXBIT /_STNK_/]        ;DEFAULT NAME 1
3014         MOVEM A,NM1
3015         MOVE A,[SIXBIT /DUMP/]  ;AND NAME 2
3016         MOVEM A,NM2
3017         POPJ P,
3018 \f
3019 ; CORE AND TABLE MANAGEMENT ROUTINES FOR HASH CODED TABLE STINK.
3020
3021 PAIR:   PUSH    P,B
3022         SKIPN   A,PARLST        ; ANY ON FREE LIST?
3023         JRST    PAIR1           ; NO, TRY FREE AREA
3024         HRRZ    B,(A)           ; YES, CDR THE LIST
3025         MOVEM   B,PARLST
3026 PAIR3A: SETZM   (A)     ; CLEAR 1ST WORD
3027 PAIR3:  POP     P,B
3028         POPJ    P,
3029
3030 PAIR1:  MOVE    A,PARCUR        ; TRY FREE AREA
3031         ADDI    A,2             ; WORDS NEEDED
3032         CAML    A,PARTOP        ; SKIP IF ROOM EXISTS
3033         JRST    PAIR2
3034 PAIR4:  EXCH    A,PARCUR        ; RETURN POINTER AND RESET PARCUR
3035         JRST    PAIR3A
3036
3037 QUAD:   PUSH    P,B
3038         SKIPN   A,QUADLS        ; SKIP IF ANY THERE
3039         JRST    QUAD1
3040         HRRZ    B,(A)           ; CDR THE QUAD LIST
3041         MOVEM   B,QUADLS
3042         JRST    PAIR3A
3043
3044 QUAD1:  MOVE    A,PARCUR        ; GET TOP
3045         ADDI    A,4
3046         CAML    A,PARTOP        ; OVERFLOW?
3047         JRST    QUAD2           ; YES, GET MORE
3048         JRST    PAIR4           ; NO, WIN
3049
3050 PAIR2:  PUSHJ   P,MORPAR        ; GET MORE CORE
3051         JRST    PAIR1
3052
3053 QUAD2:  PUSHJ   P,MORPAR
3054         JRST    QUAD1
3055
3056 PARRET: PUSH    P,B
3057         HRRZ    B,PARLST        ; SPLICE IT INTO FREE LIST
3058         HRRM    B,(A)
3059         MOVEM   A,PARLST
3060         JRST    PAIR3           ; RETURN POPPING B
3061
3062 QUADRT: PUSH    P,B
3063         HRRZ    B,QUADLS
3064         HRRM    B,(A)
3065         MOVEM   A,QUADLS
3066         JRST    PAIR3
3067 \f
3068 ; HERE TO ALLOCATE MORE STORAGE (1 BLOCK) FOR SYMBOL TABLE STUFF
3069
3070 MORPAR: PUSHJ P,GETCOR          ; TRY AND GET A BLOCK
3071 IFN ITS,[
3072         PUSHJ   P,TMSERR                ; COMPLAIN
3073         SKIPE   KEEP
3074         PUSHJ   P,WINP
3075 ]
3076         JFCL
3077         AOS     NBLKS
3078         PUSHJ   P,MOVCOD        ; TRY AND GET CODE OUT OF THE WAY
3079         PUSHJ   P,MOVDD         ; ALSO GET DDT SYMBOLS OUT
3080         MOVEI   A,2000          ; INCREASE PARTOP
3081         ADDM    A,PARTOP
3082         AOS     LOBLKS
3083         POPJ    P,
3084
3085 ; HERE TO MOVE CODE
3086
3087 MOVCOD: PUSH    P,C
3088         PUSH    P,B
3089         HRRZ    A,ADRPTR        ; POINT TO CURRENT START
3090         ADDI    A,2000          ; NEW START
3091         MOVE    C,A
3092         HRRM    A,ADRPTR        ; FIX POINTERS
3093         HRRM    A,BPTR
3094         HRRM    A,DPTR
3095         MOVE    B,LOBLKS        ; GEV(CURRENT TOP (IN BLOCKS)
3096         ASH     B,10.           ; CONVERT TO WORDS
3097
3098 MOVCO3: MOVEI   A,-2000(B)      ; A/ POINT TO LAST DESTINATION
3099         CAIG    B,(C)           ; SKIP IF NOT DONE
3100         JRST    MOVCO2
3101         HRLI    A,-2000(A)      ; B/ FIRST SOURCE,,FIRST DESTINATION
3102         BLT     A,-1(B)
3103         SUBI    B,2000
3104         JRST    MOVCO3
3105
3106 MOVCO2: POP     P,B
3107         POP     P,C
3108         POPJ    P,
3109
3110
3111 ; HERE TO MOVE DDT SYMBOLS
3112
3113 MOVDD:  PUSH    P,C
3114         PUSH    P,C
3115         HRRZ    A,DDPTR         ; GET CURRENT POINTER
3116         ADDI    A,2000
3117         HRRM    A,DDPTR
3118         HRRZ    A,DDTOP         ; TOP OF DDT TABLE
3119         ADDI    A,2000
3120         MOVEM   A,DDTOP
3121
3122         MOVEI   B,1(A)          ; SET UP FOR BLT LOOP
3123         HRRZ    C,DDBOT
3124         ADDI    C,2000  ; BUMP
3125         MOVEM   C,DDBOT
3126         JRST    MOVCO3          ; FALL INTO BLT LOOP
3127
3128
3129 ;HAVE NAME W/ FLAGS IN A, VALUE IN T,
3130 ;PUT SYM IN DDT SYMBOL TABLE.
3131 ADDDDT: PUSH    P,A
3132         PUSH    P,B
3133 ADDDD1: MOVE    A,DDPTR
3134         SUB     A,[2,,2]
3135         HRRZ    B,DDBOT
3136         CAILE   B,(A)           ; SKIP IF OK
3137         JRST    GROWDD          ; MUST GROW DDT TABLE
3138         MOVEM   A,DDPTR
3139         MOVEM   T,1(A)          ; CLOBBER AWAY
3140         POP     P,B
3141         POP     P,(A)
3142         MOVE    A,(A)           ; RESTORE A
3143         POPJ    P,
3144
3145 GROWDD: PUSHJ P,GETCOR
3146 IFN ITS,[
3147         PUSHJ   P,TMSERR
3148         SKIPE   KEEP
3149         PUSHJ   P,WINP
3150 ]
3151         JFCL
3152         AOS     NBLKS
3153         PUSHJ   P,MOVCOD        ; MOVE THE CODE
3154         PUSHJ   P,MOVDD
3155         MOVNI   A,2000
3156         ADDM    A,DDBOT
3157         AOS     LOBLKS
3158         JRST    ADDDD1
3159
3160 ADDDD2: PUSH P,A        ;CALL HERE FROM SYMS OR TDDT.
3161         PUSH P,B
3162         SKIPA B,DDPTR   ;SPECIAL LOCAL SYM, LOOK FOR STE WITH SAME "NAME".
3163 ADDDD3: ADD B,[2,,2]
3164         JUMPGE B,POPBAJ ;NO ENTRY, THROW AWAY SYM.
3165         HLL A,(B)
3166         CAME A,(B)
3167          JRST ADDDD3    ;NOT THIS ONE.
3168         MOVE A,1(B)     ;SYM'S REAL NAME IS IN 2ND WD OF STE,
3169         MOVEM A,(B)
3170         MOVEM T,1(B)    ;PUT IN THE VALUE.
3171         JRST POPBAJ
3172
3173 ;TDDT EXITS THROUGH HERE.
3174 TDDTEX: PUSH P,A        ;MAKE SURE 1ST STE IN FILE IS PROGRAM NAME.
3175         PUSH P,B
3176         SKIPA A,DDPTR
3177 TDDTE1: ADD A,[2,,2]
3178         JUMPGE A,POPBAJ ;NO PROGRAM NAMES AT ALL => NO PROBLEM.
3179         MOVE B,(A)
3180         TLNE B,740000
3181          JRST TDDTE1    ;THIS NOT PROGRAM NAME.
3182         CAMN A,DDPTR
3183          JRST POPBAJ    ;IF IT'S ALREADY 1ST, NO PROBLEM.
3184         MOVE B,DDPTR
3185 REPEAT 2,[
3186         EXCH T,.RPCNT(A) ;EXCHANGE PROGRAM NAME WITH 1ST STE.
3187         EXCH T,.RPCNT(B)
3188         EXCH T,.RPCNT(A)]
3189         JRST POPBAJ
3190 \fISYM:  MOVSI C,(50*50*50*50*50*50)
3191         MOVSI T,40000   ;GLOBAL BIT
3192
3193 ISYM0:  ILDB A,CPTR
3194         CAIN A,"*
3195         TLZ T,40000     ;LOCAL
3196         CAIN A,"*
3197         JRST ISYM0
3198         CAIN A,">
3199         JRST LKUP
3200         SUBI A,"0-1
3201         CAIL A,"A-"0+1
3202         SUBI A,"A-"0+1-13
3203         JUMPGE A,ISYM2
3204         ADDI A,61
3205         CAIN A,60
3206         MOVEI A,45      ;.
3207 ISYM2:  IDIVI C,50
3208         IMUL A,C
3209         ADDM A,T
3210         JRST ISYM0
3211
3212 \f
3213 IFN ITS,[
3214 FRD2:   CAME B,[SIXBIT /@/]
3215         JRST DEVNAM
3216         SKIPA B,C
3217 FRD:    MOVSI B,(SIXBIT /@/)
3218         MOVSI C,(SIXBIT /@/)
3219         MOVE A,[(600)C-1]
3220 FRD1:   ILDB T,CPTR
3221         CAIE T,33
3222         CAIN T,DOLL
3223         JRST CHBIN      ;CHECK IF SHOULD CHANGE NAME 2 TO BIN
3224         TRC T,40
3225         JUMPE T,FRD2
3226         CAIN T,32
3227         JRST DEVSET
3228         CAIN T,33
3229         JRST USRSET
3230         CAIN T,77
3231         MOVEI T,0
3232         CAME A,[(600)C]
3233         IDPB T,A
3234         JRST FRD1
3235
3236
3237
3238
3239 USRSET: MOVEM C,SNAME
3240         JRST FRD+1
3241
3242 DEVNAM: PUSH P,CDEVN1
3243         MOVEM C,NM2
3244         JRST FRD+1
3245
3246 DEVNM1: TRO FF,SETDEV   ;SAY DEVICE SET
3247         HLRM C,DEV
3248         MOVE C,NM2
3249         JRST CHBIN      ;CHECK FOR CHANGE TO BIN
3250
3251 DEVSET: TRO FF,SETDEV   ;DEVICE SET
3252         HLRM C,DEV
3253         JRST FRD+1
3254
3255 CHBIN:  CAME B,[SIXBIT /@/]     ;WAS NO NAME2 SUPPLIED?
3256         POPJ P,                 ;NAME2 SUPPLIED, GO AWAY
3257         MOVE B,C                ;MAKE NAME1 INTO NAME2
3258 NODMCG, MOVSI C,(SIXBIT /REL/)  ;USE REL FOR NAME2
3259 DMCG,   MOVSI C,(SIXBIT /BIN/)
3260 CDEVN1: POPJ P,DEVNM1
3261 ]
3262 IFE ITS,[
3263 FRD:
3264         MOVE    B,[440700,,FILSTR]
3265
3266 FRD2:   ILDB    T,CPTR
3267         CAIE    T,DOLL
3268         CAIN    T,33
3269         JRST    FRD1            ; FINISHED
3270         IDPB    T,B
3271         JRST    FRD2
3272
3273 FRD1:   MOVEI   T,0
3274         IDPB    T,B             ; ASCIZ
3275         POPJ    P,
3276 ]
3277 CONSTANTS
3278 \f;IMPURE STORAGE
3279
3280 EISYM:  ;INITIAL SYMBOLS
3281
3282 CRELPT: SQUOZE 64,$R.
3283 FACTOR: 100
3284         0
3285 CPOINT: SQUOZE 64,$.
3286         100
3287         0
3288         SQUOZE 64,.LVAL1
3289 .VAL1:  0
3290         0
3291         SQUOZE 64,.LVAL2
3292 .VAL2:  0
3293         0
3294         SQUOZE 64,USDATL
3295 USDATP: 0
3296         0
3297 EISYME:
3298
3299 POLSW:  0                       ;-1=>WE ARE DOING POLISH
3300 PPDP:   -PPDL,,PPDB-1           ;INITIAL POLISH PUSH DOWN POINTER
3301 PPDB:   BLOCK   PPDL+1          ;POLISH PUSH DOWN BLOCK
3302 SATED:  0                       ;COUNT OF POLISH FIXUPS TO BE DELETED
3303 SATPDP: -SATPDL,,SATPDB-1       ;POINTER TO POLISH FIXUPS TO BE DELETED
3304 SATPDB: BLOCK   SATPDL+1        ;LIST OF POLISH FIXUPS TO BE DELETED
3305 SVSAT:  0                       ;# OF OPERANDS NEEDED
3306 POLPNT: 0                       ;POINTER TO POLISH CHAIN
3307 CGLOB:  0                       ;CURRENT GLOBAL IN SOME SENSE
3308 CGLOBV: 0                       ;CURRENT GLOBAL VALUE IN SOME SENSE
3309 GLBFS:  0                       ;GLOBAL BEING FIXED UP DURINGS DEFERED REQUEST
3310 SVHWD:  0                       ;WORD CURRENTLY BEING READ BY POLISH
3311 GLBCNT: 0                       ;# UNDEFINED FIXUPS DURING READING PHASE OF POLISH
3312 HEADNM: 0                       ;# POLISH FIXUPS SEEN
3313 LFTFIX: 0                       ;-1=> LEFT HALF FIXUP IN PROGRESS
3314 LINKDB: BLOCK   MNLNKS+1        ;LINK DATA BLOCK (END LINK,,CURRENT VALUE)
3315 HIBLK:  0                       ; BLOCKS IN HIGH SEG
3316 KEEP:   0                       ; FLAG SAYING WE ARE IN A CORE LOOP
3317 DMCG,[
3318 USINDX: 0                       ; USER INDEX
3319 ];DMCG
3320 HIGTOP: 0                       ; TOP OF HIGH SEG
3321 INPTR:  0                       ;HOLDS CURRENT IO POINTER
3322 STNBUF: BLOCK STNBLN            ;BUFFER FOR BLOCK READS
3323 PAT:    BLOCK   100
3324 PATEND==.+1
3325 CPTR:   0
3326 AWORD:  0
3327 ADRPTR: <INITCR*2000>(ADR)
3328 BPTR:   <INITCR*2000>(B)
3329 DPTR:   <INITCR*2000>(D)
3330 SA:     0
3331 TC:     0
3332 BITS:   0
3333 BITPTR: (300)BITS
3334 SAVPDL: 0
3335 LBOT:   INITCR*2000
3336 TIMES:  0
3337 COMLOC: ICOMM
3338 T1:     0
3339 T2:     0
3340 FLSH:   0
3341 PRGNAM: 0
3342
3343 ; CORE MANAGEMENT VARIABLES
3344
3345 NODMCG,[
3346 CWORD0: 4000,,400000+<<INITCR-1>_9.>
3347 CWORD1: 4000,,600000-1000
3348 LOWSIZ: INITCR          ; NUMBER BLOCKS WE GOT (IN LOW SEGMENT)
3349 ];NODMCG
3350 LOBLKS: INITCR+1        ; NUMBER OF BLOCKS OF CORE WE WANT
3351 PARBOT: 0               ; POINT TO BOTTOM OF SYMBOL TABLES
3352 PARTOP: 0               ; POINT TO TOP OF SAME
3353 PARLST: 0               ; LIST OF AVAILABLE 2 WORD BLOCKS
3354 QUADLS: 0               ; LIST OF AVAILABLE 4 WORD BLOCKS
3355 PARCUR: 0               ; TOP CURRENTLY IN USE SYMBOL TABLE CORE
3356
3357 DDPTR:  0               ; AOBJN POINTER TO CURRENT DDT SYMBOL TABLE
3358 DDTOP:  0               ; HIGHEST ALLOCATED FOR DDT
3359 DDBOT:  0               ; LOWEST ALLOCATED FOR DDT
3360
3361 HTOP:   0               ; TOP OF HASH TABLE
3362 HBOT:   0               ; BOTTOM OF HASH TABLE
3363 \fINIT:
3364 PDL:    IFN ITS,        .SUSET [.RSNAM,,SNAME]  ;GET INITIAL SYSTEM NAME
3365         MOVEI A,100
3366         MOVEM A,FACTOR
3367         MOVE NBLKS,[20,,INITCR]
3368         MOVEI A,ICOMM
3369         MOVEM A,COMLOC
3370         HLLZS LKUP3
3371         SETOM MEMTOP
3372         MOVEI A,FACTOR
3373         HRRM A,REL
3374         MOVE P,[-100,,PDL]
3375         PUSHJ P,KILL
3376 IFN ITS,[
3377         .OPEN TYOC,TTYO
3378         .VALUE 0
3379         .OPEN TYIC,TTYI
3380         .VALUE 0
3381         .STATUS TYIC,T
3382         ANDI T,77
3383         CAIN T,2
3384         TRO FF,GETTY
3385 ]
3386         MOVE TT,[SIXBIT /STINK./]
3387         PUSHJ P,SIXTYO
3388         MOVE TT,[.FNAM2]
3389         PUSHJ P,SIXTYO
3390 IFN ITS,        .SUSET [.RMEMT,,TT]
3391 IFE ITS,[
3392         MOVEI TT,INITCR*2000
3393 ]
3394         LSH TT,-10.
3395         MOVEM TT,LOWSIZ
3396         SUBI TT,1
3397         LSH TT,9.
3398         TDO TT,[4000,,400000]
3399         MOVEM TT,CWORD0
3400         JRST LIS
3401
3402 TTYO==.
3403         1,,(SIXBIT /TTY/)
3404         SIXBIT /STINK/
3405         SIXBIT /OUTPUT/
3406
3407 TTYI==.
3408         30,,(SIXBIT /TTY/)
3409         SIXBIT /STINK/
3410         SIXBIT /INPUT/
3411
3412 CONSTANTS
3413
3414 LOC PDL+LPDL
3415 CBUF:   BLOCK CBUFL
3416 FILSTR: BLOCK 10                ; GOOD FOR 40 CHARS
3417 LOSYM:  ;LOWEST LOC AVAIL FOR SYM TBL
3418 INITCR==<LOSYM+3000>/2000       ;LDR LENGTH IN BLOCKS
3419
3420 INFORM [HIGHEST USED]\LOSYM
3421 INFORM [LOWEST LOCATION LOADED ]\LOWLOD
3422 INFORM [COMMAND BUFFER LENGTH]\<CBUFL*5>
3423 INFORM [INITIAL CORE ALLOCATION]\INITCR
3424
3425 END PDL
3426 \ 3\ 3