(FILECREATED " 5-Sep-85 19:12:21" {ERIS}<LISP>INTERMEZZO>PATCHES>FAULTPATCH.;2 34019
changes to: (VARS FAULTPATCHCOMS)
(MACROS .LOCKABLERP.)
(FNS \ASSURE.FPTOVP.PAGE \MOVEREALPAGE \DOTEMPLOCKPAGES \INSTALLFAULTPATCH)
previous date: " 5-Sep-85 19:08:25" {ERIS}<LISP>INTERMEZZO>PATCHES>FAULTPATCH.;1)
(* Copyright (c) 1985 by Xerox Corporation. All rights reserved.)
(PRETTYCOMPRINT FAULTPATCHCOMS)
(RPAQQ FAULTPATCHCOMS [[DECLARE: DONTEVAL@LOAD DOCOPY FIRST (P (RESETSAVE DFNFLG (QUOTE PROP]
(FNS \PAGEFAULT \ASSURE.FPTOVP.PAGE \MOVEREALPAGE \FLUSHVMOK? \FLUSHPAGE \DONEWPAGE
\DOTEMPLOCKPAGES \TEMPLOCKPAGES \WRITEDIRTYPAGE1 \WRITEDIRTYPAGE \DOLOCKPAGES
\MAKESPACEFORLOCKEDPAGE \DONEWEPHEMERALPAGE \LOADVMEMPAGE \SELECTREALPAGE)
(FNS \INSTALLFAULTPATCH)
(INITVARS (\NEWVMEMPAGEADDED))
(GLOBALVARS \NEWVMEMPAGEADDED)
(DECLARE: EVAL@COMPILE DONTCOPY (MACROS .LOCKABLERP.))
(DECLARE: DONTEVAL@LOAD DOCOPY (P (\INSTALLFAULTPATCH])
(DECLARE: DONTEVAL@LOAD DOCOPY FIRST
(RESETSAVE DFNFLG (QUOTE PROP))
)
(DEFINEQ
(\PAGEFAULT
[LAMBDA (PTR) (* bvm: "13-Aug-85 16:38")
(\CLOCK0 (LOCF (fetch SWAPTEMP0 of \MISCSTATS))) (* Note time of start)
(PROG ((VP (fetch (POINTER PAGE#) of PTR))
FLAGS FILEPAGE)
(COND
((fetch (VP INVALID) of VP) (* Map out of bounds on Dolphin always produces -1 as
the vp. Don't know about other machines)
(\MP.ERROR \MP.MOB "Page Fault: Map out of bounds" (AND (NEQ VP 65535)
PTR)
T))
([NOT (fetch (VMEMFLAGS VACANT) of (SETQ FLAGS (\READFLAGS VP]
(\MP.ERROR \MP.RESIDENT "Fault on resident page" PTR T))
((EQ (SETQ FILEPAGE (\LOOKUPPAGEMAP VP))
0)
(\INVALIDADDR PTR))
(T (COND
((EQ (\HILOC PTR)
\STACKHI) (* should never happen. For debugging)
(\MP.ERROR \MP.STACKFAULT "Fault on stack" PTR T)))
(\LOADVMEMPAGE VP FILEPAGE)))
(COND
(\NEWVMEMPAGEADDED (* Only happens if VMEM.PURE.STATE on)
(\ASSURE.FPTOVP.PAGE)))
[\BOXIPLUS (LOCF (fetch SWAPWAITTIME of \MISCSTATS))
(\BOXIDIFFERENCE (\CLOCK0 (LOCF (fetch SWAPTEMP1 of \MISCSTATS)))
(LOCF (fetch SWAPTEMP0 of \MISCSTATS]
(* Count the time used.)
(RETURN PTR])
(\ASSURE.FPTOVP.PAGE
[LAMBDA NIL (* bvm: "13-Aug-85 16:29")
(* Called at the end of some swapping operation that added one or more pages to the vmem file, setting
\NEWVMEMPAGEADDED true. If we're going to need a new page of \FPTOVP soon, do it now while there's still maneuvering
room. The allowance below is for the worst case, which can happen when VMEM.PURE.STATE is on and \NEWPAGE was called
needing a new pagemap page as well, in which case we could have as many as the following new vmem pages before we're
home safe -
1: \NEWPAGE added a page -
2: a page was displaced by the new page and written to the end of the vmem -
3: a new pagemap page was needed -
4: it displaced a page to end of vmem -
5: the new \FPTOVP page below -
6: a page displaced by same. -
-
Alternatively, it could have been the new \FPTOVP page that needed a new pagemap block. Will never have both needing
a new pagemap block, since there are several pagemap blocks per page)
(LET ((FILEPAGE (fetch (IFPAGE NActivePages) of \InterfacePage)))
(COND
((IGREATERP (IMOD FILEPAGE WORDSPERPAGE)
(IDIFFERENCE WORDSPERPAGE 7)) (* This is a no-op if the page has already been
allocated)
(\DONEWPAGE (\ADDBASE \FPTOVP (CEIL FILEPAGE WORDSPERPAGE))
T T)))
(SETQ \NEWVMEMPAGEADDED NIL])
(\MOVEREALPAGE
[LAMBDA (SOURCEINDEX SOURCERPT DESTINDEX DESTRPT) (* bvm: "14-Aug-85 13:53")
(* * Moves the page, if any, currently living in real page table SOURCEINDEX & SOURCERPT into the page indicated by
DESTINDEX & DESTRPT. The destination is assumed to have been vacated)
(CHECK (NOT (fetch (RPT LOCKED) of SOURCERPT)))
(replace (RPT LOCKED) of DESTRPT with NIL)
[COND
((fetch (RPT OCCUPIED) of SOURCERPT) (* Page was not vacant to start with)
(LET* ((SOURCEVP (fetch (RPT VP) of SOURCERPT))
(SOURCEFLAGS (\READFLAGS SOURCEVP)))
(replace (RPT VP) of DESTRPT with SOURCEVP)
(replace (RPT FILEPAGE) of DESTRPT with (fetch (RPT FILEPAGE) of SOURCERPT))
(\WRITEMAP \EMBUFVP (RPFROMRPT DESTINDEX)
0) (* Map buffer to target page)
(\BLT \EMBUFBASE (create POINTER
PAGE# ← SOURCEVP)
WORDSPERPAGE) (* move data to buffer page)
(\WRITEMAP \EMBUFVP \EMBUFRP 0) (* Restore buffer to its proper page)
(\WRITEMAP SOURCEVP (RPFROMRPT DESTINDEX)
SOURCEFLAGS) (* Set flags and new RP for page)
]
DESTINDEX])
(\FLUSHVMOK?
[LAMBDA (TYPE NOERROR) (* bvm: " 5-Sep-85 18:38")
(* * Called before any attempt to do a \FLUSHVM to make sure it's ok)
(LET [(MSG (COND
((SELECTQ \VMEM.FULL.STATE
((T DIRTY)
T)
NIL)
"-- virtual memory backing file too small")
((AND \VMEM.PURE.LIMIT (NEQ \VMEM.PURE.LIMIT -1)
(NOT VMEM.COMPRESS.FLG))
" while VMEM.PURE.STATE is on."]
(COND
((NOT MSG)
T)
(T [COND
((NOT NOERROR)
(ERROR [CONCAT "Can't " (OR TYPE (SETQ TYPE (QUOTE LOGOUT]
MSG
(COND
((EQ TYPE (QUOTE LOGOUT))
"
You may (LOGOUT T), which quits without saving state.")
(T ""]
NIL])
(\FLUSHPAGE
[LAMBDA (RPTINDEX FROMFLUSHVM) (* bvm: "13-Aug-85 16:35")
(* * Write out real page RPTINDEX if it is dirty.)
(PROG ((RPTR (fetch RPTRBASE of RPTINDEX))
VP FP NEWFP)
(COND
([AND (fetch (RPT OCCUPIED) of RPTR)
(fetch (VMEMFLAGS DIRTY) of (\READFLAGS (SETQ VP (fetch (RPT VP) of RPTR]
(* Yes, page is dirty)
(SETQ FP (fetch (RPT FILEPAGE) of RPTR))
[COND
[(AND \VMEM.PURE.LIMIT (NOT FROMFLUSHVM)) (* Don't sully vmem; write page out beyond the original
end of vmem)
(COND
((ILEQ FP \VMEM.PURE.LIMIT)
(COND
((fetch (RPT LOCKED) of RPTR)
(\MP.ERROR \MP.WRITING.LOCKED.PAGE)))
(SETQ NEWFP (add (fetch NActivePages of \InterfacePage)
1))
(COND
((IGREATERP NEWFP (IDIFFERENCE \LASTVMEMFILEPAGE \GUARDVMEMFULL))
(\SET.VMEM.FULL.STATE)))
(SETQ \NEWVMEMPAGEADDED T)
(\PUTBASE (.PAGEMAPBASE. VP)
0 NEWFP)
(\PUTBASE \FPTOVP NEWFP VP)
(\PUTBASE \FPTOVP FP \NO.VMEM.PAGE)
(replace (RPT FILEPAGE) of RPTR with (SETQ FP NEWFP]
((.VMEM.CONSISTENTP.)
(replace (IFPAGE Key) of \InterfacePage with (LOGNOT16 \IFPValidKey))
(* Invalidate vmem and write out the Interface page)
(SETQ \DIRTYPAGEHINT 0) (* So that the dirty page background writer wakes up)
(PROG ((IFVP (fetch (POINTER PAGE#) of \InterfacePage)))
(\TRANSFERPAGE IFVP \FirstVmemBlock (RPTFROMRP (\READRP IFVP))
T NIL] (* Write it out)
(COND
((IGREATERP \DIRTYPAGEHINT 0)
(add \DIRTYPAGEHINT -1)))
(\TRANSFERPAGE VP FP RPTINDEX T NIL])
(\DONEWPAGE
[LAMBDA (BASE LOCK? INTERNALFLG) (* bvm: "13-Aug-85 16:32")
(* * Allocates new page at BASE, locking it if LOCK? is true. Returns vmemfile page# on success, NIL if page already
exists. Must be run in safe context! because it can cause vmem activity)
(AND \DOFAULTINIT (\FAULTINIT)) (* Only an issue when INIT.SYSOUT starts.
Perhaps there is a better place to put this)
(PROG ((VP (fetch (POINTER PAGE#) of BASE))
MAPBASE LOCKBASE FILEPAGE NEXTPM ERRCODE)
(RETURN (COND
((fetch (VP INVALID) of VP)
(\INVALIDVP VP)
NIL)
(T (SETQ MAPBASE (\GETBASE \PageMapTBL (fetch (VP PRIMARYKEY) of VP)))
(COND
((EQ MAPBASE \EMPTYPMTENTRY) (* Need to create a new second-level block)
(SETQ NEXTPM (fetch (IFPAGE NxtPMAddr) of \InterfacePage))
[COND
((EVENP NEXTPM WORDSPERPAGE)
(* Need a new secondary pagemap page. This recursion is ok, because we know that SETUPPAGEMAP assures that the
pagemap pages for all the pages in secondary map space were created at MAKEINIT time)
(OR (\DONEWPAGE (\ADDBASE \PAGEMAP NEXTPM)
T T)
(RETURN (\MP.ERROR \MP.NEWMAPPAGE
"\DONEWPAGE failed to allocate new map page"]
(\PUTBASE \PageMapTBL (fetch (VP PRIMARYKEY) of VP)
NEXTPM)
(replace (IFPAGE NxtPMAddr) of \InterfacePage with (IPLUS NEXTPM
\PMblockSize))
(SETQ MAPBASE NEXTPM)))
[SETQ MAPBASE (\ADDBASE \PAGEMAP (IPLUS MAPBASE (fetch (VP SECONDARYKEY)
of VP]
(COND
((NEQ (\GETBASE MAPBASE 0)
0) (* Page exists)
(RETURN NIL)))
(SETQ FILEPAGE (add (fetch (IFPAGE NActivePages) of \InterfacePage)
1))
(replace (IFPAGE NDirtyPages) of \InterfacePage with FILEPAGE)
(* Currently a redundant field)
[COND
(LOCK? (SETQ FILEPAGE (\MAKESPACEFORLOCKEDPAGE VP FILEPAGE))
(\PUTBASE (SETQ LOCKBASE (.LOCKEDVPBASE. VP))
0
(LOGOR (.LOCKEDVPMASK. VP)
(\GETBASE LOCKBASE 0]
(\PUTBASE \FPTOVP FILEPAGE VP)
(\PUTBASE MAPBASE 0 FILEPAGE)
(\LOADVMEMPAGE VP FILEPAGE T LOCK?)
(COND
(INTERNALFLG (SETQ \NEWVMEMPAGEADDED T))
(T (* Make sure \FPTOVP extended if necessary)
(\ASSURE.FPTOVP.PAGE)))
FILEPAGE])
(\DOTEMPLOCKPAGES
[LAMBDA (BASE NPAGES) (* bvm: "10-Aug-85 18:26")
(* "Temporarily" locks BASE for NPAGES, i.e. ensures that the swapper will not move the pages.
Information vanishes at logout etc. This function must be locked because it manipulates the page table table.
Runs in MISC context)
(to NPAGES as VP from (fetch (POINTER PAGE#) of BASE) bind RPTBASE RPINDEX RP
do (\TOUCHPAGE BASE) (* Touch page in case not resident)
[SETQ RPTBASE (fetch RPTRBASE of (SETQ RPINDEX (RPTFROMRP (SETQ RP (\READRP VP]
[COND
((NOT (.LOCKABLERP. RP))
(* Page already swapped in, but lives in a real page that might need to get bumped (e.g., for stack), so move it
now)
(LET* ((NEWINDEX (\SELECTREALPAGE NIL T))
(NEWRPT (fetch RPTRBASE of NEWINDEX)))
(\MOVEREALPAGE RPINDEX RPTBASE NEWINDEX NEWRPT)
(replace (RPT EMPTY) of RPTBASE with T) (* Mark vacated RPT entry empty)
(SETQ RPTBASE NEWRPT]
(replace (RPT LOCKED) of RPTBASE with T)
(SETQ BASE (\ADDBASE BASE WORDSPERPAGE])
(\TEMPLOCKPAGES
[LAMBDA (BASE NPAGES) (* bvm: "10-Aug-85 18:17")
(* * "Temporarily" locks BASE for NPAGES, i.e. ensures that the swapper will not move the pages.
Information vanishes at logout etc.)
(\MISCAPPLY* (FUNCTION \DOTEMPLOCKPAGES)
BASE NPAGES])
(\WRITEDIRTYPAGE1
[LAMBDA (RP RPTR) (* bvm: "13-Aug-85 16:41")
(* Write out buffer RP. This fn is locked and called in
the misc context)
(COND
([AND (NOT (fetch (RPT LOCKED) of RPTR))
(fetch (VMEMFLAGS DIRTY) of (\READFLAGS (fetch (RPT VP) of RPTR]
(* Verify that the page is still a candidate, so
previous loop could be interruptable)
(\FLUSHPAGE RP)
(COND
(\NEWVMEMPAGEADDED (\ASSURE.FPTOVP.PAGE])
(\WRITEDIRTYPAGE
[LAMBDA (MINDIRTY) (* bvm: "13-Aug-85 17:51")
(COND
((OR (NOT (.VMEM.CONSISTENTP.))
(AND \VMEM.PURE.LIMIT (NEQ \VMEM.PURE.LIMIT -1)
(NOT \VMEM.FULL.STATE)))
(PROG ((RPTR (OR \LASTDIRTYSCANPTR \REALPAGETABLE))
(NUMDIRTY (OR \LASTDIRTYCNT 0))
(CNT \MAXDIRTYSCANCOUNT)
RP FP FLAGS)
[COND
((AND (NULL \LASTDIRTYSCANPTR)
(IGREATERP (IPLUS (add \DIRTYPAGECOUNTER 1)
\PAGEFAULTCOUNTER)
\UPDATECHAINFREQ)) (* Take this time to update the page chain instead)
(RETURN (UNINTERRUPTABLY
(\MISCAPPLY* (FUNCTION \UPDATECHAIN)))]
(OR MINDIRTY (SETQ MINDIRTY 1))
LP [COND
[(EQ (SETQ RP (fetch (RPT NEXTRP) of RPTR))
\PAGETABLESTOPFLG) (* Hit end of chain. Write out what we found if enough
were dirty)
(COND
((AND (IGEQ NUMDIRTY MINDIRTY)
(NEQ NUMDIRTY 0)
(SETQ RP \LASTDIRTYFOUND))
(GO GOTPAGE))
(T (SETQ \LASTDIRTYSCANPTR (SETQ \LASTDIRTYCNT (SETQ \LASTDIRTYFOUND NIL)))
[COND
((AND (NEQ NUMDIRTY 0)
(ILESSP \DIRTYSEEKMAX (LRSH MAX.SMALL.INTEGER 1)))
(* Failed because page not close enough, so widen the
tolerance)
(SETQ \DIRTYSEEKMAX (LLSH \DIRTYSEEKMAX 1]
(RETURN]
((fetch (RPT EMPTY) of (SETQ RPTR (fetch RPTRBASE of RP)))
(* Page is empty. Should never happen if key is valid)
(RETURN))
((NOT (fetch (RPT LOCKED) of RPTR)) (* Don't bother writing out locked pages, since they
don't help us in our swapping quest)
(SETQ FLAGS (\READFLAGS (fetch (RPT VP) of RPTR)))
(COND
((NOT (fetch (VMEMFLAGS DIRTY) of FLAGS))
(* Page not dirty; skip)
)
[(PROGN (SETQ FP (fetch (RPT FILEPAGE) of RPTR))
(IGREATERP (IABS (IDIFFERENCE (COND
((AND \VMEM.PURE.LIMIT (ILESSP FP
\VMEM.PURE.LIMIT))
(* We'd have to write page to a new place, not here)
(fetch (IFPAGE NActivePages)
of \InterfacePage))
(T FP))
\LASTACCESSEDVMEMPAGE))
\DIRTYSEEKMAX)) (* Page too far away, don't write it)
(COND
((fetch (VMEMFLAGS REFERENCED) of FLAGS)
(* but still count it)
(add NUMDIRTY 1]
((IGREATERP FP \LASTVMEMFILEPAGE) (* Can't write it)
)
((fetch (VMEMFLAGS REFERENCED) of FLAGS)
(* Page dirty but referenced.
Note it, but keep looking for a better one)
(COND
((EQ NUMDIRTY 0)
(SETQ \LASTDIRTYFOUND RP)))
(add NUMDIRTY 1))
(T (* Dirty, not referenced: do it)
(GO GOTPAGE]
(COND
((EQ (add CNT -1)
0) (* Scanned for long enough; don't lock user out)
(SETQ \LASTDIRTYSCANPTR RPTR)
(SETQ \LASTDIRTYCNT NUMDIRTY)
(RETURN)))
(GO LP)
GOTPAGE
(UNINTERRUPTABLY
(SETQ \LASTDIRTYSCANPTR (SETQ RPTR (fetch RPTRBASE of RP)))
(* Keep traveling pointer)
(SETQ \LASTDIRTYCNT (SETQ \LASTDIRTYFOUND NIL))
(COND
((ILEQ (IABS (IDIFFERENCE (fetch (RPT FILEPAGE) of RPTR)
\LASTACCESSEDVMEMPAGE))
\DIRTYSEEKMAX) (* Could fail if swapping since the selection has moved
the disk arm too far)
(\MISCAPPLY* (FUNCTION \WRITEDIRTYPAGE1)
RP RPTR)))
(SETQ \DIRTYSEEKMAX \MAXSHORTSEEK))
(RETURN T])
(\DOLOCKPAGES
[LAMBDA (BASE NPAGES) (* bvm: "16-Aug-85 05:41")
(for I from 0 to (SUB1 NPAGES) bind (VP ←(fetch (POINTER PAGE#) of BASE))
FILEPAGE MAPBASE RPTBASE RPINDEX RP MASK LOCKBASE
do [COND
((fetch (VP INVALID) of VP)
(\INVALIDVP VP))
[(EQ (SETQ MAPBASE (\GETBASE \PageMapTBL (fetch (VP PRIMARYKEY) of VP)))
\EMPTYPMTENTRY)
(\INVALIDADDR (ADDBASE BASE (UNFOLD I WORDSPERPAGE]
(T [SETQ MAPBASE (\ADDBASE \PAGEMAP (IPLUS MAPBASE (fetch (VP SECONDARYKEY) of VP]
(SETQ FILEPAGE (\GETBASE MAPBASE 0))
(COND
((EQ 0 (LOGAND (SETQ MASK (.LOCKEDVPMASK. VP))
(\GETBASE (SETQ LOCKBASE (.LOCKEDVPBASE. VP))
0))) (* Not locked yet)
(COND
((fetch VACANT of (\READFLAGS VP)) (* Bring locked page into core so we can move it if
necessary)
(\LOADVMEMPAGE VP FILEPAGE NIL T)))
[SETQ RPTBASE (fetch RPTRBASE of (SETQ RPINDEX (RPTFROMRP (SETQ RP (\READRP VP]
[COND
((AND (NOT (.LOCKABLERP. RP))
(NOT (\SPECIALRP VP)))
(* Page already swapped in, but lives in a real page that might need to get bumped (e.g., for stack), so move it
now. If \SPECIALRP is true then we know that the page got swapped into the right place, so no need to move it.)
(LET* ((NEWINDEX (\SELECTREALPAGE NIL T))
(NEWRPT (fetch RPTRBASE of NEWINDEX)))
(\MOVEREALPAGE RPINDEX RPTBASE NEWINDEX NEWRPT)
(replace (RPT EMPTY) of RPTBASE with T)
(* Mark vacated RPT entry empty)
(SETQ RPTBASE NEWRPT)
(SETQ RP (RPFROMRPT NEWINDEX]
(COND
((NEQ FILEPAGE (SETQ FILEPAGE (\MAKESPACEFORLOCKEDPAGE VP FILEPAGE)))
(* Moving to a new page, so have to mark this locked page dirty so that it will eventually get written to its new
home)
(\WRITEMAP VP RP (LOGOR \VMAP.DIRTY \VMAP.REF))
(replace (RPT FILEPAGE) of RPTBASE with FILEPAGE)
(\PUTBASE \FPTOVP FILEPAGE VP)
(\PUTBASE MAPBASE 0 FILEPAGE)))
(\PUTBASE LOCKBASE 0 (LOGOR MASK (\GETBASE LOCKBASE 0)))
(* Set lock bit in page map)
(replace (RPT LOCKED) of RPTBASE with T]
(add VP 1)
finally (COND
(\NEWVMEMPAGEADDED (* If we had to load or rearrange pages, vmem could
have gotten bigger if VMEM.PURE.STATE on)
(\ASSURE.FPTOVP.PAGE])
(\MAKESPACEFORLOCKEDPAGE
[LAMBDA (VP FILEPAGE) (* bvm: "12-Aug-85 18:34")
(* VP is a page to be locked, FILEPAGE its home. Returns a possibly new file page where VP will now live, after
having kicked the former resident of the new file page into VP's old FILEPAGE)
(PROG (DESIREDFP OLDVP FPBASE)
[SETQ DESIREDFP (SELECTC (FOLDLO VP PAGESPERSEGMENT)
((FOLDLO \VP.STACK PAGESPERSEGMENT)
(IPLUS VP (IDIFFERENCE (DLFPFROMRP \RP.STACK)
\VP.STACK)))
((FOLDLO \VP.DISPLAY PAGESPERSEGMENT)
(* Display lives in a fixed place in file, but does not
land there initially)
(IPLUS VP (IDIFFERENCE (DLFPFROMRP \RP.TEMPDISPLAY)
\VP.DISPLAY)))
((FOLDLO \VP.FPTOVP PAGESPERSEGMENT)
(* A new page of FPTOVP has to be continguous on file
with other such pages)
(IPLUS VP (IDIFFERENCE (DLFPFROMRP \RP.FPTOVP)
\VP.FPTOVP)))
(COND
((AND (ILEQ FILEPAGE (fetch LastLockedFilePage of \InterfacePage)
)
(IGREATERP FILEPAGE (DLFPFROMRP \RP.TYPETABLE)))
(* Page is in a good place already.
It probably was once locked, then unlocked)
(RETURN FILEPAGE))
(T (* Put it after all the other locked pages)
(add (fetch LastLockedFilePage of \InterfacePage)
1]
(COND
((AND (fetch FPOCCUPIED of (SETQ FPBASE (\ADDBASE \FPTOVP DESIREDFP)))
(NEQ (SETQ OLDVP (fetch FPVIRTUALPAGE of FPBASE))
VP)) (* Someone else lives here, so move it out)
(\MOVEVMEMFILEPAGE OLDVP DESIREDFP FILEPAGE)))
(RETURN DESIREDFP])
(\DONEWEPHEMERALPAGE
[LAMBDA (BASE NOERROR) (* bvm: "13-Aug-85 16:42")
(* * Creates and returns a new page located at virtual addr BASE, mapping it permanently into some real page but
leaving it out of the vmem file)
(PROG ((VP (fetch (POINTER PAGE#) of BASE))
MAPBASE PREVRP RPTINDEX RPTR)
(RETURN (COND
((fetch (VP INVALID) of VP)
(\INVALIDVP VP)
NIL)
(T (SETQ MAPBASE (\GETBASE \PageMapTBL (fetch (VP PRIMARYKEY) of VP)))
(* First check that the page doesn't exist)
(COND
([OR (AND (NEQ MAPBASE \EMPTYPMTENTRY)
(NEQ (\GETBASE \PAGEMAP (IPLUS MAPBASE (fetch (VP SECONDARYKEY)
of VP)))
0))
(NOT (fetch (VMEMFLAGS VACANT) of (\READFLAGS VP]
(* Page is in the vmem already, so no hope)
(COND
((NOT NOERROR)
(\MP.ERROR \MP.NEWPAGE "Page already exists " BASE T)))
(RETURN BASE)))
(COND
((IGREATERP \PAGEFAULTCOUNTER \UPDATECHAINFREQ)
(\UPDATECHAIN)))
(add \PAGEFAULTCOUNTER 1)
(SETQ RPTINDEX (\SELECTREALPAGE NIL T (QUOTE REMOVE)))
(* Find a page to put this in)
(SETQ RPTR (fetch RPTRBASE of RPTINDEX))
(* Fill in new RPTINDEX with appropriate data)
(replace (RPT VP) of RPTR with \RPT.UNAVAILABLE)
(replace (RPT FILEPAGE) of RPTR with VP)
(* For debugging only)
(FLIPCURSORBAR 0)
(\WRITEMAP VP (RPFROMRPT RPTINDEX)
\VMAP.DIRTY) (* Set flags for page)
(\CLEARWORDS (create POINTER
PAGE# ← VP)
WORDSPERPAGE) (* Clear new page)
(FLIPCURSORBAR 0)
(\BOXIPLUS (LOCF (fetch PAGEFAULTS of \MISCSTATS))
1)
(COND
(\NEWVMEMPAGEADDED (\ASSURE.FPTOVP.PAGE)))
BASE])
(\LOADVMEMPAGE
[LAMBDA (VPAGE FILEPAGE NEWPAGEFLG LOCK? DONTMOVETOPFLG) (* bvm: " 5-Sep-85 18:52")
(* Fault in virtual page VPAGE known to live in FILEPAGE on the vmem. NEWPAGEFLG is true if the page is new, so
should just be cleared, not loaded from vmem file. If LOCK? is true, locks down the page as well.
In this case, if on Dandelion, we also check for page wanting to live in a particular real page.
If DONTMOVETOPFLG is true, the real page we put this page in is not promoted to the front of the LRU queue of pages)
(COND
((IGREATERP \PAGEFAULTCOUNTER \UPDATECHAINFREQ)
(\UPDATECHAIN)))
(add \PAGEFAULTCOUNTER 1)
(PROG ((RPTINDEX (\SELECTREALPAGE FILEPAGE LOCK? DONTMOVETOPFLG))
RPTBASE SPECIALRP)
(SETQ RPTBASE (fetch RPTRBASE of RPTINDEX))
[COND
((AND LOCK? (EQ \MACHINETYPE \DANDELION)
(SETQ SPECIALRP (\SPECIALRP VPAGE))) (* Must actually put FILEPAGE into special RP, and thus
move old contents of SPECIALRP into RPTINDEX)
(LET* ((SRINDEX (RPTFROMRP SPECIALRP))
(SRPTR (fetch RPTRBASE of SRINDEX)))
(\MOVEREALPAGE SRINDEX SRPTR RPTINDEX RPTBASE)
(SETQ RPTINDEX SRINDEX)
(SETQ RPTBASE SRPTR] (* Fill in new RPTINDEX with appropriate data)
(replace (RPT VP) of RPTBASE with VPAGE)
(replace (RPT FILEPAGE) of RPTBASE with FILEPAGE)
(replace (RPT LOCKED) of RPTBASE with LOCK?)
(\TRANSFERPAGE VPAGE FILEPAGE RPTINDEX NIL NEWPAGEFLG])
(\SELECTREALPAGE
[LAMBDA (NEWFP LOCK? DONTMOVETOPFLG) (* bvm: " 5-Sep-85 18:48")
(* Selects a real page, flushing it if necessary, and returns the RPT index of the page. NEWFP, if supplied, is the
filepage that will be read into here. This might influence page choice by minimizing seek time.
LOCK? means caller intends to lock the page, which constrains which real pages it can fall into.
The selected page is moved to the back of the LRU queue, so that it won't be selected again soon, unless
DONTMOVETOPFLG is true. If DONTMOVETOPFLG is REMOVE then the page is spliced out of the chain forever.)
(PROG ((TRIES 0)
(CNTR \MAXCLEANPROBES)
(DISTANCE \MINSHORTSEEK)
PREVRPT PREVINDEX RPTINDEX RPTBASE FP FLAGS)
RETRY
(SETQ PREVRPT \REALPAGETABLE)
(until (EQ (SETQ RPTINDEX (fetch (RPT NEXTRP) of PREVRPT))
\PAGETABLESTOPFLG)
do (SETQ RPTBASE (fetch RPTRBASE of RPTINDEX))
[COND
((fetch (RPT EMPTY) of RPTBASE)
(RETURN PREVRPT))
((NOT (fetch (RPT OCCUPIED) of RPTBASE))
(\MP.ERROR \MP.CHAIN.UNAVAIL "UNAVAILABLE page on Chain"))
([AND (NOT (fetch (RPT LOCKED) of RPTBASE))
[NOT (fetch (VMEMFLAGS REFERENCED) of (SETQ FLAGS (\READFLAGS
(fetch (RPT VP) of RPTBASE]
(OR (NOT LOCK?)
(.LOCKABLERP. (RPFROMRPT RPTINDEX]
(* Page is unlocked and unreferenced, so is good candidate for flushing. LOCK? check is to avoid locking a page into
a real page that might be desired by code that cares about real pages)
(COND
([OR (NOT (fetch (VMEMFLAGS DIRTY) of FLAGS))
(PROGN (SETQ FP (fetch (RPT FILEPAGE) of RPTBASE))
(COND
((SELECTQ \VMEM.INHIBIT.WRITE
[NIL (SELECTQ \VMEM.FULL.STATE
(NIL
(* Normal, can write anything)
T)
(T
(* Vmem is full and clean, don't write anything)
NIL)
(PROGN
(* Vmem is full, but sullied, so might as well write
anything for which there is space)
(AND (ILEQ FP \LASTVMEMFILEPAGE)
(OR (NULL \VMEM.PURE.LIMIT)
(IGREATERP FP
\VMEM.PURE.LIMIT]
(NEW (* Only allowed to write old pages, since new pages
might just have to get moved a second time)
(ILEQ FP \VMEM.PURE.LIMIT))
(PROGN (* We are forbidden from writing any page)
NIL))
(COND
((OR (ILEQ CNTR 0)
(NULL NEWFP)
(ILESSP (IABS (IDIFFERENCE FP NEWFP))
DISTANCE))
(* Page is near replacement, or we have given up trying
for closeness)
T)
(T (* Page is too far away from replacement page)
(SETQ CNTR (SUB1 CNTR))
[COND
((ILESSP DISTANCE \MAXSHORTSEEK)
(* Get more liberal)
(SETQ DISTANCE (LLSH DISTANCE 1]
NIL]
(\FLUSHPAGE RPTINDEX)
(\WRITEMAP (fetch (RPT VP) of RPTBASE)
0 \VMAP.VACANT)
(replace (RPT EMPTY) of RPTBASE with T)
(RETURN PREVRPT]
(SETQ PREVRPT RPTBASE)
(SETQ PREVINDEX RPTINDEX)
finally (* Couldn't find an unreffed page because all pages
were touched since last \UPDATECHAIN.
Do another, which clears ref bits, and try again)
(COND
((EQ TRIES 0)
(SETQ TRIES 1)
(\UPDATECHAIN))
[(AND (EQ TRIES 1)
\VMEM.INHIBIT.WRITE)
(SETQ \VMEM.INHIBIT.WRITE)
(COND
((NEQ \MACHINETYPE \DANDELION) (* Don't call RAID on a DLion, since the interface is
so bad. Dorado user might want to know that we're
smashing \VMEM.INHIBIT.WRITE)
(RAID "No clean vmem pages to reuse, must write one. ↑N to continue"]
(T (\MP.ERROR \MP.SELECTLOOP "Loop in \SELECTREALPAGE")))
(GO RETRY))
(SELECTQ DONTMOVETOPFLG
(NIL (* Move this page to head of chain, so that it won't be
picked again soon)
(replace (RPT NEXTRP) of PREVRPT with (fetch (RPT NEXTRP) of RPTBASE))
(* Splice RPTINDEX out of chain)
(replace (RPT NEXTRP) of \RPTLAST with RPTINDEX)
(* Put new page at end of chain)
(replace (RPT NEXTRP) of (SETQ \RPTLAST RPTBASE) with \PAGETABLESTOPFLG))
(REMOVE (* Splice this page out of chain altogether)
(replace (RPT NEXTRP) of PREVRPT with (fetch (RPT NEXTRP) of RPTBASE))
(replace (RPT NEXTRP) of RPTBASE with \PAGETABLESTOPFLG))
NIL)
(RETURN RPTINDEX])
)
(DEFINEQ
(\INSTALLFAULTPATCH
[LAMBDA NIL (* bvm: " 5-Sep-85 19:04")
(\LOCKVAR (QUOTE \NEWVMEMPAGEADDED)) (* Have to hope that PUTD is hot and so is the gc
collision table where relevant)
(for FN
in (QUOTE (\PAGEFAULT \ASSURE.FPTOVP.PAGE \FLUSHPAGE \MOVEREALPAGE \FLUSHVMOK? \DONEWPAGE
\TEMPLOCKPAGES \DOTEMPLOCKPAGES \WRITEDIRTYPAGE1 \WRITEDIRTYPAGE
\LOADVMEMPAGE \SELECTREALPAGE \MAKESPACEFORLOCKEDPAGE
\DONEWEPHEMERALPAGE \DOLOCKPAGES))
do (PUTD FN (GETPROP FN (QUOTE CODE))
T) (* Instead of UNSAVEDEF to minimize faulting)
(\LOCKFN FN])
)
(RPAQ? \NEWVMEMPAGEADDED )
(DECLARE: DOEVAL@COMPILE DONTCOPY
(GLOBALVARS \NEWVMEMPAGEADDED)
)
(DECLARE: EVAL@COMPILE DONTCOPY
(DECLARE: EVAL@COMPILE
(PUTPROPS .LOCKABLERP. MACRO [(RP) (* It's okay to lock a vp into this RP)
(OR (NEQ (FOLDLO RP PAGESPERSEGMENT)
(FOLDLO \RP.STACK PAGESPERSEGMENT))
(NOT (EQ \MACHINETYPE \DANDELION])
)
)
(DECLARE: DONTEVAL@LOAD DOCOPY
(\INSTALLFAULTPATCH)
)
(PUTPROPS FAULTPATCH COPYRIGHT ("Xerox Corporation" 1985))
(DECLARE: DONTCOPY
(FILEMAP (NIL (1059 32677 (\PAGEFAULT 1069 . 2650) (\ASSURE.FPTOVP.PAGE 2652 . 4175) (\MOVEREALPAGE
4177 . 5565) (\FLUSHVMOK? 5567 . 6359) (\FLUSHPAGE 6361 . 8430) (\DONEWPAGE 8432 . 11264) (
\DOTEMPLOCKPAGES 11266 . 12538) (\TEMPLOCKPAGES 12540 . 12875) (\WRITEDIRTYPAGE1 12877 . 13566) (
\WRITEDIRTYPAGE 13568 . 18012) (\DOLOCKPAGES 18014 . 20901) (\MAKESPACEFORLOCKEDPAGE 20903 . 22977) (
\DONEWEPHEMERALPAGE 22979 . 25360) (\LOADVMEMPAGE 25362 . 27044) (\SELECTREALPAGE 27046 . 32675)) (
32678 33462 (\INSTALLFAULTPATCH 32688 . 33460)))))
STOP