(FILECREATED "10-MAR-83 23:34:23" <BLISP>PMAP.;20 27288
changes to: (RECORDS BUFFER)
(FNS ALLOCMAPBUFFER FINDPTRSBUFFER GETBUFFERPTR CHECKBUFFERREFVAL RESTOREMAP
\MAPPAGE CHECKBUFFERREF MAPWORD)
(VARS PMAPCOMS)
(MACROS GETBUFFERPTR CHECKBUFFERREF CPBUFFERP BUFFERINUSEP UNDIRTY)
previous date: " 9-MAR-83 21:49:26" <BLISP>PMAP.;19)
(* Copyright (c) 1982, 1983 by Xerox Corporation)
(PRETTYCOMPRINT PMAPCOMS)
(RPAQQ PMAPCOMS [(* Page mapping primitives. This file is shared with VAX.)
(FNS ADDMAPBUFFER ALLOCMAPBUFFER CHECKBUFFERREFVAL CLEARMAP WRITEOUTBUFFER \CLEARMAP DIRTYP
DOPMAP FINDPTRSBUFFER FLUSHMAP FORGETPAGES GETMAPBUFFER LOCKMAP MAPAFTERCLOSE
MAPBUFFERCOUNT MAPPAGE MAPWORD RELEASEBUFFER RELEASINGVMEMPAGE RESTOREMAP UNDIRTY
UNLOCKMAP \MAPPAGE \SETIODIRTY)
(FNS WORDCONTENTS SETWORDCONTENTS /SETWORDCONTENTS WORDOFFSET)
(EXPORT (PROP BYTEMACRO WORDCONTENTS SETWORDCONTENTS WORDOFFSET))
(ADDVARS (DEFAULTMAPOFD)
(SYSTEMBUFFERLIST)
(MAPEMPTYBUFFERLIST))
(FNS PPBUFS)
(DECLARE: DONTCOPY (RECORDS BUFFER)
EVAL@COMPILE
(MACROS GETBUFFERPTR CHECKBUFFERREF CPBUFFERP BUFFERINUSEP UNDIRTY)
(I.S.OPRS INBUFS))
(INITRECORDS BUFFER)
(GLOBALVARS SYSTEMBUFFERLIST MAPEMPTYBUFFERLIST DEFAULTMAPOFD)
(BLOCKS (NIL /SETWORDCONTENTS ADDMAPBUFFER CLEARMAP \CLEARMAP CHECKBUFFERREFVAL DIRTYP DOPMAP
FINDPTRSBUFFER FLUSHMAP LOCKMAP MAPAFTERCLOSE MAPBUFFERCOUNT WRITEOUTBUFFER
MAPPAGE MAPWORD RELEASINGVMEMPAGE RESTOREMAP SETWORDCONTENTS UNLOCKMAP
RELEASEBUFFER WORDCONTENTS WORDOFFSET ALLOCMAPBUFFER GETMAPBUFFER
(GLOBALVARS SYSTEMBUFFERLIST MAPEMPTYBUFFERLIST DEFAULTMAPOFD)
(LOCALVARS . T])
(* Page mapping primitives. This file is shared with VAX.)
(DEFINEQ
(ADDMAPBUFFER
[LAMBDA (TEMP ERRORFLG) (* rrb "16-DEC-79 15:54")
(* old entry left arond for compatibility)
NIL])
(ALLOCMAPBUFFER
[LAMBDA NIL (* lmm "10-MAR-83 23:19")
(* allocates a new buffer. The new buffer will be put on SYSTEMBUFFERLIST which
is used by the GC when releasing a buffer.)
(* This should be the only function that creates BUFFERs.)
(SETQ SYSTEMBUFFERLIST (create BUFFER
VMEMPAGE ←(NCREATE (QUOTE VMEMPAGEP))
SYSNEXT ← SYSTEMBUFFERLIST])
(CHECKBUFFERREFVAL
[LAMBDA (BUFF) (* lmm "10-MAR-83 23:23")
(* checks the reference bit of a buffer descriptor and sets it if it is off. Also returns the value of the buffer
page ptr so that it will be on the stack and therefore not be reset if a gc occurs.)
(UNINTERRUPTABLY
(COND
((fetch NOREFERENCE of BUFF)
(\DELREF (fetch VMEMPAGE of BUFF))
(replace NOREFERENCE of BUFF with NIL)))
(fetch VMEMPAGE of BUFF))])
(CLEARMAP
[LAMBDA (FILE PAGES RELEASE) (* lmm "30-SEP-80 13:12")
(* Clears the usermapped PAGES of FILE from the buffers.
RELEASE is for compatibility with MAXC.)
(DECLARE (GLOBALVARS \OPENFILES))
(COND
((EQ FILE T) (* T denotes all files)
(for OFDX in \OPENFILES do (\CLEARMAP OFDX PAGES T)))
(T (PROG NIL
(\CLEARMAP (OR (\GETOFD FILE NIL T)
(RETURN))
PAGES T])
(WRITEOUTBUFFER
[LAMBDA (BUFFER OFD) (* bvm: "24-JUN-82 16:54")
(* writes the contents of a buffer back out to the file
they are mapped from)
(\WRITEPAGES OFD (fetch FILEPAGE# of BUFFER)
(CHECKBUFFERREFVAL BUFFER)) (* reset dirty bit.)
(UNDIRTY BUFFER OFD])
(\CLEARMAP
[LAMBDA (OFD PAGES USERFLG) (* rmk: " 7-APR-81 21:02")
(* clears pages from an ofd writing them out if they are dirty. PAGES is a page# or a list of page#s or NIL.
USERFLG is T for user calls and if PAGES is NIL, causes all usermapped pages to get written out.)
(* first write out any buffers that are dirty. This is done first to keep the manipulation of buffer pointers away
from disk operations and allows the pages to be written out in ascending order.)
(FLUSHMAP OFD PAGES)
(PROG ((BUFFER (fetch BUFFS of OFD))
PREVBUFFER)
LP (COND
((NULL BUFFER)
(RETURN))
((COND
((NULL PAGES)
(COND
(USERFLG (* User is asking for all mapped pages to be cleared, Is
this a usermapped page?)
(fetch USERMAPPED of BUFFER))
(T (* system call, clear all pages)
T)))
((NLISTP PAGES)
(EQ PAGES (fetch FILEPAGE# of BUFFER)))
((FMEMB (fetch FILEPAGE# of BUFFER)
PAGES))) (* found a page to clear.)
(* this may cause extra IO system buffers to get unallocated. this is ok in that they will get reallocated up to the
standard number but not ok in that if the file was opened specifying more that the standard number, the extras will
get lost.)
(RELEASEBUFFER [PROG1 BUFFER (COND
[PREVBUFFER (* This isn't the first buffer on list.)
(replace NEXT of PREVBUFFER
with (SETQ BUFFER (fetch NEXT of BUFFER]
(T (* deleting the first buffer, change the OFD)
(replace BUFFS of OFD with (SETQ BUFFER
(fetch NEXT of BUFFER]
OFD)
(GO LP))
(T (SETQ PREVBUFFER BUFFER)
(SETQ BUFFER (fetch NEXT of BUFFER))
(GO LP])
(DIRTYP
[LAMBDA (BUFFER OFD) (* bas: "21-DEC-79 16:02")
(* determines if this buffer has been dirtied by the IO system. It can't determine if the user has done a putbase
into the page if he got it from MAPPAGE.)
(OR (fetch IODIRTY of BUFFER)
(AND (CPBUFFERP BUFFER OFD)
(fetch CPDIRTY of OFD])
(DOPMAP
[LAMBDA (PAGE# OFD VMEMPAGE) (* bas: "21-DEC-79 17:42")
(* reads a page from a file into a block of storage. If the protection bits are ever implemented in hardware, this
should set them from a new argument.)
(\READPAGES OFD PAGE# VMEMPAGE)
(* We return the page pointer to ensure that it remains on the stack to guard
against inclement garbage collections)
VMEMPAGE])
(FINDPTRSBUFFER
[LAMBDA (PTR NOERRORFLG) (* lmm "10-MAR-83 23:20")
(* given a pointer to a mapped location, return the buffer which contains that pointer. Causes error if no such
buffer (thus this is used as a checking function too))
(COND
[(bind (B ← SYSTEMBUFFERLIST) while B do (COND
((EQ PTR (fetch VMEMPAGE of B))
(RETURN B))
(T (SETQ B (fetch SYSNEXT of B]
(NOERRORFLG NIL)
(T (ERROR PTR "not a MAPPAGE pointer"])
(FLUSHMAP
[LAMBDA (OFD PAGES) (* rmk: " 7-APR-81 21:01")
(* Flushes the contents of any dirty pages back into the file but leaves them available to LISP.
As there is no way to know whether or not a usermapped page has been changed, such pages will be written out again
when the ofd is closed.)
(DECLARE (GLOBALVARS \OPENFILES))
(for OFDX inside (COND
((EQ OFD T)
\OPENFILES)
(T (\GETOFD OFD)))
when (DIRTYABLE OFDX)
do (for WB in [SORT (for B inbufs (fetch BUFFS of OFDX)
when (AND [OR (NULL PAGES)
(for P inside PAGES thereis (EQ P (fetch FILEPAGE#
of B]
(OR (fetch USERMAPPED of B)
(DIRTYP B OFDX)))
collect B)
(FUNCTION (LAMBDA (X Y)
(IGREATERP (fetch FILEPAGE# of Y)
(fetch FILEPAGE# of X]
do (WRITEOUTBUFFER WB OFDX) (* Write out any page on PAGES and dirty, in ascending
order.))
(\TRUNCATEFILE OFDX) (* Adjusts length on device)
finally (RETURN OFDX])
(FORGETPAGES
[LAMBDA (OFD FROMPAGE TOPAGE) (* rmk: " 7-APR-81 21:00")
(* cleans pages out of the map. Used only by truncate file to throw away any trancated pages that might be mapped.
Pages FROMPAGE to TOPAGE inclusive are forgotten. If FROMPAGE is NIL uses 0, if TOPAGE is NIL, uses last page.)
(COND
((OR (NULL TOPAGE)
(NULL FROMPAGE)
(IGEQ TOPAGE FROMPAGE))
(PROG (REFFED (BUFFER (fetch BUFFS of OFD))
PREVBUFFER)
LP (COND
((NULL BUFFER)
(RETURN REFFED))
((AND (OR (NULL FROMPAGE)
(IGEQ (fetch FILEPAGE# of BUFFER)
FROMPAGE))
(OR (NULL TOPAGE)
(ILEQ (fetch FILEPAGE# of BUFFER)
TOPAGE))) (* this is a BUFFER to process)
[COND
((BUFFERINUSEP BUFFER OFD) (* if buffer is still referenced, note to return that
fact.)
(SETQ REFFED (CONS (fetch FILEPAGE# of BUFFER)
REFFED]
[COND
(PREVBUFFER (replace NEXT of PREVBUFFER with (fetch NEXT of BUFFER)))
(T (replace BUFFS of OFD with (fetch NEXT of BUFFER]
(* MAPOUTBUFFER changes the structure of BUFFER so make
change to BUFFS before it is called.)
(RELEASEBUFFER BUFFER OFD)
[SETQ BUFFER (COND
(PREVBUFFER (fetch NEXT of PREVBUFFER))
(T (fetch BUFFS of OFD]
(GO LP))
(T (SETQ PREVBUFFER BUFFER)
(SETQ BUFFER (fetch NEXT of BUFFER))
(GO LP])
(GETMAPBUFFER
[LAMBDA NIL (* rrb " 2-JAN-80 15:46")
(* gets a map buffer from the free list or creates a new one. Some of the ones on the free list may still be
referenced by user structure and hence can't be used. the reference counts will actually be behind the real ones
because PMAPs only gets updated when a garbage collection occurs. A possible strategy before allocating a new one or
if none can be allocated is to force a garbage collection.)
(COND
[(AND MAPEMPTYBUFFERLIST (COND
[(OR (NOT (fetch USERMAPPED of MAPEMPTYBUFFERLIST))
(fetch NOREFERENCE of MAPEMPTYBUFFERLIST))
(* is first empty buffer unreferenced or has it never been user mapped?)
(replace IODIRTY of MAPEMPTYBUFFERLIST with NIL)
(replace USERMAPPED of MAPEMPTYBUFFERLIST with NIL)
(PROG1 MAPEMPTYBUFFERLIST (SETQ MAPEMPTYBUFFERLIST (fetch NEXT of MAPEMPTYBUFFERLIST]
(T (* find the first not referenced one and return it.)
(PROG ((PREV MAPEMPTYBUFFERLIST)
(BUF MAPEMPTYBUFFERLIST))
LP (COND
((NULL (SETQ BUF (fetch NEXT of BUF)))
(RETURN NIL))
((OR (NOT (fetch USERMAPPED of BUF))
(fetch NOREFERENCE of BUF))
(* buffer is not referenced or was never user mapped.)
(replace NEXT of PREV with (fetch NEXT of BUF))
(replace IODIRTY of BUF with NIL)
(replace USERMAPPED of BUF with NIL)
(RETURN BUF))
(T (SETQ PREV BUF)
(GO LP]
(T (* if there isn't one that's not referenced, create a new one.)
(ALLOCMAPBUFFER])
(LOCKMAP
[LAMBDA (PTR) (* rrb "15-SEP-79 18:17")
(* is a noop on the dorado all buffers are locked until no longer referenced.)
PTR])
(MAPAFTERCLOSE
[LAMBDA (OFD) (* rrb " 2-JAN-80 16:34")
(* this function is called after closing a file.)
(\CLEARMAP OFD)
(COND
((EQ OFD DEFAULTMAPOFD)
(SETQ DEFAULTMAPOFD NIL])
(MAPBUFFERCOUNT
[LAMBDA (AVAILFLG) (* rrb " 2-JAN-80 15:47")
(* counts either the total number of buffers or the number available for use
now.)
(bind B←SYSTEMBUFFERLIST while B count (PROG1 (OR (NOT AVAILFLG)
(fetch NOREFERENCE of B)
(NOT (fetch USERMAPPED of B)))
(SETQ B (fetch SYSNEXT of B])
(MAPPAGE
[LAMBDA (PAGE# FILE/OFD READONLY)
(* lmm "30-SEP-80 13:17")
(* establishes a buffer for a page of a file and (since semantics of 10 require it) checks to make sure file is open
for reading.)
(* must set the eof pointer if this page is past the current eof and the file is writable, unless user says READONLY
in which case we don't guarantee that (accidental) changes to the buffer will get saved in the file.)
(PROG ((OFD (\GETOFD FILE/OFD)))
(RETURN (SELECTQ (fetch ACCESS of OFD)
(INPUT (\MAPPAGE PAGE# OFD T))
[BOTH (PROG1 (\MAPPAGE PAGE# OFD T)
(OR READONLY (COND
((ILEQ (fetch EPAGE of OFD)
PAGE#)
(* user is mapping for write the last page or a page beyond the last one, set the EOF to the zeroth byte of the next
page. This assumes that BOUT keeps at least the page part of the EOF up to date with its output.)
(\SETEOF OFD (ADD1 PAGE#)
0]
(ERROR OFD "must be open for input to map."])
(MAPWORD
[LAMBDA (FILEADR FILE) (* lmm "10-MAR-83 23:33")
(* changed to contain dorado standard page size constants.)
(WORDOFFSET (MAPPAGE (FOLDLO FILEADR WORDSPERPAGE)
FILE)
(MOD FILEADR BYTESPERPAGE])
(RELEASEBUFFER
[LAMBDA (BUFFER OFD) (* rrb "11-JAN-80 16:09")
(* releases a buffer by moving it from the OFD to the free list. it will not be taken off the free list if it is
still referenced and it has been usermapped.)
(* put the buffer on the free list.)
(replace NEXT of BUFFER with MAPEMPTYBUFFERLIST)
(SETQ MAPEMPTYBUFFERLIST BUFFER])
(RELEASINGVMEMPAGE
[LAMBDA (PTR) (* bvm: "24-JUN-82 17:01")
(* this function is called by the garbage collector when it determines that PTR is a VMEMPAGE to which there are
no pointers. If this function returns T, PTR will not be put on the free list. This function checks to see if PTR
is a buffer and if so, marks that buffer's descriptor as available. If not, the user has created and used PTR so
zero it before it goes onto free list.)
(COND
((SETQ PTR (FINDPTRSBUFFER PTR T))
(replace NOREFERENCE of PTR with T)
T])
(RESTOREMAP
[LAMBDA (OFD PAGES) (* lmm "10-MAR-83 23:24")
(* This function is called by LOGOUT after it has returned on any file that has been found to be changed.
It remaps any pages that are referenced (LOGOUT calls RECLAIM) and returns a list of their page numbers.)
(PROG ((OFDX (\GETOFD OFD))
(BUFFER (fetch BUFFS of OFD))
PREVBUFFER REFFED)
LP [COND
((NULL BUFFER)
(RETURN REFFED))
([OR (NULL PAGES)
(for P inside PAGES thereis (EQ P (fetch FILEPAGE# of BUFFER]
(* found a page to restore. If page is not referenced, don't bother to remap it. If it is referenced, map it and
return its page number.)
(COND
((BUFFERINUSEP BUFFER OFDX)
(* if r/w bits are ever made accessible to LISP, they should be gotten from the
ofd and passed to DOPMAP.)
(DOPMAP (fetch FILEPAGE# of BUFFER)
OFDX
(fetch VMEMPAGE of BUFFER))
(SETQ REFFED (CONS (fetch FILEPAGE# of BUFFER)
REFFED)))
(T
(* this may cause extra IO system buffers to get unallocated. this is ok in that they will get reallocated up to the
standard number but not ok in that if the file was opened specifying more that the standard number, the extras will
get lost.)
(RELEASEBUFFER [PROG1 BUFFER (COND
[PREVBUFFER
(* This isn't the first buffer on list.)
(replace NEXT of PREVBUFFER
with (SETQ BUFFER (fetch NEXT of BUFFER]
(T
(* deleting the first buffer, change the OFDX)
(replace BUFFS of OFDX with (SETQ BUFFER
(fetch NEXT of BUFFER]
OFDX)
(GO LP]
(SETQ PREVBUFFER BUFFER)
(SETQ BUFFER (fetch NEXT of BUFFER))
(GO LP])
(UNDIRTY
[LAMBDA (BUFFER OFD) (* rrb "11-JAN-80 15:49")
(* sets the dirty bits to indicate a page is clean.)
(replace IODIRTY of BUFFER with NIL)
(COND
((CPBUFFERP BUFFER OFD)
(replace CPDIRTY of OFD with NIL])
(UNLOCKMAP
[LAMBDA (PTR) (* rrb "15-SEP-79 18:18")
(* is a noop on the dorado all buffers are locked until no longer referenced.)
PTR])
(\MAPPAGE
[LAMBDA (FILEPAGE# OFD USERFLG)
(* lmm "10-MAR-83 23:25")
(* maps a page of a file into a buffer. Assumes its arg is an OFD and has been checked. Currently mapped pages are
maintained in the OFD. The OFD specifies a fixed number of buffers which are cycled through the sequential IO and
more are added if the user calls MAPPAGE. The oldest available buffer is used for the new page and more are
allocated if none is available.)
(PROG ((BUF (fetch BUFFS of OFD)))
(RETURN (COND
((NULL BUF) (* no buffers yet)
(SETQ BUF (GETMAPBUFFER))
(PROG1 (DOPMAP FILEPAGE# OFD (CHECKBUFFERREFVAL BUF))
(replace FILEPAGE# of BUF with FILEPAGE#)
(replace NEXT of BUF with NIL)
(replace BUFFS of OFD with BUF)
(replace USERMAPPED of BUF with USERFLG)))
((EQ (fetch FILEPAGE# of BUF)
FILEPAGE#)
(* if usermapped, then set bit in buffer.)
(COND
(USERFLG (replace USERMAPPED of BUF with T)))
(CHECKBUFFERREF BUF)
(* page is already on top)
(fetch VMEMPAGE of BUF))
(T (* not on top walk thru the list, looking for the page and noting the last
available buffer in case it is not found.)
(PROG ((#IOBUFFS (COND
((fetch USERMAPPED of BUF)
0)
(T 1)))
(PREV BUF)
PREVAVAIL)
LP [COND
[(NULL (SETQ BUF (fetch NEXT of BUF)))
(* not found)
[COND
((OR (NULL PREVAVAIL)
(ILEQ #IOBUFFS (fetch MAXBUFFERS of OFD)))
(* to increase the number of buffers available to a file, put a field in the OFD
and check it here)
(* create a new buffer)
(SETQ BUF (GETMAPBUFFER)))
(T (SETQ BUF (fetch NEXT of PREVAVAIL))
(* write out the old buffer if necessary and remove it from its place in the
list)
(COND
((AND (DIRTYABLE OFD)
(OR (fetch USERMAPPED of BUF)
(DIRTYP BUF OFD)))
(WRITEOUTBUFFER BUF OFD)))
(replace NEXT of PREVAVAIL with (fetch NEXT of BUF]
(* BUF is not a buffer to be used. If interrupted here a buffer could get
dropped.)
(RETURN (PROG1 (DOPMAP FILEPAGE# OFD (CHECKBUFFERREFVAL BUF))
(* PROG1 holds page pointer)
(replace FILEPAGE# of BUF with FILEPAGE#)
(replace NEXT of BUF with (fetch BUFFS of OFD))
(* move to front of buffer list)
(replace BUFFS of OFD with BUF)
(replace USERMAPPED of BUF with USERFLG]
((EQ (fetch FILEPAGE# of BUF)
FILEPAGE#)
(* found the page, move it to front.)
(CHECKBUFFERREF BUF)
(UNINTERRUPTABLY
(replace NEXT of PREV with (fetch NEXT of BUF))
(replace NEXT of BUF with (fetch BUFFS of OFD))
(replace BUFFS of OFD with BUF))
(RETURN (GETBUFFERPTR BUF)))
((OR (NULL (fetch USERMAPPED of BUF))
(fetch NOREFERENCE of BUF))
(* BUF is available)
(SETQ PREVAVAIL PREV)
(SETQ #IOBUFFS (ADD1 #IOBUFFS]
(* advance to next buffer on list.)
(SETQ PREV BUF)
(GO LP])
(\SETIODIRTY
[LAMBDA (OFD PAGENUMBER) (* rmk: " 7-APR-81 20:56")
(* marks a buffer descriptor as dirty.)
(for BUF inbufs (fetch BUFFS of OFD) when (EQ (fetch FILEPAGE# of BUF)
PAGENUMBER)
do (replace IODIRTY of BUF with T)
(RETURN BUF)
finally (SHOULDNT) (* It better be there somewhere)])
)
(DEFINEQ
(WORDCONTENTS
[LAMBDA (PTR) (* lmm "28-FEB-82 23:24")
(CHECK (FINDPTRSBUFFER PTR T))
(\GETBASE PTR 0])
(SETWORDCONTENTS
[LAMBDA (PTR N) (* lmm "28-FEB-82 23:21")
(* stores into a word in a buffer. Does error checking which is not done by
macro.)
(OR (FINDPTRSBUFFER PTR T)
(ERROR PTR "not a PMAP buffer."))
(\PUTBASE PTR 0 N])
(/SETWORDCONTENTS
[LAMBDA (PTR N) (* lmm "18-SEP-78 00:26")
[AND LISPXHIST (UNDOSAVE (LIST (FUNCTION /SETWORDCONTENTS)
PTR
(WORDCONTENTS PTR]
(SETWORDCONTENTS PTR N])
(WORDOFFSET
[LAMBDA (PTR N) (* lmm "28-FEB-82 23:22")
(CHECK (FINDPTRSBUFFER PTR T))
(\ADDBASE PTR N])
)
(* FOLLOWING DEFINITIONS EXPORTED)
(PUTPROPS WORDCONTENTS BYTEMACRO ((PTR)
(\GETBASE PTR 0)))
(PUTPROPS SETWORDCONTENTS BYTEMACRO ((PTR N)
(\PUTBASE PTR 0 N)))
(PUTPROPS WORDOFFSET BYTEMACRO ((PTR N)
(\ADDBASE PTR N)))
(* END EXPORTED DEFINITIONS)
(ADDTOVAR DEFAULTMAPOFD )
(ADDTOVAR SYSTEMBUFFERLIST )
(ADDTOVAR MAPEMPTYBUFFERLIST )
(DEFINEQ
(PPBUFS
[LAMBDA (BUF0) (* rmk: " 7-APR-81 20:53")
(* Displays a buffer chain)
(for B inbufs BUF0 do (printout T "[" (fetch FILEPAGE# of B)
": " B "] ")
finally (TERPRI T])
)
(DECLARE: DONTCOPY
[DECLARE: EVAL@COMPILE
(DATATYPE BUFFER (FILEPAGE# (VMEMPAGE XPOINTER)
NEXT SYSNEXT (NOREFERENCE FLAG)
(USERMAPPED FLAG)
(IODIRTY FLAG)))
]
(/DECLAREDATATYPE (QUOTE BUFFER)
(QUOTE (POINTER XPOINTER POINTER POINTER FLAG FLAG FLAG)))
EVAL@COMPILE
(DECLARE: EVAL@COMPILE
(PUTPROPS GETBUFFERPTR MACRO ((BUFF)
(fetch VMEMPAGE of BUFF)))
(PUTPROPS CHECKBUFFERREF MACRO [OPENLAMBDA (BUFF)
(* bvm: "24-JUN-82 17:03")
(* checks the reference field of a buffer descriptor and if no one is referencing it, it creates a reference and
changes the flag. The flag is set by the garbage collector when there are no longer any references to the buffer it
describes.)
(UNINTERRUPTABLY
(COND
((fetch NOREFERENCE of BUFF)
(* this is a page the reference to which has been dropped, zero its reference
count before returning it.)
(\DELREF (fetch VMEMPAGE of BUFF))
(replace NOREFERENCE of BUFF with NIL))))])
(PUTPROPS CPBUFFERP MACRO ((BUFFER STREAM)
(EQ (fetch CPPTR of STREAM)
(fetch VMEMPAGE of BUFFER))))
(PUTPROPS BUFFERINUSEP MACRO [OPENLAMBDA (BUFFER STREAM)
(AND (NULL (fetch NOREFERENCE of BUFFER))
(OR (fetch USERMAPPED of BUFFER)
(CPBUFFERP BUFFER STREAM])
(PUTPROPS UNDIRTY MACRO [OPENLAMBDA (BUFFER STREAM)
(replace IODIRTY of BUFFER with NIL)
(COND
((CPBUFFERP BUFFER STREAM)
(replace CPDIRTY of STREAM with NIL])
)
(DECLARE: EVAL@COMPILE
[I.S.OPR (QUOTE INBUFS)
NIL
(QUOTE (first I.V. ← BODY by (fetch NEXT of I.V.)
until
(NULL I.V.]
)
)
(/DECLAREDATATYPE (QUOTE BUFFER)
(QUOTE (POINTER XPOINTER POINTER POINTER FLAG FLAG FLAG)))
(DECLARE: DOEVAL@COMPILE DONTCOPY
(ADDTOVAR GLOBALVARS SYSTEMBUFFERLIST MAPEMPTYBUFFERLIST DEFAULTMAPOFD)
)
[DECLARE: DONTEVAL@LOAD DOEVAL@COMPILE DONTCOPY
(BLOCK: NIL /SETWORDCONTENTS ADDMAPBUFFER CLEARMAP \CLEARMAP CHECKBUFFERREFVAL DIRTYP DOPMAP
FINDPTRSBUFFER FLUSHMAP LOCKMAP MAPAFTERCLOSE MAPBUFFERCOUNT WRITEOUTBUFFER MAPPAGE MAPWORD
RELEASINGVMEMPAGE RESTOREMAP SETWORDCONTENTS UNLOCKMAP RELEASEBUFFER WORDCONTENTS WORDOFFSET
ALLOCMAPBUFFER GETMAPBUFFER (GLOBALVARS SYSTEMBUFFERLIST MAPEMPTYBUFFERLIST DEFAULTMAPOFD)
(LOCALVARS . T))
]
(PUTPROPS PMAP COPYRIGHT ("Xerox Corporation" 1982 1983))
(DECLARE: DONTCOPY
(FILEMAP (NIL (1827 22946 (ADDMAPBUFFER 1839 . 2014) (ALLOCMAPBUFFER 2018 . 2509) (CHECKBUFFERREFVAL
2513 . 3054) (CLEARMAP 3058 . 3580) (WRITEOUTBUFFER 3584 . 4024) (\CLEARMAP 4028 . 6115) (DIRTYP 6119
. 6497) (DOPMAP 6501 . 6983) (FINDPTRSBUFFER 6987 . 7535) (FLUSHMAP 7539 . 8821) (FORGETPAGES 8825 .
10496) (GETMAPBUFFER 10500 . 12349) (LOCKMAP 12353 . 12559) (MAPAFTERCLOSE 12563 . 12830) (
MAPBUFFERCOUNT 12834 . 13280) (MAPPAGE 13284 . 14424) (MAPWORD 14428 . 14712) (RELEASEBUFFER 14716 .
15167) (RELEASINGVMEMPAGE 15171 . 15827) (RESTOREMAP 15831 . 17884) (UNDIRTY 17888 . 18206) (UNLOCKMAP
18210 . 18418) (\MAPPAGE 18422 . 22423) (\SETIODIRTY 22427 . 22943)) (22948 23811 (WORDCONTENTS 22960
. 23106) (SETWORDCONTENTS 23110 . 23430) (/SETWORDCONTENTS 23434 . 23660) (WORDOFFSET 23664 . 23808))
(24225 24578 (PPBUFS 24237 . 24575)))))
STOP