(FILECREATED "24-Apr-85 15:34:20" {ERIS}<LISPNEW>INTERMEZZO>PATCHES>ALLOCPAGEBLOCK.;2 13527
changes to: (FNS \ALLOCPAGEBLOCK)
(VARS ALLOCPAGEBLOCKCOMS)
previous date: "24-Apr-85 15:17:21" {ERIS}<LISPNEW>INTERMEZZO>PATCHES>ALLOCPAGEBLOCK.;1)
(* Copyright (c) 1985 by Xerox Corporation. All rights reserved.)
(PRETTYCOMPRINT ALLOCPAGEBLOCKCOMS)
(RPAQQ ALLOCPAGEBLOCKCOMS ((FNS \ALLOCPAGEBLOCK \MAPMDS \CHECKFORSTORAGEFULL STORAGE STORAGE.LEFT)))
(DEFINEQ
(\ALLOCPAGEBLOCK
[LAMBDA (NPAGES) (* bvm: "24-Apr-85 15:33")
(UNINTERRUPTABLY
(* * Allocates a continguous chunk of NPAGES pages. Currently there is no provision for giving them back.)
(PROG (FIRSTPAGE RESULT)
(COND
([ILEQ (IPLUS \NxtArrayPage \GUARDSTORAGEFULL)
(SETQ FIRSTPAGE (IDIFFERENCE (IPLUS \NxtMDSPage \PagesPerMDSUnit)
(SETQ NPAGES (CEIL NPAGES \PagesPerMDSUnit]
(* Plenty of space)
(SETQ \NxtMDSPage (IDIFFERENCE FIRSTPAGE \PagesPerMDSUnit)))
((NEQ (OR \STORAGEFULLSTATE (\SET.STORAGE.STATE))
\SFS.SWITCHABLE) (* Can't switch to the higher area)
(RETURN NIL))
((ILESSP \NxtArrayPage FIRSTPAGE) (* Safe to go ahead anyway. We'll be pretty short of
space in the first 8mb, but it's switchable)
(SETQ \NxtMDSPage (IDIFFERENCE FIRSTPAGE \PagesPerMDSUnit)))
((ILESSP (IPLUS (SETQ FIRSTPAGE \SecondArrayPage)
NPAGES)
\SecondMDSPage) (* There is space in upper area.
So advance the pointer that says where array space will
start when we switch later on)
(SETQ \SecondArrayPage (IPLUS FIRSTPAGE NPAGES))
(replace (IFPAGE FullSpaceUsed) of \InterfacePage with 65535))
(T (RETURN NIL)))
(to NPAGES as (BASE ←(SETQ RESULT (create POINTER
PAGE# ← FIRSTPAGE)))
by (\ADDBASE BASE WORDSPERPAGE)
do (* Allocate the new pages. Leave them having the
default type, namely type 0, don't refcnt)
(\NEWPAGE BASE))
(RETURN RESULT)))])
(\MAPMDS
[LAMBDA (TYPE FN) (* bvm: "24-Apr-85 14:29")
(* * Applies FN to each virtual page number that is of type TYPE, or to all MDS pages if TYPE is NIL)
(OR (NULL TYPE)
(FIXP TYPE)
(SETQ TYPE (\TYPENUMBERFROMNAME TYPE)))
(CHECK (EQ (FOLDLO \MDSIncrement PAGESPERSEGMENT)
2)) (* I'd put this FOLDLO as the increment in the FOR
below, but the translation is atrocious)
(for I from 0 to (COND
((EQ \STORAGEFULLSTATE \SFS.FULLYSWITCHED)
1)
(T 0))
bind TYP
do
(* This is pretty grody because of the two different regions MDS can live in. Could just do everything from
(IMIN \NxtMDSPage \LeastMDSPage) to \MaxMDSPage but waste time on the stuff in between)
(for VP from (COND
((EQ I 0)
(IMIN \NxtMDSPage \LeastMDSPage))
(T \NxtMDSPage))
by 2 to (COND
((EQ I 0)
\DefaultSecondArrayPage)
(T \MaxMDSPage))
do
(* * We could just access \MDSTypeTable directly here, but since NTYPX should be ucoded, we benefit by
"modularizing" this access.)
(COND
((OR (EQ (SETQ TYP (NTYPX (create POINTER
PAGE# ← VP)))
TYPE)
(AND (NULL TYPE)
(NEQ TYP 0)
(NEQ TYP \SMALLP)))
(SPREADAPPLY* FN VP])
(\CHECKFORSTORAGEFULL
[LAMBDA (NPAGES) (* bvm: "24-Apr-85 15:00")
(DECLARE (GLOBALVARS \INTERRUPTSTATE \PENDINGINTERRUPT))
(* * Take appropriate action if storage is getting full. NPAGES is size of attempted allocation or NIL for MDS
requests. Complications here because array space and MDS grow toward each other in two separate areas: the first 8MB
of vmem and the remaining 24MB. Some machines cannot use the latter, so have to signal storage full when the first
fills up. Other machines have to know when to switch over. Array space usually gets switched to the high segment
before MDS, since MDS can eat the lo space in small increments all the way to the end -
Returns T if storage is ok, 0 if storage is ok but \NxtArrayPage changed, and NIL if storage is nearly full)
(UNINTERRUPTABLY
[PROG (PAGESLEFT)
(RETURN (COND
((OR (ILESSP (SETQ PAGESLEFT (IPLUS (IDIFFERENCE \NxtMDSPage \NxtArrayPage)
\PagesPerMDSUnit))
\GUARDSTORAGEFULL)
NPAGES)
(SELECTC (OR \STORAGEFULLSTATE (\SET.STORAGE.STATE))
((LIST \SFS.NOTSWITCHABLE \SFS.FULLYSWITCHED)
(COND
((ILESSP PAGESLEFT 0)
(while T do (\MP.ERROR \MP.MDSFULL "Storage completely full")
))
((AND (ILEQ PAGESLEFT \GUARD1STORAGEFULL)
(NEQ \STORAGEFULL 0))
(SETQ \STORAGEFULL 0)
(\MP.ERROR \MP.MDSFULLWARNING
"Space getting VERY full. Please save and reload a.s.a.p. Type control-N to continue now."))
((NOT \STORAGEFULL)
(SETQ \STORAGEFULL T)
(* Note this is uninterruptable)
(replace STORAGEFULL of \INTERRUPTSTATE with T)
(SETQ \PENDINGINTERRUPT T)))
(\DORECLAIM)
NIL)
(\SFS.SWITCHABLE (* We have verified that we can use the full 32MB, but
haven't switched there yet)
(OR [COND
[(NULL NPAGES)
(* Want MDS)
(COND
((ILEQ PAGESLEFT 0)
(SETQ \LeastMDSPage \NxtArrayPage)
(SETQ \NxtMDSPage \SecondMDSPage)
(\ADVANCE.STORAGE.STATE
\SFS.FULLYSWITCHED)
(\ADVANCE.ARRAY.SEGMENTS
\SecondArrayPage]
(T
(* Want array space)
(COND
((IGREATERP NPAGES PAGESLEFT)
(* Have to switch array space over, but leave MDS to
fill the rest of the low pages)
(SETQ \LeastMDSPage \NxtArrayPage)
(\ADVANCE.STORAGE.STATE
\SFS.ARRAYSWITCHED)
(\ADVANCE.ARRAY.SEGMENTS
\SecondArrayPage]
T))
(\SFS.ARRAYSWITCHED (COND
((ILESSP \NxtMDSPage \LeastMDSPage)
(* Finally used up lo MDS, so switch over to hi)
(SETQ \NxtMDSPage \SecondMDSPage)
(\ADVANCE.STORAGE.STATE \SFS.FULLYSWITCHED)
T)
((AND NPAGES (IGEQ (IPLUS NPAGES
\GUARDSTORAGEFULL)
(IDIFFERENCE
\SecondMDSPage
\NxtArrayPage)))
(* MDS still in lo area, arrays in hi area, and we're asking for too big an array! Unlikely, but handle it as a
storage full case)
NIL)
(T T)))
(SHOULDNT])])
(STORAGE
[LAMBDA (TYPES PAGETHRESHOLD) (* bvm: "12-Feb-85 17:22")
(PROG ((TOTALALLOCMDS (CREATECELL \FIXP))
(TOTALHUNKS (CREATECELL \FIXP))
(FREE (CREATECELL \FIXP))
(HUNKSTATS (from 0 to 2 collect (create HUNKSTAT)))
TYPE TYPENAME DOBLOCKSFLG)
(DECLARE (SPECVARS HUNKSTATS))
(printout NIL "Type" 15 "Assigned" 30 "Free items" 45 "In use" 55 "Total alloc" T 15
"pages [items]"
T)
(COND
[(AND TYPES (NEQ TYPES T))
(for TYPE HFLG inside TYPES when [COND
((FIXP TYPE)
(COND
((OR (ILESSP TYPE 0)
(IGREATERP TYPE \MaxTypeNumber))
(* An explicit type number ought to be "right")
(ERROR "Not a type number" TYPE))
((EQ TYPE 0)
(SETQ DOBLOCKSFLG T)
NIL)
(T T)))
(T (SETQ TYPE (\TYPENUMBERFROMNAME TYPE]
do (COND
((fetch DTDHUNKP of (\GETDTD TYPE))
(SETQ HFLG T)))
(\STORAGE.TYPE TYPE FREE TOTALALLOCMDS PAGETHRESHOLD)
finally (COND
(HFLG (\STORAGE.HUNKTYPE TOTALALLOCMDS PAGETHRESHOLD]
(T (for I from 1 to \MaxTypeNumber do (\STORAGE.TYPE I FREE TOTALALLOCMDS PAGETHRESHOLD))
(\STORAGE.HUNKTYPE TOTALHUNKS PAGETHRESHOLD)
(printout NIL T "TOTAL" 15 .I5 (IPLUS TOTALALLOCMDS TOTALHUNKS)
T T)
(printout NIL "Data Spaces Summary" T)
(printout NIL 30 "Allocated" 50 "Remaining" T)
(printout NIL 32 "Pages" 52 "Pages" T)
(printout NIL "Datatypes (incl. LISTP etc.)" 30 .I8 TOTALALLOCMDS 50 "\" T)
(* Arrayspace and MDS come out of the same pot, so lump
their "remaining" pages together)
(printout NIL "ArrayBlocks" (COND
((NOT (IEQP TOTALHUNKS 0))
" (variable)")
(T ""))
30 .I8 (SELECTC \STORAGEFULLSTATE
((LIST \SFS.FULLYSWITCHED \SFS.ARRAYSWITCHED)
(IPLUS (IDIFFERENCE \LeastMDSPage \FirstArrayPage)
(IDIFFERENCE \NxtArrayPage \SecondArrayPage)))
(IDIFFERENCE \NxtArrayPage \FirstArrayPage))
50 "--" .I6 (CAR (STORAGE.LEFT))
T)
(COND
((NOT (IEQP TOTALHUNKS 0))
(printout NIL "ArrayBlocks (chunked)" 30 .I8 TOTALHUNKS 50 "/" T)))
(* \LastATOMpage marks off atom indexes as if they were word addresses; but the space behind a litatom is one cell
in each of the four spaces: DEFSPACE, VALSPACE, PNAMESPACE, and PROPSPACE)
(\STLINP "Litatoms" (ITIMES (FOLDHI \AtomFrLst CELLSPERPAGE)
4)
(ITIMES (UNFOLD (ADD1 \LastAtomPage)
WORDSPERCELL)
4))
(COND
(\PNAMES.IN.BLOCKS? (\STLINP "Litatom Pnames (from bootstrap)" (ADD1 \CurPnPage)
(ADD1 \CurPnPage)))
(T (\STLINP "Litatom Pnames" (ADD1 \CurPnPage)
\LastPnPage)))
(SETQ DOBLOCKSFLG T)))
(COND
(DOBLOCKSFLG (\SHOW.ARRAY.FREELISTS])
(STORAGE.LEFT
[LAMBDA NIL (* bvm: "24-Apr-85 15:02")
(* * Return a list MDS+Arrays left in 8mb, in 24mb, litatoms left, pnames left and the same as fractions)
(PROG ((MDSFREE (IPLUS (IDIFFERENCE (SELECTC (OR \STORAGEFULLSTATE (\SET.STORAGE.STATE))
(\SFS.ARRAYSWITCHED
(* There's free space in two places: some leftover MDS
in the lo region, and the space beyond allocated arrays
in the hi)
\SecondMDSPage)
\NxtMDSPage)
\NxtArrayPage)
\PagesPerMDSUnit
(SELECTC \STORAGEFULLSTATE
(\SFS.SWITCHABLE (* We have another 24MB to work with)
(IPLUS (IDIFFERENCE \SecondMDSPage
\SecondArrayPage)
\PagesPerMDSUnit))
(\SFS.ARRAYSWITCHED (* Account for the space left behind after array
allocation moved)
(IPLUS (IDIFFERENCE \NxtMDSPage \LeastMDSPage)
\PagesPerMDSUnit))
0)
(for (FREE ← \MDSFREELISTPAGE)
by (SMALLP (\GETBASEPTR (create POINTER
PAGE# ← FREE)
0))
while FREE sum 1)))
(ATOMTOTAL (ITIMES (UNFOLD (ADD1 \LastAtomPage)
WORDSPERCELL)
4))
ATOMSLEFT MDSFRAC)
[SETQ MDSFRAC (FQUOTIENT MDSFREE (IPLUS (IDIFFERENCE (IPLUS \FirstMDSPage \PagesPerMDSUnit)
\FirstArrayPage)
(COND
((EQ \STORAGEFULLSTATE \SFS.NOTSWITCHABLE)
0)
(T (IDIFFERENCE (IPLUS \SecondMDSPage
\PagesPerMDSUnit)
\SecondArrayPage]
(RETURN (LIST MDSFREE MDSFRAC (SELECTC \STORAGEFULLSTATE
(\SFS.NOTSWITCHABLE MDSFRAC)
(\SFS.SWITCHABLE (FQUOTIENT (IDIFFERENCE
(IPLUS \NxtMDSPage
\PagesPerMDSUnit)
\NxtArrayPage)
(IDIFFERENCE
(IPLUS \FirstMDSPage
\PagesPerMDSUnit)
\FirstArrayPage)))
0)
(SETQ ATOMSLEFT (IDIFFERENCE ATOMTOTAL (ITIMES (FOLDHI \AtomFrLst
CELLSPERPAGE)
4)))
(FQUOTIENT ATOMSLEFT ATOMTOTAL])
)
(PUTPROPS ALLOCPAGEBLOCK COPYRIGHT ("Xerox Corporation" 1985))
(DECLARE: DONTCOPY
(FILEMAP (NIL (480 13442 (\ALLOCPAGEBLOCK 490 . 2372) (\MAPMDS 2374 . 3919) (\CHECKFORSTORAGEFULL 3921
. 7723) (STORAGE 7725 . 11041) (STORAGE.LEFT 11043 . 13440)))))
STOP