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