(FILECREATED " 5-Jun-84 12:23:39" {PHYLUM}<LISPNEW>SOURCES>VOLUMEALLOCATIONMAP.;3 12774
changes to: (FNS \DFSVAMAllocPageGroup)
previous date: "24-May-84 20:04:53" {PHYLUM}<LISPNEW>SOURCES>VOLUMEALLOCATIONMAP.;2)
(* Copyright (c) 1984 by Xerox Corporation)
(PRETTYCOMPRINT VOLUMEALLOCATIONMAPCOMS)
(RPAQQ VOLUMEALLOCATIONMAPCOMS ((* Implements the 1108 file system volume file map. Very roughly
translates {idun}<apilot100>pilot>private>volAllocMapImpl.mesa,
but omits a number of dubious optimizations.)
(DECLARE: EVAL@COMPILE DONTCOPY (CONSTANTS (BITSPERPAGE 4096)))
(* Public routines)
(FNS \DFSVAMAllocPageGroup \DFSVAMFreePageGroup \DFSVAMInit
\DFSVAMRecomputeFreePageCount)
(* Private routines:)
(FNS \DFSVAMAllocPage \DFSVAMUpdateVAM \DFSVAMGetVAMPageFor
\DFSVAMAdjustGroup \DFSVAMFreePage)
(FNS \DFSVAMAtLoad)
(GLOBALVARS \DFSVAMmonitor \DFSVAMbuffer \DFSVAMbufferVolume
\DFSVAMbufferVolumePage)
(P (\DFSVAMAtLoad))))
(* Implements the 1108 file system volume file map. Very roughly translates
{idun}<apilot100>pilot>private>volAllocMapImpl.mesa, but omits a number of dubious
optimizations.)
(DECLARE: EVAL@COMPILE DONTCOPY
(DECLARE: EVAL@COMPILE
(RPAQQ BITSPERPAGE 4096)
(CONSTANTS (BITSPERPAGE 4096))
)
)
(* Public routines)
(DEFINEQ
(\DFSVAMAllocPageGroup
[LAMBDA (vol filePtr groupPtr createFile) (* hts: " 5-Jun-84 11:49")
(* vol: LogicalVolumeDescriptor, filePtr:
FileDescriptor, groupPtr: PageGroup, createFile:
BOOLEAN)
(WITH.MONITOR \DFSVAMmonitor
(UNINTERRUPTABLY
(PROG ((page (fetch (LogicalVolumeDescriptor lowerBound) of vol))
desiredPage allocated)
(until (PROGN [if (IGEQ page (SUB1 (fetch (LogicalVolumeDescriptor
volumeSize)
of vol)))
then (SETQ \INTERRUPTABLE T)
(* Gross hack to allow the error to show up as a break
rather than a 9318)
(LISPERROR "FILE SYSTEM RESOURCES EXCEEDED"
(\DFSGetLvName (\DFSFindVolumeNumber
vol]
(\DFSVAMAllocPage vol filePtr page))
do (add page 1)) (* Find first free page)
(replace (PageGroup volumePage) of groupPtr with page)
[SETQ desiredPage (IPLUS page (IDIFFERENCE (fetch (PageGroup nextFilePage)
of groupPtr)
(fetch (PageGroup filePage)
of groupPtr]
[repeatuntil (PROGN (add page 1)
[if (IGEQ page (SUB1 (fetch (LogicalVolumeDescriptor
volumeSize)
of vol)))
then (SETQ \INTERRUPTABLE T)
(* Gross hack to allow the error to show up as a break
rather than a 9318)
(LISPERROR "FILE SYSTEM RESOURCES EXCEEDED"
(\DFSGetLvName (
\DFSFindVolumeNumber vol]
(OR (EQP page desiredPage)
(NOT (\DFSVAMAllocPage vol filePtr page]
(* Find last free page in run.)
(SETQ allocated (IDIFFERENCE page (fetch (PageGroup volumePage)
of groupPtr)))
(replace (PageGroup nextFilePage) of groupPtr
with (IPLUS (fetch (PageGroup filePage) of groupPtr)
allocated))
(add (fetch (LogicalVolumeDescriptor freePageCount) of vol)
(MINUS allocated)) (* Update free page count)
(replace (LogicalVolumeDescriptor lowerBound) of vol with page)
(* Indicate new lower bound for first free page)
(\LvPutPage vol 0 vol) (* Flush logical volume page)
(\LvPutPage \DFSVAMbufferVolume \DFSVAMbufferVolumePage \DFSVAMbuffer)
(* Flush last VAM page used)
))])
(\DFSVAMFreePageGroup
[LAMBDA (vol filePtr groupPtr deleteFile) (* hts: "24-May-84 20:02")
(* vol: LogicalVolumeDescriptor, filePtr:
FileDescriptor, groupPtr: PageGroup, deleteFile:
BOOLEAN)
(* Frees each page in groupPtr)
(WITH.MONITOR \DFSVAMmonitor (UNINTERRUPTABLY
(PROG ((group (\DFSVAMAdjustGroup groupPtr)))
(* Adjust to coincide with Pilot's silly "[0, 0)"
convention)
(if (IGEQ (fetch (PageGroup filePage) of group)
(fetch (PageGroup nextFilePage) of group))
then (RETURN))
(for page from (fetch (PageGroup volumePage) of group)
to [IPLUS (fetch (PageGroup volumePage) of group)
(SUB1 (IDIFFERENCE (fetch (PageGroup
nextFilePage)
of group)
(fetch (PageGroup filePage)
of group]
do (\DFSVAMFreePage vol filePtr page))
(add (fetch (LogicalVolumeDescriptor freePageCount)
of vol)
(IDIFFERENCE (fetch (PageGroup nextFilePage)
of group)
(fetch (PageGroup filePage)
of group)))
(* Update free page count for the volume)
(replace (LogicalVolumeDescriptor lowerBound)
of vol with (MIN (fetch (PageGroup volumePage)
of group)
(fetch (LogicalVolumeDescriptor
lowerBound)
of vol)))
(\LvPutPage vol 0 vol)
(* Flush logical volume page)
(\LvPutPage vol \DFSVAMbufferVolumePage \DFSVAMbuffer)))])
(\DFSVAMInit
[LAMBDA NIL (* hts: "21-May-84 17:46")
(SETQ \DFSVAMbufferVolumePage) (* if bufferVolumePage is NIL, GetVAMPageFor will not
try to flush an old version of it)
])
(\DFSVAMRecomputeFreePageCount
[LAMBDA (vol) (* hts: "22-May-84 09:23")
(* vol: LogicalVolumeDescriptor,)
(* Recomputes the free page count for each volume from
scratch; also resets the lower bound pointer)
(WITH.MONITOR \DFSVAMmonitor (UNINTERRUPTABLY
[replace (LogicalVolumeDescriptor freePageCount) of vol
with (bind firstFree ← T for page from 1
to (fetch (LogicalVolumeDescriptor volumeSize)
of vol)
count (PROG [(free (ZEROP (\DFSVAMUpdateVAM
vol NIL page
(QUOTE read]
(if (AND free firstFree)
then (replace (LogicalVolumeDescriptor
lowerBound)
of vol with page)
(SETQ firstFree NIL))
(RETURN free]
(\LvPutPage vol 0 vol)
(fetch (LogicalVolumeDescriptor freePageCount) of vol))])
)
(* Private routines:)
(DEFINEQ
(\DFSVAMAllocPage
[LAMBDA (vol filePtr page#) (* hts: "15-May-84 11:55")
(* vol: LogicalVolumeDescriptor, filePtr:
FileDescriptor, page: FIXP)
(* RETURNS T if successful at allocating page, otherwise
NIL)
(if (ZEROP (\DFSVAMUpdateVAM vol filePtr page# (QUOTE alloc)))
then (PROG ((page (\LvGetPage vol page#)))
(for word from 0 to (SUB1 WORDSPERPAGE) do (\PUTBASE page word 0))
(\LvPutPage vol page# page)) (* Zero out the page)
(OR (EQ 1 (\DFSVAMUpdateVAM vol filePtr page# (QUOTE read)))
(SHOULDNT (QUOTE fuckup)))
T
else NIL])
(\DFSVAMUpdateVAM
[LAMBDA (vol filePtr page allocOrFree) (* hts: "15-May-84 12:06")
(* vol: LogicalVolumeDescriptor, filePtr:
FileDescriptor, page: FIXP, allocOrFree: {alloc, free})
(* RETURNS previous value of allocation map for
specified page)
(* Sets (if allocOrFree = alloc) or clears
(if allocOrFree = free) the map bit for the specified
page)
(PROG ((VAMPage# (IQUOTIENT page BITSPERPAGE))
(VAMWord# (IQUOTIENT (IREMAINDER page BITSPERPAGE)
BITSPERWORD))
(VAMBit# (IREMAINDER page BITSPERWORD))
VAMPage VAMWord VAMBit result)
(SETQ VAMPage (\DFSVAMGetVAMPageFor vol VAMPage#))
(SETQ VAMWord (\GETBASE VAMPage VAMWord#))
(SETQ VAMBit (MASK.1'S VAMBit# 1))
(SETQ result (if (BITTEST VAMWord VAMBit)
then 1
else 0))
(SELECTQ allocOrFree
(alloc (SETQ VAMWord (BITSET VAMWord VAMBit)))
(free (SETQ VAMWord (BITCLEAR VAMWord VAMBit)))
(read)
(SHOULDNT))
(\PUTBASE VAMPage VAMWord# VAMWord)
(RETURN result])
(\DFSVAMGetVAMPageFor
[LAMBDA (vol VAMPage#) (* hts: "18-May-84 21:55")
(PROG ((volumePage (IPLUS (fetch (LogicalVolumeDescriptor vamStart) of vol)
VAMPage#)))
(if (AND (LVEqual \DFSVAMbufferVolume vol)
(EQP \DFSVAMbufferVolumePage volumePage))
then (RETURN \DFSVAMbuffer) (* If the desired VAM page is already read in, just
return it)
else (if \DFSVAMbufferVolumePage
then (\LvPutPage \DFSVAMbufferVolume \DFSVAMbufferVolumePage \DFSVAMbuffer))
(* Otherwise write out the old VAM page)
(UNINTERRUPTABLY
(SETQ \DFSVAMbufferVolume vol)
(SETQ \DFSVAMbufferVolumePage volumePage)
(* Record what the new page is)
(RETURN (\LvGetPage \DFSVAMbufferVolume \DFSVAMbufferVolumePage \DFSVAMbuffer))
(* and read it in)
)])
(\DFSVAMAdjustGroup
[LAMBDA (groupPtr) (* hts: "12-Apr-84 14:47")
(PROG ((group (create PageGroup using groupPtr)))
[if (ZEROP (fetch (PageGroup filePage) of group))
then (if (ZEROP (fetch (PageGroup nextFilePage) of group))
then (replace (PageGroup nextFilePage) of group with 1)
else (replace (PageGroup filePage) of group with 1)
(replace (PageGroup volumePage) of group with (ADD1 (fetch (PageGroup
volumePage)
of group]
(RETURN group])
(\DFSVAMFreePage
[LAMBDA (vol filePtr page) (* hts: "14-May-84 17:16")
(* vol: LogicalVolumeDescriptor, filePtr:
FileDescriptor, page: FIXP)
(* Frees the specified page)
(if (ZEROP (\DFSVAMUpdateVAM vol filePtr page (QUOTE free)))
then (SHOULDNT (QUOTE pageAlreadyDeallocated])
)
(DEFINEQ
(\DFSVAMAtLoad
[LAMBDA NIL (* hts: "15-May-84 11:43")
(SETQ \DFSVAMmonitor (CREATE.MONITORLOCK (QUOTE \DFSVAMmonitor)))
(SETQ \DFSVAMbuffer (NCREATE (QUOTE VMEMPAGEP)))
(SETQ \DFSVAMbufferVolume)
(SETQ \DFSVAMbufferVolumePage])
)
(DECLARE: DOEVAL@COMPILE DONTCOPY
(ADDTOVAR GLOBALVARS \DFSVAMmonitor \DFSVAMbuffer \DFSVAMbufferVolume \DFSVAMbufferVolumePage)
)
(\DFSVAMAtLoad)
(PUTPROPS VOLUMEALLOCATIONMAP COPYRIGHT ("Xerox Corporation" 1984))
(DECLARE: DONTCOPY
(FILEMAP (NIL (1369 7748 (\DFSVAMAllocPageGroup 1379 . 4242) (\DFSVAMFreePageGroup 4244 . 6321) (
\DFSVAMInit 6323 . 6609) (\DFSVAMRecomputeFreePageCount 6611 . 7746)) (7779 12223 (\DFSVAMAllocPage
7789 . 8625) (\DFSVAMUpdateVAM 8627 . 9962) (\DFSVAMGetVAMPageFor 9964 . 11076) (\DFSVAMAdjustGroup
11078 . 11736) (\DFSVAMFreePage 11738 . 12221)) (12224 12536 (\DFSVAMAtLoad 12234 . 12534)))))
STOP