<mdl.int>/mappur.mid.160

   1
   2 TITLE MAPURE-PAGE LOADER
   3
   4 RELOCATABLE
   5
   6 MAPCH==0                        ; channel for MAPing
   7 XJRST==JRST 5,
   8
   9 .GLOBAL PURVEC,PURTOP,PURBOT,P.TOP,GCSTOP,FRETOP,MUDSTR,STRTO6,PLOAD,AGC,GCDOWN
  10 .GLOBAL SQUTOA,IGVAL,IBLOCK,PURCLN,MOVPUR,GETPAG,GCFLG,NOSHUF,DIR,NDIRS,SQUPNT
  11 .GLOBAL PLODR,SQUKIL,GETBUF,KILBUF,INPLOD,SQKIL,PVSTOR,TVSTOR,DSTOREM,SLEEPR
  12 .GLOBAL OPSYS,SJFNS,MULTSG,PURBTB,SFIX,NSEGS
  13 .GLOBAL C%11,C%22,C%33,C%44,C%55,C%66,C%0,C%1,C%2,C%3,C%M1,C%M2,C%M10
  14 .GLOBAL C%M20,C%M30,C%M40,C%M60
  15 .GLOBAL MAPJFN,DIRCHN
  16
  17 .INSRT MUDDLE >
  18 SPCFXU==1
  19 SYSQ
  20
  21 IFE ITS,[
  22 IF1, .INSRT STENEX >
  23 ]
  24
  25 F==PVP
  26 G==TVP
  27 H==SP
  28 RDTP==1000,,200000
  29 FME==1000,,-1
  30
  31
  32 IFN ITS,[
  33 PGMSK==1777
  34 PGSHFT==10.
  35 ]
  36
  37 IFE ITS,[
  38 FLUSHP==0
  39 PGMSK==777
  40 PGSHFT==9.
  41 ]
  42
  43 LNTBYT==340700
  44 ELN==4                          ; LENGTH OF SLOT
  45 FB.NAM==0                       ; NAME SLOT IN TABLE
  46 FB.PTR==1                       ; Pointer to core pages
  47 FB.AGE==2                       ; age,,chain
  48 FB.PGS==3                       ; PTR AND LENGTH OF PAGE IN FILE
  49 FB.AMK==37777777                ; extended address mask
  50 FB.CNT==<-1>#<FB.AMK>           ; page count mask
  51 EOC==400000                     ; END OF PURVEC CHAIN
  52
  53 IFE ITS,[
  54 .FHSLF==400000                  ; THIS FORK
  55 %GJSHT==000001                  ; SHORT FORM GTJFN
  56 %GJOLD==100000
  57         ;PMAP BITS
  58 PM%CNT==400000                  ; PMAP WITH REPEAT COUNT
  59 PM%RD==100000                   ; PMAP WITH READ ACCESS
  60 PM%EX==20000                    ; PMAP WITH EXECUTE ACCESS (NO-OP ON 20X)
  61 PM%CPY==400                     ; PMAP WITH COPY-ON-WRITE ACCESS
  62 PM%WR==40000                    ; PMAP WITH WRITE ACCESS
  63
  64         ;OPENF BITS
  65 OF%RD==200000                   ; OPEN IN READ MODE
  66 OF%WR==100000                   ; OPEN IN WRITE MODE
  67 OF%EX==040000                   ; OPEN IN EXECUTE MODE (TENEX CARES)
  68 OF%THW==02000                   ; OPEN IN THAWED MODE
  69 OF%DUD==00020                   ; DON'T UPDATE THAWED PAGES
  70 ]
  71 ; THIS ROUTINE TAKES A SLOT OFFSET IN REGISTER A AND MAPS IN THE ASSOCIATED
  72 ; FILE. IT CLOBBERS ALL ACs AND SKIP RETURNS IF IT WINS.
  73
  74 OFF==-5                         ; OFFSET INTO PURVEC OF SLOT
  75 NAM==-4                         ; SIXBIT NAME OF THING BEING LOADED
  76 LASTC==-3                       ; LAST CHARACTER OF THE NAME
  77 DIR==-2                         ; SAVED POINTER TO DIRECTORY
  78 SPAG==-1                        ; FIRST PAGE IN FILE
  79 PGNO==0                         ; FIRST PAGE IN CORE
  80 VER==-6                         ; VERSION NUMBER OF MUDDLE TO USE IN OPENING FILES
  81 FLEN==-7                        ; LENGTH OF THE FILE
  82 TEMP==-10                       ; GENERAL TEMPORARY SLOT
  83 WRT==-11                        ; INDICATION IF OPEN IS FOR WRITING OR READING
  84 CADDR==-12                      ; ADDRESS OF CORE IMAGE LOCATION OF FILE
  85 NSLOTS==13
  86
  87 ; IT FIRST LOOKS TO SEE IF IT HAS THE PAGE NUMBER OF THE FILE
  88
  89 PLOAD:  ADD     P,[NSLOTS,,NSLOTS]
  90         SKIPL   P
  91          JRST   PDLOV
  92         MOVEM   A,OFF(P)
  93         PUSH    TP,C%0                  ; [0]
  94         PUSH    TP,C%0          ; [0]
  95 IFE ITS,[
  96         SKIPN   MAPJFN
  97          PUSHJ  P,OPSAV
  98 ]
  99
 100 PLOADX: PUSHJ   P,SQKIL
 101         MOVE    A,OFF(P)
 102         ADD     A,PURVEC+1              ; GET TO SLOT
 103         SKIPE   B,FB.PGS(A)             ; SKIP IF PAGE NUMBER
 104          JRST   GETIT
 105         MOVE    B,FB.NAM(A)
 106         MOVEM   B,NAM(P)
 107         MOVE    0,B
 108         MOVEI   A,6                     ; FIND LAST CHARACTER
 109         TRNE    0,77                    ; SKIP IF NOT DONE
 110          JRST   .+3
 111         LSH     0,-6                    ; BACK A CHAR
 112         SOJG    A,.-3                   ; NOW CHAR IS BACKED OUT
 113         ANDI    0,77            ; LASTCHR
 114         MOVEM   0,LASTC(P)
 115
 116 ; NOT TO TRY TO FIND FILE IN MAIN DATA BASE.
 117 ; THE GC'S WINDOW IS USED IN THIS CASE.
 118
 119 IFN ITS,[
 120         .CALL   MNBLK           ; OPEN CHANNEL TO MAIN FILE
 121          JRST   NTHERE
 122         PUSHJ   P,TRAGN                 ; TRY OPENING UP CHANNEL AGAIN IF POSSIBLE
 123 ]
 124 IFE ITS,[
 125         SKIPN   E,MAPJFN
 126          JRST   NTHERE          ;who cares if no SAV.FILE?
 127         MOVEM   E,DIRCHN
 128 ]
 129         MOVE    D,NAM(P)
 130         MOVE    0,LASTC(P)
 131         PUSHJ   P,GETDIR
 132         MOVEM   E,DIR(P)
 133         PUSHJ   P,GENVN                 ; GET VERSION # AS FIX
 134         MOVE    E,DIR(P)
 135         MOVE    D,NAM(P)
 136         MOVE    A,B
 137         PUSHJ   P,DIRSRC                ; SEARCH DIRECTORY
 138          JRST   NTHERE                  ; GO TRY FIXING UP ITS NOT THERE
 139         ANDI    A,-1                    ; WIN IN MULT SEG CASE
 140         MOVE    B,OFF(P)                ; GET SLOT NUMBER
 141         ADD     B,PURVEC+1              ; POINT TO SLOT
 142         HRRZ    C,1(A)                  ; GET BLOCK NUMBER
 143         HRRM    C,FB.PGS(B)             ; SMASH INTO SLOT
 144         LDB     C,[LNTBYT,,1(A)]        ; SMASH IN LENGTH
 145         HRLM    C,FB.PGS(B)             ; SMASH IN LENGTH
 146         JRST    PLOADX
 147
 148 ; NOW TRY TO FIND FILE IN WORKING DIRECTORY
 149
 150 NTHERE: PUSHJ   P,KILBUF
 151         MOVE    A,OFF(P)                        ; GET POINTER TO PURVEC SLOT
 152         ADD     A,PURVEC+1
 153         PUSHJ   P,GENVN                 ; GET VERSION NUMBER
 154         HRRZM   B,VER(P)
 155         PUSHJ   P,OPMFIL                ; OPEN FILE
 156          JRST   FIXITU
 157
 158 ; NUMBER OF PAGES ARE IN A
 159 ; STARTING PAGE NUMBER IN SPAG(P)
 160
 161 PLOD1:  PUSHJ   P,ALOPAG        ; get the necessary pages
 162          JRST    MAPLS2
 163         MOVE    E,SPAG(P)       ; E starting page in file
 164         MOVEM   B,PGNO(P)
 165 IFN ITS,[
 166         MOVN    A,FLEN(P)       ; get neg count
 167         MOVSI   A,(A)           ; build aobjn pointer
 168         HRR     A,PGNO(P)       ; get page to start
 169         MOVE    B,A             ; save for later
 170         HRRI    0,(E)           ; page pointer for file
 171         DOTCAL  CORBLK,[[1000,,200000],[1000,,-1],A,[1000,,MAPCH],0]
 172          .LOSE  %LSSYS
 173         .CLOSE  MAPCH,          ; no need to have file open anymore
 174 ]
 175 IFE ITS,[
 176         MOVEI   A,(E)           ; First page on rh of A
 177         HRL     A,DIRCHN        ; JFN to lh of A
 178         HRLI    B,.FHSLF        ; specify this fork
 179         MOVSI   C,PM%RD+PM%EX   ; bits for read/execute
 180         MOVE    D,FLEN(P)       ; # of pages to D
 181         HRROI   E,(B)           ; build page aobjn for later
 182         TLC     E,-1(D)         ; sexy way of doing lh
 183
 184         SKIPN   OPSYS
 185          JRST   BLMAP           ; if tops-20 can block PMAP
 186         PMAP
 187         ADDI    A,1
 188         ADDI    B,1
 189         SOJG    D,.-3           ; map 'em all
 190         MOVE    B,E
 191         JRST    PLOAD1
 192
 193 BLMAP:  HRRI    C,(D)
 194         TLO     C,PM%CNT        ; say it is counted
 195         PMAP                    ; one PMAP does the trick
 196         MOVE    B,E
 197 ]
 198 ; now try to smash slot in PURVEC
 199
 200 PLOAD1: MOVE    A,PURVEC+1 ; get pointer to it
 201         ASH     B,PGSHFT        ; convert to aobjn pointer to words
 202         MOVE    C,OFF(P)        ; get slot offset
 203         ADDI    C,(A)           ; point to slot
 204         MOVEM   B,FB.PTR(C)     ; clobber it in
 205         TLZ     B,(FB.CNT)      ; isolate address of page
 206         HRRZ    D,PURVEC        ; get offset into vector for start of chain
 207         TRNE    D,EOC           ; skip if not end marker
 208          JRST   SCHAIN
 209         HRLI    D,400000+A      ; set up indexed pointer
 210         ADDI    D,1
 211 IFN ITS,        HRRZ    0,@D            ; get its address
 212 IFE ITS,[
 213         MOVE    0,@D
 214         TLZ     0,(FB.CNT)
 215 ]
 216         JUMPE   0,SCHAIN        ; no chain exists, start one
 217         CAMLE   0,B             ; skip if new one should be first
 218          AOJA   D,INLOOP        ; jump into the loop
 219
 220         SUBI    D,1             ; undo ADDI
 221 FCLOB:  MOVE    E,OFF(P)        ; get offset for this guy
 222         HRRM    D,FB.AGE(C)             ; link up
 223         HRRM    E,PURVEC        ; store him away
 224         JRST    PLOADD
 225
 226 SCHAIN: MOVEI   D,EOC           ; get end of chain indicator
 227         JRST    FCLOB           ; and clobber it in
 228
 229 INLOOP: MOVE    E,D             ; save in case of later link up
 230         HRR     D,@D            ; point to next table entry
 231         TRNE    D,EOC           ; 400000 is the end of chain bit
 232          JRST   SLFOUN          ; found a slot, leave loop
 233         ADDI    D,1             ; point to address of progs
 234 IFN ITS,        HRRZ    0,@D    ; get address of block
 235 IFE ITS,[
 236         MOVE    0,@D
 237         TLZ     0,(FB.CNT)
 238 ]
 239         CAMLE   0,B             ; skip if still haven't fit it in
 240          AOJA   D,INLOOP        ; back to loop start and point to chain link
 241         SUBI    D,1             ; point back to start of slot
 242
 243 SLFOUN: MOVE    0,OFF(P)                ; get offset into vector of this guy
 244         HRRM    0,@E            ; make previous point to us
 245         HRRM    D,FB.AGE(C)             ; link it in
 246
 247
 248 PLOADD: AOS     -NSLOTS(P)              ; skip return
 249
 250 MAPLOS: SUB     P,[NSLOTS,,NSLOTS]      ; flush stack crap
 251         SUB     TP,C%22
 252         POPJ    P,
 253
 254
 255 MAPLS0: ERRUUO  EQUOTE NO-SAV-FILE
 256         JRST    MAPLOS
 257
 258 MAPLS1: ERRUUO  EQUOTE NO-FIXUP-FILE
 259         JRST    MAPLOS
 260
 261 MAPLS2: ERRUUO  EQUOTE NO-ROOM-AVAILABLE
 262         JRST    MAPLOS
 263
 264 FIXITU:
 265
 266 ;OPEN FIXUP FILE ON MUDSAV
 267
 268 IFN ITS,[
 269         .CALL   FIXBLK          ; OPEN UP FIXUP FILE
 270         PUSHJ   P,TRAGN                 ; SEE IF TOTALLY LOSING
 271 ]
 272 IFE ITS,[
 273         MOVSI   A,%GJSHT                ; GTJFN BITS
 274         HRROI   B,FXSTR
 275         SKIPE   OPSYS
 276          HRROI  B,TFXSTR
 277         GTJFN
 278          FATAL  FIXUP FILE NOT FOUND
 279         MOVEM   A,DIRCHN
 280         MOVE    B,[440000,,OF%RD+OF%EX]
 281         OPENF
 282          FATAL  FIXUP FILE CANT BE OPENED
 283 ]
 284
 285         MOVE    0,LASTC(P)              ; GET DIRECTORY
 286         PUSHJ   P,GETDIR
 287         MOVE    D,NAM(P)
 288         PUSHJ   P,DIRSR1                ; SEARCH DIRECTORY FOR FIXUP
 289          JRST   NOFXUP                  ; NO FIXUP IN MAIN DIRECTORY
 290         ANDI    A,-1                    ; WIN IN MULTI SEGS
 291         HRRZ    A,1(A)                  ; GET BLOCK NUMBER OF START
 292         ASH     A,8.                    ; CONVERT TO WORDS
 293 IFN ITS,[
 294         .ACCES  MAPCH,A                 ; ACCESS FILE
 295 ]
 296
 297 IFE ITS,[
 298         MOVEI   B,(A)
 299         MOVE    A,DIRCHN
 300         SFPTR
 301          JFCL
 302 ]
 303         PUSHJ   P,KILBUF
 304 FIXT1:  PUSHJ   P,RFXUP                 ; READ IN THE FIXUP FILE
 305
 306 IFN ITS,[
 307         .CALL   MNBLK                   ; REOPEN SAV FILE
 308         PUSHJ   P,TRAGN
 309 ]
 310
 311 IFE ITS,[
 312         MOVE    A,MAPJFN                ; SET UP DIRCHAN AGAIN
 313         MOVEM   A,DIRCHN
 314 ]
 315
 316 ; NOW TRY TO LOCATE SAV FILE
 317
 318         MOVE    0,LASTC(P)              ; GET LASTCHR
 319         PUSHJ   P,GETDIR                ; GET DIRECTORY
 320         HRRZ    A,VER(P)                        ; GET VERSION #
 321         MOVE    D,NAM(P)                ; GET NAME OF FILE
 322         PUSHJ   P,DIRSRC                ; SEARCH DIRECTORY
 323          JRST   MAPLS1                  ; NO SAV FILE THERE
 324         ANDI    A,-1
 325         HRRZ    E,1(A)                  ; GET STARTING BLOCK #
 326         LDB     A,[LNTBYT,,1(A)]        ; GET LENGTH INTO A
 327         MOVEM   A,FLEN(P)               ; SAVE LENGTH
 328         MOVEM   E,SPAG(P)               ; SAVE STARTING BLOCK NUMBER
 329         PUSHJ   P,KILBUF
 330         PUSHJ   P,RSAV                  ; READ IN CODE
 331 ; now to do fixups
 332
 333 FXUPGO: MOVE    A,(TP)          ; pointer to them
 334         SETOM   INPLOD          ;  ABSOLUTE CLUDGE TO PREVENT BUFFER FROM
 335                                 ;       SCREWING US
 336 IFE ITS,[
 337         SKIPN   MULTSG
 338          JRST   FIXMLT
 339         HRRZ    D,B             ; this codes gets us running in the correct
 340                                 ;       segment
 341         ASH     D,PGSHFT
 342         HRRI    D,FIXMLT
 343         MOVEI   C,0
 344         XJRST   C               ; good bye cruel segment (will work if we fell
 345                                 ;        into segment 0)
 346 FIXMLT: ASH     B,PGSHFT        ; aobjn to program
 347
 348 FIX1:   SKIPL   E,(A)           ; read one hopefully squoze
 349         FATAL   ATTEMPT TO TYPE FIX PURE
 350         TLZ     E,740000
 351
 352 NOPV1:  PUSHJ   P,SQUTOA        ; look it up
 353         FATAL   BAD FIXUPS
 354
 355 ; N.B. THE VALUE IN THE FIXUPS FOR AN ADDRESS CAN BE NEGATIVE. IF THIS HAPPENS
 356 ; IT MEANS THAT THE LEFT HALF CONTAINS THE VALUE INSTEAD OF THE RIGHT HALF
 357 NOPV2:  AOBJP   A,FIX2
 358         HLRZ    D,(A)           ; get old value
 359         HRRZS   E
 360         SUBM    E,D             ; D is diff between old and new
 361         HRLM    E,(A)           ; fixup the fixups
 362 NOPV3:  MOVEI   0,0             ; flag for which half
 363 FIX4:   JUMPE   0,FIXRH         ; jump if getting rh
 364         MOVEI   0,0             ; next time will get rh
 365         AOBJP   A,FIX2          ; done?
 366         HLRE    C,(A)           ; get lh
 367         JUMPE   C,FIX3          ; 0 terminates
 368 FIX5:   SKIPGE  C               ; If C is negative then left half garbage
 369          JRST   FIX6
 370         ADDI    C,(B)           ; access the code
 371
 372 NOPV4:  ADDM    D,-1(C)         ; and fix it up
 373         JRST    FIX4
 374
 375 ; FOR LEFT HALF CASE
 376
 377 FIX6:   MOVNS   C               ; GET TO ADRESS
 378         ADDI    C,(B)           ; ACCESS TO CODE
 379         HLRZ    E,-1(C)         ; GET OUT WORD
 380         ADDM    D,E             ; FIX IT UP
 381         HRLM    E,-1(C)
 382         JRST    FIX4
 383
 384 FIXRH:  MOVEI   0,1             ; change flag
 385         HRRE    C,(A)           ; get it and
 386         JUMPN   C,FIX5
 387
 388 FIX3:   AOBJN   A,FIX1          ; do next one
 389
 390 IFN SPCFXU,[
 391         MOVE    C,B
 392         PUSHJ   P,SFIX
 393 ]
 394         PUSHJ   P,SQUKIL        ; KILL SQUOZE TABLE
 395         SETZM   INPLOD
 396 FIX2:
 397         HRRZS   VER(P)          ; INDICATE SAV FILE
 398         MOVEM   B,CADDR(P)
 399         PUSHJ   P,GENVN
 400         HRRM    B,VER(P)
 401         PUSHJ   P,OPWFIL
 402          FATAL  MAP FIXUP LOSSAGE
 403 IFN ITS,[
 404         MOVE    B,CADDR(P)
 405         .IOT    MAPCH,B         ; write out the goodie
 406         .CLOSE  MAPCH,
 407         PUSHJ   P,OPMFIL
 408          FATAL  WHERE DID THE FILE GO?
 409         MOVE    E,CADDR(P)
 410         ASH     E,-PGSHFT       ; to page AOBJN
 411         DOTCAL  CORBLK,[[1000,,200000],[1000,,-1],E,[1000,,MAPCH],0]
 412          .LOSE  %LSSYS
 413         .CLOSE  MAPCH,
 414 ]
 415
 416
 417 IFE ITS,[
 418         MOVE    A,DIRCHN        ; GET JFN
 419         MOVE    B,CADDR(P)      ; ready to write it out
 420         HRLI    B,444400
 421         HLRE    C,CADDR(P)
 422         SOUT                    ; zap it out
 423         TLO     A,400000        ; dont recycle the JFN
 424         CLOSF
 425          JFCL
 426         ANDI    A,-1            ; kill sign bit
 427         MOVE    B,[440000,,240000]
 428         OPENF
 429          FATAL MAP FIXUP LOSSAGE
 430         MOVE    B,CADDR(P)
 431         ASH     B,-PGSHFT       ; aobjn to pages
 432         HLRE    D,B             ; -count
 433         HRLI    B,.FHSLF
 434         MOVSI   A,(A)
 435         MOVSI   C,PM%RD+PM%EX
 436         PMAP
 437         ADDI    A,1
 438         ADDI    B,1
 439         AOJN    D,.-3
 440 ]
 441
 442         SKIPGE  MUDSTR+2
 443          JRST   EFIX2           ; exp vers, dont write out
 444 IFE ITS,[
 445         HRRZ    A,SJFNS         ; get last jfn from savxxx file
 446         JUMPE   A,.+4           ; oop
 447          CAME   A,MAPJFN
 448           CLOSF                 ; close it
 449            JFCL
 450         HLLZS   SJFNS           ; zero the slot
 451 ]
 452         MOVEI   0,1             ; INDICATE FIXUP
 453         HRLM    0,VER(P)
 454         PUSHJ   P,OPWFIL
 455          FATAL  CANT WRITE FIXUPS
 456
 457 IFN ITS,[
 458         MOVE    E,(TP)
 459         HLRE    A,E             ; get length
 460         MOVNS   A
 461         ADDI    A,2             ; account for these 2 words
 462         MOVE    0,[-2,,A]       ; write version and length
 463         .IOT    MAPCH,0
 464         .IOT    MAPCH,E         ; out go the fixups
 465         SETZB   0,A
 466         MOVEI   B,MAPCH
 467         .CLOSE  MAPCH,
 468 ]
 469
 470 IFE ITS,[
 471         MOVE    A,DIRCHN
 472         HLRE    B,(TP)          ; length of fixup vector
 473         MOVNS   B
 474         ADDI    B,2             ; for length and version words
 475         BOUT
 476         PUSHJ   P,GENVN
 477         BOUT
 478         MOVSI   B,444400        ; byte pointer to fixups
 479         HRR     B,(TP)
 480         HLRE    C,(TP)
 481         SOUT
 482         CLOSF
 483          JFCL
 484 ]
 485
 486 EFIX2:  MOVE    B,CADDR(P)
 487         ASH     B,-PGSHFT
 488         JRST    PLOAD1
 489
 490 ; Here to try to get a free page block for new thing
 491 ;       A/      # of pages to get
 492
 493 ALOPAG: MOVE    C,GCSTOP        ; FOOL GETPAG
 494         ADDI    C,3777
 495         ASH     C,-PGSHFT
 496         MOVE    B,PURBOT
 497 IFE ITS,[
 498         SKIPN   MULTSG          ; skip if multi-segments
 499          JRST   ALOPA1
 500 ; Compute the "highest" PURBOT (i.e. find the least busy segment)
 501
 502         PUSH    P,E
 503         PUSH    P,A
 504         MOVN    A,NSEGS         ; aobjn pntr to table
 505         HRLZS   A
 506         MOVEI   B,0
 507 ALOPA3: CAML    B,PURBTB(A)     ; if this one is larger
 508          JRST   ALOPA2
 509         MOVE    B,PURBTB(A)     ; use it
 510         MOVEI   E,FSEG(A)       ; and the segment #
 511 ALOPA2: AOBJN   A,ALOPA3
 512         POP     P,A
 513 ]
 514
 515 ALOPA1: ASH     B,-PGSHFT
 516         SUBM    B,C             ; SEE IF ROOM
 517         CAIL    C,(A)
 518          JRST   ALOPGW
 519         PUSHJ   P,GETPAX        ; try to get enough pages
 520 IFE ITS,         JRST   EPOPJ
 521 IFN ITS,         POPJ   P,
 522
 523 ALOPGW:
 524 IFN ITS,        AOS     (P)             ; won skip return
 525 IFE ITS,[
 526         SKIPE   MULTSG
 527          AOS    -1(P)                   ; ret addr
 528         SKIPN   MULTSG
 529          AOS    (P)
 530 ]
 531         MOVE    0,PURBOT
 532 IFE ITS,[
 533         SKIPE   MULTSG
 534          MOVE   0,PURBTB-FSEG(E)
 535 ]
 536         ASH     0,-PGSHFT
 537         SUBI    0,(A)
 538         MOVE    B,0
 539 IFE ITS,[
 540         SKIPN   MULTSG
 541          JRST   ALOPW1
 542         ASH     0,PGSHFT
 543         HRRZM   0,PURBTB-FSEG(E)
 544         ASH     E,PGSHFT                ; INTO POSITION
 545         IORI    B,(E)           ; include segment in address
 546         POP     P,E
 547         JRST    ALOPW2
 548 ]
 549 ALOPW1: ASH     0,PGSHFT
 550 ALOPW2: CAMGE   0,PURBOT
 551          MOVEM  0,PURBOT
 552         CAML    0,P.TOP
 553          POPJ   P,
 554 IFE ITS,[
 555         SUBI    0,1777
 556         ANDCMI  0,1777
 557 ]
 558         MOVEM   0,P.TOP
 559         POPJ    P,
 560
 561 EPOPJ:  SKIPE   MULTSG
 562          POP    P,E
 563         POPJ    P,
 564 IFE ITS,[
 565 GETPAX: TDZA    B,B             ; here if other segs ok
 566 GETPAG: MOVEI   B,1             ; here for only main segment
 567         JRST    @[.+1]          ; run in sect 0
 568         MOVNI   E,1
 569 ]
 570 IFN ITS,[
 571 GETPAX:
 572 GETPAG:
 573 ]
 574         MOVE    C,P.TOP         ; top of GC space
 575         ASH     C,-PGSHFT       ; to page number
 576 IFE ITS,[
 577         SKIPN   MULTSG
 578          JRST   GETPA9
 579         JUMPN   B,GETPA9        ; if really wan all segments,
 580                                 ;       must force all to be  free
 581         PUSH    P,A
 582         MOVN    A,NSEGS         ; aobjn pntr to table
 583         HRLZS   A
 584         MOVE    B,P.TOP
 585 GETPA8: CAMLE   B,PURBTB(A)     ; if this one is larger (or the same)
 586          JRST   GETPA7
 587         MOVE    B,PURBTB(A)     ; use it
 588         MOVEI   E,FSEG(A)       ; and the segment #
 589 GETPA7: AOBJN   A,GETPA8
 590         POP     P,A
 591         JRST    .+2
 592 ]
 593 GETPA9: MOVE    B,PURBOT
 594         ASH     B,-PGSHFT       ; also to pages
 595         SUBM    B,C             ; pages available ==> C
 596         CAMGE   C,A             ; skip if have enough already
 597          JRST   GETPG1          ; no, try to shuffle around
 598         SUBI    B,(A)           ; B/  first new page
 599 CPOPJ1: AOS     (P)
 600 IFN ITS,        POPJ    P,
 601 IFE ITS,[
 602 SPOPJ:  SKIPN   MULTSG
 603          POPJ   P,              ; return with new free page in B
 604                                 ;       (and seg# in E?)
 605         POP     P,21
 606         SETZM   20
 607         XJRST   20
 608 ]
 609 ; Here if shuffle must occur or gc must be done to make room
 610
 611 GETPG1: MOVEI   0,0
 612         SKIPE   NOSHUF          ; if can't shuffle, then ask gc
 613          JRST   ASKAGC
 614         MOVE    0,PURTOP        ; get top of mapped pure area
 615         SUB     0,P.TOP
 616         ASH     0,-PGSHFT       ; to pages
 617         CAMGE   0,A             ; skip if winnage possible
 618          JRST   ASKAGC          ; please AGC give me some room!!
 619         SUBM    A,C             ; C/ amount we must flush to make room
 620
 621 IFE ITS,[
 622         SKIPE   MULTSG          ; if  multi and getting in all segs
 623          JUMPL  E,LPGL1         ; check out each and every segment
 624
 625         PUSHJ   P,GL1
 626
 627         SKIPE   MULTSG
 628          PUSHJ  P,PURTBU        ; update PURBOT in multi case
 629
 630         JRST    GETPAX
 631
 632 LPGL1:  PUSH    P,A
 633         PUSH    P,[FSEG-1]
 634
 635 LPGL2:  AOS     E,(P)           ; count segments
 636         MOVE    B,NSEGS
 637         ADDI    B,FSEG
 638         CAML    E,B
 639          JRST   LPGL3
 640         PUSH    P,C
 641         MOVE    C,PURBOT        ; fudge so look for appropriate amt
 642         SUB     C,PURBTB-FSEG(E)
 643         ASH     C,-PGSHFT       ; to pages
 644         ADD     C,(P)
 645         SKIPLE  C               ; none to flush
 646         PUSHJ   P,GL1
 647         HRRZ    E,-1(P)         ; fet section again
 648         HRRZ    B,PURBOT
 649         HRRZ    C,PURBTB-FSEG(E)        ; lets share with 0 again
 650         SUB     C,B
 651         HRL     B,E             ; get segment
 652         MOVEI   A,(B)
 653         ASH     B,-PGSHFT
 654         ASH     A,-PGSHFT
 655         HRLI    A,.FHSLF
 656         HRLI    B,.FHSLF
 657         ASH     C,-PGSHFT
 658         HRLI    C,PM%CNT+PM%RD+PM%WR+PM%EX
 659         PMAP
 660 LPGL4:  POP     P,C
 661         JRST    LPGL2
 662
 663 LPGL3:  SUB     P,C%11
 664         POP     P,A
 665
 666         SKIPE   MULTSG
 667          PUSHJ  P,PURTBU        ; update PURBOT in multi case
 668
 669         JRST    GETPAG
 670 ]
 671 ; Here to find pages for flush using LRU algorithm (in multi seg mode, only
 672 ;               care about the segment in E)
 673
 674 GL1:    MOVE    B,PURVEC+1      ; get pointer to pure sr vector
 675         MOVEI   0,-1            ; get very large age
 676
 677 GL2:    SKIPL   FB.PTR(B)       ; skip if not already flushed
 678          JRST   GL3
 679 IFE ITS,[
 680         SKIPN   MULTSG
 681          JRST   GLX
 682         LDB     D,[220500,,FB.PTR(B)]   ; get segment #
 683         CAIE    D,(E)
 684          JRST   GL3             ; wrong swegment, ignore
 685 ]
 686 GLX:    HLRZ    D,FB.AGE(B)     ; get this ones age
 687         CAMLE   D,0             ; skip if this is a candidate
 688          JRST   GL3
 689         MOVE    F,B             ; point to table entry with E
 690         MOVEI   0,(D)           ; and use as current best
 691 GL3:    ADD     B,[ELN,,ELN]    ; look at next
 692         JUMPL   B,GL2
 693
 694         HLRE    B,FB.PTR(F)     ; get length of flushee
 695         ASH     B,-PGSHFT       ; to negative # of pages
 696         ADD     C,B             ; update amount needed
 697 IFN ITS,SETZM   FB.PTR(F)       ; indicate it will be gone
 698 IFE ITS,MOVNS   FB.PTR(F)       ; save page info for flushing pages
 699         JUMPG   C,GL1           ; jump if more to get
 700
 701 ; Now compact pure space
 702
 703         PUSH    P,A             ; need all acs
 704         HRRZ    D,PURVEC        ; point to first in core addr order
 705         HRRZ    C,PURTOP
 706 IFE ITS,[
 707         SKIPE   MULTSG
 708          HRLI   C,(E)           ; adjust for segment
 709 ]
 710         ASH     C,-PGSHFT       ; to page number
 711         SETZB   F,A
 712
 713 CL1:    ADD     D,PURVEC+1      ; to real pointer
 714         SKIPGE  FB.PTR(D)       ; skip if this one is a flushee
 715          JRST   CL2             ; this one stays
 716
 717 IFE ITS,[
 718         PUSH    P,C
 719         PUSH    P,D
 720         HRRZ    C,FB.PGS(D)     ; is this from SAV FILE?
 721         JUMPN   C,CLFOUT        ; yes.  don't bother flushing pages
 722         MOVN    C,FB.PTR(D)     ; get aobjn pointer to code in C
 723         SETZM   FB.PTR(D)       ; and flush this because it works (sorry)
 724         ASH     C,-PGSHFT       ; pages speak louder than words
 725         HLRE    D,C             ; # of pages saved here for unmap
 726         HRLI    C,.FHSLF        ; C now contains myfork,,lowpage
 727         MOVE    A,C             ; put that in A for RMAP
 728         RMAP                    ; A now contains JFN in left half
 729         MOVE    B,C             ; ac roulette: get fork,,page into B for PMAP
 730         HLRZ    C,A             ; hold JFN in C for future CLOSF
 731         MOVNI   A,1             ; say this page to be unmapped
 732 CLFLP:  PMAP                    ; do the unmapping
 733         ADDI    B,1             ; next page
 734         AOJL    D,CLFLP         ; continue for all pages
 735         MOVE    A,C             ; restore JFN
 736         CLOSF                   ; and close it, throwing away the JFN
 737          JFCL                   ; should work in 95/100 cases
 738 CLFOU1: POP     P,D             ; fatal error if can't close
 739         POP     P,C
 740 ]
 741         HRRZ    D,FB.AGE(D)     ; point to next one in chain
 742         JUMPN   F,CL3           ; jump if not first one
 743         HRRM    D,PURVEC        ; and use its next as first
 744         JRST    CL4
 745
 746 IFE ITS,[
 747 CLFOUT: SETZM   FB.PTR(D)       ; zero the code pointer
 748         JRST    CLFOU1
 749 ]
 750
 751 CL3:    HRRM    D,FB.AGE(F)     ; link up
 752         JRST    CL4
 753
 754 ; Found a stayer, move it if necessary
 755
 756 CL2:
 757 IFE ITS,[
 758         SKIPN   MULTSG
 759          JRST   CL9
 760         LDB     F,[220500,,FB.PTR(D)]   ; check segment
 761         CAIE    E,(F)
 762          JRST   CL6X            ; no other segs move at all
 763 ]
 764 CL9:    MOVEI   F,(D)           ; another pointer to slot
 765         HLRE    B,FB.PTR(D)     ; - length of block
 766 IFE ITS,[
 767         TRZ     B,<-1>#<(FB.CNT)>
 768         MOVE    D,FB.PTR(D)     ; pointer to block
 769         TLZ     D,(FB.CNT)      ; kill count bits
 770 ]
 771 IFN ITS,        HRRZ    D,FB.PTR(D)
 772         SUB     D,B             ; point to top of block
 773         ASH     D,-PGSHFT       ; to page number
 774         CAMN    D,C             ; if not moving, jump
 775          JRST   CL6
 776
 777         ASH     B,-PGSHFT       ; to pages
 778 IFN ITS,[
 779 CL5:    SUBI    C,1             ; move to pointer and from pointer
 780         SUBI    D,1
 781         DOTCAL  CORBLK,[[1000,,200000],[1000,,-1],C,[1000,,-1],D]
 782          .LOSE  %LSSYS
 783         AOJL    B,CL5           ; count down
 784 ]
 785 IFE ITS,[
 786         PUSH    P,B             ; save # of pages
 787         MOVEI   A,-1(D)         ; copy from pointer
 788         HRLI    A,.FHSLF        ; get this fork code
 789         RMAP                    ; get a JFN (hopefully)
 790         EXCH    D,(P)           ; D # of pages (save from)
 791         ADDM    D,(P)           ; update from
 792         MOVEI   B,-1(C)         ; to pointer in B
 793         HRLI    B,.FHSLF
 794         MOVSI   C,PM%RD+PM%EX   ; read/execute modes
 795
 796         SKIPN   OPSYS
 797          JRST   CCL1
 798         PMAP                    ; move a page
 799         SUBI    A,1
 800         SUBI    B,1
 801         AOJL    D,.-3           ; move them all
 802         AOJA    B,CCL2
 803
 804 CCL1:   TLO     C,PM%CNT
 805         MOVNS   D
 806         SUBI    B,-1(D)
 807         SUBI    A,-1(D)
 808         HRRI    C,(D)
 809         PMAP
 810
 811 CCL2:   MOVEI   C,(B)
 812         POP     P,D
 813 ]
 814 ; Update the table address for this loser
 815
 816         SUBM    C,D             ; compute offset (in pages)
 817         ASH     D,PGSHFT        ; to words
 818         ADDM    D,FB.PTR(F)     ; update it
 819 CL7:    HRRZ    D,FB.AGE(F)     ; chain on
 820 CL4:    TRNN    D,EOC           ; skip if end of chain
 821          JRST   CL1
 822
 823         ASH     C,PGSHFT        ; to words
 824 IFN ITS,        MOVEM   C,PURBOT        ; reset pur bottom
 825 IFE ITS,[
 826         SKIPN   MULTSG
 827          JRST   CLXX
 828
 829         HRRZM   C,PURBTB-FSEG(E)
 830         CAIA
 831 CLXX:   MOVEM   C,PURBOT        ; reset pur bottom
 832 ]
 833         POP     P,A
 834         POPJ    P,
 835
 836 IFE ITS,[
 837 CL6X:   MOVEI   F,(D)           ; chain on
 838         JRST    CL7
 839 ]
 840 CL6:
 841 IFN ITS,        HRRZ    C,FB.PTR(F)     ; get new top of world
 842 IFE ITS,[
 843         MOVE    C,FB.PTR(F)
 844         TLZ     C,(FB.CNT)
 845 ]
 846         ASH     C,-PGSHFT       ; to page #
 847         JRST    CL7
 848
 849 IFE ITS,[
 850 PURTBU: PUSH    P,A
 851         PUSH    P,B
 852
 853         MOVN    B,NSEGS
 854         HRLZS   B
 855         MOVE    A,PURTOP
 856
 857 PURTB2: CAMGE   A,PURBTB(B)
 858          JRST   PURTB1
 859         MOVE    A,PURBTB(B)
 860         MOVEM   A,PURBOT
 861 PURTB1: AOBJN   B,PURTB2
 862
 863         POP     P,B
 864         POP     P,A
 865         POPJ    P,
 866 ]
 867
 868 \f; SUBR to create an entry in the vector for one of these guys
 869
 870 MFUNCTION PCODE,SUBR
 871
 872         ENTRY   2
 873
 874         GETYP   0,(AB)          ; check 1st arg is string
 875         CAIE    0,TCHSTR
 876          JRST   WTYP1
 877         GETYP   0,2(AB)         ; second must be fix
 878         CAIE    0,TFIX
 879          JRST   WTYP2
 880
 881         MOVE    A,(AB)          ; convert name of program to sixbit
 882         MOVE    B,1(AB)
 883         PUSHJ   P,STRTO6
 884 PCODE4: MOVE    C,(P)           ; get name in sixbit
 885
 886 ; Now look for either this one or an empty slot
 887
 888         MOVEI   E,0
 889         MOVE    B,PURVEC+1
 890
 891 PCODE2: CAMN    C,FB.NAM(B)     ; skip if this is not it
 892          JRST   PCODE1          ; found it, drop out of loop
 893         JUMPN   E,.+3           ; dont record another empty if have one
 894         SKIPN   FB.NAM(B)               ; skip if slot filled
 895          MOVE   E,B             ; remember pointer
 896         ADD     B,[ELN,,ELN]
 897         JUMPL   B,PCODE2        ; jump if more to look at
 898
 899         JUMPE   E,PCODE3        ; if E=0, error no room
 900         MOVEM   C,FB.NAM(E)     ; else stash away name and zero rest
 901         SETZM   FB.PTR(E)
 902         SETZM   FB.AGE(E)
 903         CAIA
 904 PCODE1:  MOVE   E,B             ; build <slot #>,,<offset>
 905         MOVEI   0,0             ; flag whether new slot
 906         SKIPE   FB.PTR(E)       ; skip if mapped already
 907          MOVEI  0,1
 908         MOVE    B,3(AB)
 909         HLRE    D,E
 910         HLRE    E,PURVEC+1
 911         SUB     D,E
 912         HRLI    B,(D)
 913         MOVSI   A,TPCODE
 914         SKIPN   NOSHUF          ; skip if not shuffling
 915          JRST   FINIS
 916         JUMPN   0,FINIS         ; jump if winner
 917         PUSH    TP,A
 918         PUSH    TP,B
 919         HLRZ    A,B
 920         PUSHJ   P,PLOAD
 921          JRST   PCOERR
 922         POP     TP,B
 923         POP     TP,A
 924         JRST    FINIS
 925
 926 PCOERR: ERRUUO  EQUOTE PURE-LOAD-FAILURE
 927
 928 PCODE3: HLRE    A,PURVEC+1      ; get current length
 929         MOVNS   A
 930         ADDI    A,10*ELN        ; add 10(8) more entry slots
 931         PUSHJ   P,IBLOCK
 932         EXCH    B,PURVEC+1      ; store new one and get old
 933         HLRE    A,B             ; -old length to A
 934         MOVSI   B,(B)           ; start making BLT pointer
 935         HRR     B,PURVEC+1
 936         SUBM    B,A             ; final dest to A
 937 IFE ITS,        HRLI    A,-1            ; force local index
 938         BLT     B,-1(A)
 939         JRST    PCODE4
 940
 941 ; Here if must try to GC for some more core
 942
 943 ASKAGC: SKIPE   GCFLG           ; if already in GC, lose
 944 IFN ITS,         POPJ   P,
 945 IFE ITS,         JRST   SPOPJ
 946         MOVEM   A,0             ; amount required to 0
 947         ASH     0,PGSHFT        ; TO WORDS
 948         MOVEM   0,GCDOWN        ; pass as funny arg to AGC
 949         EXCH    A,C             ; save A from gc's destruction
 950 IFN ITS,.IOPUSH MAPCH,          ; gc uses same channel
 951         PUSH    P,C
 952         SETOM   PLODR
 953         MOVE    C,[8,,9.]       ; SET UP INDICATORS FOR GC
 954         PUSHJ   P,AGC
 955         SETZM   PLODR
 956         POP     P,C
 957 IFN ITS,.IOPOP  MAPCH,
 958         EXCH    C,A
 959 IFE ITS,[
 960         JUMPL   C,.+3
 961         JUMPL   E,GETPAG
 962         JRST    GETPAX
 963 ]
 964 IFN ITS,        JUMPGE  C,GETPAG
 965          ERRUUO EQUOTE NO-MORE-PAGES
 966
 967 ; Here to clean up pure space by flushing all shared stuff
 968
 969 PURCLN: SKIPE   NOSHUF
 970          POPJ   P,
 971         MOVEI   B,EOC
 972         HRRM    B,PURVEC        ; flush chain pointer
 973         MOVE    B,PURVEC+1      ; get pointer to table
 974 CLN1:   SETZM   FB.PTR(B)       ; zero pointer entry
 975         SETZM   FB.AGE(B)       ; zero link and age slots
 976         SETZM   FB.PGS(B)
 977         ADD     B,[ELN,,ELN]    ; go to next slot
 978         JUMPL   B,CLN1          ; do til exhausted
 979         MOVE    B,PURBOT        ; now return pages
 980         SUB     B,PURTOP        ; compute page AOBJN pointer
 981 IFE ITS,        SETZM   MAPJFN          ; make sure zero mapjfn
 982         JUMPE   B,CPOPJ         ; no pure pages?
 983         MOVSI   B,(B)
 984         HRR     B,PURBOT
 985         ASH     B,-PGSHFT
 986 IFN ITS,[
 987         DOTCAL  CORBLK,[[1000,,0],[1000,,-1],B]
 988          .LOSE  %LSSYS
 989 ]
 990 IFE ITS,[
 991
 992         SKIPE   MULTSG
 993          JRST   CLN2
 994         HLRE    D,B             ; - # of pges to flush
 995         HRLI    B,.FHSLF        ; specify hacking hom fork
 996         MOVNI   A,1
 997         MOVEI   C,0
 998
 999         PMAP
1000         ADDI    B,1
1001         AOJL    D,.-2
1002 ]
1003
1004         MOVE    B,PURTOP        ; now fix up pointers
1005         MOVEM   B,PURBOT        ;   to indicate no pure
1006 CPOPJ:  POPJ    P,
1007
1008 IFE ITS,[
1009 CLN2:   HLRE    C,B             ; compute pos no. pages
1010         HRLI    B,.FHSLF
1011         MOVNS   C
1012         MOVNI   A,1             ; flushing pages
1013         HRLI    C,PM%CNT
1014         MOVE    D,NSEGS
1015         MOVE    E,PURTOP        ; for munging table
1016         ADDI    B,<FSEG>_9.     ; do it to the correct segment
1017         PMAP
1018         ADDI    B,1_9.          ; cycle through segments
1019         HRRZM   E,PURBTB(D)     ; mung table
1020         SOJG    D,.-3
1021
1022         MOVEM   E,PURBOT
1023         POPJ    P,
1024 ]
1025
1026 ; Here to move the entire pure space.
1027 ;       A/      # and direction of pages to move (+ ==> up)
1028
1029 MOVPUR: SKIPE   NOSHUF
1030          FATAL  CANT MOVE PURE SPACE AROUND
1031 IFE ITS,ASH     A,1
1032         SKIPN   B,A             ; zero movement, ignore call
1033          POPJ   P,
1034
1035         ASH     B,PGSHFT        ; convert to words for pointer update
1036         MOVE    C,PURVEC+1      ; loop through updating non-zero entries
1037         SKIPE   1(C)
1038          ADDM   B,1(C)
1039         ADD     C,[ELN,,ELN]
1040         JUMPL   C,.-3
1041
1042         MOVE    C,PURTOP        ; found pages at top and bottom of pure
1043         ASH     C,-PGSHFT
1044         MOVE    D,PURBOT
1045         ASH     D,-PGSHFT
1046         ADDM    B,PURTOP        ; update to new boundaries
1047         ADDM    B,PURBOT
1048 IFE ITS,[
1049         SKIPN   MULTSG          ; in multi-seg mode, must mung whole table
1050          JRST   MOVPU1
1051         MOVN    E,NSEGS
1052         HRLZS   E
1053         ADDM    PURBTB(E)
1054         AOBJN   E,.-1
1055 ]
1056 MOVPU1: CAIN    C,(D)           ; differ?
1057          POPJ   P,
1058         JUMPG   A,PUP           ; if moving up, go do separate CORBLKs
1059
1060 IFN ITS,[
1061         SUBM    D,C             ; -size of area to C (in pages)
1062         MOVEI   E,(D)           ; build pointer to bottom of destination
1063         ADD     E,A
1064         HRLI    E,(C)
1065         HRLI    D,(C)
1066         DOTCAL  CORBLK,[[1000,,200000],[1000,,-1],E,[1000,,-1],D]
1067          .LOSE  %LSSYS
1068         POPJ    P,
1069
1070 PUP:    SUBM    C,D             ; pages to move to D
1071         ADDI    A,(C)           ; point to new top
1072
1073 PUPL:   SUBI    C,1
1074         SUBI    A,1
1075         DOTCAL  CORBLK,[[1000,,200000],[1000,,-1],A,[1000,,-1],C]
1076          .LOSE  %LSSYS
1077         SOJG    D,PUPL
1078         POPJ    P,
1079 ]
1080 IFE ITS,[
1081         SUBM    D,C             ; pages to move to D
1082         MOVSI   E,(C)           ; build aobjn pointer
1083         HRRI    E,(D)           ; point to lowest
1084         ADD     D,A             ; D==> new lowest page
1085         MOVEI   F,0             ; seg info
1086         SKIPN   MULTSG
1087          JRST   XPLS3
1088         MOVEI   F,FSEG-1
1089         ADD     F,NSEGS
1090         ASH     F,9.
1091 XPLS3:  MOVE    G,E
1092         MOVE    H,D             ; save for outer loop
1093
1094 PURCL1: MOVSI   A,.FHSLF                ; specify here
1095         HRRI    A,(E)           ; get a page
1096         IORI    A,(F)           ; hack seg i
1097         RMAP                    ; get a real handle on it
1098         MOVE    B,D             ; where to go
1099         HRLI    B,.FHSLF
1100         MOVSI   C,PM%RD+PM%EX
1101         IORI    A,(F)
1102         PMAP
1103         ADDI    D,1
1104         AOBJN   E,PURCL1
1105         SKIPN   MULTSG
1106          POPJ   P,
1107         SUBI    F,1_9.
1108         CAIGE   F,FSEG_9.
1109          POPJ   P,
1110         MOVE    E,G
1111         MOVE    D,H
1112         JRST    PURCL1
1113
1114 PUP:    SUB     D,C             ; - count to D
1115         MOVSI   E,(D)           ; start building AOBJN
1116         HRRI    E,(C)           ; aobjn to top
1117         ADD     C,A             ; C==> new top
1118         MOVE    D,C
1119         MOVEI   F,0             ; seg info
1120         SKIPN   MULTSG
1121          JRST   XPLS31
1122         MOVEI   F,FSEG
1123         ADD     F,NSEGS
1124         ASH     F,9.
1125 XPLS31: MOVE    G,E
1126         MOVE    H,D             ; save for outer loop
1127
1128 PUPL:   MOVSI   A,.FHSLF
1129         HRRI    A,(E)
1130         IORI    A,(F)           ; segment
1131         RMAP                    ; get real handle
1132         MOVE    B,D
1133         HRLI    B,.FHSLF
1134         IORI    B,(F)
1135         MOVSI   C,PM%RD+PM%EX
1136         PMAP
1137         SUBI    E,2
1138         SUBI    D,1
1139         AOBJN   E,PUPL
1140         SKIPN   MULTSG
1141          POPJ   P,
1142         SUBI    F,1_9.
1143         CAIGE   F,FSEG_9.
1144          POPJ   P,
1145         MOVE    E,G
1146         MOVE    D,H
1147         JRST    PUPL
1148
1149         POPJ    P,
1150 ]
1151 IFN ITS,[
1152 .GLOBAL CSIXBT
1153 CSIXBT: MOVEI   0,5
1154         PUSH    P,[440700,,C]
1155         PUSH    P,[440600,,D]
1156         MOVEI   D,0
1157 CSXB2:  ILDB    E,-1(P)
1158         CAIN    E,177
1159         JRST    CSXB1
1160         SUBI    E,40
1161         IDPB    E,(P)
1162         SOJG    0,CSXB2
1163 CSXB1:  SUB     P,C%22
1164         MOVE    C,D
1165         POPJ    P,
1166 ]
1167 GENVN:  MOVE    C,[440700,,MUDSTR+2]
1168         MOVEI   D,5
1169         MOVEI   B,0
1170 VNGEN:  ILDB    0,C
1171         CAIN    0,177
1172          POPJ   P,
1173         IMULI   B,10.
1174         SUBI    0,60
1175         ADD     B,0
1176         SOJG    D,VNGEN
1177         POPJ    P,
1178
1179 IFE ITS,[
1180 MSKS:   774000,,0
1181         777760,,0
1182         777777,,700000
1183         777777,,777400
1184         777777,,777776
1185 ]
1186
1187 \f; THESE ARE DIRECTORY SEARCH ROUTINES
1188
1189
1190 ; THIS ROUTINE DOES A BINARY SEARCH ON A DIRECTORY AND RETURNS A POINTER
1191 ; RESTED DOWN TO THE APPROPRIATE SLOT IN THE DIRECTORY.
1192 ; ARGS: E==DIR POINTER D==FILE-NAME 1 A==VERSION #
1193 ; RETS: A==RESTED DOWN DIRECTORY
1194
1195 DIRSR1: TLOA    0,400000                ; INDICATION OF ONE ARGUMENT SEARCH
1196 DIRSRC:  TLZ    0,400000                ; INDICATOR OF 2 ARGUMENT SEARCH
1197         PUSH    P,A                     ; SAVE VERSION #
1198         HLRE    B,E                     ; GET LENGTH INTO B
1199         MOVNS   B
1200         MOVE    A,E
1201         HRLS    B                       ; GET BOTH SIDES
1202 UP:     ASH     B,-1                    ; HALVE TABLE
1203         AND     B,[-2,,-2]              ; FORCE DIVIS BY 2
1204         MOVE    C,A                     ; COPY POINTER
1205         JUMPLE  B,LSTHLV                ; CANT GET SMALLER
1206         ADD     C,B
1207 IFE ITS,        HRRZ    F,C             ; avoid lossage in multi-sections
1208 IFN ITS,        CAMLE   D,(C)           ; SKIP IF EITHER FOUND OR IN TOP
1209 IFE ITS,        CAMLE   D,(F)           ; SKIP IF EITHER FOUND OR IN TOP
1210          MOVE    A,C                    ; POINT TO SECOND HALF
1211 IFN ITS,        CAMN    D,(C)           ; SKIP IF NOT FOUND
1212 IFE ITS,        CAMN    D,(F)           ; SKIP IF NOT FOUND
1213          JRST    WON
1214 IFN ITS,        CAML    D,(C)           ; SKIP IF IN TOP HALF
1215 IFE ITS,        CAML    D,(F)           ; SKIP IF IN TOP HALF
1216          JRST    UP
1217         HLLZS   C                       ; FIX UP POINTER
1218         SUB     A,C
1219         JRST    UP
1220
1221 WON:    JUMPL   0,SUPWIN
1222         MOVEI   0,0                     ; DOWN FLAG
1223 WON1:   LDB     A,[221200,,1(C)]        ; GET VERSION NUMBER
1224         CAMN    A,(P)                   ; SKIP IF NOT EQUAL
1225          JRST   SUPWIN
1226         CAMG    A,(P)                   ; SKIP IF LT
1227          JRST   SUBIT
1228         SETO    0,
1229         SUB     C,C%22                  ; GET NEW C
1230         JRST    SUBIT1
1231
1232 SUBIT:  ADD     C,C%22                  ; SUBTRACT
1233         JUMPN   0,C1POPJ
1234 SUBIT1:
1235 IFN ITS,        CAMN    D,(C)           ; SEE WHETHER WERE STILL WINNING
1236 IFE ITS,[
1237         HRRZ    F,C
1238         CAMN    D,(F)
1239 ]
1240          JRST   WON1
1241 C1POPJ: SUB     P,C%11                  ; GET RID OF VERSION #
1242         POPJ    P,                      ; LOSE LOSE LOSE
1243 SUPWIN: MOVE    A,C                     ; RETURN ARGUMENT IN A
1244         AOS     -1(P)                   ; SKIP RETURN INDICATES IT WAS FOUND
1245         JRST    C1POPJ
1246
1247 LSTHLV:
1248 IFN ITS,        CAMN    D,(C)           ; LINEAR SEARCH REST
1249 IFE ITS,[
1250         HRRZ    F,C
1251         CAMN    D,(F)           ; LINEAR SEARCH REST
1252 ]
1253          JRST    WON
1254         ADD     C,C%22
1255         JUMPL   C,LSTHLV
1256         JRST    C1POPJ
1257
1258 \f; ROUTINE TO GET A DIRECTORY. ASSUMES MAPCH IS OPEN TO FIXUP OR SAV FILE AND 0 IS THE
1259 ; LAST CHAR TO BE HASHED. RETURNS POINTER TO DIRECTORY IN E
1260
1261 IFN ITS,[
1262 GETDIR: PUSH    P,C
1263         PUSH    P,0
1264         PUSHJ   P,SQKIL
1265         MOVEI   A,1                     ; GET A BUFFER
1266         PUSHJ   P,GETBUF
1267         MOVEI   C,(B)
1268         ASH     C,-10.
1269         DOTCAL  CORBLK,[[RDTP],[FME],C,[1000,,MAPCH],[1000,,0]]
1270         PUSHJ   P,SLEEPR
1271         POP     P,0
1272         IDIV    0,(B)                   ; A NOW CONTAINS THE DIRECTORY NUMBER
1273         ADDI    A,1(B)
1274         DOTCAL  CORBLK,[[RDTP],[FME],C,[1000,,MAPCH],(A)]
1275         PUSHJ   P,SLEEPR
1276         MOVN    E,(B)                   ; GET -LENGTH OF DIRECTORY
1277         HRLZS   E                       ; BUILD AOBJN PTR TO DIR
1278         HRRI    E,1(B)
1279         POP     P,C
1280         POPJ    P,
1281 ]
1282 ; IN WONDERFUL TOPS20 VERSION DIRCHN CONTAINS THE JFN
1283
1284 IFE ITS,[
1285 GETDIR: JRST    @[.+1]
1286         PUSH    P,C
1287         PUSH    P,0
1288         PUSHJ   P,SQKIL
1289         MOVEI   A,1                     ; GET A BUFFER
1290         PUSHJ   P,GETBUF
1291         HRROI   E,(B)
1292         ASH     B,-9.
1293         HRLI    B,.FHSLF                        ; SET UP DESTINATION (CORE)
1294         MOVS    A,DIRCHN                ; SET UP SOURCE (FILE)
1295         MOVSI   C,PM%RD+PM%EX           ; READ+EXEC ACCESS
1296         PMAP
1297         POP     P,0
1298         IDIV    0,(E)                   ; A NOW CONTAINS THE DIRECTORY NUMBER
1299         ADDI    A,1(E)                  ; POINT TO THE DIRECTORY ENTRY
1300         MOVE    A,(A)                   ; GET THE PAGE NUMBER
1301         HRL     A,DIRCHN                ; SET UP SOURCE (FILE)
1302         PMAP                            ; AGAIN READ IN DIRECTORY
1303         MOVEI   A,(E)
1304         MOVN    E,(E)                   ; GET -LENGTH OF DIRECTORY
1305         HRLZS   E                       ; BUILD AOBJN PTR TO DIR
1306         HRRI    E,1(A)
1307         POP     P,C
1308         SKIPN   MULTSG
1309          POPJ   P,
1310         POP     P,21
1311         SETZM   20
1312         XJRST   20
1313 ]
1314 ; HERE IF CAN'T FIND FIXUP FILE IN MAIN DIRECTORY
1315
1316 NOFXUP:
1317 IFE ITS,[
1318         MOVE    A,DIRCHN                ; JFN FOR FIXUP FILE
1319         CLOSF                           ; CLOSE IT
1320          JFCL
1321 ]
1322         MOVE    A,FXTBL                 ; GET AOBJN POINTER TO FIXUP TABLE
1323 NOFXU1: HRRZ    B,(A)                   ; GET VERSION TO TRY
1324         HRRM    B,VER(P)                ; STUFF IN VERSION
1325         MOVEI   B,1                     ; DUMP IN FIXUP INDICATOR
1326         HRLM    B,VER(P)
1327         MOVEM   A,TEMP(P)               ; SAVE POINTER TO FXTBL
1328         PUSHJ   P,OPXFIL                ; LOOK FOR FIXUP FILE
1329          JRST   NOFXU2
1330         PUSHJ   P,RFXUP                 ; READ IN THE FIXUP FILE
1331         HRRZS   VER(P)                  ; INDICATE SAV FILE
1332         PUSHJ   P,OPXFIL                ; TRY OPENING IT
1333          JRST   MAPLS0                  ; GIVE UP NO SAV FILE TO BE HAD
1334         PUSHJ   P,RSAV
1335         JRST    FXUPGO                  ; GO FIXUP THE WORLD
1336 NOFXU2: MOVE    A,TEMP(P)               ; GET BACK POINTER
1337         AOBJN   A,NOFXU1                ; TRY NEXT
1338         JRST    MAPLS1                  ; NO FILE TO BE HAD
1339
1340 GETIT:  HRRZM   B,SPAG(P)               ; GET BLOCK OF START
1341         HLRZM   B,FLEN(P)               ; DAMMIT SAVE THIS!
1342         HLRZ    A,B                     ; GET LENGTH\r
1343 IFN ITS,[
1344         .CALL   MNBLK
1345         PUSHJ   P,TRAGN
1346 ]
1347 IFE ITS,[
1348         MOVE    E,MAPJFN
1349         MOVEM   E,DIRCHN
1350 ]
1351
1352         JRST    PLOD1
1353
1354 ; ROUTINE TO SEE IF FILE IS NOT OPEN BECAUSE OF FNF AND FATAL IF SO
1355
1356 IFN ITS,[
1357 TRAGN:  PUSH    P,0             ; SAVE 0
1358         .STATUS MAPCH,0         ; GET STATUS BITS
1359         LDB     0,[220600,,0]
1360         CAIN    0,4             ; SKIP IF NOT FNF
1361          FATAL  MAJOR FILE NOT FOUND
1362         POP     P,0
1363         SOS     (P)
1364         SOS     (P)             ; RETRY OPEN
1365         POPJ    P,
1366 ]
1367 IFE ITS,[
1368 OPSAV:  MOVSI   A,%GJSHT+%GJOLD ; BITS FOR GTJFN
1369         HRROI   B,SAVSTR        ; STRING POINTER
1370         SKIPE   OPSYS
1371          HRROI  B,TSAVST
1372         GTJFN
1373          FATAL  CANT FIND SAV FILE
1374         MOVEM   A,MAPJFN        ; STORE THE JFN
1375         MOVE    B,[440000,,OF%RD+OF%EX+OF%THW+OF%DUD]
1376         OPENF
1377          FATAL  CANT OPEN SAV FILE
1378         POPJ    P,
1379 ]
1380
1381 ; OPMFIL IS USED TO OPEN A FILE ON MUDTMP.  IT CAN OPEN EITHER A SAV OR FIXUP FILE
1382 ; AND THE VERSION NUMBER IS SPECIFIED.  THE ARGUMENTS ARE
1383 ; NAM-1(P) HAS SIXBIT OF FILE NAME
1384 ; VER-1(P) HAS 0,,VERSION # FOR SAV FILE AND 1,,VERSION# FOR FIXUP FILE
1385 ; RETURNS LENGTH OF FILE IN SLEN AND
1386
1387 ; OPXFIL IS A KLUDGE FOR GETTING SAV AND FIXUP FILES OFF OF THE MDLLIB
1388 ; DIRECTORY DURING THE CHANGEOVER TO PRE- AND POST- MUDSAV WORLDS
1389
1390 OPXFIL: MOVEI   0,1
1391         MOVEM   0,WRT-1(P)
1392         JRST    OPMFIL+1
1393
1394 OPWFIL: SETOM   WRT-1(P)
1395         SKIPA
1396 OPMFIL:  SETZM  WRT-1(P)
1397
1398 IFN ITS,[
1399         HRRZ    C,VER-1(P)              ; GET VERSION NUMBER
1400         PUSHJ   P,NTOSIX                ; CONVERT TO SIXBIT
1401         HRLI    C,(SIXBIT /SAV/)        ; BUILD SECOND FILE NAME
1402         HLRZ    0,VER-1(P)
1403         SKIPE   0                       ; SKIP IF SAV
1404          HRLI   C,(SIXBIT/FIX/)
1405         MOVE    B,NAM-1(P)              ; GET NAME
1406         MOVSI   A,7                     ; WRITE MODE
1407         SKIPL   WRT-1(P)
1408          MOVSI  A,6                     ; READ MODE
1409 RETOPN: .CALL   FOPBLK
1410          JRST   OPCHK                   ; SEE IF FIXUP IS NECESSARY OR JUST REOPENING
1411         DOTCAL  FILLEN,[[1000,,MAPCH],[2000,,A]]
1412          .LOSE  1000
1413         ADDI    A,PGMSK                 ; ROUND
1414         ASH     A,-PGSHFT               ; TO PAGES
1415         MOVEM   A,FLEN-1(P)
1416         SETZM   SPAG-1(P)
1417         AOS     (P)                     ; SKIP RETURN TO SHOW SUCCESS
1418         POPJ    P,
1419
1420 OPCHK: .STATUS  MAPCH,0                 ; GET STATUS BITS
1421         LDB     0,[220600,,0]
1422         CAIE    0,4                     ; SKIP IF FNF
1423          JRST   OPCHK1                  ; RETRY
1424         POPJ    P,
1425
1426 OPCHK1: MOVEI   0,1                     ; SLEEP FOR A WHILE
1427         .SLEEP
1428         JRST    OPCHK
1429
1430 ; NTOSIX GETS NUMBER IN C AND CONVERTS IT TO SIXBIT AND RETURNS RESULT IN C
1431
1432 NTOSIX: PUSH    P,A                     ; SAVE A AND B
1433         PUSH    P,B
1434         PUSH    P,D
1435         MOVE    D,[220600,,C]
1436         MOVEI   A,(C)                   ; GET NUMBER
1437         MOVEI   C,0
1438         IDIVI   A,100.                  ; GET RESULT OF DIVISION
1439         SKIPN   A
1440          JRST   ALADD
1441         ADDI    A,20                    ; CONVERT TO DIGIT
1442         IDPB    A,D
1443 ALADD:  MOVEI   A,(B)
1444         IDIVI   A,10.                   ; GET TENS DIGIT
1445         SKIPN   C
1446          SKIPE  A                       ; IF BOTH 0 BLANK DIGIT
1447           ADDI  A,20
1448         IDPB    A,D
1449         SKIPN   C
1450          SKIPE  B
1451           ADDI  B,20
1452         IDPB    B,D
1453         POP     P,D
1454         POP     P,B
1455         POP     P,A
1456         POPJ    P,
1457
1458 ]
1459
1460 IFE ITS,[
1461         MOVE    E,P             ; save pdl base
1462         MOVE    B,NAM-1(E)              ; GET FIRST NAME
1463         PUSH    P,C%0           ; [0]; slots for building strings
1464         PUSH    P,C%0           ; [0]
1465         MOVE    A,[440700,,1(E)]
1466         MOVE    C,[440600,,B]
1467
1468 ; DUMP OUT SIXBIT NAME
1469
1470         MOVEI   D,6
1471         ILDB    0,C
1472         JUMPE   0,.+4           ; violate cardinal ".+ rule"
1473         ADDI    0,40            ; to ASCII
1474         IDPB    0,A
1475         SOJG    D,.-4
1476
1477         MOVE    0,[ASCII /  SAV/]
1478         HLRZ    C,VER-1(E)              ; GET SAV/FIXUP FLAG
1479         SKIPE   C
1480          MOVE   0,[ASCII /  FIX/]
1481         PUSH    P,0
1482         HRRZ    C,VER-1(E)              ; get ascii of vers no.
1483         PUSHJ   P,NTOSEV        ; CONVERT TO STRING LEFT JUSTIFIED
1484         PUSH    P,C
1485         MOVEI   B,-1(P)         ; point to it
1486         HRLI    B,260700
1487         HRROI   D,1(E)          ; point to name
1488         MOVEI   A,1(P)
1489         MOVSI   0,100000        ; INPUT FILE (GJ%OLD)
1490         SKIPGE  WRT-1(E)
1491          MOVSI  0,400000        ; OUTPUT FILE (GJ%FOU)
1492         PUSH    P,0
1493         PUSH    P,[377777,,377777]
1494         MOVE    0,[-1,,[ASCIZ /DSK/]]
1495         SKIPN   OPSYS
1496          MOVE   0,[-1,,[ASCIZ /PS/]]
1497         PUSH    P,0
1498         HRROI   0,[ASCIZ /MDL/]
1499         SKIPLE  WRT-1(E)
1500          HRROI  0,[ASCIZ /MDLLIB/]      ; USE MDLLIB FOR SPECIAL CASE
1501         PUSH    P,0
1502         PUSH    P,D
1503         PUSH    P,B
1504         PUSH    P,C%0           ; [0]
1505         PUSH    P,C%0           ; [0]
1506         PUSH    P,C%0           ; [0]
1507         MOVEI   B,0
1508         MOVE    D,4(E)          ; save final version string
1509         GTJFN
1510          JRST   OPMLOS          ; FAILURE
1511         MOVEM   A,DIRCHN
1512         MOVE    B,[440000,,OF%RD+OF%EX]
1513         SKIPGE  WRT-1(E)
1514          MOVE   B,[440000,,OF%RD+OF%WR]
1515         OPENF
1516          FATAL  OPENF FAILED
1517         MOVE    P,E             ; flush crap
1518         PUSH    P,A
1519         SIZEF                   ; get length
1520          JRST   MAPLOS
1521         SKIPL   WRT-1(E)
1522          MOVEM  C,FLEN-1(E)     ; ONLY SAVE LENGTH FOR READ JFNS
1523         SETZM   SPAG-1(E)
1524
1525 ; RESTORE STACK AND LEAVE
1526
1527         MOVE    P,E
1528         MOVE    A,C             ; NUMBER OF PAGES IN A, DAMN!
1529         AOS     (P)
1530         POPJ    P,
1531
1532 OPMLOS: MOVE    P,E
1533         POPJ    P,
1534
1535 ; CONVERT A NUMBER IN C TO AN ASCII STRING LEFT JUSTIFIED IN C
1536
1537 NTOSEV: PUSH    P,A                     ; SAVE A AND B
1538         PUSH    P,B
1539         PUSH    P,D
1540         MOVE    D,[440700,,C]
1541         MOVEI   A,(C)                   ; GET NUMBER
1542         MOVEI   C,0
1543         IDIVI   A,100.                  ; GET RESULT OF DIVISION
1544         JUMPE   A,ALADD
1545         ADDI    A,60                    ; CONVERT TO DIGIT
1546         IDPB    A,D
1547 ALADD:  MOVEI   A,(B)
1548         IDIVI   A,10.                   ; GET TENS DIGIT
1549         ADDI    A,60
1550         IDPB    A,D
1551 ALADD1: ADDI    B,60
1552         IDPB    B,D
1553         POP     P,D
1554         POP     P,B
1555         POP     P,A
1556         POPJ    P,
1557
1558 ]
1559
1560 ; ROUTINE TO READ IN THE FIXUPS FROM DIRCHN OR MAPCH WORKS
1561 ; FOR FIXUP FILE OR FIXUPS IN A SEPERATE FILE AS LONG AS THE
1562 ; CHANNEL IS OPENED AND ACCESSED TO THE RIGHT PLACE
1563
1564 RFXUP:
1565 IFN ITS,[
1566         MOVE    0,[-2,,A]               ; PREPARE TO READ VERSION AND LENGTH
1567         .IOT    MAPCH,0                 ; READ IT IN
1568         SKIPGE  0                       ; SKIP IF NOT HIT EOF
1569         FATAL   BAD FIXUP FILE
1570         MOVEI   A,-2(A)                 ; COUNT FOR FIRST 2 WORDS
1571         HRRM    B,VER-1(P)              ; SAVE VERSION #
1572         .IOPUS  MAPCH,                  ; PUSH THE MAPPING CHANNEL
1573         SETOM   PLODR
1574         PUSHJ   P,IBLOCK                ; GET A UVECTOR OF APPROPRIATE SIZE
1575         SETZM   PLODR
1576         .IOPOP  MAPCH,
1577         MOVE    0,$TUVEC
1578         MOVEM   0,-1(TP)                ; SAVE UVECTOR
1579         MOVEM   B,(TP)
1580         MOVE    A,B                     ; GET AOBJN POINTER TO UVECTOR FOR IOT
1581         .IOT    MAPCH,A                 ; GET FIXUPS
1582         .CLOSE  MAPCH,
1583         POPJ    P,
1584 ]
1585
1586 IFE ITS,[
1587         MOVE    A,DIRCHN
1588         BIN                             ; GET LENGTH OF FIXUP
1589         MOVE    C,B
1590         MOVE    A,DIRCHN
1591         BIN                             ; GET VERSION NUMBER
1592         HRRM    B,VER-1(P)
1593         SETOM   PLODR
1594         MOVEI   A,-2(C)
1595         PUSHJ   P,IBLOCK
1596         SETZM   PLODR
1597         MOVSI   0,$TUVEC
1598         MOVEM   0,-1(TP)
1599         MOVEM   B,(TP)
1600         MOVE    A,DIRCHN
1601         HLRE    C,B
1602 ;       SKIPE   OPSYS           ; SKIP IF TOPS20 SINCE C MUST BE NEGETIVE
1603 ;        MOVNS  C               ; C IS POSITIVE FOR TENEX ?????
1604         HRLI    B,444400
1605         SIN
1606         MOVE    A,DIRCHN
1607         CLOSF
1608          FATAL  CANT CLOSE FIXUP FILE
1609         RLJFN
1610          JFCL
1611         POPJ    P,
1612 ]
1613
1614 ; ROUTINE TO READ IN THE CODE
1615
1616 RSAV:   MOVE    A,FLEN-1(P)
1617         PUSHJ   P,ALOPAG                ; GET PAGES
1618         JRST    MAPLS2
1619         MOVE    E,SPAG-1(P)
1620
1621 IFN ITS,[
1622         MOVN    A,FLEN-1(P)     ; build aobjn pointer
1623         MOVSI   A,(A)
1624         HRRI    A,(B)
1625         MOVE    B,A
1626         HRRI    0,(E)
1627         DOTCAL  CORBLK,[[1000,,104000],[1000,,-1],A,[1000,,MAPCH],0]
1628          .LOSE  %LSSYS
1629         .CLOSE  MAPCH,
1630         POPJ    P,
1631 ]
1632 IFE ITS,[
1633         PUSH    P,B             ; SAVE PAGE #
1634         MOVS    A,DIRCHN        ; SOURCE (MUDSAV)
1635         HLRM    A,SJFNS         ; SAVE POINTER FOR FUTURE CLOSING
1636         HRR     A,E
1637         HRLI    B,.FHSLF        ; DESTINATION (FORK)
1638         MOVSI   C,PM%RD+PM%CPY  ; MAKE COPY ON WRITE
1639         SKIPE   OPSYS
1640          JRST   RSAV1           ; HANDLE TENEX
1641         TLO     C,PM%CNT        ; REPEAT COUNT BIT FOR TOPS20
1642         HRR     C,FLEN-2(P)     ; PAGE (FOR PUSHJ AND PUSHED B)
1643         PMAP
1644 RSAVDN: POP     P,B
1645         MOVN    0,FLEN-1(P)
1646         HRL     B,0
1647         POPJ    P,
1648
1649 RSAV1:  HRRZ    D,FLEN-2(P)     ; GET IN PAGE COUNT
1650 RSAV2:  PMAP
1651         ADDI    A,1             ; NEXT PAGE
1652         ADDI    B,1
1653         SOJN    D,RSAV2         ; LOOP
1654         JRST    RSAVDN
1655 ]
1656
1657 PDLOV:  SUB     P,[NSLOTS,,NSLOTS]
1658         PUSH    P,C%0           ; [0]; CAUSE A PDL OVERFLOW
1659         JRST    .-1
1660
1661 ; CONSTANTS RELATED TO DATA BASE
1662 DEV:    SIXBIT /DSK/
1663 MODE:   6,,0
1664 MNDIR:  SIXBIT /MUDSAV/                         ; DIR OF MAIN DATA BASE FILES
1665 WRKDIR: SIXBIT /MUDTMP/                         ; DIRECTORY OF UPDATE FILES
1666
1667 IFN ITS,[
1668 MNBLK:  SETZ
1669         SIXBIT /OPEN/
1670         MODE
1671         DEV
1672         [SIXBIT /SAV/]
1673         [SIXBIT /FILE/]
1674         SETZ MNDIR
1675
1676
1677 FIXBLK: SETZ
1678         SIXBIT /OPEN/
1679         MODE
1680         DEV
1681         [SIXBIT /FIXUP/]
1682         [SIXBIT /FILE/]
1683         SETZ MNDIR
1684
1685 FOPBLK: SETZ
1686         SIXBIT /OPEN/
1687         A
1688         DEV
1689         B
1690         C
1691         SETZ WRKDIR
1692
1693 FXTBL:  -2,,.+1
1694         55.
1695         54.
1696 ]
1697 IFE ITS,[
1698
1699 FXSTR:  ASCIZ /PS:<MDL>FIXUP.FILE/
1700 SAVSTR: ASCIZ /PS:<MDL>SAV.FILE/
1701 TFXSTR: ASCIZ /DSK:<MDL>FIXUP.FILE/
1702 TSAVST: ASCIZ /DSK:<MDL>SAV.FILE/
1703
1704 FXTBL:  -3,,.+1
1705         55.
1706         54.
1707         104.
1708 ]
1709 IFN SPCFXU,[
1710
1711 ;This code does two things to code for FBIN;
1712 ;       1)      Makes dispatches win in multi seg mode
1713 ;       2)      Makes OBLIST? work with "new" atom format
1714 ;       3)      Makes LENGTH win in multi seg mode
1715 ;       4)      Gets AOBJN pointer to code vector in C
1716
1717 SFIX:   PUSH    P,A
1718         PUSH    P,B
1719         PUSH    P,C             ; for referring back
1720
1721 SFIX1:  MOVSI   B,-MLNT         ; for looping through tables
1722
1723 SFIX2:  MOVE    A,(C)           ; get code word
1724
1725         AND     A,SMSKS(B)
1726         CAMN    A,SPECS(B)      ; do we match
1727          JRST   @SFIXR(B)
1728
1729         AOBJN   B,SFIX2
1730
1731 SFIX3:  AOBJN   C,SFIX1         ; do all of code
1732 SFIX4:  POP     P,C
1733         POP     P,B
1734         POP     P,A
1735         POPJ    P,
1736
1737 SMSKS:  -1
1738         777000,,-1
1739         -1,,0
1740         777037,,0
1741 MLNT==.-SMSKS
1742
1743 SPECS:  HLRES   A               ; begin of arg diaptch table
1744         SKIPN   2               ; old compiled OBLIST?
1745         JRST    (M)             ; compiled LENGTH
1746         ADDI    (M)             ; begin a case dispatch
1747
1748 SFIXR:  SETZ    DFIX
1749         SETZ    OBLFIX
1750         SETZ    LFIX
1751         SETZ    CFIX
1752
1753 DFIX:   AOBJP   C,SFIX4         ; make sure dont run out
1754         MOVE    A,(C)           ; next ins
1755         CAME    A,[ASH A,-1]    ; still winning?
1756          JRST   SFIX3           ; false alarm
1757         AOBJP   C,SFIX4         ; make sure dont run out
1758         HLRZ    A,(C)           ; next ins
1759         CAIE    A,(ADDI A,(M))  ; still winning?
1760          JRST   SFIX3           ; false alarm
1761         AOBJP   C,SFIX4
1762         HLRZ    A,(C)
1763         CAIE    A,(PUSHJ P,@(A))        ; last one to check
1764          JRST   SFIX3
1765         AOBJP   C,SFIX4
1766         MOVE    A,(C)
1767         CAME    A,[JRST FINIS]          ; extra check
1768          JRST   SFIX3
1769
1770         MOVSI   B,(SETZ)
1771 SFIX5:  AOBJP   C,SFIX4
1772         HLRZ    A,(C)
1773         CAIN    A,(SUBM M,(P))
1774          JRST   SFIX3
1775         CAIE    A,M                     ; dispatch entry?
1776          JRST   SFIX3           ; maybe already fixed
1777         IORM    B,(C)           ; fix it
1778         JRST    SFIX5
1779
1780 OBLFIX: PUSH    P,[-TLN,,TPTR]
1781         PUSH    P,C
1782         MOVE    B,-1(P)
1783
1784 OBLFXY: PUSH    P,1(B)
1785         PUSH    P,(B)
1786
1787 OBLFI1: AOBJP   C,OBLFXX
1788         MOVE    A,(C)
1789         AOS     B,(P)
1790         AND     A,(B)
1791         MOVE    B,-1(P)
1792         CAME    A,(B)
1793          JRST   OBLFXX
1794         AOBJP   B,DOOBFX
1795         MOVEM   B,-1(P)
1796         JRST    OBLFI1
1797
1798 OBLFXX: SUB     P,C%22          ; for checking more ins
1799         MOVE    B,-1(P)
1800         ADD     B,C%22
1801         JUMPGE  B,OBLFX1
1802         MOVEM   B,-1(P)
1803         MOVE    C,(P)
1804         JRST    OBLFXY
1805
1806
1807 INSBP==331100                   ; byte pointer for ins field
1808 ACBP==270400                    ; also for ac
1809 INDXBP==220400
1810
1811 DOOBFX: MOVE    C,-2(P)
1812         SUB     P,C%44
1813         MOVEI   B,<<(HRRZ)>_<-9>>       ; change em
1814         DPB     B,[INSBP,,(C)]  ; SKIPN==>HRRZ
1815         LDB     A,[ACBP,,(C)]   ; get AC field
1816         MOVEI   B,<<(JUMPE)>_<-9>>
1817         DPB     B,[INSBP,,1(C)]
1818         DPB     A,[ACBP,,1(C)]
1819         AOS     1(C)            ; JRST FOO==>JUMPE ac,FOO+1
1820         MOVE    B,[CAMG VECBOT]
1821         DPB     A,[ACBP,,B]
1822         MOVEM   B,2(C)          ; JUMPL ==> CAMG ac,VECBOT
1823         HRRZ    A,3(C)          ; get indicator of existence of ADD AC,TVP
1824         CAIE    A,TVP           ; skip if extra ins exists
1825          JRST   NOATVP
1826         MOVSI   A,(JFCL)
1827         EXCH    A,4(C)
1828         MOVEM   A,3(C)
1829         ADD     C,C%11
1830 NOATVP: TLC     B,(CAMG#HRLI)   ; change CAMG to HRLI (preserving AC)
1831         HRRZ    A,4(C)          ; see if moves in type
1832         CAIE    A,$TOBLS
1833          SUB    C,[1,,1]        ; fudge it
1834         HLLOM   B,5(C)          ; in goes HRLI -1
1835         CAIE    A,$TOBLS        ; do we need a skip?
1836          JRST   NOOB$
1837         MOVSI   B,(CAIA)        ;  skipper
1838         EXCH    B,6(C)
1839         MOVEM   B,7(C)
1840         ADD     C,[7,,7]
1841         JRST    SFIX3
1842
1843 NOOB$:  MOVSI   B,(JFCL)
1844         MOVEM   B,6(C)
1845         ADD     C,C%66
1846         JRST    SFIX3
1847
1848 OBLFX1: MOVE    C,(P)
1849         SUB     P,C%22
1850         JRST    SFIX3
1851
1852 ; Here to fixup compiled LENGTH
1853
1854 LFIX:   MOVSI   B,-LLN          ; for checking other LENGTH ins
1855         PUSH    P,C
1856
1857 LFIX1:  AOBJP   C,LFIXY
1858         MOVE    A,(C)
1859         AND     A,LMSK(B)
1860         CAME    A,LINS(B)
1861          JRST   LFIXY
1862         AOBJN   B,LFIX1
1863
1864         POP     P,C             ; restore code pointer
1865         MOVE    A,(C)           ; save jump for its addr
1866         MOVE    B,[MOVSI 400000]
1867         MOVEM   B,(C)           ; JRST .+2 ==> MOVSI 0,400000
1868         LDB     B,[ACBP,,1(C)]  ; B==> AC of interest
1869         ADDI    A,2
1870         DPB     B,[ACBP,,A]
1871         MOVEI   B,<<(JUMPE)>_<-9.>>
1872         DPB     B,[INSBP,,A]
1873         EXCH    A,1(C)
1874         TLC     A,(HRR#HRRZ)    ; HRR==>HRRZ
1875         HLLZM   A,2(C)          ; TRNN AC,-1 ==> HRRZ AC,(AC)
1876         MOVEI   B,(AOBJN (M))
1877         HRLM    B,3(C)          ; AOBJP AC,.-2 ==> AOBJN 0,.-2
1878         MOVE    B,2(C)          ; get HRRZ AC,(AC)
1879         TLZ     B,17            ; kill (AC) part
1880         MOVEM   B,4(C)          ; HLRZS AC ==> HRRZ AC,0
1881         ADD     C,C%44
1882         JRST    SFIX3
1883
1884 LFIXY:  POP     P,C
1885         JRST    SFIX3
1886
1887 ; Fixup a CASE dispatch
1888
1889  CFIX:  LDB     A,[ACBP,,(C)]
1890         AOBJP   C,SFIX4
1891         HLRZ    B,(C)           ; Next ins
1892         ANDI    B,777760
1893         CAIE    B,(JRST @)
1894          JRST   SFIX3
1895         LDB     B,[INDXBP,,(C)]
1896         CAIE    A,(B)
1897          JRST   SFIX3
1898         MOVE    A,(C)           ; ok, fix it up
1899         TLZ     A,20            ; kill indirection
1900         MOVEM   A,(C)
1901         HRRZ    B,-1(C)         ; point to table
1902         ADD     B,(P)           ; point to code to change
1903
1904 CFIXLP: HLRZ    A,(B)           ; check one out
1905         TRZ     A,400000        ; kill bit
1906         CAIE    A,M             ; check for just index (or index with SETZ)
1907          JRST   SFIX3
1908         MOVEI   A,(JRST (M))
1909         HRLM    A,(B)
1910         AOJA    B,CFIXLP
1911
1912 DEFINE FOO LBL,LNT,LBL2,L
1913 LBL:
1914         IRP A,,[L]
1915                 IRP B,C,[A]
1916                         B
1917                         .ISTOP
1918                 TERMIN
1919         TERMIN
1920 LNT==.-LBL
1921 LBL2:
1922         IRP A,,[L]
1923                 IRP B,C,[A]
1924                         C
1925                         .ISTOP
1926                 TERMIN
1927         TERMIN
1928 TERMIN
1929
1930 IMSK==777017,,0
1931 AIMSK==777000,,-1
1932
1933 FOO OINS,OLN,OMSK,[[<JRST (M)>,IMSK],[<JUMPL (M)>,IMSK],[MOVE,AIMSK]
1934                    [<MOVE $TOBLS>,AIMSK],[<JRST (M)>,IMSK]
1935                    [<MOVE $TFALSE>,AIMSK],[MOVEI,AIMSK]]
1936
1937 FOO OINS3,OLN3,OMSK3,[[<JRST (M)>,IMSK],[<JUMPL (M)>,IMSK],[MOVE,AIMSK]
1938                       [<JRST (M)>,IMSK],[MOVEI,AIMSK]]
1939
1940 FOO OINS2,OLN2,OMSK2,[[<JRST (M)>,IMSK],[<JUMPL (M)>,IMSK],[<ADD TVP>,AIMSK]
1941                       [MOVE,AIMSK],[<MOVE $TOBLS>,AIMSK],[<JRST (M)>,IMSK]
1942                       [<MOVE $TFALSE>,AIMSK],[MOVEI,AIMSK]]
1943
1944 FOO OINS4,OLN4,OMSK4,[[<JRST (M)>,IMSK],[<JUMPL (M)>,IMSK],[<ADD TVP>,AIMSK]
1945                       [MOVE,AIMSK],[<JRST (M)>,IMSK],[MOVEI,AIMSK]]
1946
1947 TPTR:   -OLN,,OINS
1948         OMSK-1
1949         -OLN2,,OINS2
1950         OMSK2-1
1951         -OLN3,,OINS3
1952         OMSK3-1
1953         -OLN4,,OINS4
1954         OMSK4-1
1955 TLN==.-TPTR
1956
1957 FOO LINS,LLN,LMSK,[[<HRR -1>,AIMSK],[<TRNE -1>,AIMSK],[<AOBJP (M)>,IMSK]
1958                    [<HLRZS>,<-1,,777760>]]
1959
1960 ]
1961 IMPURE
1962
1963 SAVSNM: 0                                       ; SAVED SNAME
1964 INPLOD: 0                                       ; FLAG SAYING WE ARE IN MAPPUR
1965
1966 IFE ITS,[
1967 MAPJFN: 0                                       ; JFN OF <MDL>SAV FILE
1968 DIRCHN: 0                                       ; JFN USED BY GETDIR
1969 ]
1970
1971 PURE
1972
1973 END
1974