<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    A,[-<400-PHIBOT>,,PHIBOT]
 465         DOTCAL  CORBLK,[[1000,,210000],[1000,,-1],A]
 466          FATAL  INITM -- CAN'T PURIFY HIGH CORE
 467 ]
 468
 469 IFE ITS,[
 470         MOVEI   A,400000
 471         MOVE    B,[1,,START]
 472         SEVEC
 473 ]
 474         PUSH    P,[15.,,15.]    ;PUSH A SMALL PRGRM ONTO P
 475         MOVEI   A,1(P)  ;POINT TO ITS START
 476         PUSH    P,[JRST AAGC]   ;GO TO AGC
 477         PUSH    P,[MOVE PVP,PVSTOR+1]
 478         PUSH    P,[MOVE B,PSTO+1(PVP)]  ;GET SAVED P
 479         PUSH    P,[SUB B,-14.(P)]       ;FUDGE TO POP OFF PROGRAM
 480         PUSH    P,[MOVEM B,PSAV(TB)]    ;INTO FRAME
 481         PUSH    P,[MOVE B,TPSTO+1(PVP)] ;GET TP
 482         PUSH    P,[MOVEM B,TPSAV(TB)]   ;STORE IT
 483         PUSH    P,[MOVE B,SPSTOR+1]     ;SP
 484         PUSH    P,[MOVEM B,SPSAV(TB)]
 485         PUSH    P,[MOVEI B,TOPLEV]      ;WHERE TO GO
 486         PUSH    P,[MOVEM B,PCSAV(TB)]
 487 IFN ITS,        PUSH    P,[MOVSI B,(.VALUE )]
 488 IFE ITS,        PUSH    P,[MOVSI B,(JRST)]
 489         PUSH    P,[HRRI B,C]
 490         PUSH    P,[JRST B]      ;GO DO VALRET
 491         PUSH    P,[B]
 492         PUSH    P,A             ; PUSH START ADDR
 493         MOVE    B,[JRST -12.(P)]
 494         MOVE    0,[JUMPA START]
 495 IFE ITS,        MOVE    C,[HALTF]
 496 IFE ITS,        SKIPE   OPSYS
 497         MOVE    C,[ASCII \\170/\e9\]
 498         MOVE    D,[ASCII \B/\e1Q\]
 499         MOVE    E,[ASCIZ \\r\16*\r\]                ;TERMINATE
 500         POPJ    P,              ; GO
 501 \f
 502 ; CHECK PAIR SPACE
 503
 504 PAIRCH: CAMG    A,B
 505         JRST    SETTV           ;O.K.
 506
 507 DEATH1: MOVEI   B,[ASCIZ /LOSSAGE--CODE AND DATA OVERLAP
 508 /]
 509         PUSHJ   P,MSGTYP
 510         .VALUE
 511
 512 ;CHARACTER STRING HACKER
 513
 514 CHACK:  MOVE    A,(C)           ;GET TYPE
 515         HLLZM   A,(D)           ;STORE IN NEW HOME
 516         MOVE    B,1(C)          ;GET POINTER
 517         HLRZ    E,B             ;-LENGHT
 518         HRRM    E,(D)
 519         PUSH    P,E+1           ; IDIVI WILL CLOBBER
 520         ADDI    E,4+5*2         ; ROUND AND ACCOUNT FOR DOPE WORDS
 521         IDIVI   E,5             ; E/ WORDS LONG
 522         PUSHJ   P,EBPUR         ; MAKE A PURIFIED COPY
 523         POP     P,E+1
 524         HRLI    B,010700        ;MAKE POINT BYTER
 525         SUBI    B,1
 526         MOVEM   B,1(D)          ;AND STORE IT
 527         ANDI    A,-1    ;CLEAR LH OF A
 528         JUMPE   A,SETLP ;JUMP IF NO REF
 529         HRRZ    B,-1(A) ;SEE IF PREVIOUS INSTRUCTION REFERS TO $TCHSTR
 530         CAIE    B,$TCHSTR       ;SKIP IF IT DOES
 531         JRST    CHACK1  ;NO, JUST DO CHQUOTE PART
 532         HRRM    D,-1(A) ;CLOBBER
 533 CHACK1: MOVEI   E,1(D)
 534         HRRM    E,(A)           ;STORE INTO REFERENCE
 535         MOVEI   E,0
 536         DPB     E,[220400,,(A)]
 537         JRST    SETLP
 538
 539 ; SUBROUTINE TO COPY A HUNK OF STRUCTURE TO THE HIGH SEGMENT
 540
 541 EBPUR:  PUSH    P,E
 542         PUSH    P,A
 543         ADD     E,HITOP         ; GET NEW TOP
 544         CAMG    E,RHITOP        ; SKIP IF TOO BIG
 545         JRST    EBPUR1
 546
 547 ;  CODE TO GROW HI SEG
 548
 549         MOVEI   A,2000
 550         ADDB    A,RHITOP        ; NEW TOP
 551         TLNE    A,777776
 552          JRST   HIFUL
 553 IFN ITS,[
 554         ASH     A,-10.          ; NUM OF BLOCKS
 555         SUBI    A,1             ; BLOCK TO GET
 556         .CALL   HIGET
 557         .VALUE
 558 ]
 559
 560 EBPUR1: MOVEI   A,-1(E)         ; NEEDED TO TERMINATE BLT
 561         EXCH    E,HITOP
 562         HRLI    E,(B)
 563         MOVEI   B,(E)
 564         BLT     E,(A)
 565         POP     P,A
 566         POP     P,E
 567         POPJ    P,
 568
 569 GIVCOR: SETZ
 570         SIXBIT /CORBLK/
 571         1000,,0
 572         1000,,-1
 573         SETZ    A
 574
 575 HIGET:  SETZ
 576         SIXBIT /CORBLK/
 577         1000,,100000
 578         1000,,-1
 579         A
 580         401000,,400001
 581
 582 \f
 583 ; PROCESS AN ATOM AND ADD IT TO AN APPROPRIATE OBLIST IF IT ISN'T
 584 ; ALREADY THERE
 585
 586 ATOMHK: PUSH    TP,$TOBLS       ; SAVE OBLIST
 587         PUSH    TP,[0]          ; FILLED IN LATER
 588         PUSH    TP,$TVEC        ;SAVE TV POINTERS
 589         PUSH    TP,C
 590         PUSH    TP,$TVEC
 591         PUSH    TP,D
 592         MOVE    C,1(C)          ;GET THE ATOM
 593         PUSH    TP,$TATOM       ;AND SAVE
 594         PUSH    TP,C
 595         PUSH    TP,$TATOM
 596         PUSH    TP,[0]
 597         HRRZ    B,(C)           ;GET OBLIST SPEC FROM ATOM
 598         LSH     B,1
 599         ADDI    B,1(TB)         ;POINT TO ITS HOME
 600         HRRM    B,-9(TP)
 601         MOVE    B,(B)
 602         MOVEM   B,-10(TP)       ; CLOBBER
 603
 604         SETZM   2(C)            ; FLUSH CURRENT OBLIST SPEC
 605         MOVEI   E,0
 606         MOVE    D,C
 607         PUSH    P,[LOOKCR]
 608         ADD     D,[3,,3]
 609         JUMPGE  D,.+4
 610         PUSH    P,(D)
 611         ADDI    E,1
 612         AOBJN   D,.-2
 613         PUSH    P,E
 614         MOVSI   A,TOBLS
 615         JRST    ILOOKC
 616 LOOKCR:
 617         MOVEM   B,(TP)
 618         JUMPN   B,CHCKD
 619
 620 ;HERE IF THIS ATOM MUST BE PUT ON OBLIST
 621
 622 USEATM: MOVE    B,-2(TP)                ; GET ATOM
 623         HLRZ    E,(B)           ; SEE IF PURE OR NOT
 624         TRNN    E,400000        ; SKIP IF IMPURE
 625         JRST    PURATM
 626         PUSH    TP,$TATOM
 627         PUSH    TP,B
 628         PUSH    TP,$TOBLS
 629         PUSH    TP,-13(TP)
 630         MCALL   2,INSERT
 631
 632         PUSHJ   P,VALMAK        ;MAKE A GLOBAL VALUE FOR THIS LOSER
 633 PURAT2: MOVE    C,-6(TP)        ;RESET POINTERS
 634         MOVE    D,-4(TP)
 635         SUB     TP,[12,,12]
 636         MOVE    B,(C)           ;MOVE THE ENTRY
 637         HLLZM   B,(D)           ;DON'T WANT REF POINTER STORED
 638         MOVE    A,1(C)          ;AND MOVE ATOM
 639         MOVEM   A,1(D)
 640         MOVEI   A,1(D)
 641         ANDI    B,-1            ;CHECK FOR REAL REF
 642         JUMPE   B,SETLP1        ;DON'T SAVE THIS ATOM ON TVP
 643         HRRM    A,(B)           ;CLOBBER CODE
 644         MOVEI   A,0
 645         DPB     A,[220400,,(B)] ; CLOBBER TVP PORTION
 646         JRST    SETLP
 647
 648
 649 ; HERE TO MAKE A PURE ATOM
 650
 651 PURATM: HRRZ    B,-2(TP)        ; POINT TO IT
 652         HLRE    E,-2(TP)        ; - LNTH
 653         MOVNS   E
 654         ADDI    E,2
 655         PUSHJ   P,EBPUR         ; PURE COPY
 656         HRRM    B,-2(TP)        ; AND STORE BACK
 657         MOVE    B,-2(TP)
 658         JUMPE   0,PURAT0
 659         HRRZ    D,0
 660         HLRE    E,0
 661         SUBM    D,E
 662         HLRZ    0,2(D)
 663         JUMPE   0,PURAT8
 664         CAIG    0,HIBOT
 665         FATAL   INITM--PURE IMPURE LOSSAGE
 666         JRST    PURAT8
 667
 668 PURAT0: HRRZ    E,(C)
 669         MOVE    D,-2(TP)        ; GET ATOM BACK
 670         HRRZ    0,(D)           ; GET OBLIST CODE
 671         JUMPE   E,PURAT9
 672 PURAT7: HLRZ    D,1(E)
 673         MOVEI   D,-2(D)
 674         SUBM    E,D
 675         HLRZ    D,2(D)
 676         CAILE   D,HIBOT                 ; IF NEXT PURE & I AM ROOT
 677         JUMPE   0,PURAT8                ; TAKES ADVANTAGE OF SYSTEM=0
 678         JUMPE   D,PURAT8
 679         MOVE    E,D
 680         JRST    PURAT7
 681
 682 PURAT8: HLRZ    D,1(E)
 683         SUBI    D,2
 684         SUBM    E,D
 685         HLRE    C,B
 686         SUBM    B,C
 687         HLRZ    E,2(D)
 688         HRLM    E,2(B)
 689         HRLM    C,2(D)
 690         JRST    PURAT6
 691
 692 PURAT9: HLRE    A,-2(TP)
 693         SUBM    B,A
 694         HRRZM   A,(C)
 695
 696 PURAT6: MOVE    B,-10(TP)               ; GET BUCKET BACK
 697         MOVE    C,-2(TP)
 698         HRRZ    0,-9(TP)
 699         HRRM    0,2(C)          ; STORE OBLIST IN ATOM
 700 PURAT1: HRRZ    C,(B)           ; GET CONTENTS
 701         JUMPE   C,HICONS        ; AT END, OK
 702         CAIL    C,HIBOT         ; SKIP IF IMPURE
 703         JRST    HICONS  ; CONS IT ON
 704         MOVEI   B,(C)
 705         JRST    PURAT1
 706
 707 HICONS: HRLI    C,TATOM
 708         PUSH    P,C
 709         PUSH    P,-2(TP)
 710         PUSH    P,B
 711         MOVEI   B,-2(P)
 712         MOVEI   E,2
 713         PUSHJ   P,EBPUR         ; MAKE PURE LIST CELL
 714
 715         MOVE    C,(P)
 716         SUB     P,[3,,3]
 717         HRRM    B,(C)           ; STORE IT
 718         MOVE    B,1(B)          ; ATOM BACK
 719         MOVE    C,-6(TP)        ; GET TVP SLOT
 720         HRRM    B,1(C)          ; AND STORE
 721         HLRZ    0,(B)           ; TYPE OF VAL
 722         MOVE    C,B
 723         CAIN    0,TUNBOU        ; NOT UNBOUND?
 724         JRST    PURAT3          ; UNBOUND, NO VAL
 725         MOVEI   E,2             ; COUNT AGAIN
 726         PUSHJ   P,EBPUR         ; VALUE CELL
 727         MOVE    C,-2(TP)                ; ATOM BACK
 728         HLLZS   (B)             ; CLEAR LH
 729         MOVSI   0,TLOCI
 730         MOVEM   B,1(C)
 731         SKIPA
 732 PURAT3: MOVEI   0,0
 733         HRRZ    A,(C)           ; GET OBLIST CODE
 734         MOVE    A,OBTBL2(A)
 735         HRRM    A,2(C)          ; STORE OBLIST SLOT
 736         MOVEM   0,(C)
 737         JRST    PURAT2
 738 \f
 739 ; A POSSIBLE MATCH ARRIVES HERE
 740
 741 CHCKD:  MOVE    D,(TP)          ;THEY MATCH!,  GET EXISTING ATOM
 742         MOVEI   A,(D)           ;GET TYPE OF IT
 743         MOVE    B,-2(TP)        ;GET NEW ATOM
 744         HLRZ    0,(B)
 745         TRZ     A,377777        ; SAVE ONLY 400000 BIT
 746         TRZ     0,377777
 747         CAIN    0,(A)           ; SKIP IF WIN
 748         JRST    IM.PUR
 749         MOVSI   0,400000
 750         ANDCAM  0,(B)
 751         ANDCAM  0,(D)
 752         HLRZ    A,(D)
 753         JUMPN   A,A1VAL
 754         MOVE    A,(B)           ;MOVE VALUE
 755         MOVEM   A,(D)
 756         MOVE    A,1(B)
 757         MOVEM   A,1(D)
 758         MOVE    B,D             ;EXISTING ATOM TO B
 759         MOVEI   0,(B)
 760         CAIL    0,HIBOT
 761         JRST    .+3
 762         PUSHJ   P,VALMAK        ;MAKE A VALUE
 763         JRST    .+2
 764         PUSHJ   P,PVALM
 765
 766 ;NOW FIND ATOMS OCCURENCE IN XFER VECTOR
 767
 768 OFFIND: MOVE    D,-4(TP)        ;GET CURRENT POINTER INTO TP
 769         MOVE    C,[-TVLNT,,TVSTRT]      ;AND A COPY OF TVP
 770         MOVEI   A,0             ;INITIALIZE COUNTER
 771 ALOOP:  CAMN    B,1(C)          ;IS THIS IT?
 772         JRST    AFOUND
 773         ADD     C,[2,,2]        ;BUMP COUNTER
 774         CAMG    C,D
 775         AOJA    A,ALOOP         ;NO, KEEP LOOKING
 776
 777         MOVEI   B,[ASCIZ /LOSSAGE--ATOM DISAPPEARED
 778 /]
 779 TYPIT:  PUSHJ   P,MSGTYP
 780         .VALUE
 781
 782 AFOUND: LSH     A,1             ;FOUND ATOM, GET REAL OFFSET
 783         ADDI    A,1
 784         ADDI    A,TVSTRT
 785         MOVE    C,-6(TP)        ;GET TV POINTER TO NEW ATOM
 786         HRRZ    B,(C)           ;POINT TO REFERENCE
 787         SKIPE   B               ;ANY THERE?
 788         HRRM    A,(B)           ;YES, CLOBBER AWAY
 789         SUB     TP,[12,,12]
 790         MOVEI   A,0
 791         DPB     A,[220400,,(B)] ; KILL TVP POINTER
 792         JRST    SETLP1          ;AND GO ON
 793
 794 A1VAL:  HLRZ    C,(B)           ;GET VALUE'S TYPE
 795         MOVE    B,D             ;NOW PUT EXISTING ATOM IN B
 796         CAIN    C,TUNBOU        ;UNBOUND?
 797         JRST    OFFIND          ;YES, WINNER
 798
 799         MOVEI   B,[ASCIZ /LOSSAGE--ATOM TRIES TO HAVE 2 VALUES
 800 /]
 801         JRST    TYPIT
 802
 803
 804 IM.PUR: MOVEI   B,[ASCIZ /LOSSAG--ATOM TRIES TO BE BOTH PURE AND IMPURE
 805 /]
 806         JRST    TYPIT
 807
 808 PAGLOS: MOVEI   B,[ASCIZ /LOSSAGE--IMPURE CORE EXTENDS INTO HIGH SEGMENT
 809 /]
 810         JRST    TYPIT
 811
 812 HIFUL:  MOVEI   B,[ASCIZ /LOSSAGE--HI SEG FULL
 813 /]
 814         JRST    TYPIT
 815
 816 \f
 817 ;MAKE A VALUE IN SLOT ON GLOBAL SP
 818
 819 VALMAK: HLRZ    A,(B)           ;TYPE OF VALUE
 820         CAIE    A,400000+TUNBOU
 821         CAIN    A,TUNBOU        ;VALUE?
 822         JRST    VALMA1
 823         MOVE    A,GLOBSP+1      ;GET POINTER TO GLOBAL SP
 824         SUB     A,[4,,4]        ;ALLOCATE SPACE
 825         CAMG    A,GLOBAS+1      ;CHECK FOR OVERFLOW
 826         JRST    SPOVFL
 827         MOVEM   A,GLOBSP+1      ;STORE IT BACK
 828         MOVE    C,(B)           ;GET TYPE CELL
 829         TLZ     C,400000
 830         HLLZM   C,2(A)          ;INTO TYPE CELL
 831         MOVE    C,1(B)          ;GET VALUE
 832         MOVEM   C,3(A)          ;INTO VALUE SLOT
 833         MOVSI   C,TGATOM        ;GET TATOM,,0
 834         MOVEM   C,(A)
 835         MOVEM   B,1(A)          ;AND POINTER TO ATOM
 836         MOVSI   C,TLOCI         ;NOW CLOBBER THE ATOM
 837         MOVEM   C,(B)           ;INTO TYPE CELL
 838         ADD     A,[2,,2]        ;POINT TO VALUE
 839         MOVEM   A,1(B)
 840         POPJ    P,
 841
 842 VALMA1: SETZM   (B)
 843         POPJ    P,
 844
 845 SPOVFL: MOVEI   B,[ASCIZ /LOSSAGE--GLOBAL SP OVERFLOW
 846 /]
 847         JRST    TYPIT
 848
 849
 850 PVALM:  HLRZ    0,(B)
 851         CAIE    0,400000+TUNBOU
 852         CAIN    0,TUNBOU
 853         JRST    VALMA1
 854         MOVEI   E,2
 855         PUSH    P,B
 856         PUSHJ   P,EBPUR
 857         POP     P,C
 858         MOVEM   B,1(C)
 859         MOVSI   0,TLOCI
 860         MOVEM   0,(C)
 861         MOVE    B,C
 862         POPJ    P,
 863 \f;SET UP LIST OF INTERNAL NAMES AND ADDRESS NEEDED BY COMPILER
 864
 865 VECTGO DUMMY1
 866
 867 IRP     A,,[FINIS,SPECBIND,WNA,WRONGT,$TLOSE,CALER1,POPUNW
 868 ILOC,IGLOC,IDVAL,IDVAL1,ILVAL,IGVAL,INTFLG,LCKINT,ONINT,TYPLOO,TDEFER
 869 IFALSE,UNAS,UNBOU,RCALL,SEGMNT,SEGLST,NUMPRI,OPSYS,SSPEC1,COMPERR
 870 MAKACT,MAKENV,BFRAME,TTP,TTB,$TTP,$TTB,MAKTUP,TPALOC,IBIND,SSPECS
 871 CILVAL,CISET,CIGVAL,CSETG,IBLOK1,IBLOCK,CLLOC,CGLOC,CASSQ,CGASSQ
 872 CILNT,CILNQ,CILEGQ,CEMPTY,CIEQUA,CIREST,CINTH,CIAT,CSETLO,CIN
 873 CIPUT,CIGET,CIGETL,CIMON,CISTRU,CIMEMQ,CIMEMB,CITOP,CIBACK,TYPSEG
 874 C1CONS,CICONS,CIUVEC,CIVEC,IIFORM,IILIST,CISTNG,HITOP,INCR1,TYPG,VALG,TESTR
 875 OTBSAV,CITYPE,CFRAME,CARGS,CFUNCT,CUTYPE,CPTYPE,CTYPEP,CTYPEQ,CCHUTY
 876 CIREMA,RTFALS,CIPUTP,CIGETP,CIGTPR,MPOPJ,TAB,$TAB,ICONS,CSTO,DSTO,NTPALO
 877 CPLUS,CTIMES,CTIME,CDIVID,CMINUS,CLQ,CLEQ,CGQ,CGEQ,CLOG,CSIN,CCOS,CATAN,CSQRT
 878 CFIX,CFLOAT,CEXP,CRAND,CINEQU,SPECBND,PGGIVE,PGFIND,MTYO,CMIN,CMAX,RCL,R1C,W1C
 879 CALLTY,CTYPEC,CTYPEW,NOTTY,CHKAB,CTMPLT,IUNWIN,UNWIN2,NOSHUF,ROOT,ERROBL,INTOBL
 880 CINSER,CIRMV,CLOOKU,CATOM,CIPNAM,ISTRCM,CITERP,CIPRIN,CIPRN1,CIPRNC,CGFALS
 881 CPATM,CP1ATM,CPCATM,CPSTR,CP1STR,CPCSTR,CPCH,CREADC,CNXTCH,CREDC1,CNXTC1
 882 CGBOUN,IIGLOC,MAKTU2,CIFLTZ,CIUPRS,SAT,TFA,WTYP,NAPT,PTYPE,APLQ,PURBOT,GCSBOT
 883 GLOTOP,TYPVEC,1STEPR,LSTRES,NODES,MAINPR,CVTYPE,CSPNAM,CSBSTR,INTBCK,CICRLF
 884 CERR1,CERR2,CERR3,CANDP,CORP,CSQUTA,CIMAGE,ATOSQ,CFILLE,CPRTYC,FMPOPJ
 885 TD.PUT,TD.GET,TD.LNT,CBYTES,MARK,MARK2G,TD.AGC,DSTORE,RCLV,NUMSAT,RMCALL,NPRFLG
 886 NSPOPJ,NFPOPJ,PURCLN,FRETOP,PURVEC,SWAPGC,VECBOT]
 887         .GLOBAL A
 888         ADDSQU A
 889 TERMIN
 890 IFE ITS,[
 891 IRP     A,,[NTTYPE,CLRSTR]
 892         .GLOBAL A
 893         ADDSQU A
 894 TERMIN
 895 ]
 896
 897 VECRET
 898
 899 ; ROUTINE TO SORT AND PURIFY SQUOZE TABLE
 900
 901 SQSETU: MOVE    A,[SQUTBL-SQULOC+2,,SQUTBL]
 902         MOVEI   0,1
 903 SQ2:    MOVE    B,(A)
 904         CAMG    B,2(A)
 905         JRST    SQ1
 906         MOVEI   0,0
 907         EXCH    B,2(A)
 908         MOVEM   B,(A)
 909         MOVE    B,1(A)
 910         EXCH    B,3(A)
 911         MOVEM   B,1(A)
 912 SQ1:    ADD     A,[2,,2]
 913         JUMPL   A,SQ2
 914         JUMPE   0,SQSETU
 915 IFE ITS,[
 916 STSQU:  MOVE    B,[440700,,SQBLK]
 917         PUSHJ   P,MNGNAM
 918         HRROI   B,SQBLK
 919         MOVSI   A,600001
 920         GTJFN
 921         FATAL   CANT MAKE FIXUP FILE
 922         MOVEI   E,(A)
 923         MOVE    B,[440000,,100000]
 924         OPENF
 925         FATAL   CANT OPEN FIXUP FILE
 926         MOVE    B,[444400,,SQUTBL]
 927         MOVNI   C,SQULOC-SQUTBL
 928         SOUT
 929         MOVEI   A,(E)
 930         CLOSF
 931         JFCL
 932         MOVE    A,[SQUTBL-SQULOC,,SQUTBL]
 933         MOVEM   A,SQUPNT"
 934 ]
 935 IFN ITS,[
 936 .GLOBAL CSIXBT
 937 STSQU:  MOVE    C,MUDSTR+2              ; CALCULATE SECOND FILE NAME FOR SQUOZE TABLE
 938         PUSHJ   P,CSIXBT
 939         HRRI    C,(SIXBIT/TAB/) ; TABxxx IS SECOND NAME OF FILE
 940         MOVSS   C
 941         MOVEM   C,SQBLK+2               ; STORE IN APPROPRIATE BLOCKS
 942         MOVEM   C,SQWBLK+2
 943         .SUSET  [.SSNAM,,SQDIR]
 944         .OPEN   GCHN,SQWBLK     ; OPEN FILE
 945         FATAL CAN'T CREATE SQUOZE FILE
 946         MOVE    A,[SQUTBL-SQULOC,,SQUTBL]
 947         MOVEM   A,SQUPNT"
 948         .IOT    GCHN,A
 949         .CLOSE  GCHN            ; CLOSE THE CHANNEL
 950 ]
 951         POPJ    P,
 952
 953 RHITOP: 0
 954
 955 OBSZ:   151.
 956         13.
 957         151.
 958         151.
 959         317.
 960
 961 OBTBL2: ROOT+1
 962         ERROBL+1
 963         INTOBL+1
 964         MUDOBL+1
 965         INITIAL+1
 966
 967 OBTBL:  INITIAL+1-TVSTRT+TVBASE
 968         MUDOBL+1-TVSTRT+TVBASE
 969         INTOBL+1-TVSTRT+TVBASE
 970         ERROBL+1-TVSTRT+TVBASE
 971         ROOT+1-TVSTRT+TVBASE
 972 OBNAM:  MQUOTE INITIAL
 973         IMQUOTE MUDDLE
 974         MQUOTE INTERRUPTS
 975         MQUOTE ERRORS
 976         MQUOTE ROOT
 977
 978 OBTBL1: INITIAL+1
 979         MUDOBL+1
 980         INTOBL+1
 981         ERROBL+1
 982         ROOT+1
 983
 984
 985 IFN ITS,[
 986 SQWBLK: SIXBIT /  'DSK/
 987         SIXBIT /SQUOZE/
 988         SIXBIT /TABLE/
 989 ]
 990 IFE ITS,[
 991 MNGNAM: MOVE    A,[440700,,MUDSTR+2]            ; FOR NAME HACKING
 992         ILDB    0,A                     ; SEE IF IT IS A VERSION
 993         CAIN    0,177
 994          POPJ   P,
 995         MOVE    A,B
 996         ILDB    0,A
 997         CAIN    0,"X                    ; LOOK FOR X'S
 998          JRST   .+3
 999         MOVE    B,A
1000         JRST    .-4
1001
1002         MOVE    A,[440700,,MUDSTR+2]
1003         ILDB    0,A
1004         IDPB    0,B
1005         ILDB    0,A
1006         IDPB    0,B
1007         ILDB    0,A
1008         IDPB    0,B
1009         POPJ    P,
1010 ]
1011
1012 IFN ITS,[
1013 .GLOBAL VCREATE,MUDSTR
1014
1015 DEBUG:  MOVE    E,[440600,,[SIXBIT /EXPERIMENTAL/]]
1016         MOVEI   0,12.
1017         JRST    STUFF
1018
1019 VCREATE:        .SUSET  [.SSNAM,,[SIXBIT /MUDSYS/]]
1020         .OPEN   0,OP%
1021         .VALUE
1022         MOVEI   0,0     ; SET 0 TO DO THE .RCHST
1023         .RCHST  0
1024         .CLOSE  0
1025         .FDELE  DB%
1026         .VALUE
1027         MOVE    E,[440600,,B]
1028         MOVEI   0,6
1029 STUFF:  MOVE    D,[440700,,MUDSTR+2]
1030 STUFF1: ILDB    A,E             ; GET A CHAR
1031         CAIN    A,0             ;SUPRESS SPACES
1032         MOVEI   A,137           ;RUBOUT'S DON'T TYPE OUT
1033         ADDI    A,40            ; TO ASCII
1034         IDPB    A,D             ; STORE
1035         SOJN    0,STUFF1
1036         SETZM   34
1037         SETZM   35
1038         SETZM   36
1039         .VALUE
1040
1041 OP%:    1,,(SIXBIT /DSK/)
1042         SIXBIT /MUD%/
1043         SIXBIT />/
1044
1045 DB%:    (SIXBIT /DSK/)
1046         SIXBIT /MUD%/
1047         SIXBIT /</
1048         0
1049         0
1050 ]
1051
1052
1053 .GLOBAL GCDIR,ILDBLK,TILDBL,GCLDBK,LENGC,SLENGC,SGCLBK,RLENGC
1054 .GLOBAL SECBLK,SECLEN,RSLENG,DECBLK
1055
1056 ; ROUTINE TO DUMP OUT THE GARBAGE-COLLECTOR
1057
1058 DUMPGC:
1059 IFN ITS,[
1060         .SUSET  [.SSNAM,,GCDIR]                 ; SET SNAME
1061         MOVE    C,MUDSTR+2                      ; CREATE SECOND NAMES
1062         PUSHJ   P,CSIXBT
1063         HRRI    C,(SIXBIT /MUD/)
1064         MOVS    A,C                             ; MUDxx IS SECOND NAME
1065         MOVEM   A,GCLDBK+2
1066         MOVEM   A,SGCLBK+2
1067         MOVEM   A,ILDBLK+2
1068         MOVEM   A,GCDBLK+2                      ; SMASH IN SECOND NAMES
1069         MOVEM   A,SGCDBK+2
1070         MOVEM   A,INTDBK+2
1071         .OPEN   0,GCDBLK                        ; OPEN GC FILE
1072         FATAL   CANT CREATE AGC FILE
1073         MOVNI   A,LENGC                         ; CALCULATE IOT POINTER
1074         ASH     A,10.
1075         HRLZS   A
1076         HRRI    A,REALGC
1077         .IOT    0,A                             ; SEND IT OUT
1078         .CLOSE  0,                              ; CLOSE THE CHANNEL
1079         .OPEN   0,SGCDBK                        ; OPEN GC FILE
1080         FATAL   CANT CREATE AGC FILE
1081         MOVNI   A,SLENGC                        ; CALCULATE IOT POINTER
1082         ASH     A,10.
1083         HRLZS   A
1084         HRRI    A,REALGC+RLENGC
1085         .IOT    0,A                             ; SEND IT OUT
1086         .CLOSE  0,                              ; CLOSE THE CHANNEL
1087
1088
1089 ; ROUTINE TO DUMP THE INTERPRETER
1090
1091         .SUSET  [.SSNAM,,INTDIR]
1092         .OPEN   0,ILDBLK                        ; OPEN FILE TO INTERPRETER BLOCK
1093         FATAL   CANT FIXUP INTERPRETER
1094         HLRE    B,TP                            ; MAKE SURE BIG ENOUGJ
1095         MOVNS   B                               ; SEE IF WE WIN
1096         CAIGE   B,400                           ; SKIP IF WINNING
1097         FATAL   NO ROOM FOR PAGE MAP
1098         MOVSI   A,-400
1099         HRRI    A,1(TP)
1100         .ACCES  0,[1]
1101         .IOT    0,A                     ; GET IN PAGE MAP
1102         .CLOSE  0,
1103         .OPEN   0,INTDBK
1104         FATAL   CANT FIXUP INTERPRETER
1105         MOVEI   A,1                             ; INITIALIZE FILE PAGE COUNT
1106         MOVEI   B,0                             ; CORE PAGE COUNT
1107         MOVEI   E,1(TP)
1108 LOPFND: HRRZ    0,(E)
1109         JUMPE   0,NOPAG                         ; IF 0 FORGET IT
1110         ADDI    A,1                             ; AOS FILE MAP
1111 NOPAG:  ADDI    B,1                             ; AOS PAGE MAP
1112         CAIE    B,PAGEGC                                ; SKIP IF DONE
1113         AOJA    E,LOPFND
1114         ASH     A,10.                           ; TO WORDS
1115         .ACCES  0,A
1116         MOVNI   B,LENGC
1117         ASH     B,10.                           ; TO WORDS
1118         HRLZS   B                               ; SWAP
1119         HRRI    B,AGCLD
1120         .IOT    0,B
1121         .CLOSE  0,
1122         POPJ    P,                              ; DONE
1123
1124 GCDBLK: SIXBIT /  'DSK/
1125         SIXBIT /AGC/
1126         SIXBIT /MUD  /
1127
1128 SGCDBK: SIXBIT /  'DSK/
1129         SIXBIT /SGC/
1130         SIXBIT /MUD  /
1131
1132 INTDBK: 100007,,(SIXBIT /DSK/)
1133         SIXBIT /TS/
1134         SIXBIT /MUD/
1135
1136 ]
1137 IFE ITS,[
1138         MOVE    B,[440700,,GCLDBK]
1139         PUSHJ   P,MNGNAM                        ; VERSION TO NAME IF NECESSARY
1140         HRROI   B,GCLDBK
1141         MOVSI   A,600001
1142         GTJFN
1143          FATAL  CANT WRITE OUT GC
1144         MOVEI   E,(A)
1145         MOVE    B,[440000,,100000]
1146         OPENF
1147          FATAL  CANT OPEN GC FILE
1148         MOVNI   C,LENGC
1149         ASH     C,10.
1150         MOVE    B,[444400,,REALGC]
1151         MOVEI   A,(E)
1152         SOUT
1153         MOVEI   A,(E)
1154         CLOSF
1155          JFCL
1156         MOVEI   D,LENGC+LENGC
1157         MOVNI   A,1
1158         MOVEI   B,REALGC
1159         ASH     B,-9.
1160         HRLI    B,400000
1161
1162         PMAP
1163         ADDI    B,1
1164         SOJG    D,.-2
1165
1166         MOVE    B,[440700,,SGCLBK]
1167         PUSHJ   P,MNGNAM                        ; VERSION TO NAME IF NECESSARY
1168         HRROI   B,SGCLBK
1169         MOVSI   A,600001
1170         GTJFN
1171          FATAL  CANT WRITE OUT GC
1172         MOVEI   E,(A)
1173         MOVE    B,[440000,,100000]
1174         OPENF
1175          FATAL  CANT OPEN GC FILE
1176         MOVNI   C,SLENGC
1177         ASH     C,10.
1178         MOVE    B,[444400,,REALGC+RLENGC]
1179         MOVEI   A,(E)
1180         SOUT
1181         MOVEI   A,(E)
1182         CLOSF
1183          JFCL
1184         MOVEI   D,SLENGC+SLENGC
1185         MOVNI   A,1
1186         MOVEI   B,REALGC+RLENGC
1187         ASH     B,-9.
1188         HRLI    B,400000
1189
1190         PMAP
1191         ADDI    B,1
1192         SOJG    D,.-2
1193
1194         MOVE    B,[440700,,SECBLK]
1195         PUSHJ   P,MNGNAM                        ; VERSION TO NAME IF NECESSARY
1196         HRROI   B,SECBLK
1197         MOVSI   A,600001
1198         GTJFN
1199          FATAL  CANT WRITE OUT GC
1200         MOVEI   E,(A)
1201         MOVE    B,[440000,,100000]
1202         OPENF
1203          FATAL  CANT OPEN GC FILE
1204         MOVNI   C,SECLEN
1205         ASH     C,10.
1206         MOVE    B,[444400,,REALGC+RLENGC+RSLENG]
1207         MOVEI   A,(E)
1208         SOUT
1209         MOVEI   A,(E)
1210         CLOSF
1211          JFCL
1212
1213 ; NOW MUNG THE THING TO BE DIFFERENT TO USE UUOS FOR DEBUGGING VERSION
1214
1215 .GLOBAL %FXUPS,%FXEND
1216
1217         MOVEI   A,%FXUPS
1218
1219 %DBG1:  HLRZ    D,(A)
1220         HRRZ    A,(A)
1221         LDB     0,[331100,,(A)]         ; GET INS
1222         MOVEI   C,%TBL
1223         HRRZ    B,(C)
1224         CAME    B,0
1225          AOJA   C,.-2
1226         CAIN    B,<<(XBLT)>_<-9.>>
1227          HLLZS  (A)
1228         LDB     B,[331100,,(C)]
1229         DPB     B,[331100,,(A)]
1230         MOVE    A,D
1231         JUMPN   A,%DBG1
1232 %DBG2:
1233         MOVE    B,[440700,,DECBLK]
1234         PUSHJ   P,MNGNAM                        ; VERSION TO NAME IF NECESSARY
1235         HRROI   B,DECBLK
1236         MOVSI   A,600001
1237         GTJFN
1238          FATAL  CANT WRITE OUT GC
1239         MOVEI   E,(A)
1240         MOVE    B,[440000,,100000]
1241         OPENF
1242          FATAL  CANT OPEN GC FILE
1243         MOVNI   C,SECLEN
1244         ASH     C,10.
1245         MOVE    B,[444400,,REALGC+RLENGC+RSLENG]
1246         MOVEI   A,(E)
1247         SOUT
1248         MOVEI   A,(E)
1249         CLOSF
1250          JFCL
1251         MOVEI   D,SECLEN+SECLEN
1252         MOVNI   A,1
1253         MOVEI   B,REALGC+RLENGC
1254         ASH     B,-9.
1255         HRLI    B,400000
1256
1257         PMAP
1258         ADDI    B,1
1259         SOJG    D,.-2
1260
1261         MOVE    B,[440700,,ILDBLK]
1262         SKIPE   OPSYS
1263          MOVE   B,[440700,,TILDBL]
1264         PUSHJ   P,MNGNAM
1265         MOVSI   C,-1000
1266         MOVSI   A,400000
1267 RPA:    RPACS
1268         TLNE    B,10000
1269         TLNN    B,400                   ; SKIP IF NOT PRIVATE
1270         SKIPA
1271          MOVES  (C)
1272         ADDI    C,777
1273         ADDI    A,1
1274         AOBJN   C,RPA
1275
1276         MOVNI   A,1
1277         CLOSF
1278          FATAL  CANT CLOSE STUFF
1279         HRROI   B,ILDBLK
1280         MOVSI   A,100001
1281         GTJFN                                   ; GET A JFN
1282          FATAL  GARBAGE COLLECTOR IS MISSING
1283         HRRZS   E,A                             ; SAVE JFN
1284         MOVE    B,[440000,,300000]
1285         OPENF
1286          FATAL  CANT OPEN GC FILE
1287         MOVEI   A,(E)                           ; FIND OUT LENGTH OF MAP
1288         BIN                                     ; GET LENGTH WORD
1289         HLRZ    0,B
1290         CAIE    0,1776                          ; TOPS20 SSAVE FILE FORMAT
1291          CAIN   0,1000                          ; TENEX SSAVE FILE FORMAT
1292           JRST  .+2
1293         FATAL   NOT AN SSAVE FILE
1294          MOVEI  A,(B)                           ; ISOLATE SIZE OF MAP
1295         HLRE    B,TP                            ; MUST BE SPACE FOR CRUFT
1296         MOVNS   B
1297         CAIGE   B,(A)                           ; ROOM?
1298          FATAL  NO ROOM FOR PAGE MAP (GULP)
1299         MOVN    C,A
1300         MOVEI   A,(E)                           ; READY TO READ IN MAP
1301         MOVEI   B,1(TP)                         ; ONTO TP STACK
1302         HRLI    B,444400
1303         SIN                                     ; SNARF IT IN
1304
1305         MOVEI   A,1(TP)                         ; POINT TO MAP
1306         CAIE    0,1000
1307          JRST   RPA1                            ; GO TO THE TOPS20 CODE
1308         LDB     0,[221100,,(A)]                 ; GET FORK PAGE
1309         CAIE    0,PAGEGC+PAGEGC                 ; GOT IT?
1310          AOJA   A,.-2
1311         JRST    RPA2
1312
1313 RPA1:   ADDI    A,1                             ; POINT TO PROCESS PAGE NUMBER
1314         LDB     0,[331100,,(A)]                 ; REPEAT COUNT IN 0
1315         LDB     B,[3300,,(A)]                   ; FIRST PAGE NUMBER IN B
1316         ADD     0,B                             ; LARGEST PAGE NUMBER
1317         CAIL    0,PAGEGC+PAGEGC
1318          CAILE  B,PAGEGC+PAGEGC
1319           AOJA  A,RPA1                          ; NEXT PAIR OF WORDS PLEASE
1320         SUBI    A,1                             ; POINT TO FILE PAGE NUMBER
1321         SUBI    B,PAGEGC+PAGEGC
1322         MOVN    B,B
1323         ADDM    B,(A)                           ; SET UP THE PAGE
1324
1325 RPA2:   HRRZ    B,(A)                           ; GET PAGE
1326         MOVEI   A,(E)                           ; GET JFN
1327         ASH     B,9.
1328         SFPTR
1329          FATAL  ACCESS OF FILE FAILED
1330         MOVEI   A,(E)
1331         MOVE    B,[444400,,AGCLD]
1332         MOVNI   C,LENGC
1333         ASH     C,10.
1334         SOUT
1335         MOVEI   A,(E)
1336         CLOSF
1337          JFCL
1338         POPJ    P,
1339
1340 ; CODE TO DISTINGUISH BETWEEN TOPS20 AND TENEX AT SETUP TIME
1341
1342 TWENTY: HRROI   A,C                             ; RESULTS KEPT HERE
1343         HRLOI   B,600015
1344         MOVEI   C,0                             ; CLEAN C UP
1345         DEVST
1346          JFCL
1347         MOVEI   A,1                             ; TENEX HAS OPSYS = 1
1348         CAME    C,[ASCII/NUL/]                  ; TOPS20 GIVES "NUL"
1349          MOVEM  A,OPSYS                         ; TENEX  GIVES "NIL"
1350         POPJ    P,
1351 %TBL:   IRP A,,[HRRM,HRLM,MOVEM,SETZM,HLRZ,XBLT]
1352         S!A <<(A)>_<-9.>>
1353         TERMIN
1354
1355 GCLDBK: ASCIZ /MDLXXX.AGC/
1356 SGCLBK: ASCIZ /MDLXXX.SGC/
1357 SECBLK: ASCIZ /MDLXXX.SEC/
1358 ILDBLK: ASCIZ /MDLXXX.EXE/
1359 TILDBL: ASCIZ /MDLXXX.SAV/
1360 DECBLK: ASCIZ /MDLXXX.DEC/
1361 ]
1362
1363
1364
1365 END SETUP
1366 \f