<mdl.int>/initm.373

   1 TITLE INITIALIZATION FOR MUDDLE
   2
   3 RELOCATABLE
   4
   5 HTVLNT==3000            ; GUESS OF TVP LENGTH
   6
   7 LAST==1 ;POSSIBLE CHECKS DONE LATER
   8
   9 .INSRT MUDDLE >
  10
  11 SYSQ
  12 XBLT==123000,,
  13 GCHN==0
  14 IFE ITS,[
  15 FATINS==.FATAL"
  16 SEVEC==104000,,204
  17 .INSRT STENEX >
  18 ]
  19
  20 IMPURE
  21
  22 OBSIZE==151.    ;DEFAULT OBLIST SIZE
  23
  24 .LIFL <TVBASE+TVLNT-TVLOC>
  25 .LOP .VALUE
  26 .ELDC
  27
  28 .GLOBAL SHRRM,SHRLM,SMOVEM,SSETZM,SXBLT,SHLRZ
  29 .GLOBAL SETUP,TPBAS,GCPDL,GCPVP,PVBASE,PVLNT,PARNEW,AAGC,ICR,SWAP,OBLNT,MSGTYP,POPUNW
  30 .GLOBAL ICLOS,OCLOS,GLOBASE,GLOBSP,PARBOT,PARTOP,CODTOP,START,BEGIN,VECBOT,VECTOP,TPBASE
  31 .GLOBAL LISTEN,ROOT,INITIAL,TBINIT,TOPLEV,INTOBL,ERROBL,MUDOBL,TTYOPE,RESFUN,QUITTER
  32 .GLOBAL IOINS,BUFRIN,IOIN2,ECHO,MTYI,MTYO,IMTYO,MUDSTR,P.TOP,TTICHN,TTOCHN,TYPVEC,SQDIR
  33 .GLOBAL PDLBUF,PHIBOT,%UNAM,PURVEC,STOSTR,ISTOST,TD.LNT,TD.PUT,TD.GET,CAFRE1
  34 .GLOBAL FRETOP,LPUR,SQBLK,REALGC,INTDIR,AGCLD,PAGEGC,TD.AGC,TVSTRT,REALTV,PVSTOR
  35 .GLOBAL GCSTOP,SPSTOR,DSTORE,SQBYTE,INBYTE,GCBYTE,FRSTCH,OPSYS,IJFNS,GETJS
  36 .GLOBAL HASHTB,ILOOKC
  37
  38 LPUR==.LPUR             ; SET UP SO LPUR WORKS
  39
  40 ; INIITAL AMOUNT OF AFREE SPACE
  41
  42 STOSTR:
  43 LOC TVSTRT-1
  44 ISTOST: TVSTRT-STOSTR,,0
  45
  46         BLOCK HTVLNT                            ; TVP
  47
  48 SETUP:  MOVEI   0,0                     ; ZERO ACS
  49         MOVEI   17,1
  50         BLT     17,17
  51
  52 IFN ITS,        .SUSET  [.RUNAM,,%UNAM]         ; FOR AGC'S BENFIT
  53         MOVE    P,GCPDL         ;GET A PUSH DOWN STACK
  54 IFN ITS,        .SUSET  [.SMASK,,[200000]]      ; ENABLE PDL OVFL
  55         MOVE    0,[TVBASE,,TVSTRT]
  56         BLT     0,TVSTRT+HTVLNT-3       ; BLT OVER TVP
  57 IFE ITS,        PUSHJ   P,TWENTY        ; FIND OUT WHETHER IT IS TOPS20 OR NOT
  58         PUSHJ   P,TTYOPE                ;OPEN THE TTY
  59         AOS     A,20            ; TOP OF LOW SEGG
  60         HRRZM   A,P.TOP
  61         SOSN    A               ; IF NOTHING YET
  62 IFN ITS,        .SUSET  [.RMEMT,,P.TOP]
  63 IFE ITS,        JRST    4,
  64         MOVE    A,P.TOP
  65         SUB     A,FRETOP        ; SETUP FOR GETTING NEEDED CORE
  66         SUBI    A,3777
  67         ASH     A,-10.          ; TO PAGES
  68         HRLS    A               ; SET UP AOBJN
  69         HRRZ    0,P.TOP
  70         ASH     0,-10.
  71         SUBI    0,1
  72         HRR     A,0
  73 IFN ITS,[
  74         .CALL   HIGET           ; GET THEM
  75         FATAL   INITM--CORE NOT AVAILABLE FOR INITIALIZATION
  76         ASH     A,10.           ; TO WORDS
  77         MOVEM   A,P.TOP
  78         SUBI    A,2000          ; WHERE FRETOP IS
  79         MOVEM   A,FRETOP
  80
  81 ]
  82 IFE ITS,[
  83         MOVE    A,FRETOP
  84         ADDI    A,2000
  85         MOVEM   A,P.TOP
  86 ]
  87         HRRE    A,P.TOP         ; CHECK TOP
  88         TRNE    A,377777                ; SKIP IF ALL LOW SEG
  89         JUMPL   A,PAGLOS        ; COMPLAIN
  90         MOVE    A,HITOP         ; FIND HI SEG TOP
  91         ADDI    A,1777
  92         ANDCMI  A,1777
  93         MOVEM   A,RHITOP        ; SAVE IT
  94         MOVEI   A,200
  95         SUBI    A,PHIBOT
  96         JUMPE   A,HIBOK
  97         MOVSI   A,(A)
  98         HRRI    A,200
  99 IFN ITS,[
 100         .CALL   GIVCOR
 101         .VALUE
 102 ]
 103 HIBOK:  MOVEI   B,[ASCIZ /MUDDLE INITIALIZATION.
 104 /]
 105         PUSHJ   P,MSGTYP        ;PRINT IT
 106         MOVE    A,CODTOP        ;CHECK FOR A WINNING LOAD
 107         CAML    A,VECBOT        ;IT BETTER BE LESS
 108         JRST    DEATH1          ;LOSE COMPLETELY
 109 SETTV:  MOVE    PVP,[-PVLNT*2,,GCPVP]   ;AND A PROCESS VECTOR
 110         MOVEM   PVP,PVSTOR+1
 111         MOVEM   PVP,PVSTOR+1-TVSTRT+TVBASE
 112         MOVEI   A,(PVP)         ;SET UP A BLT
 113         HRLI    A,PVBASE        ;FROM PROTOTYPE
 114         BLT     A,PVLNT*2-1(PVP)        ;INITIALIZE
 115         MOVE    TP,[-ITPLNT,,TPBAS]     ;GET A STACK FOR THIS PROCCESS
 116         MOVEI   TB,(TP)         ;AND A BASE
 117 IFN ITS,        HRLI    TB,1
 118 IFE ITS,        HRLI    TB,400001       ; FOR MULTI SEG HACKING
 119         SUB     TP,[1,,1]       ;POP ONCE
 120
 121 ; FIRST BUILD MOBY HASH TABLE
 122
 123         MOVEI   A,1023.         ; TRY THIS OUT FOR SIZE
 124         PUSHJ   P,IBLOCK
 125         MOVEM   B,HASHTB+1-TVSTRT+TVBASE        ; STORE IN TVP POINTER
 126         HLRE    A,B
 127         SUB     B,A
 128         MOVEI   A,TATOM+.VECT.
 129         HRLM    A,(B)
 130
 131 ; ALLOCATE SOME OBLISTS FOR INITIAL ATOMS
 132
 133         PUSH    P,[5]           ;COUNT INITIAL OBLISTS
 134
 135         PUSH    P,OBLNT         ;SAVE CURRENT OBLIST DEFAULT SIZE
 136
 137 MAKEOB: SOS     A,-1(P)
 138         MOVE    A,OBSZ(A)
 139         MOVEM   A,OBLNT
 140         MCALL   0,MOBLIST       ;GOBBLE AN OBLIST
 141         PUSH    TP,$TOBLS       ;AND SAVE THEM
 142         PUSH    TP,B
 143         MOVE    A,(P)-1         ;COUNT DOWN
 144         MOVEM   B,@OBTBL(A)     ;STORE
 145         JUMPN   A,MAKEOB
 146
 147         POP     P,OBLNT         ;RESTORE DEFAULT OBLIST SIZE
 148
 149         MOVE    C,[-TVLNT+2,,TVBASE]
 150         MOVE    D,[-HTVLNT+2,,TVSTRT]
 151
 152 ;MAIN INITIALIZE LOOP - SCAN XFER VECTOR FOR ATOMS, UPDATE
 153 ;OFFSETS IN CODE, UNIQUIFY ATOMS AND COMPACT XFER VECTOR
 154
 155 ILOOP:  HLRZ    A,(C)           ;FIRST TYPE
 156         JUMPE   A,TVEXAU        ;USEFUL STUFF EXHAUSTED
 157         CAIN    A,TCHSTR        ;CHARACTER STRING?
 158         JRST    CHACK           ;YES, GO HACK IT
 159         CAIN    A,TATOM         ;ATOM?
 160         JRST    ATOMHK          ;YES, CHECK IT OUT
 161         MOVE    A,(C)           ;MOVE TO NEW HOME (MAY BE SAME)
 162         MOVEM   A,(D)
 163         MOVE    A,1(C)
 164         MOVEM   A,1(D)
 165 SETLP:  AOS     (P)             ;COUNT NUMBER OF PAIRS IN XFER VECTOR
 166         ADD     D,[2,,2]        ;OUT COUNTER
 167 SETLP1: ADD     C,[2,,2]        ;AND IN COUNTER
 168         JUMPL   C,ILOOP         ;JUMP IF MORE TO DO
 169 \f
 170 ;NEW XFER VECTOR FINISHED, NOW GIVE AWAY THE REST
 171
 172 TVEXAU: HLRE    B,D             ; LEFT HALF OF AOBJN
 173         MOVNI   TVP,HTVLNT-2    ; CALCULATE LENGTH OF TVP
 174         SUB     TVP,B           ; GET -LENGTH OF TVP IN TVP
 175         HRLS    TVP
 176         HRRI    TVP,TVSTRT      ; BUILD A TASTEFUL TVP POINTER
 177         MOVNI   C,TVLNT-HTVLNT+2(B)             ; SMASH IN LENGTH INTO END DOPE WORDS
 178         HRLM    C,TVSTRT+HTVLNT-1
 179         MOVSI   E,400000
 180         MOVEM   E,TVSTRT+HTVLNT-2
 181         HLRE    C,TVP
 182         MOVNI   C,-2(C)         ; CLOBBER LENGTH INTO REAL TVP
 183         HLRE    B,TVP
 184         SUBM    TVP,B
 185         MOVEM   E,(B)
 186         HRLM    C,1(B)          ; PUT IN LENGTH
 187         MOVE    PVP,PVSTOR+1
 188         MOVEM   TVP,REALTV+1(PVP)
 189
 190
 191 ; FIX UP TYPE VECTOR
 192
 193         MOVE    A,TYPVEC+1      ;GET POINTER
 194         MOVEI   0,0             ;FOR POSSIBLE NULL SLOTS
 195         MOVSI   B,TATOM         ;SET TYPE TO ATOM
 196         MOVEI   D,400000        ; TYPE CODE HACKS
 197
 198 TYPLP:  HLLM    B,(A)           ;CHANGE TYPE TO ATOM
 199         MOVE    C,@1(A)         ;GET ATOM
 200         HLRE    E,C             ; FIND DOPE WORD
 201         SUBM    C,E
 202         HRRM    D,(E)           ; STUFF INTO ATOM
 203         MOVEM   C,1(A)
 204         ADDI    D,1
 205         ADD     A,[2,,2]                ;BUMP
 206         JUMPL   A,TYPLP
 207
 208 \f; CLOSE TTY CHANNELS
 209 IFN ITS,[
 210
 211         .CLOSE  1,
 212         .CLOSE  2,
 213 ]
 214
 215 ;GENERAT THE LOGICAL TTY IN AND OUT CHANNELS
 216
 217 ;SETUP CALL TO OPEN OUTPUT TTY CHANNNEL
 218
 219         IRP     A,,[[PRINT,TCHSTR],[TTY:,TCHSTR]]
 220         IRP     B,C,[A]
 221         PUSH    TP,$!C
 222         PUSH    TP,CHQUOTE B
 223         .ISTOP
 224         TERMIN
 225         TERMIN
 226
 227         MCALL   2,FOPEN         ;OPEN THE OUT PUT CHANNEL
 228         MOVEM   B,TTOCHN+1      ;SAVE IT
 229
 230 ;ASSIGN AS GLOBAL VALUE
 231
 232         PUSH    TP,$TATOM
 233         PUSH    TP,IMQUOTE OUTCHAN
 234         PUSH    TP,A
 235         PUSH    TP,B
 236         MOVE    A,[PUSHJ P,MTYO]        ;MORE WINNING INS
 237         MOVEM   A,IOINS(B)      ;CLOBBER
 238         MCALL   2,SETG
 239
 240 ;SETUP A CALL TO OPEN THE TTY CHANNEL
 241
 242         IRP     A,,[[READ,TCHSTR],[TTY:,TCHSTR]]
 243         IRP     B,C,[A]
 244         PUSH    TP,$!C
 245         PUSH    TP,CHQUOTE B
 246         .ISTOP
 247         TERMIN
 248         TERMIN
 249
 250         MCALL   2,FOPEN         ;OPEN INPUTCHANNEL
 251         MOVEM   B,TTICHN+1      ;SAVE IT
 252         PUSH    TP,$TATOM       ;ASSIGN AS A GLOBAL VALUE
 253         PUSH    TP,IMQUOTE INCHAN
 254         PUSH    TP,A
 255         PUSH    TP,B
 256         MOVE    C,BUFRIN(B)     ;GET AUX BUFFER PTR
 257         MOVE    A,[PUSHJ P,MTYI]
 258         MOVEM   A,IOIN2(C)      ;MORE OF A WINNER
 259         MOVE    A,[PUSHJ P,IMTYO]
 260         MOVEM   A,ECHO(C)       ;ECHO INS
 261         MCALL   2,SETG
 262         MOVEI   A,3             ;FIRST CHANNEL AFTER INIT HAPPENS
 263         MOVEM   A,FRSTCH
 264
 265 ;GENERATE AN INITIAL PROCESS AND SWAP IT IN
 266
 267         MOVEI   A,TPLNT         ;STACK PARAMETERS
 268         MOVEI   B,PLNT
 269         PUSHJ   P,ICR           ;CREATE IT
 270         MOVE    PVP,PVSTOR+1
 271         MOVE    0,SPSTO+1(B)
 272         MOVEM   0,SPSTOR+1
 273         MOVE    0,REALTV+1(PVP)
 274         MOVEM   0,REALTV+1(B)   ; STUFF IN TRANSFER VECTOR POINTER
 275         MOVEI   0,RUNING
 276         MOVEM   0,PSTAT"+1(B)
 277         MOVE    D,B             ;SET UP TO CALL SWAP
 278         JSP     C,SWAP          ;AND SWAP IN
 279         MOVEM   PVP,MAINPR"     ;SAVE AS THE MAIN PROCESS
 280         PUSH    TP,[TENTRY,,TOPLEV]     ;BUILD DUMMY FRAME
 281         PUSH    TP,[1,,0]
 282         MOVEI   A,-1(TP)
 283         PUSH    TP,A
 284         PUSH    TP,SPSTOR+1
 285         PUSH    TP,P
 286         MOVE    C,TP    ;COPY TP
 287         ADD     C,[3,,3]        ;FUDGE
 288         PUSH    TP,C    ;TPSAV PUSHED
 289         PUSH    TP,[TOPLEV]
 290         HRRI    TB,(TP) ;SETUP TB
 291 IFN ITS,        HRLI    TB,2
 292 IFE ITS,        HRLI    TB,400002
 293         ADD     TB,[1,,1]
 294         MOVE    PVP,PVSTOR+1
 295         MOVEM   TB,TBINIT+1(PVP)
 296         MOVSI   A,TSUBR
 297         MOVEM   A,RESFUN(PVP)
 298         MOVEI   A,LISTEN"
 299         MOVEM   A,RESFUN+1(PVP)
 300         PUSH    TP,$TATOM
 301         PUSH    TP,IMQUOTE THIS-PROCESS
 302         PUSH    TP,$TPVP
 303         PUSH    TP,PVP
 304         MCALL   2,SETG
 305
 306 ; FIND TVP OFFSET FOR THE ATOM 'T' FOR TEMPLATE
 307
 308         MOVEI   A,IMQUOTE T
 309         SUBI    A,
 310 TVTOFF==0
 311         ADDSQU  TVTOFF
 312
 313         MOVEM   A,SQULOC-1
 314
 315         PUSH    TP,$TATOM
 316         PUSH    TP,IMQUOTE TVTOFF,,MUDDLE
 317         PUSH    TP,$TFIX
 318         PUSH    TP,A
 319         MCALL   2,SETG
 320
 321 ; HERE TO SETUP SQUOZE TABLE IN PURE CORE
 322
 323         PUSHJ   P,SQSETU        ; GO TO ROUTINE
 324
 325         PUSHJ   P,DUMPGC
 326         MOVEI   A,400000        ; FENCE POST PURE SR VECTOR
 327         HRRM    A,PURVEC
 328         MOVE    A,TP
 329         HLRE    B,A
 330         SUBI    A,-PDLBUF(B)    ;POINT TO DOPE WORDS
 331         MOVEI   B,12            ;GROWTH SPEC
 332         IORM    B,(A)
 333         MOVE    PVP,PVSTOR+1
 334         MOVE    0,REALTV+1(PVP)
 335         HLRE    E,0
 336         SUBI    0,-1(E)
 337         HRRZM   0,CODTOP
 338 IFE ITS,        PUSHJ   P,GETJS
 339         PUSHJ   P,AAGC          ;DO IT
 340         AOJL    A,.-1
 341         MOVE    PVP,PVSTOR+1
 342         MOVE    A,TPBASE+1(PVP)
 343         SUB     A,[640.,,640.]
 344         MOVEM   A,TPBASE+1(PVP)
 345
 346 ; CREATE LIST OF ROOT AND NEW OBLIST
 347
 348         MOVEI   A,5
 349         PUSH    P,A
 350
 351 NAMOBL: PUSH    TP,$TATOM
 352         PUSH    TP,@OBNAM-1(A)  ; NAME
 353         PUSH    TP,$TATOM
 354         PUSH    TP,IMQUOTE OBLIST
 355         PUSH    TP,$TOBLS
 356         PUSH    TP,@OBTBL1-1(A)
 357         MCALL   3,PUT           ; NAME IT
 358         SOS     A,(P)
 359         PUSH    TP,$TOBLS
 360         PUSH    TP,@OBTBL1(A)
 361         PUSH    TP,$TATOM
 362         PUSH    TP,IMQUOTE OBLIST
 363         PUSH    TP,$TATOM
 364         PUSH    TP,@OBNAM(A)
 365         MCALL   3,PUT
 366         SKIPE   A,(P)
 367         JRST    NAMOBL
 368         SUB     P,[1,,1]
 369
 370 ;Define MUDDLE version number
 371         MOVEI   A,5
 372         MOVEI   B,0             ;Initialize result
 373         MOVE    C,[440700,,MUDSTR+2]
 374 VERLP:  ILDB    D,C             ;Get next charcter digit
 375         CAIG    D,"9            ;Non-digit ?
 376         CAIGE   D,"0
 377         JRST    VERDEF
 378         SUBI    D,"0            ;Convert to number
 379         IMULI   B,10.
 380         ADD     B,D             ;Include number into result
 381         SOJG    A,VERLP         ;Finished ?
 382 VERDEF:
 383         PUSH    TP,$TATOM
 384         PUSH    TP,IMQUOTE MUDDLE
 385         PUSH    TP,$TFIX
 386         PUSH    TP,B
 387         MCALL   2,SETG          ;Make definition
 388 OPIPC:
 389 IFN ITS,[
 390         PUSH    TP,$TCHSTR
 391         PUSH    TP,CHQUOTE IPC
 392         PUSH    TP,$TATOM
 393         PUSH    TP,MQUOTE IPC-HANDLER
 394         MCALL   1,GVAL
 395         PUSH    TP,A
 396         PUSH    TP,B
 397         PUSH    TP,$TFIX
 398         PUSH    TP,[1]
 399         MCALL   3,ON
 400         MCALL   0,IPCON
 401 ]
 402
 403 ; Allocate inital template tables
 404
 405         MOVEI   A,10
 406         PUSHJ   P,CAFRE1
 407         MOVSI   A,(B)
 408         HRRI    A,1(B)
 409         SETZM   (B)
 410         BLT     A,7(B)
 411         ADD     B,[10,,10]              ; REST IT OFF
 412         MOVEM   B,TD.LNT+1
 413         MOVEI   A,10
 414         PUSHJ   P,CAFRE1
 415         MOVEI   0,TUVEC         ; SETUP UTYPE
 416         HRLM    0,10(B)
 417         MOVEM   B,TD.GET+1
 418         MOVSI   A,(B)
 419         HRRI    A,1(B)
 420         SETZM   (B)
 421         BLT     A,7(B)
 422         MOVEI   A,10
 423         PUSHJ   P,CAFRE1
 424         MOVEI   0,TUVEC         ; SETUP UTYPE
 425         HRLM    0,10(B)
 426         MOVEM   B,TD.PUT+1
 427         MOVSI   A,(B)
 428         HRRI    A,1(B)
 429         SETZM   (B)
 430         BLT     A,7(B)
 431         MOVEI   A,10
 432         PUSHJ   P,CAFRE1
 433         MOVEI   0,TUVEC         ; SETUP UTYPE
 434         HRLM    0,10(B)
 435         MOVEM   B,TD.AGC+1
 436         MOVSI   A,(B)
 437         HRRI    A,1(B)
 438         SETZM   (B)
 439         BLT     A,7(B)
 440
 441 PTSTRT: MOVEI   A,SETUP
 442         ADDI    A,1
 443         SUB     A,PARBOT        ;FIND WHERE PAIRS SHOULD GO
 444         MOVEM   A,PARNEW
 445
 446 ; PURIFY/IMPURIFY THE WORLD (PDL)
 447
 448 IFN ITS,[
 449 PURIMP: MOVE    A,FRETOP
 450         SUBI    A,1
 451         LSH     A,-12
 452         MOVE    B,A
 453         MOVNI   A,1(A)
 454         HRLZ    A,A
 455         DOTCAL  CORBLK,[[1000,,310000],[1000,,-1],A]
 456          FATAL  INITM -- CAN'T IMPURIFY LOW CORE
 457         MOVEI   A,PHIBOT
 458         ADDI    B,1
 459         SUB     A,B
 460         MOVNS   A
 461         HRL     B,A
 462         DOTCAL  CORBLK,[[1000,,0],[1000,,-1],B]
 463          FATAL  INITM -- CAN'T FLUSH MIDDLE CORE
 464         MOVE    B,RHITOP
 465         ASH     B,-10.
 466         SUBI    B,1
 467         MOVEI   A,PHIBOT
 468         SUB     A,B
 469         HRLS    A
 470         HRRI    A,PHIBOT
 471 ;FIXME Disabled because this doesn't succeed...
 472 ;       DOTCAL  CORBLK,[[1000,,210000],[1000,,-1],A]
 473 ;        FATAL  INITM -- CAN'T PURIFY HIGH CORE
 474 ]
 475
 476 IFE ITS,[
 477         MOVEI   A,400000
 478         MOVE    B,[1,,START]
 479         SEVEC
 480 ]
 481         PUSH    P,[15.,,15.]    ;PUSH A SMALL PRGRM ONTO P
 482         MOVEI   A,1(P)  ;POINT TO ITS START
 483         PUSH    P,[JRST AAGC]   ;GO TO AGC
 484         PUSH    P,[MOVE PVP,PVSTOR+1]
 485         PUSH    P,[MOVE B,PSTO+1(PVP)]  ;GET SAVED P
 486         PUSH    P,[SUB B,-14.(P)]       ;FUDGE TO POP OFF PROGRAM
 487         PUSH    P,[MOVEM B,PSAV(TB)]    ;INTO FRAME
 488         PUSH    P,[MOVE B,TPSTO+1(PVP)] ;GET TP
 489         PUSH    P,[MOVEM B,TPSAV(TB)]   ;STORE IT
 490         PUSH    P,[MOVE B,SPSTOR+1]     ;SP
 491         PUSH    P,[MOVEM B,SPSAV(TB)]
 492         PUSH    P,[MOVEI B,TOPLEV]      ;WHERE TO GO
 493         PUSH    P,[MOVEM B,PCSAV(TB)]
 494 IFN ITS,        PUSH    P,[MOVSI B,(.VALUE )]
 495 IFE ITS,        PUSH    P,[MOVSI B,(JRST)]
 496         PUSH    P,[HRRI B,C]
 497         PUSH    P,[JRST B]      ;GO DO VALRET
 498         PUSH    P,[B]
 499         PUSH    P,A             ; PUSH START ADDR
 500         MOVE    B,[JRST -12.(P)]
 501         MOVE    0,[JUMPA START]
 502 IFE ITS,        MOVE    C,[HALTF]
 503 IFE ITS,        SKIPE   OPSYS
 504         MOVE    C,[ASCII \\170/\e9\]
 505         MOVE    D,[ASCII \B/\e1Q\]
 506         MOVE    E,[ASCIZ \\r\16*\r\]                ;TERMINATE
 507         POPJ    P,              ; GO
 508 \f
 509 ; CHECK PAIR SPACE
 510
 511 PAIRCH: CAMG    A,B
 512         JRST    SETTV           ;O.K.
 513
 514 DEATH1: MOVEI   B,[ASCIZ /LOSSAGE--CODE AND DATA OVERLAP
 515 /]
 516         PUSHJ   P,MSGTYP
 517         .VALUE
 518
 519 ;CHARACTER STRING HACKER
 520
 521 CHACK:  MOVE    A,(C)           ;GET TYPE
 522         HLLZM   A,(D)           ;STORE IN NEW HOME
 523         MOVE    B,1(C)          ;GET POINTER
 524         HLRZ    E,B             ;-LENGHT
 525         HRRM    E,(D)
 526         PUSH    P,E+1           ; IDIVI WILL CLOBBER
 527         ADDI    E,4+5*2         ; ROUND AND ACCOUNT FOR DOPE WORDS
 528         IDIVI   E,5             ; E/ WORDS LONG
 529         PUSHJ   P,EBPUR         ; MAKE A PURIFIED COPY
 530         POP     P,E+1
 531         HRLI    B,010700        ;MAKE POINT BYTER
 532         SUBI    B,1
 533         MOVEM   B,1(D)          ;AND STORE IT
 534         ANDI    A,-1    ;CLEAR LH OF A
 535         JUMPE   A,SETLP ;JUMP IF NO REF
 536         HRRZ    B,-1(A) ;SEE IF PREVIOUS INSTRUCTION REFERS TO $TCHSTR
 537         CAIE    B,$TCHSTR       ;SKIP IF IT DOES
 538         JRST    CHACK1  ;NO, JUST DO CHQUOTE PART
 539         HRRM    D,-1(A) ;CLOBBER
 540 CHACK1: MOVEI   E,1(D)
 541         HRRM    E,(A)           ;STORE INTO REFERENCE
 542         MOVEI   E,0
 543         DPB     E,[220400,,(A)]
 544         JRST    SETLP
 545
 546 ; SUBROUTINE TO COPY A HUNK OF STRUCTURE TO THE HIGH SEGMENT
 547
 548 EBPUR:  PUSH    P,E
 549         PUSH    P,A
 550         ADD     E,HITOP         ; GET NEW TOP
 551         CAMG    E,RHITOP        ; SKIP IF TOO BIG
 552         JRST    EBPUR1
 553
 554 ;  CODE TO GROW HI SEG
 555
 556         MOVEI   A,2000
 557         ADDB    A,RHITOP        ; NEW TOP
 558         TLNE    A,777776
 559          JRST   HIFUL
 560 IFN ITS,[
 561         ASH     A,-10.          ; NUM OF BLOCKS
 562         SUBI    A,1             ; BLOCK TO GET
 563         .CALL   HIGET
 564         .VALUE
 565 ]
 566
 567 EBPUR1: MOVEI   A,-1(E)         ; NEEDED TO TERMINATE BLT
 568         EXCH    E,HITOP
 569         HRLI    E,(B)
 570         MOVEI   B,(E)
 571         BLT     E,(A)
 572         POP     P,A
 573         POP     P,E
 574         POPJ    P,
 575
 576 GIVCOR: SETZ
 577         SIXBIT /CORBLK/
 578         1000,,0
 579         1000,,-1
 580         SETZ    A
 581
 582 HIGET:  SETZ
 583         SIXBIT /CORBLK/
 584         1000,,100000
 585         1000,,-1
 586         A
 587         401000,,400001
 588
 589 \f
 590 ; PROCESS AN ATOM AND ADD IT TO AN APPROPRIATE OBLIST IF IT ISN'T
 591 ; ALREADY THERE
 592
 593 ATOMHK: PUSH    TP,$TOBLS       ; SAVE OBLIST
 594         PUSH    TP,[0]          ; FILLED IN LATER
 595         PUSH    TP,$TVEC        ;SAVE TV POINTERS
 596         PUSH    TP,C
 597         PUSH    TP,$TVEC
 598         PUSH    TP,D
 599         MOVE    C,1(C)          ;GET THE ATOM
 600         PUSH    TP,$TATOM       ;AND SAVE
 601         PUSH    TP,C
 602         PUSH    TP,$TATOM
 603         PUSH    TP,[0]
 604         HRRZ    B,(C)           ;GET OBLIST SPEC FROM ATOM
 605         LSH     B,1
 606         ADDI    B,1(TB)         ;POINT TO ITS HOME
 607         HRRM    B,-9(TP)
 608         MOVE    B,(B)
 609         MOVEM   B,-10(TP)       ; CLOBBER
 610
 611         SETZM   2(C)            ; FLUSH CURRENT OBLIST SPEC
 612         MOVEI   E,0
 613         MOVE    D,C
 614         PUSH    P,[LOOKCR]
 615         ADD     D,[3,,3]
 616         JUMPGE  D,.+4
 617         PUSH    P,(D)
 618         ADDI    E,1
 619         AOBJN   D,.-2
 620         PUSH    P,E
 621         MOVSI   A,TOBLS
 622         JRST    ILOOKC
 623 LOOKCR:
 624         MOVEM   B,(TP)
 625         JUMPN   B,CHCKD
 626
 627 ;HERE IF THIS ATOM MUST BE PUT ON OBLIST
 628
 629 USEATM: MOVE    B,-2(TP)                ; GET ATOM
 630         HLRZ    E,(B)           ; SEE IF PURE OR NOT
 631         TRNN    E,400000        ; SKIP IF IMPURE
 632         JRST    PURATM
 633         PUSH    TP,$TATOM
 634         PUSH    TP,B
 635         PUSH    TP,$TOBLS
 636         PUSH    TP,-13(TP)
 637         MCALL   2,INSERT
 638
 639         PUSHJ   P,VALMAK        ;MAKE A GLOBAL VALUE FOR THIS LOSER
 640 PURAT2: MOVE    C,-6(TP)        ;RESET POINTERS
 641         MOVE    D,-4(TP)
 642         SUB     TP,[12,,12]
 643         MOVE    B,(C)           ;MOVE THE ENTRY
 644         HLLZM   B,(D)           ;DON'T WANT REF POINTER STORED
 645         MOVE    A,1(C)          ;AND MOVE ATOM
 646         MOVEM   A,1(D)
 647         MOVEI   A,1(D)
 648         ANDI    B,-1            ;CHECK FOR REAL REF
 649         JUMPE   B,SETLP1        ;DON'T SAVE THIS ATOM ON TVP
 650         HRRM    A,(B)           ;CLOBBER CODE
 651         MOVEI   A,0
 652         DPB     A,[220400,,(B)] ; CLOBBER TVP PORTION
 653         JRST    SETLP
 654
 655
 656 ; HERE TO MAKE A PURE ATOM
 657
 658 PURATM: HRRZ    B,-2(TP)        ; POINT TO IT
 659         HLRE    E,-2(TP)        ; - LNTH
 660         MOVNS   E
 661         ADDI    E,2
 662         PUSHJ   P,EBPUR         ; PURE COPY
 663         HRRM    B,-2(TP)        ; AND STORE BACK
 664         MOVE    B,-2(TP)
 665         JUMPE   0,PURAT0
 666         HRRZ    D,0
 667         HLRE    E,0
 668         SUBM    D,E
 669         HLRZ    0,2(D)
 670         JUMPE   0,PURAT8
 671         CAIG    0,HIBOT
 672         FATAL   INITM--PURE IMPURE LOSSAGE
 673         JRST    PURAT8
 674
 675 PURAT0: HRRZ    E,(C)
 676         MOVE    D,-2(TP)        ; GET ATOM BACK
 677         HRRZ    0,(D)           ; GET OBLIST CODE
 678         JUMPE   E,PURAT9
 679 PURAT7: HLRZ    D,1(E)
 680         MOVEI   D,-2(D)
 681         SUBM    E,D
 682         HLRZ    D,2(D)
 683         CAILE   D,HIBOT                 ; IF NEXT PURE & I AM ROOT
 684         JUMPE   0,PURAT8                ; TAKES ADVANTAGE OF SYSTEM=0
 685         JUMPE   D,PURAT8
 686         MOVE    E,D
 687         JRST    PURAT7
 688
 689 PURAT8: HLRZ    D,1(E)
 690         SUBI    D,2
 691         SUBM    E,D
 692         HLRE    C,B
 693         SUBM    B,C
 694         HLRZ    E,2(D)
 695         HRLM    E,2(B)
 696         HRLM    C,2(D)
 697         JRST    PURAT6
 698
 699 PURAT9: HLRE    A,-2(TP)
 700         SUBM    B,A
 701         HRRZM   A,(C)
 702
 703 PURAT6: MOVE    B,-10(TP)               ; GET BUCKET BACK
 704         MOVE    C,-2(TP)
 705         HRRZ    0,-9(TP)
 706         HRRM    0,2(C)          ; STORE OBLIST IN ATOM
 707 PURAT1: HRRZ    C,(B)           ; GET CONTENTS
 708         JUMPE   C,HICONS        ; AT END, OK
 709         CAIL    C,HIBOT         ; SKIP IF IMPURE
 710         JRST    HICONS  ; CONS IT ON
 711         MOVEI   B,(C)
 712         JRST    PURAT1
 713
 714 HICONS: HRLI    C,TATOM
 715         PUSH    P,C
 716         PUSH    P,-2(TP)
 717         PUSH    P,B
 718         MOVEI   B,-2(P)
 719         MOVEI   E,2
 720         PUSHJ   P,EBPUR         ; MAKE PURE LIST CELL
 721
 722         MOVE    C,(P)
 723         SUB     P,[3,,3]
 724         HRRM    B,(C)           ; STORE IT
 725         MOVE    B,1(B)          ; ATOM BACK
 726         MOVE    C,-6(TP)        ; GET TVP SLOT
 727         HRRM    B,1(C)          ; AND STORE
 728         HLRZ    0,(B)           ; TYPE OF VAL
 729         MOVE    C,B
 730         CAIN    0,TUNBOU        ; NOT UNBOUND?
 731         JRST    PURAT3          ; UNBOUND, NO VAL
 732         MOVEI   E,2             ; COUNT AGAIN
 733         PUSHJ   P,EBPUR         ; VALUE CELL
 734         MOVE    C,-2(TP)                ; ATOM BACK
 735         HLLZS   (B)             ; CLEAR LH
 736         MOVSI   0,TLOCI
 737         MOVEM   B,1(C)
 738         SKIPA
 739 PURAT3: MOVEI   0,0
 740         HRRZ    A,(C)           ; GET OBLIST CODE
 741         MOVE    A,OBTBL2(A)
 742         HRRM    A,2(C)          ; STORE OBLIST SLOT
 743         MOVEM   0,(C)
 744         JRST    PURAT2
 745 \f
 746 ; A POSSIBLE MATCH ARRIVES HERE
 747
 748 CHCKD:  MOVE    D,(TP)          ;THEY MATCH!,  GET EXISTING ATOM
 749         MOVEI   A,(D)           ;GET TYPE OF IT
 750         MOVE    B,-2(TP)        ;GET NEW ATOM
 751         HLRZ    0,(B)
 752         TRZ     A,377777        ; SAVE ONLY 400000 BIT
 753         TRZ     0,377777
 754         CAIN    0,(A)           ; SKIP IF WIN
 755         JRST    IM.PUR
 756         MOVSI   0,400000
 757         ANDCAM  0,(B)
 758         ANDCAM  0,(D)
 759         HLRZ    A,(D)
 760         JUMPN   A,A1VAL
 761         MOVE    A,(B)           ;MOVE VALUE
 762         MOVEM   A,(D)
 763         MOVE    A,1(B)
 764         MOVEM   A,1(D)
 765         MOVE    B,D             ;EXISTING ATOM TO B
 766         MOVEI   0,(B)
 767         CAIL    0,HIBOT
 768         JRST    .+3
 769         PUSHJ   P,VALMAK        ;MAKE A VALUE
 770         JRST    .+2
 771         PUSHJ   P,PVALM
 772
 773 ;NOW FIND ATOMS OCCURENCE IN XFER VECTOR
 774
 775 OFFIND: MOVE    D,-4(TP)        ;GET CURRENT POINTER INTO TP
 776         MOVE    C,[-TVLNT,,TVSTRT]      ;AND A COPY OF TVP
 777         MOVEI   A,0             ;INITIALIZE COUNTER
 778 ALOOP:  CAMN    B,1(C)          ;IS THIS IT?
 779         JRST    AFOUND
 780         ADD     C,[2,,2]        ;BUMP COUNTER
 781         CAMG    C,D
 782         AOJA    A,ALOOP         ;NO, KEEP LOOKING
 783
 784         MOVEI   B,[ASCIZ /LOSSAGE--ATOM DISAPPEARED
 785 /]
 786 TYPIT:  PUSHJ   P,MSGTYP
 787         .VALUE
 788
 789 AFOUND: LSH     A,1             ;FOUND ATOM, GET REAL OFFSET
 790         ADDI    A,1
 791         ADDI    A,TVSTRT
 792         MOVE    C,-6(TP)        ;GET TV POINTER TO NEW ATOM
 793         HRRZ    B,(C)           ;POINT TO REFERENCE
 794         SKIPE   B               ;ANY THERE?
 795         HRRM    A,(B)           ;YES, CLOBBER AWAY
 796         SUB     TP,[12,,12]
 797         MOVEI   A,0
 798         DPB     A,[220400,,(B)] ; KILL TVP POINTER
 799         JRST    SETLP1          ;AND GO ON
 800
 801 A1VAL:  HLRZ    C,(B)           ;GET VALUE'S TYPE
 802         MOVE    B,D             ;NOW PUT EXISTING ATOM IN B
 803         CAIN    C,TUNBOU        ;UNBOUND?
 804         JRST    OFFIND          ;YES, WINNER
 805
 806         MOVEI   B,[ASCIZ /LOSSAGE--ATOM TRIES TO HAVE 2 VALUES
 807 /]
 808         JRST    TYPIT
 809
 810
 811 IM.PUR: MOVEI   B,[ASCIZ /LOSSAG--ATOM TRIES TO BE BOTH PURE AND IMPURE
 812 /]
 813         JRST    TYPIT
 814
 815 PAGLOS: MOVEI   B,[ASCIZ /LOSSAGE--IMPURE CORE EXTENDS INTO HIGH SEGMENT
 816 /]
 817         JRST    TYPIT
 818
 819 HIFUL:  MOVEI   B,[ASCIZ /LOSSAGE--HI SEG FULL
 820 /]
 821         JRST    TYPIT
 822
 823 \f
 824 ;MAKE A VALUE IN SLOT ON GLOBAL SP
 825
 826 VALMAK: HLRZ    A,(B)           ;TYPE OF VALUE
 827         CAIE    A,400000+TUNBOU
 828         CAIN    A,TUNBOU        ;VALUE?
 829         JRST    VALMA1
 830         MOVE    A,GLOBSP+1      ;GET POINTER TO GLOBAL SP
 831         SUB     A,[4,,4]        ;ALLOCATE SPACE
 832         CAMG    A,GLOBAS+1      ;CHECK FOR OVERFLOW
 833         JRST    SPOVFL
 834         MOVEM   A,GLOBSP+1      ;STORE IT BACK
 835         MOVE    C,(B)           ;GET TYPE CELL
 836         TLZ     C,400000
 837         HLLZM   C,2(A)          ;INTO TYPE CELL
 838         MOVE    C,1(B)          ;GET VALUE
 839         MOVEM   C,3(A)          ;INTO VALUE SLOT
 840         MOVSI   C,TGATOM        ;GET TATOM,,0
 841         MOVEM   C,(A)
 842         MOVEM   B,1(A)          ;AND POINTER TO ATOM
 843         MOVSI   C,TLOCI         ;NOW CLOBBER THE ATOM
 844         MOVEM   C,(B)           ;INTO TYPE CELL
 845         ADD     A,[2,,2]        ;POINT TO VALUE
 846         MOVEM   A,1(B)
 847         POPJ    P,
 848
 849 VALMA1: SETZM   (B)
 850         POPJ    P,
 851
 852 SPOVFL: MOVEI   B,[ASCIZ /LOSSAGE--GLOBAL SP OVERFLOW
 853 /]
 854         JRST    TYPIT
 855
 856
 857 PVALM:  HLRZ    0,(B)
 858         CAIE    0,400000+TUNBOU
 859         CAIN    0,TUNBOU
 860         JRST    VALMA1
 861         MOVEI   E,2
 862         PUSH    P,B
 863         PUSHJ   P,EBPUR
 864         POP     P,C
 865         MOVEM   B,1(C)
 866         MOVSI   0,TLOCI
 867         MOVEM   0,(C)
 868         MOVE    B,C
 869         POPJ    P,
 870 \f;SET UP LIST OF INTERNAL NAMES AND ADDRESS NEEDED BY COMPILER
 871
 872 VECTGO DUMMY1
 873
 874 IRP     A,,[FINIS,SPECBIND,WNA,WRONGT,$TLOSE,CALER1,POPUNW
 875 ILOC,IGLOC,IDVAL,IDVAL1,ILVAL,IGVAL,INTFLG,LCKINT,ONINT,TYPLOO,TDEFER
 876 IFALSE,UNAS,UNBOU,RCALL,SEGMNT,SEGLST,NUMPRI,OPSYS,SSPEC1,COMPERR
 877 MAKACT,MAKENV,BFRAME,TTP,TTB,$TTP,$TTB,MAKTUP,TPALOC,IBIND,SSPECS
 878 CILVAL,CISET,CIGVAL,CSETG,IBLOK1,IBLOCK,CLLOC,CGLOC,CASSQ,CGASSQ
 879 CILNT,CILNQ,CILEGQ,CEMPTY,CIEQUA,CIREST,CINTH,CIAT,CSETLO,CIN
 880 CIPUT,CIGET,CIGETL,CIMON,CISTRU,CIMEMQ,CIMEMB,CITOP,CIBACK,TYPSEG
 881 C1CONS,CICONS,CIUVEC,CIVEC,IIFORM,IILIST,CISTNG,HITOP,INCR1,TYPG,VALG,TESTR
 882 OTBSAV,CITYPE,CFRAME,CARGS,CFUNCT,CUTYPE,CPTYPE,CTYPEP,CTYPEQ,CCHUTY
 883 CIREMA,RTFALS,CIPUTP,CIGETP,CIGTPR,MPOPJ,TAB,$TAB,ICONS,CSTO,DSTO,NTPALO
 884 CPLUS,CTIMES,CTIME,CDIVID,CMINUS,CLQ,CLEQ,CGQ,CGEQ,CLOG,CSIN,CCOS,CATAN,CSQRT
 885 CFIX,CFLOAT,CEXP,CRAND,CINEQU,SPECBND,PGGIVE,PGFIND,MTYO,CMIN,CMAX,RCL,R1C,W1C
 886 CALLTY,CTYPEC,CTYPEW,NOTTY,CHKAB,CTMPLT,IUNWIN,UNWIN2,NOSHUF,ROOT,ERROBL,INTOBL
 887 CINSER,CIRMV,CLOOKU,CATOM,CIPNAM,ISTRCM,CITERP,CIPRIN,CIPRN1,CIPRNC,CGFALS
 888 CPATM,CP1ATM,CPCATM,CPSTR,CP1STR,CPCSTR,CPCH,CREADC,CNXTCH,CREDC1,CNXTC1
 889 CGBOUN,IIGLOC,MAKTU2,CIFLTZ,CIUPRS,SAT,TFA,WTYP,NAPT,PTYPE,APLQ,PURBOT,GCSBOT
 890 GLOTOP,TYPVEC,1STEPR,LSTRES,NODES,MAINPR,CVTYPE,CSPNAM,CSBSTR,INTBCK,CICRLF
 891 CERR1,CERR2,CERR3,CANDP,CORP,CSQUTA,CIMAGE,ATOSQ,CFILLE,CPRTYC,FMPOPJ
 892 TD.PUT,TD.GET,TD.LNT,CBYTES,MARK,MARK2G,TD.AGC,DSTORE,RCLV,NUMSAT,RMCALL,NPRFLG
 893 NSPOPJ,NFPOPJ,PURCLN,FRETOP,PURVEC,SWAPGC,VECBOT]
 894         .GLOBAL A
 895         ADDSQU A
 896 TERMIN
 897 IFE ITS,[
 898 IRP     A,,[NTTYPE,CLRSTR]
 899         .GLOBAL A
 900         ADDSQU A
 901 TERMIN
 902 ]
 903
 904 VECRET
 905
 906 ; ROUTINE TO SORT AND PURIFY SQUOZE TABLE
 907
 908 SQSETU: MOVE    A,[SQUTBL-SQULOC+2,,SQUTBL]
 909         MOVEI   0,1
 910 SQ2:    MOVE    B,(A)
 911         CAMG    B,2(A)
 912         JRST    SQ1
 913         MOVEI   0,0
 914         EXCH    B,2(A)
 915         MOVEM   B,(A)
 916         MOVE    B,1(A)
 917         EXCH    B,3(A)
 918         MOVEM   B,1(A)
 919 SQ1:    ADD     A,[2,,2]
 920         JUMPL   A,SQ2
 921         JUMPE   0,SQSETU
 922 IFE ITS,[
 923 STSQU:  MOVE    B,[440700,,SQBLK]
 924         PUSHJ   P,MNGNAM
 925         HRROI   B,SQBLK
 926         MOVSI   A,600001
 927         GTJFN
 928         FATAL   CANT MAKE FIXUP FILE
 929         MOVEI   E,(A)
 930         MOVE    B,[440000,,100000]
 931         OPENF
 932         FATAL   CANT OPEN FIXUP FILE
 933         MOVE    B,[444400,,SQUTBL]
 934         MOVNI   C,SQULOC-SQUTBL
 935         SOUT
 936         MOVEI   A,(E)
 937         CLOSF
 938         JFCL
 939         MOVE    A,[SQUTBL-SQULOC,,SQUTBL]
 940         MOVEM   A,SQUPNT"
 941 ]
 942 IFN ITS,[
 943 .GLOBAL CSIXBT
 944 STSQU:  MOVE    C,MUDSTR+2              ; CALCULATE SECOND FILE NAME FOR SQUOZE TABLE
 945         PUSHJ   P,CSIXBT
 946         HRRI    C,(SIXBIT/TAB/) ; TABxxx IS SECOND NAME OF FILE
 947         MOVSS   C
 948         MOVEM   C,SQBLK+2               ; STORE IN APPROPRIATE BLOCKS
 949         MOVEM   C,SQWBLK+2
 950         .SUSET  [.SSNAM,,SQDIR]
 951         .OPEN   GCHN,SQWBLK     ; OPEN FILE
 952         FATAL CAN'T CREATE SQUOZE FILE
 953         MOVE    A,[SQUTBL-SQULOC,,SQUTBL]
 954         MOVEM   A,SQUPNT"
 955         .IOT    GCHN,A
 956         .CLOSE  GCHN            ; CLOSE THE CHANNEL
 957 ]
 958         POPJ    P,
 959
 960 RHITOP: 0
 961
 962 OBSZ:   151.
 963         13.
 964         151.
 965         151.
 966         317.
 967
 968 OBTBL2: ROOT+1
 969         ERROBL+1
 970         INTOBL+1
 971         MUDOBL+1
 972         INITIAL+1
 973
 974 OBTBL:  INITIAL+1-TVSTRT+TVBASE
 975         MUDOBL+1-TVSTRT+TVBASE
 976         INTOBL+1-TVSTRT+TVBASE
 977         ERROBL+1-TVSTRT+TVBASE
 978         ROOT+1-TVSTRT+TVBASE
 979 OBNAM:  MQUOTE INITIAL
 980         IMQUOTE MUDDLE
 981         MQUOTE INTERRUPTS
 982         MQUOTE ERRORS
 983         MQUOTE ROOT
 984
 985 OBTBL1: INITIAL+1
 986         MUDOBL+1
 987         INTOBL+1
 988         ERROBL+1
 989         ROOT+1
 990
 991
 992 IFN ITS,[
 993 SQWBLK: SIXBIT /  'DSK/
 994         SIXBIT /SQUOZE/
 995         SIXBIT /TABLE/
 996 ]
 997 IFE ITS,[
 998 MNGNAM: MOVE    A,[440700,,MUDSTR+2]            ; FOR NAME HACKING
 999         ILDB    0,A                     ; SEE IF IT IS A VERSION
1000         CAIN    0,177
1001          POPJ   P,
1002         MOVE    A,B
1003         ILDB    0,A
1004         CAIN    0,"X                    ; LOOK FOR X'S
1005          JRST   .+3
1006         MOVE    B,A
1007         JRST    .-4
1008
1009         MOVE    A,[440700,,MUDSTR+2]
1010         ILDB    0,A
1011         IDPB    0,B
1012         ILDB    0,A
1013         IDPB    0,B
1014         ILDB    0,A
1015         IDPB    0,B
1016         POPJ    P,
1017 ]
1018
1019 IFN ITS,[
1020 .GLOBAL VCREATE,MUDSTR
1021
1022 DEBUG:  MOVE    E,[440600,,[SIXBIT /EXPERIMENTAL/]]
1023         MOVEI   0,12.
1024         JRST    STUFF
1025
1026 VCREATE:        .SUSET  [.SSNAM,,[SIXBIT /MUDSYS/]]
1027         .OPEN   0,OP%
1028         .VALUE
1029         MOVEI   0,0     ; SET 0 TO DO THE .RCHST
1030         .RCHST  0
1031         .CLOSE  0
1032         .FDELE  DB%
1033         .VALUE
1034         MOVE    E,[440600,,B]
1035         MOVEI   0,6
1036 STUFF:  MOVE    D,[440700,,MUDSTR+2]
1037 STUFF1: ILDB    A,E             ; GET A CHAR
1038         CAIN    A,0             ;SUPRESS SPACES
1039         MOVEI   A,137           ;RUBOUT'S DON'T TYPE OUT
1040         ADDI    A,40            ; TO ASCII
1041         IDPB    A,D             ; STORE
1042         SOJN    0,STUFF1
1043         SETZM   34
1044         SETZM   35
1045         SETZM   36
1046         .VALUE
1047
1048 OP%:    1,,(SIXBIT /DSK/)
1049         SIXBIT /MUD%/
1050         SIXBIT />/
1051
1052 DB%:    (SIXBIT /DSK/)
1053         SIXBIT /MUD%/
1054         SIXBIT /</
1055         0
1056         0
1057 ]
1058
1059
1060 .GLOBAL GCDIR,ILDBLK,TILDBL,GCLDBK,LENGC,SLENGC,SGCLBK,RLENGC
1061 .GLOBAL SECBLK,SECLEN,RSLENG,DECBLK
1062
1063 ; ROUTINE TO DUMP OUT THE GARBAGE-COLLECTOR
1064
1065 DUMPGC:
1066 IFN ITS,[
1067         .SUSET  [.SSNAM,,GCDIR]                 ; SET SNAME
1068         MOVE    C,MUDSTR+2                      ; CREATE SECOND NAMES
1069         PUSHJ   P,CSIXBT
1070         HRRI    C,(SIXBIT /MUD/)
1071         MOVS    A,C                             ; MUDxx IS SECOND NAME
1072         MOVEM   A,GCLDBK+2
1073         MOVEM   A,SGCLBK+2
1074         MOVEM   A,ILDBLK+2
1075         MOVEM   A,GCDBLK+2                      ; SMASH IN SECOND NAMES
1076         MOVEM   A,SGCDBK+2
1077         MOVEM   A,INTDBK+2
1078         .OPEN   0,GCDBLK                        ; OPEN GC FILE
1079         FATAL   CANT CREATE AGC FILE
1080         MOVNI   A,LENGC                         ; CALCULATE IOT POINTER
1081         ASH     A,10.
1082         HRLZS   A
1083         HRRI    A,REALGC
1084         .IOT    0,A                             ; SEND IT OUT
1085         .CLOSE  0,                              ; CLOSE THE CHANNEL
1086         .OPEN   0,SGCDBK                        ; OPEN GC FILE
1087         FATAL   CANT CREATE AGC FILE
1088         MOVNI   A,SLENGC                        ; CALCULATE IOT POINTER
1089         ASH     A,10.
1090         HRLZS   A
1091         HRRI    A,REALGC+RLENGC
1092         .IOT    0,A                             ; SEND IT OUT
1093         .CLOSE  0,                              ; CLOSE THE CHANNEL
1094
1095
1096 ; ROUTINE TO DUMP THE INTERPRETER
1097
1098         .SUSET  [.SSNAM,,INTDIR]
1099         .OPEN   0,ILDBLK                        ; OPEN FILE TO INTERPRETER BLOCK
1100         FATAL   CANT FIXUP INTERPRETER
1101         HLRE    B,TP                            ; MAKE SURE BIG ENOUGJ
1102         MOVNS   B                               ; SEE IF WE WIN
1103         CAIGE   B,400                           ; SKIP IF WINNING
1104         FATAL   NO ROOM FOR PAGE MAP
1105         MOVSI   A,-400
1106         HRRI    A,1(TP)
1107         .ACCES  0,[1]
1108         .IOT    0,A                     ; GET IN PAGE MAP
1109         .CLOSE  0,
1110         .OPEN   0,INTDBK
1111         FATAL   CANT FIXUP INTERPRETER
1112         MOVEI   A,1                             ; INITIALIZE FILE PAGE COUNT
1113         MOVEI   B,0                             ; CORE PAGE COUNT
1114         MOVEI   E,1(TP)
1115 LOPFND: HRRZ    0,(E)
1116         JUMPE   0,NOPAG                         ; IF 0 FORGET IT
1117         ADDI    A,1                             ; AOS FILE MAP
1118 NOPAG:  ADDI    B,1                             ; AOS PAGE MAP
1119         CAIE    B,PAGEGC                                ; SKIP IF DONE
1120         AOJA    E,LOPFND
1121         ASH     A,10.                           ; TO WORDS
1122         .ACCES  0,A
1123         MOVNI   B,LENGC
1124         ASH     B,10.                           ; TO WORDS
1125         HRLZS   B                               ; SWAP
1126         HRRI    B,AGCLD
1127         .IOT    0,B
1128         .CLOSE  0,
1129         POPJ    P,                              ; DONE
1130
1131 GCDBLK: SIXBIT /  'DSK/
1132         SIXBIT /AGC/
1133         SIXBIT /MUD  /
1134
1135 SGCDBK: SIXBIT /  'DSK/
1136         SIXBIT /SGC/
1137         SIXBIT /MUD  /
1138
1139 INTDBK: 100007,,(SIXBIT /DSK/)
1140         SIXBIT /TS/
1141         SIXBIT /MUD/
1142
1143 ]
1144 IFE ITS,[
1145         MOVE    B,[440700,,GCLDBK]
1146         PUSHJ   P,MNGNAM                        ; VERSION TO NAME IF NECESSARY
1147         HRROI   B,GCLDBK
1148         MOVSI   A,600001
1149         GTJFN
1150          FATAL  CANT WRITE OUT GC
1151         MOVEI   E,(A)
1152         MOVE    B,[440000,,100000]
1153         OPENF
1154          FATAL  CANT OPEN GC FILE
1155         MOVNI   C,LENGC
1156         ASH     C,10.
1157         MOVE    B,[444400,,REALGC]
1158         MOVEI   A,(E)
1159         SOUT
1160         MOVEI   A,(E)
1161         CLOSF
1162          JFCL
1163         MOVEI   D,LENGC+LENGC
1164         MOVNI   A,1
1165         MOVEI   B,REALGC
1166         ASH     B,-9.
1167         HRLI    B,400000
1168
1169         PMAP
1170         ADDI    B,1
1171         SOJG    D,.-2
1172
1173         MOVE    B,[440700,,SGCLBK]
1174         PUSHJ   P,MNGNAM                        ; VERSION TO NAME IF NECESSARY
1175         HRROI   B,SGCLBK
1176         MOVSI   A,600001
1177         GTJFN
1178          FATAL  CANT WRITE OUT GC
1179         MOVEI   E,(A)
1180         MOVE    B,[440000,,100000]
1181         OPENF
1182          FATAL  CANT OPEN GC FILE
1183         MOVNI   C,SLENGC
1184         ASH     C,10.
1185         MOVE    B,[444400,,REALGC+RLENGC]
1186         MOVEI   A,(E)
1187         SOUT
1188         MOVEI   A,(E)
1189         CLOSF
1190          JFCL
1191         MOVEI   D,SLENGC+SLENGC
1192         MOVNI   A,1
1193         MOVEI   B,REALGC+RLENGC
1194         ASH     B,-9.
1195         HRLI    B,400000
1196
1197         PMAP
1198         ADDI    B,1
1199         SOJG    D,.-2
1200
1201         MOVE    B,[440700,,SECBLK]
1202         PUSHJ   P,MNGNAM                        ; VERSION TO NAME IF NECESSARY
1203         HRROI   B,SECBLK
1204         MOVSI   A,600001
1205         GTJFN
1206          FATAL  CANT WRITE OUT GC
1207         MOVEI   E,(A)
1208         MOVE    B,[440000,,100000]
1209         OPENF
1210          FATAL  CANT OPEN GC FILE
1211         MOVNI   C,SECLEN
1212         ASH     C,10.
1213         MOVE    B,[444400,,REALGC+RLENGC+RSLENG]
1214         MOVEI   A,(E)
1215         SOUT
1216         MOVEI   A,(E)
1217         CLOSF
1218          JFCL
1219
1220 ; NOW MUNG THE THING TO BE DIFFERENT TO USE UUOS FOR DEBUGGING VERSION
1221
1222 .GLOBAL %FXUPS,%FXEND
1223
1224         MOVEI   A,%FXUPS
1225
1226 %DBG1:  HLRZ    D,(A)
1227         HRRZ    A,(A)
1228         LDB     0,[331100,,(A)]         ; GET INS
1229         MOVEI   C,%TBL
1230         HRRZ    B,(C)
1231         CAME    B,0
1232          AOJA   C,.-2
1233         CAIN    B,<<(XBLT)>_<-9.>>
1234          HLLZS  (A)
1235         LDB     B,[331100,,(C)]
1236         DPB     B,[331100,,(A)]
1237         MOVE    A,D
1238         JUMPN   A,%DBG1
1239 %DBG2:
1240         MOVE    B,[440700,,DECBLK]
1241         PUSHJ   P,MNGNAM                        ; VERSION TO NAME IF NECESSARY
1242         HRROI   B,DECBLK
1243         MOVSI   A,600001
1244         GTJFN
1245          FATAL  CANT WRITE OUT GC
1246         MOVEI   E,(A)
1247         MOVE    B,[440000,,100000]
1248         OPENF
1249          FATAL  CANT OPEN GC FILE
1250         MOVNI   C,SECLEN
1251         ASH     C,10.
1252         MOVE    B,[444400,,REALGC+RLENGC+RSLENG]
1253         MOVEI   A,(E)
1254         SOUT
1255         MOVEI   A,(E)
1256         CLOSF
1257          JFCL
1258         MOVEI   D,SECLEN+SECLEN
1259         MOVNI   A,1
1260         MOVEI   B,REALGC+RLENGC
1261         ASH     B,-9.
1262         HRLI    B,400000
1263
1264         PMAP
1265         ADDI    B,1
1266         SOJG    D,.-2
1267
1268         MOVE    B,[440700,,ILDBLK]
1269         SKIPE   OPSYS
1270          MOVE   B,[440700,,TILDBL]
1271         PUSHJ   P,MNGNAM
1272         MOVSI   C,-1000
1273         MOVSI   A,400000
1274 RPA:    RPACS
1275         TLNE    B,10000
1276         TLNN    B,400                   ; SKIP IF NOT PRIVATE
1277         SKIPA
1278          MOVES  (C)
1279         ADDI    C,777
1280         ADDI    A,1
1281         AOBJN   C,RPA
1282
1283         MOVNI   A,1
1284         CLOSF
1285          FATAL  CANT CLOSE STUFF
1286         HRROI   B,ILDBLK
1287         MOVSI   A,100001
1288         GTJFN                                   ; GET A JFN
1289          FATAL  GARBAGE COLLECTOR IS MISSING
1290         HRRZS   E,A                             ; SAVE JFN
1291         MOVE    B,[440000,,300000]
1292         OPENF
1293          FATAL  CANT OPEN GC FILE
1294         MOVEI   A,(E)                           ; FIND OUT LENGTH OF MAP
1295         BIN                                     ; GET LENGTH WORD
1296         HLRZ    0,B
1297         CAIE    0,1776                          ; TOPS20 SSAVE FILE FORMAT
1298          CAIN   0,1000                          ; TENEX SSAVE FILE FORMAT
1299           JRST  .+2
1300         FATAL   NOT AN SSAVE FILE
1301          MOVEI  A,(B)                           ; ISOLATE SIZE OF MAP
1302         HLRE    B,TP                            ; MUST BE SPACE FOR CRUFT
1303         MOVNS   B
1304         CAIGE   B,(A)                           ; ROOM?
1305          FATAL  NO ROOM FOR PAGE MAP (GULP)
1306         MOVN    C,A
1307         MOVEI   A,(E)                           ; READY TO READ IN MAP
1308         MOVEI   B,1(TP)                         ; ONTO TP STACK
1309         HRLI    B,444400
1310         SIN                                     ; SNARF IT IN
1311
1312         MOVEI   A,1(TP)                         ; POINT TO MAP
1313         CAIE    0,1000
1314          JRST   RPA1                            ; GO TO THE TOPS20 CODE
1315         LDB     0,[221100,,(A)]                 ; GET FORK PAGE
1316         CAIE    0,PAGEGC+PAGEGC                 ; GOT IT?
1317          AOJA   A,.-2
1318         JRST    RPA2
1319
1320 RPA1:   ADDI    A,1                             ; POINT TO PROCESS PAGE NUMBER
1321         LDB     0,[331100,,(A)]                 ; REPEAT COUNT IN 0
1322         LDB     B,[3300,,(A)]                   ; FIRST PAGE NUMBER IN B
1323         ADD     0,B                             ; LARGEST PAGE NUMBER
1324         CAIL    0,PAGEGC+PAGEGC
1325          CAILE  B,PAGEGC+PAGEGC
1326           AOJA  A,RPA1                          ; NEXT PAIR OF WORDS PLEASE
1327         SUBI    A,1                             ; POINT TO FILE PAGE NUMBER
1328         SUBI    B,PAGEGC+PAGEGC
1329         MOVN    B,B
1330         ADDM    B,(A)                           ; SET UP THE PAGE
1331
1332 RPA2:   HRRZ    B,(A)                           ; GET PAGE
1333         MOVEI   A,(E)                           ; GET JFN
1334         ASH     B,9.
1335         SFPTR
1336          FATAL  ACCESS OF FILE FAILED
1337         MOVEI   A,(E)
1338         MOVE    B,[444400,,AGCLD]
1339         MOVNI   C,LENGC
1340         ASH     C,10.
1341         SOUT
1342         MOVEI   A,(E)
1343         CLOSF
1344          JFCL
1345         POPJ    P,
1346
1347 ; CODE TO DISTINGUISH BETWEEN TOPS20 AND TENEX AT SETUP TIME
1348
1349 TWENTY: HRROI   A,C                             ; RESULTS KEPT HERE
1350         HRLOI   B,600015
1351         MOVEI   C,0                             ; CLEAN C UP
1352         DEVST
1353          JFCL
1354         MOVEI   A,1                             ; TENEX HAS OPSYS = 1
1355         CAME    C,[ASCII/NUL/]                  ; TOPS20 GIVES "NUL"
1356          MOVEM  A,OPSYS                         ; TENEX  GIVES "NIL"
1357         POPJ    P,
1358 %TBL:   IRP A,,[HRRM,HRLM,MOVEM,SETZM,HLRZ,XBLT]
1359         S!A <<(A)>_<-9.>>
1360         TERMIN
1361
1362 GCLDBK: ASCIZ /MDLXXX.AGC/
1363 SGCLBK: ASCIZ /MDLXXX.SGC/
1364 SECBLK: ASCIZ /MDLXXX.SEC/
1365 ILDBLK: ASCIZ /MDLXXX.EXE/
1366 TILDBL: ASCIZ /MDLXXX.SAV/
1367 DECBLK: ASCIZ /MDLXXX.DEC/
1368 ]
1369
1370
1371
1372 END SETUP
1373 \f