--- /dev/null
+
+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
+.GLOBAL MAPJFN,DIRCHN
+
+.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: CAMLE B,PURBTB(A) ; if this one is larger (or the same)
+ 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,A
+ 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
+ POP P,A
+
+ 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: CAMGE 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
+IFE ITS,[
+ JUMPL C,.+3
+ JUMPL E,GETPAG
+ JRST GETPAX
+]
+IFN ITS, 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-1
+ 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: PUSH P,[-TLN,,TPTR]
+ PUSH P,C
+ MOVE B,-1(P)
+
+OBLFXY: PUSH P,1(B)
+ PUSH P,(B)
+
+OBLFI1: AOBJP C,OBLFXX
+ MOVE A,(C)
+ AOS B,(P)
+ AND A,(B)
+ MOVE B,-1(P)
+ CAME A,(B)
+ JRST OBLFXX
+ AOBJP B,DOOBFX
+ MOVEM B,-1(P)
+ JRST OBLFI1
+
+OBLFXX: SUB P,C%22 ; for checking more ins
+ MOVE B,-1(P)
+ ADD B,C%22
+ JUMPGE B,OBLFX1
+ MOVEM B,-1(P)
+ MOVE C,(P)
+ JRST OBLFXY
+
+
+INSBP==331100 ; byte pointer for ins field
+ACBP==270400 ; also for ac
+INDXBP==220400
+
+DOOBFX: MOVE C,-2(P)
+ SUB P,C%44
+ 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)
+ HRRZ A,4(C) ; see if moves in type
+ CAIE A,$TOBLS
+ SUB C,[1,,1] ; fudge it
+ HLLOM B,5(C) ; in goes HRLI -1
+ CAIE A,$TOBLS ; do we need a skip?
+ JRST NOOB$
+ MOVSI B,(CAIA) ; skipper
+ EXCH B,6(C)
+ MOVEM B,7(C)
+ ADD C,[7,,7]
+ JRST SFIX3
+
+NOOB$: MOVSI B,(JFCL)
+ MOVEM B,6(C)
+ ADD C,C%66
+ JRST SFIX3
+
+OBLFX1: MOVE C,(P)
+ SUB P,C%22
+ JRST SFIX3
+
+; Here to fixup compiled LENGTH
+
+LFIX: MOVSI B,-LLN ; for checking other LENGTH ins
+ PUSH P,C
+
+LFIX1: AOBJP C,LFIXY
+ MOVE A,(C)
+ AND A,LMSK(B)
+ CAME A,LINS(B)
+ JRST LFIXY
+ 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
+
+LFIXY: POP P,C
+ 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
+ TRZ A,400000 ; kill bit
+ CAIE A,M ; check for just index (or index with SETZ)
+ 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 OINS3,OLN3,OMSK3,[[<JRST (M)>,IMSK],[<JUMPL (M)>,IMSK],[MOVE,AIMSK]
+ [<JRST (M)>,IMSK],[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 OINS4,OLN4,OMSK4,[[<JRST (M)>,IMSK],[<JUMPL (M)>,IMSK],[<ADD TVP>,AIMSK]
+ [MOVE,AIMSK],[<JRST (M)>,IMSK],[MOVEI,AIMSK]]
+
+TPTR: -OLN,,OINS
+ OMSK-1
+ -OLN2,,OINS2
+ OMSK2-1
+ -OLN3,,OINS3
+ OMSK3-1
+ -OLN4,,OINS4
+ OMSK4-1
+TLN==.-TPTR
+
+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
+