<mdl.int>/stink.2

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