<mdl.int>/mappur.mid.146

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