<mdl.int>/stink.mid.1

   1 TITLE TSTINKING ODOR
   2
   3 ITS==0                  ; 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         CAIE T,15
1837         CAIN T,12
1838         JRST TYO
1839         CAIN T,^R
1840         JRST TYO
1841         POPJ P,
1842
1843 LIS:    ANDI FF,GETTY
1844 LI3:    MOVE A,[(10700)CBUF-1]
1845         MOVEM A,CPTR
1846         MOVE P,[(,-LPDL)PDL-1]
1847         PUSHJ P,CRLS
1848         TRZ FF,LOCF
1849 LI1:    TRZ FF,ALTF
1850 LI2:    PUSHJ P,TYI
1851         CAIN T,33
1852         MOVEI T,"\e
1853         CAIN T,7
1854         JRST LI3
1855         CAIN T,177      ;RUBOUT
1856         JRST LI4
1857         IDPB T,A
1858         CAMN A,[(10700)CBUF+CBUFL]
1859         JRST LI4
1860
1861 \f
1862 LIS1:   CAIE T,"\e
1863         JRST LI1
1864         TRON FF,ALTF
1865         JRST LI2
1866         PUSHJ P,CRL
1867 CD:     MOVEI D,0
1868 CD3:    TRZ FF,ARG
1869 CD2:    ILDB T,CPTR
1870         CAIL T,"0
1871         CAILE T,"9
1872         JRST CD1
1873         LSH D,3
1874         ADDI D,-"0(T)
1875 VALRET: TRO FF,ARG
1876         JRST CD2
1877
1878 CD1:    CAIE T,33
1879         CAIN T,DOLL     ;CHECK FOR A REAL DOLLAR SIGN
1880         JRST LI3
1881         CAIL T,"<
1882         CAILE T,"[
1883         JRST CD
1884         IDIVI T,4
1885         LDB T,DTAB(TT)
1886         MOVEI A,SLIS(T) ;WHERE TO?
1887         CAIE    A,DUMPY ;IS IT A DUMP
1888         TRZ FF,MLAST+SETDEV     ;NO, KILL FUNNY FLAGS
1889         CAIE    A,HASHS ; HASH SET?
1890         PUSHJ   P,HASHS1        ; MAYBE DO IT
1891         PUSHJ P,SLIS(T)
1892         JRST CD
1893         JRST VALRET
1894
1895
1896 \f
1897 SLIS:   TDZA C,C
1898 MLIS:   MOVEI C,2
1899         TRNE FF,GETTY
1900         PUSHJ P,FORMF
1901         TRNE FF,ARG
1902         JUMPL D,LISTER
1903         MOVE D,BOT
1904         JRST LISTER
1905
1906 LISTER: MOVE A,(D)
1907         LDB TT,[(410300)A]
1908         ORCMI   TT,7            ; -1 -> PROGNAME, -2 DEFINED , -4 UNDEFINED
1909         AOJN    TT,LIST2        ; NOT PROG NAME
1910 LIST4:  PUSHJ P,ASPT
1911 LIST5:  PUSHJ   P,VALPT
1912         JRST    LIST6
1913
1914 LIST2:  XOR     TT,C            ; TT/ -1 IF S AND DEF, OR ? AND UNDEF
1915         AOJE    TT,LIST7        ; PRINT VALUES
1916 LIST6:  HRRZ    D,LIST(D)       ; NEXT SYMBOL
1917         JUMPN   D,LISTER        ; MORE, GO ON
1918         JRST    CRL             ; DONE
1919
1920 LIST7:  PUSHJ   P,SPC           ; PRINT UNDEFINED SYMBOL
1921         PUSHJ   P,ASPT          ; PRINT SYMBOL
1922         PUSH    P,D
1923         TRNE    FF,ARG          ; SKIP IF 1?
1924         JUMPN   C,LIST9         ; JUMP IF ?
1925         PUSHJ   P,VALPT
1926         JRST    LIST8
1927 LIST9:  MOVE    D,1(D)          ; POINT TO CHAIN
1928         PUSHJ   P,VALPT
1929         HRRZ    D,(D)
1930         JUMPN   D,.-2
1931 LIST8:  POP     P,D
1932         JRST    LIST6
1933
1934 VALPT:  PUSHJ   P,TAB
1935         HRRZ    T,1(D)          ; SMALL VAL
1936         TRNN    FF,ARG          ; ARG GIVEN?
1937         SKIPN   C               ; OR SS COMM
1938         MOVE    T,1(D)          ; USE FULL WORD
1939         JRST    OPTCR           ; PRINT
1940 \f
1941 ; INITIALIZES ALL AREAS OF CORE
1942
1943 HASHS:  MOVE    A,D             ; SIZE TO A
1944         TRNN    FF,ARG          ; SKI IF ARG GIVEN
1945 HASHS1: MOVEI   A,INHASH        ; USE INITIAL
1946         SKIPE   HBOT            ; SKIP IF NOT DONE
1947         POPJ    P,
1948         PUSH    P,A             ; NOW SAVEE IT
1949         PUSH    P,T
1950         PUSH    P,B
1951
1952         MOVEI   B,LOSYM ; CURRENT TOP
1953         ADDI    A,LOSYM
1954         CAIG    A,<INITCR*2000> ; MORE CORE NEEDED?
1955         JRST    HASHS3          ; NO, OK
1956         SUBI    A,<INITCR*2000>+1777
1957         ASH     A,-10.
1958 HASHS2: PUSHJ   P,CORRUP                ; UP THE CORE
1959         SOJN    A,.-1           ; FOR ALL BLOCKS
1960
1961 HASHS3: MOVEM   B,HBOT          ; STORE AS BOTTOM OF HASH TABLE
1962         ADD     B,-2(P)         ; ADD LENGTH
1963         MOVEM   B,HTOP          ; INTOTOP
1964
1965         ADDI    B,1             ; BUMP
1966         MOVEM   B,PARBOT        ; SAVE AS BOTTOM OF LOADER TABLE AREA
1967         MOVEM   B,PARCUR        ; ALSO AS  CURRENT PLACE
1968
1969         MOVE    B,LOBLKS        ; CURRENT TOP OF CORE
1970         PUSHJ   P,CORRUP
1971         ASH     B,10.           ; WORDS
1972         SUBI    B,1
1973         MOVEM   B,PARTOP
1974         ADDI    B,1             ; NOW DDT TABLE
1975         MOVEM   B,DDBOT
1976         ADDI    B,1777
1977         MOVEM   B,DDPTR
1978         MOVEM   B,DDTOP         ; TOP OF DDT TABLE
1979         ADDI    B,1
1980         HRRM    B,ADRPTR        ; INTO CORE SLOTS
1981         HRRM    B,BPTR
1982         HRRM    B,DPTR
1983
1984         PUSHJ   P,CORRUP        ; INITIAL CCORE BLOCK
1985
1986         PUSHJ   P,GETMEM
1987
1988 ; SET UP INIT SYMBOLS
1989
1990         MOVE    C,[EISYM-EISYME,,EISYM]
1991
1992 SYMINT: MOVE    A,(C)
1993         TLZ     A,600000
1994         MOVE    B,HTOP
1995         SUB     B,HBOT
1996         IDIVI   A,(B)           ; HASH IT
1997         ADD     B,HBOT
1998         HRRZ    A,(B)           ; GET CONTENTS
1999         HRROM   C,(B)
2000         HRRM    A,BUCK(C)
2001         HRLM    B,BUCK(C)
2002         SKIPE   A
2003         HRLM    C,(A)
2004         ADD     C,[3,,3]
2005         JUMPL   C,SYMINT
2006
2007
2008         POP     P,B
2009         POP     P,T
2010         POP     P,A
2011         POPJ    P,
2012
2013 CORRUP: PUSHJ P,GETCOR
2014 IFN ITS,[
2015         PUSHJ   P,SCE
2016         SKIPE   KEEP
2017         PUSHJ   P,WINP          ; WE HAVE THE CORE, TELL LOSER
2018 ]
2019         JFCL
2020         AOS     NBLKS
2021         AOS     LOBLKS
2022 CCRL:   POPJ    P,CRL
2023
2024 IFN ITS,TMSERR: JRST    SCE
2025 \f
2026
2027 EQLS:   MOVE T,D
2028 OPTCR:  PUSH P,CCRL
2029 OPT:    MOVEI TT,10
2030         HRRM TT,OPT1
2031 OPT2:   LSHC T,-43
2032         LSH TT,-1
2033 OPT1:   DIVI T,10
2034         HRLM TT,(P)
2035         JUMPE T,.+2
2036         PUSHJ P,OPT2
2037         HLRZ T,(P)
2038         ADDI T,260
2039 TYOM:   JRST TYO
2040
2041 TAB:    PUSHJ P,SPC
2042         PUSHJ P,TYO
2043         JRST TYO
2044
2045 CRLS:   TRNE FF,GETTY
2046         PUSH P,[CRLS1]
2047 CRL:    MOVEI T,15
2048         PUSHJ P,TYO
2049 CRT:    SKIPA T,C.12
2050 FORMF1: MOVEI T,"C
2051 TYO:    IFN ITS,        .IOT TYOC,T
2052 IFE ITS,[
2053 IFN T-1,[
2054         MOVEM   1,JSYS1
2055         MOVE    1,T
2056 ]
2057         PBOUT
2058 IFN T-1,        MOVE    1,JSYS1
2059
2060 C.12:   POPJ P,12
2061
2062 CRLS1:  MOVEI T,"*
2063         JRST TYO
2064
2065 FORMF:  POPJ    P,12
2066 \f
2067 TDDT:   SKIPE LINKDB    ;TEST FOR LINK HACKAGE
2068         PUSHJ P,LNKFIN  ;CLEAN UP LINKS
2069         PUSH P,[TDDTEX] ;MAKE SURE 1ST SYM IS A PROGRAM NAME, FOR DDT'S SAKE.
2070         HRRZ D,BOT
2071         TRO FF,GLOSYM
2072
2073 SYMS:   JUMPE   D,SYMS5         ; DONE, QUIT
2074         MOVE    A,(D)           ; GET SYMBOL
2075         TLNN    A,200000        ; SKIP IF DEFINED
2076         JRST    SYMS6
2077         TLNE    A,40000         ; SKIP IF LOCAL
2078         TRNE    FF,GLOSYM       ; SKIP IF GLOBALS NOT ACCEPTABLE
2079         TLNE    A,100000        ; HERE IF LOCAL OR WINNING GLOBAL, SKIP IF NOT PROG NAME
2080         JRST    SYMS6           ; LOSER, OMIT
2081         TRNN    FF,GLOSYM       ; SKIP IF GLOBAL
2082         SKIPL   SYMSW           ; SKIP IF NO LOCALS
2083         JRST    SYMS3           ; WINNER!!!, MOVE IT OUT
2084
2085 SYMS8:  HRRZ    A,LIST(D)       ; POINT TO NEXT
2086         PUSH    P,A             ; AND SAVE
2087         MOVEM   D,T2            ; SAVE FOR PATCH
2088         PUSHJ   P,PATCH         ; FLUSH FROM TABLE
2089         POP     P,D             ; POINT TO NEXT
2090         JRST    SYMS
2091
2092 SYMS6:  HRRZ    D,LIST(D)       ; POINT TO NEXT SYMBOL
2093         JRST    SYMS            ; AND CONTINUE
2094
2095 SYMS3:  TRZ FF,NOTNUM   ;ASSUME ALL NUMERIC
2096         TLZ A,740000
2097         MOVE T,A        ;SEE IF IT IS A FUNNY SYMBOL
2098         IDIVI T,50      ;GET LAST CHAR IN TT
2099         JUMPE TT,OKSYM
2100 DIVSYM: CAIG TT,12      ;IS THE SYMBOL > 9
2101         CAIGE TT,1      ;AND LESS THAN OR EQUAL TO 0
2102         TRO FF,NOTNUM   ;NO, SAY NOT A NUMBER
2103         IDIVI T,50      ;CHECK NEXT
2104         JUMPE TT,SYMS8  ;NULL IN THE MIDDLE LOSES
2105         JUMPN T,DIVSYM  ;DIVIDE UNTIL T IS 0
2106         CAIN TT,21      ;IS THIS A "G"
2107         TRNE FF,NOTNUM  ;YES, SKIP IF SYMBOL OF FORM "GXXXXX" X IS A DIGGIT
2108         JRST  OKSYM     ;WIN
2109         JRST SYMS8      ;LOSE
2110 OKSYM:  MOVE T,1(D)
2111         HRRZ    C,LIST(D)       ; POINT TO NEXT
2112         PUSH    P,C
2113         MOVEM   D,T2
2114         PUSHJ   P,PATCH         ; FLUSH IT
2115         POP     P,D
2116         TLO A,40000
2117         TRNN FF,GLOSYM
2118         TLC A,140000    ;DDT LOCAL
2119         TLNN A,37777    ;IF SQUOZE "NAME" < 1000000,
2120         PUSHJ P,ADDDD2  ;TREAT SPECIALLY (IT IS MIDAS'S SYMTAB IDX)
2121         TLNE A,37777
2122         PUSHJ   P,ADDDDT
2123         JRST SYMS
2124
2125 SYMS5:  POPJ    P,
2126 \fGO:    TRNE FF,ARG
2127         MOVEM D,SA
2128         TRO FF,GOF
2129         JRST DDT
2130
2131 EXAM:   CAMLE D,MEMTOP
2132         JRST    TRYHI           ; COULD BE IN HIGH SEG
2133         MOVE T,@DPTR
2134         JRST OPTCR
2135
2136 TRYHI:  TRNE    D,400000        ; SKIP IF NOT HIGH
2137         CAMLE   D,HIGTOP        ; SKIP IF OK
2138         (3000+SIXBIT /NEM/)
2139         MOVE    T,(D)           ; GET CONTENTS
2140         JRST    OPTCR
2141
2142 C.CD2:  POPJ P,CD2
2143
2144 GETCOM: MOVE A,[10700,,CBUF-1]
2145         MOVEM A,CPTR
2146         MOVE P,[(,-LPDL)PDL-1]
2147         PUSH P,C.CD2
2148         MOVEM P,SAVPDL
2149 IFN ITS,[
2150         MOVEI T,0       ;REOPEN CHANNEL IN ASCII MODE
2151         HLLM T,DEV
2152         .OPEN TPCHN,DEV ;RE OPEN
2153         JRST FNF2       ;LOSE
2154 ]
2155 IFE ITS,[
2156         MOVEM   1,JSYS1
2157         MOVEM   2,JSYS2
2158         MOVEM   3,JSYS3
2159         MOVSI   1,100001
2160         HRROI   2,FILSTR
2161         GTJFN
2162         JRST    .+3
2163         MOVE    2,[070000,,200000]
2164         OPENF
2165         MOVEI   1,0
2166         MOVEM   1,IJFN
2167         MOVE    1,JSYS1
2168         MOVE    2,JSYS2
2169         MOVE    3,JSYS3
2170         SKIPN   IJFN
2171         JRST    FNF
2172 ]
2173 GTCM1:
2174 IFN ITS,        .IOT TPCHN,T
2175 IFE ITS,[
2176         MOVEM 1,JSYS1
2177         MOVEM 2,JSYS2
2178         MOVEM 3,JSYS3
2179
2180         MOVE 1,IJFN
2181         MOVE 2,[070700,,T]
2182         MOVNI 3,1
2183         SIN
2184
2185         SKIPGE 3
2186         MOVNI T,1
2187         MOVE 1,JSYS1
2188         MOVE 2,JSYS2
2189         MOVE 3,JSYS3
2190 ]
2191         JUMPL T,FIXOPN  ;JUMP IF EOF
2192         CAIN T,3        ;CHECK FOR EOF
2193         JRST FIXOPN     ;IF SO QUIT
2194         CAIL T,"a
2195         CAILE T,"z
2196         CAIA
2197         SUBI T,40
2198         IDPB T,A        ;DEPOSIT CHARACTER
2199         CAME A,[10700,,CBUF+CBUFL]
2200         JRST GTCM1
2201 TPOK:   SKIPA T,BELL
2202 ERR:    MOVE T,"?
2203 IFN ITS,        .IOT TYOC,T
2204 IFE ITS,[
2205         MOVEM 1,JSYS1
2206         MOVE 1,T
2207         PBOUT
2208         MOVE 1,JSYS1
2209 ]
2210         PUSHJ P,FIXOPN  ;FIX UP OPEN CODE
2211         JRST LI3
2212
2213 ;HERE TO RESET OPEN
2214
2215 FIXOPN: MOVEI T,6
2216         HRLM T,DEV
2217         POPJ P,
2218
2219 FNF2:   PUSHJ P,FIXOPN
2220         JRST FNF
2221
2222 \f
2223 PAPER:  MOVEI A,(SIXBIT /PTR/)
2224         HRRM A,DEV
2225         POPJ P, ;REAL OPEN WILL OCCUR LATER
2226
2227 UTAP:   TRZN FF,ARG
2228         JRST OPNTP
2229         TRO FF,SETDEV   ;SETTING DEVICE
2230         MOVE A,DEVTBL(D)
2231         HRRM A,DEV
2232 OPNTP:  TRO FF,MLAST    ;SET M LAST COMMAND
2233         PUSHJ P,FRD
2234 IFN ITS,        .SUSET [.SSNAM,,SNAME]
2235         MOVEM B,NM1
2236         MOVEM C,NM2
2237         POPJ P, ;REAL OPEN WILL OCCUR LATER
2238
2239 OPNPTR:
2240 IFN ITS,[
2241         .OPEN TPCHN,DEV
2242         JRST FNF
2243         JRST RDFRST     ;STAART UP THE READ ING
2244 ]
2245 IFE ITS,[
2246         MOVEM   1,JSYS1
2247         MOVEM   2,JSYS2
2248         MOVEM   3,JSYS3
2249         MOVSI   1,100001
2250         HRROI   2,FILSTR
2251         GTJFN
2252         JRST    .+3
2253
2254         MOVE    2,[440000,,200000]
2255         OPENF
2256         MOVEI   1,0
2257         MOVEM   1,IJFN
2258         MOVE    1,JSYS1
2259         MOVE    2,JSYS2
2260         MOVE    3,JSYS3
2261         SKIPN   IJFN
2262         JRST    FNF
2263         JRST    RDFRST
2264 ]
2265 NTS:    (3000+SIXBIT /NTS/)
2266
2267 DEV:    6,,(SIXBIT /DSK/)
2268 NM1:    SIXBIT /BIN/
2269 NM2:    SIXBIT /BIN/
2270 0
2271 SNAME:  0               ;SYSTEM NAME
2272 JSYS1:  0
2273 JSYS2:  0
2274 JSYS3:  0
2275 IJFN:   0
2276 OUTJFN: 0
2277
2278 SIXTYO: JUMPE TT,CPOPJ
2279         MOVEI T,0
2280         LSHC T,6
2281         ADDI T,40
2282         PUSHJ P,TYO
2283         JRST SIXTYO
2284
2285 JOB:    PUSHJ P,FRD
2286         MOVEM B,JOBNAM
2287         TRO FF,JBN
2288         POPJ P,
2289
2290 JOBNAM: 0
2291
2292
2293 DEVTBL: IRPS DEV,,[DSK UT1 UT2 UT3 UT4 UT5 UT6 UT7 UT8]
2294         (SIXBIT /DEV/)
2295         TERMIN
2296
2297 FNF:    PUSHJ P,TYPFIL
2298         REPEAT 2,PUSHJ P,SPC
2299 IFN ITS,[
2300         .OPEN ERCHN,ERRBL       ;OPEN ERROR DEVICE
2301         JRST .-1        ;DON'T TAKE NO FOR AN ANSWER
2302
2303 ERLP:   .IOT ERCHN,A    ;READ A CHAR
2304         CAIE A,14       ;IF FORM FEED
2305         CAIN A,3        ;OR ^C
2306         JRST ERDON      ;STOP
2307
2308         .IOT TYOC,A     ;PRINT
2309         JRST ERLP
2310
2311 ERDON:  .CLOSE ERCHN,
2312 ]
2313
2314         JRST LI3
2315
2316
2317 ERRBL:  (SIXBIT /ERR/)  ;ERROR DEVICE
2318         2
2319         TPCHN
2320
2321
2322 TYPFIL:
2323 IFN ITS,[
2324         MOVSI A,-4
2325         HRLZ TT,DEV
2326         JRST .+3
2327 TYPF2:  SKIPN TT,DEV(A)
2328         AOJA    A,.-1
2329         PUSHJ P,SIXTYO
2330         MOVE T,TYPFTB(A)
2331         PUSHJ P,TYO
2332         AOBJN A,TYPF2
2333         POPJ P,
2334
2335 TYPFTB: ":
2336         40
2337         40
2338         0
2339         ";
2340 ]
2341 IFE ITS,[
2342         MOVE A,[440700,,FILSTR]
2343
2344         ILDB T,A
2345         JUMPE T,.+3
2346         PUSHJ P,TYO
2347         JRST .-3
2348         POPJ P,
2349 ]
2350
2351
2352
2353 ]\f
2354 LOADN:  SKIPA C,SYMFLG
2355 LOADG:  MOVEI C,DDSYMS
2356         PUSHJ P,OPNPTR  ;DO THE REAL OPEN (AND FIRST READ)
2357
2358         MOVEM C,SYMSW
2359
2360 RESTAR: MOVEM P,SAVPDL
2361         CLEARB CKS,TC
2362         CLEARB RH,AWORD
2363         PUSH P,CJMP1
2364 RESETT: MOVEI A,FACTOR  ;LEAVE GLOBAL LOCATION MODE
2365         HRRM A,REL
2366         TRZA FF,UNDEF+GPARAM+INDEF+GLOSYM+SEARCH+CODEF+COND
2367 SFACT:  MOVEM D,FACTOR
2368 CJMP1:  POPJ P,JMP1
2369
2370 KILL:   POPJ    P,
2371 COMVAL: SKIPA   COMLOC
2372 SADR:   HRRZ D,SA
2373 POPJ1:  AOSA (P)
2374 COMSET: MOVEM D,COMLOC
2375 BELL:   POPJ P,7
2376
2377 LBRAK:  MOVEM D,T1
2378         TRZ FF,LOSE
2379         PUSHJ P,ISYM
2380         MOVE T,T1
2381         TRO FF,GPARAM
2382         TRZE FF,ARG
2383         JRST DFSYM2
2384         TLNN B,200000
2385         (3000+SIXBIT /UND/)
2386         MOVE D,1(D)
2387         TRZN FF,LOSE
2388         JRST POPJ1
2389         (2000+SIXBIT /UND/)
2390
2391 SOFSET: HRRM D,LKUP3
2392 CPOPJ:  POPJ P,
2393 \f
2394
2395 BEG:    MOVE D,FACTOR
2396         JRST POPJ1
2397
2398 DDT:    SKIPN JOBNAM
2399         JRST NJN
2400         PUSHJ P,TDDT
2401         MOVE A,JOBNAM
2402         HRR B,BPTR
2403         ADDI B,30
2404         HRRM B,YPTR
2405         HRLI B,440700
2406         MOVEI D,^W
2407         IDPB D,B
2408         MOVE C,[(000600)A-1]
2409         MOVEI T,6
2410 DDT2:   ILDB D,C
2411         JUMPE D,DDT1
2412         ADDI D,40
2413         IDPB D,B
2414         SOJG T,DDT2
2415 \fDMCG,[
2416 DDT1:   MOVEI C,[CONC69 ASCIZ \\e\eJ,\SA,[/\e9B!\eQ\r],\DDPTR,[/\eQ\e\19:VP \]]
2417         HRLI C,440700
2418 DDT6:   ILDB T,C
2419         IDPB T,B
2420         JUMPN T,DDT6    ;END OF STRING MARKED WITH ZERO BYTE
2421         MOVE T,SA       ;GET STARTING ADDRESS
2422         TLNN T,777000   ;IF INSTRUCTION PART ZERO,
2423         TLO T,(JRST)    ;THEN TURN INTO JRST
2424         MOVEM T,SA      ;USE AS STARTING ADDRESS
2425         TRNE FF,GOF     ;IF G COMMAND,
2426         MOVEM T,EXIT    ;THEN USE AS LOADER EXIT
2427         MOVE B,LOBLKS   ;GET CURRENT CORE ALLOCATION+1
2428         SUBI B,1(NBLKS) ;REDUCE TO PROGRAM CORE ALLOCATION
2429         HRRM B,PALLOC   ;SAVE IN EXIT ROUTINE
2430         LSH B,10.       ;SHIFT TO MEMORY LOCATION
2431         SUBI B,1        ;REDUCE TO TOP LOCATION IN CORE OF PROGRAM
2432         HRRM B,PMEMT    ;SAVE FOR MAIN PROGRAM BLT (DON'T LET NON-ZERO CORE ABOVE PROGRAM STAY AROUND)
2433         HRLZ 17,BPTR    ;GET LOCATION OF BEGINNING OF PROGRAM IN LH(17)
2434         ADDM 17,PSV17   ;17 BLT POINTER FOR AC'S, TURN SV17 INTO BLT POINTER FOR PROGRAM
2435         MOVE B,EXBLTP   ;GET EXIT ROUTINE BLT POINTER
2436 YPTR:
2437 IFN ITS,        .VALUE          ;ADDRESS POINTS TO VALRET STRING
2438 IFE ITS,        HALTF
2439                 ;DON'T TRY TO STOP THEN START STINK AFTER HERE (AFTER BREAKPOINT OR WITH $G)
2440         BLT B,LEXEND    ;BLT IN EXIT ROUTINE
2441         BLT 17,17       ;BLT IN PROGRAM AC'S
2442         EXCH 17,SV17    ;SAVE PROGRAM LOCATION 17, SET UP BLT POINTER
2443 IFN ITS,[
2444         .CLOSE TYOC,
2445         .CLOSE TYIC,
2446         .CLOSE TPCHN,
2447 ]
2448 IFE ITS,[
2449         MOVEM 1,JSYS1
2450         MOVE 1,IJFN
2451         CLOSF
2452         JFCL
2453         MOVE 1,JSYS1
2454 ]
2455         JRST LEXIT
2456
2457                 ;EXIT ROUTINE FROM LOADER
2458                 ;BLT'ED INTO 30 - 30+N
2459
2460 EXBLTP: .+1,,LEXIT      ;BLT POINTER
2461         OFST==30-.      ;LEXIT=30
2462 LEXIT=.+OFST
2463 PMEMT:  BLT 17,         ;BLT DOWN MAIN PROGRAM
2464         MOVE 17,SV17    ;GIVE USER HIS LOCATION 17
2465 PALLOC:
2466 IFN ITS,        .CORE           ;REDUCE CORE ALLOCATION TO WHAT REQUIRED BY PROGRAM
2467 IFE ITS,        SKIPA
2468 PSV17:  SV17=.+OFST
2469         40,,40          ;40 FIRST PROGRAM ADDRESS LOADED INTO
2470 EXIT:
2471 IFN ITS,        .VALUE LEXEND
2472 IFE ITS,        HALTF
2473 LEXEND=.+OFST
2474         0               ;END OF EXIT ROUTINE
2475 ];DMCG
2476 \fNODMCG,[
2477 DDT1:   MOVE T,SA       ;GET STARTING ADDRESS
2478         TLNN T,777000   ;IF INSTRUCTION PART ZERO,
2479         TLO T,(JRST)    ;THEN TURN INTO JRST
2480         MOVEM T,SA      ;USE AS STARTING ADDRESS
2481         TRNE FF,GOF     ;IF G COMMAND,
2482         MOVEM T,EXIT    ;THEN USE AS LOADER EXIT
2483         MOVEI T,DDT4    ;MAKE OPT GO TO DDT4
2484         HRRM T,TYOM     ;INSTEAD OF TYO
2485         MOVEI C,[ASCIZ \\e\eJ\e9B/#0\r#1\e\19\eP\16\]     ;# CAUSES FOLLOWING DIGIT TO BE INTERPRETED AS INDEX INTO DDTST
2486         HRLI C,440700
2487         PUSHJ P,DDTSG   ;GENERATE REST OF STRING
2488         MOVE B,LOWSIZ   ;GET CURRENT CORE ALLOCATION
2489         SUBI B,(NBLKS)  ;REDUCE TO PROGRAM CORE ALLOCATION
2490         MOVE C,B        ;SAVE OUR SIZE
2491         LSH B,10.       ;SHIFT TO MEMORY LOCATION
2492         SUBI B,1        ;REDUCE TO TOP LOCATION IN CORE OF PROGRAM
2493         HRRM B,PMEMT    ;SAVE FOR MAIN PROGRAM BLT (DON'T LET NON-ZERO CORE ABOVE PROGRAM STAY AROUND)
2494         SUB C,LOWSIZ
2495         MOVNM C,PALL0   ;NUMBER OF BLOCKS TO FLUSH
2496         MOVE C,CWORD0
2497         TRZ C,400000    ;DELETE PAGE
2498         HRRZM C,PALL1
2499         HRLZ 17,BPTR    ;GET LOCATION OF BEGINNING OF PROGRAM IN LH(17)
2500         ADDM 17,PSV17   ;17 BLT POINTER FOR AC'S, TURN SV17 INTO BLT POINTER FOR PROGRAM
2501         MOVE B,EXBLTP   ;GET EXIT ROUTINE BLT POINTER
2502 YPTR:
2503 IFN ITS,        .VALUE          ;ADDRESS POINTS TO VALRET STRING
2504 IFE ITS,        HALTF
2505                 ;DON'T TRY TO STOP THEN START STINK AFTER HERE (AFTER BREAKPOINT OR WITH $G)
2506         BLT B,LEXEND    ;BLT IN EXIT ROUTINE
2507         BLT 17,17       ;BLT IN PROGRAM AC'S
2508         EXCH 17,SV17    ;SAVE PROGRAM LOCATION 17, SET UP BLT POINTER
2509 IFN ITS,[
2510         .CLOSE TYOC,
2511         .CLOSE TYIC,
2512         .CLOSE TPCHN,
2513 ]
2514 IFE ITS,[
2515         MOVEM 1,JSYS1
2516         MOVE 1,IJFN
2517         CLOSF
2518         JFCL
2519         MOVE 1,JSYS1
2520 ]
2521         JRST LEXIT
2522
2523 DDTST:  MOVE T,SA       ;#0
2524         MOVE T,DDPTR    ;#1
2525
2526 DDTSN:  ILDB T,C        ;GET DIGIT AFTER NUMBER SIGN
2527         XCT DDTST-"0(T) ;GET VALUE IN T
2528         PUSHJ P,OPT     ;"TYPE OUT" INTO VALRET STRING IN OCTAL
2529 DDTSG:  ILDB T,C        ;GET CHAR FROM INPUT STRING
2530         CAIN T,"#       ;NUMBER SIGN?
2531         JRST DDTSN      ;NUMBER SIGN, INTERPRET FOLLOWING DIGIT
2532         IDPB T,B        ;DEPOSIT IN OUTPUT STRING
2533         JUMPN T,DDTSG   ;LOOP ON NOT DONE YET
2534         POPJ P,
2535
2536                 ;EXIT ROUTINE FROM LOADER
2537                 ;BLT'ED INTO 20 - 20+N
2538
2539 EXBLTP: .+1,,LEXIT              ;BLT POINTER
2540         OFST==20-.              ;OFFSET, THIS CODE DESTINED FOR LEXIT
2541 LEXIT=.+OFST                    ;LEXIT=20
2542
2543 PMEMT:  BLT 17,                 ;BLT DOWN MAIN PROGRAM
2544         MOVE 17,PALL1+OFST
2545 IFN ITS,        .CBLK 17,
2546 IFE ITS,        SKIPA
2547 PSV17:  40,,40                  ;40 FIRST PROGRAM ADDRESS LOADED INTO
2548         SUBI 17,1000
2549         SOSLE PALL0+OFST
2550         JRST .+OFST-4
2551         MOVE 17,PSV17+OFST      ;GIVE USER HIS LOCATION 17
2552 EXIT:
2553 IFN ITS,        .VALUE .+OFST+1
2554 IFE ITS,        HALTF
2555 PALL0:  0
2556 PALL1:  0
2557
2558 LEXEND=.+OFST-1                 ;END OF EXIT ROUTINE
2559 SV17=PSV17+OFST                 ;LOCATION TO SAVE 17
2560 ];NODMCG
2561 \f
2562 NJN:    TRZ FF,GOF
2563         (3000+SIXBIT /NJN/)
2564
2565 ZERO:   MOVEI A,(NBLKS)
2566         MOVEM A,LOBLKS
2567         PUSHJ P,GETCOR
2568 IFN ITS,[
2569         PUSHJ P,SCE     ;GO TO ERROR
2570         SKIPE   KEEP
2571         PUSHJ   P,WINP
2572 ]
2573         JFCL
2574         SETOM MEMTOP
2575         MOVEI A,1(NBLKS)
2576         MOVEM A,LOBLKS
2577 GETMEM: PUSHJ P,GETCOR
2578 IFN ITS,[
2579         PUSHJ P,SCE
2580         SKIPE   KEEP
2581         PUSHJ   P,WINP
2582 ]
2583         JFCL
2584
2585         ADDI MEMTOP,2000
2586         AOS LOBLKS
2587         POPJ P,
2588
2589 GETCOR:
2590 DMCG,[
2591 IFN ITS,[
2592         .CORE @LOBLKS
2593         POPJ P,
2594 ]
2595         JRST POPJ1
2596 ];DMCG
2597
2598 NODMCG,[
2599         PUSH P,A
2600         PUSH P,B
2601         MOVE B,LOBLKS
2602         SUB B,LOWSIZ    ;NUMBER OF BLOCKS WE WANT
2603         JUMPE B,GETC2
2604         SKIPG B
2605 IFN ITS,        .VALUE
2606 IFE ITS,        HALTF
2607         MOVE A,CWORD0
2608 GETC1:  ADDI A,1000
2609 IFN ITS,[
2610         .CBLK A,
2611         JRST POPBAJ
2612 ]
2613         MOVEM A,CWORD0
2614         AOS LOWSIZ
2615         SOJG B,GETC1
2616 GETC2:  AOS -2(P)       ;SKIP RETURN
2617         JRST POPBAJ
2618 ];NODMCG
2619
2620 IFN ITS,[
2621 SCE:    SOS (P) ;MAKE POPJ BE A "JRST .-1"
2622         SOS (P)
2623         PUSHJ P,COREQ   ;ASK LOSER
2624         POPJ P, ;HE SAID YES
2625         (2000+SIXBIT /SCE/)
2626
2627 COREQ:  PUSH P,A        ;SAVE SOME ACS
2628         SKIPE   KEEP    ; SKIP IF NOT LOOPING
2629         JRST    COREQ3
2630 COREQ0: MOVEI A,[ASCIZ /NO CORE:
2631         TYPE C TO TRY INDEFINITELY
2632         TYPE Y TO TRY ONCE
2633         TYPE N TO LOSE/]
2634
2635         PUSHJ P,LINOUT
2636         .IOT TYIC,A     ;READ A CHARACTER
2637         .RESET  TYIC,
2638         CAIN    A,"N    ; WANTS LOSSAGE?
2639         JRST    COREQ2
2640         CAIN    A,"Y
2641         JRST    POPAJ
2642         CAIE    A,"C
2643         JRST    COREQ0
2644         AOSA    KEEP
2645 COREQ2: AOS     -1(P)
2646         JRST    POPAJ
2647
2648 COREQ3: MOVEI   A,1
2649         .SLEEP  A,
2650         JRST    POPAJ
2651 ]
2652 ;ROUTINE TO PRINT A LINE
2653
2654 LINOUT: PUSH P,C
2655         PUSH P,B
2656         MOVSI B,440700+A        ;BYTE POINTER TO INDEX OF A
2657
2658 LINO1:  ILDB C,B        ;GET CHAR
2659         JUMPE C,LINO2   ;ZERO, END
2660 IFN ITS,        .IOT TYOC,C
2661 IFE ITS,[
2662         EXCH C,1
2663         PBOUT
2664         EXCH C,1
2665 ]
2666         JRST LINO1
2667
2668 LINO2:  MOVEI A,15      ;PUT OUT CR
2669 IFN ITS,        .IOT TYOC,A
2670 IFE ITS,[
2671         EXCH A,1
2672         PBOUT
2673         EXCH A,1
2674 ]
2675         POP P,B
2676         POP P,C
2677         POPJ P,
2678
2679 WINP:   PUSH    P,A
2680         MOVEI   A,[ASCIZ /WIN!!!/]
2681         PUSHJ   P,LINOUT
2682         SETZM   KEEP
2683         JRST    POPAJ
2684 \f
2685 DEFINE FOUR A,B,C,D
2686         (<<A-SLIS>_9>+B-SLIS)<<C-SLIS>_9>+D-SLIS
2687         TERMIN
2688
2689 DTAB:   (331100+T)DTB-74/4
2690         (221100+T)DTB-74/4
2691         (111100+T)DTB-74/4
2692         (1100+T)DTB-74/4
2693
2694 DTB:    FOUR LBRAK,EQLS,ERR,MLIS,       ;< = > ?
2695         FOUR GETCOM,ERR,BEG,COMSET,     ;@ A B C
2696         FOUR DDT,NTS,NTS,GO,            ;D E F G
2697         FOUR HASHS,ERR,JOB,KILL,        ;H I J K
2698         FOUR LOADG,UTAP,LOADN,SOFSET,   ;L M N O
2699         FOUR PAPER,COMVAL,SFACT,SLIS,   ;P Q R S
2700         FOUR CPOPJ,ERR,ERR,ERR,         ;T U V W
2701         FOUR SADR,DUMPY,ZERO,EXAM,      ;X Y Z [
2702
2703 IFLE 1000-DDT+SLIS,[PRINTX /DISPATCH OVERFLOW
2704 /]
2705 INFORM [DISPATCH ROOM]\<1000-DDT+SLIS>
2706
2707 \f
2708 ;THIS CODE DUMPS THE LOADED CORE IMAGE INTO A DISK FILE AND THEN CAUSES
2709 ;STINK TO KILL ITSELF.
2710
2711 DUMPY:
2712 IFN ITS,[
2713         TRZN FF,MLAST   ;WAS "M" THE LAST COMMAND?
2714         PUSHJ P,FIXFIL  ;FIX UP THE FILE NAME
2715         MOVEI A,(SIXBIT /DSK/)
2716         TRZN FF,SETDEV  ;WAS DEVICE SET?
2717         HRRM A,DEV      ;NO, SET IT
2718
2719         .OPEN TPCHN,DEV ;SEE IF IT EXISTS
2720         JRST OPNOK      ;NO, WIN
2721
2722         .CLOSE TPCHN,   ;CLOSE IT
2723         .FDELE DEV      ;DELETE IT
2724         JFCL    ;IGNORE LOSSAGE
2725
2726 OPNOK:  MOVSI A,7       ;SET DEVICE SPEC TO BE WRITE/IMAGE/BLOCK
2727         HLLM A,DEV
2728         .OPEN TPCHN,DEV ;OPEN THE CHANNEL
2729         JRST FNF
2730 ]
2731 IFE ITS,[
2732         MOVEM   1,JSYS1
2733         MOVEM   2,JSYS2
2734         MOVEM   3,JSYS3
2735         MOVSI   1,1
2736         HRROI   2,FILSTR
2737         GTJFN
2738         JRST    .+3
2739         MOVE    2,[440000,,300000]
2740         OPENF
2741         MOVEI   1,0
2742         MOVEM   1,OUTJFN
2743         MOVE    1,JSYS1
2744         MOVE    2,JSYS2
2745         MOVE    3,JSYS3
2746         SKIPN   OUTJFN
2747         JRST    FNF
2748 ]
2749         PUSHJ P,TDDT    ;MOVE ALL SYMBOLS TO DDT TABLE
2750 IFN ITS,[
2751         MOVE B,[JRST 1] ;START FILE WITH "JRST 1"
2752         PUSHJ P,OUTWRD  ;PUT IT OUT
2753 ]
2754         MOVE B,LOWSIZ   ;GET CURRENT CORE ALLOCATION
2755         SUBI B,(NBLKS)  ;REDUCE TO PROGRAM CORE ALLOCATION
2756         LSH B,10.       ;SHIFT TO MEMORY LOCATION
2757         SUBI B,1        ;REDUCE TO TOP LOCATION IN CORE OF PROGRAM
2758         MOVEI ADR,20    ; GET TOP OF LOW SEG IN USER'S LOC 20
2759         HRRZM B,@ADRPTR
2760
2761         MOVN ADR,MEMTOP ;GET -<LENGTH OF CORE IMAGE>
2762         HRLZS ADR       ;AOBJN POINTER
2763
2764 DMP2:   SKIPN B,@ADRPTR ;LOOK FOR THE FIRST NON-ZERO WORD
2765         AOBJN ADR,.-1   ;UNTIL THE WORLD IS EXHAUSTED
2766         JUMPGE ADR,CHKHI        ;DROPPED THROUGH, JUMP IF CORE EMPTY
2767
2768         MOVEI C,(ADR)   ;SAVE POINTER TO NON ZERO WORD
2769         MOVEI A,(C)     ;AND ANOTHER COPY
2770
2771 DMP1:   SKIPE B,@ADRPTR ;NOW LOOK FOR END OF NON ZERO BLOCK
2772         AOBJN ADR,.-1   ;UNTIL WORLD EXHAUSTED
2773         JUMPGE ADR,DMPLST       ;IF WORLD EMPTY, QUIT
2774
2775         AOBJP ADR,DMPLST        ;CHECK NEXT WORD
2776         SKIPE B,@ADRPTR ;FOR BEING ZERO
2777         JRST DMP1       ;ONE LONE ZERO, DON'T END BLOCK
2778
2779 DMPLST: MOVEI D,(ADR)   ;POINT TO END
2780         SUB C,D ;C/ -<LENGTH OF BLOCK>
2781         HRL A,C ;A/ AOBJN TO BLOCK
2782         MOVE B,A        ;COPY TO B FOR OUTWRD
2783 IFE ITS,        SUBI    B,1
2784         PUSHJ P,OUTWRD  ;PUT IT OUT
2785 IFE ITS,        ADDI    B,1
2786         HRRI B,@BPTR    ;NOW POINT TO REAL CORE
2787 IFN ITS,        .IOT TPCHN,B    ;BARF IT OUT
2788 IFE ITS,[
2789         MOVEM 1,JSYS1
2790         MOVEM 2,JSYS2
2791         MOVEM 3,JSYS3
2792
2793         MOVE 2,B
2794         HLRE 3,B
2795         HRLI 2,444400
2796         MOVE 1,OUTJFN
2797         SOUT
2798         MOVE 1,JSYS1
2799         MOVE 2,JSYS2
2800         MOVE 3,JSYS3
2801 ]
2802
2803 IFN ITS,[
2804         MOVE B,A        ;GET POINTER BACK IN B
2805         MOVE C,B        ;FIRST WORD IN CHECK SUM
2806         HRRI B,@BPTR    ;POINT TO REAL CORE
2807
2808         ROT C,1 ;ROTATE CKS
2809         ADD C,(B)       ;ADD
2810         AOBJN B,.-2     ;AND DO FOR ENTIRE BLOCK
2811
2812         MOVE B,C        ;CKS TO B
2813         PUSHJ P,OUTWRD  ;AND PUT IT OUT
2814 ]
2815         JUMPL ADR,DMP2  ;IF MORE, GO DO IT
2816
2817 CHKHI:  SKIPN   MEMTOP,HIGTOP   ; ANY HIGH SEG
2818         JRST    DMPSYMS         ; NO, GO ON TO SYMS
2819         SETZM   HIGTOP          ; RESET IT
2820         HLLZS   ADRPTR          ; FIX UP POINTERS
2821         HLLZS   BPTR
2822         LDB     ADR,[2100,,MEMTOP]      ; GET NO. OF WORDS
2823         MOVNS   ADR             ; NEGATE
2824         MOVSI   ADR,(ADR)
2825         HRRI    ADR,400000      ; START OF HIGH SEG
2826         JRST    DMP2
2827
2828
2829 ;HERE TO DO START ADDRESS
2830
2831 DMPSYMS:        HRRZ B,SA       ;GET START ADR
2832 IFN ITS,        HRLI B,(JUMPA)  ;USE "JUMPA" TO MAKE DDT HAPPY
2833 IFE ITS,        HRLI B,1
2834         PUSHJ P,OUTWRD
2835
2836 ;HERE TO DO SYMBOLS
2837
2838 IFE ITS,[
2839 ; ON TENEX/20 CLOSE FILE AND CREATE SEPARATE SYMBOL FILE
2840
2841         MOVEM   1,JSYS1
2842         MOVEM   2,JSYS2
2843         MOVEM   3,JSYS3
2844
2845         MOVE    1,OUTJFN
2846         CLOSF
2847         JFCL
2848
2849         MOVE    1,[440700,,FILSTR]
2850
2851 FNDNMX: ILDB    2,1
2852         CAIE    2,"<
2853         JRST    FNDNM2
2854
2855         ILDB    2,1
2856         CAIE    2,">
2857         JRST    .-2
2858         ILDB    2,1
2859
2860 FNDNM2: JUMPE   2,.+3
2861         CAIE    2,".
2862         JRST    FNDNMX
2863
2864         MOVEI   2,".
2865         DPB     2,1
2866
2867         MOVE    3,[440700,,[ASCIZ /SYMBOLS/]]
2868         ILDB    2,3
2869         IDPB    2,1
2870         JUMPN   2,.-2
2871
2872         MOVSI   1,1
2873         HRROI   2,FILSTR
2874         GTJFN
2875         JRST    .+3
2876         MOVE    2,[440000,,300000]
2877         OPENF
2878         MOVEI   1,0
2879         MOVEM   1,OUTJFN
2880         MOVE    1,JSYS1
2881         MOVE    2,JSYS2
2882         MOVE    3,JSYS3
2883         SKIPN   OUTJFN
2884         JRST    FNF
2885 ]
2886 IFN ITS,[
2887         HLLZ B,DDPTR    ;GET NUMBER
2888         PUSHJ P,OUTWRD  ;PUT IT OUT
2889
2890         MOVE C,DDPTR    ;FOR CKS
2891         .IOT TPCHN,DDPTR        ;OUT GOES THE WHOLE TABLE
2892 ]
2893
2894 IFE ITS,[
2895         MOVE A,DDPTR
2896         MOVEI B,0               ; WILL COUNT SYMS
2897
2898 TWNTY1: MOVE T,(A)
2899         TLZ T,740000            ; KILL SQUOZE BITS
2900
2901         MOVE D,T
2902         IDIVI T,50              ; CONVERT TO 10X/20 SQUOZE
2903         JUMPN TT,.+3
2904         MOVE D,T
2905         JRST .-3
2906
2907         HLLZ  T,(A)
2908         TLZ  T,37777            ; JUST GET SQUOZE BITS
2909         JUMPN T,TWNTY2          ; JUMP UNLESS PROG NAME
2910         ADDI B,1
2911 TWNTY2: ADDI B,1
2912         IOR D,T
2913         MOVEM D,(A)
2914         ADD A,[2,,2]
2915         JUMPL A,TWNTY1
2916
2917 ; HAVE COUNTED SYMS AND FIXED UP SYMBOLS, START OUTPUTTING
2918
2919         ASH B,1
2920         MOVNS B
2921         MOVSS B
2922         PUSHJ P,OUTWRD          ; PUT OUT COUNT
2923
2924         MOVE A,DDPTR
2925
2926 TWNTY3: MOVE D,A
2927         MOVEI C,0
2928 TWNTY5: MOVE T,(A)              ; SEARCH FOR A PROG NAME (OR END)
2929         TLNN T,740000
2930         JRST TWNTY4
2931         ADD A,[2,,2]
2932         ADDI C,2
2933         JUMPL A,TWNTY5
2934
2935 TWNTY6: JUMPE C,TWNTY7
2936         MOVNS C
2937         HRL D,C
2938         MOVEM 1,JSYS1
2939         MOVEM 2,JSYS2
2940         MOVEM 3,JSYS3
2941
2942         MOVE 1,OUTJFN
2943         MOVE 2,D
2944         HRLI 2,444400
2945         HLRE 3,D
2946         SOUT
2947         MOVE 1,JSYS1
2948         MOVE 2,JSYS2
2949         MOVE 3,JSYS3
2950 TWNTY7: ADD A,[2,,2]
2951         JUMPL A,TWNTY3
2952 ]
2953 IFN ITS,[
2954         ROT B,1
2955         ADD B,(C)       ;ADD IT
2956         AOBJN C,.-2
2957
2958         PUSHJ P,OUTWRD  ;PUT OUT THE CKS
2959
2960         MOVSI B,(JRST)  ;FINISH WITH "JRST 0"
2961         PUSHJ P,OUTWRD
2962
2963         MOVNI B,1       ;FINISH WITH NEGATIVE
2964         PUSHJ P,OUTWRD
2965
2966         .CLOSE TPCHN,   ;CLOSE THE FILE
2967 ]
2968 IFE ITS,[
2969         EXCH 1,OUTJFN
2970         CLOSF
2971         JFCL
2972         EXCH 1,OUTJFN
2973 ]
2974
2975 IFN ITS,        .VALUE [ASCIZ /:KILL /] ;KILL
2976 IFE ITS,[
2977         HALTF
2978
2979 TWNTY4: MOVE B,T
2980         PUSHJ P,OUTWRD
2981         MOVEI B,0
2982         PUSHJ P,OUTWRD
2983         MOVEI B,0
2984         PUSHJ P,OUTWRD
2985         MOVEI B,0
2986         PUSHJ P,OUTWRD
2987         JRST TWNTY6
2988
2989 ;SUBROUTINE TO PUT OUT ONE WORD
2990
2991 OUTWRD: HRROI T,B       ;AOBJN POINTER TO B
2992 IFN ITS,        .IOT TPCHN,T
2993 IFE ITS,[
2994         MOVEM 1,JSYS1
2995         MOVEM 2,JSYS2
2996         MOVEM 3,JSYS3
2997         MOVE 2,B
2998         MOVE 1,OUTJFN
2999         BOUT
3000         MOVE 1,JSYS1
3001         MOVE 2,JSYS2
3002         MOVE 3,JSYS3
3003 ]
3004         POPJ P,
3005
3006
3007
3008 \f
3009 ;HERE TO BUILD DEFAULT OUTPUT FILE NAME
3010
3011 FIXFIL: MOVE A,[SIXBIT /_STNK_/]        ;DEFAULT NAME 1
3012         MOVEM A,NM1
3013         MOVE A,[SIXBIT /DUMP/]  ;AND NAME 2
3014         MOVEM A,NM2
3015         POPJ P,
3016 \f
3017 ; CORE AND TABLE MANAGEMENT ROUTINES FOR HASH CODED TABLE STINK.
3018
3019 PAIR:   PUSH    P,B
3020         SKIPN   A,PARLST        ; ANY ON FREE LIST?
3021         JRST    PAIR1           ; NO, TRY FREE AREA
3022         HRRZ    B,(A)           ; YES, CDR THE LIST
3023         MOVEM   B,PARLST
3024 PAIR3A: SETZM   (A)     ; CLEAR 1ST WORD
3025 PAIR3:  POP     P,B
3026         POPJ    P,
3027
3028 PAIR1:  MOVE    A,PARCUR        ; TRY FREE AREA
3029         ADDI    A,2             ; WORDS NEEDED
3030         CAML    A,PARTOP        ; SKIP IF ROOM EXISTS
3031         JRST    PAIR2
3032 PAIR4:  EXCH    A,PARCUR        ; RETURN POINTER AND RESET PARCUR
3033         JRST    PAIR3A
3034
3035 QUAD:   PUSH    P,B
3036         SKIPN   A,QUADLS        ; SKIP IF ANY THERE
3037         JRST    QUAD1
3038         HRRZ    B,(A)           ; CDR THE QUAD LIST
3039         MOVEM   B,QUADLS
3040         JRST    PAIR3A
3041
3042 QUAD1:  MOVE    A,PARCUR        ; GET TOP
3043         ADDI    A,4
3044         CAML    A,PARTOP        ; OVERFLOW?
3045         JRST    QUAD2           ; YES, GET MORE
3046         JRST    PAIR4           ; NO, WIN
3047
3048 PAIR2:  PUSHJ   P,MORPAR        ; GET MORE CORE
3049         JRST    PAIR1
3050
3051 QUAD2:  PUSHJ   P,MORPAR
3052         JRST    QUAD1
3053
3054 PARRET: PUSH    P,B
3055         HRRZ    B,PARLST        ; SPLICE IT INTO FREE LIST
3056         HRRM    B,(A)
3057         MOVEM   A,PARLST
3058         JRST    PAIR3           ; RETURN POPPING B
3059
3060 QUADRT: PUSH    P,B
3061         HRRZ    B,QUADLS
3062         HRRM    B,(A)
3063         MOVEM   A,QUADLS
3064         JRST    PAIR3
3065 \f
3066 ; HERE TO ALLOCATE MORE STORAGE (1 BLOCK) FOR SYMBOL TABLE STUFF
3067
3068 MORPAR: PUSHJ P,GETCOR          ; TRY AND GET A BLOCK
3069 IFN ITS,[
3070         PUSHJ   P,TMSERR                ; COMPLAIN
3071         SKIPE   KEEP
3072         PUSHJ   P,WINP
3073 ]
3074         JFCL
3075         AOS     NBLKS
3076         PUSHJ   P,MOVCOD        ; TRY AND GET CODE OUT OF THE WAY
3077         PUSHJ   P,MOVDD         ; ALSO GET DDT SYMBOLS OUT
3078         MOVEI   A,2000          ; INCREASE PARTOP
3079         ADDM    A,PARTOP
3080         AOS     LOBLKS
3081         POPJ    P,
3082
3083 ; HERE TO MOVE CODE
3084
3085 MOVCOD: PUSH    P,C
3086         PUSH    P,B
3087         HRRZ    A,ADRPTR        ; POINT TO CURRENT START
3088         ADDI    A,2000          ; NEW START
3089         MOVE    C,A
3090         HRRM    A,ADRPTR        ; FIX POINTERS
3091         HRRM    A,BPTR
3092         HRRM    A,DPTR
3093         MOVE    B,LOBLKS        ; GEV(CURRENT TOP (IN BLOCKS)
3094         ASH     B,10.           ; CONVERT TO WORDS
3095
3096 MOVCO3: MOVEI   A,-2000(B)      ; A/ POINT TO LAST DESTINATION
3097         CAIG    B,(C)           ; SKIP IF NOT DONE
3098         JRST    MOVCO2
3099         HRLI    A,-2000(A)      ; B/ FIRST SOURCE,,FIRST DESTINATION
3100         BLT     A,-1(B)
3101         SUBI    B,2000
3102         JRST    MOVCO3
3103
3104 MOVCO2: POP     P,B
3105         POP     P,C
3106         POPJ    P,
3107
3108
3109 ; HERE TO MOVE DDT SYMBOLS
3110
3111 MOVDD:  PUSH    P,C
3112         PUSH    P,C
3113         HRRZ    A,DDPTR         ; GET CURRENT POINTER
3114         ADDI    A,2000
3115         HRRM    A,DDPTR
3116         HRRZ    A,DDTOP         ; TOP OF DDT TABLE
3117         ADDI    A,2000
3118         MOVEM   A,DDTOP
3119
3120         MOVEI   B,1(A)          ; SET UP FOR BLT LOOP
3121         HRRZ    C,DDBOT
3122         ADDI    C,2000  ; BUMP
3123         MOVEM   C,DDBOT
3124         JRST    MOVCO3          ; FALL INTO BLT LOOP
3125
3126
3127 ;HAVE NAME W/ FLAGS IN A, VALUE IN T,
3128 ;PUT SYM IN DDT SYMBOL TABLE.
3129 ADDDDT: PUSH    P,A
3130         PUSH    P,B
3131 ADDDD1: MOVE    A,DDPTR
3132         SUB     A,[2,,2]
3133         HRRZ    B,DDBOT
3134         CAILE   B,(A)           ; SKIP IF OK
3135         JRST    GROWDD          ; MUST GROW DDT TABLE
3136         MOVEM   A,DDPTR
3137         MOVEM   T,1(A)          ; CLOBBER AWAY
3138         POP     P,B
3139         POP     P,(A)
3140         MOVE    A,(A)           ; RESTORE A
3141         POPJ    P,
3142
3143 GROWDD: PUSHJ P,GETCOR
3144 IFN ITS,[
3145         PUSHJ   P,TMSERR
3146         SKIPE   KEEP
3147         PUSHJ   P,WINP
3148 ]
3149         JFCL
3150         AOS     NBLKS
3151         PUSHJ   P,MOVCOD        ; MOVE THE CODE
3152         PUSHJ   P,MOVDD
3153         MOVNI   A,2000
3154         ADDM    A,DDBOT
3155         AOS     LOBLKS
3156         JRST    ADDDD1
3157
3158 ADDDD2: PUSH P,A        ;CALL HERE FROM SYMS OR TDDT.
3159         PUSH P,B
3160         SKIPA B,DDPTR   ;SPECIAL LOCAL SYM, LOOK FOR STE WITH SAME "NAME".
3161 ADDDD3: ADD B,[2,,2]
3162         JUMPGE B,POPBAJ ;NO ENTRY, THROW AWAY SYM.
3163         HLL A,(B)
3164         CAME A,(B)
3165          JRST ADDDD3    ;NOT THIS ONE.
3166         MOVE A,1(B)     ;SYM'S REAL NAME IS IN 2ND WD OF STE,
3167         MOVEM A,(B)
3168         MOVEM T,1(B)    ;PUT IN THE VALUE.
3169         JRST POPBAJ
3170
3171 ;TDDT EXITS THROUGH HERE.
3172 TDDTEX: PUSH P,A        ;MAKE SURE 1ST STE IN FILE IS PROGRAM NAME.
3173         PUSH P,B
3174         SKIPA A,DDPTR
3175 TDDTE1: ADD A,[2,,2]
3176         JUMPGE A,POPBAJ ;NO PROGRAM NAMES AT ALL => NO PROBLEM.
3177         MOVE B,(A)
3178         TLNE B,740000
3179          JRST TDDTE1    ;THIS NOT PROGRAM NAME.
3180         CAMN A,DDPTR
3181          JRST POPBAJ    ;IF IT'S ALREADY 1ST, NO PROBLEM.
3182         MOVE B,DDPTR
3183 REPEAT 2,[
3184         EXCH T,.RPCNT(A) ;EXCHANGE PROGRAM NAME WITH 1ST STE.
3185         EXCH T,.RPCNT(B)
3186         EXCH T,.RPCNT(A)]
3187         JRST POPBAJ
3188 \fISYM:  MOVSI C,(50*50*50*50*50*50)
3189         MOVSI T,40000   ;GLOBAL BIT
3190
3191 ISYM0:  ILDB A,CPTR
3192         CAIN A,"*
3193         TLZ T,40000     ;LOCAL
3194         CAIN A,"*
3195         JRST ISYM0
3196         CAIN A,">
3197         JRST LKUP
3198         SUBI A,"0-1
3199         CAIL A,"A-"0+1
3200         SUBI A,"A-"0+1-13
3201         JUMPGE A,ISYM2
3202         ADDI A,61
3203         CAIN A,60
3204         MOVEI A,45      ;.
3205 ISYM2:  IDIVI C,50
3206         IMUL A,C
3207         ADDM A,T
3208         JRST ISYM0
3209
3210 \f
3211 IFN ITS,[
3212 FRD2:   CAME B,[SIXBIT /@/]
3213         JRST DEVNAM
3214         SKIPA B,C
3215 FRD:    MOVSI B,(SIXBIT /@/)
3216         MOVSI C,(SIXBIT /@/)
3217         MOVE A,[(600)C-1]
3218 FRD1:   ILDB T,CPTR
3219         CAIE T,33
3220         CAIN T,DOLL
3221         JRST CHBIN      ;CHECK IF SHOULD CHANGE NAME 2 TO BIN
3222         TRC T,40
3223         JUMPE T,FRD2
3224         CAIN T,32
3225         JRST DEVSET
3226         CAIN T,33
3227         JRST USRSET
3228         CAIN T,77
3229         MOVEI T,0
3230         CAME A,[(600)C]
3231         IDPB T,A
3232         JRST FRD1
3233
3234
3235
3236
3237 USRSET: MOVEM C,SNAME
3238         JRST FRD+1
3239
3240 DEVNAM: PUSH P,CDEVN1
3241         MOVEM C,NM2
3242         JRST FRD+1
3243
3244 DEVNM1: TRO FF,SETDEV   ;SAY DEVICE SET
3245         HLRM C,DEV
3246         MOVE C,NM2
3247         JRST CHBIN      ;CHECK FOR CHANGE TO BIN
3248
3249 DEVSET: TRO FF,SETDEV   ;DEVICE SET
3250         HLRM C,DEV
3251         JRST FRD+1
3252
3253 CHBIN:  CAME B,[SIXBIT /@/]     ;WAS NO NAME2 SUPPLIED?
3254         POPJ P,                 ;NAME2 SUPPLIED, GO AWAY
3255         MOVE B,C                ;MAKE NAME1 INTO NAME2
3256 NODMCG, MOVSI C,(SIXBIT /REL/)  ;USE REL FOR NAME2
3257 DMCG,   MOVSI C,(SIXBIT /BIN/)
3258 CDEVN1: POPJ P,DEVNM1
3259 ]
3260 IFE ITS,[
3261 FRD:
3262         MOVE    B,[440700,,FILSTR]
3263
3264 FRD2:   ILDB    T,CPTR
3265         CAIE    T,DOLL
3266         CAIN    T,33
3267         JRST    FRD1            ; FINISHED
3268         IDPB    T,B
3269         JRST    FRD2
3270
3271 FRD1:   MOVEI   T,0
3272         IDPB    T,B             ; ASCIZ
3273         POPJ    P,
3274 ]
3275 CONSTANTS
3276 \f;IMPURE STORAGE
3277
3278 EISYM:  ;INITIAL SYMBOLS
3279
3280 CRELPT: SQUOZE 64,$R.
3281 FACTOR: 100
3282         0
3283 CPOINT: SQUOZE 64,$.
3284         100
3285         0
3286         SQUOZE 64,.LVAL1
3287 .VAL1:  0
3288         0
3289         SQUOZE 64,.LVAL2
3290 .VAL2:  0
3291         0
3292         SQUOZE 64,USDATL
3293 USDATP: 0
3294         0
3295 EISYME:
3296
3297 POLSW:  0                       ;-1=>WE ARE DOING POLISH
3298 PPDP:   -PPDL,,PPDB-1           ;INITIAL POLISH PUSH DOWN POINTER
3299 PPDB:   BLOCK   PPDL+1          ;POLISH PUSH DOWN BLOCK
3300 SATED:  0                       ;COUNT OF POLISH FIXUPS TO BE DELETED
3301 SATPDP: -SATPDL,,SATPDB-1       ;POINTER TO POLISH FIXUPS TO BE DELETED
3302 SATPDB: BLOCK   SATPDL+1        ;LIST OF POLISH FIXUPS TO BE DELETED
3303 SVSAT:  0                       ;# OF OPERANDS NEEDED
3304 POLPNT: 0                       ;POINTER TO POLISH CHAIN
3305 CGLOB:  0                       ;CURRENT GLOBAL IN SOME SENSE
3306 CGLOBV: 0                       ;CURRENT GLOBAL VALUE IN SOME SENSE
3307 GLBFS:  0                       ;GLOBAL BEING FIXED UP DURINGS DEFERED REQUEST
3308 SVHWD:  0                       ;WORD CURRENTLY BEING READ BY POLISH
3309 GLBCNT: 0                       ;# UNDEFINED FIXUPS DURING READING PHASE OF POLISH
3310 HEADNM: 0                       ;# POLISH FIXUPS SEEN
3311 LFTFIX: 0                       ;-1=> LEFT HALF FIXUP IN PROGRESS
3312 LINKDB: BLOCK   MNLNKS+1        ;LINK DATA BLOCK (END LINK,,CURRENT VALUE)
3313 HIBLK:  0                       ; BLOCKS IN HIGH SEG
3314 KEEP:   0                       ; FLAG SAYING WE ARE IN A CORE LOOP
3315 DMCG,[
3316 USINDX: 0                       ; USER INDEX
3317 ];DMCG
3318 HIGTOP: 0                       ; TOP OF HIGH SEG
3319 INPTR:  0                       ;HOLDS CURRENT IO POINTER
3320 STNBUF: BLOCK STNBLN            ;BUFFER FOR BLOCK READS
3321 PAT:    BLOCK   100
3322 PATEND==.+1
3323 CPTR:   0
3324 AWORD:  0
3325 ADRPTR: <INITCR*2000>(ADR)
3326 BPTR:   <INITCR*2000>(B)
3327 DPTR:   <INITCR*2000>(D)
3328 SA:     0
3329 TC:     0
3330 BITS:   0
3331 BITPTR: (300)BITS
3332 SAVPDL: 0
3333 LBOT:   INITCR*2000
3334 TIMES:  0
3335 COMLOC: ICOMM
3336 T1:     0
3337 T2:     0
3338 FLSH:   0
3339 PRGNAM: 0
3340
3341 ; CORE MANAGEMENT VARIABLES
3342
3343 NODMCG,[
3344 CWORD0: 4000,,400000+<<INITCR-1>_9.>
3345 CWORD1: 4000,,600000-1000
3346 LOWSIZ: INITCR          ; NUMBER BLOCKS WE GOT (IN LOW SEGMENT)
3347 ];NODMCG
3348 LOBLKS: INITCR+1        ; NUMBER OF BLOCKS OF CORE WE WANT
3349 PARBOT: 0               ; POINT TO BOTTOM OF SYMBOL TABLES
3350 PARTOP: 0               ; POINT TO TOP OF SAME
3351 PARLST: 0               ; LIST OF AVAILABLE 2 WORD BLOCKS
3352 QUADLS: 0               ; LIST OF AVAILABLE 4 WORD BLOCKS
3353 PARCUR: 0               ; TOP CURRENTLY IN USE SYMBOL TABLE CORE
3354
3355 DDPTR:  0               ; AOBJN POINTER TO CURRENT DDT SYMBOL TABLE
3356 DDTOP:  0               ; HIGHEST ALLOCATED FOR DDT
3357 DDBOT:  0               ; LOWEST ALLOCATED FOR DDT
3358
3359 HTOP:   0               ; TOP OF HASH TABLE
3360 HBOT:   0               ; BOTTOM OF HASH TABLE
3361 \fINIT:
3362 PDL:    IFN ITS,        .SUSET [.RSNAM,,SNAME]  ;GET INITIAL SYSTEM NAME
3363         MOVEI A,100
3364         MOVEM A,FACTOR
3365         MOVE NBLKS,[20,,INITCR]
3366         MOVEI A,ICOMM
3367         MOVEM A,COMLOC
3368         HLLZS LKUP3
3369         SETOM MEMTOP
3370         MOVEI A,FACTOR
3371         HRRM A,REL
3372         MOVE P,[-100,,PDL]
3373         PUSHJ P,KILL
3374 IFN ITS,[
3375         .OPEN TYOC,TTYO
3376         .VALUE 0
3377         .OPEN TYIC,TTYI
3378         .VALUE 0
3379         .STATUS TYIC,T
3380         ANDI T,77
3381         CAIN T,2
3382         TRO FF,GETTY
3383 ]
3384         MOVE TT,[SIXBIT /STINK./]
3385         PUSHJ P,SIXTYO
3386         MOVE TT,[.FNAM2]
3387         PUSHJ P,SIXTYO
3388 IFN ITS,        .SUSET [.RMEMT,,TT]
3389 IFE ITS,[
3390         MOVEI TT,INITCR*2000
3391 ]
3392         LSH TT,-10.
3393         MOVEM TT,LOWSIZ
3394         SUBI TT,1
3395         LSH TT,9.
3396         TDO TT,[4000,,400000]
3397         MOVEM TT,CWORD0
3398         JRST LIS
3399
3400 TTYO==.
3401         1,,(SIXBIT /TTY/)
3402         SIXBIT /STINK/
3403         SIXBIT /OUTPUT/
3404
3405 TTYI==.
3406         30,,(SIXBIT /TTY/)
3407         SIXBIT /STINK/
3408         SIXBIT /INPUT/
3409
3410 CONSTANTS
3411
3412 LOC PDL+LPDL
3413 CBUF:   BLOCK CBUFL
3414 FILSTR: BLOCK 10                ; GOOD FOR 40 CHARS
3415 LOSYM:  ;LOWEST LOC AVAIL FOR SYM TBL
3416 INITCR==<LOSYM+3000>/2000       ;LDR LENGTH IN BLOCKS
3417
3418 INFORM [HIGHEST USED]\LOSYM
3419 INFORM [LOWEST LOCATION LOADED ]\LOWLOD
3420 INFORM [COMMAND BUFFER LENGTH]\<CBUFL*5>
3421 INFORM [INITIAL CORE ALLOCATION]\INITCR
3422
3423 END PDL
3424 \ 3\ 3