<mdl.int>/save.mid.175

   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         MOVE    A,$TCHSTR
 381         MOVE    B,CHQUOTE RESTORED
 382         JRST    FINIS
 383
 384 IFE ITS,[
 385 ;SKIPS IF THERE IS AN SNAME, RETURNING IT
 386 SGSNMQ: MOVE    B,IMQUOTE SNM
 387         PUSHJ   P,IDVAL1
 388         GETYP   0,A
 389         CAIE    0,TCHSTR
 390          JRST   CPOPJ
 391         HRRZ    0,A
 392         JUMPE   CPOPJ
 393         JRST    CPOPJ1
 394 ]
 395
 396 FASTR:
 397 IFN ITS,[
 398         PUSHJ   P,WRDIN
 399         ADDI    A,1777
 400         ANDCMI  A,1777          ; ROUND AND TO PAGE BOUNDRY
 401         ASH     A,-10.          ; TO PAGES
 402         MOVNS   A
 403         MOVSI   A,(A)           ; TO PAGE AOBJN
 404         MOVE    C,A             ; COPY OF POINTER
 405         MOVE    0,NOTTY         ; SAVE NOTTY FLAG AROUND
 406         MOVE    D,(P)           ; CHANNEL
 407         DOTCAL  CORBLK,[[1000,,104000],[1000,,-1],A,D,C]
 408         FATAL   CORBLK ON RESTORE LOSSAGE
 409         PUSHJ   P,PURIN         ; GET PURIFIED STRUCTURE
 410         MOVSI   A,(D)           ; GET CHANNLEL BACK
 411         ASH     A,5
 412         MOVEI   B,E             ; WHERE TO STRAT IN FILE
 413         IOR     A,[.ACCESS B]
 414         XCT     A               ; ACCESS TO RIGHT ACS
 415         XOR     A,[<.IOT B>#<.ACCESS B>]
 416         MOVE    B,[D-P-1,,E]
 417         XCT     A               ; GET ACS
 418         MOVE    E,0             ; NO TTY FLAG BACK
 419         XOR     A,[<.IOT B>#<.CLOSE>]
 420         XCT     A
 421         MOVE    A,GCSTOP        ; GET CORE AND FOOL P.CORE
 422         ADDI    A,1777
 423         ANDCMI  A,1777
 424         EXCH    A,P.TOP                 ; GET P.TOP
 425         ASH     A,-10.          ; TO PAGES
 426         PUSHJ   P,P.CORE
 427         PUSHJ   P,NOCORE
 428         JRST    FASTR1
 429 ]
 430
 431 IFE ITS,[
 432 FASTR:  POP     P,A             ; JFN TO A
 433         BIN                     ; CORE TOP TO B
 434         MOVE    E,B             ; SAVE
 435         BIN                     ; PARTOP
 436         MOVE    D,B
 437         BIN                     ; SAVED P
 438         MOVE    P,B
 439         MOVE    0,DEMFLG        ; SAVE DEMFLG FLAG AROUND
 440         HRL     E,C             ; SAVE VECTOP
 441         MOVSI   A,(A)           ; JFN TO LH
 442         MOVSI   B,400000        ; FOR ME
 443         MOVSI   C,120400        ; FLAGS
 444         ASH     D,-9.           ; PAGES TO D
 445         PMAP
 446         ADDI    A,1
 447         ADDI    B,1
 448         SOJG    D,.-3
 449
 450         PUSHJ   P,PURIN
 451
 452         HLRZS   A
 453         CLOSF
 454         JFCL
 455         MOVE    E,0             ; DEMFLG TO E
 456         JRST    FASTR1
 457 ]
 458
 459 ; HERE TO GROCK FILE NAME FROM ARGS
 460
 461 GTFNM:
 462 IFN ITS,[
 463         PUSH    P,[0]           ; DIRECTION
 464         PUSH    TP,$TPDL
 465         PUSH    TP,P
 466         IRP A,,[DSK,MUDDLE,SAVE]
 467         PUSH    P,[SIXBIT /A/]
 468         TERMIN
 469         PUSHJ   P,SGSNAM        ; GET SNAME
 470         PUSH    P,A             ; SAVE SNAME
 471         JUMPGE  AB,GTFNM1
 472         PUSHJ   P,RGPRS         ; PARSE THESE ARGS
 473         JRST    .+2
 474 GTFNM1: AOS     -5(P)           ; SKIP RETURN
 475         MOVE    A,(P)           ; GET SNAME
 476         .SUSET  [.SSNAM,,A]
 477         MOVE    A,-5(P)         ; GET RET ADDR
 478         SUB     TP,[2,,2]
 479         JRST    (A)
 480
 481 ; HERE TO OUTPUT 1 WORD
 482
 483 WRDOUT: PUSH    P,B
 484         PUSH    P,A
 485         HRROI   B,(P)           ; POINT AT C(A)
 486         MOVE    A,-3(P)         ; CHANNEL
 487         PUSHJ   P,MIOT           ;WRITE IT
 488 POPJB:  POP     P,A
 489         POP     P,B
 490         POPJ    P,
 491
 492 ; HERE TO READ 1 WORD
 493 WRDIN==WRDOUT
 494 ]
 495 IFE ITS,[
 496         PUSH    P,C
 497         PUSH    P,B
 498         MOVE    B,IMQUOTE SNM
 499         PUSHJ   P,IDVAL1
 500         GETYP   0,A
 501         CAIN    0,TUNBOU
 502          JRST   GTFNM0
 503         TRNN    A,-1            ;ANY LENGTH?
 504          PUSHJ  P,%RSNAM        ;IF <SNAME> IS "", GET REAL ONE
 505         PUSHJ   P,ADDNUL
 506          SKIPA
 507 GTFNM0: MOVEI   B,0
 508         PUSH    P,[377777,,377777]
 509         PUSH    P,[-1,,[ASCIZ /DSK/]]
 510         PUSH    P,B
 511         PUSH    P,[-1,,[ASCIZ /MUDDLE/]]
 512         PUSH    P,[-1,,[ASCIZ /SAVE/]]
 513         PUSH    P,[0]
 514         PUSH    P,[0]
 515         PUSH    P,[77]          ; USE AN OBSCURE JFN IF POSSIBLE
 516         MOVE    A,(AB)
 517         MOVE    B,1(AB)
 518         PUSHJ   P,ADDNUL
 519         MOVEI   A,-10(P)
 520         GTJFN
 521         JRST    FNF
 522         SUB     P,[9.,,9.]
 523         POP     P,B
 524         OPENF
 525         JRST    FNF
 526         ADD     AB,[2,,2]
 527         SKIPL   AB
 528 CPOPJ1: AOS     (P)
 529 CPOPJ:  POPJ    P,
 530
 531 WRDIN:  PUSH    P,B
 532         MOVE    A,-2(P)         ; JFN TO A
 533         BIN
 534         MOVE    A,B
 535         POP     P,B
 536         POPJ    P,
 537
 538 WRDOUT: PUSH    P,B
 539         MOVE    B,-2(P)
 540         EXCH    A,B
 541         BOUT
 542         EXCH    A,B
 543         POP     P,B
 544         POPJ    P,
 545 ]
 546
 547
 548 ;REPLACE ALL OCCURANCES OF CHARACTER (B) TO CHARACTER (C) IN A
 549 HACKV:  PUSH    P,D
 550         PUSH    P,E
 551         MOVE    D,[440700,,A]
 552         MOVEI   E,5
 553 HACKV1: ILDB    0,D
 554         CAIN    0,(B)           ; MATCH ?
 555         DPB     C,D             ; YES, CLOBBER
 556         SOJG    E,HACKV1
 557         POP     P,E
 558         POP     P,D
 559         POPJ    P,
 560
 561
 562 CANTOP: ERRUUO  EQUOTE CANT-OPEN-OUTPUT-FILE
 563
 564 FNF:    ERRUUO  EQUOTE FILE-NOT-FOUND
 565
 566 BADVRS: ERRUUO  EQUOTE MUDDLE-VERSIONS-DIFFER
 567
 568
 569 CHNLO1: MOVE    C,(TP)
 570         SETZM   1(C)
 571         JRST    CHNLO2
 572
 573 CHNLOS: MOVE    C,(TP)
 574         MOVE    B,1(C)
 575         SETZM   1(B)                    ; CLOBBER CHANNEL #
 576         SETZM   1(C)
 577 CHNLO2: MOVEI   B,[ASCIZ /
 578 CHANNEL-NOT-RESTORED
 579 /]
 580         JRST    MSGTYP"
 581
 582 IFN ITS,[
 583 NOCORE: PUSH    P,A
 584         PUSH    P,B
 585         MOVEI   B,[ASCIZ /
 586 WAIT, CORE NOT YET HERE
 587 /]
 588         PUSHJ   P,MSGTYP"
 589         MOVE    A,-1(P)         ; RESTORE BLOCKS NEEDED
 590         MOVEI   B,1
 591         .SLEEP  B,
 592         PUSHJ   P,P.CORE
 593         JRST    .-4
 594         MOVEI   B,[ASCIZ /
 595 CORE ARRIVED
 596 /]
 597         PUSHJ   P,MSGTYP
 598         POP     P,B
 599         POP     P,A
 600         POPJ    P,
 601 ]
 602 IFN UNTAST,[
 603 PUCHK:  MOVEI   E,HIBOT         ; COMPUTE REAL START OF INTERPRETER
 604         ASH     E,-10.          ; TO PAGES
 605         MOVE    A,PURTOP        ; GET START TO POSSIBLE AREA CONTAINING P.S.
 606         ASH     A,-10.          ; TO PAGES
 607 PURCH1: PUSHJ   P,CHKPGI        ; SEE IF PAGE IS PURIFIED
 608         JFCL
 609         ADDI    A,1             ; INCREMENT PAGE COUNTER
 610         CAMG    A,E             ; SKIP IF DONE
 611         JRST    PURCH1
 612         POPJ    P,
 613 ]
 614
 615 ; THESE ROUTINES ARE USED BY SAVE AND RESTORE TO GET PAGES OF PURE STRUCTURE
 616 ; INTO A SAVE FILE.
 617
 618 PUROUT: MOVEI   E,HIBOT         ; COMPUTE REAL START OF INTERPRETER
 619         ASH     E,-10.          ; TO PAGES
 620         MOVE    A,PURTOP        ; GET START TO POSSIBLE AREA CONTAINING P.S.
 621         ASH     A,-10.          ; TO PAGES
 622 PUROU2: PUSHJ   P,CHKPGI        ; SEE IF PAGE IS PURIFIED
 623         JRST    INCPUT
 624         PUSH    P,A             ; SAVE A
 625         ASH     A,10.           ; TO WORDS
 626         HRLI    A,-2000         ; MAKE UP AOBJN PTR FOR IOT
 627         MOVE    B,-2(P)         ; RESTORE CHN #
 628 IFN ITS,[
 629         DOTCAL  IOT,[B,A]
 630         FATAL   SAVE--IOT FAILED
 631 ]
 632 IFE ITS,[
 633         PUSH    P,C             ; SAVE C
 634         MOVE    B,A             ; SET UP BYTE POINTER
 635         MOVE    A,0             ; CHANNEL TO A
 636         HRLI    B,444400        ; SET UP BYTE POINTER
 637         MOVNI   C,2000
 638         SOUT                    ; OUT IT GOES
 639         POP     P,C
 640 ]
 641
 642         POP     P,A             ; RESTORE PAGE #
 643 INCPUT: ADDI    A,1             ; INCREMENT PAGE COUNTER
 644         CAMG    A,E             ; SKIP IF DONE
 645         JRST    PUROU2
 646         POPJ    P,
 647
 648
 649 IFN UNTAST,[
 650
 651 CHKPGJ: TDZA    0,0
 652 ]
 653 CHKPGI:
 654 IFN UNTAST,[
 655         MOVEI   0,1
 656 ]
 657         PUSH    P,A             ; SAVE IT
 658         IDIVI   A,16.           ; FIND ENTRY IN PMAP TABLE
 659         MOVE    C,PMAPB(A)      ; GET WORD CONTAINING ENTRY
 660         HRLZI   D,400000        ; SET UP TEST WORD
 661         IMULI   B,2
 662         MOVNS   B
 663         LSH     D,(B)           ; GET TO CHECK PAIR
 664         LSH     D,-1            ; TO BIT INDICATING SAVE
 665         TDON    C,D             ; SKIP IF PAGE CONTAINS P.S
 666         JRST    PUROU1
 667         POP     P,A
 668         AOS     (P)             ; SKIP ITS A WINNER
 669 IFN UNTAST,[
 670         JUMPN   0,.+4
 671         LSH     D,1
 672         TDNN    C,D
 673         AOS     (P)
 674 ]       POPJ    P,              ; EXIT
 675 PUROU1:
 676 IFN UNTAST,[
 677         JUMPE   0,CHKPG2
 678 IFN ITS,[
 679         PUSH    P,A
 680         DOTCAL  CORTYP,[A,[2000,,A],[2000,,0]]
 681         FATAL DOTCAL FAILURE
 682         SKIPN   A
 683         MOVEI   0,0
 684         POP     P,A
 685         JUMPGE  0,CHKPG2
 686 ]
 687 IFE ITS,[
 688         PUSH    P,A
 689         PUSH    P,B
 690         LSH     A,1
 691         HRLI    A,400000
 692         RPACS
 693         MOVE    0,B
 694         POP     P,B
 695         POP     P,A
 696         TLC     0,150400
 697         TRNE    0,150400
 698         JRST    CHKPG2
 699 ]
 700         LSH     D,1
 701         TDO     C,D
 702         MOVEM   C,PMAPB(A)
 703         AOS     -1(P)
 704 CHKPG2:]
 705         POP     P,A
 706         POPJ    P,
 707
 708
 709 ; ROUTINE TO READ IN PURE STRUCTURE PAGES
 710
 711 IFN ITS,[
 712 PURIN:  PUSH    P,D             ; SAVE CHANNEL #
 713         MOVEI   E,HIBOT         ; COMPUTE REAL START OF INTERPRETER
 714         ASH     E,-10.          ; TO PAGES
 715         MOVE    A,PURTOP        ; GET START TO POSSIBLE AREA CONTAINING P.S.
 716         ASH     A,-10.          ; TO WORDS
 717 PURIN1:
 718 IFN UNTAST,     PUSHJ   P,CHKPGJ        ; SEE IF PURE PAGE EXISTS
 719 IFE UNTAST,     PUSHJ   P,CHKPGI        ; SEE IF PURE PAGE EXISTS
 720         JRST    NXPGPN
 721 IFN UNTAST,[
 722         SKIPA   D,[200000]
 723         MOVEI   D,[104000]
 724         MOVSI   0,(D)
 725 ]
 726         PUSH    P,A             ; SAVE A
 727         MOVE    D,-1(P)         ; RESTORE CHANNEL #
 728         HRLI    A,-1            ; SET UP AOBJN POINTER FOR DOTCAL
 729 IFN UNTAST,[
 730         DOTCAL  CORBLK,[0,[1000,,-1],A,D]
 731 ]
 732 IFE UNTAST,[
 733         DOTCAL  CORBLK,[[1000,,200000],[1000,,-1],A,D]
 734 ]
 735         FATAL SAVE--CORBLK FAILED
 736         POP     P,A             ; RESTORE A
 737 NXPGPN: ADDI    A,1
 738         CAMG    A,E             ; SKIP IF DONE
 739         JRST    PURIN1
 740         POP     P,D             ; RESTORE CHANNEL
 741         POPJ    P,
 742 ]
 743 IFE ITS,[
 744 PURIN:  PUSH    P,A             ; SAVE CHANNEL
 745         MOVEI   E,HIBOT         ; TOP OF SCAN
 746         ASH     E,-10.
 747         MOVE    A,PURBOT        ; BOTTOM OF SCAN
 748         ASH     A,-10.          ; TO PAGES
 749 PURIN1: PUSHJ   P,CHKPGI        ; SEE IF PAGE IS NEEDED
 750         JRST    NXTPGN
 751         SKIPA   C,[120000]
 752         MOVEI   C,120400
 753         PUSH    P,A
 754         MOVE    B,A             ; COPY TO B
 755         ASH     B,1             ; FOR TEXEX PAGES
 756         HRLI    B,MFORK         ; SET UP ARGS TO PMAP
 757         MOVSI   C,(C)
 758         MOVE    A,-1(P)         ; GET FILE POINTER
 759         PMAP                    ; IN IT COMES
 760         ADDI    B,1             ; INCREMENT B
 761         ADDI    A,1             ; AND A
 762         PMAP                    ; SECOND HALF OF ITS PAGE
 763         ADDI    A,1
 764         MOVEM   A,-1(P)         ; SAVE FILE PAGE
 765         POP     P,A
 766 NXTPGN: ADDI    A,1
 767         CAMG    A,E             ; SKIP IF DONE
 768         JRST    PURIN1
 769         POP     P,A             ; RESTOR CHANNEL
 770         POPJ    P,              ;EXIT
 771 ]
 772 CKVRS:  PUSH    P,-1(P)
 773         PUSHJ   P,WRDIN         ; READ MUDDLE VERSION
 774         MOVEI   B,40            ; CHANGE ALL SPACES
 775         MOVEI   C,177           ; ----- TO RUBOUT CHARACTERS
 776         PUSHJ   P,HACKV
 777         CAME    A,MUDSTR+2      ; AGREE ?
 778         JRST    BADVRS
 779         SUB     P,[1,,1]        ; POP OFF CHANNEL #
 780         POPJ    P,
 781
 782 IFE ITS,[
 783 JFNTBL: SETZ    IJFNS
 784         SETZ    IJFNS1
 785         SETZ    MAPJFN
 786         SETZ    DIRCHN
 787
 788 JFNLNT==.-JFNTBL
 789 ]
 790 END
 791
 792 \f