<mdl.int>/save.mid.169

   1 TITLE SAVE AND RESTORE STATE OF A MUDDLE
   2
   3 RELOCATABLE
   4
   5 .INSRT DSK:MUDDLE >
   6
   7 SYSQ
   8
   9 UNTAST==0
  10 IFE ITS,[
  11 IF1,[
  12 .INSRT STENEX >
  13 EXPUNGE SAVE
  14 ]
  15 ]
  16 .GLOBAL MOPEN,MIOT,MCLOSE,MUDSTR,SWAP,STRTO6,GCPDL,RGPRS,ADDNUL,GCSTOP,PHIBOT
  17 .GLOBAL CHNL0,CHNL1,REOPN,AGC,SWAPIN,MASK1,MASK2,IPCBLS,DEMFLG,FSTART,CKVRS
  18 .GLOBAL P.CORE,P.TOP,SGSNAM,%RUNAM,%RSNAM,%RJNAM,INTINT,CLOSAL,TTYOPE,PURBOT,CHKPGI
  19 .GLOBAL NOTTY,PURCLN,6TOCHS,DISXTR,IDVAL1,N.CHNS,PMAPB,PURTOP,HITOP,FRETOP,FREMIN
  20 .GLOBAL SQKIL,SFRK,GETJS,IJFNS,IJFNS1,MULTSG,MULTI,NOMULT
  21
  22 FME==1000,,-1
  23 FLS==1000,,
  24 MFORK==400000
  25
  26 MFUNCTION FSAVE,SUBR
  27
  28         ENTRY
  29
  30         JRST    SAVE1
  31
  32 MFUNCTION SAVE,SUBR
  33
  34         ENTRY
  35 SAVE1:  PUSHJ   P,SQKIL
  36 IFE ITS,[
  37         SKIPE   MULTSG
  38          PUSHJ  P,NOMULT
  39 ]
  40         PUSH    P,.
  41         PUSH    P,[0]           ; GC OR NOT?
  42 IFE ITS,[
  43         MOVE    B,[400600,,]
  44         MOVE    C,[440000,,100000]
  45 ]
  46         PUSHJ   P,GTFNM         ; GET THE FILE NAME ONTO P
  47          JRST   .+2
  48         JRST    SAVEON
  49         JUMPGE  AB,TMA          ; TOO MUCH STRING
  50         GETYP   0,(AB)          ; WHAT IS ARG
  51         CAMGE   AB,[-3,,0]      ; NOT TOO MANY
  52         JRST    TMA
  53         CAIN    0,TFALSE
  54 IFN ITS,        SETOM   -6(P)           ; GC FLAG
  55 IFE ITS,        SETOM   (P)
  56 SAVEON:
  57 IFN ITS,[
  58         MOVSI   A,7             ; IMAGE BLOCK OUT
  59         MOVEM   A,-4(P)         ; DIRECTION
  60         PUSH    P,A
  61         PUSH    P,-4(P)         ; DEVICE
  62         PUSH    P,[SIXBIT /_MUDS_/]
  63         PUSH    P,[SIXBIT />/]
  64         PUSH    P,-4(P)         ; SNAME
  65         MOVEI   A,-4(P)         ; POINT TO BLOCK
  66         PUSHJ   P,MOPEN         ; ATTEMPT TO OPEN
  67         JRST    CANTOP
  68         SUB     P,[5,,5]        ; FLUSH OPEN BLOCK
  69         PUSH    P,-6(P)         ; GC FLAG TO TOP OF STACK (-4 --> -6 TAA)
  70 ]
  71         EXCH    A,(P)           ; CHAN TO STACK GC TO A
  72         JUMPL   A,NOGC
  73         PUSH    TP,$TFIX                ; CAUSE HAIRY GC TO OCCUR
  74         PUSH    TP,[0]
  75         PUSH    TP,$TATOM
  76         PUSH    TP,IMQUOTE T
  77         MCALL   2,GC
  78 NOGC:   PUSHJ   P,PURCLN
  79
  80 ; NOW GET VERSION OF MUDDLE FOR COMPARISON
  81
  82         MOVE    A,MUDSTR+2      ; GET #
  83         MOVEI   B,177           ; CHANGE ALL RUBOUT CHARACTERS
  84         MOVEI   C,40            ; ----- TO SPACES
  85         PUSHJ   P,HACKV
  86
  87         PUSHJ   P,WRDOUT
  88         MOVE    A,P.TOP         ; GET TOP OF CORD
  89         PUSHJ   P,WRDOUT
  90         MOVEI   A,0             ; WRITE ZERO IF FAST
  91 IFN ITS,        SKIPE   -8(P)   ; -6 --> -8 TAA
  92 IFE ITS,        SKIPE   -1(P)
  93         PUSHJ   P,WRDOUT
  94         MOVE    A,VECTOP        ; CORE REQUIREMENTS FOR THIS SAVED MUDDLE
  95         PUSHJ   P,WRDOUT
  96
  97 IFN ITS,[
  98         SETZB   A,B             ; FIRST, ALL INTS OFF
  99         .SETM2  A,
 100
 101 ; IF FAST SAVE JUMP OFF HERE
 102
 103         SKIPE   -6(P)
 104         JRST    FSAVE1
 105
 106 ]
 107
 108 IFE ITS,[
 109         MOVEI   A,400000        ; FOR THIS PROCESS
 110         DIR                     ; TURN OFF INT SYSTEM
 111
 112 ; IF FAST, LEAVE HERE
 113
 114         SKIPE   -1(P)
 115         JRST    FSAVE1
 116
 117 ; NOW DUMP OUT GC SPACE
 118
 119 ]
 120 IFN ITS,[
 121
 122 DMPDN2: SETZB   A,B             ; SET UP RENAME WHILE OPEN ETC.
 123         MOVE    E,-1(P)
 124         MOVE    D,-2(P)
 125         LDB     C,[270400,,0]   ; GET CHANNEL
 126         .FDELE  A               ; RENAME IT
 127         FATAL SAVE RENAME FAILED
 128         XOR     0,[<.IOT A>#<.CLOSE>]   ; CHANGE TO A CLOSE
 129         XCT     0
 130
 131         MOVE    A,MASK1         ; TURN INTS BACK ON
 132         MOVE    B,MASK2
 133         .SETM2  A,
 134 ]
 135
 136 IFE ITS,[
 137
 138 DMPDN2: MOVE    A,0
 139         CLOSF
 140         FATAL CANT CLOSE SAVE FILE
 141         CIS                     ; CLEAR IT SYSTEM
 142         MOVEI   A,400000
 143         EIR                     ; AND RE-ENABLE
 144 ]
 145
 146 SDONE:  MOVE    A,$TCHSTR
 147         MOVE    B,CHQUOTE SAVED
 148         JRST    FINIS
 149
 150 ; SCAN FOR MANY OCCURENCES OF THE SAME THING
 151
 152
 153 ; HERE TO WRITE OUT FAST SAVE FILE
 154
 155 FSAVE1:
 156 IFN UNTAST,[
 157         PUSHJ   P,PUCHK
 158 ]
 159         MOVE    A,PARTOP        ; DONT WRITE OUT "HOLE"
 160         ADDI    A,1777
 161         ANDCMI  A,1777
 162         MOVEI   E,(A)
 163         PUSHJ   P,WRDOUT
 164         MOVE    0,(P)           ; CHANNEL TO 0
 165 IFN ITS,[
 166         ASH     0,23.           ; TO AC FIELS
 167         IOR     0,[.IOT A]
 168         MOVEI   A,5             ; START AT WORD 5
 169 ]
 170 IFE ITS,[
 171         MOVE    A,[-<P-E>,,E]
 172         PUSH    P,(A)
 173         AOBJN   A,.-1
 174         MOVE    A,0
 175         MOVE    B,P             ; WRITE OUT P FOR WIINAGE
 176         BOUT
 177         MOVE    B,[444400,,20]
 178         MOVNI   C,20-6
 179         SOUT                    ; MAKE PAGE BOUNDARIES WIN
 180         MOVEI   A,20            ; START AT 20
 181 ]
 182         MOVEI   B,(E)           ; PARTOP TO B
 183         PUSHJ   P,FOUT          ; WRITE OUT UP TO PAIR TOP
 184         PUSHJ   P,PUROUT
 185         SUB     P,[1,,1]        ; CLEAN OFF STACK
 186         JRST    DMPDN2
 187
 188 IFN ITS,[
 189 FOUT:   MOVEI   D,(A)           ; SAVE START
 190         SUB     A,B             ; COMPUTE LH OF IOT PNTR
 191         MOVSI   A,(A)
 192         SKIPL   A               ; IF + MEANS GROSS CORE SIZE
 193         MOVSI   A,400000        ; USE BIGGEST
 194         HRRI    A,(D)
 195         XCT     0               ; ZAP, OUT IT GOES
 196         CAMGE   A,B             ; SKIP IF ALL WENT
 197         JRST    FOUT            ; DO THE REST
 198         POPJ    P,              ; GO CLOSE FILE
 199 ]
 200 IFE ITS,[
 201 FOUT:   MOVEI   C,(A)
 202         SUBI    C,(B)           ; # OF BYTES TP C
 203         MOVEI   B,(A)           ; START TO B
 204         HRLI    B,444400
 205         MOVE    A,0
 206         SOUT                    ; WRITE IT OUT
 207         POPJ    P,
 208 ]
 209
 210
 211 ; HERE TO ATTEMPT TO RESTORE A SAVED STATE
 212
 213 MFUNCTION RESTORE,SUBR
 214
 215         ENTRY
 216         PUSHJ   P,SQKIL
 217 IFE ITS,[
 218         MOVE    B,[100600,,]
 219         MOVE    C,[440000,,240000]
 220 ]
 221         PUSHJ   P,GTFNM
 222         JRST    TMA
 223 IFN ITS,[
 224         MOVSI   A,6             ; READ/IMAGE/BLOCK
 225         MOVEM   A,-4(P)
 226         MOVEI   A,-4(P)
 227         PUSHJ   P,MOPEN         ; OPEN THE LOSER
 228         JRST    FNF
 229         SUB     P,[6,,6]        ; REMOVE OPEN BLOCK
 230
 231         PUSH    P,A             ; SAVE CHANNEL
 232         PUSHJ   P,SGSNAM        ; SAVE SNAME IN SYSTEM
 233 ]
 234 IFE ITS,        PUSH    P,A             ; SAVE JFN
 235         PUSHJ   P,CKVRS         ; CHECK THE VERSION NUMBER
 236
 237 IFN ITS,        MCALL   0,IPCOFF        ; CLOSE ALL IPC CHANS
 238         PUSHJ   P,CLOSAL        ; CLOSE CHANNELS
 239 IFN ITS,[
 240         SETZB   A,B             ; KILL ALL POSSIBLE INTERRUPTION
 241         .SETM2  A,
 242         DOTCAL  UNLOCK,[[1000,,-1]]
 243          .VALUE                 ; UNLOCK LOCKS
 244 ]
 245 IFE ITS,[
 246         MOVEI   A,400000        ; DISABLE INTS
 247         DIR                     ; INTS OFF
 248
 249         HLRZ    A,IJFNS         ; CLOSE AGC
 250         CLOSF
 251          JFCL
 252         HRRZ    A,IJFNS         ; CLOSE INTERPRETER
 253         CLOSF
 254          JFCL
 255         HLRZ    A,IJFNS1        ; CLOSE SGC
 256         CLOSF
 257          JFCL
 258
 259         HRRZ    A,IJFNS1
 260         CLOSF
 261          JFCL
 262
 263         SETZM   IJFNS
 264         SETZM   IJFNS1
 265 ]
 266         PUSHJ   P,PURCLN        ; DONT KEEP PURE SHAREDNESS
 267
 268         POP     P,E
 269 IFE ITS,[
 270         SKIPLE  A,SFRK          ; IF WE HAVE AN INFERIOR, KILL IT
 271          KFORK
 272 ]
 273         MOVE    A,E
 274 FSTART: MOVE    P,GCPDL
 275         PUSH    P,A
 276 IFN ITS,[
 277         MOVE    0,[1-PHIBOT,,1]
 278         DOTCAL  CORBLK,[[FLS],[FME],0]
 279         FATAL CANT FLUSH PURE PAGES
 280 ]
 281         PUSHJ   P,WRDIN         ; GET P.TOP
 282         ASH     A,-10.
 283         MOVE    E,A
 284         PUSHJ   P,WRDIN         ; READ A WORD (VECTOP) OR 0==>FAST I.E. MAP RESTORE
 285         JUMPE   A,FASTR
 286
 287 IFE ITS,[
 288 FASTR1: MOVEI   A,P-1
 289         MOVEI   B,P-1-E
 290         POP     P,(A)
 291         SUBI    A,1
 292         SOJG    B,.-2
 293 ]
 294
 295 IFN ITS,[
 296 FASTR1:
 297 ]
 298 IFN ITS,        MOVEM   E,NOTTY         ; SAVE TTY FLAG
 299 IFE ITS,[
 300         MOVEM   E,DEMFLG
 301         PUSHJ   P,GETJS
 302         HRRZS   IJFNS
 303         SETZM   IJFNS1
 304 ]
 305         PUSHJ   P,PURCLN        ; IN CASE RESTORED THING HAD PURE STUFF
 306         PUSHJ   P,INTINT        ; USE NEW INTRRRUPTS
 307
 308 IFN ITS,[
 309         .SUSET  [.RSNAM,,A]
 310         PUSH    P,A
 311 ]
 312
 313 ; NOW CYCLE THROUGH CHANNELS
 314         MOVE    C,[-N.CHNS*2,,CHNL1]    ; POINT TO REAL CHANNELS SLOTS
 315         PUSH    TP,$TVEC
 316         PUSH    TP,C
 317         PUSH    P,[N.CHNS]
 318
 319 CHNLP:  HRRZ    A,(C)           ; SEE IF NEW VALUE
 320         JUMPN   A,NXTCHN
 321         SKIPN   B,1(C)          ; GET CHANNEL
 322         JRST    NXTCHN
 323         PUSHJ   P,REOPN
 324         PUSHJ   P,CHNLOS
 325         MOVE    C,(TP)          ; GET POINTER
 326 NXTCHN: ADD     C,[2,,2]        ; AND BUMP
 327         MOVEM   C,(TP)
 328         SOSE    (P)
 329         JRST    CHNLP
 330
 331         SKIPN   C,CHNL0+1       ; ANY PSUEDO CHANNELS
 332         JRST    RDONE           ; NO, JUST GO AWAY
 333         MOVSI   A,TLIST         ; YES, REOPEN THEM
 334         MOVEM   A,(TP)-1
 335 CHNLP1: MOVEM   C,(TP)          ; SAVE POINTER
 336         SKIPE   B,(C)+1         ; GET CHANNEL
 337         PUSHJ   P,REOPN
 338         PUSHJ   P,CHNLO1
 339         MOVE    C,(TP)          ; GOBBLE POINTER
 340         HRRZ    C,(C)           ; REST LIST OF PSUEDO CHANNELS
 341         JUMPN   C,CHNLP1
 342
 343 RDONE:  MOVE    A,VECTOP
 344         CAMN    A,P.TOP
 345         JRST    NOCOR
 346         SETZM   (A)
 347         HRLS    A
 348         ADDI    A,1             ; SET UP BLT POINTER
 349         MOVE    B,P.TOP
 350         BLT     A,-1(B)         ; TO THE TOP OF THE WORLD
 351 NOCOR:  SUB     TP,[2,,2]
 352         SUB     P,[1,,1]
 353         PUSHJ   P,TTYOPE
 354 IFN ITS,[
 355         PUSHJ   P,IPCBLS        ;BLESS ALL THE IPC CHANNELS
 356         PUSHJ   P,SGSNAM        ; GET SNAME
 357         SKIPN   A
 358         MOVE    A,(P)           ; GET OLD SNAME
 359         SUB     P,[1,,1]
 360         PUSHJ   P,6TOCHS        ; TO STRING
 361 ]
 362 IFE ITS,[
 363         PUSHJ   P,SGSNMQ        ; SKIPS IF SNAME IS NON-NIL
 364          PUSHJ  P,%RSNAM        ;  ELSE GETS "REAL" SNAME
 365         PUSH    TP,A
 366         PUSH    TP,B
 367         MCALL   1,SNAME
 368         SETOM   SFRK
 369 ]
 370         PUSHJ   P,%RUNAM
 371         PUSHJ   P,%RJNAM
 372         MOVE    A,$TCHSTR
 373         MOVE    B,CHQUOTE RESTORED
 374         JRST    FINIS
 375
 376 IFE ITS,[
 377 ;SKIPS IF THERE IS AN SNAME, RETURNING IT
 378 SGSNMQ: MOVE    B,IMQUOTE SNM
 379         PUSHJ   P,IDVAL1
 380         GETYP   0,A
 381         CAIE    0,TCHSTR
 382          JRST   CPOPJ
 383         HRRZ    0,A
 384         JUMPE   CPOPJ
 385         JRST    CPOPJ1
 386 ]
 387
 388 FASTR:
 389 IFN ITS,[
 390         PUSHJ   P,WRDIN
 391         ADDI    A,1777
 392         ANDCMI  A,1777          ; ROUND AND TO PAGE BOUNDRY
 393         ASH     A,-10.          ; TO PAGES
 394         MOVNS   A
 395         MOVSI   A,(A)           ; TO PAGE AOBJN
 396         MOVE    C,A             ; COPY OF POINTER
 397         MOVE    0,NOTTY         ; SAVE NOTTY FLAG AROUND
 398         MOVE    D,(P)           ; CHANNEL
 399         DOTCAL  CORBLK,[[1000,,104000],[1000,,-1],A,D,C]
 400         FATAL   CORBLK ON RESTORE LOSSAGE
 401         PUSHJ   P,PURIN         ; GET PURIFIED STRUCTURE
 402         MOVSI   A,(D)           ; GET CHANNLEL BACK
 403         ASH     A,5
 404         MOVEI   B,E             ; WHERE TO STRAT IN FILE
 405         IOR     A,[.ACCESS B]
 406         XCT     A               ; ACCESS TO RIGHT ACS
 407         XOR     A,[<.IOT B>#<.ACCESS B>]
 408         MOVE    B,[D-P-1,,E]
 409         XCT     A               ; GET ACS
 410         MOVE    E,0             ; NO TTY FLAG BACK
 411         XOR     A,[<.IOT B>#<.CLOSE>]
 412         XCT     A
 413         MOVE    A,GCSTOP        ; GET CORE AND FOOL P.CORE
 414         ADDI    A,1777
 415         ANDCMI  A,1777
 416         EXCH    A,P.TOP                 ; GET P.TOP
 417         ASH     A,-10.          ; TO PAGES
 418         PUSHJ   P,P.CORE
 419         PUSHJ   P,NOCORE
 420         JRST    FASTR1
 421 ]
 422
 423 IFE ITS,[
 424 FASTR:  POP     P,A             ; JFN TO A
 425         BIN                     ; CORE TOP TO B
 426         MOVE    E,B             ; SAVE
 427         BIN                     ; PARTOP
 428         MOVE    D,B
 429         BIN                     ; SAVED P
 430         MOVE    P,B
 431         MOVE    0,DEMFLG        ; SAVE DEMFLG FLAG AROUND
 432         HRL     E,C             ; SAVE VECTOP
 433         MOVSI   A,(A)           ; JFN TO LH
 434         MOVSI   B,400000        ; FOR ME
 435         MOVSI   C,120400        ; FLAGS
 436         ASH     D,-9.           ; PAGES TO D
 437         PMAP
 438         ADDI    A,1
 439         ADDI    B,1
 440         SOJG    D,.-3
 441
 442         PUSHJ   P,PURIN
 443
 444         HLRZS   A
 445         CLOSF
 446         JFCL
 447         MOVE    E,0             ; DEMFLG TO E
 448         JRST    FASTR1
 449 ]
 450
 451 ; HERE TO GROCK FILE NAME FROM ARGS
 452
 453 GTFNM:
 454 IFN ITS,[
 455         PUSH    P,[0]           ; DIRECTION
 456         PUSH    TP,$TPDL
 457         PUSH    TP,P
 458         IRP A,,[DSK,MUDDLE,SAVE]
 459         PUSH    P,[SIXBIT /A/]
 460         TERMIN
 461         PUSHJ   P,SGSNAM        ; GET SNAME
 462         PUSH    P,A             ; SAVE SNAME
 463         JUMPGE  AB,GTFNM1
 464         PUSHJ   P,RGPRS         ; PARSE THESE ARGS
 465         JRST    .+2
 466 GTFNM1: AOS     -5(P)           ; SKIP RETURN
 467         MOVE    A,(P)           ; GET SNAME
 468         .SUSET  [.SSNAM,,A]
 469         MOVE    A,-5(P)         ; GET RET ADDR
 470         SUB     TP,[2,,2]
 471         JRST    (A)
 472
 473 ; HERE TO OUTPUT 1 WORD
 474
 475 WRDOUT: PUSH    P,B
 476         PUSH    P,A
 477         HRROI   B,(P)           ; POINT AT C(A)
 478         MOVE    A,-3(P)         ; CHANNEL
 479         PUSHJ   P,MIOT           ;WRITE IT
 480 POPJB:  POP     P,A
 481         POP     P,B
 482         POPJ    P,
 483
 484 ; HERE TO READ 1 WORD
 485 WRDIN==WRDOUT
 486 ]
 487 IFE ITS,[
 488         PUSH    P,C
 489         PUSH    P,B
 490         MOVE    B,IMQUOTE SNM
 491         PUSHJ   P,IDVAL1
 492         GETYP   0,A
 493         CAIN    0,TUNBOU
 494          JRST   GTFNM0
 495         TRNN    A,-1            ;ANY LENGTH?
 496          PUSHJ  P,%RSNAM        ;IF <SNAME> IS "", GET REAL ONE
 497         PUSHJ   P,ADDNUL
 498          SKIPA
 499 GTFNM0: MOVEI   B,0
 500         PUSH    P,[377777,,377777]
 501         PUSH    P,[-1,,[ASCIZ /DSK/]]
 502         PUSH    P,B
 503         PUSH    P,[-1,,[ASCIZ /MUDDLE/]]
 504         PUSH    P,[-1,,[ASCIZ /SAVE/]]
 505         PUSH    P,[0]
 506         PUSH    P,[0]
 507         PUSH    P,[77]          ; USE AN OBSCURE JFN IF POSSIBLE
 508         MOVE    A,(AB)
 509         MOVE    B,1(AB)
 510         PUSHJ   P,ADDNUL
 511         MOVEI   A,-10(P)
 512         GTJFN
 513         JRST    FNF
 514         SUB     P,[9.,,9.]
 515         POP     P,B
 516         OPENF
 517         JRST    FNF
 518         ADD     AB,[2,,2]
 519         SKIPL   AB
 520 CPOPJ1: AOS     (P)
 521 CPOPJ:  POPJ    P,
 522
 523 WRDIN:  PUSH    P,B
 524         MOVE    A,-2(P)         ; JFN TO A
 525         BIN
 526         MOVE    A,B
 527         POP     P,B
 528         POPJ    P,
 529
 530 WRDOUT: PUSH    P,B
 531         MOVE    B,-2(P)
 532         EXCH    A,B
 533         BOUT
 534         EXCH    A,B
 535         POP     P,B
 536         POPJ    P,
 537 ]
 538
 539
 540 ;REPLACE ALL OCCURANCES OF CHARACTER (B) TO CHARACTER (C) IN A
 541 HACKV:  PUSH    P,D
 542         PUSH    P,E
 543         MOVE    D,[440700,,A]
 544         MOVEI   E,5
 545 HACKV1: ILDB    0,D
 546         CAIN    0,(B)           ; MATCH ?
 547         DPB     C,D             ; YES, CLOBBER
 548         SOJG    E,HACKV1
 549         POP     P,E
 550         POP     P,D
 551         POPJ    P,
 552
 553
 554 CANTOP: ERRUUO  EQUOTE CANT-OPEN-OUTPUT-FILE
 555
 556 FNF:    ERRUUO  EQUOTE FILE-NOT-FOUND
 557
 558 BADVRS: ERRUUO  EQUOTE MUDDLE-VERSIONS-DIFFER
 559
 560
 561 CHNLO1: MOVE    C,(TP)
 562         SETZM   1(C)
 563         JRST    CHNLO2
 564
 565 CHNLOS: MOVE    C,(TP)
 566         SETZM   (C)-1
 567 CHNLO2: MOVEI   B,[ASCIZ /
 568 CHANNEL-NOT-RESTORED
 569 /]
 570         JRST    MSGTYP"
 571
 572
 573 NOCORE: PUSH    P,A
 574         PUSH    P,B
 575         MOVEI   B,[ASCIZ /
 576 WAIT, CORE NOT YET HERE
 577 /]
 578         PUSHJ   P,MSGTYP"
 579         MOVE    A,-1(P)         ; RESTORE BLOCKS NEEDED
 580         MOVEI   B,1
 581         .SLEEP  B,
 582         PUSHJ   P,P.CORE
 583         JRST    .-4
 584         MOVEI   B,[ASCIZ /
 585 CORE ARRIVED
 586 /]
 587         PUSHJ   P,MSGTYP
 588         POP     P,B
 589         POP     P,A
 590         POPJ    P,
 591
 592 IFN UNTAST,[
 593 PUCHK:  MOVEI   E,HIBOT         ; COMPUTE REAL START OF INTERPRETER
 594         ASH     E,-10.          ; TO PAGES
 595         MOVE    A,PURTOP        ; GET START TO POSSIBLE AREA CONTAINING P.S.
 596         ASH     A,-10.          ; TO PAGES
 597 PURCH1: PUSHJ   P,CHKPGI        ; SEE IF PAGE IS PURIFIED
 598         JFCL
 599         ADDI    A,1             ; INCREMENT PAGE COUNTER
 600         CAMG    A,E             ; SKIP IF DONE
 601         JRST    PURCH1
 602         POPJ    P,
 603 ]
 604
 605 ; THESE ROUTINES ARE USED BY SAVE AND RESTORE TO GET PAGES OF PURE STRUCTURE
 606 ; INTO A SAVE FILE.
 607
 608 PUROUT: MOVEI   E,HIBOT         ; COMPUTE REAL START OF INTERPRETER
 609         ASH     E,-10.          ; TO PAGES
 610         MOVE    A,PURTOP        ; GET START TO POSSIBLE AREA CONTAINING P.S.
 611         ASH     A,-10.          ; TO PAGES
 612 PUROU2: PUSHJ   P,CHKPGI        ; SEE IF PAGE IS PURIFIED
 613         JRST    INCPUT
 614         PUSH    P,A             ; SAVE A
 615         ASH     A,10.           ; TO WORDS
 616         HRLI    A,-2000         ; MAKE UP AOBJN PTR FOR IOT
 617         MOVE    B,-2(P)         ; RESTORE CHN #
 618 IFN ITS,[
 619         DOTCAL  IOT,[B,A]
 620         FATAL   SAVE--IOT FAILED
 621 ]
 622 IFE ITS,[
 623         PUSH    P,C             ; SAVE C
 624         MOVE    B,A             ; SET UP BYTE POINTER
 625         MOVE    A,0             ; CHANNEL TO A
 626         HRLI    B,444400        ; SET UP BYTE POINTER
 627         MOVNI   C,2000
 628         SOUT                    ; OUT IT GOES
 629         POP     P,C
 630 ]
 631
 632         POP     P,A             ; RESTORE PAGE #
 633 INCPUT: ADDI    A,1             ; INCREMENT PAGE COUNTER
 634         CAMG    A,E             ; SKIP IF DONE
 635         JRST    PUROU2
 636         POPJ    P,
 637
 638
 639 IFN UNTAST,[
 640
 641 CHKPGJ: TDZA    0,0
 642 ]
 643 CHKPGI:
 644 IFN UNTAST,[
 645         MOVEI   0,1
 646 ]
 647         PUSH    P,A             ; SAVE IT
 648         IDIVI   A,16.           ; FIND ENTRY IN PMAP TABLE
 649         MOVE    C,PMAPB(A)      ; GET WORD CONTAINING ENTRY
 650         HRLZI   D,400000        ; SET UP TEST WORD
 651         IMULI   B,2
 652         MOVNS   B
 653         LSH     D,(B)           ; GET TO CHECK PAIR
 654         LSH     D,-1            ; TO BIT INDICATING SAVE
 655         TDON    C,D             ; SKIP IF PAGE CONTAINS P.S
 656         JRST    PUROU1
 657         POP     P,A
 658         AOS     (P)             ; SKIP ITS A WINNER
 659 IFN UNTAST,[
 660         JUMPN   0,.+4
 661         LSH     D,1
 662         TDNN    C,D
 663         AOS     (P)
 664 ]       POPJ    P,              ; EXIT
 665 PUROU1:
 666 IFN UNTAST,[
 667         JUMPE   0,CHKPG2
 668 IFN ITS,[
 669         PUSH    P,A
 670         DOTCAL  CORTYP,[A,[2000,,A],[2000,,0]]
 671         FATAL DOTCAL FAILURE
 672         SKIPN   A
 673         MOVEI   0,0
 674         POP     P,A
 675         JUMPGE  0,CHKPG2
 676 ]
 677 IFE ITS,[
 678         PUSH    P,A
 679         PUSH    P,B
 680         LSH     A,1
 681         HRLI    A,400000
 682         RPACS
 683         MOVE    0,B
 684         POP     P,B
 685         POP     P,A
 686         TLC     0,150400
 687         TRNE    0,150400
 688         JRST    CHKPG2
 689 ]
 690         LSH     D,1
 691         TDO     C,D
 692         MOVEM   C,PMAPB(A)
 693         AOS     -1(P)
 694 CHKPG2:]
 695         POP     P,A
 696         POPJ    P,
 697
 698
 699 ; ROUTINE TO READ IN PURE STRUCTURE PAGES
 700
 701 IFN ITS,[
 702 PURIN:  PUSH    P,D             ; SAVE CHANNEL #
 703         MOVEI   E,HIBOT         ; COMPUTE REAL START OF INTERPRETER
 704         ASH     E,-10.          ; TO PAGES
 705         MOVE    A,PURTOP        ; GET START TO POSSIBLE AREA CONTAINING P.S.
 706         ASH     A,-10.          ; TO WORDS
 707 PURIN1:
 708 IFN UNTAST,     PUSHJ   P,CHKPGJ        ; SEE IF PURE PAGE EXISTS
 709 IFE UNTAST,     PUSHJ   P,CHKPGI        ; SEE IF PURE PAGE EXISTS
 710         JRST    NXPGPN
 711 IFN UNTAST,[
 712         SKIPA   D,[200000]
 713         MOVEI   D,[104000]
 714         MOVSI   0,(D)
 715 ]
 716         PUSH    P,A             ; SAVE A
 717         MOVE    D,-1(P)         ; RESTORE CHANNEL #
 718         HRLI    A,-1            ; SET UP AOBJN POINTER FOR DOTCAL
 719 IFN UNTAST,[
 720         DOTCAL  CORBLK,[0,[1000,,-1],A,D]
 721 ]
 722 IFE UNTAST,[
 723         DOTCAL  CORBLK,[[1000,,200000],[1000,,-1],A,D]
 724 ]
 725         FATAL SAVE--CORBLK FAILED
 726         POP     P,A             ; RESTORE A
 727 NXPGPN: ADDI    A,1
 728         CAMG    A,E             ; SKIP IF DONE
 729         JRST    PURIN1
 730         POP     P,D             ; RESTORE CHANNEL
 731         POPJ    P,
 732 ]
 733 IFE ITS,[
 734 PURIN:  PUSH    P,A             ; SAVE CHANNEL
 735         MOVEI   E,HIBOT         ; TOP OF SCAN
 736         ASH     E,-10.
 737         MOVE    A,PURBOT        ; BOTTOM OF SCAN
 738         ASH     A,-10.          ; TO PAGES
 739 PURIN1: PUSHJ   P,CHKPGI        ; SEE IF PAGE IS NEEDED
 740         JRST    NXTPGN
 741         SKIPA   C,[120000]
 742         MOVEI   C,120400
 743         PUSH    P,A
 744         MOVE    B,A             ; COPY TO B
 745         ASH     B,1             ; FOR TEXEX PAGES
 746         HRLI    B,MFORK         ; SET UP ARGS TO PMAP
 747         MOVSI   C,(C)
 748         MOVE    A,-1(P)         ; GET FILE POINTER
 749         PMAP                    ; IN IT COMES
 750         ADDI    B,1             ; INCREMENT B
 751         ADDI    A,1             ; AND A
 752         PMAP                    ; SECOND HALF OF ITS PAGE
 753         ADDI    A,1
 754         MOVEM   A,-1(P)         ; SAVE FILE PAGE
 755         POP     P,A
 756 NXTPGN: ADDI    A,1
 757         CAMG    A,E             ; SKIP IF DONE
 758         JRST    PURIN1
 759         POP     P,A             ; RESTOR CHANNEL
 760         POPJ    P,              ;EXIT
 761 ]
 762 CKVRS:  PUSH    P,-1(P)
 763         PUSHJ   P,WRDIN         ; READ MUDDLE VERSION
 764         MOVEI   B,40            ; CHANGE ALL SPACES
 765         MOVEI   C,177           ; ----- TO RUBOUT CHARACTERS
 766         PUSHJ   P,HACKV
 767         CAME    A,MUDSTR+2      ; AGREE ?
 768         JRST    BADVRS
 769         SUB     P,[1,,1]        ; POP OFF CHANNEL #
 770         POPJ    P,
 771
 772
 773 END
 774 \f