Twenex Muddle.
[pdp10-muddle.git] / <mdl.int> / mappur.mid.146
diff --git a/<mdl.int>/mappur.mid.146 b/<mdl.int>/mappur.mid.146
new file mode 100644 (file)
index 0000000..3d0015e
--- /dev/null
@@ -0,0 +1,1928 @@
+
+TITLE MAPURE-PAGE LOADER
+
+RELOCATABLE
+
+MAPCH==0                       ; channel for MAPing
+XJRST==JRST 5,
+
+.GLOBAL PURVEC,PURTOP,PURBOT,P.TOP,GCSTOP,FRETOP,MUDSTR,STRTO6,PLOAD,AGC,GCDOWN
+.GLOBAL SQUTOA,IGVAL,IBLOCK,PURCLN,MOVPUR,GETPAG,GCFLG,NOSHUF,DIR,NDIRS,SQUPNT
+.GLOBAL PLODR,SQUKIL,GETBUF,KILBUF,INPLOD,SQKIL,PVSTOR,TVSTOR,DSTOREM,SLEEPR
+.GLOBAL OPSYS,SJFNS,MULTSG,PURBTB,SFIX,NSEGS
+.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
+.GLOBAL C%M20,C%M30,C%M40,C%M60
+
+.INSRT MUDDLE >
+SPCFXU==1
+SYSQ
+
+IFE ITS,[
+IF1, .INSRT STENEX >
+]
+
+F==PVP
+G==TVP
+H==SP
+RDTP==1000,,200000
+FME==1000,,-1
+
+
+IFN ITS,[
+PGMSK==1777
+PGSHFT==10.
+]
+
+IFE ITS,[
+FLUSHP==0
+PGMSK==777
+PGSHFT==9.
+]
+
+LNTBYT==340700
+ELN==4                         ; LENGTH OF SLOT
+FB.NAM==0                      ; NAME SLOT IN TABLE
+FB.PTR==1                      ; Pointer to core pages
+FB.AGE==2                      ; age,,chain
+FB.PGS==3                      ; PTR AND LENGTH OF PAGE IN FILE
+FB.AMK==37777777               ; extended address mask
+FB.CNT==<-1>#<FB.AMK>          ; page count mask
+EOC==400000                    ; END OF PURVEC CHAIN
+
+IFE ITS,[
+.FHSLF==400000                 ; THIS FORK
+%GJSHT==000001                 ; SHORT FORM GTJFN
+%GJOLD==100000
+       ;PMAP BITS
+PM%CNT==400000                 ; PMAP WITH REPEAT COUNT
+PM%RD==100000                  ; PMAP WITH READ ACCESS
+PM%EX==20000                   ; PMAP WITH EXECUTE ACCESS (NO-OP ON 20X)
+PM%CPY==400                    ; PMAP WITH COPY-ON-WRITE ACCESS
+PM%WR==40000                   ; PMAP WITH WRITE ACCESS
+
+       ;OPENF BITS
+OF%RD==200000                  ; OPEN IN READ MODE
+OF%WR==100000                  ; OPEN IN WRITE MODE
+OF%EX==040000                  ; OPEN IN EXECUTE MODE (TENEX CARES)
+OF%THW==02000                  ; OPEN IN THAWED MODE
+OF%DUD==00020                  ; DON'T UPDATE THAWED PAGES
+]
+; THIS ROUTINE TAKES A SLOT OFFSET IN REGISTER A AND MAPS IN THE ASSOCIATED
+; FILE. IT CLOBBERS ALL ACs AND SKIP RETURNS IF IT WINS.
+
+OFF==-5                                ; OFFSET INTO PURVEC OF SLOT
+NAM==-4                                ; SIXBIT NAME OF THING BEING LOADED
+LASTC==-3                      ; LAST CHARACTER OF THE NAME
+DIR==-2                                ; SAVED POINTER TO DIRECTORY
+SPAG==-1                       ; FIRST PAGE IN FILE
+PGNO==0                                ; FIRST PAGE IN CORE 
+VER==-6                                ; VERSION NUMBER OF MUDDLE TO USE IN OPENING FILES
+FLEN==-7                       ; LENGTH OF THE FILE
+TEMP==-10                      ; GENERAL TEMPORARY SLOT
+WRT==-11                       ; INDICATION IF OPEN IS FOR WRITING OR READING
+CADDR==-12                     ; ADDRESS OF CORE IMAGE LOCATION OF FILE
+NSLOTS==13
+
+; IT FIRST LOOKS TO SEE IF IT HAS THE PAGE NUMBER OF THE FILE
+
+PLOAD: ADD     P,[NSLOTS,,NSLOTS]
+       SKIPL   P
+        JRST   PDLOV
+       MOVEM   A,OFF(P)
+       PUSH    TP,C%0                  ; [0]
+       PUSH    TP,C%0          ; [0]
+IFE ITS,[
+       SKIPN   MAPJFN
+        PUSHJ  P,OPSAV
+]
+
+PLOADX:        PUSHJ   P,SQKIL
+       MOVE    A,OFF(P)
+       ADD     A,PURVEC+1              ; GET TO SLOT
+       SKIPE   B,FB.PGS(A)             ; SKIP IF PAGE NUMBER
+        JRST   GETIT
+       MOVE    B,FB.NAM(A)
+       MOVEM   B,NAM(P)
+       MOVE    0,B
+       MOVEI   A,6                     ; FIND LAST CHARACTER
+       TRNE    0,77                    ; SKIP IF NOT DONE
+        JRST   .+3
+       LSH     0,-6                    ; BACK A CHAR
+       SOJG    A,.-3                   ; NOW CHAR IS BACKED OUT
+       ANDI    0,77            ; LASTCHR
+       MOVEM   0,LASTC(P)
+
+; NOT TO TRY TO FIND FILE IN MAIN DATA BASE.
+; THE GC'S WINDOW IS USED IN THIS CASE.
+
+IFN ITS,[
+       .CALL   MNBLK           ; OPEN CHANNEL TO MAIN FILE
+        JRST   NTHERE
+       PUSHJ   P,TRAGN                 ; TRY OPENING UP CHANNEL AGAIN IF POSSIBLE
+]
+IFE ITS,[
+       SKIPN   E,MAPJFN
+        JRST   NTHERE          ;who cares if no SAV.FILE?
+       MOVEM   E,DIRCHN
+]
+       MOVE    D,NAM(P)
+       MOVE    0,LASTC(P)
+       PUSHJ   P,GETDIR
+       MOVEM   E,DIR(P)
+       PUSHJ   P,GENVN                 ; GET VERSION # AS FIX
+       MOVE    E,DIR(P)
+       MOVE    D,NAM(P)
+       MOVE    A,B
+       PUSHJ   P,DIRSRC                ; SEARCH DIRECTORY
+        JRST   NTHERE                  ; GO TRY FIXING UP ITS NOT THERE
+       ANDI    A,-1                    ; WIN IN MULT SEG CASE
+       MOVE    B,OFF(P)                ; GET SLOT NUMBER
+       ADD     B,PURVEC+1              ; POINT TO SLOT
+       HRRZ    C,1(A)                  ; GET BLOCK NUMBER
+       HRRM    C,FB.PGS(B)             ; SMASH INTO SLOT
+       LDB     C,[LNTBYT,,1(A)]        ; SMASH IN LENGTH
+       HRLM    C,FB.PGS(B)             ; SMASH IN LENGTH
+       JRST    PLOADX
+
+; NOW TRY TO FIND FILE IN WORKING DIRECTORY
+
+NTHERE:        PUSHJ   P,KILBUF
+       MOVE    A,OFF(P)                        ; GET POINTER TO PURVEC SLOT
+       ADD     A,PURVEC+1
+       PUSHJ   P,GENVN                 ; GET VERSION NUMBER
+       HRRZM   B,VER(P)
+       PUSHJ   P,OPMFIL                ; OPEN FILE
+        JRST   FIXITU
+       
+; NUMBER OF PAGES ARE IN A
+; STARTING PAGE NUMBER IN SPAG(P)
+
+PLOD1: PUSHJ   P,ALOPAG        ; get the necessary pages
+         JRST    MAPLS2
+       MOVE    E,SPAG(P)       ; E starting page in file
+       MOVEM   B,PGNO(P)
+IFN ITS,[
+        MOVN    A,FLEN(P)      ; get neg count
+        MOVSI   A,(A)           ; build aobjn pointer
+        HRR     A,PGNO(P)       ; get page to start
+        MOVE    B,A             ; save for later
+       HRRI    0,(E)           ; page pointer for file
+        DOTCAL CORBLK,[[1000,,200000],[1000,,-1],A,[1000,,MAPCH],0]
+         .LOSE %LSSYS
+        .CLOSE  MAPCH,          ; no need to have file open anymore
+]
+IFE ITS,[
+       MOVEI   A,(E)           ; First page on rh of A
+       HRL     A,DIRCHN        ; JFN to lh of A
+       HRLI    B,.FHSLF        ; specify this fork
+       MOVSI   C,PM%RD+PM%EX   ; bits for read/execute
+       MOVE    D,FLEN(P)       ; # of pages to D
+       HRROI   E,(B)           ; build page aobjn for later
+       TLC     E,-1(D)         ; sexy way of doing lh
+
+       SKIPN   OPSYS
+        JRST   BLMAP           ; if tops-20 can block PMAP
+       PMAP
+       ADDI    A,1
+       ADDI    B,1
+       SOJG    D,.-3           ; map 'em all
+       MOVE    B,E
+       JRST    PLOAD1
+
+BLMAP: HRRI    C,(D)
+       TLO     C,PM%CNT        ; say it is counted
+       PMAP                    ; one PMAP does the trick
+       MOVE    B,E
+]
+; now try to smash slot in PURVEC
+
+PLOAD1:        MOVE    A,PURVEC+1 ; get pointer to it
+        ASH     B,PGSHFT        ; convert to aobjn pointer to words
+       MOVE    C,OFF(P)        ; get slot offset
+        ADDI    C,(A)           ; point to slot
+        MOVEM   B,FB.PTR(C)    ; clobber it in
+        TLZ    B,(FB.CNT)      ; isolate address of page
+        HRRZ    D,PURVEC       ; get offset into vector for start of chain
+       TRNE    D,EOC           ; skip if not end marker
+        JRST   SCHAIN
+        HRLI    D,400000+A      ; set up indexed pointer
+        ADDI    D,1
+IFN ITS,        HRRZ    0,@D            ; get its address
+IFE ITS,[
+       MOVE    0,@D
+       TLZ     0,(FB.CNT)
+]
+       JUMPE   0,SCHAIN        ; no chain exists, start one
+       CAMLE   0,B             ; skip if new one should be first
+        AOJA   D,INLOOP        ; jump into the loop
+
+       SUBI    D,1             ; undo ADDI
+FCLOB: MOVE    E,OFF(P)        ; get offset for this guy
+       HRRM    D,FB.AGE(C)             ; link up
+       HRRM    E,PURVEC        ; store him away
+       JRST    PLOADD
+
+SCHAIN:        MOVEI   D,EOC           ; get end of chain indicator
+       JRST    FCLOB           ; and clobber it in
+
+INLOOP:        MOVE    E,D             ; save in case of later link up
+       HRR     D,@D            ; point to next table entry
+       TRNE    D,EOC           ; 400000 is the end of chain bit
+        JRST   SLFOUN          ; found a slot, leave loop
+       ADDI    D,1             ; point to address of progs
+IFN ITS,       HRRZ    0,@D    ; get address of block
+IFE ITS,[
+       MOVE    0,@D
+       TLZ     0,(FB.CNT)
+]
+       CAMLE   0,B             ; skip if still haven't fit it in
+        AOJA   D,INLOOP        ; back to loop start and point to chain link
+       SUBI    D,1             ; point back to start of slot
+
+SLFOUN:        MOVE    0,OFF(P)                ; get offset into vector of this guy
+       HRRM    0,@E            ; make previous point to us
+       HRRM    D,FB.AGE(C)             ; link it in
+
+
+PLOADD:        AOS     -NSLOTS(P)              ; skip return
+
+MAPLOS:        SUB     P,[NSLOTS,,NSLOTS]      ; flush stack crap
+       SUB     TP,C%22
+       POPJ    P,
+
+
+MAPLS0: ERRUUO EQUOTE NO-SAV-FILE
+       JRST    MAPLOS
+
+MAPLS1:        ERRUUO  EQUOTE NO-FIXUP-FILE
+       JRST    MAPLOS
+
+MAPLS2:        ERRUUO  EQUOTE NO-ROOM-AVAILABLE
+       JRST    MAPLOS
+
+FIXITU:
+
+;OPEN FIXUP FILE ON MUDSAV
+
+IFN ITS,[
+       .CALL   FIXBLK          ; OPEN UP FIXUP FILE
+       PUSHJ   P,TRAGN                 ; SEE IF TOTALLY LOSING
+]
+IFE ITS,[
+       MOVSI   A,%GJSHT                ; GTJFN BITS
+       HRROI   B,FXSTR
+       SKIPE   OPSYS
+        HRROI  B,TFXSTR
+       GTJFN
+        FATAL  FIXUP FILE NOT FOUND
+       MOVEM   A,DIRCHN
+       MOVE    B,[440000,,OF%RD+OF%EX]
+       OPENF
+        FATAL  FIXUP FILE CANT BE OPENED
+]
+
+       MOVE    0,LASTC(P)              ; GET DIRECTORY
+       PUSHJ   P,GETDIR
+       MOVE    D,NAM(P)
+       PUSHJ   P,DIRSR1                ; SEARCH DIRECTORY FOR FIXUP
+        JRST   NOFXUP                  ; NO FIXUP IN MAIN DIRECTORY
+       ANDI    A,-1                    ; WIN IN MULTI SEGS
+       HRRZ    A,1(A)                  ; GET BLOCK NUMBER OF START
+       ASH     A,8.                    ; CONVERT TO WORDS
+IFN ITS,[
+       .ACCES  MAPCH,A                 ; ACCESS FILE
+]
+
+IFE ITS,[
+       MOVEI   B,(A)
+       MOVE    A,DIRCHN
+       SFPTR
+        JFCL
+]
+       PUSHJ   P,KILBUF
+FIXT1: PUSHJ   P,RFXUP                 ; READ IN THE FIXUP FILE
+
+IFN ITS,[
+       .CALL   MNBLK                   ; REOPEN SAV FILE
+       PUSHJ   P,TRAGN
+]
+
+IFE ITS,[
+       MOVE    A,MAPJFN                ; SET UP DIRCHAN AGAIN
+       MOVEM   A,DIRCHN
+]
+
+; NOW TRY TO LOCATE SAV FILE
+
+       MOVE    0,LASTC(P)              ; GET LASTCHR
+       PUSHJ   P,GETDIR                ; GET DIRECTORY
+       HRRZ    A,VER(P)                        ; GET VERSION #
+       MOVE    D,NAM(P)                ; GET NAME OF FILE
+       PUSHJ   P,DIRSRC                ; SEARCH DIRECTORY
+        JRST   MAPLS1                  ; NO SAV FILE THERE
+       ANDI    A,-1
+       HRRZ    E,1(A)                  ; GET STARTING BLOCK #
+       LDB     A,[LNTBYT,,1(A)]        ; GET LENGTH INTO A
+       MOVEM   A,FLEN(P)               ; SAVE LENGTH
+       MOVEM   E,SPAG(P)               ; SAVE STARTING BLOCK NUMBER
+       PUSHJ   P,KILBUF
+       PUSHJ   P,RSAV                  ; READ IN CODE
+; now to do fixups
+
+FXUPGO:        MOVE    A,(TP)          ; pointer to them
+       SETOM   INPLOD          ;  ABSOLUTE CLUDGE TO PREVENT BUFFER FROM
+                               ;       SCREWING US
+IFE ITS,[
+       SKIPN   MULTSG
+        JRST   FIXMLT
+       HRRZ    D,B             ; this codes gets us running in the correct
+                               ;       segment
+       ASH     D,PGSHFT
+       HRRI    D,FIXMLT
+       MOVEI   C,0
+       XJRST   C               ; good bye cruel segment (will work if we fell
+                               ;        into segment 0)
+FIXMLT:        ASH     B,PGSHFT        ; aobjn to program
+
+FIX1:  SKIPL   E,(A)           ; read one hopefully squoze
+       FATAL   ATTEMPT TO TYPE FIX PURE
+       TLZ     E,740000
+
+NOPV1: PUSHJ   P,SQUTOA        ; look it up
+       FATAL   BAD FIXUPS
+
+; N.B. THE VALUE IN THE FIXUPS FOR AN ADDRESS CAN BE NEGATIVE. IF THIS HAPPENS
+; IT MEANS THAT THE LEFT HALF CONTAINS THE VALUE INSTEAD OF THE RIGHT HALF
+NOPV2: AOBJP   A,FIX2
+       HLRZ    D,(A)           ; get old value
+       HRRZS   E
+       SUBM    E,D             ; D is diff between old and new
+       HRLM    E,(A)           ; fixup the fixups
+NOPV3: MOVEI   0,0             ; flag for which half
+FIX4:  JUMPE   0,FIXRH         ; jump if getting rh
+       MOVEI   0,0             ; next time will get rh
+       AOBJP   A,FIX2          ; done?
+       HLRE    C,(A)           ; get lh
+       JUMPE   C,FIX3          ; 0 terminates
+FIX5:  SKIPGE  C               ; If C is negative then left half garbage
+        JRST   FIX6
+       ADDI    C,(B)           ; access the code
+
+NOPV4: ADDM    D,-1(C)         ; and fix it up
+       JRST    FIX4
+
+; FOR LEFT HALF CASE
+
+FIX6:  MOVNS   C               ; GET TO ADRESS
+       ADDI    C,(B)           ; ACCESS TO CODE
+       HLRZ    E,-1(C)         ; GET OUT WORD
+       ADDM    D,E             ; FIX IT UP
+       HRLM    E,-1(C)
+       JRST    FIX4
+
+FIXRH: MOVEI   0,1             ; change flag
+       HRRE    C,(A)           ; get it and
+       JUMPN   C,FIX5
+
+FIX3:  AOBJN   A,FIX1          ; do next one
+
+IFN SPCFXU,[
+       MOVE    C,B
+       PUSHJ   P,SFIX
+]
+       PUSHJ   P,SQUKIL        ; KILL SQUOZE TABLE
+       SETZM   INPLOD
+FIX2:
+       HRRZS   VER(P)          ; INDICATE SAV FILE
+       MOVEM   B,CADDR(P)
+       PUSHJ   P,GENVN
+       HRRM    B,VER(P)
+       PUSHJ   P,OPWFIL
+        FATAL  MAP FIXUP LOSSAGE
+IFN ITS,[
+       MOVE    B,CADDR(P)
+       .IOT    MAPCH,B         ; write out the goodie
+       .CLOSE  MAPCH,
+       PUSHJ   P,OPMFIL
+        FATAL  WHERE DID THE FILE GO?
+       MOVE    E,CADDR(P)
+       ASH     E,-PGSHFT       ; to page AOBJN
+       DOTCAL  CORBLK,[[1000,,200000],[1000,,-1],E,[1000,,MAPCH],0]
+        .LOSE  %LSSYS
+       .CLOSE  MAPCH,
+]
+
+
+IFE ITS,[
+       MOVE    A,DIRCHN        ; GET JFN
+       MOVE    B,CADDR(P)      ; ready to write it out
+       HRLI    B,444400
+       HLRE    C,CADDR(P)
+       SOUT                    ; zap it out
+       TLO     A,400000        ; dont recycle the JFN
+       CLOSF
+        JFCL
+       ANDI    A,-1            ; kill sign bit
+       MOVE    B,[440000,,240000]
+       OPENF
+        FATAL MAP FIXUP LOSSAGE
+       MOVE    B,CADDR(P)
+       ASH     B,-PGSHFT       ; aobjn to pages
+       HLRE    D,B             ; -count
+       HRLI    B,.FHSLF
+       MOVSI   A,(A)
+       MOVSI   C,PM%RD+PM%EX
+       PMAP
+       ADDI    A,1
+       ADDI    B,1
+       AOJN    D,.-3
+]
+
+       SKIPGE  MUDSTR+2
+        JRST   EFIX2           ; exp vers, dont write out
+IFE ITS,[
+       HRRZ    A,SJFNS         ; get last jfn from savxxx file
+       JUMPE   A,.+4           ; oop
+        CAME   A,MAPJFN
+         CLOSF                 ; close it
+          JFCL
+       HLLZS   SJFNS           ; zero the slot
+]
+       MOVEI   0,1             ; INDICATE FIXUP
+       HRLM    0,VER(P)
+       PUSHJ   P,OPWFIL
+        FATAL  CANT WRITE FIXUPS
+
+IFN ITS,[
+       MOVE    E,(TP)
+       HLRE    A,E             ; get length
+       MOVNS   A
+       ADDI    A,2             ; account for these 2 words
+       MOVE    0,[-2,,A]       ; write version and length
+       .IOT    MAPCH,0
+       .IOT    MAPCH,E         ; out go the fixups
+       SETZB   0,A
+       MOVEI   B,MAPCH
+       .CLOSE  MAPCH,
+]
+
+IFE ITS,[      
+       MOVE    A,DIRCHN
+       HLRE    B,(TP)          ; length of fixup vector
+       MOVNS   B
+       ADDI    B,2             ; for length and version words
+       BOUT
+       PUSHJ   P,GENVN
+       BOUT
+       MOVSI   B,444400        ; byte pointer to fixups
+       HRR     B,(TP)
+       HLRE    C,(TP)
+       SOUT
+       CLOSF
+        JFCL
+]
+
+EFIX2: MOVE    B,CADDR(P)
+       ASH     B,-PGSHFT
+       JRST    PLOAD1
+
+; Here to try to get a free page block for new thing
+;      A/      # of pages to get
+
+ALOPAG:        MOVE    C,GCSTOP        ; FOOL GETPAG
+       ADDI    C,3777
+       ASH     C,-PGSHFT
+       MOVE    B,PURBOT
+IFE ITS,[
+       SKIPN   MULTSG          ; skip if multi-segments
+        JRST   ALOPA1
+; Compute the "highest" PURBOT (i.e. find the least busy segment)
+
+       PUSH    P,E
+       PUSH    P,A
+       MOVN    A,NSEGS         ; aobjn pntr to table
+       HRLZS   A
+       MOVEI   B,0
+ALOPA3:        CAML    B,PURBTB(A)     ; if this one is larger
+        JRST   ALOPA2
+       MOVE    B,PURBTB(A)     ; use it
+       MOVEI   E,FSEG(A)       ; and the segment #
+ALOPA2:        AOBJN   A,ALOPA3
+       POP     P,A
+]
+
+ALOPA1:        ASH     B,-PGSHFT
+       SUBM    B,C             ; SEE IF ROOM
+       CAIL    C,(A)
+        JRST   ALOPGW
+       PUSHJ   P,GETPAX        ; try to get enough pages
+IFE ITS,        JRST   EPOPJ
+IFN ITS,        POPJ   P,
+
+ALOPGW:
+IFN ITS,       AOS     (P)             ; won skip return
+IFE ITS,[
+       SKIPE   MULTSG
+        AOS    -1(P)                   ; ret addr
+       SKIPN   MULTSG
+        AOS    (P)
+]
+       MOVE    0,PURBOT
+IFE ITS,[
+       SKIPE   MULTSG
+        MOVE   0,PURBTB-FSEG(E)
+]
+       ASH     0,-PGSHFT
+       SUBI    0,(A)
+       MOVE    B,0
+IFE ITS,[
+       SKIPN   MULTSG
+        JRST   ALOPW1
+       ASH     0,PGSHFT
+       HRRZM   0,PURBTB-FSEG(E)
+       ASH     E,PGSHFT                ; INTO POSITION
+       IORI    B,(E)           ; include segment in address
+       POP     P,E
+       JRST    ALOPW2
+]
+ALOPW1:        ASH     0,PGSHFT
+ALOPW2:        CAMGE   0,PURBOT
+        MOVEM  0,PURBOT
+       CAML    0,P.TOP
+        POPJ   P,
+IFE ITS,[
+       SUBI    0,1777
+       ANDCMI  0,1777
+]
+       MOVEM   0,P.TOP
+       POPJ    P,
+
+EPOPJ: SKIPE   MULTSG
+        POP    P,E
+       POPJ    P,
+IFE ITS,[
+GETPAX:        TDZA    B,B             ; here if other segs ok
+GETPAG:        MOVEI   B,1             ; here for only main segment
+       JRST    @[.+1]          ; run in sect 0
+       MOVNI   E,1
+]
+IFN ITS,[
+GETPAX:
+GETPAG:
+]
+       MOVE    C,P.TOP         ; top of GC space
+       ASH     C,-PGSHFT       ; to page number
+IFE ITS,[
+       SKIPN   MULTSG
+        JRST   GETPA9
+       JUMPN   B,GETPA9        ; if really wan all segments,
+                               ;       must force all to be  free
+       PUSH    P,A
+       MOVN    A,NSEGS         ; aobjn pntr to table
+       HRLZS   A
+       MOVE    B,P.TOP
+GETPA8:        CAML    B,PURBTB(A)     ; if this one is larger
+        JRST   GETPA7
+       MOVE    B,PURBTB(A)     ; use it
+       MOVEI   E,FSEG(A)       ; and the segment #
+GETPA7:        AOBJN   A,GETPA8
+       POP     P,A
+       JRST    .+2
+]
+GETPA9:        MOVE    B,PURBOT
+       ASH     B,-PGSHFT       ; also to pages
+       SUBM    B,C             ; pages available ==> C
+       CAMGE   C,A             ; skip if have enough already
+        JRST   GETPG1          ; no, try to shuffle around
+       SUBI    B,(A)           ; B/  first new page
+CPOPJ1:        AOS     (P)
+IFN ITS,       POPJ    P,
+IFE ITS,[
+SPOPJ: SKIPN   MULTSG
+        POPJ   P,              ; return with new free page in B
+                               ;       (and seg# in E?)
+       POP     P,21
+       SETZM   20
+       XJRST   20
+]
+; Here if shuffle must occur or gc must be done to make room
+
+GETPG1:        MOVEI   0,0
+       SKIPE   NOSHUF          ; if can't shuffle, then ask gc
+        JRST   ASKAGC
+       MOVE    0,PURTOP        ; get top of mapped pure area
+       SUB     0,P.TOP
+       ASH     0,-PGSHFT       ; to pages
+       CAMGE   0,A             ; skip if winnage possible
+        JRST   ASKAGC          ; please AGC give me some room!!
+       SUBM    A,C             ; C/ amount we must flush to make room
+
+IFE ITS,[
+       SKIPE   MULTSG          ; if  multi and getting in all segs
+        JUMPL  E,LPGL1         ; check out each and every segment
+
+       PUSHJ   P,GL1
+
+       SKIPE   MULTSG
+        PUSHJ  P,PURTBU        ; update PURBOT in multi case
+
+       JRST    GETPAX
+
+LPGL1: PUSH    P,[FSEG-1]
+
+LPGL2: AOS     E,(P)           ; count segments
+       MOVE    B,NSEGS
+       ADDI    B,FSEG
+       CAML    E,B
+        JRST   LPGL3
+       PUSH    P,C
+       MOVE    C,PURBOT        ; fudge so look for appropriate amt
+       SUB     C,PURBTB-FSEG(E)
+       ASH     C,-PGSHFT       ; to pages
+       ADD     C,(P)
+       SKIPLE  C               ; none to flush
+       PUSHJ   P,GL1
+       HRRZ    E,-1(P)         ; fet section again
+       HRRZ    B,PURBOT
+       HRRZ    C,PURBTB-FSEG(E)        ; lets share with 0 again
+       SUB     C,B
+       HRL     B,E             ; get segment
+       MOVEI   A,(B)
+       ASH     B,-PGSHFT
+       ASH     A,-PGSHFT
+       HRLI    A,.FHSLF
+       HRLI    B,.FHSLF
+       ASH     C,-PGSHFT
+       HRLI    C,PM%CNT+PM%RD+PM%WR+PM%EX
+       PMAP
+LPGL4: POP     P,C
+       JRST    LPGL2
+
+LPGL3: SUB     P,C%11
+
+       SKIPE   MULTSG
+        PUSHJ  P,PURTBU        ; update PURBOT in multi case
+
+       JRST    GETPAG
+]
+; Here to find pages for flush using LRU algorithm (in multi seg mode, only
+;              care about the segment in E)
+
+GL1:   MOVE    B,PURVEC+1      ; get pointer to pure sr vector
+       MOVEI   0,-1            ; get very large age
+
+GL2:   SKIPL   FB.PTR(B)       ; skip if not already flushed
+        JRST   GL3
+IFE ITS,[
+       SKIPN   MULTSG
+        JRST   GLX
+       LDB     D,[220500,,FB.PTR(B)]   ; get segment #
+       CAIE    D,(E)
+        JRST   GL3             ; wrong swegment, ignore
+]
+GLX:   HLRZ    D,FB.AGE(B)     ; get this ones age
+       CAMLE   D,0             ; skip if this is a candidate
+        JRST   GL3
+       MOVE    F,B             ; point to table entry with E
+       MOVEI   0,(D)           ; and use as current best
+GL3:   ADD     B,[ELN,,ELN]    ; look at next
+       JUMPL   B,GL2
+
+       HLRE    B,FB.PTR(F)     ; get length of flushee
+       ASH     B,-PGSHFT       ; to negative # of pages
+       ADD     C,B             ; update amount needed
+IFN ITS,SETZM  FB.PTR(F)       ; indicate it will be gone
+IFE ITS,MOVNS  FB.PTR(F)       ; save page info for flushing pages
+       JUMPG   C,GL1           ; jump if more to get
+
+; Now compact pure space
+
+       PUSH    P,A             ; need all acs
+       HRRZ    D,PURVEC        ; point to first in core addr order
+       HRRZ    C,PURTOP        
+IFE ITS,[
+       SKIPE   MULTSG
+        HRLI   C,(E)           ; adjust for segment
+]
+       ASH     C,-PGSHFT       ; to page number
+       SETZB   F,A
+
+CL1:   ADD     D,PURVEC+1      ; to real pointer
+       SKIPGE  FB.PTR(D)       ; skip if this one is a flushee
+        JRST   CL2             ; this one stays
+
+IFE ITS,[
+       PUSH    P,C
+       PUSH    P,D
+       HRRZ    C,FB.PGS(D)     ; is this from SAV FILE?
+       JUMPN   C,CLFOUT        ; yes.  don't bother flushing pages
+       MOVN    C,FB.PTR(D)     ; get aobjn pointer to code in C
+       SETZM   FB.PTR(D)       ; and flush this because it works (sorry)
+       ASH     C,-PGSHFT       ; pages speak louder than words
+       HLRE    D,C             ; # of pages saved here for unmap
+       HRLI    C,.FHSLF        ; C now contains myfork,,lowpage
+       MOVE    A,C             ; put that in A for RMAP
+       RMAP                    ; A now contains JFN in left half
+       MOVE    B,C             ; ac roulette: get fork,,page into B for PMAP
+       HLRZ    C,A             ; hold JFN in C for future CLOSF
+       MOVNI   A,1             ; say this page to be unmapped
+CLFLP: PMAP                    ; do the unmapping
+       ADDI    B,1             ; next page
+       AOJL    D,CLFLP         ; continue for all pages
+       MOVE    A,C             ; restore JFN
+       CLOSF                   ; and close it, throwing away the JFN
+        JFCL                   ; should work in 95/100 cases
+CLFOU1:        POP     P,D             ; fatal error if can't close
+       POP     P,C
+]
+       HRRZ    D,FB.AGE(D)     ; point to next one in chain
+       JUMPN   F,CL3           ; jump if not first one
+       HRRM    D,PURVEC        ; and use its next as first
+       JRST    CL4
+
+IFE ITS,[
+CLFOUT:        SETZM   FB.PTR(D)       ; zero the code pointer
+       JRST    CLFOU1
+]
+
+CL3:   HRRM    D,FB.AGE(F)     ; link up
+       JRST    CL4
+
+; Found a stayer, move it if necessary
+
+CL2:
+IFE ITS,[
+       SKIPN   MULTSG
+        JRST   CL9
+       LDB     F,[220500,,FB.PTR(D)]   ; check segment
+       CAIE    E,(F)
+        JRST   CL6X            ; no other segs move at all
+]
+CL9:   MOVEI   F,(D)           ; another pointer to slot
+       HLRE    B,FB.PTR(D)     ; - length of block
+IFE ITS,[
+       TRZ     B,<-1>#<(FB.CNT)>
+       MOVE    D,FB.PTR(D)     ; pointer to block
+       TLZ     D,(FB.CNT)      ; kill count bits
+]
+IFN ITS,       HRRZ    D,FB.PTR(D)     
+       SUB     D,B             ; point to top of block
+       ASH     D,-PGSHFT       ; to page number
+       CAMN    D,C             ; if not moving, jump
+        JRST   CL6
+
+       ASH     B,-PGSHFT       ; to pages
+IFN ITS,[
+CL5:   SUBI    C,1             ; move to pointer and from pointer
+       SUBI    D,1
+       DOTCAL  CORBLK,[[1000,,200000],[1000,,-1],C,[1000,,-1],D]
+        .LOSE  %LSSYS
+       AOJL    B,CL5           ; count down
+]
+IFE ITS,[
+       PUSH    P,B             ; save # of pages
+       MOVEI   A,-1(D)         ; copy from pointer
+       HRLI    A,.FHSLF        ; get this fork code
+       RMAP                    ; get a JFN (hopefully)
+       EXCH    D,(P)           ; D # of pages (save from)
+       ADDM    D,(P)           ; update from
+       MOVEI   B,-1(C)         ; to pointer in B
+       HRLI    B,.FHSLF
+       MOVSI   C,PM%RD+PM%EX   ; read/execute modes
+
+       SKIPN   OPSYS
+        JRST   CCL1
+       PMAP                    ; move a page
+       SUBI    A,1
+       SUBI    B,1
+       AOJL    D,.-3           ; move them all
+       AOJA    B,CCL2
+
+CCL1:  TLO     C,PM%CNT
+       MOVNS   D
+       SUBI    B,-1(D)
+       SUBI    A,-1(D)
+       HRRI    C,(D)
+       PMAP
+
+CCL2:  MOVEI   C,(B)
+       POP     P,D
+]
+; Update the table address for this loser
+
+       SUBM    C,D             ; compute offset (in pages)
+       ASH     D,PGSHFT        ; to words
+       ADDM    D,FB.PTR(F)     ; update it
+CL7:   HRRZ    D,FB.AGE(F)     ; chain on
+CL4:   TRNN    D,EOC           ; skip if end of chain
+        JRST   CL1
+
+       ASH     C,PGSHFT        ; to words
+IFN ITS,       MOVEM   C,PURBOT        ; reset pur bottom
+IFE ITS,[
+       SKIPN   MULTSG
+        JRST   CLXX
+
+       HRRZM   C,PURBTB-FSEG(E)
+       CAIA
+CLXX:  MOVEM   C,PURBOT        ; reset pur bottom
+]
+       POP     P,A
+       POPJ    P,
+
+IFE ITS,[
+CL6X:  MOVEI   F,(D)           ; chain on
+       JRST    CL7
+]
+CL6:   
+IFN ITS,       HRRZ    C,FB.PTR(F)     ; get new top of world
+IFE ITS,[
+       MOVE    C,FB.PTR(F)
+       TLZ     C,(FB.CNT)
+]
+       ASH     C,-PGSHFT       ; to page #
+       JRST    CL7
+
+IFE ITS,[
+PURTBU:        PUSH    P,A
+       PUSH    P,B
+
+       MOVN    B,NSEGS
+       HRLZS   B
+       MOVE    A,PURTOP
+
+PURTB2:        CAMG    A,PURBTB(B)
+        JRST   PURTB1
+       MOVE    A,PURBTB(B)
+       MOVEM   A,PURBOT
+PURTB1:        AOBJN   B,PURTB2
+
+       POP     P,B
+       POP     P,A
+       POPJ    P,
+]
+
+\f; SUBR to create an entry in the vector for one of these guys
+
+MFUNCTION PCODE,SUBR
+
+       ENTRY   2
+
+       GETYP   0,(AB)          ; check 1st arg is string
+       CAIE    0,TCHSTR
+        JRST   WTYP1
+       GETYP   0,2(AB)         ; second must be fix
+       CAIE    0,TFIX
+        JRST   WTYP2
+
+       MOVE    A,(AB)          ; convert name of program to sixbit
+       MOVE    B,1(AB)
+       PUSHJ   P,STRTO6
+PCODE4:        MOVE    C,(P)           ; get name in sixbit
+
+; Now look for either this one or an empty slot
+
+       MOVEI   E,0
+       MOVE    B,PURVEC+1
+
+PCODE2:        CAMN    C,FB.NAM(B)     ; skip if this is not it
+        JRST   PCODE1          ; found it, drop out of loop
+       JUMPN   E,.+3           ; dont record another empty if have one
+       SKIPN   FB.NAM(B)               ; skip if slot filled
+        MOVE   E,B             ; remember pointer
+       ADD     B,[ELN,,ELN]
+       JUMPL   B,PCODE2        ; jump if more to look at
+
+       JUMPE   E,PCODE3        ; if E=0, error no room
+       MOVEM   C,FB.NAM(E)     ; else stash away name and zero rest
+       SETZM   FB.PTR(E)
+       SETZM   FB.AGE(E)
+       CAIA
+PCODE1:         MOVE   E,B             ; build <slot #>,,<offset>
+       MOVEI   0,0             ; flag whether new slot
+       SKIPE   FB.PTR(E)       ; skip if mapped already
+        MOVEI  0,1
+       MOVE    B,3(AB)
+       HLRE    D,E
+       HLRE    E,PURVEC+1
+       SUB     D,E
+       HRLI    B,(D)
+       MOVSI   A,TPCODE
+       SKIPN   NOSHUF          ; skip if not shuffling
+        JRST   FINIS
+       JUMPN   0,FINIS         ; jump if winner
+       PUSH    TP,A
+       PUSH    TP,B
+       HLRZ    A,B
+       PUSHJ   P,PLOAD
+        JRST   PCOERR
+       POP     TP,B
+       POP     TP,A
+       JRST    FINIS
+
+PCOERR:        ERRUUO  EQUOTE PURE-LOAD-FAILURE
+
+PCODE3:        HLRE    A,PURVEC+1      ; get current length
+       MOVNS   A
+       ADDI    A,10*ELN        ; add 10(8) more entry slots
+       PUSHJ   P,IBLOCK
+       EXCH    B,PURVEC+1      ; store new one and get old
+       HLRE    A,B             ; -old length to A
+       MOVSI   B,(B)           ; start making BLT pointer
+       HRR     B,PURVEC+1
+       SUBM    B,A             ; final dest to A
+IFE ITS,       HRLI    A,-1            ; force local index
+       BLT     B,-1(A)
+       JRST    PCODE4
+
+; Here if must try to GC for some more core
+
+ASKAGC:        SKIPE   GCFLG           ; if already in GC, lose
+IFN ITS,        POPJ   P,
+IFE ITS,        JRST   SPOPJ
+       MOVEM   A,0             ; amount required to 0
+       ASH     0,PGSHFT        ; TO WORDS
+       MOVEM   0,GCDOWN        ; pass as funny arg to AGC
+       EXCH    A,C             ; save A from gc's destruction
+IFN ITS,.IOPUSH        MAPCH,          ; gc uses same channel
+       PUSH    P,C
+       SETOM   PLODR
+       MOVE    C,[8,,9.]       ; SET UP INDICATORS FOR GC
+       PUSHJ   P,AGC
+       SETZM   PLODR
+       POP     P,C
+IFN ITS,.IOPOP MAPCH,
+       EXCH    C,A
+       JUMPGE  C,GETPAG
+        ERRUUO EQUOTE NO-MORE-PAGES
+
+; Here to clean up pure space by flushing all shared stuff
+
+PURCLN:        SKIPE   NOSHUF
+        POPJ   P,
+       MOVEI   B,EOC
+       HRRM    B,PURVEC        ; flush chain pointer
+       MOVE    B,PURVEC+1      ; get pointer to table
+CLN1:  SETZM   FB.PTR(B)       ; zero pointer entry
+       SETZM   FB.AGE(B)       ; zero link and age slots
+       SETZM   FB.PGS(B)
+       ADD     B,[ELN,,ELN]    ; go to next slot
+       JUMPL   B,CLN1          ; do til exhausted
+       MOVE    B,PURBOT        ; now return pages
+       SUB     B,PURTOP        ; compute page AOBJN pointer
+IFE ITS,       SETZM   MAPJFN          ; make sure zero mapjfn
+       JUMPE   B,CPOPJ         ; no pure pages?
+       MOVSI   B,(B)
+       HRR     B,PURBOT
+       ASH     B,-PGSHFT
+IFN ITS,[
+       DOTCAL  CORBLK,[[1000,,0],[1000,,-1],B]
+        .LOSE  %LSSYS
+]
+IFE ITS,[
+
+       SKIPE   MULTSG
+        JRST   CLN2
+       HLRE    D,B             ; - # of pges to flush
+       HRLI    B,.FHSLF        ; specify hacking hom fork
+       MOVNI   A,1
+       MOVEI   C,0
+
+       PMAP
+       ADDI    B,1
+       AOJL    D,.-2
+]
+
+       MOVE    B,PURTOP        ; now fix up pointers
+       MOVEM   B,PURBOT        ;   to indicate no pure
+CPOPJ: POPJ    P,
+
+IFE ITS,[
+CLN2:  HLRE    C,B             ; compute pos no. pages
+       HRLI    B,.FHSLF
+       MOVNS   C
+       MOVNI   A,1             ; flushing pages
+       HRLI    C,PM%CNT
+       MOVE    D,NSEGS
+       MOVE    E,PURTOP        ; for munging table
+       ADDI    B,<FSEG>_9.     ; do it to the correct segment
+       PMAP
+       ADDI    B,1_9.          ; cycle through segments
+       HRRZM   E,PURBTB(D)     ; mung table
+       SOJG    D,.-3
+
+       MOVEM   E,PURBOT
+       POPJ    P,
+]
+
+; Here to move the entire pure space.
+;      A/      # and direction of pages to move (+ ==> up)
+
+MOVPUR:        SKIPE   NOSHUF
+        FATAL  CANT MOVE PURE SPACE AROUND
+IFE ITS,ASH    A,1
+       SKIPN   B,A             ; zero movement, ignore call
+        POPJ   P,
+
+       ASH     B,PGSHFT        ; convert to words for pointer update
+       MOVE    C,PURVEC+1      ; loop through updating non-zero entries
+       SKIPE   1(C)
+        ADDM   B,1(C)
+       ADD     C,[ELN,,ELN]
+       JUMPL   C,.-3
+
+       MOVE    C,PURTOP        ; found pages at top and bottom of pure
+       ASH     C,-PGSHFT
+       MOVE    D,PURBOT
+       ASH     D,-PGSHFT
+       ADDM    B,PURTOP        ; update to new boundaries
+       ADDM    B,PURBOT
+IFE ITS,[
+       SKIPN   MULTSG          ; in multi-seg mode, must mung whole table
+        JRST   MOVPU1
+       MOVN    E,NSEGS
+       HRLZS   E
+       ADDM    PURBTB(E)
+       AOBJN   E,.-1
+]
+MOVPU1:        CAIN    C,(D)           ; differ?
+        POPJ   P,
+       JUMPG   A,PUP           ; if moving up, go do separate CORBLKs
+
+IFN ITS,[
+       SUBM    D,C             ; -size of area to C (in pages)
+       MOVEI   E,(D)           ; build pointer to bottom of destination
+       ADD     E,A
+       HRLI    E,(C)
+       HRLI    D,(C)
+       DOTCAL  CORBLK,[[1000,,200000],[1000,,-1],E,[1000,,-1],D]
+        .LOSE  %LSSYS
+       POPJ    P,
+
+PUP:   SUBM    C,D             ; pages to move to D
+       ADDI    A,(C)           ; point to new top
+
+PUPL:  SUBI    C,1
+       SUBI    A,1
+       DOTCAL  CORBLK,[[1000,,200000],[1000,,-1],A,[1000,,-1],C]
+        .LOSE  %LSSYS
+       SOJG    D,PUPL
+       POPJ    P,
+]
+IFE ITS,[
+       SUBM    D,C             ; pages to move to D
+       MOVSI   E,(C)           ; build aobjn pointer
+       HRRI    E,(D)           ; point to lowest
+       ADD     D,A             ; D==> new lowest page
+       MOVEI   F,0             ; seg info 
+       SKIPN   MULTSG
+        JRST   XPLS3
+       MOVEI   F,FSEG
+       ADD     F,NSEGS
+       ASH     F,9.
+XPLS3: MOVE    G,E
+       MOVE    H,D             ; save for outer loop
+
+PURCL1:        MOVSI   A,.FHSLF                ; specify here
+       HRRI    A,(E)           ; get a page
+       IORI    A,(F)           ; hack seg i
+       RMAP                    ; get a real handle on it
+       MOVE    B,D             ; where to go
+       HRLI    B,.FHSLF
+       MOVSI   C,PM%RD+PM%EX
+       IORI    A,(F)
+       PMAP
+       ADDI    D,1
+       AOBJN   E,PURCL1
+       SKIPN   MULTSG
+        POPJ   P,
+       SUBI    F,1_9.
+       CAIGE   F,FSEG_9.
+        POPJ   P,
+       MOVE    E,G
+       MOVE    D,H
+       JRST    PURCL1
+
+PUP:   SUB     D,C             ; - count to D
+       MOVSI   E,(D)           ; start building AOBJN
+       HRRI    E,(C)           ; aobjn to top
+       ADD     C,A             ; C==> new top
+       MOVE    D,C
+       MOVEI   F,0             ; seg info 
+       SKIPN   MULTSG
+        JRST   XPLS31
+       MOVEI   F,FSEG
+       ADD     F,NSEGS
+       ASH     F,9.
+XPLS31:        MOVE    G,E
+       MOVE    H,D             ; save for outer loop
+
+PUPL:  MOVSI   A,.FHSLF
+       HRRI    A,(E)
+       IORI    A,(F)           ; segment
+       RMAP                    ; get real handle
+       MOVE    B,D
+       HRLI    B,.FHSLF
+       IORI    B,(F)
+       MOVSI   C,PM%RD+PM%EX
+       PMAP
+       SUBI    E,2
+       SUBI    D,1
+       AOBJN   E,PUPL
+       SKIPN   MULTSG
+        POPJ   P,
+       SUBI    F,1_9.
+       CAIGE   F,FSEG_9.
+        POPJ   P,
+       MOVE    E,G
+       MOVE    D,H
+       JRST    PUPL
+
+       POPJ    P,
+]
+IFN ITS,[
+.GLOBAL CSIXBT
+CSIXBT:        MOVEI   0,5
+       PUSH    P,[440700,,C]
+       PUSH    P,[440600,,D]
+       MOVEI   D,0
+CSXB2: ILDB    E,-1(P)
+       CAIN    E,177
+       JRST    CSXB1
+       SUBI    E,40
+       IDPB    E,(P)
+       SOJG    0,CSXB2
+CSXB1: SUB     P,C%22
+       MOVE    C,D
+       POPJ    P,
+]
+GENVN: MOVE    C,[440700,,MUDSTR+2]
+       MOVEI   D,5
+       MOVEI   B,0
+VNGEN: ILDB    0,C
+       CAIN    0,177
+        POPJ   P,
+       IMULI   B,10.
+       SUBI    0,60
+       ADD     B,0
+       SOJG    D,VNGEN
+       POPJ    P,
+
+IFE ITS,[
+MSKS:  774000,,0
+       777760,,0
+       777777,,700000
+       777777,,777400
+       777777,,777776
+]
+
+\f; THESE ARE DIRECTORY SEARCH ROUTINES
+
+
+; THIS ROUTINE DOES A BINARY SEARCH ON A DIRECTORY AND RETURNS A POINTER
+; RESTED DOWN TO THE APPROPRIATE SLOT IN THE DIRECTORY.
+; ARGS: E==DIR POINTER D==FILE-NAME 1 A==VERSION #
+; RETS: A==RESTED DOWN DIRECTORY
+
+DIRSR1:        TLOA    0,400000                ; INDICATION OF ONE ARGUMENT SEARCH
+DIRSRC:         TLZ    0,400000                ; INDICATOR OF 2 ARGUMENT SEARCH
+       PUSH    P,A                     ; SAVE VERSION #
+       HLRE    B,E                     ; GET LENGTH INTO B
+       MOVNS   B
+       MOVE    A,E
+       HRLS    B                       ; GET BOTH SIDES
+UP:     ASH     B,-1                   ; HALVE TABLE
+        AND     B,[-2,,-2]             ; FORCE DIVIS BY 2
+        MOVE    C,A                    ; COPY POINTER
+        JUMPLE  B,LSTHLV               ; CANT GET SMALLER
+        ADD     C,B
+IFE ITS,       HRRZ    F,C             ; avoid lossage in multi-sections
+IFN ITS,       CAMLE   D,(C)           ; SKIP IF EITHER FOUND OR IN TOP
+IFE ITS,       CAMLE   D,(F)           ; SKIP IF EITHER FOUND OR IN TOP
+         MOVE    A,C                   ; POINT TO SECOND HALF
+IFN ITS,       CAMN    D,(C)           ; SKIP IF NOT FOUND
+IFE ITS,       CAMN    D,(F)           ; SKIP IF NOT FOUND
+         JRST    WON
+IFN ITS,        CAML    D,(C)                  ; SKIP IF IN TOP HALF
+IFE ITS,        CAML    D,(F)                  ; SKIP IF IN TOP HALF
+         JRST    UP
+        HLLZS   C                      ; FIX UP POINTER
+        SUB     A,C
+        JRST    UP
+
+WON:   JUMPL   0,SUPWIN
+       MOVEI   0,0                     ; DOWN FLAG
+WON1:  LDB     A,[221200,,1(C)]        ; GET VERSION NUMBER
+       CAMN    A,(P)                   ; SKIP IF NOT EQUAL
+        JRST   SUPWIN
+       CAMG    A,(P)                   ; SKIP IF LT
+        JRST   SUBIT
+       SETO    0,
+       SUB     C,C%22                  ; GET NEW C
+       JRST    SUBIT1
+
+SUBIT: ADD     C,C%22                  ; SUBTRACT
+       JUMPN   0,C1POPJ
+SUBIT1:
+IFN ITS,       CAMN    D,(C)           ; SEE WHETHER WERE STILL WINNING
+IFE ITS,[
+       HRRZ    F,C
+       CAMN    D,(F)
+]
+        JRST   WON1
+C1POPJ:        SUB     P,C%11                  ; GET RID OF VERSION #
+       POPJ    P,                      ; LOSE LOSE LOSE
+SUPWIN:        MOVE    A,C                     ; RETURN ARGUMENT IN A  
+       AOS     -1(P)                   ; SKIP RETURN INDICATES IT WAS FOUND
+       JRST    C1POPJ
+
+LSTHLV:
+IFN ITS,       CAMN    D,(C)           ; LINEAR SEARCH REST
+IFE ITS,[
+       HRRZ    F,C
+       CAMN    D,(F)           ; LINEAR SEARCH REST
+]
+         JRST    WON
+        ADD     C,C%22
+        JUMPL   C,LSTHLV
+       JRST    C1POPJ
+
+\f; ROUTINE TO GET A DIRECTORY. ASSUMES MAPCH IS OPEN TO FIXUP OR SAV FILE AND 0 IS THE
+; LAST CHAR TO BE HASHED. RETURNS POINTER TO DIRECTORY IN E
+
+IFN ITS,[
+GETDIR:        PUSH    P,C
+       PUSH    P,0
+       PUSHJ   P,SQKIL
+       MOVEI   A,1                     ; GET A BUFFER
+       PUSHJ   P,GETBUF
+       MOVEI   C,(B)
+       ASH     C,-10.
+       DOTCAL  CORBLK,[[RDTP],[FME],C,[1000,,MAPCH],[1000,,0]]
+       PUSHJ   P,SLEEPR
+       POP     P,0
+       IDIV    0,(B)                   ; A NOW CONTAINS THE DIRECTORY NUMBER
+       ADDI    A,1(B)
+       DOTCAL  CORBLK,[[RDTP],[FME],C,[1000,,MAPCH],(A)]
+       PUSHJ   P,SLEEPR
+       MOVN    E,(B)                   ; GET -LENGTH OF DIRECTORY
+       HRLZS   E                       ; BUILD AOBJN PTR TO DIR
+       HRRI    E,1(B)
+       POP     P,C
+       POPJ    P,
+]
+; IN WONDERFUL TOPS20 VERSION DIRCHN CONTAINS THE JFN
+
+IFE ITS,[
+GETDIR:        JRST    @[.+1]
+       PUSH    P,C
+       PUSH    P,0
+       PUSHJ   P,SQKIL
+       MOVEI   A,1                     ; GET A BUFFER
+       PUSHJ   P,GETBUF
+       HRROI   E,(B)
+       ASH     B,-9.
+       HRLI    B,.FHSLF                        ; SET UP DESTINATION (CORE)
+       MOVS    A,DIRCHN                ; SET UP SOURCE (FILE)
+       MOVSI   C,PM%RD+PM%EX           ; READ+EXEC ACCESS
+       PMAP
+       POP     P,0
+       IDIV    0,(E)                   ; A NOW CONTAINS THE DIRECTORY NUMBER
+       ADDI    A,1(E)                  ; POINT TO THE DIRECTORY ENTRY
+       MOVE    A,(A)                   ; GET THE PAGE NUMBER
+       HRL     A,DIRCHN                ; SET UP SOURCE (FILE)
+       PMAP                            ; AGAIN READ IN DIRECTORY
+       MOVEI   A,(E)
+       MOVN    E,(E)                   ; GET -LENGTH OF DIRECTORY
+       HRLZS   E                       ; BUILD AOBJN PTR TO DIR
+       HRRI    E,1(A)
+       POP     P,C
+       SKIPN   MULTSG
+        POPJ   P,
+       POP     P,21
+       SETZM   20
+       XJRST   20
+]
+; HERE IF CAN'T FIND FIXUP FILE IN MAIN DIRECTORY
+
+NOFXUP:        
+IFE ITS,[
+       MOVE    A,DIRCHN                ; JFN FOR FIXUP FILE
+       CLOSF                           ; CLOSE IT
+        JFCL
+]
+       MOVE    A,FXTBL                 ; GET AOBJN POINTER TO FIXUP TABLE
+NOFXU1:        HRRZ    B,(A)                   ; GET VERSION TO TRY
+       HRRM    B,VER(P)                ; STUFF IN VERSION
+       MOVEI   B,1                     ; DUMP IN FIXUP INDICATOR
+       HRLM    B,VER(P)
+       MOVEM   A,TEMP(P)               ; SAVE POINTER TO FXTBL
+       PUSHJ   P,OPXFIL                ; LOOK FOR FIXUP FILE   
+        JRST   NOFXU2
+       PUSHJ   P,RFXUP                 ; READ IN THE FIXUP FILE
+       HRRZS   VER(P)                  ; INDICATE SAV FILE
+       PUSHJ   P,OPXFIL                ; TRY OPENING IT
+        JRST   MAPLS0                  ; GIVE UP NO SAV FILE TO BE HAD
+       PUSHJ   P,RSAV
+       JRST    FXUPGO                  ; GO FIXUP THE WORLD
+NOFXU2:        MOVE    A,TEMP(P)               ; GET BACK POINTER
+       AOBJN   A,NOFXU1                ; TRY NEXT
+       JRST    MAPLS1                  ; NO FILE TO BE HAD
+
+GETIT: HRRZM   B,SPAG(P)               ; GET BLOCK OF START
+       HLRZM   B,FLEN(P)               ; DAMMIT SAVE THIS!
+       HLRZ    A,B                     ; GET LENGTH\r
+IFN ITS,[
+       .CALL   MNBLK
+       PUSHJ   P,TRAGN
+]
+IFE ITS,[
+       MOVE    E,MAPJFN
+       MOVEM   E,DIRCHN
+]
+
+       JRST    PLOD1
+
+; ROUTINE TO SEE IF FILE IS NOT OPEN BECAUSE OF FNF AND FATAL IF SO
+
+IFN ITS,[
+TRAGN: PUSH    P,0             ; SAVE 0
+       .STATUS MAPCH,0         ; GET STATUS BITS
+       LDB     0,[220600,,0]
+       CAIN    0,4             ; SKIP IF NOT FNF
+        FATAL  MAJOR FILE NOT FOUND
+       POP     P,0
+       SOS     (P)
+       SOS     (P)             ; RETRY OPEN
+       POPJ    P,
+]
+IFE ITS,[
+OPSAV: MOVSI   A,%GJSHT+%GJOLD ; BITS FOR GTJFN
+       HRROI   B,SAVSTR        ; STRING POINTER
+       SKIPE   OPSYS
+        HRROI  B,TSAVST
+       GTJFN
+        FATAL  CANT FIND SAV FILE
+       MOVEM   A,MAPJFN        ; STORE THE JFN
+       MOVE    B,[440000,,OF%RD+OF%EX+OF%THW+OF%DUD]
+       OPENF
+        FATAL  CANT OPEN SAV FILE
+       POPJ    P,
+]
+
+; OPMFIL IS USED TO OPEN A FILE ON MUDTMP.  IT CAN OPEN EITHER A SAV OR FIXUP FILE
+; AND THE VERSION NUMBER IS SPECIFIED.  THE ARGUMENTS ARE
+; NAM-1(P) HAS SIXBIT OF FILE NAME
+; VER-1(P) HAS 0,,VERSION # FOR SAV FILE AND 1,,VERSION# FOR FIXUP FILE
+; RETURNS LENGTH OF FILE IN SLEN AND 
+
+; OPXFIL IS A KLUDGE FOR GETTING SAV AND FIXUP FILES OFF OF THE MDLLIB
+; DIRECTORY DURING THE CHANGEOVER TO PRE- AND POST- MUDSAV WORLDS
+
+OPXFIL:        MOVEI   0,1
+       MOVEM   0,WRT-1(P)
+       JRST    OPMFIL+1
+
+OPWFIL:        SETOM   WRT-1(P)
+       SKIPA
+OPMFIL:         SETZM  WRT-1(P)
+
+IFN ITS,[
+       HRRZ    C,VER-1(P)              ; GET VERSION NUMBER
+       PUSHJ   P,NTOSIX                ; CONVERT TO SIXBIT
+       HRLI    C,(SIXBIT /SAV/)        ; BUILD SECOND FILE NAME
+       HLRZ    0,VER-1(P)
+       SKIPE   0                       ; SKIP IF SAV
+        HRLI   C,(SIXBIT/FIX/)
+       MOVE    B,NAM-1(P)              ; GET NAME
+       MOVSI   A,7                     ; WRITE MODE
+       SKIPL   WRT-1(P)
+        MOVSI  A,6                     ; READ MODE
+RETOPN: .CALL  FOPBLK
+        JRST   OPCHK                   ; SEE IF FIXUP IS NECESSARY OR JUST REOPENING
+       DOTCAL  FILLEN,[[1000,,MAPCH],[2000,,A]]
+        .LOSE  1000
+       ADDI    A,PGMSK                 ; ROUND
+       ASH     A,-PGSHFT               ; TO PAGES
+       MOVEM   A,FLEN-1(P)
+       SETZM   SPAG-1(P)
+       AOS     (P)                     ; SKIP RETURN TO SHOW SUCCESS
+       POPJ    P,
+
+OPCHK: .STATUS MAPCH,0                 ; GET STATUS BITS
+       LDB     0,[220600,,0]
+       CAIE    0,4                     ; SKIP IF FNF
+        JRST   OPCHK1                  ; RETRY
+       POPJ    P,
+
+OPCHK1:        MOVEI   0,1                     ; SLEEP FOR A WHILE
+       .SLEEP
+       JRST    OPCHK
+
+; NTOSIX GETS NUMBER IN C AND CONVERTS IT TO SIXBIT AND RETURNS RESULT IN C
+NTOSIX:        PUSH    P,A                     ; SAVE A AND B
+       PUSH    P,B
+       PUSH    P,D
+       MOVE    D,[220600,,C]
+       MOVEI   A,(C)                   ; GET NUMBER
+       MOVEI   C,0
+       IDIVI   A,100.                  ; GET RESULT OF DIVISION
+       SKIPN   A
+        JRST   ALADD
+       ADDI    A,20                    ; CONVERT TO DIGIT
+       IDPB    A,D
+ALADD: MOVEI   A,(B)
+       IDIVI   A,10.                   ; GET TENS DIGIT
+       SKIPN   C
+        SKIPE  A                       ; IF BOTH 0 BLANK DIGIT
+         ADDI  A,20
+       IDPB    A,D
+       SKIPN   C
+        SKIPE  B
+         ADDI  B,20
+       IDPB    B,D
+       POP     P,D
+       POP     P,B
+       POP     P,A
+       POPJ    P,
+
+]
+
+IFE ITS,[
+       MOVE    E,P             ; save pdl base
+       MOVE    B,NAM-1(E)              ; GET FIRST NAME
+       PUSH    P,C%0           ; [0]; slots for building strings
+       PUSH    P,C%0           ; [0]
+       MOVE    A,[440700,,1(E)]
+       MOVE    C,[440600,,B]
+       
+; DUMP OUT SIXBIT NAME
+
+       MOVEI   D,6
+       ILDB    0,C
+       JUMPE   0,.+4           ; violate cardinal ".+ rule"
+       ADDI    0,40            ; to ASCII
+       IDPB    0,A
+       SOJG    D,.-4
+
+       MOVE    0,[ASCII /  SAV/]
+       HLRZ    C,VER-1(E)              ; GET SAV/FIXUP FLAG
+       SKIPE   C
+        MOVE   0,[ASCII /  FIX/]
+       PUSH    P,0 
+       HRRZ    C,VER-1(E)              ; get ascii of vers no.
+       PUSHJ   P,NTOSEV        ; CONVERT TO STRING LEFT JUSTIFIED
+       PUSH    P,C
+       MOVEI   B,-1(P)         ; point to it
+       HRLI    B,260700
+       HRROI   D,1(E)          ; point to name
+       MOVEI   A,1(P)
+       MOVSI   0,100000        ; INPUT FILE (GJ%OLD)
+       SKIPGE  WRT-1(E)
+        MOVSI  0,400000        ; OUTPUT FILE (GJ%FOU)
+       PUSH    P,0
+       PUSH    P,[377777,,377777]
+       MOVE    0,[-1,,[ASCIZ /DSK/]]
+       SKIPN   OPSYS
+        MOVE   0,[-1,,[ASCIZ /PS/]]
+       PUSH    P,0
+       HRROI   0,[ASCIZ /MDL/]
+       SKIPLE  WRT-1(E)                
+        HRROI  0,[ASCIZ /MDLLIB/]      ; USE MDLLIB FOR SPECIAL CASE
+       PUSH    P,0
+       PUSH    P,D
+       PUSH    P,B
+       PUSH    P,C%0           ; [0]
+       PUSH    P,C%0           ; [0]
+       PUSH    P,C%0           ; [0]
+       MOVEI   B,0
+       MOVE    D,4(E)          ; save final version string
+       GTJFN
+        JRST   OPMLOS          ; FAILURE
+       MOVEM   A,DIRCHN
+       MOVE    B,[440000,,OF%RD+OF%EX]
+       SKIPGE  WRT-1(E)
+        MOVE   B,[440000,,OF%RD+OF%WR]
+       OPENF
+        FATAL  OPENF FAILED
+       MOVE    P,E             ; flush crap
+       PUSH    P,A
+       SIZEF                   ; get length
+        JRST   MAPLOS
+       SKIPL   WRT-1(E)
+        MOVEM  C,FLEN-1(E)     ; ONLY SAVE LENGTH FOR READ JFNS
+       SETZM   SPAG-1(E)
+
+; RESTORE STACK AND LEAVE
+
+       MOVE    P,E
+       MOVE    A,C             ; NUMBER OF PAGES IN A, DAMN!
+       AOS     (P)
+       POPJ    P,
+
+OPMLOS:        MOVE    P,E
+       POPJ    P,
+
+; CONVERT A NUMBER IN C TO AN ASCII STRING LEFT JUSTIFIED IN C
+
+NTOSEV:        PUSH    P,A                     ; SAVE A AND B
+       PUSH    P,B
+       PUSH    P,D
+       MOVE    D,[440700,,C]
+       MOVEI   A,(C)                   ; GET NUMBER
+       MOVEI   C,0
+       IDIVI   A,100.                  ; GET RESULT OF DIVISION
+       JUMPE   A,ALADD
+       ADDI    A,60                    ; CONVERT TO DIGIT
+       IDPB    A,D
+ALADD: MOVEI   A,(B)
+       IDIVI   A,10.                   ; GET TENS DIGIT
+       ADDI    A,60
+       IDPB    A,D
+ALADD1:        ADDI    B,60
+       IDPB    B,D
+       POP     P,D
+       POP     P,B
+       POP     P,A
+       POPJ    P,
+
+]
+
+; ROUTINE TO READ IN THE FIXUPS FROM DIRCHN OR MAPCH WORKS
+; FOR FIXUP FILE OR FIXUPS IN A SEPERATE FILE AS LONG AS THE
+; CHANNEL IS OPENED AND ACCESSED TO THE RIGHT PLACE
+
+RFXUP:
+IFN ITS,[
+       MOVE    0,[-2,,A]               ; PREPARE TO READ VERSION AND LENGTH
+       .IOT    MAPCH,0                 ; READ IT IN
+       SKIPGE  0                       ; SKIP IF NOT HIT EOF
+       FATAL   BAD FIXUP FILE
+       MOVEI   A,-2(A)                 ; COUNT FOR FIRST 2 WORDS
+       HRRM    B,VER-1(P)              ; SAVE VERSION #
+       .IOPUS  MAPCH,                  ; PUSH THE MAPPING CHANNEL
+       SETOM   PLODR
+       PUSHJ   P,IBLOCK                ; GET A UVECTOR OF APPROPRIATE SIZE
+       SETZM   PLODR
+       .IOPOP  MAPCH,
+       MOVE    0,$TUVEC
+       MOVEM   0,-1(TP)                ; SAVE UVECTOR
+       MOVEM   B,(TP)
+       MOVE    A,B                     ; GET AOBJN POINTER TO UVECTOR FOR IOT
+       .IOT    MAPCH,A                 ; GET FIXUPS
+       .CLOSE  MAPCH,
+       POPJ    P,
+]
+
+IFE ITS,[
+       MOVE    A,DIRCHN
+       BIN                             ; GET LENGTH OF FIXUP
+       MOVE    C,B
+       MOVE    A,DIRCHN
+       BIN                             ; GET VERSION NUMBER
+       HRRM    B,VER-1(P)
+       SETOM   PLODR
+       MOVEI   A,-2(C)
+       PUSHJ   P,IBLOCK
+       SETZM   PLODR
+       MOVSI   0,$TUVEC
+       MOVEM   0,-1(TP)
+       MOVEM   B,(TP)
+       MOVE    A,DIRCHN
+       HLRE    C,B
+;      SKIPE   OPSYS           ; SKIP IF TOPS20 SINCE C MUST BE NEGETIVE
+;       MOVNS  C               ; C IS POSITIVE FOR TENEX ?????
+       HRLI    B,444400
+       SIN
+       MOVE    A,DIRCHN
+       CLOSF
+        FATAL  CANT CLOSE FIXUP FILE
+       RLJFN
+        JFCL
+       POPJ    P,
+]
+
+; ROUTINE TO READ IN THE CODE
+
+RSAV:  MOVE    A,FLEN-1(P)
+       PUSHJ   P,ALOPAG                ; GET PAGES
+       JRST    MAPLS2
+       MOVE    E,SPAG-1(P)
+
+IFN ITS,[
+       MOVN    A,FLEN-1(P)     ; build aobjn pointer
+       MOVSI   A,(A)
+       HRRI    A,(B)
+       MOVE    B,A
+       HRRI    0,(E)
+       DOTCAL  CORBLK,[[1000,,104000],[1000,,-1],A,[1000,,MAPCH],0]
+        .LOSE  %LSSYS
+       .CLOSE  MAPCH,
+       POPJ    P,
+]
+IFE ITS,[
+       PUSH    P,B             ; SAVE PAGE #
+       MOVS    A,DIRCHN        ; SOURCE (MUDSAV)
+       HLRM    A,SJFNS         ; SAVE POINTER FOR FUTURE CLOSING
+       HRR     A,E
+       HRLI    B,.FHSLF        ; DESTINATION (FORK)
+       MOVSI   C,PM%RD+PM%CPY  ; MAKE COPY ON WRITE
+       SKIPE   OPSYS
+        JRST   RSAV1           ; HANDLE TENEX
+       TLO     C,PM%CNT        ; REPEAT COUNT BIT FOR TOPS20
+       HRR     C,FLEN-2(P)     ; PAGE (FOR PUSHJ AND PUSHED B)
+       PMAP
+RSAVDN:        POP     P,B
+       MOVN    0,FLEN-1(P)
+       HRL     B,0
+       POPJ    P,
+
+RSAV1: HRRZ    D,FLEN-2(P)     ; GET IN PAGE COUNT
+RSAV2: PMAP
+       ADDI    A,1             ; NEXT PAGE
+       ADDI    B,1     
+       SOJN    D,RSAV2         ; LOOP
+       JRST    RSAVDN
+]
+
+PDLOV: SUB     P,[NSLOTS,,NSLOTS]
+       PUSH    P,C%0           ; [0]; CAUSE A PDL OVERFLOW
+       JRST    .-1
+
+; CONSTANTS RELATED TO DATA BASE
+DEV:   SIXBIT /DSK/
+MODE:  6,,0
+MNDIR: SIXBIT /MUDSAV/                         ; DIR OF MAIN DATA BASE FILES
+WRKDIR:        SIXBIT /MUDTMP/                         ; DIRECTORY OF UPDATE FILES
+
+IFN ITS,[
+MNBLK: SETZ
+       SIXBIT /OPEN/
+       MODE
+       DEV
+       [SIXBIT /SAV/]
+       [SIXBIT /FILE/]
+       SETZ MNDIR
+
+
+FIXBLK:        SETZ
+       SIXBIT /OPEN/
+       MODE
+       DEV
+       [SIXBIT /FIXUP/]
+       [SIXBIT /FILE/]
+       SETZ MNDIR
+
+FOPBLK:        SETZ
+       SIXBIT /OPEN/
+        A
+        DEV
+        B
+        C
+        SETZ WRKDIR
+
+FXTBL: -2,,.+1
+       55.
+       54.
+]
+IFE ITS,[
+
+FXSTR: ASCIZ /PS:<MDL>FIXUP.FILE/
+SAVSTR:        ASCIZ /PS:<MDL>SAV.FILE/
+TFXSTR:        ASCIZ /DSK:<MDL>FIXUP.FILE/
+TSAVST:        ASCIZ /DSK:<MDL>SAV.FILE/
+
+FXTBL: -3,,.+1
+       55.
+       54.
+       104.
+]
+IFN SPCFXU,[
+
+;This code does two things to code for FBIN;
+;      1)      Makes dispatches win in multi seg mode
+;      2)      Makes OBLIST? work with "new" atom format
+;      3)      Makes LENGTH win in multi seg mode
+;      4)      Gets AOBJN pointer to code vector in C
+
+SFIX:  PUSH    P,A
+       PUSH    P,B
+       PUSH    P,C             ; for referring back
+
+SFIX1: MOVSI   B,-MLNT         ; for looping through tables    
+
+SFIX2: MOVE    A,(C)           ; get code word
+
+       AND     A,SMSKS(B)
+       CAMN    A,SPECS(B)      ; do we match
+        JRST   @SFIXR(B)
+
+       AOBJN   B,SFIX2
+
+SFIX3: AOBJN   C,SFIX1         ; do all of code
+SFIX4: POP     P,C
+       POP     P,B
+       POP     P,A
+       POPJ    P,
+
+SMSKS: -1
+       777000,,-1
+       -1,,0
+       777037,,0
+MLNT==.-SMSKS
+
+SPECS: HLRES   A               ; begin of arg diaptch table
+       SKIPN   2               ; old compiled OBLIST?
+       JRST    (M)             ; compiled LENGTH
+       ADDI    (M)             ; begin a case dispatch
+
+SFIXR: SETZ    DFIX
+       SETZ    OBLFIX
+       SETZ    LFIX
+       SETZ    CFIX
+
+DFIX:  AOBJP   C,SFIX4         ; make sure dont run out
+       MOVE    A,(C)           ; next ins
+       CAME    A,[ASH A,-1]    ; still winning?
+        JRST   SFIX3           ; false alarm
+       AOBJP   C,SFIX4         ; make sure dont run out
+       HLRZ    A,(C)           ; next ins
+       CAIE    A,(ADDI A,(M))  ; still winning?
+        JRST   SFIX3           ; false alarm
+       AOBJP   C,SFIX4
+       HLRZ    A,(C)
+       CAIE    A,(PUSHJ P,@(A))        ; last one to check
+        JRST   SFIX3
+       AOBJP   C,SFIX4
+       MOVE    A,(C)
+       CAME    A,[JRST FINIS]          ; extra check
+        JRST   SFIX3
+
+       MOVSI   B,(SETZ)
+SFIX5: AOBJP   C,SFIX4
+       HLRZ    A,(C)
+       CAIN    A,(SUBM M,(P))
+        JRST   SFIX3
+       CAIE    A,M                     ; dispatch entry?
+        JRST   SFIX3           ; maybe already fixed
+       IORM    B,(C)           ; fix it
+       JRST    SFIX5
+
+OBLFIX:        MOVSI   B,-OLN          ; for checking more ins
+       PUSH    P,C
+
+OBLFI1:        AOBJP   C,OBLFXX
+       MOVE    A,(C)
+       AND     A,OMSK(B)
+       CAME    A,OINS(B)
+        JRST   OBLFXX
+       AOBJN   B,OBLFI1
+       JRST    DOOBFX
+
+OBLFXX:        MOVSI   B,-OLN2         ; for checking more ins
+       MOVE    C,(P)
+
+OBLFX1:        AOBJP   C,OBLFI2
+       MOVE    A,(C)
+       AND     A,OMSK2(B)
+       CAME    A,OINS2(B)
+        JRST   OBLFI2
+       AOBJN   B,OBLFX1
+
+INSBP==331100                  ; byte pointer for ins field
+ACBP==270400                   ; also for ac
+INDXBP==220400
+
+DOOBFX:        POP     P,C
+       MOVEI   B,<<(HRRZ)>_<-9>>       ; change em
+       DPB     B,[INSBP,,(C)]  ; SKIPN==>HRRZ
+       LDB     A,[ACBP,,(C)]   ; get AC field
+       MOVEI   B,<<(JUMPE)>_<-9>>
+       DPB     B,[INSBP,,1(C)]
+       DPB     A,[ACBP,,1(C)]
+       AOS     1(C)            ; JRST FOO==>JUMPE ac,FOO+1
+       MOVE    B,[CAMG VECBOT]
+       DPB     A,[ACBP,,B]
+       MOVEM   B,2(C)          ; JUMPL ==> CAMG ac,VECBOT
+       HRRZ    A,3(C)          ; get indicator of existence of ADD AC,TVP
+       CAIE    A,TVP           ; skip if extra ins exists
+        JRST   NOATVP
+       MOVSI   A,(JFCL)
+       EXCH    A,4(C)
+       MOVEM   A,3(C)
+       ADD     C,C%11
+NOATVP:        TLC     B,(CAMG#HRLI)   ; change CAMG to HRLI (preserving AC)
+       HLLOM   B,5(C)          ; in goes HRLI -1
+       MOVSI   B,(CAIA)        ;  skipper
+       EXCH    B,6(C)
+       MOVEM   B,7(C)
+       ADD     C,[7,,7]
+       JRST    SFIX3
+
+OBLFI2:        POP     P,C
+       JRST    SFIX3
+
+; Here to fixup compiled LENGTH
+
+LFIX:  MOVSI   B,-LLN          ; for checking other LENGTH ins
+       PUSH    P,C
+
+LFIX1: AOBJP   C,OBLFI2
+       MOVE    A,(C)
+       AND     A,LMSK(B)
+       CAME    A,LINS(B)
+        JRST   OBLFI2
+       AOBJN   B,LFIX1
+
+       POP     P,C             ; restore code pointer
+       MOVE    A,(C)           ; save jump for its addr
+       MOVE    B,[MOVSI 400000]
+       MOVEM   B,(C)           ; JRST .+2 ==> MOVSI 0,400000
+       LDB     B,[ACBP,,1(C)]  ; B==> AC of interest
+       ADDI    A,2
+       DPB     B,[ACBP,,A]
+       MOVEI   B,<<(JUMPE)>_<-9.>>
+       DPB     B,[INSBP,,A]
+       EXCH    A,1(C)
+       TLC     A,(HRR#HRRZ)    ; HRR==>HRRZ
+       HLLZM   A,2(C)          ; TRNN AC,-1 ==> HRRZ AC,(AC)
+       MOVEI   B,(AOBJN (M))
+       HRLM    B,3(C)          ; AOBJP AC,.-2 ==> AOBJN 0,.-2
+       MOVE    B,2(C)          ; get HRRZ AC,(AC)
+       TLZ     B,17            ; kill (AC) part
+       MOVEM   B,4(C)          ; HLRZS AC ==> HRRZ AC,0
+       ADD     C,C%44
+       JRST    SFIX3
+
+; Fixup a CASE dispatch
+
+ CFIX: LDB     A,[ACBP,,(C)]
+       AOBJP   C,SFIX4
+       HLRZ    B,(C)           ; Next ins
+       ANDI    B,777760
+       CAIE    B,(JRST @)
+        JRST   SFIX3
+       LDB     B,[INDXBP,,(C)]
+       CAIE    A,(B)
+        JRST   SFIX3
+       MOVE    A,(C)           ; ok, fix it up
+       TLZ     A,20            ; kill indirection
+       MOVEM   A,(C)
+       HRRZ    B,-1(C)         ; point to table
+       ADD     B,(P)           ; point to code to change
+
+CFIXLP:        HLRZ    A,(B)           ; check one out
+       CAIE    A,M             ; check for just index
+        JRST   SFIX3
+       MOVEI   A,(JRST (M))
+       HRLM    A,(B)
+       AOJA    B,CFIXLP
+
+DEFINE FOO LBL,LNT,LBL2,L
+LBL:
+       IRP A,,[L]
+               IRP B,C,[A]
+                       B
+                       .ISTOP
+               TERMIN
+       TERMIN
+LNT==.-LBL
+LBL2:
+       IRP A,,[L]
+               IRP B,C,[A]
+                       C
+                       .ISTOP
+               TERMIN
+       TERMIN
+TERMIN
+
+IMSK==777017,,0
+AIMSK==777000,,-1
+
+FOO OINS,OLN,OMSK,[[<JRST (M)>,IMSK],[<JUMPL (M)>,IMSK],[MOVE,AIMSK]
+                  [<MOVE $TOBLS>,AIMSK],[<JRST (M)>,IMSK]
+                  [<MOVE $TFALSE>,AIMSK],[MOVEI,AIMSK]]
+
+FOO OINS2,OLN2,OMSK2,[[<JRST (M)>,IMSK],[<JUMPL (M)>,IMSK],[<ADD TVP>,AIMSK]
+                     [MOVE,AIMSK],[<MOVE $TOBLS>,AIMSK],[<JRST (M)>,IMSK]
+                     [<MOVE $TFALSE>,AIMSK],[MOVEI,AIMSK]]
+
+FOO LINS,LLN,LMSK,[[<HRR -1>,AIMSK],[<TRNE -1>,AIMSK],[<AOBJP (M)>,IMSK]
+                  [<HLRZS>,<-1,,777760>]]
+
+]
+IMPURE
+
+SAVSNM:        0                                       ; SAVED SNAME
+INPLOD:        0                                       ; FLAG SAYING WE ARE IN MAPPUR
+
+IFE ITS,[
+MAPJFN: 0                                      ; JFN OF <MDL>SAV FILE
+DIRCHN:        0                                       ; JFN USED BY GETDIR
+]
+
+PURE
+
+END
+