(FILECREATED "31-Jul-85 10:47:06" {ERIS}<LISP>INTERMEZZO>PATCHES>FAULTCHECK.;1 12365
changes to: (VARS FAULTCHECKCOMS)
(FNS \INSTALLFAULTCHECK))
(* Copyright (c) 1985 by Xerox Corporation. All rights reserved.)
(PRETTYCOMPRINT FAULTCHECKCOMS)
(RPAQQ FAULTCHECKCOMS [[DECLARE: DONTEVAL@LOAD DOCOPY FIRST (P (RESETSAVE DFNFLG (QUOTE PROP]
(FNS \TEMPUNLOCKPAGES \UNLOCKPAGES \SELECTREALPAGE \UPDATECHAIN)
(FNS \INSTALLFAULTCHECK)
(DECLARE: DONTCOPY (RECORDS RPT)
(CONSTANTS (DOLOCKCHECKS T)))
(DECLARE: DONTEVAL@LOAD DOCOPY (P (\INSTALLFAULTCHECK])
(DECLARE: DONTEVAL@LOAD DOCOPY FIRST
(RESETSAVE DFNFLG (QUOTE PROP))
)
(DEFINEQ
(\TEMPUNLOCKPAGES
[LAMBDA (BASE NPAGES) (* bvm: "30-Jul-85 16:58")
(* Unlocks pages that were locked by \TEMPLOCKPAGES.
This function must be locked because it manipulates the
page table)
(while (IGREATERP NPAGES 0) bind (VP ←(fetch (POINTER PAGE#) of BASE))
RPTR
do (UNINTERRUPTABLY
(\TOUCHPAGE BASE) (* Touch page in case not resident.
Should only happen if page wasn't locked to begin with)
(COND
((AND (NEQ (SETQ RPTR (\READRP VP))
0)
(EQ [fetch (RPT VP) of (SETQ RPTR (fetch RPTRBASE of (RPTFROMRP RPTR]
VP))
(COND
([AND DOLOCKCHECKS (EQ (LRSH VP 8)
(CONSTANT (\HILOC \PAGEMAP]
(\MP.ERROR \MP.UNLOCKINGMAP "Attempt to unlock map page" VP)))
(replace (RPT LOCKED) of RPTR with NIL))
(T (HELP "Page table changed out from under me!" VP))))
(add VP 1)
(add NPAGES -1)
(SETQ BASE (\ADDBASE BASE WORDSPERPAGE])
(\UNLOCKPAGES
[LAMBDA (BASE NPAGES) (* bvm: "30-Jul-85 16:58")
(* * Unlocks NPAGES virtual pages from BASE onward)
(UNINTERRUPTABLY
(for I from 0 to (SUB1 NPAGES) bind (VP ←(fetch (POINTER PAGE#) of BASE))
MASK LOCKBASE
do (COND
((fetch (VP INVALID) of VP)
(\INVALIDVP VP))
((NEQ 0 (LOGAND (SETQ MASK (.LOCKEDVPMASK. VP))
(\GETBASE (SETQ LOCKBASE (.LOCKEDVPBASE. VP))
0))) (* Yes, page was locked, so turn the bit off now)
(COND
([AND DOLOCKCHECKS (EQ (LRSH VP 8)
(CONSTANT (\HILOC \PAGEMAP]
(\MP.ERROR \MP.UNLOCKINGMAP "Attempt to unlock map page" VP)))
(\PUTBASE LOCKBASE 0 (LOGXOR MASK (\GETBASE LOCKBASE 0)))
(* Update pagemap, then update real page table)
(replace (RPT LOCKED) of (fetch RPTRBASE of (RPTFROMRP (\READRP VP))) with NIL)))
(add VP 1)))])
(\SELECTREALPAGE
[LAMBDA (NEWFP) (* bvm: "31-Jul-85 10:34")
(* Selects a real page, flushing it if necessary, and returns the pagenumber of the PREVIOUS page in the chain, so
it can be easily spliced out. NEWFP, if supplied, is the filepage that will be read into here.
This might influence page choice by minimizing seek time)
(PROG ((TRIES 0)
(CNTR \MAXCLEANPROBES)
(DISTANCE \MINSHORTSEEK)
LAST RP RPTR FP FLAGS)
RETRY
(SETQ LAST \REALPAGETABLE)
(RETURN
(until (EQ (SETQ RP (fetch (RPT NEXTRP) of LAST))
\PAGETABLESTOPFLG)
do (SETQ RPTR (fetch RPTRBASE of RP))
[COND
((fetch (RPT EMPTY) of RPTR)
(RETURN LAST))
((NOT (fetch (RPT OCCUPIED) of RPTR))
(\MP.ERROR \MP.CHAIN.UNAVAIL "UNAVAILABLE page on Chain"))
([AND (NOT (fetch (RPT LOCKED) of RPTR))
(NOT (fetch (VMEMFLAGS REFERENCED) of (SETQ FLAGS
(\READFLAGS (fetch (RPT VP)
of RPTR]
(* Page is unlocked and unreferenced, so is good
candidate for flushing)
(COND
([OR (NOT (fetch (VMEMFLAGS DIRTY) of FLAGS))
(PROGN (SETQ FP (fetch (RPT FILEPAGE) of RPTR))
(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]
[COND
(DOLOCKCHECKS (COND
((fetch (RPT LOCKED) of RPTR)
(\MP.ERROR \MP.FLUSHLOCKED
"Attempt to displace locked page"
RPTR))
((EQ (fetch (RPT VPSEG) of RPTR)
(CONSTANT (\HILOC \PAGEMAP)))
(\MP.ERROR \MP.MAPNOTLOCKED
"A page of the page map is not locked"
RPTR]
(\FLUSHPAGE RP)
(\WRITEMAP (fetch (RPT VP) of RPTR)
0 \VMAP.VACANT)
(replace (RPT EMPTY) of RPTR with T)
(RETURN LAST]
(SETQ LAST RPTR)
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)
(GO RETRY))
((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"))
)
(GO RETRY))
(T (\MP.ERROR \MP.SELECTLOOP "Loop in \SELECTREALPAGE"])
(\UPDATECHAIN
[LAMBDA NIL (* bvm: "30-Jul-85 15:20")
(* Sorts the page chain by reference bit)
(CHECK (NOT \INTERRUPTABLE))
(PROG ((RPTINDEX (fetch (RPT NEXTRP) of \REALPAGETABLE))
(CHAIN0 \REALPAGETABLE)
(CHAIN1 (\ADDBASE \REALPAGETABLE 2))
RPTR VP FLAGS HEAD1)
(SETQ HEAD1 CHAIN1)
(* HEAD1 = CHAIN1 is just a holding cell for the second Chain we temporarily create inside here.
Use the unused third word of the dummy header entry of \REALPAGETABLE)
(replace (RPT NEXTRP) of CHAIN0 with \PAGETABLESTOPFLG)
(replace (RPT NEXTRP) of CHAIN1 with \PAGETABLESTOPFLG)
(do (SETQ RPTR (fetch RPTRBASE of RPTINDEX))
(SETQ VP (fetch (RPT VP) of RPTR))
[SETQ FLAGS (COND
((fetch (RPT EMPTY) of RPTR)
0)
(T (\READFLAGS VP]
(COND
((OR (fetch (RPT LOCKED) of RPTR)
(PROGN (COND
([AND DOLOCKCHECKS (EQ (fetch (RPT VPSEG) of RPTR)
(CONSTANT (\HILOC \PAGEMAP]
(\MP.ERROR \MP.MAPNOTLOCKED "A page of the page map is not locked"
RPTR)))
(fetch (VMEMFLAGS REFERENCED) of FLAGS)))
(* Page referenced or locked, put on CHAIN1)
(\WRITEMAP VP (RPFROMRPT RPTINDEX)
(LOGAND FLAGS (LOGNOT16 \VMAP.REF)))
(* Turn off ref bit)
(replace (RPT NEXTRP) of CHAIN1 with RPTINDEX)
(SETQ CHAIN1 RPTR))
(T (* Page was not referenced recently, put on CHAIN0)
(replace (RPT NEXTRP) of CHAIN0 with RPTINDEX)
(SETQ CHAIN0 RPTR)))
(SETQ RPTINDEX (fetch (RPT NEXTRP) of RPTR))
(* Look at next page in old chain)
repeatuntil (EQ RPTINDEX \PAGETABLESTOPFLG))
(replace (RPT NEXTRP) of CHAIN1 with \PAGETABLESTOPFLG)
(* End of the line)
(replace (RPT NEXTRP) of CHAIN0 with (fetch (RPT NEXTRP) of HEAD1))
(* Link end of CHAIN0 to beginning of CHAIN1)
(SETQ \RPTLAST (COND
((EQ HEAD1 CHAIN1) (* Nothing on CHAIN1 ??!!)
CHAIN0)
(T CHAIN1))) (* Pointer to end of complete chain)
(SETQ \DIRTYPAGECOUNTER (SETQ \PAGEFAULTCOUNTER 0])
)
(DEFINEQ
(\INSTALLFAULTCHECK
[LAMBDA NIL (* bvm: "31-Jul-85 10:42")
(for FN in (QUOTE (\TEMPUNLOCKPAGES \UNLOCKPAGES \SELECTREALPAGE \UPDATECHAIN))
do (OR (GETPROP FN (QUOTE CODE))
(SHOULDNT))
(UNSAVEDEF FN (QUOTE CODE))
(\LOCKFN FN])
)
(DECLARE: DONTCOPY
[DECLARE: EVAL@COMPILE
(BLOCKRECORD RPT ((LOCKED FLAG)
(NEXTRP BITS 15) (* rp of next entry in page chain)
(VP WORD) (* Virtual page number occupying this real page)
(FILEPAGE WORD) (* Page in Lisp.VirtualMem)
)
(BLOCKRECORD RPT ((NIL BITS 16)
(VPSEG BYTE)
(VPPAGEINSEG BYTE)))
[ACCESSFNS RPT ([EMPTY (EQ (fetch (RPT VP) of DATUM)
\RPT.EMPTY)
(COND
(NEWVALUE (replace (RPT VP) of DATUM with \RPT.EMPTY))
(T (ERROR "Invalid replace of RPT.EMPTY" DATUM]
[UNAVAILABLE (EQ (fetch (RPT VP) of DATUM)
\RPT.UNAVAILABLE)
(COND
(NEWVALUE (replace (RPT VP) of DATUM with
\RPT.UNAVAILABLE))
(T (ERROR "Invalid replace of RPT.UNAVAILABLE" DATUM]
(OCCUPIED (ILESSP (fetch (RPT VP) of DATUM)
\RPT.EMPTY])
]
(DECLARE: EVAL@COMPILE
(RPAQQ DOLOCKCHECKS T)
(CONSTANTS (DOLOCKCHECKS T))
)
)
(DECLARE: DONTEVAL@LOAD DOCOPY
(\INSTALLFAULTCHECK)
)
(PUTPROPS FAULTCHECK COPYRIGHT ("Xerox Corporation" 1985))
(DECLARE: DONTCOPY
(FILEMAP (NIL (688 10708 (\TEMPUNLOCKPAGES 698 . 1936) (\UNLOCKPAGES 1938 . 3063) (\SELECTREALPAGE
3065 . 7775) (\UPDATECHAIN 7777 . 10706)) (10709 11075 (\INSTALLFAULTCHECK 10719 . 11073)))))
STOP