(FILECREATED "23-Sep-86 13:45:14" {ERIS}<LISPCORE>MSPF>COREIO.;2 40634
changes to: (VARS COREIOCOMS)
previous date: "22-Sep-86 18:47:51" {ERIS}<LISPCORE>MSPF>COREIO.;1)
(* Copyright (c) 1981, 1982, 1983, 1984, 1985, 1986 by Xerox Corporation. All rights reserved.)
(PRETTYCOMPRINT COREIOCOMS)
(RPAQQ COREIOCOMS
((* ;;; "Implementation of Core resident `files'")
(FNS \CORE.CLOSEFILE \CORE.DELETEFILE \CORE.FINDPAGE \CORE.GENERATEFILES \CORE.NEXTFILEFN
\CORE.FILEINFOFN \CORE.GETFILEHANDLE \CORE.GETFILEINFO \CORE.GETFILEINFO.FROM.INFOBLOCK
\CORE.GETFILENAME \CORE.GETINFOBLOCK \CORE.NAMESCAN \CORE.NAMESEGMENT \CORE.OPENFILE
\COREFILE.SETPARAMETERS \CORE.PACKFILENAME \CORE.RELEASEPAGES \CORE.SETFILEPTR
\CORE.UPDATEOF \CORE.BACKFILEPTR \CORE.SETEOFPTR \CORE.SETACCESSTIME \CORE.SETFILEINFO
\CORE.GETNEXTBUFFER \CORE.UNPACKFILENAME)
(FNS COREDEVICE \CREATECOREDEVICE)
(FNS \NODIRCOREFDEV \NODIRCORE.OPENFILE)
(DECLARE: DONTCOPY (RECORDS CORE.PAGEENTRY COREFILEINFOBLK CORESTREAM COREDEVICE
COREGENFILESTATE))
(INITRECORDS COREFILEINFOBLK)
(DECLARE: DONTEVAL@LOAD DOCOPY (P (COREDEVICE (QUOTE NODIRCORE)
T)
(COREDEVICE (QUOTE CORE))
(COREDEVICE (QUOTE SCRATCH)
T))
(ADDVARS (GAINSPACEFORMS ((FILDIR (QUOTE {SCRATCH}*.*))
"delete {SCRATCH} files"
(DIRECTORY (QUOTE {SCRATCH}*.*;*)
(QUOTE (P DELETE)))))))
(DECLARE: DOEVAL@LOAD DONTCOPY (LOCALVARS . T))))
(* ;;; "Implementation of Core resident `files'")
(DEFINEQ
(\CORE.CLOSEFILE
(LAMBDA (STREAM) (* hdj "22-Sep-86 18:40")
(* ;;; "Close a CORE file.")
(SELECTQ (fetch ACCESS of STREAM)
((OUTPUT BOTH APPEND)
(\CORE.UPDATEOF STREAM)
(replace IOEPAGE of (fetch INFOBLK of STREAM) with (fetch EPAGE of STREAM))
(replace IOEOFFSET of (fetch INFOBLK of STREAM) with (fetch EOFFSET of STREAM))
(\CORE.RELEASEPAGES STREAM (fetch EPAGE of STREAM)))
NIL)
(UNINTERRUPTABLY
(replace CBUFPTR of STREAM with NIL)
(replace CBUFSIZE of STREAM with 0))
STREAM))
(\CORE.DELETEFILE
[LAMBDA (FILENAME DEV EVENIFOPEN) (* hdj "23-Jun-86 14:03")
(* delete a file from a directory.)
(PROG [(INFOBLOCK (COND
((type? STREAM FILENAME) (* If ACCESS, it's open.)
(AND (OR EVENIFOPEN (NULL (fetch ACCESS of FILENAME)))
(fetch INFOBLK of FILENAME)))
(T (\CORE.GETINFOBLOCK FILENAME (QUOTE OLDEST)
DEV]
(COND
((OR (NULL INFOBLOCK)
(FDEVOP (QUOTE OPENP)
DEV
(fetch IOFILEFULLNAME of INFOBLOCK)
NIL DEV)) (* Can't delete an open file)
(RETURN)))
[for I on (fetch COREDIRECTORY of DEV)
when [for J on (CADR I) when [for K on (CADR J) when (EQ (CDR (CADR K))
INFOBLOCK)
do (RETURN (RPLACD K (CDDR K]
do (RETURN (OR (CDADR J)
(RPLACD J (CDDR J] do (RETURN (OR (CDADR I)
(RPLACD I (CDDR I]
(* Ad hoc code to Delete directory
entry)
(replace IOFILEPAGES of INFOBLOCK with (LIST (create CORE.PAGEENTRY
PAGENUMBER ← 0)))
(RETURN (fetch IOFILEFULLNAME of INFOBLOCK])
(\CORE.FINDPAGE
[LAMBDA (STREAM PN) (* bvm: "20-Apr-85 13:32")
(* Finds the entry for page PN in the page list for
STREAM, creating it if necessary.)
(PROG ((CACHE (fetch COREPAGECACHE of STREAM))
PAGETAIL PREVTAIL PAGEPTR PE)
[SETQ PAGETAIL (COND
((AND CACHE (LEQ (fetch PAGENUMBER of (CAR CACHE))
PN)) (* Use cache: PN must be somewhere in this tail of the
page list, so no sense in searching the entire page
list)
CACHE)
(T (COND
((LESSP PN 0) (* Consistency check so that we don't try to RPLACD NIL
down below)
(\ILLEGAL.ARG PN)))
(fetch FILEPAGES of STREAM]
LP (* Page 0 always exists)
(COND
[(EQ (fetch PAGENUMBER of (SETQ PE (CAR PAGETAIL)))
PN)
(OR (SETQ PAGEPTR (fetch PAGEPOINTER of PE))
(replace PAGEPOINTER of PE with (SETQ PAGEPTR (\ALLOCBLOCK (FOLDHI WORDSPERPAGE
WORDSPERCELL]
[[OR (IGREATERP (fetch PAGENUMBER of PE)
PN)
(NULL (SETQ PAGETAIL (CDR (SETQ PREVTAIL PAGETAIL]
(* PN would be before this, so it doesn't exist yet; splice it onto front of tail. This case also works when we hit
the end of the list, in which case we are just smashing a new cons onto the end)
(RPLACD PREVTAIL (SETQ PAGETAIL (CONS [create CORE.PAGEENTRY
PAGENUMBER ← PN
PAGEPOINTER ←(SETQ PAGEPTR
(\ALLOCBLOCK (FOLDHI WORDSPERPAGE
WORDSPERCELL]
PAGETAIL]
(T (GO LP)))
(replace COREPAGECACHE of STREAM with PAGETAIL)
(RETURN PAGEPTR])
(\CORE.GENERATEFILES
[LAMBDA (FDEV PATTERN DESIREDPROPS OPTIONS) (* bvm: " 9-Jul-84 14:11")
(PROG ((FILTER (DIRECTORY.MATCH.SETUP PATTERN))
(DESIREDVERSION (FILENAMEFIELD PATTERN (QUOTE VERSION)))
MATCHINGFILES)
[SETQ MATCHINGFILES (for NAME in (CDR (fetch (FDEV DEVICEINFO) of FDEV))
join (for EXT in (CDR NAME) when (CDR EXT)
join (COND
((FIXP DESIREDVERSION)
(AND (SETQ EXT (ASSOC DESIREDVERSION (CDR EXT)))
[DIRECTORY.MATCH FILTER (fetch (COREFILEINFOBLK
IOFILEFULLNAME)
of (SETQ EXT
(CDR EXT]
(LIST EXT)))
((DIRECTORY.MATCH FILTER (CONCAT (CAR NAME)
"."
(CAR EXT)))
(COND
[(NULL DESIREDVERSION)
(* Highest version only)
(LIST (CDR (CADR EXT]
(T (for VERS in (CDR EXT) collect (CDR VERS]
(RETURN (create FILEGENOBJ
NEXTFILEFN ←(FUNCTION \CORE.NEXTFILEFN)
FILEINFOFN ←(FUNCTION \CORE.FILEINFOFN)
GENFILESTATE ←(create COREGENFILESTATE
COREFILELST ←(CONS NIL MATCHINGFILES])
(\CORE.NEXTFILEFN
[LAMBDA (GENFILESTATE NAMEONLY SCRATCHLIST) (* bvm: " 9-Jul-84 14:05")
(PROG (FILE)
(pop (fetch COREFILELST of GENFILESTATE))
[SETQ FILE (fetch (COREFILEINFOBLK IOFILEFULLNAME)
of (CAR (OR (fetch COREFILELST of GENFILESTATE)
(RETURN]
(RETURN (COND
(NAMEONLY (NAMEFIELD FILE T))
(T FILE])
(\CORE.FILEINFOFN
[LAMBDA (GENFILESTATE ATTRIBUTE) (* bvm: " 3-May-84 10:50")
(\CORE.GETFILEINFO.FROM.INFOBLOCK (CAR (fetch COREFILELST of GENFILESTATE))
ATTRIBUTE])
(\CORE.GETFILEHANDLE
[LAMBDA (NAME RECOG FD CREATEFLG) (* bvm: " 9-Jul-84 17:17")
(PROG ((INFOBLOCK (\CORE.GETINFOBLOCK NAME RECOG FD CREATEFLG)))
(RETURN (AND INFOBLOCK (create CORESTREAM
DEVICE ← FD
INFOBLK ← INFOBLOCK
FULLFILENAME ←(fetch IOFILEFULLNAME of INFOBLOCK)
EOFFSET ←(fetch IOEOFFSET of INFOBLOCK)
EPAGE ←(fetch IOEPAGE of INFOBLOCK)
EOLCONVENTION ←(fetch COREEOLC of INFOBLOCK)
CBUFMAXSIZE ← BYTESPERPAGE])
(\CORE.GETFILEINFO
[LAMBDA (STREAM ATTRIBUTE DEV) (* bvm: "27-Apr-84 22:39")
(* Get the value of the ATTRIBUTE for a Core file.
If STREAM is a filename, then the file is not open.)
(\CORE.GETFILEINFO.FROM.INFOBLOCK (\CORE.GETINFOBLOCK STREAM (QUOTE OLD)
DEV)
ATTRIBUTE])
(\CORE.GETFILEINFO.FROM.INFOBLOCK
[LAMBDA (INFOBLOCK ATTRIBUTE) (* bvm: "15-Jan-85 17:39")
(COND
(INFOBLOCK (SELECTQ ATTRIBUTE
(LENGTH (create BYTEPTR
PAGE ←(fetch IOEPAGE of INFOBLOCK)
OFFSET ←(fetch IOEOFFSET of INFOBLOCK)))
(SIZE (IPLUS (fetch IOEPAGE of INFOBLOCK)
(FOLDHI (fetch IOEOFFSET of INFOBLOCK)
BYTESPERPAGE)))
(BYTESIZE 8)
(CREATIONDATE (GDATE (fetch IOFIBCreationTime of INFOBLOCK)))
(READDATE (GDATE (fetch IOFIBReadTime of INFOBLOCK)))
(WRITEDATE (GDATE (fetch IOFIBWriteTime of INFOBLOCK)))
(ICREATIONDATE (fetch IOFIBCreationTime of INFOBLOCK))
(IREADDATE (fetch IOFIBReadTime of INFOBLOCK))
(IWRITEDATE (fetch IOFIBWriteTime of INFOBLOCK))
((TYPE FILETYPE)
(fetch IOFIBType of INFOBLOCK))
(EOL (SELECTC (fetch COREEOLC of INFOBLOCK)
(CR.EOLC (QUOTE CR))
(LF.EOLC (QUOTE LF))
(CRLF.EOLC (QUOTE CRLF))
(SHOULDNT)))
NIL])
(\CORE.GETFILENAME
[LAMBDA (NAME RECOG FD) (* bvm: "16-Jan-85 14:58")
(PROG (ROOT EXT VERS SCR CREATEFLG)
(DECLARE (SPECVARS ROOT EXT VERS))
(\CORE.UNPACKFILENAME NAME) (* Sets ROOT EXT and VERS freely)
(AND [SETQ ROOT (CAR (OR (SETQ SCR (\CORE.NAMESCAN ROOT (fetch COREDIRECTORY of FD)
CREATEFLG))
(\CORE.NAMESEGMENT ROOT]
[SETQ EXT (CAR (OR (SETQ SCR (\CORE.NAMESCAN EXT SCR CREATEFLG))
(\CORE.NAMESEGMENT EXT]
[COND
(VERS (OR (FASSOC VERS (CDR SCR))
(RETURN NIL)))
(T (SETQ VERS (SELECTQ (COND
((NEQ RECOG (QUOTE OLD/NEW))
RECOG)
((CDR SCR)
(QUOTE OLD))
(T (QUOTE NEW)))
(NEW (ADD1 (OR (CAAR (CDR SCR))
0)))
(OLD (CAAR (CDR SCR)))
[OLDEST (CAAR (FLAST (CDR SCR]
(SHOULDNT]
(RETURN (\CORE.PACKFILENAME FD])
(\CORE.GETINFOBLOCK
[LAMBDA (NAME RECOG FD CREATEFLG) (* rmk: " 5-NOV-83 21:05")
(COND
((type? STREAM NAME)
(fetch INFOBLK of NAME))
(T (PROG (ROOT EXT VERS SCR INFOBLOCK NEWSTREAM)
(DECLARE (SPECVARS ROOT EXT VERS))
(\CORE.UNPACKFILENAME NAME) (* Sets ROOT EXT and VERS freely)
(COND
((SETQ SCR (\CORE.NAMESCAN ROOT (fetch COREDIRECTORY of FD)
CREATEFLG))
(SETQ ROOT (CAR SCR)) (* In case name completion occurred)
)
(T (RETURN)))
(COND
((SETQ SCR (\CORE.NAMESCAN EXT SCR CREATEFLG))
(SETQ EXT (CAR SCR)))
(T (RETURN)))
[COND
[VERS (COND
[(SETQ INFOBLOCK (CDR (FASSOC VERS (CDR SCR]
(CREATEFLG (SETQ INFOBLOCK (create COREFILEINFOBLK
IOFILEFULLNAME ←(\CORE.PACKFILENAME
FD)))
(for I on SCR when (OR (NOT (CDR I))
(IGREATERP VERS (CAADR I)))
do (push (CDR I)
(CONS VERS INFOBLOCK))
(RETURN]
(T (SELECTQ (COND
((NEQ RECOG (QUOTE OLD/NEW))
RECOG)
((CDR SCR)
(QUOTE OLD))
(T (QUOTE NEW)))
(NEW (SETQ VERS (ADD1 (OR (CAAR (CDR SCR))
0)))
(SETQ INFOBLOCK (create COREFILEINFOBLK
IOFILEFULLNAME ←(\CORE.PACKFILENAME FD)))
(push (CDR SCR)
(CONS VERS INFOBLOCK)))
(OLD (SETQ INFOBLOCK (CDADR SCR)))
[OLDEST (SETQ INFOBLOCK (CDAR (FLAST SCR]
(SHOULDNT]
(RETURN INFOBLOCK])
(\CORE.NAMESCAN
[LAMBDA (NAME NAMELST CREATEFLG) (* rmk: " 5-NOV-83 21:06")
(COND
((LISTP NAMELST)
(bind NEWSEG NEXTNAME while [AND (CDR NAMELST)
(COND
((EQ (SETQ NEXTNAME (CAAR (CDR NAMELST)))
NAME) (* Found it)
(RETURN (CADR NAMELST)))
(T (ALPHORDER NEXTNAME NAME]
do (* Segments are in order, so stop when
(CDR NAMELST) is lexicographically greater than NAME)
(SETQ NAMELST (CDR NAMELST))
finally (RETURN (COND
((AND CREATEFLG (SETQ NEWSEG (\CORE.NAMESEGMENT NAME)))
(RPLACD NAMELST (CONS NEWSEG (CDR NAMELST)))
NEWSEG])
(\CORE.NAMESEGMENT
[LAMBDA (NAME) (* rmk: "24-FEB-84 21:14")
(* Checks that name is a valid name fragment and makes a
list of it if so)
(* Possibly we should check the validity of each character of NAME, but for the time being we just upper case it to
merge together files spelt with different case letters.)
(AND (NLISTP NAME)
(LIST NAME])
(\CORE.OPENFILE
[LAMBDA (NAME ACCESS RECOG PARAMETERS FDEV OLDSTREAM) (* hdj "17-Jun-86 17:17")
(PROG (STREAM INFOBLK)
(AND OLDSTREAM (RETURN OLDSTREAM)) (* From REOPENFILE. Core files can't
go away over logout, so just return
old stream)
(COND
[(type? STREAM NAME)
(COND
[(NULL (fetch ACCESS of NAME)) (* A closed file to be re-opened by
its stream)
(SETQ INFOBLK (fetch INFOBLK of NAME))
(SETQ STREAM (create CORESTREAM smashing NAME DEVICE ← FDEV INFOBLK ← INFOBLK
FULLFILENAME ← (fetch IOFILEFULLNAME
of INFOBLK)
EOFFSET ← (fetch IOEOFFSET of INFOBLK)
EPAGE ← (fetch IOEPAGE of INFOBLK)
EOLCONVENTION ← (fetch COREEOLC of INFOBLK]
((\IOMODEP NAME ACCESS T) (* hdj -
2 may 86 -
need we ever worry about being passed
an already-open stream?)
(RETURN NAME))
(T (\FILE.WONT.OPEN NAME]
[[AND (NOT (\FILE-CONFLICT (\RECOGNIZE-HACK NAME RECOG FDEV)
ACCESS FDEV))
(SETQ STREAM (\CORE.GETFILEHANDLE NAME RECOG FDEV (SELECTQ RECOG
((NEW OLD/NEW)
T)
NIL]
(COND
((NEQ ACCESS (QUOTE INPUT))
(\COREFILE.SETPARAMETERS STREAM PARAMETERS]
(T (* Head for not-found error in
\OPENFILE)
(RETURN NIL)))
(\CORE.SETACCESSTIME STREAM ACCESS)
(RETURN STREAM])
(\COREFILE.SETPARAMETERS
[LAMBDA (STREAM PARAMETERS) (* bvm: "15-Jan-85 17:40")
(for PAIR in PARAMETERS bind (INFOBLK ←(fetch INFOBLK of STREAM))
do (SELECTQ (CAR (LISTP PAIR))
[EOL (replace EOLCONVENTION of STREAM with (replace COREEOLC of INFOBLK
with (SELECTQ (CADR PAIR)
((CR NIL)
(* default)
CR.EOLC)
(LF LF.EOLC)
(CRLF CRLF.EOLC)
(\ILLEGAL.ARG PAIR]
((TYPE FILETYPE)
(replace IOFIBType of INFOBLK with (OR (CADR PAIR)
DEFAULTFILETYPE)))
[(CREATIONDATE ICREATIONDATE)
(replace IOFIBCreationTime of INFOBLK
with (OR [FIXP (COND
((EQ (CAR PAIR)
(QUOTE CREATIONDATE))
(IDATE (CADR PAIR)))
(T (CADR PAIR]
(\ILLEGAL.ARG (CADR PAIR]
NIL])
(\CORE.PACKFILENAME
[LAMBDA (DEVICE)
(DECLARE (USEDFREE ROOT EXT VERS)) (* rmk: "23-SEP-83 15:23")
(PACK* (QUOTE {)
(fetch DEVICENAME of DEVICE)
(QUOTE })
ROOT
(QUOTE %.)
EXT
(QUOTE ;)
VERS])
(\CORE.RELEASEPAGES
[LAMBDA (STREAM LP) (* rmk: "23-SEP-83 16:02")
(* Release all pages of the file beyond the last page)
(OR LP (SETQ LP (fetch EPAGE of STREAM)))
(for P in (fetch FILEPAGES of STREAM) when (ILESSP LP (fetch PAGENUMBER of P))
do (replace PAGEPOINTER of P with NIL])
(\CORE.SETFILEPTR
[LAMBDA (STREAM INDX) (* bvm: " 9-Jul-84 14:25")
(\CORE.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)
(replace CBUFSIZE of STREAM with 0)
(replace CBUFPTR of STREAM with NIL)
(replace CPAGE of STREAM with NEWPAGE)))
(replace COFFSET of STREAM with NEWOFF))])
(\CORE.UPDATEOF
[LAMBDA (STREAM) (* bvm: " 9-Jul-84 14:25")
(* The EOF needs updating if we have written past the EOF. We check CBUFPTR to detect phony file positions from
SETFILEPTR and TURNPAGE that were never actually written thru)
(COND
([AND (fetch CBUFPTR of STREAM)
(PROGN
(* Determines if the current file ptr is BEYOND the end of file. Since page is loaded, we can test against the
CBUFSIZE. As we are ignoring the equal case, we dont need the test for page numbers used by FASTEOF.)
(IGREATERP (fetch COFFSET of STREAM)
(fetch CBUFSIZE of STREAM]
(UNINTERRUPTABLY
(PROG ((OFF (fetch COFFSET of STREAM)))
(COND
((IGEQ OFF BYTESPERPAGE)
(add (fetch CPAGE of STREAM)
(fetch (BYTEPTR PAGE) of OFF))
(replace COFFSET of STREAM with (SETQ OFF (fetch (BYTEPTR OFFSET) of OFF)))
(replace CBUFPTR of STREAM with NIL)))
(replace EPAGE of STREAM with (fetch CPAGE of STREAM))
(replace EOFFSET of STREAM with OFF)
(replace CBUFSIZE of STREAM with OFF)))])
(\CORE.BACKFILEPTR
[LAMBDA (STREAM) (* bvm: "13-Feb-85 23:26")
(* 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 (EQ (fetch COFFSET of STREAM)
0)
(EQ (fetch CPAGE of STREAM)
0)))
(\CORE.UPDATEOF STREAM)
(UNINTERRUPTABLY
[replace COFFSET of STREAM with (COND
((EQ (fetch COFFSET of STREAM)
0)
(replace CBUFSIZE of STREAM with 0)
(replace CBUFPTR of STREAM with NIL)
(add (fetch CPAGE of STREAM)
-1)
(SUB1 BYTESPERPAGE))
(T (SUB1 (fetch COFFSET of STREAM]
[replace (STREAM CHARPOSITION) of STREAM with (IMAX 0 (SUB1 (fetch (STREAM CHARPOSITION)
of STREAM])])
(\CORE.SETEOFPTR
[LAMBDA (STREAM NBYTES) (* bvm: "13-Feb-85 23:26")
(\CORE.UPDATEOF STREAM)
(PROG [(NEWBYTES (IDIFFERENCE NBYTES (\GETEOFPTR STREAM]
(RETURN (COND
((EQ NEWBYTES 0) (* Nothing to do)
T)
((OVERWRITEABLE STREAM)
(UNINTERRUPTABLY
[PROG ((NEWEP (fetch (BYTEPTR PAGE) of NBYTES))
(NEWEO (fetch (BYTEPTR OFFSET) of NBYTES)))
(replace EPAGE of STREAM with NEWEP)
(replace EOFFSET of STREAM with NEWEO)
(replace CBUFSIZE of STREAM
with (COND
((EQ NEWEP (fetch CPAGE of STREAM))
NEWEO)
(T (replace CBUFPTR of STREAM with NIL)
(* Unmap noncurrent page)
0)))
(COND
((ILESSP NEWBYTES 0) (* File is shorter)
(\ZEROBYTES (\CORE.FINDPAGE STREAM NEWEP)
NEWEO
(SUB1 BYTESPERPAGE))
(* Zero out the trailing fragment of the last page)
(\CORE.RELEASEPAGES STREAM NEWEP])
T])
(\CORE.SETACCESSTIME
[LAMBDA (STREAM ACCESS) (* rmk: "23-SEP-83 14:38")
(* Set the "last read" and/or "last written" times for a
core file according to access.)
(PROG ((DT (IDATE)))
(SELECTQ ACCESS
(INPUT (replace ReadTime of STREAM with DT))
(BOTH (replace ReadTime of STREAM with DT)
(replace WriteTime of STREAM with DT))
((OUTPUT APPEND)
(replace WriteTime of STREAM with DT))
(SHOULDNT)))
STREAM])
(\CORE.SETFILEINFO
[LAMBDA (STREAM ATTRIBUTE VALUE DEV) (* bvm: "15-Jan-85 17:40")
(PROG ((INFOBLOCK (\CORE.GETINFOBLOCK STREAM (QUOTE OLD)
DEV)))
(SELECTQ ATTRIBUTE
[CREATIONDATE (SETQ VALUE (OR (IDATE VALUE)
(LISPERROR "ILLEGAL ARG" VALUE]
(ICREATIONDATE (OR (FIXP VALUE)
(LISPERROR "NON-NUMERIC ARG" VALUE)))
NIL)
(RETURN (AND INFOBLOCK (SELECTQ ATTRIBUTE
((TYPE FILETYPE)
(replace IOFIBType of INFOBLOCK with VALUE))
[EOL (replace COREEOLC of INFOBLOCK
with (SELECTQ VALUE
(CR CR.EOLC)
(LF LF.EOLC)
(CRLF CRLF.EOLC)
(LISPERROR "ILLEGAL ARG" VALUE]
NIL])
(\CORE.GETNEXTBUFFER
(LAMBDA (STREAM WHATFOR NOERRORFLG) (* hdj "17-Sep-86 18:05")
(* 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 ((CPAGE# (fetch CPAGE of STREAM))
(COFF (fetch COFFSET of STREAM))
EPAGE# COREBUF)
(COND
((NOT (OPENED STREAM))
(LISPERROR "FILE NOT OPEN" (fetch FULLNAME of STREAM))))
(COND
((AND (ILESSP COFF (SELECTQ WHATFOR
(READ (fetch CBUFSIZE of STREAM))
BYTESPERPAGE))
(fetch CBUFPTR of STREAM)) (* ; " all OK, why were we called?")
(SHOULDNT)))
(* * Buffer exhausted or empty, prepare new one)
(UNINTERRUPTABLY
(* Clean up current page)
(replace CBUFSIZE of STREAM with 0)
(replace CBUFPTR of STREAM with NIL)
(if (EQ COFF BYTESPERPAGE)
then (* Change to be first byte of next
page instead of beyond last byte of
previous page)
(replace COFFSET of STREAM with (SETQ COFF 0))
(replace CPAGE of STREAM with (add CPAGE# 1))))
(COND
((AND (IGEQ CPAGE# (SETQ EPAGE# (fetch EPAGE of STREAM)))
(OR (NEQ CPAGE# EPAGE#)
(IGEQ COFF (fetch EOFFSET of STREAM))))
(* Current file pointer is at or past
end of file)
(SELECTQ WHATFOR
(READ (RETURN (AND (NULL NOERRORFLG)
(\EOF.ACTION STREAM))))
(WRITE (UNINTERRUPTABLY
(replace EPAGE of STREAM with (SETQ EPAGE# CPAGE#))
(replace EOFFSET of STREAM with COFF)))
(SHOULDNT))))
(* * Now fill the buffer -- map in current page)
(SETQ COREBUF (\CORE.FINDPAGE STREAM CPAGE#)) (* This is interruptable)
(UNINTERRUPTABLY
(* But these two fields must be set
uninterruptably for benefit of ucode)
(replace CBUFSIZE of STREAM with (COND
((ILESSP CPAGE# EPAGE#)
(* Full page)
BYTESPERPAGE)
((EQ EPAGE# CPAGE#)
(* Last page)
(fetch EOFFSET of STREAM))
(T (* Beyond EOF so no data)
0)))
(replace CBUFPTR of STREAM with COREBUF))
(RETURN T))))
(\CORE.UNPACKFILENAME
[LAMBDA (NAME) (* rmk: "24-FEB-84 21:14")
(* Breaks up a file name atom into its fields which it
sets freely in its caller)
(OR (U-CASEP NAME)
(SETQ NAME (U-CASE NAME)))
(PROG ((START (OR (AND (EQ (NTHCHAR NAME 1)
(QUOTE {))
(STRPOS (QUOTE })
NAME NIL NIL NIL T))
1))
(N (ADD1 (NCHARS NAME)))
DOT SEMI)
(DECLARE (USEDFREE ROOT EXT VERS))
(SETQ DOT (STRPOS "." NAME START))
(SETQ SEMI (STRPOS ";" NAME DOT))
[COND
[DOT (AND SEMI (OR (IGREATERP SEMI DOT)
(RETURN]
(T (SETQ DOT (OR SEMI N]
(COND
((NOT SEMI)
(SETQ SEMI N)))
[SETQ ROOT (OR (SUBATOM NAME START (SUB1 DOT))
(CONSTANT (MKATOM ""]
[SETQ EXT (COND
((IGEQ DOT (SUB1 SEMI)) (* null extension. SUBATOM will return NIL)
(CONSTANT (MKATOM "")))
(T (SUBATOM NAME (ADD1 DOT)
(SUB1 SEMI]
(SETQ VERS (NUMBERP (SUBATOM NAME (ADD1 SEMI])
)
(DEFINEQ
(COREDEVICE
[LAMBDA (NAME NODIRFLG) (* rmk: " 1-NOV-83 18:34")
(\DEFINEDEVICE NAME (\CREATECOREDEVICE NAME NODIRFLG])
(\CREATECOREDEVICE
(LAMBDA (NAME NODIRFLG) (* hdj "22-Sep-86 18:41")
(* ;; "DIRECTORYNAMEP has to be fixed up. HOSTNAMEP is OK, cause each different host is defined by its own name. Creates a NODIRCORE device if NODIRFLG")
(create FDEV
FDBINABLE ← T
FDBOUTABLE ← T
FDEXTENDABLE ← T
DEVICENAME ← NAME
RESETABLE ← T
RANDOMACCESSP ← T
PAGEMAPPED ← NIL
NODIRECTORIES ← T
BUFFERED ← T
CLOSEFILE ← (FUNCTION \CORE.CLOSEFILE)
DELETEFILE ← (COND
(NODIRFLG (FUNCTION NILL))
(T (FUNCTION \CORE.DELETEFILE)))
GETFILEINFO ← (FUNCTION \CORE.GETFILEINFO)
OPENFILE ← (COND
(NODIRFLG (FUNCTION \NODIRCORE.OPENFILE))
(T (FUNCTION \CORE.OPENFILE)))
READPAGES ← (FUNCTION \ILLEGAL.DEVICEOP)
SETFILEINFO ← (FUNCTION \CORE.SETFILEINFO)
TRUNCATEFILE ← (FUNCTION \CORE.RELEASEPAGES)
WRITEPAGES ← (FUNCTION \ILLEGAL.DEVICEOP)
GETFILENAME ← (COND
(NODIRFLG (FUNCTION NILL))
(T (FUNCTION \CORE.GETFILENAME)))
REOPENFILE ← (COND
(NODIRFLG (FUNCTION (LAMBDA (NAME ACCESS RECOG PARAMETERS FDEV OLDSTREAM)
OLDSTREAM)))
(T (FUNCTION \CORE.OPENFILE)))
GENERATEFILES ← (COND
(NODIRFLG (FUNCTION \NULLFILEGENERATOR))
(T (FUNCTION \CORE.GENERATEFILES)))
EVENTFN ← (FUNCTION NILL)
DEVICEINFO ← (AND (NOT NODIRFLG)
(LIST (QUOTE CoreFiles)))
DIRECTORYNAMEP ← (FUNCTION TRUE)
HOSTNAMEP ← (FUNCTION NILL)
READP ← (FUNCTION \GENERIC.READP)
BIN ← (FUNCTION \BUFFERED.BIN)
BOUT ← (FUNCTION \BUFFERED.BOUT)
PEEKBIN ← (FUNCTION \BUFFERED.PEEKBIN)
BACKFILEPTR ← (FUNCTION \CORE.BACKFILEPTR)
SETFILEPTR ← (FUNCTION \CORE.SETFILEPTR)
GETFILEPTR ← (FUNCTION \PAGEDGETFILEPTR)
GETEOFPTR ← (FUNCTION \PAGEDGETEOFPTR)
SETEOFPTR ← (FUNCTION \CORE.SETEOFPTR)
EOFP ← (FUNCTION \PAGEDEOFP)
BLOCKIN ← (FUNCTION \BUFFERED.BINS)
BLOCKOUT ← (FUNCTION \BUFFERED.BOUTS)
FORCEOUTPUT ← (FUNCTION NILL)
GETNEXTBUFFER ← (FUNCTION \CORE.GETNEXTBUFFER)
OPENP ← (FUNCTION \GENERIC.OPENP)
REGISTERFILE ← (COND
(NODIRFLG (FUNCTION NILL))
(T (FUNCTION \ADD-OPEN-STREAM)))
UNREGISTERFILE ← (COND
(NODIRFLG (FUNCTION NILL))
(T (FUNCTION \GENERIC-UNREGISTER-STREAM))))))
)
(DEFINEQ
(\NODIRCOREFDEV
[LAMBDA (NAME READPFN) (* rmk: " 1-NOV-83 18:33")
(* Creates a core device with no directory structure--files can't be found from names, only by saving a pointer to
the stream. This is used for linebuffers and perhaps other internal printing. The essential property is that the
stream gets collected when it is no longer referenced.)
(PROG ((FDEV (\CREATECOREDEVICE NAME T)))
(AND READPFN (replace READP of FDEV with READPFN))
(\DEFINEDEVICE NAME FDEV)
(RETURN FDEV])
(\NODIRCORE.OPENFILE
[LAMBDA (NAME ACCESS RECOG PARAMETERS FDEV) (* lmm "24-May-85 11:59")
(* Open function for NODIRCORE)
(COND
[(type? STREAM NAME)
(COND
((fetch ACCESS of NAME)
(OR (\IOMODEP NAME ACCESS T)
(\FILE.WONT.OPEN NAME)))
(T (PROG ((INFOBLK (fetch INFOBLK of NAME))) (* We'll return the stream that was given us, but we
make sure that all its fields are back to their initial
settings)
(create CORESTREAM smashing NAME DEVICE ← FDEV INFOBLK ← INFOBLK FULLFILENAME ←(
fetch IOFILEFULLNAME of INFOBLK)
EOFFSET ←(fetch IOEOFFSET of INFOBLK)
EPAGE ←(fetch IOEPAGE of INFOBLK)
EOLCONVENTION ←(fetch COREEOLC of INFOBLK)
CBUFMAXSIZE ← BYTESPERPAGE]
(T (SELECTQ RECOG
((NEW OLD/NEW)
(SETQ NAME (create CORESTREAM
DEVICE ← FDEV
INFOBLK ←(create COREFILEINFOBLK)
CBUFMAXSIZE ← BYTESPERPAGE)))
(\FILE.WONT.OPEN NAME))
(\COREFILE.SETPARAMETERS NAME PARAMETERS)))
(\CORE.SETACCESSTIME NAME ACCESS)
NAME])
)
(DECLARE: DONTCOPY
[DECLARE: EVAL@COMPILE
(RECORD CORE.PAGEENTRY (PAGENUMBER . PAGEPOINTER))
(DATATYPE COREFILEINFOBLK ((IOFIBCreationTime FIXP)
(IOFIBReadTime FIXP)
(IOFIBWriteTime FIXP)
(IOFIBType POINTER)
(IOFILEPAGES POINTER)
(IOFILEFULLNAME POINTER)
(IOEPAGE WORD)
(IOEOFFSET WORD)
(COREEOLC BITS 2)
(IOFIBFileType WORD))
IOFIBCreationTime ← (IDATE)
IOFILEPAGES ← (LIST (create CORE.PAGEENTRY
PAGENUMBER ← 0))
COREEOLC ← CR.EOLC)
(RECORD CORESTREAM STREAM (SUBRECORD STREAM)
(ACCESSFNS CORESTREAM ((INFOBLK (fetch F1 of DATUM)
(replace F1 of DATUM with NEWVALUE))
(COREPAGECACHE (fetch F10 of DATUM)
(replace F10 of DATUM with NEWVALUE))
(BEINGPRINTED (fetch IOBEINGPRINTED
of (fetch INFOBLK of DATUM))
(replace IOBEINGPRINTED
of (fetch INFOBLK of DATUM) with NEWVALUE))
(FILEPAGES (fetch IOFILEPAGES
of (fetch INFOBLK of DATUM))
(replace IOFILEPAGES
of (fetch INFOBLK of DATUM) with NEWVALUE))
(CreationTime (fetch IOFIBCreationTime
of (fetch INFOBLK of DATUM))
(replace IOFIBCreationTime
of (fetch INFOBLK of DATUM) with NEWVALUE))
(ReadTime (fetch IOFIBReadTime
of (fetch INFOBLK of DATUM))
(replace IOFIBReadTime
of (fetch INFOBLK of DATUM) with NEWVALUE))
(WriteTime (fetch IOFIBWriteTime
of (fetch INFOBLK of DATUM))
(replace IOFIBWriteTime
of (fetch INFOBLK of DATUM) with NEWVALUE))
)))
(ACCESSFNS COREDEVICE ((COREDIRECTORY (FETCH DEVICEINFO OF DATUM)
(REPLACE DEVICEINFO OF DATUM WITH NEWVALUE))))
(RECORD COREGENFILESTATE (COREFILELST))
]
(/DECLAREDATATYPE (QUOTE COREFILEINFOBLK)
(QUOTE (FIXP FIXP FIXP POINTER POINTER POINTER WORD WORD (BITS 2)
WORD))
(QUOTE ((COREFILEINFOBLK 0 FIXP)
(COREFILEINFOBLK 2 FIXP)
(COREFILEINFOBLK 4 FIXP)
(COREFILEINFOBLK 6 POINTER)
(COREFILEINFOBLK 8 POINTER)
(COREFILEINFOBLK 10 POINTER)
(COREFILEINFOBLK 12 (BITS . 15))
(COREFILEINFOBLK 13 (BITS . 15))
(COREFILEINFOBLK 10 (BITS . 1))
(COREFILEINFOBLK 14 (BITS . 15))))
(QUOTE 16))
)
(/DECLAREDATATYPE (QUOTE COREFILEINFOBLK)
(QUOTE (FIXP FIXP FIXP POINTER POINTER POINTER WORD WORD (BITS 2)
WORD))
(QUOTE ((COREFILEINFOBLK 0 FIXP)
(COREFILEINFOBLK 2 FIXP)
(COREFILEINFOBLK 4 FIXP)
(COREFILEINFOBLK 6 POINTER)
(COREFILEINFOBLK 8 POINTER)
(COREFILEINFOBLK 10 POINTER)
(COREFILEINFOBLK 12 (BITS . 15))
(COREFILEINFOBLK 13 (BITS . 15))
(COREFILEINFOBLK 10 (BITS . 1))
(COREFILEINFOBLK 14 (BITS . 15))))
(QUOTE 16))
(DECLARE: DONTEVAL@LOAD DOCOPY
(COREDEVICE (QUOTE NODIRCORE)
T)
(COREDEVICE (QUOTE CORE))
(COREDEVICE (QUOTE SCRATCH)
T)
(ADDTOVAR GAINSPACEFORMS ((FILDIR (QUOTE {SCRATCH}*.*))
"delete {SCRATCH} files"
(DIRECTORY (QUOTE {SCRATCH}*.*;*)
(QUOTE (P DELETE)))))
)
(DECLARE: DOEVAL@LOAD DONTCOPY
(DECLARE: DOEVAL@COMPILE DONTCOPY
(LOCALVARS . T)
)
)
(PUTPROPS COREIO COPYRIGHT ("Xerox Corporation" 1981 1982 1983 1984 1985 1986))
(DECLARE: DONTCOPY
(FILEMAP (NIL (1938 30271 (\CORE.CLOSEFILE 1948 . 2756) (\CORE.DELETEFILE 2758 . 4652) (\CORE.FINDPAGE
4654 . 6714) (\CORE.GENERATEFILES 6716 . 7972) (\CORE.NEXTFILEFN 7974 . 8389) (\CORE.FILEINFOFN 8391
. 8618) (\CORE.GETFILEHANDLE 8620 . 9171) (\CORE.GETFILEINFO 9173 . 9593) (
\CORE.GETFILEINFO.FROM.INFOBLOCK 9595 . 10754) (\CORE.GETFILENAME 10756 . 11879) (\CORE.GETINFOBLOCK
11881 . 13490) (\CORE.NAMESCAN 13492 . 14238) (\CORE.NAMESEGMENT 14240 . 14743) (\CORE.OPENFILE 14745
. 17383) (\COREFILE.SETPARAMETERS 17385 . 18455) (\CORE.PACKFILENAME 18457 . 18727) (
\CORE.RELEASEPAGES 18729 . 19190) (\CORE.SETFILEPTR 19192 . 20090) (\CORE.UPDATEOF 20092 . 21398) (
\CORE.BACKFILEPTR 21400 . 22618) (\CORE.SETEOFPTR 22620 . 23941) (\CORE.SETACCESSTIME 23943 . 24568) (
\CORE.SETFILEINFO 24570 . 25380) (\CORE.GETNEXTBUFFER 25382 . 29113) (\CORE.UNPACKFILENAME 29115 .
30269)) (30272 33491 (COREDEVICE 30282 . 30452) (\CREATECOREDEVICE 30454 . 33489)) (33492 35388 (
\NODIRCOREFDEV 33502 . 34113) (\NODIRCORE.OPENFILE 34115 . 35386)))))
STOP