(FILECREATED "30-Dec-83 15:12:54" {PHYLUM}<LISPCORE>SOURCES>PMAP.;14 40751
changes to: (FNS \CLEARMAP)
previous date: "12-NOV-83 22:10:12" {PHYLUM}<LISPCORE>SOURCES>PMAP.;13)
(* 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 DOPMAP
FINDPTRSBUFFER FORGETPAGES \GETMAPBUFFER LOCKMAP MAPAFTERCLOSE MAPBUFFERCOUNT MAPPAGE
MAPWORD \RELEASEBUFFER RELEASINGVMEMPAGE RESTOREMAP UNLOCKMAP \MAPPAGE \SETIODIRTY)
(FNS WORDCONTENTS SETWORDCONTENTS /SETWORDCONTENTS WORDOFFSET)
(EXPORT (PROP BYTEMACRO WORDCONTENTS SETWORDCONTENTS WORDOFFSET))
(COMS (ADDVARS (DEFAULTMAPFILE)
(SYSTEMBUFFERLIST)
(MAPEMPTYBUFFERLIST))
(GLOBALVARS SYSTEMBUFFERLIST MAPEMPTYBUFFERLIST DEFAULTMAPFILE))
(COMS (* Functions for page-mapped devices)
(DECLARE: DONTCOPY (EXPORT (MACROS RELEASECPAGE))
(MACROS GETPAGEBASE))
(FNS \GETPAGEBASE \PAGEDBACKFILEPTR \PAGEDBIN \PAGEDCOPYBYTES \PAGEDSETFILEPTR
\PAGEDGETFILEPTR \PAGEDGETEOFPTR \PAGEDREADP \PAGEDEOFP \PAGEDBINS \PAGEDBOUT
\PAGEDBOUTS \PAGEDPEEKBIN \TURNPAGE \PAGED.FLUSHOUTPUT))
(FNS PPBUFS)
(DECLARE: DONTCOPY (RECORDS BUFFER)
EVAL@COMPILE
(MACROS GETBUFFERPTR CHECKBUFFERREF CPBUFFERP BUFFERINUSEP UNDIRTY DIRTYP)
(I.S.OPRS INBUFS))
(INITRECORDS BUFFER)
(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) (* rmk: "25-OCT-83 19:56")
(* 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 STREAM in \OPENFILES do (\CLEARMAP STREAM PAGES T)))
(T (PROG NIL
(\CLEARMAP (OR (\GETSTREAM FILE NIL T)
(RETURN))
PAGES T])
(\WRITEOUTBUFFER
[LAMBDA (BUFFER STREAM) (* rmk: "25-OCT-83 19:56")
(* writes the contents of a buffer back out to the file
they are mapped from)
(\WRITEPAGES STREAM (fetch FILEPAGE# of BUFFER)
(CHECKBUFFERREFVAL BUFFER)) (* reset dirty bit.)
(UNDIRTY BUFFER STREAM])
(\CLEARMAP
[LAMBDA (STREAM PAGES USERFLG) (* bvm: "30-Dec-83 14:55")
(* 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.)
(AND (DIRTYABLE STREAM)
(FDEVOP (QUOTE FLUSHOUTPUT)
(fetch DEVICE of STREAM)
STREAM))
(PROG ((BUFFER (fetch BUFFS of STREAM))
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 BUFFERNEXT of PREVBUFFER
with (SETQ BUFFER (fetch BUFFERNEXT
of BUFFER]
(T (* deleting the first buffer, change the STREAM)
(replace BUFFS of STREAM with (SETQ BUFFER
(fetch BUFFERNEXT
of BUFFER]
STREAM)
(GO LP))
(T (SETQ PREVBUFFER BUFFER)
(SETQ BUFFER (fetch BUFFERNEXT of BUFFER))
(GO LP])
(DOPMAP
[LAMBDA (PAGE# STREAM VMEMPAGE) (* rmk: "25-OCT-83 19:57")
(* 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 STREAM 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"])
(FORGETPAGES
[LAMBDA (STREAM FROMPAGE TOPAGE) (* bvm: "12-NOV-83 16:51")
(* 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 STREAM))
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 STREAM) (* if buffer is still referenced, note to return that
fact.)
(SETQ REFFED (CONS (fetch FILEPAGE# of BUFFER)
REFFED]
[COND
(PREVBUFFER (replace BUFFERNEXT of PREVBUFFER with (fetch BUFFERNEXT
of BUFFER)))
(T (replace BUFFS of STREAM with (fetch BUFFERNEXT of BUFFER]
(* MAPOUTBUFFER changes the structure of BUFFER so make
change to BUFFS before it is called.)
(\RELEASEBUFFER BUFFER STREAM)
[SETQ BUFFER (COND
(PREVBUFFER (fetch BUFFERNEXT of PREVBUFFER))
(T (fetch BUFFS of STREAM]
(GO LP))
(T (SETQ PREVBUFFER BUFFER)
(SETQ BUFFER (fetch BUFFERNEXT of BUFFER))
(GO LP])
(\GETMAPBUFFER
[LAMBDA NIL (* bvm: "12-NOV-83 16:54")
(* 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 BUFFERNEXT of
MAPEMPTYBUFFERLIST]
(T (* find the first not referenced one and return it.)
(PROG ((PREV MAPEMPTYBUFFERLIST)
(BUF MAPEMPTYBUFFERLIST))
LP (COND
((NULL (SETQ BUF (fetch BUFFERNEXT of BUF)))
(RETURN NIL))
((OR (NOT (fetch USERMAPPED of BUF))
(fetch NOREFERENCE of BUF)) (* buffer is not referenced or was never user mapped.)
(replace BUFFERNEXT of PREV with (fetch BUFFERNEXT 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 (STREAM) (* rmk: "25-OCT-83 20:08")
(* this function is called after closing a file.)
(\CLEARMAP STREAM)
(AND DEFAULTMAPFILE (EQ STREAM (\GETSTREAM DEFAULTMAPFILE))
(SETQ DEFAULTMAPFILE 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 READONLY) (* rmk: "25-OCT-83 19:55")
(* 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 ((STREAM (\GETSTREAM FILE)))
(OR (fetch PAGEMAPPED of (fetch DEVICE of STREAM))
(ERROR STREAM "not page-mappable"))
(RETURN (SELECTQ (fetch ACCESS of STREAM)
(INPUT (\MAPPAGE PAGE# STREAM T))
[BOTH (PROG1 (\MAPPAGE PAGE# STREAM T)
(OR READONLY (COND
((ILEQ (fetch EPAGE of STREAM)
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 STREAM (ADD1 PAGE#)
0]
(ERROR STREAM "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 STREAM) (* bvm: "12-NOV-83 16:51")
(* releases a buffer by moving it from the STREAM 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 BUFFERNEXT 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 (STREAM PAGES) (* bvm: "12-NOV-83 16:51")
(* 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 ((STRM (\GETSTREAM STREAM))
(BUFFER (fetch BUFFS of STREAM))
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 STRM) (* 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)
STRM
(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 BUFFERNEXT of PREVBUFFER
with (SETQ BUFFER (fetch BUFFERNEXT
of BUFFER]
(T (* deleting the first buffer, change the STRM)
(replace BUFFS of STRM with (SETQ BUFFER
(fetch BUFFERNEXT
of BUFFER]
STRM)
(GO LP]
(SETQ PREVBUFFER BUFFER)
(SETQ BUFFER (fetch BUFFERNEXT of BUFFER))
(GO LP])
(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# STREAM USERFLG) (* bvm: "12-NOV-83 16:54")
(* maps a page of a file into a buffer. Assumes its arg is an STREAM and has been checked.
Currently mapped pages are maintained in the STREAM. The STREAM 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 STREAM)))
(RETURN (COND
((NULL BUF) (* no buffers yet)
(SETQ BUF (\GETMAPBUFFER))
(PROG1 (DOPMAP FILEPAGE# STREAM (CHECKBUFFERREFVAL BUF))
(replace FILEPAGE# of BUF with FILEPAGE#)
(replace BUFFERNEXT of BUF with NIL)
(replace BUFFS of STREAM 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 BUFFERNEXT of BUF)))
(* not found)
[COND
((OR (NULL PREVAVAIL)
(ILEQ #IOBUFFS (fetch MAXBUFFERS of STREAM)))
(* to increase the number of buffers available to a
file, put a field in the STREAM and check it here)
(* create a new buffer)
(SETQ BUF (\GETMAPBUFFER)))
(T (SETQ BUF (fetch BUFFERNEXT of PREVAVAIL))
(* write out the old buffer if necessary and remove it
from its place in the list)
(COND
((AND (DIRTYABLE STREAM)
(OR (fetch USERMAPPED of BUF)
(DIRTYP BUF STREAM)))
(\WRITEOUTBUFFER BUF STREAM)))
(replace BUFFERNEXT of PREVAVAIL with (fetch BUFFERNEXT
of BUF]
(* BUF is not a buffer to be used.
If interrupted here a buffer could get dropped.)
(RETURN (PROG1 (DOPMAP FILEPAGE# STREAM (CHECKBUFFERREFVAL BUF))
(* PROG1 holds page pointer)
(replace FILEPAGE# of BUF with FILEPAGE#)
(replace BUFFERNEXT of BUF
with (fetch BUFFS of STREAM))
(* move to front of buffer list)
(replace BUFFS of STREAM 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 BUFFERNEXT of PREV with (fetch BUFFERNEXT of BUF))
(replace BUFFERNEXT of BUF with (fetch BUFFS of STREAM))
(replace BUFFS of STREAM 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 (STREAM PAGENUMBER) (* rmk: "25-OCT-83 20:00")
(* marks a buffer descriptor as dirty.)
(for BUF inbufs (fetch BUFFS of STREAM) 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 DEFAULTMAPFILE )
(ADDTOVAR SYSTEMBUFFERLIST )
(ADDTOVAR MAPEMPTYBUFFERLIST )
(DECLARE: DOEVAL@COMPILE DONTCOPY
(ADDTOVAR GLOBALVARS SYSTEMBUFFERLIST MAPEMPTYBUFFERLIST DEFAULTMAPFILE)
)
(* Functions for page-mapped devices)
(DECLARE: DONTCOPY
(* FOLLOWING DEFINITIONS EXPORTED)
(DECLARE: EVAL@COMPILE
(PUTPROPS RELEASECPAGE MACRO ((STREAM)
(PROGN (COND
((fetch CPDIRTY of STREAM)
(\SETIODIRTY STREAM (fetch CPAGE of STREAM))
(replace CPDIRTY of STREAM with NIL)))
(replace CPPTR of STREAM with NIL))))
)
(* END EXPORTED DEFINITIONS)
(DECLARE: EVAL@COMPILE
(PUTPROPS GETPAGEBASE MACRO [(STREAM PURPOSE)
(PROG1 (OR (fetch CPPTR of STREAM)
(\GETPAGEBASE STREAM PURPOSE))
(AND (EQ PURPOSE (QUOTE WRITE))
(replace CPDIRTY of STREAM with T])
)
)
(DEFINEQ
(\GETPAGEBASE
[LAMBDA (STREAM WHATFOR) (* bvm: "31-DEC-81 18:04")
(* Obtains page for current position.
Takes this opportunity to check access)
(PROG (BUF)
[OR (SELECTQ WHATFOR
(READ (READABLE STREAM))
(WRITE (WRITEABLE STREAM))
(SHOULDNT))
(COND
((OPENED STREAM)
(LISPERROR "PROTECTION VIOLATION" (fetch FULLNAME of STREAM)))
(T (LISPERROR "FILE NOT OPEN" (fetch FULLNAME of STREAM]
(* First, set Last Char of Current Page)
(SETQ BUF (\MAPPAGE (fetch CPAGE of STREAM)
STREAM)) (* This is interruptable)
(UNINTERRUPTABLY (* But these two fields must be set uninterruptably for
benefit of ucode & \UPDATEOF)
(replace CBUFSIZE of STREAM with (COND
((IGREATERP (fetch EPAGE of STREAM)
(fetch CPAGE of STREAM))
(* Full page)
BYTESPERPAGE)
((EQ (fetch EPAGE of STREAM)
(fetch CPAGE of STREAM))
(* Last page)
(fetch EOFFSET of STREAM))
(T (* Beyond EOF so no data)
0)))
(replace CPPTR of STREAM with BUF))
(RETURN BUF])
(\PAGEDBACKFILEPTR
[LAMBDA (STREAM) (* rmk: "22-AUG-83 13:36")
(* also see similar function \DRIBBACKFILEPTR)
[COND
((APPENDONLY STREAM)
(LISPERROR "ILLEGAL ARG" (fetch FULLNAME of STREAM]
(* Checks done separately so we dont take an error with
interrupts off)
(COND
([NOT (AND (ZEROP (fetch COFFSET of STREAM))
(ZEROP (fetch CPAGE of STREAM]
(UNINTERRUPTABLY
[replace COFFSET of STREAM with (COND
((ZEROP (fetch COFFSET of STREAM))
(RELEASECPAGE STREAM)
(add (fetch CPAGE of STREAM)
-1)
(replace CBUFSIZE of STREAM with 0)
(SUB1 BYTESPERPAGE))
(T (SUB1 (fetch COFFSET of STREAM]
[replace (STREAM CHARPOSITION) of STREAM with (IMAX 0 (SUB1 (fetch (STREAM CHARPOSITION)
of STREAM])])
(\PAGEDBIN
[LAMBDA (STREAM) (* rmk: "29-MAY-82 00:14")
(CHECK (type? STREAM STREAM)
(READABLE STREAM)
(EQ (fetch BYTESIZE of STREAM)
(CONSTANT BitsPerByte))) (* EOF checked in INCREAD)
(PROG (X)
RETRY
(RETURN (\GETBASEBYTE (GETPAGEBASE STREAM (QUOTE READ))
(PROG1 (fetch COFFSET of STREAM)
(COND
((ILESSP (fetch COFFSET of STREAM)
(fetch CBUFSIZE of STREAM))
(add (fetch COFFSET of STREAM)
1))
((EQ (SETQ X (\TURNPAGE STREAM (QUOTE READ)))
T) (* \TURNPAGE found the next page, so try again)
(GO RETRY))
(T (RETURN X])
(\PAGEDCOPYBYTES
[LAMBDA (SRC DST ACTUALSTART ACTUALEND) (* rmk: "21-OCT-83 14:52")
(* COPYBYTES for page-mapped SRC.)
(bind (STARTPAGE ←(fetch CPAGE of SRC))
(STARTOFFSET ←(fetch COFFSET of SRC))
(ENDPAGE ←(fetch (BYTEPTR PAGE) of ACTUALEND))
(ENDOFFSET ←(fetch (BYTEPTR OFFSET) of ACTUALEND))
do (COND
((NEQ STARTPAGE ENDPAGE)
(\BOUTS DST (GETPAGEBASE SRC (QUOTE READ))
STARTOFFSET
(IDIFFERENCE BYTESPERPAGE STARTOFFSET))
(* Copy thru to end of source page)
(add STARTPAGE 1)
(SETQ STARTOFFSET 0)
(\TURNPAGE SRC (QUOTE READ)))
(T (COND
((IGREATERP ENDOFFSET STARTOFFSET)
(\BOUTS DST (GETPAGEBASE SRC (QUOTE READ))
STARTOFFSET
(IDIFFERENCE ENDOFFSET STARTOFFSET))
(* Copy part of a page)
(replace COFFSET of SRC with ENDOFFSET) (* Update current pointer)
))
(RETURN])
(\PAGEDSETFILEPTR
[LAMBDA (STREAM INDX) (* rmk: " 2-JUL-82 14:55")
(\UPDATEOF STREAM) (* Update the EOF in case we have writen thru it)
(PROG ((NEWPAGE (fetch (BYTEPTR PAGE) of INDX))
(NEWOFF (fetch (BYTEPTR OFFSET) of INDX)))
(UNINTERRUPTABLY
(COND
([OR (NEQ NEWPAGE (fetch CPAGE of STREAM))
(AND (APPENDONLY STREAM)
(ILESSP NEWOFF (fetch COFFSET of STREAM]
(* Force page release if ptr is going off the beaten
path)
(RELEASECPAGE STREAM)
(replace CBUFSIZE of STREAM with 0) (* Disable microcode)
(replace CPAGE of STREAM with NEWPAGE)))
(replace COFFSET of STREAM with NEWOFF))])
(\PAGEDGETFILEPTR
[LAMBDA (STREAM) (* rmk: " 2-JUL-82 13:07")
(create BYTEPTR
PAGE ←(fetch CPAGE of STREAM)
OFFSET ←(fetch COFFSET of STREAM])
(\PAGEDGETEOFPTR
[LAMBDA (STREAM) (* bvm: "26-DEC-81 15:48")
(\UPDATEOF STREAM) (* If we have been writing the EOF may not be current)
(create BYTEPTR
PAGE ←(fetch EPAGE of STREAM)
OFFSET ←(fetch EOFFSET of STREAM])
(\PAGEDREADP
[LAMBDA (STREAM FLG) (* rrb "22-JUL-83 08:58")
(* The 10 does not do the EOL check on the peeked
character.)
(* If FLG is NIL, a single EOL as the last character of
the file doesn't count.)
(AND (NOT (\PAGEDEOFP STREAM))
(OR (NOT (NULL FLG))
(NEQ EOL.TC (\SYNCODE \PRIMTERMSA (\PAGEDPEEKBIN STREAM)))
(OR (ILESSP (ffetch CPAGE of STREAM)
(ffetch EPAGE of STREAM))
(PROG2
(* Having done a \PAGEDPEEKBIN above, we won't be in the case where COFFSET is BYTESPERPAGE Thus there are at
least two characters in the buffer)
(ILESSP (ADD1 (ffetch COFFSET of STREAM))
(ffetch CBUFSIZE of STREAM])
(\PAGEDEOFP
[LAMBDA (STREAM) (* JonL "10-JUN-83 00:50")
(* Determines if a paged file is at EOF.)
(OR (READONLY STREAM)
(\UPDATEOF STREAM))
(COND
((ILESSP (IPLUS (fetch CPAGE of STREAM)
(FOLDLO (fetch COFFSET of STREAM)
BYTESPERPAGE))
(fetch EPAGE of STREAM))
(* Not on last page yet, so not eof. Need to figure in the COFFSET because it is possible for COFFSET to be
BYTESPERPAGE before the page is turned)
NIL)
((IGREATERP (fetch CPAGE of STREAM)
(fetch EPAGE of STREAM)))
((IGEQ (IMOD (fetch COFFSET of STREAM)
BYTESPERPAGE)
(fetch EOFFSET of STREAM])
(\PAGEDBINS
[LAMBDA (STREAM BASE OFF N) (* lmm " 5-MAR-83 16:45")
(* For page-mapped streams, BINs N bytes from STREAM to
memory starting at BASE+OFF. End of file check is in
TURNPAGE.)
(bind CNT END PG START
do (SETQ PG (GETPAGEBASE STREAM (QUOTE READ))) (* Page handle)
(SETQ START (fetch COFFSET of STREAM)) (* First byte. Zero xcpt on first pass)
[SETQ END (IMIN (IPLUS START N)
(COND
((ILESSP (fetch CPAGE of STREAM)
(fetch EPAGE of STREAM))
BYTESPERPAGE)
(T (fetch CBUFSIZE of STREAM] (* First byte BEYOND whats to be read from this page)
(\MOVEBYTES PG START BASE OFF (SETQ CNT (IDIFFERENCE END START)))
(COND
((IGREATERP N CNT)
(SETQ N (IDIFFERENCE N CNT)) (* This much more to do)
(SETQ OFF (IPLUS OFF CNT)) (* starting here)
(\TURNPAGE STREAM (QUOTE READ)) (* next page, pls)
)
(T (COND
((EQ END BYTESPERPAGE)
(\TURNPAGE STREAM (QUOTE READ)) (* Move onto next page)
)
(T (replace COFFSET of STREAM with END) (* Move to after the last byte we read)
))
(RETURN])
(\PAGEDBOUT
[LAMBDA (STREAM BYTE) (* rmk: "21-OCT-83 14:41")
(CHECK (type? STREAM STREAM)
(WRITEABLE STREAM))
(PROG NIL
RETRY
(RETURN (\PUTBASEBYTE (GETPAGEBASE STREAM (QUOTE WRITE))
[PROG1 (fetch COFFSET of STREAM)
(COND
((ILESSP (fetch COFFSET of STREAM)
BYTESPERPAGE)
(add (fetch COFFSET of STREAM)
1))
(T (\TURNPAGE STREAM (QUOTE WRITE))
(GO RETRY]
BYTE)))
1])
(\PAGEDBOUTS
[LAMBDA (STREAM BASE OFF N) (* lmm " 5-MAR-83 16:45")
(* For page-mapped streams, bouts N bytes to stream from
Base,off)
(bind CNT END PG START
do (SETQ PG (GETPAGEBASE STREAM (QUOTE WRITE)))
(SETQ START (fetch COFFSET of STREAM))
(SETQ END (IMIN (IPLUS START N)
BYTESPERPAGE))
(\MOVEBYTES BASE OFF PG START (SETQ CNT (IDIFFERENCE END START)))
(COND
((IGREATERP N CNT)
(SETQ N (IDIFFERENCE N CNT))
(SETQ OFF (IPLUS OFF CNT))
(\TURNPAGE STREAM (QUOTE WRITE)))
(T (COND
((EQ END BYTESPERPAGE)
(\TURNPAGE STREAM (QUOTE WRITE)))
(T (replace COFFSET of STREAM with END)))
(RETURN])
(\PAGEDPEEKBIN
[LAMBDA (STREAM NOERRORFLG) (* rmk: "30-JUN-82 17:46")
(* Grabs next byte. The GETPAGEBASE loads the current page if necessary. If we are beyond the EOF it will load a
blank page of zeros, but we are heading for an error then anyway (unless NOERRORFLG, in which case we return NIL.
This option is used by SKIPSEPRS.) A value returned from ERRORX2 under ENDOFSTREAMOP will be returned as the
peeked byte, although ENDOFSTREAMOP doesn't return at all if STREAM is the terminal.)
(PROG (X)
RETRY
(RETURN (\GETBASEBYTE (GETPAGEBASE STREAM (QUOTE READ))
(PROG1 (fetch COFFSET of STREAM)
(COND
((ILESSP (fetch COFFSET of STREAM)
(fetch CBUFSIZE of STREAM))
(* The buffer returned by GETPAGEBASE is valid)
)
((EQ (SETQ X (\TURNPAGE STREAM (QUOTE READ)
NOERRORFLG))
T) (* \TURNPAGE found the next page, so try again)
(GO RETRY))
(T (RETURN X])
(\TURNPAGE
[LAMBDA (STREAM WHATFOR NOERRORFLG) (* rmk: "30-JUN-82 17:46")
(* Advances STREAM to a new page. Leaves the current page pointer NIL as the new page may never be written, so
must update eof. Returns T on success; any other return is a value to use by \BIN)
(PROG NIL
[COND
((IGEQ (fetch CPAGE of STREAM)
(fetch EPAGE of STREAM)) (* Next page is past end of file)
(SELECTQ WHATFOR
[READ (RETURN (AND (NULL NOERRORFLG)
(STREAMOP (QUOTE ENDOFSTREAMOP)
STREAM STREAM]
(WRITE (\SETEOF STREAM (ADD1 (fetch CPAGE of STREAM))
0))
(SHOULDNT]
(RELEASECPAGE STREAM) (* Let current page go)
(UNINTERRUPTABLY
(replace CBUFSIZE of STREAM with (replace COFFSET of STREAM with 0))
(* First byte. \GETPAGEBASE will fix CBUFSIZE.)
(add (fetch CPAGE of STREAM)
1) (* Next page)
)
(RETURN T])
(\PAGED.FLUSHOUTPUT
[LAMBDA (STREAM PAGES) (* bvm: "12-NOV-83 17:12")
(* 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))
(SETQ STREAM (\GETSTREAM STREAM (QUOTE OUTPUT)))
(COND
((DIRTYABLE STREAM)
(for WB in [SORT (for B inbufs (fetch BUFFS of STREAM)
when (AND [OR (NULL PAGES)
(for P inside PAGES thereis (EQ P (fetch FILEPAGE#
of B]
(OR (fetch USERMAPPED of B)
(DIRTYP B STREAM)))
collect B)
(FUNCTION (LAMBDA (X Y)
(IGREATERP (fetch FILEPAGE# of Y)
(fetch FILEPAGE# of X]
do (\WRITEOUTBUFFER WB STREAM) (* Write out any page on PAGES and dirty, in ascending
order.))
(\TRUNCATEFILE STREAM) (* Adjusts length on device)
))
STREAM])
)
(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)
BUFFERNEXT 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])
(PUTPROPS DIRTYP MACRO [OPENLAMBDA (BUFFER STREAM) (* rmk: "25-OCT-83 19:57")
(* 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 STREAM)
(fetch CPDIRTY of STREAM])
)
(DECLARE: EVAL@COMPILE
[I.S.OPR (QUOTE INBUFS)
NIL
(QUOTE (first I.V. ← BODY by (fetch BUFFERNEXT of I.V.)
until
(NULL I.V.]
)
)
(/DECLAREDATATYPE (QUOTE BUFFER)
(QUOTE (POINTER XPOINTER POINTER POINTER FLAG FLAG FLAG)))
(DECLARE: DOEVAL@COMPILE DONTCOPY
(LOCALVARS . T)
)
(PUTPROPS PMAP COPYRIGHT ("Xerox Corporation" 1982 1983))
(DECLARE: DONTCOPY
(FILEMAP (NIL (1568 21585 (ADDMAPBUFFER 1578 . 1750) (\ALLOCMAPBUFFER 1752 . 2353) (CHECKBUFFERREFVAL
2355 . 2884) (CLEARMAP 2886 . 3490) (\WRITEOUTBUFFER 3492 . 3933) (\CLEARMAP 3935 . 6124) (DOPMAP 6126
. 6637) (FINDPTRSBUFFER 6639 . 7174) (FORGETPAGES 7176 . 8866) (\GETMAPBUFFER 8868 . 10837) (LOCKMAP
10839 . 11042) (MAPAFTERCLOSE 11044 . 11389) (MAPBUFFERCOUNT 11391 . 11830) (MAPPAGE 11832 . 13081) (
MAPWORD 13083 . 13362) (\RELEASEBUFFER 13364 . 13872) (RELEASINGVMEMPAGE 13874 . 14518) (RESTOREMAP
14520 . 16539) (UNLOCKMAP 16541 . 16746) (\MAPPAGE 16748 . 21061) (\SETIODIRTY 21063 . 21583)) (21586
22423 (WORDCONTENTS 21596 . 21739) (SETWORDCONTENTS 21741 . 22055) (/SETWORDCONTENTS 22057 . 22278) (
WORDOFFSET 22280 . 22421)) (23632 37838 (\GETPAGEBASE 23642 . 25243) (\PAGEDBACKFILEPTR 25245 . 26333)
(\PAGEDBIN 26335 . 27111) (\PAGEDCOPYBYTES 27113 . 28283) (\PAGEDSETFILEPTR 28285 . 29185) (
\PAGEDGETFILEPTR 29187 . 29415) (\PAGEDGETEOFPTR 29417 . 29764) (\PAGEDREADP 29766 . 30676) (
\PAGEDEOFP 30678 . 31498) (\PAGEDBINS 31500 . 32919) (\PAGEDBOUT 32921 . 33462) (\PAGEDBOUTS 33464 .
34289) (\PAGEDPEEKBIN 34291 . 35428) (\TURNPAGE 35430 . 36642) (\PAGED.FLUSHOUTPUT 36644 . 37836)) (
37839 38184 (PPBUFS 37849 . 38182)))))
STOP