<mdl.int>/save.mid.174

   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:  HRRZ    A,(C)           ; SEE IF NEW VALUE
 328         JUMPN   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         SETZM   (C)-1
 575 CHNLO2: MOVEI   B,[ASCIZ /
 576 CHANNEL-NOT-RESTORED
 577 /]
 578         JRST    MSGTYP"
 579
 580 IFN ITS,[
 581 NOCORE: PUSH    P,A
 582         PUSH    P,B
 583         MOVEI   B,[ASCIZ /
 584 WAIT, CORE NOT YET HERE
 585 /]
 586         PUSHJ   P,MSGTYP"
 587         MOVE    A,-1(P)         ; RESTORE BLOCKS NEEDED
 588         MOVEI   B,1
 589         .SLEEP  B,
 590         PUSHJ   P,P.CORE
 591         JRST    .-4
 592         MOVEI   B,[ASCIZ /
 593 CORE ARRIVED
 594 /]
 595         PUSHJ   P,MSGTYP
 596         POP     P,B
 597         POP     P,A
 598         POPJ    P,
 599 ]
 600 IFN UNTAST,[
 601 PUCHK:  MOVEI   E,HIBOT         ; COMPUTE REAL START OF INTERPRETER
 602         ASH     E,-10.          ; TO PAGES
 603         MOVE    A,PURTOP        ; GET START TO POSSIBLE AREA CONTAINING P.S.
 604         ASH     A,-10.          ; TO PAGES
 605 PURCH1: PUSHJ   P,CHKPGI        ; SEE IF PAGE IS PURIFIED
 606         JFCL
 607         ADDI    A,1             ; INCREMENT PAGE COUNTER
 608         CAMG    A,E             ; SKIP IF DONE
 609         JRST    PURCH1
 610         POPJ    P,
 611 ]
 612
 613 ; THESE ROUTINES ARE USED BY SAVE AND RESTORE TO GET PAGES OF PURE STRUCTURE
 614 ; INTO A SAVE FILE.
 615
 616 PUROUT: MOVEI   E,HIBOT         ; COMPUTE REAL START OF INTERPRETER
 617         ASH     E,-10.          ; TO PAGES
 618         MOVE    A,PURTOP        ; GET START TO POSSIBLE AREA CONTAINING P.S.
 619         ASH     A,-10.          ; TO PAGES
 620 PUROU2: PUSHJ   P,CHKPGI        ; SEE IF PAGE IS PURIFIED
 621         JRST    INCPUT
 622         PUSH    P,A             ; SAVE A
 623         ASH     A,10.           ; TO WORDS
 624         HRLI    A,-2000         ; MAKE UP AOBJN PTR FOR IOT
 625         MOVE    B,-2(P)         ; RESTORE CHN #
 626 IFN ITS,[
 627         DOTCAL  IOT,[B,A]
 628         FATAL   SAVE--IOT FAILED
 629 ]
 630 IFE ITS,[
 631         PUSH    P,C             ; SAVE C
 632         MOVE    B,A             ; SET UP BYTE POINTER
 633         MOVE    A,0             ; CHANNEL TO A
 634         HRLI    B,444400        ; SET UP BYTE POINTER
 635         MOVNI   C,2000
 636         SOUT                    ; OUT IT GOES
 637         POP     P,C
 638 ]
 639
 640         POP     P,A             ; RESTORE PAGE #
 641 INCPUT: ADDI    A,1             ; INCREMENT PAGE COUNTER
 642         CAMG    A,E             ; SKIP IF DONE
 643         JRST    PUROU2
 644         POPJ    P,
 645
 646
 647 IFN UNTAST,[
 648
 649 CHKPGJ: TDZA    0,0
 650 ]
 651 CHKPGI:
 652 IFN UNTAST,[
 653         MOVEI   0,1
 654 ]
 655         PUSH    P,A             ; SAVE IT
 656         IDIVI   A,16.           ; FIND ENTRY IN PMAP TABLE
 657         MOVE    C,PMAPB(A)      ; GET WORD CONTAINING ENTRY
 658         HRLZI   D,400000        ; SET UP TEST WORD
 659         IMULI   B,2
 660         MOVNS   B
 661         LSH     D,(B)           ; GET TO CHECK PAIR
 662         LSH     D,-1            ; TO BIT INDICATING SAVE
 663         TDON    C,D             ; SKIP IF PAGE CONTAINS P.S
 664         JRST    PUROU1
 665         POP     P,A
 666         AOS     (P)             ; SKIP ITS A WINNER
 667 IFN UNTAST,[
 668         JUMPN   0,.+4
 669         LSH     D,1
 670         TDNN    C,D
 671         AOS     (P)
 672 ]       POPJ    P,              ; EXIT
 673 PUROU1:
 674 IFN UNTAST,[
 675         JUMPE   0,CHKPG2
 676 IFN ITS,[
 677         PUSH    P,A
 678         DOTCAL  CORTYP,[A,[2000,,A],[2000,,0]]
 679         FATAL DOTCAL FAILURE
 680         SKIPN   A
 681         MOVEI   0,0
 682         POP     P,A
 683         JUMPGE  0,CHKPG2
 684 ]
 685 IFE ITS,[
 686         PUSH    P,A
 687         PUSH    P,B
 688         LSH     A,1
 689         HRLI    A,400000
 690         RPACS
 691         MOVE    0,B
 692         POP     P,B
 693         POP     P,A
 694         TLC     0,150400
 695         TRNE    0,150400
 696         JRST    CHKPG2
 697 ]
 698         LSH     D,1
 699         TDO     C,D
 700         MOVEM   C,PMAPB(A)
 701         AOS     -1(P)
 702 CHKPG2:]
 703         POP     P,A
 704         POPJ    P,
 705
 706
 707 ; ROUTINE TO READ IN PURE STRUCTURE PAGES
 708
 709 IFN ITS,[
 710 PURIN:  PUSH    P,D             ; SAVE CHANNEL #
 711         MOVEI   E,HIBOT         ; COMPUTE REAL START OF INTERPRETER
 712         ASH     E,-10.          ; TO PAGES
 713         MOVE    A,PURTOP        ; GET START TO POSSIBLE AREA CONTAINING P.S.
 714         ASH     A,-10.          ; TO WORDS
 715 PURIN1:
 716 IFN UNTAST,     PUSHJ   P,CHKPGJ        ; SEE IF PURE PAGE EXISTS
 717 IFE UNTAST,     PUSHJ   P,CHKPGI        ; SEE IF PURE PAGE EXISTS
 718         JRST    NXPGPN
 719 IFN UNTAST,[
 720         SKIPA   D,[200000]
 721         MOVEI   D,[104000]
 722         MOVSI   0,(D)
 723 ]
 724         PUSH    P,A             ; SAVE A
 725         MOVE    D,-1(P)         ; RESTORE CHANNEL #
 726         HRLI    A,-1            ; SET UP AOBJN POINTER FOR DOTCAL
 727 IFN UNTAST,[
 728         DOTCAL  CORBLK,[0,[1000,,-1],A,D]
 729 ]
 730 IFE UNTAST,[
 731         DOTCAL  CORBLK,[[1000,,200000],[1000,,-1],A,D]
 732 ]
 733         FATAL SAVE--CORBLK FAILED
 734         POP     P,A             ; RESTORE A
 735 NXPGPN: ADDI    A,1
 736         CAMG    A,E             ; SKIP IF DONE
 737         JRST    PURIN1
 738         POP     P,D             ; RESTORE CHANNEL
 739         POPJ    P,
 740 ]
 741 IFE ITS,[
 742 PURIN:  PUSH    P,A             ; SAVE CHANNEL
 743         MOVEI   E,HIBOT         ; TOP OF SCAN
 744         ASH     E,-10.
 745         MOVE    A,PURBOT        ; BOTTOM OF SCAN
 746         ASH     A,-10.          ; TO PAGES
 747 PURIN1: PUSHJ   P,CHKPGI        ; SEE IF PAGE IS NEEDED
 748         JRST    NXTPGN
 749         SKIPA   C,[120000]
 750         MOVEI   C,120400
 751         PUSH    P,A
 752         MOVE    B,A             ; COPY TO B
 753         ASH     B,1             ; FOR TEXEX PAGES
 754         HRLI    B,MFORK         ; SET UP ARGS TO PMAP
 755         MOVSI   C,(C)
 756         MOVE    A,-1(P)         ; GET FILE POINTER
 757         PMAP                    ; IN IT COMES
 758         ADDI    B,1             ; INCREMENT B
 759         ADDI    A,1             ; AND A
 760         PMAP                    ; SECOND HALF OF ITS PAGE
 761         ADDI    A,1
 762         MOVEM   A,-1(P)         ; SAVE FILE PAGE
 763         POP     P,A
 764 NXTPGN: ADDI    A,1
 765         CAMG    A,E             ; SKIP IF DONE
 766         JRST    PURIN1
 767         POP     P,A             ; RESTOR CHANNEL
 768         POPJ    P,              ;EXIT
 769 ]
 770 CKVRS:  PUSH    P,-1(P)
 771         PUSHJ   P,WRDIN         ; READ MUDDLE VERSION
 772         MOVEI   B,40            ; CHANGE ALL SPACES
 773         MOVEI   C,177           ; ----- TO RUBOUT CHARACTERS
 774         PUSHJ   P,HACKV
 775         CAME    A,MUDSTR+2      ; AGREE ?
 776         JRST    BADVRS
 777         SUB     P,[1,,1]        ; POP OFF CHANNEL #
 778         POPJ    P,
 779
 780 IFE ITS,[
 781 JFNTBL: SETZ    IJFNS
 782         SETZ    IJFNS1
 783         SETZ    MAPJFN
 784         SETZ    DIRCHN
 785
 786 JFNLNT==.-JFNTBL
 787 ]
 788 END
 789
 790 \f