(FILECREATED "16-Dec-84 18:59:27" {ERIS}<LISP>HARMONY>SOURCES>COREIO.;3 34898
changes to: (FNS \NODIRCORE.OPENFILE)
previous date: "30-Sep-84 15:46:45" {ERIS}<LISP>HARMONY>SOURCES>COREIO.;2)
(* Copyright (c) 1981, 1982, 1983, 1984 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
\CORE.PACKFILENAME \CORE.RELEASEPAGES \CORE.SETFILEPTR \CORE.UPDATEOF \CORE.BACKFILEPTR
\CORE.SETEOFPTR \CORE.SETACCESSTIME \CORE.SETFILEINFO \CORE.GETNEXTBUFFER
\CORE.UNPACKFILENAME)
(FNS COREDEVICE \CREATECOREDEVICE PRINTERDEVICE)
(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))
(PRINTERDEVICE (QUOTE LPT))))
(LOCALVARS . T)))
(* Implementation of Core resident "files")
(DEFINEQ
(\CORE.CLOSEFILE
[LAMBDA (STREAM) (* bvm: " 9-Jul-84 16:04")
(* Close a IO 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) (* rmk: " 5-NOV-83 21:02")
(* 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)
(\GETSTREAM (fetch IOFILEFULLNAME of INFOBLOCK)
NIL T)) (* 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) (* rmk: " 5-NOV-83 21:02")
(* Finds the entry for page PN in the page list for
STREAM, creating it if necessary.)
(for P PAGEPTR on (fetch FILEPAGES of STREAM)
do (* There's always at least one)
(COND
[(EQ PN (fetch PAGENUMBER of (CAR P)))
(RETURN (OR (fetch PAGEPOINTER of (CAR P))
(replace PAGEPOINTER of (CAR P) with (\ALLOCBLOCK (FOLDHI WordsPerPage
WORDSPERCELL]
((IGREATERP (fetch PAGENUMBER of (CAR P))
PN)
(RPLNODE P [create CORE.PAGEENTRY
PAGENUMBER ← PN
PAGEPOINTER ←(SETQ PAGEPTR (\ALLOCBLOCK (FOLDHI WordsPerPage
WORDSPERCELL]
(CONS (CAR P)
(CDR P)))
(RETURN PAGEPTR))
((NULL (CDR P))
[RPLACD P (LIST (create CORE.PAGEENTRY
PAGENUMBER ← PN
PAGEPOINTER ←(SETQ PAGEPTR (\ALLOCBLOCK (FOLDHI WordsPerPage
WORDSPERCELL]
(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: "27-Apr-84 23:21")
(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 (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) (* rmk: " 5-NOV-83 21:05")
(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 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 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) (* bvm: " 9-Jul-84 15:06")
(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)
(RETURN NAME))
(T (\FILE.WONT.OPEN NAME]
[(SETQ STREAM (\CORE.GETFILEHANDLE NAME RECOG FDEV (SELECTQ RECOG
((NEW OLD/NEW)
T)
NIL)))
(COND
((NEQ ACCESS (QUOTE INPUT))
(SETQ INFOBLK (fetch INFOBLK of STREAM))
(for PAIR in PARAMETERS bind TYPE EOLC
do (SELECTQ (CAR (LISTP PAIR))
[EOL (COND
((SETQ EOLC (CADR PAIR))
(replace EOLCONVENTION of STREAM
with (replace COREEOLC of INFOBLK
with (SELECTQ EOLC
(CR CR.EOLC)
(LF LF.EOLC)
(CRLF CRLF.EOLC)
(\ILLEGAL.ARG EOLC]
(TYPE (SETQ TYPE (CDR PAIR)))
[(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)
finally (COND
((SETQ TYPE (COND
(TYPE (CAR TYPE))
(T DEFAULTFILETYPE)))
(replace IOFIBType of INFOBLK with (SELECTQ TYPE
((TEXT BINARY)
TYPE)
(\ILLEGAL.ARG TYPE]
(T (* Head for not-found error in \OPENFILE)
(RETURN NIL)))
(\CORE.SETACCESSTIME STREAM ACCESS)
(RETURN STREAM])
(\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: " 9-Jul-84 14:28")
(* 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]
(\CORE.UPDATEOF STREAM)
(UNINTERRUPTABLY
[replace COFFSET of STREAM with (COND
((ZEROP (fetch COFFSET of STREAM))
(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: " 9-Jul-84 17:42")
(\CORE.UPDATEOF STREAM)
(PROG [(NEWBYTES (IDIFFERENCE NBYTES (\GETEOFPTR STREAM]
(RETURN (COND
((ZEROP NEWBYTES) (* 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) (* rmk: " 7-NOV-83 22:27")
(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 (replace IOFIBType of INFOBLOCK
with (SELECTQ VALUE
((TEXT BINARY NIL)
VALUE)
(LISPERROR "ILLEGAL ARG" 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) (* bvm: "30-Sep-84 15:22")
(* 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?)
(RETURN T)))
(* * 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) (* bvm: "10-Jul-84 23:01")
(* 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])
(PRINTERDEVICE
[LAMBDA (NAME) (* rmk: " 5-NOV-83 18:35")
(* This defines an LPT device.
An LPT file is a core file that gets empressed and
deleted when it is closed.)
(PROG ((DEV (\CREATECOREDEVICE NAME)))
[replace CLOSEFILE of DEV
with (FUNCTION (LAMBDA (STREAM)
(\CORE.CLOSEFILE STREAM)
(COND
((fetch BEINGPRINTED of STREAM) (* Error while EMPRESSING; do nothing now cause the
RESETSAVE below will do the delete)
NIL)
[(AND (NOT RESETSTATE)
(IGREATERP (GETEOFPTR STREAM)
0))
(replace BEINGPRINTED of STREAM with T)
(* Let EMPRESS choose the host if it is the generic
printer LPT, otherwise use the name in the devicename
field.)
(* EVAL.AS.PROCESS (BQUOTE (SEND.FILE.TO.PRINTER (QUOTE , (fetch FULLNAME of STREAM)) (QUOTE ,
(COND ((NEQ (QUOTE LPT) (fetch DEVICENAME of (fetch DEVICE of STREAM))) (fetch DEVICENAME of
(fetch DEVICE of STREAM))) (T (FILENAMEFIELD (fetch FULLNAME of STREAM) (QUOTE NAME))))) (QUOTE
(DELETE T HEADING T)))))
(SEND.FILE.TO.PRINTER (fetch FULLNAME of STREAM)
[COND
((NEQ (QUOTE LPT)
(fetch DEVICENAME
of (fetch DEVICE of STREAM)))
(fetch DEVICENAME of (fetch DEVICE of STREAM)))
(T (PROG ((NAME (fetch FULLNAME of STREAM))
POS POS2)
(RETURN (AND (SETQ POS (STRPOS "}" NAME))
(SETQ POS2
(STRPOS "." NAME
(ADD1 POS)))
(SUBATOM NAME (ADD1 POS)
(SUB1 POS2]
(QUOTE (DELETE T HEADING T]
(T (* Error while creating the file, if the user had
wrapped a RESETLST/CLOSEF around his code.
Presumably, he doesn't want the file printed)
(\CORE.DELETEFILE STREAM (fetch DEVICE of STREAM)
T]
(\DEFINEDEVICE NAME DEV)
(RETURN NAME])
)
(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) (* JonL "13-Dec-84 01:52")
(* 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)))
NIL)
(PROG (EOLC)
(COND
((AND (EQ ACCESS (QUOTE OUTPUT))
(SETQ EOLC (LISTGET PARAMETERS (QUOTE EOL))))
(replace EOLCONVENTION of NAME with (replace COREEOLC
of (fetch INFOBLK of NAME)
with (SELECTQ EOLC
(CR CR.EOLC)
(LF LF.EOLC)
(CRLF CRLF.EOLC)
(\ILLEGAL.ARG EOLC)))))))))
(\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)
(IOBEINGPRINTED FLAG)
(COREEOLC BITS 2))
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))
(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 FLAG (BITS 2))))
)
(/DECLAREDATATYPE (QUOTE COREFILEINFOBLK)
(QUOTE (FIXP FIXP FIXP POINTER POINTER POINTER WORD WORD FLAG (BITS 2))))
(DECLARE: DONTEVAL@LOAD DOCOPY
(COREDEVICE (QUOTE NODIRCORE)
T)
(COREDEVICE (QUOTE CORE))
(PRINTERDEVICE (QUOTE LPT))
)
(DECLARE: DOEVAL@COMPILE DONTCOPY
(LOCALVARS)
)
(PUTPROPS COREIO COPYRIGHT ("Xerox Corporation" 1981 1982 1983 1984))
(DECLARE: DONTCOPY
(FILEMAP (NIL (1334 25598 (\CORE.CLOSEFILE 1344 . 2105) (\CORE.DELETEFILE 2107 . 3421) (\CORE.FINDPAGE
3423 . 4611) (\CORE.GENERATEFILES 4613 . 5869) (\CORE.NEXTFILEFN 5871 . 6286) (\CORE.FILEINFOFN 6288
. 6515) (\CORE.GETFILEHANDLE 6517 . 7068) (\CORE.GETFILEINFO 7070 . 7490) (
\CORE.GETFILEINFO.FROM.INFOBLOCK 7492 . 8585) (\CORE.GETFILENAME 8587 . 9559) (\CORE.GETINFOBLOCK 9561
. 11170) (\CORE.NAMESCAN 11172 . 11918) (\CORE.NAMESEGMENT 11920 . 12423) (\CORE.OPENFILE 12425 .
14747) (\CORE.PACKFILENAME 14749 . 15019) (\CORE.RELEASEPAGES 15021 . 15482) (\CORE.SETFILEPTR 15484
. 16382) (\CORE.UPDATEOF 16384 . 17690) (\CORE.BACKFILEPTR 17692 . 18836) (\CORE.SETEOFPTR 18838 .
20107) (\CORE.SETACCESSTIME 20109 . 20734) (\CORE.SETFILEINFO 20736 . 21569) (\CORE.GETNEXTBUFFER
21571 . 24440) (\CORE.UNPACKFILENAME 24442 . 25596)) (25599 30157 (COREDEVICE 25609 . 25779) (
\CREATECOREDEVICE 25781 . 27885) (PRINTERDEVICE 27887 . 30155)) (30158 32444 (\NODIRCOREFDEV 30168 .
30779) (\NODIRCORE.OPENFILE 30781 . 32442)))))
STOP