<mdl.int>/mappur.163

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