<mdl.int>/save.mid.176

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