<mdl.int>/initm.mid.371

   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 .LIFG <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,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,NTTYPE,CLRSTR]
 887         .GLOBAL A
 888         ADDSQU A
 889 TERMIN
 890
 891 VECRET
 892
 893 ; ROUTINE TO SORT AND PURIFY SQUOZE TABLE
 894
 895 SQSETU: MOVE    A,[SQUTBL-SQULOC+2,,SQUTBL]
 896         MOVEI   0,1
 897 SQ2:    MOVE    B,(A)
 898         CAMG    B,2(A)
 899         JRST    SQ1
 900         MOVEI   0,0
 901         EXCH    B,2(A)
 902         MOVEM   B,(A)
 903         MOVE    B,1(A)
 904         EXCH    B,3(A)
 905         MOVEM   B,1(A)
 906 SQ1:    ADD     A,[2,,2]
 907         JUMPL   A,SQ2
 908         JUMPE   0,SQSETU
 909 IFE ITS,[
 910 STSQU:  MOVE    B,[440700,,SQBLK]
 911         PUSHJ   P,MNGNAM
 912         HRROI   B,SQBLK
 913         MOVSI   A,600001
 914         GTJFN
 915         FATAL   CANT MAKE FIXUP FILE
 916         MOVEI   E,(A)
 917         MOVE    B,[440000,,100000]
 918         OPENF
 919         FATAL   CANT OPEN FIXUP FILE
 920         MOVE    B,[444400,,SQUTBL]
 921         MOVNI   C,SQULOC-SQUTBL
 922         SOUT
 923         MOVEI   A,(E)
 924         CLOSF
 925         JFCL
 926         MOVE    A,[SQUTBL-SQULOC,,SQUTBL]
 927         MOVEM   A,SQUPNT"
 928 ]
 929 IFN ITS,[
 930 .GLOBAL CSIXBT
 931 STSQU:  MOVE    C,MUDSTR+2              ; CALCULATE SECOND FILE NAME FOR SQUOZE TABLE
 932         PUSHJ   P,CSIXBT
 933         HRRI    C,(SIXBIT/TAB/) ; TABxxx IS SECOND NAME OF FILE
 934         MOVSS   C
 935         MOVEM   C,SQBLK+2               ; STORE IN APPROPRIATE BLOCKS
 936         MOVEM   C,SQWBLK+2
 937         .SUSET  [.SSNAM,,SQDIR]
 938         .OPEN   GCHN,SQWBLK     ; OPEN FILE
 939         FATAL CAN'T CREATE SQUOZE FILE
 940         MOVE    A,[SQUTBL-SQULOC,,SQUTBL]
 941         MOVEM   A,SQUPNT"
 942         .IOT    GCHN,A
 943         .CLOSE  GCHN            ; CLOSE THE CHANNEL
 944 ]
 945         POPJ    P,
 946
 947 RHITOP: 0
 948
 949 OBSZ:   151.
 950         13.
 951         151.
 952         151.
 953         317.
 954
 955 OBTBL2: ROOT+1
 956         ERROBL+1
 957         INTOBL+1
 958         MUDOBL+1
 959         INITIAL+1
 960
 961 OBTBL:  INITIAL+1-TVSTRT+TVBASE
 962         MUDOBL+1-TVSTRT+TVBASE
 963         INTOBL+1-TVSTRT+TVBASE
 964         ERROBL+1-TVSTRT+TVBASE
 965         ROOT+1-TVSTRT+TVBASE
 966 OBNAM:  MQUOTE INITIAL
 967         IMQUOTE MUDDLE
 968         MQUOTE INTERRUPTS
 969         MQUOTE ERRORS
 970         MQUOTE ROOT
 971
 972 OBTBL1: INITIAL+1
 973         MUDOBL+1
 974         INTOBL+1
 975         ERROBL+1
 976         ROOT+1
 977
 978
 979 IFN ITS,[
 980 SQWBLK: SIXBIT /  'DSK/
 981         SIXBIT /SQUOZE/
 982         SIXBIT /TABLE/
 983 ]
 984 IFE ITS,[
 985 MNGNAM: MOVE    A,[440700,,MUDSTR+2]            ; FOR NAME HACKING
 986         ILDB    0,A                     ; SEE IF IT IS A VERSION
 987         CAIN    0,177
 988          POPJ   P,
 989         MOVE    A,B
 990         ILDB    0,A
 991         CAIN    0,"X                    ; LOOK FOR X'S
 992          JRST   .+3
 993         MOVE    B,A
 994         JRST    .-4
 995
 996         MOVE    A,[440700,,MUDSTR+2]
 997         ILDB    0,A
 998         IDPB    0,B
 999         ILDB    0,A
1000         IDPB    0,B
1001         ILDB    0,A
1002         IDPB    0,B
1003         POPJ    P,
1004 ]
1005
1006 IFN ITS,[
1007 .GLOBAL VCREATE,MUDSTR
1008
1009 DEBUG:  MOVE    E,[440600,,[SIXBIT /EXPERIMENTAL/]]
1010         MOVEI   0,12.
1011         JRST    STUFF
1012
1013 VCREATE:        .SUSET  [.SSNAM,,[SIXBIT /MUDSYS/]]
1014         .OPEN   0,OP%
1015         .VALUE
1016         MOVEI   0,0     ; SET 0 TO DO THE .RCHST
1017         .RCHST  0
1018         .CLOSE  0
1019         .FDELE  DB%
1020         .VALUE
1021         MOVE    E,[440600,,B]
1022         MOVEI   0,6
1023 STUFF:  MOVE    D,[440700,,MUDSTR+2]
1024 STUFF1: ILDB    A,E             ; GET A CHAR
1025         CAIN    A,0             ;SUPRESS SPACES
1026         MOVEI   A,137           ;RUBOUT'S DON'T TYPE OUT
1027         ADDI    A,40            ; TO ASCII
1028         IDPB    A,D             ; STORE
1029         SOJN    0,STUFF1
1030         SETZM   34
1031         SETZM   35
1032         SETZM   36
1033         .VALUE
1034
1035 OP%:    1,,(SIXBIT /DSK/)
1036         SIXBIT /MUD%/
1037         SIXBIT />/
1038
1039 DB%:    (SIXBIT /DSK/)
1040         SIXBIT /MUD%/
1041         SIXBIT /</
1042         0
1043         0
1044 ]
1045
1046
1047 .GLOBAL GCDIR,ILDBLK,TILDBL,GCLDBK,LENGC,SLENGC,SGCLBK,RLENGC
1048 .GLOBAL SECBLK,SECLEN,RSLENG,DECBLK
1049
1050 ; ROUTINE TO DUMP OUT THE GARBAGE-COLLECTOR
1051
1052 DUMPGC:
1053 IFN ITS,[
1054         .SUSET  [.SSNAM,,GCDIR]                 ; SET SNAME
1055         MOVE    C,MUDSTR+2                      ; CREATE SECOND NAMES
1056         PUSHJ   P,CSIXBT
1057         HRRI    C,(SIXBIT /MUD/)
1058         MOVS    A,C                             ; MUDxx IS SECOND NAME
1059         MOVEM   A,GCLDBK+2
1060         MOVEM   A,SGCLBK+2
1061         MOVEM   A,ILDBLK+2
1062         MOVEM   A,GCDBLK+2                      ; SMASH IN SECOND NAMES
1063         MOVEM   A,SGCDBK+2
1064         MOVEM   A,INTDBK+2
1065         .OPEN   0,GCDBLK                        ; OPEN GC FILE
1066         FATAL   CANT CREATE AGC FILE
1067         MOVNI   A,LENGC                         ; CALCULATE IOT POINTER
1068         ASH     A,10.
1069         HRLZS   A
1070         HRRI    A,REALGC
1071         .IOT    0,A                             ; SEND IT OUT
1072         .CLOSE  0,                              ; CLOSE THE CHANNEL
1073         .OPEN   0,SGCDBK                        ; OPEN GC FILE
1074         FATAL   CANT CREATE AGC FILE
1075         MOVNI   A,SLENGC                        ; CALCULATE IOT POINTER
1076         ASH     A,10.
1077         HRLZS   A
1078         HRRI    A,REALGC+RLENGC
1079         .IOT    0,A                             ; SEND IT OUT
1080         .CLOSE  0,                              ; CLOSE THE CHANNEL
1081
1082
1083 ; ROUTINE TO DUMP THE INTERPRETER
1084
1085         .SUSET  [.SSNAM,,INTDIR]
1086         .OPEN   0,ILDBLK                        ; OPEN FILE TO INTERPRETER BLOCK
1087         FATAL   CANT FIXUP INTERPRETER
1088         HLRE    B,TP                            ; MAKE SURE BIG ENOUGJ
1089         MOVNS   B                               ; SEE IF WE WIN
1090         CAIGE   B,400                           ; SKIP IF WINNING
1091         FATAL   NO ROOM FOR PAGE MAP
1092         MOVSI   A,-400
1093         HRRI    A,1(TP)
1094         .ACCES  0,[1]
1095         .IOT    0,A                     ; GET IN PAGE MAP
1096         .CLOSE  0,
1097         .OPEN   0,INTDBK
1098         FATAL   CANT FIXUP INTERPRETER
1099         MOVEI   A,1                             ; INITIALIZE FILE PAGE COUNT
1100         MOVEI   B,0                             ; CORE PAGE COUNT
1101         MOVEI   E,1(TP)
1102 LOPFND: HRRZ    0,(E)
1103         JUMPE   0,NOPAG                         ; IF 0 FORGET IT
1104         ADDI    A,1                             ; AOS FILE MAP
1105 NOPAG:  ADDI    B,1                             ; AOS PAGE MAP
1106         CAIE    B,PAGEGC                                ; SKIP IF DONE
1107         AOJA    E,LOPFND
1108         ASH     A,10.                           ; TO WORDS
1109         .ACCES  0,A
1110         MOVNI   B,LENGC
1111         ASH     B,10.                           ; TO WORDS
1112         HRLZS   B                               ; SWAP
1113         HRRI    B,AGCLD
1114         .IOT    0,B
1115         .CLOSE  0,
1116         POPJ    P,                              ; DONE
1117
1118 GCDBLK: SIXBIT /  'DSK/
1119         SIXBIT /AGC/
1120         SIXBIT /MUD  /
1121
1122 SGCDBK: SIXBIT /  'DSK/
1123         SIXBIT /SGC/
1124         SIXBIT /MUD  /
1125
1126 INTDBK: 100007,,(SIXBIT /DSK/)
1127         SIXBIT /TS/
1128         SIXBIT /MUD/
1129
1130 ]
1131 IFE ITS,[
1132         MOVE    B,[440700,,GCLDBK]
1133         PUSHJ   P,MNGNAM                        ; VERSION TO NAME IF NECESSARY
1134         HRROI   B,GCLDBK
1135         MOVSI   A,600001
1136         GTJFN
1137          FATAL  CANT WRITE OUT GC
1138         MOVEI   E,(A)
1139         MOVE    B,[440000,,100000]
1140         OPENF
1141          FATAL  CANT OPEN GC FILE
1142         MOVNI   C,LENGC
1143         ASH     C,10.
1144         MOVE    B,[444400,,REALGC]
1145         MOVEI   A,(E)
1146         SOUT
1147         MOVEI   A,(E)
1148         CLOSF
1149          JFCL
1150         MOVEI   D,LENGC+LENGC
1151         MOVNI   A,1
1152         MOVEI   B,REALGC
1153         ASH     B,-9.
1154         HRLI    B,400000
1155
1156         PMAP
1157         ADDI    B,1
1158         SOJG    D,.-2
1159
1160         MOVE    B,[440700,,SGCLBK]
1161         PUSHJ   P,MNGNAM                        ; VERSION TO NAME IF NECESSARY
1162         HRROI   B,SGCLBK
1163         MOVSI   A,600001
1164         GTJFN
1165          FATAL  CANT WRITE OUT GC
1166         MOVEI   E,(A)
1167         MOVE    B,[440000,,100000]
1168         OPENF
1169          FATAL  CANT OPEN GC FILE
1170         MOVNI   C,SLENGC
1171         ASH     C,10.
1172         MOVE    B,[444400,,REALGC+RLENGC]
1173         MOVEI   A,(E)
1174         SOUT
1175         MOVEI   A,(E)
1176         CLOSF
1177          JFCL
1178         MOVEI   D,SLENGC+SLENGC
1179         MOVNI   A,1
1180         MOVEI   B,REALGC+RLENGC
1181         ASH     B,-9.
1182         HRLI    B,400000
1183
1184         PMAP
1185         ADDI    B,1
1186         SOJG    D,.-2
1187
1188         MOVE    B,[440700,,SECBLK]
1189         PUSHJ   P,MNGNAM                        ; VERSION TO NAME IF NECESSARY
1190         HRROI   B,SECBLK
1191         MOVSI   A,600001
1192         GTJFN
1193          FATAL  CANT WRITE OUT GC
1194         MOVEI   E,(A)
1195         MOVE    B,[440000,,100000]
1196         OPENF
1197          FATAL  CANT OPEN GC FILE
1198         MOVNI   C,SECLEN
1199         ASH     C,10.
1200         MOVE    B,[444400,,REALGC+RLENGC+RSLENG]
1201         MOVEI   A,(E)
1202         SOUT
1203         MOVEI   A,(E)
1204         CLOSF
1205          JFCL
1206
1207 ; NOW MUNG THE THING TO BE DIFFERENT TO USE UUOS FOR DEBUGGING VERSION
1208
1209 .GLOBAL %FXUPS,%FXEND
1210
1211         MOVEI   A,%FXUPS
1212
1213 %DBG1:  HLRZ    D,(A)
1214         HRRZ    A,(A)
1215         LDB     0,[331100,,(A)]         ; GET INS
1216         MOVEI   C,%TBL
1217         HRRZ    B,(C)
1218         CAME    B,0
1219          AOJA   C,.-2
1220         CAIN    B,<<(XBLT)>_<-9.>>
1221          HLLZS  (A)
1222         LDB     B,[331100,,(C)]
1223         DPB     B,[331100,,(A)]
1224         MOVE    A,D
1225         JUMPN   A,%DBG1
1226 %DBG2:
1227         MOVE    B,[440700,,DECBLK]
1228         PUSHJ   P,MNGNAM                        ; VERSION TO NAME IF NECESSARY
1229         HRROI   B,DECBLK
1230         MOVSI   A,600001
1231         GTJFN
1232          FATAL  CANT WRITE OUT GC
1233         MOVEI   E,(A)
1234         MOVE    B,[440000,,100000]
1235         OPENF
1236          FATAL  CANT OPEN GC FILE
1237         MOVNI   C,SECLEN
1238         ASH     C,10.
1239         MOVE    B,[444400,,REALGC+RLENGC+RSLENG]
1240         MOVEI   A,(E)
1241         SOUT
1242         MOVEI   A,(E)
1243         CLOSF
1244          JFCL
1245         MOVEI   D,SECLEN+SECLEN
1246         MOVNI   A,1
1247         MOVEI   B,REALGC+RLENGC
1248         ASH     B,-9.
1249         HRLI    B,400000
1250
1251         PMAP
1252         ADDI    B,1
1253         SOJG    D,.-2
1254
1255         MOVE    B,[440700,,ILDBLK]
1256         SKIPE   OPSYS
1257          MOVE   B,[440700,,TILDBL]
1258         PUSHJ   P,MNGNAM
1259         MOVSI   C,-1000
1260         MOVSI   A,400000
1261 RPA:    RPACS
1262         TLNE    B,10000
1263         TLNN    B,400                   ; SKIP IF NOT PRIVATE
1264         SKIPA
1265          MOVES  (C)
1266         ADDI    C,777
1267         ADDI    A,1
1268         AOBJN   C,RPA
1269
1270         MOVNI   A,1
1271         CLOSF
1272          FATAL  CANT CLOSE STUFF
1273         HRROI   B,ILDBLK
1274         MOVSI   A,100001
1275         GTJFN                                   ; GET A JFN
1276          FATAL  GARBAGE COLLECTOR IS MISSING
1277         HRRZS   E,A                             ; SAVE JFN
1278         MOVE    B,[440000,,300000]
1279         OPENF
1280          FATAL  CANT OPEN GC FILE
1281         MOVEI   A,(E)                           ; FIND OUT LENGTH OF MAP
1282         BIN                                     ; GET LENGTH WORD
1283         HLRZ    0,B
1284         CAIE    0,1776                          ; TOPS20 SSAVE FILE FORMAT
1285          CAIN   0,1000                          ; TENEX SSAVE FILE FORMAT
1286           JRST  .+2
1287         FATAL   NOT AN SSAVE FILE
1288          MOVEI  A,(B)                           ; ISOLATE SIZE OF MAP
1289         HLRE    B,TP                            ; MUST BE SPACE FOR CRUFT
1290         MOVNS   B
1291         CAIGE   B,(A)                           ; ROOM?
1292          FATAL  NO ROOM FOR PAGE MAP (GULP)
1293         MOVN    C,A
1294         MOVEI   A,(E)                           ; READY TO READ IN MAP
1295         MOVEI   B,1(TP)                         ; ONTO TP STACK
1296         HRLI    B,444400
1297         SIN                                     ; SNARF IT IN
1298
1299         MOVEI   A,1(TP)                         ; POINT TO MAP
1300         CAIE    0,1000
1301          JRST   RPA1                            ; GO TO THE TOPS20 CODE
1302         LDB     0,[221100,,(A)]                 ; GET FORK PAGE
1303         CAIE    0,PAGEGC+PAGEGC                 ; GOT IT?
1304          AOJA   A,.-2
1305         JRST    RPA2
1306
1307 RPA1:   ADDI    A,1                             ; POINT TO PROCESS PAGE NUMBER
1308         LDB     0,[331100,,(A)]                 ; REPEAT COUNT IN 0
1309         LDB     B,[3300,,(A)]                   ; FIRST PAGE NUMBER IN B
1310         ADD     0,B                             ; LARGEST PAGE NUMBER
1311         CAIL    0,PAGEGC+PAGEGC
1312          CAILE  B,PAGEGC+PAGEGC
1313           AOJA  A,RPA1                          ; NEXT PAIR OF WORDS PLEASE
1314         SUBI    A,1                             ; POINT TO FILE PAGE NUMBER
1315         SUBI    B,PAGEGC+PAGEGC
1316         MOVN    B,B
1317         ADDM    B,(A)                           ; SET UP THE PAGE
1318
1319 RPA2:   HRRZ    B,(A)                           ; GET PAGE
1320         MOVEI   A,(E)                           ; GET JFN
1321         ASH     B,9.
1322         SFPTR
1323          FATAL  ACCESS OF FILE FAILED
1324         MOVEI   A,(E)
1325         MOVE    B,[444400,,AGCLD]
1326         MOVNI   C,LENGC
1327         ASH     C,10.
1328         SOUT
1329         MOVEI   A,(E)
1330         CLOSF
1331          JFCL
1332         POPJ    P,
1333
1334 ; CODE TO DISTINGUISH BETWEEN TOPS20 AND TENEX AT SETUP TIME
1335
1336 TWENTY: HRROI   A,C                             ; RESULTS KEPT HERE
1337         HRLOI   B,600015
1338         MOVEI   C,0                             ; CLEAN C UP
1339         DEVST
1340          JFCL
1341         MOVEI   A,1                             ; TENEX HAS OPSYS = 1
1342         CAME    C,[ASCII/NUL/]                  ; TOPS20 GIVES "NUL"
1343          MOVEM  A,OPSYS                         ; TENEX  GIVES "NIL"
1344         POPJ    P,
1345 %TBL:   IRP A,,[HRRM,HRLM,MOVEM,SETZM,HLRZ,XBLT]
1346         S!A <<(A)>_<-9.>>
1347         TERMIN
1348
1349 GCLDBK: ASCIZ /MDLXXX.AGC/
1350 SGCLBK: ASCIZ /MDLXXX.SGC/
1351 SECBLK: ASCIZ /MDLXXX.SEC/
1352 ILDBLK: ASCIZ /MDLXXX.EXE/
1353 TILDBL: ASCIZ /MDLXXX.SAV/
1354 DECBLK: ASCIZ /MDLXXX.DEC/
1355 ]
1356
1357
1358
1359 END SETUP
1360 \f