github.com/PDP-10.its
1
0
Fork 0
mirror of https://github.com/PDP-10/its.git synced 2026-01-17 16:53:23 +00:00
Code Issues Releases Wiki Activity
PDP-10.its/src/mudsys/mappur.163

1991 lines
41 KiB
Plaintext
Raw Blame History

This file contains invisible Unicode characters

This file contains invisible Unicode characters that are indistinguishable to humans but may be processed differently by a computer. If you think that this is intentional, you can safely ignore this warning. Use the Escape button to reveal them.

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
MOVE B,FB.PTR(C)
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:
IFE ITS,[
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,
]
; 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 D,PURVEC+1 ; get pointer to table
CLN1:
IFE ITS,[
SKIPN A,FB.PTR(D)
JRST NOCL
ASH A,-PGSHFT
HRLI A,.FHSLF
RMAP
HLRZS A
CLOSF
JFCL
]
NOCL: SETZM FB.PTR(D) ; zero pointer entry
SETZM FB.AGE(D) ; zero link and age slots
SETZM FB.PGS(D)
ADD D,[ELN,,ELN] ; go to next slot
JUMPL D,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
]
; 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
; 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
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
Reference in New Issue View Git Blame Copy Permalink