File [phylum]<LispLibrary>Lyric>DORADOFAULTFNS!1

(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
(FILECREATED " 5-Nov-87 12:36:24" {QV}<BRIGGS>XVMEM>LYRIC>DORADOFAULTFNS.;2 37859  

      changes to%:  (FNS INSTALL-DORADOFAULTFNS \DL.NEWFAULTINIT \DL.MARK.PAGES.UNAVAILABLE \FLUSHPAGE \LOADVMEMPAGE \LOCKEDPAGEP \SELECTREALPAGE \TRANSFERPAGE \UPDATECHAIN \MOVEVMEMFILEPAGE \DONEWEPHEMERALPAGE \DOLOCKPAGES \DOTEMPLOCKPAGES \TEMPUNLOCKPAGES \UNLOCKPAGES \RELEASEWORKINGSET \WRITEDIRTYPAGE \SHOWPAGETABLE CHECKPAGEMAP)
 (RECORDS RPT1) (VARS DORADOFAULTFNSCOMS)

      previous date%: " 3-Nov-87 22:34:53" {QV}<BRIGGS>XVMEM>LYRIC>DORADOFAULTFNS.;1)


(* "
Copyright (c) 1987 by Xerox Corporation.  All rights reserved.
")

(PRETTYCOMPRINT DORADOFAULTFNSCOMS)

(RPAQQ DORADOFAULTFNSCOMS ((* ;; "NOTE: This file, even the compiled file, MUST BE LOADED PROP.") (FNS * DORADORPTFNS) (FNS INSTALL-DORADOFAULTFNS) (DECLARE%: DONTCOPY (RECORDS RPT1)) (DECLARE%: DONTEVAL@LOAD DOCOPY (P (UNSAVEDEF (QUOTE INSTALL-DORADOFAULTFNS) (QUOTE CODE)) (* ; "Since we loaded this PROP, right?") (INSTALL-DORADOFAULTFNS))))
)



(* ;; "NOTE: This file, even the compiled file, MUST BE LOADED PROP.")


(RPAQQ DORADORPTFNS (\DL.NEWFAULTINIT \DL.MARK.PAGES.UNAVAILABLE \FLUSHPAGE \LOADVMEMPAGE \LOCKEDPAGEP \SELECTREALPAGE \TRANSFERPAGE \UPDATECHAIN \MOVEVMEMFILEPAGE \DONEWEPHEMERALPAGE \DOLOCKPAGES \DOTEMPLOCKPAGES \TEMPUNLOCKPAGES \UNLOCKPAGES \RELEASEWORKINGSET \WRITEDIRTYPAGE \SHOWPAGETABLE CHECKPAGEMAP)
)
(DEFINEQ

(\DL.NEWFAULTINIT
(LAMBDA NIL (* ; "Edited 21-Oct-87 15:40 by bvm:") (* ;; "We have just started up on a DLion or Daybreak.  Boot code has loaded the first n pages of the sysout into pages 2 thru n-3, except for the area covered by the map and IO page, and has built the map accordingly.  Our principal task is to build \REALPAGETABLE") (PROG ((NREALPAGES (fetch (IFPAGE NRealPages) of \InterfacePage)) (FIRSTBUFFERRP \RP.STARTBUFFERS) (SCRATCHVP \VP.INITSCRATCH) (SCRATCHBASE (create POINTER PAGE# ← \VP.INITSCRATCH)) FIRSTUSEFULRP IFPAGERP IOCBRP RPTBASE VP RPTPAGES FIRSTRP NDISPLAYPAGES) (do (COND ((for I from 0 to (SUB1 \DLBUFFERPAGES) as (FPBASE ← (\ADDBASE \FPTOVP (DLFPFROMRP FIRSTBUFFERRP))) by (\ADDBASE FPBASE 1) do (COND ((OR (NOT (fetch FPOCCUPIED of FPBASE)) (\LOCKEDPAGEP (SETQ VP (fetch FPVIRTUALPAGE of FPBASE)))) (* ;; "Can't use as buffer.  This is just a check for consistency;  you should pick \RP.STARTBUFFERS so that this isn't a problem") (RETURN T))) (* ; "Unmap this page so we can use it for buffers") (\WRITEMAP VP 0 \VMAP.VACANT)) (* ; "Bad starting place, try again") (add FIRSTBUFFERRP 1)) (T (RETURN)))) (SETQ FIRSTUSEFULRP (+ FIRSTBUFFERRP \DLBUFFERPAGES)) (PROGN (* ; "Copy vital info that booting left in page 1") (COND ((EQ \MACHINETYPE \DAYBREAK) (* ;; "Use first buffer page for IOCB page.  Used to have to place this in a real page whose page-in-segment number was the same as that of \VP.IOCBS, but that constraint is now lifted for Daybreak.") (SETQ IOCBRP FIRSTBUFFERRP) (add FIRSTBUFFERRP 1)) (T (SETQ IOCBRP (+ (LOGAND (SUB1 (IMIN NREALPAGES 3072)) 65280) \VP.IOCBS)) (* ;; "Put IOCB page near the end of memory, but in the first 1.5 mb so that Burdock can see it.  Temporary until Steve fixes swap code to not care what RP contains IOCB's") (SETQ VP (fetch FPVIRTUALPAGE of (\ADDBASE \FPTOVP (DLFPFROMRP IOCBRP)))) (COND ((\LOCKEDPAGEP VP) (\MP.ERROR \MP.IOCBPAGE)) (T (* ; "Unmap whoever lived in our target page") (\WRITEMAP VP 0 \VMAP.VACANT))))) (\WRITEMAP \VP.IOCBS IOCBRP \VMAP.CLEAN) (\WRITEMAP SCRATCHVP 1 \VMAP.CLEAN) (\BLT \IOCBPAGE SCRATCHBASE WORDSPERPAGE)) (PROGN (* ; "Copy InterfacePage out of segment zero") (\WRITEMAP SCRATCHVP FIRSTBUFFERRP \VMAP.CLEAN) (\BLT SCRATCHBASE \InterfacePage WORDSPERPAGE) (\WRITEMAP \VP.IFPAGE (SETQ IFPAGERP FIRSTBUFFERRP) \VMAP.CLEAN) (add FIRSTBUFFERRP 1)) (PROGN (* ; "Unmap everything that fell somewhere we can't use") (\DL.UNMAPPAGES (ADD1 \FP.IFPAGE) (DLFPFROMRP \RP.IOPAGE)) (* ; "real segment zero, map or IOPAGE") (COND ((EQ \MACHINETYPE \DANDELION) (for NEXTBANK0 from 2MBPAGES by 2MBPAGES until (> NEXTBANK0 NREALPAGES) do (* ;; "All the `shadows of the display bank' in higher memory have restricted use;  take them out of commission for now") (\DL.UNMAPPAGES NEXTBANK0 (+ NEXTBANK0 PAGESPERSEGMENT -1)))))) (PROGN (* ; "Copy Display into segment zero") (SETQ NDISPLAYPAGES (COND ((EQ \MACHINETYPE \DANDELION) (* ;; "Only lock the standard screen's worth of pages on DLion, even if there are more because the sysout came from wide Daybreak.  Only this many need to be in the display bank, besides which there is a cursor bank after the display;  the rest can be vanilla locked pages.") \NP.DISPLAY) (T (IMAX \NP.DISPLAY (ADD1 \MaxScreenPage))))) (* ; "Number of display pages in use in this image") (for I from 0 to (SUB1 NDISPLAYPAGES) do (\WRITEMAP (+ SCRATCHVP I) (+ \RP.DISPLAY I) \VMAP.CLEAN)) (* ; "Point scratch area at real segment zero") (\BLT SCRATCHBASE (create POINTER PAGE# ← \VP.DISPLAY) (UNFOLD NDISPLAYPAGES WORDSPERPAGE)) (* ; "Copy display from wherever boot put it") (for I from 0 to (SUB1 NDISPLAYPAGES) do (\WRITEMAP (+ SCRATCHVP I) 0 \VMAP.VACANT) (\WRITEMAP (+ \VP.DISPLAY I) (+ \RP.DISPLAY I) \VMAP.CLEAN)) (* ; "Display is now where hardware wants it, so enable display") (replace (IOPAGE DLDISPCONTROL) of \IOPAGE with 0)) (COND ((EQ \MACHINETYPE \DAYBREAK) (* ; "If on a daybreak, map the I/O region.  Have to do this before calling \DoveDisplay.ScreenWidth") (for I from 0 to (SUB1 \DOVEIORGNSIZE) do (\WRITEMAP (+ \VP.DOVEIORGN I) (+ \RP.DOVEIORGN I) \VMAP.CLEAN)) (\DoveIO.InitializeIORegionPtrs))) (PROG ((RPSIZE (- NREALPAGES (SETQ \RPOFFSET -1))) (FIRSTVP \VP.RPT)) (SETQ FIRSTRP (COND ((OR (> NDISPLAYPAGES \NP.DISPLAY) (AND (EQ \MACHINETYPE \DAYBREAK) (EQ (\DoveDisplay.ScreenWidth) \WIDEDOVEDISPLAYWIDTH))) (* ;; "Sysout was made on a large screen daybreak, or is now being run on one.  Need to make sure there is space for all that display") \RP.AFTERDOVEDISPLAY) (T \RP.AFTERDISPLAY))) (* ; "Construct real page table in segment zero after the display") (COND ((> RPSIZE (CONSTANT (EXPT 2 15))) (* ; "We only have 15 bits for real page table numbers, so have to sacrifice the rest of memory") (SETQ RPSIZE (CONSTANT (EXPT 2 15))))) (SETQ RPTPAGES (PROGN (* ;; "This is a way of computing (FOLDHI RPSIZE*3 WORDSPERPAGE) that won't overflow when memory exceeds 10.6MB -- the first term computes RPSIZE*3/256, the second performs the FOLDHI directly on the now much smaller remainder.") (+ (TIMES3 (FOLDLO RPSIZE WORDSPERPAGE)) (FOLDHI (TIMES3 (IMOD RPSIZE WORDSPERPAGE)) WORDSPERPAGE)))) (COND ((> (+ RPTPAGES FIRSTRP) PAGESPERSEGMENT) (* ;; "No space in bank zero, so put RPT in first segment after 2 megabytes, where the first `shadow' display bank lives.  No shadow bank on Daybreak, but this is as good a place as any") (SETQ FIRSTRP (IMIN 2MBPAGES (- NREALPAGES RPTPAGES))) (* ; "IMIN because we could be on a wide-display Daybreak with small memory") (COND ((> (+ FIRSTVP RPTPAGES) \VP.BUFFERS) (* ; "Move virtual assignment backwards if necessary") (SETQ FIRSTVP (COND ((< RPTPAGES \VP.BUFFERS) (- \VP.BUFFERS RPTPAGES)) ((<= RPTPAGES PAGESPERSEGMENT) (* ; "Can't fit real page table in display bank at all, so overlap smallneg space") (UNFOLD \SmallNegHi PAGESPERSEGMENT)) (T (* ; "Ack, more than 10.6 MB, have to slop over into smallpos space") (- (+ (UNFOLD \SmallNegHi PAGESPERSEGMENT) PAGESPERSEGMENT) RPTPAGES)))))) (\DL.UNMAPPAGES (DLFPFROMRP FIRSTRP) (DLFPFROMRP (+ FIRSTRP RPTPAGES -1))) (* ; "Unmap the pages in which RPT lives.  This was already done on DLion, but can't hurt to do it again"))) (for I from 0 to (SUB1 RPTPAGES) do (* ; "Assign pages to real page table now") (\WRITEMAP (+ FIRSTVP I) (+ FIRSTRP I) \VMAP.CLEAN)) (SETQ \REALPAGETABLE (create POINTER PAGE# ← FIRSTVP)) (\CLEARWORDS \REALPAGETABLE RPSIZE) (\CLEARWORDS (\ADDBASE \REALPAGETABLE RPSIZE) RPSIZE) (\CLEARWORDS (\ADDBASE (\ADDBASE \REALPAGETABLE RPSIZE) RPSIZE) RPSIZE) (* ; "Clear table in three steps, since 3*RPSIZE overflows after 10MB") (SETQ \RPTSIZE RPSIZE) (COND ((EQ \MACHINETYPE \DANDELION) (for NEXTBANK0 from 2MBPAGES by 2MBPAGES until (> NEXTBANK0 NREALPAGES) do (* ; "Mark the shadow display bank pages unavailable") (\DL.MARK.PAGES.UNAVAILABLE NEXTBANK0 (+ NEXTBANK0 PAGESPERSEGMENT -1)))) (T (* ;; "RPT itself occupies unavailable pages;  on DLion these were marked unavailable either in segment zero after display or as part of shadow bank") (\DL.MARK.PAGES.UNAVAILABLE FIRSTRP (+ FIRSTRP RPTPAGES -1)) (* ; "Also, Dove IO region is unavailable") (\DL.MARK.PAGES.UNAVAILABLE \RP.DOVEIORGN (SUB1 (+ \RP.DOVEIORGN \DOVEIORGNSIZE)))))) (PROGN (* ;; "Fill in special cases in RPT -- the display, which is not where FPTOVP says it is, and all the pages that are unavailable for one reason or another.  Note: any page marked unavailable here MUST be unmapped by now, either because booting never put it where FPTOVP says it would be, there's no page there to begin with, or there's an explicit call to \WRITEMAP or \DL.UNMAPPAGES to unmap it above") (SETQ RPTBASE \REALPAGETABLE) (for I from 0 to (SUB1 NDISPLAYPAGES) do (SETQ RPTBASE (\ADDBASE RPTBASE \RPTENTRYLENGTH)) (* ; "Fill in Display pages") (replace (RPT VP) of RPTBASE with (+ \VP.DISPLAY I)) (replace (RPT FILEPAGE) of RPTBASE with (DLFPFROMRP (+ \RP.TEMPDISPLAY I)))) (\DL.MARK.PAGES.UNAVAILABLE NDISPLAYPAGES \RP.IOPAGE) (* ; "Mark rest of segment zero plus Map and IOPAGE unavailable")) (PROGN (* ; "fill in main part of RPT by reading FPTOVP") (for I from (ADD1 \RP.IOPAGE) to (SUB1 NREALPAGES) as (FPBASE ← (\ADDBASE \FPTOVP (DLFPFROMRP (ADD1 \RP.IOPAGE)))) by (\ADDBASE FPBASE 1) as (RPTBASE ← (fetch RPTRBASE of (RPTFROMRP (ADD1 \RP.IOPAGE)))) by (\ADDBASE RPTBASE \RPTENTRYLENGTH) bind (LASTREALPAGE ← (DLRPFROMFP (fetch (IFPAGE NActivePages) of \InterfacePage))) do (* ;; "Fill in rest of RPT from \FPTOVP.  Could optimize this a little by special casing the area occupied by the display, but this is simpler") (COND ((fetch (RPT UNAVAILABLE) of RPTBASE)) ((AND (<= I LASTREALPAGE) (fetch FPOCCUPIED of FPBASE) (NOT (fetch (VMEMFLAGS VACANT) of (\READFLAGS (SETQ VP (fetch FPVIRTUALPAGE of FPBASE))))) (EQ I (\READRP VP))) (* ;; "There is a VP assigned to this filepage, and it is still there.  False for display that got moved and any real pages that didn't get filled.  LASTREALPAGE is in case the real memory is larger than the sysout -- FPTOVP does not exist all the way") (replace (RPT VP) of RPTBASE with VP) (replace (RPT FILEPAGE) of RPTBASE with (DLFPFROMRP I))) (T (replace (RPT EMPTY) of RPTBASE with T))))) (PROGN (* ; "Touch up RPT with the exceptions") (SETQ RPTBASE (fetch RPTRBASE of (RPTFROMRP IFPAGERP))) (* ; "Interface Page") (replace (RPT VP) of RPTBASE with \VP.IFPAGE) (replace (RPT FILEPAGE) of RPTBASE with \FP.IFPAGE) (replace (RPT UNAVAILABLE) of (fetch RPTRBASE of (RPTFROMRP IOCBRP)) with T) (* ; "\IOCBPAGE") (\DL.MARK.PAGES.UNAVAILABLE FIRSTBUFFERRP (SUB1 FIRSTUSEFULRP)) (* ; "buffer pages unavailable to swapper")) (\CHAIN.UP.RPT) (PROG ((NBUFFERS (- FIRSTUSEFULRP FIRSTBUFFERRP))) (* ; "Allocate buffers") (for I from 0 to (SUB1 NBUFFERS) do (\WRITEMAP (+ \VP.BUFFERS I) (+ FIRSTBUFFERRP I) \VMAP.CLEAN)) (\DL.ASSIGNBUFFERS (create POINTER PAGE# ← \VP.BUFFERS) NBUFFERS))))
)

(\DL.MARK.PAGES.UNAVAILABLE
(LAMBDA (FIRSTRP LASTRP) (* bvm%: "14-Jan-84 14:32") (for I from FIRSTRP to LASTRP as (RPTBASE ← (fetch RPTRBASE of (RPTFROMRP FIRSTRP))) by (\ADDBASE RPTBASE \RPTENTRYLENGTH) do (replace (RPT UNAVAILABLE) of RPTBASE with T)))
)

(\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)))))
)

(\LOADVMEMPAGE
(LAMBDA (VPAGE FILEPAGE NEWPAGEFLG LOCK? DONTMOVETOPFLG) (* bvm%: "10-Aug-85 18:08") (* ;; "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? (OR (EQ \MACHINETYPE \DANDELION) (EQ \MACHINETYPE \DAYBREAK)) (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?) (COND ((AND DOLOCKCHECKS (NOT LOCK?) (EQ (LRSH VPAGE 8) (CONSTANT (\HILOC \PAGEMAP)))) (\MP.ERROR \MP.MAPNOTLOCKED "Page of page map being loaded but not locked" VPAGE))) (\TRANSFERPAGE VPAGE FILEPAGE RPTINDEX NIL NEWPAGEFLG)))
)

(\LOCKEDPAGEP
(LAMBDA (VP TEMP) (* bvm%: "18-Feb-85 18:08") (* ;;; "True if VP is locked.  If TEMP is NIL consults only the locked page table;  otherwise, also checks for `temporary' locked page") (OR (NEQ 0 (LOGAND (.LOCKEDVPMASK. VP) (\GETBASE (.LOCKEDVPBASE. VP) 0))) (UNLESSRDSYS (AND TEMP (NOT (fetch (VMEMFLAGS VACANT) of (\READFLAGS VP))) (fetch (RPT LOCKED) of (fetch RPTRBASE of (RPTFROMRP (\READRP VP))))))))
)

(\SELECTREALPAGE
(LAMBDA (NEWFP LOCK? DONTMOVETOPFLG) (* bvm%: "10-Aug-85 18:08") (* ;; "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)))))) (COND (DOLOCKCHECKS (COND ((fetch (RPT LOCKED) of RPTBASE) (\MP.ERROR \MP.FLUSHLOCKED "Attempt to displace locked page" RPTBASE)) ((EQ (fetch (RPT VPSEG) of RPTBASE) (CONSTANT (\HILOC \PAGEMAP))) (\MP.ERROR \MP.MAPNOTLOCKED "A page of the page map is not locked" RPTBASE))))) (\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 ((AND (NEQ \MACHINETYPE \DANDELION) (NEQ \MACHINETYPE \DAYBREAK)) (* ;; "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)))
)

(\TRANSFERPAGE
(LAMBDA (VP FILEPAGE RPTINDEX WRITE? NEWPAGE?) (* MPL "27-Jul-85 21:28") (* ;; "Transfers virtual page VP between page FILEPAGE of the vmem and real page RPTINDEX.  WRITE?  indicates direction of transfer.  If NEWPAGE?, then page does not exist on file, and is simply cleared") (PROG (NEWFLAGS) (COND (WRITE? (FLIPCURSORBAR 15)) (T (FLIPCURSORBAR 0))) (SETQ NEWFLAGS (COND (NEWPAGE? \VMAP.DIRTY) (WRITE? (LOGAND (\READFLAGS VP) (LOGNOT16 \VMAP.DIRTY))) (T 0))) (COND ((AND WRITE? (fetch (RPT LOCKED) of (fetch RPTRBASE of RPTINDEX))) (* ;; "Writing a locked page: can't diddle map, because others might die, so do this in the straightforward way") (\BLT \EMBUFBASE (create POINTER PAGE# ← VP) WORDSPERPAGE) (* ; "Copy page into buffer, then write the buffer out") (\ACTONVMEMFILE FILEPAGE \EMBUFBASE 1 T) (SETQ \LASTACCESSEDVMEMPAGE FILEPAGE)) ((NOT NEWPAGE?) (* ; "Map the buffer page into the target real page, read/write the page, then set the map back") (\WRITEMAP VP 0 \VMAP.VACANT) (* ; "Unmap VP so that we don't have two virtual pages pointing at same real page") (\WRITEMAP \EMBUFVP (RPFROMRPT RPTINDEX) 0) (* ; "Map buffer to target page") (\ACTONVMEMFILE FILEPAGE \EMBUFBASE 1 WRITE?) (* ; "Do the i/o") (\WRITEMAP \EMBUFVP \EMBUFRP 0) (* ; "Restore buffer to its proper page") (SETQ \LASTACCESSEDVMEMPAGE FILEPAGE))) (\WRITEMAP VP (RPFROMRPT RPTINDEX) NEWFLAGS) (* ; "Set flags for page") (COND (NEWPAGE? (* ; "Not on file yet, so clear it.  Couldn't do this sooner because the flags weren't set") (\CLEARWORDS (create POINTER PAGE# ← VP) WORDSPERPAGE))) (COND (WRITE? (FLIPCURSORBAR 15) (\BOXIPLUS (LOCF (fetch SWAPWRITES of \MISCSTATS)) 1)) (T (FLIPCURSORBAR 0) (\BOXIPLUS (LOCF (fetch PAGEFAULTS of \MISCSTATS)) 1)))))
)

(\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))))
)

(\MOVEVMEMFILEPAGE
(LAMBDA (VP OLDFP NEWFP) (* bvm%: "18-Nov-84 14:14") (PROG ((FLAGS (\READFLAGS VP)) RP) (COND ((fetch (VMEMFLAGS VACANT) of FLAGS) (* ; "Page not resident, so pull it in") (\LOADVMEMPAGE VP OLDFP) (SETQ FLAGS \VMAP.CLEAN)) ((\LOCKEDPAGEP VP) (\MP.ERROR \MP.BADLOCKED "Locked page is in the way" VP))) (\WRITEMAP VP (SETQ RP (\READRP VP)) (LOGOR FLAGS \VMAP.DIRTY)) (* ; "Mark page dirty, so that it will eventually be written to its new home") (replace (RPT FILEPAGE) of (fetch RPTRBASE of (RPTFROMRP RP)) with NEWFP) (* ; "Tell RPT where VP now lives") (\PUTBASE (.PAGEMAPBASE. VP) 0 NEWFP) (* ; "Tell \PAGEMAP about it") (\PUTBASE \FPTOVP NEWFP VP) (* ; "...  and \FPTOVP")))
)

(\DONEWEPHEMERALPAGE
(LAMBDA (BASE NOERROR) (* bvm%: "30-Oct-86 16:47") (* ;;; "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") (LET ((VP (fetch (POINTER PAGE#) of BASE)) MAPBASE PREVRP RPTINDEX RPTR) (COND ((fetch (VP INVALID) of VP) (\INVALIDVP VP) NIL) ((OR (AND (NEQ (SETQ MAPBASE (\GETBASE \PageMapTBL (fetch (VP PRIMARYKEY) of VP))) \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))) BASE) (T (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))))
)

(\DOLOCKPAGES
(LAMBDA (BASE NPAGES) (* ; "Edited 21-Oct-87 15:49 by bvm:") (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 RPINDEX (RPTFROMRP (SETQ RP (\READRP VP)))) (SETQ RPTBASE (fetch RPTRBASE of RPINDEX)) (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)))))
)

(\DOTEMPLOCKPAGES
(LAMBDA (BASE NPAGES) (* ; "Edited 21-Oct-87 15:49 by bvm:") (* ;; "`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 RPINDEX (RPTFROMRP (SETQ RP (\READRP VP)))) (SETQ RPTBASE (fetch RPTRBASE of RPINDEX)) (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))))
)

(\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))))
)

(\RELEASEWORKINGSET
(LAMBDA NIL (* bvm%: "29-Nov-84 10:56") (COND ((\FLUSHVM) (* ; "Returning from Lisp startup") T) (T (* ; "Unmap any unlocked page") (for RPTINDEX from 1 to (SUB1 \RPTSIZE) bind RPTR when (AND (fetch (RPT OCCUPIED) of (SETQ RPTR (fetch RPTRBASE of RPTINDEX))) (NOT (fetch (RPT LOCKED) of RPTR))) do (\WRITEMAP (fetch (RPT VP) of RPTR) (RPFROMRPT RPTINDEX) \VMAP.VACANT) (replace (RPT EMPTY) of RPTR with T)))))
)

(\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)))))
)

(\SHOWPAGETABLE
(LAMBDA (MODE FILE) (* bvm%: "12-Jul-86 16:55") (PROG ((*PRINT-BASE* 8) (OUTSTREAM (GETSTREAM FILE (QUOTE OUTPUT))) (RPTR \REALPAGETABLE) (RP 0) FLAGS VP STATE FIRSTONE LASTONE) (printout OUTSTREAM "     RP      VP           FilePage  Status" T) (until (SELECTQ MODE (CHAIN (EQ (SETQ RP (fetch (RPT NEXTRP) of RPTR)) \PAGETABLESTOPFLG)) (NIL (add RP 1) (IGEQ RP \RPTSIZE)) (\ILLEGAL.ARG MODE)) do (SETQ RPTR (fetch RPTRBASE of RP)) (SETQ VP (fetch (RPT VP) of RPTR)) (COND ((AND (NULL MODE) (EQ VP STATE)) (SETQ LASTONE RP)) (T (COND (LASTONE (printout OUTSTREAM "ditto thru " LASTONE T) (SETQ LASTONE NIL))) (SETQ FIRSTONE RP) (SETQ STATE VP) (printout OUTSTREAM |.I7.8| (RPFROMRPT RP)) (COND ((fetch (RPT EMPTY) of RPTR) (PRIN1 " Empty" OUTSTREAM)) ((NOT (fetch (RPT OCCUPIED) of RPTR)) (PRIN1 " Unavailable" OUTSTREAM)) (T (printout OUTSTREAM |.I8.8| VP %,) (\PRINTVP VP OUTSTREAM) (printout OUTSTREAM 28 |.I6.8| (fetch (RPT FILEPAGE) of RPTR) %,,) (COND ((fetch (RPT LOCKED) of RPTR) (COND ((NOT (\LOCKEDPAGEP VP)) (* ; "not permanently locked") (PRIN1 "Temp" OUTSTREAM))) (PRIN1 "Locked " OUTSTREAM))) (UNLESSRDSYS (PROGN (COND ((fetch (VMEMFLAGS REFERENCED) of (SETQ FLAGS (\READFLAGS VP))) (PRIN1 "Ref " OUTSTREAM))) (COND ((fetch (VMEMFLAGS DIRTY) of FLAGS) (PRIN1 "Dirty" OUTSTREAM))))))) (TERPRI OUTSTREAM))))))
)

(CHECKPAGEMAP
(LAMBDA NIL (* bvm%: "12-Jul-86 16:56") (LET ((*PRINT-BASE* 8) (NUMOCCUPIED 0) (NUMLOCKED 0) (CHAINOCCUPIED 0) (CHAINLOCKED 0) RPTR FPBASE FP VP RP) (CHECKFPTOVP) (for RPTINDEX from 1 to (SUB1 \RPTSIZE) when (fetch (RPT OCCUPIED) of (SETQ RPTR (fetch RPTRBASE of RPTINDEX))) do (add NUMOCCUPIED 1) (SETQ VP (fetch (RPT VP) of RPTR)) (SETQ FP (fetch (RPT FILEPAGE) of RPTR)) (COND ((CHECKFPTOVP1 FP VP RPTINDEX)) ((NEQ VP (fetch FPVIRTUALPAGE of (SETQ FPBASE (\ADDBASE \FPTOVP FP)))) (printout T "RPT for RP " (RPFROMRPT RPTINDEX) " says VP ") (\PRINTVP VP T) (printout T " lives in FP " FP "; but FP Map says that FP contains ") (\PRINTVP (fetch FPVIRTUALPAGE of FPBASE) T) (printout T T)) ((\LOCKEDPAGEP VP) (add NUMLOCKED 1) (COND ((NOT (fetch (RPT LOCKED) of RPTR)) (printout T "VP " VP ", living in RP " (RPFROMRPT RPTINDEX) " should be locked but isn't." T)) ((IGREATERP FP (DLRPFROMFP (fetch (IFPAGE LastLockedFilePage) of \InterfacePage))) (printout T "VP " VP " is locked, but living in FP " FP ", which is not in the locked page area" T)))))) (PROGN (SETQ RPTR \REALPAGETABLE) (* ; "Check pagetable chain") (while (NEQ (SETQ RP (fetch (RPT NEXTRP) of RPTR)) \PAGETABLESTOPFLG) when (fetch (RPT OCCUPIED) of (SETQ RPTR (fetch RPTRBASE of RP))) do (add CHAINOCCUPIED 1) (COND ((fetch (RPT LOCKED) of RPTR) (add CHAINLOCKED 1)))) (COND ((ILESSP CHAINOCCUPIED NUMOCCUPIED) (printout T NUMOCCUPIED " occupied pages, but only " CHAINOCCUPIED " are on page chain.  " NUMLOCKED " pages are permanently locked; " CHAINLOCKED " pages on chain are locked somehow." T))))))
)
)
(DEFINEQ

(INSTALL-DORADOFAULTFNS
(LAMBDA NIL (* ; "Edited  5-Nov-87 12:35 by Briggs") (* ; "Edited 21-Oct-87 16:32 by bvm:") (* ;; "Installs the recompiled fault functions.  Safe way to load is with dfnflg PROP.") (LET ((NEEDNTLOCK (QUOTE (\SHOWPAGETABLE CHECKPAGEMAP)))) (if (NEQ DFNFLG (QUOTE PROP)) then (* ; "Loser!") (PRINTOUT T T "You really should have loaded this file PROP; I'll do my best" T) (for FN in DORADORPTFNS unless (MEMB FN NEEDNTLOCK) do (\LOCKFN FN)) elseif (OR (NLISTP DORADORPTFNS) (for FN in DORADORPTFNS thereis (NOT (CCODEP (GET FN (QUOTE CODE)))))) then (HELP "Can't find code definitions") else (for FN in DORADORPTFNS do (OR (MEMB FN NEEDNTLOCK) (\LOCKCODE (fetch (COMPILED-CLOSURE FNHEADER) of (GET FN (QUOTE CODE))))) (UNSAVEDEF FN (QUOTE CODE)) (REMPROP FN (QUOTE CODE))))) (* ;; "Now that this is installed, we can tell Bcpl that it's ok to use all that memory.  Such a kludge--set random bits in the version number, since we can't use strict hierarchy of versions (they want this in Koto, yeccch).") (replace (IFPAGE LVersion) of \InterfacePage with (LOGOR 12 (fetch (IFPAGE LVersion) of \InterfacePage))) (PUTD (QUOTE INSTALL-DORADOFAULTFNS)) (* ; "Remove all evidence...") (UNMARKASCHANGED (QUOTE DORADOFAULTFNSCOMS) (QUOTE VARS)) (UNMARKASCHANGED (QUOTE DORADORPTFNS) (QUOTE VARS)) (* ;; "Finally, try fooling LOAD into thinking it had loaded this SYSLOAD to begin with.") (SETQ LDFLG (QUOTE SYSLOAD)))
)
)
(DECLARE%: DONTCOPY 
(DECLARE%: EVAL@COMPILE

(ACCESSFNS RPT1 (RPTRBASE (\ADDBASE (\ADDBASE \REALPAGETABLE (LLSH DATUM 1)) DATUM)) (* ;; "Given a RP, RPTRBASE produces a pointer to its entry in the real page table, by adding 3*RP to the table base.  Done carefully because multiply by 3 can overflow if more than 8mb of memory.")
)
)
)
(DECLARE%: DONTEVAL@LOAD DOCOPY 
(UNSAVEDEF (QUOTE INSTALL-DORADOFAULTFNS) (QUOTE CODE))
(* ; "Since we loaded this PROP, right?")
(INSTALL-DORADOFAULTFNS)
)
(PUTPROPS DORADOFAULTFNS COPYRIGHT ("Xerox Corporation" 1987))
(DECLARE%: DONTCOPY
  (FILEMAP (NIL (1483 35826 (\DL.NEWFAULTINIT 1493 . 11324) (\DL.MARK.PAGES.UNAVAILABLE 11326 . 11586) (
\FLUSHPAGE 11588 . 13022) (\LOADVMEMPAGE 13024 . 14598) (\LOCKEDPAGEP 14600 . 15024) (\SELECTREALPAGE 
15026 . 19151) (\TRANSFERPAGE 19153 . 20907) (\UPDATECHAIN 20909 . 22746) (\MOVEVMEMFILEPAGE 22748 . 
23450) (\DONEWEPHEMERALPAGE 23452 . 24867) (\DOLOCKPAGES 24869 . 26976) (\DOTEMPLOCKPAGES 26978 . 
27998) (\TEMPUNLOCKPAGES 28000 . 28837) (\UNLOCKPAGES 28839 . 29618) (\RELEASEWORKINGSET 29620 . 30055
) (\WRITEDIRTYPAGE 30057 . 32887) (\SHOWPAGETABLE 32889 . 34232) (CHECKPAGEMAP 34234 . 35824)) (35827 
37275 (INSTALL-DORADOFAULTFNS 35837 . 37273)))))
STOP