(FILECREATED "24-FEB-84 21:29:40" <BLISP>COREIO.;95 35868
changes to: (FNS \CORE.NAMESEGMENT \CORE.UNPACKFILENAME)
previous date: "31-Jan-84 15:43:27" <BLISP>COREIO.;94)
(* Copyright (c) 1981, 1982, 1983, 1984 by Xerox Corporation)
(PRETTYCOMPRINT COREIOCOMS)
(RPAQQ COREIOCOMS ((* Implementation of Core resident "files")
(FNS \CORE.BIN \CORE.BINS \CORE.BOUT \CORE.BOUTS \CORE.CLOSEFILE \CORE.DELETEFILE
\CORE.FINDPAGE \CORE.GENERATEFILES \CORE.GETFILEHANDLE \CORE.GETFILEINFO
\CORE.GETFILENAME \CORE.GETINFOBLOCK \CORE.GETPAGEBASE \CORE.NAMESCAN \CORE.NAMESEGMENT
\CORE.NEXTFILEFN \CORE.OPENFILE \CORE.PACKFILENAME \CORE.PEEKBIN \CORE.READPAGE
\CORE.READPAGES \CORE.RELEASEPAGES \CORE.SETACCESSTIME \CORE.SETFILEINFO \CORE.TURNPAGE
\CORE.UNPACKFILENAME \CORE.WRITEPAGES)
(FNS COREDEVICE \CREATECOREDEVICE PRINTERDEVICE)
(FNS \NODIRCOREFDEV \NODIRCORE.OPENFILE)
(DECLARE: DONTCOPY (RECORDS CORE.PAGEENTRY COREFILEINFOBLK CORESTREAM COREDEVICE))
(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.BIN
[LAMBDA (STREAM) (* rmk: "21-OCT-83 13:43")
(CHECK (type? STREAM STREAM)
(READABLE STREAM)
(EQ (fetch BYTESIZE of STREAM)
(CONSTANT BitsPerByte))) (* EOF checked in INCREAD)
(PROG (X)
RETRY
(RETURN (\GETBASEBYTE (OR (fetch CPPTR of STREAM)
(\CORE.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))
((IGEQ (fetch CPAGE of STREAM)
(fetch EPAGE of STREAM))
(* Next page is past end of file)
(RETURN (STREAMOP (QUOTE ENDOFSTREAMOP)
STREAM STREAM)))
(T (UNINTERRUPTABLY
(replace CPPTR of STREAM with NIL)
(* Let current page go)
(replace CBUFSIZE of STREAM
with (replace COFFSET of STREAM with 0))
(* First byte. \CORE.GETPAGEBASE will fix CBUFSIZE.)
(add (fetch CPAGE of STREAM)
1) (* Next page)
)
(GO RETRY])
(\CORE.BINS
[LAMBDA (STREAM BASE OFF N) (* rmk: "21-OCT-83 15:32")
(* For core streams, BINs N bytes from STREAM to memory
starting at BASE+OFF. End of file check is in
\CORE.TURNPAGE)
(bind CNT END PG START
do [SETQ PG (OR (fetch CPPTR of STREAM)
(\CORE.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)
(\CORE.TURNPAGE STREAM (QUOTE READ)) (* next page, pls)
)
(T (COND
((EQ END BYTESPERPAGE)
(\CORE.TURNPAGE STREAM (QUOTE READ)) (* Move onto next page)
)
(T (replace COFFSET of STREAM with END) (* Move to after the last byte we read)
))
(RETURN])
(\CORE.BOUT
[LAMBDA (STREAM BYTE) (* rmk: "21-OCT-83 15:00")
(CHECK (type? STREAM STREAM)
(WRITEABLE STREAM))
(PROG NIL
RETRY
(RETURN (\PUTBASEBYTE (OR (fetch CPPTR of STREAM)
(\CORE.GETPAGEBASE STREAM (QUOTE WRITE)))
[PROG1 (fetch COFFSET of STREAM)
(COND
((ILESSP (fetch COFFSET of STREAM)
BYTESPERPAGE)
(add (fetch COFFSET of STREAM)
1))
(T (COND
((IGEQ (fetch CPAGE of STREAM)
(fetch EPAGE of STREAM))
(* Next page is past end of file)
(\SETEOF STREAM (ADD1 (fetch CPAGE of STREAM))
0)))
(* Let current page go)
(UNINTERRUPTABLY
(replace CPPTR of STREAM with NIL)
(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)
)
(GO RETRY]
BYTE)))
1])
(\CORE.BOUTS
[LAMBDA (STREAM BASE OFF N) (* rmk: "21-OCT-83 15:33")
(* For page-mapped streams, bouts N bytes to stream from
Base,off)
(bind CNT END PG START
do [SETQ PG (OR (fetch CPPTR of STREAM)
(\CORE.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))
(\CORE.TURNPAGE STREAM (QUOTE WRITE)))
(T (COND
((EQ END BYTESPERPAGE)
(\CORE.TURNPAGE STREAM (QUOTE WRITE)))
(T (replace COFFSET of STREAM with END)))
(RETURN])
(\CORE.CLOSEFILE
[LAMBDA (STREAM) (* bvm: "12-NOV-83 18:00")
(* Close a IO file.)
(SELECTQ (fetch ACCESS of STREAM)
((OUTPUT BOTH APPEND)
(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 CPPTR 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) (* rmk: " 5-NOV-83 14:50")
(LIST [FUNCTION (LAMBDA (STATE SCRATCH NOV HD)
(PROG NIL
(RETURN (COND
((AND HD (NOT NOV))
(DCHCON (FETCH (COREFILEINFOBLK IOFILEFULLNAME)
OF (OR (pop (CAR STATE))
(RETURN)))
SCRATCH))
(T (* ???)
NIL]
(for NAM in (CDR (fetch (FDEV DEVICEINFO) of FDEV)) join (for EXT in (CDR NAM)
join (for VERS
in (CDR EXT)
collect (CDR VERS])
(\CORE.GETFILEHANDLE
[LAMBDA (NAME RECOG FD CREATEFLG) (* rmk: " 7-NOV-83 21:54")
(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])
(\CORE.GETFILEINFO
[LAMBDA (STREAM ATTRIBUTE DEV) (* rmk: " 7-NOV-83 22:33")
(* Get the value of the ATTRIBUTE for a Core file.
If STREAM is a filename, then the file is not open.)
(PROG ((INFOBLOCK (\CORE.GETINFOBLOCK STREAM (QUOTE OLD)
DEV)))
(RETURN (COND
(INFOBLOCK (SELECTQ ATTRIBUTE
(LENGTH (create BYTEPTR
PAGE ←(fetch IOEPAGE of INFOBLOCK)
OFFSET ←(fetch IOEOFFSET of INFOBLOCK)))
(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.GETPAGEBASE
[LAMBDA (STREAM WHATFOR) (* rmk: "24-OCT-83 13:20")
(* Obtains page for current position.
Takes this opportunity to check access)
(PROG (PAGE)
[OR (SELECTQ WHATFOR
(READ (READABLE STREAM))
(WRITE (WRITEABLE STREAM))
(SHOULDNT))
(COND
((OPENED STREAM)
(LISPERROR "PROTECTION VIOLATION" (fetch FULLNAME of STREAM)))
(T (\FILE.NOT.OPEN STREAM] (* First, set Last Char of Current Page)
(SETQ PAGE (\CORE.FINDPAGE STREAM (fetch CPAGE of 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 PAGE))
(RETURN PAGE])
(\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.NEXTFILEFN
[LAMBDA (GENFILESTATE SCRATCHLIST NOVERSION) (* rmk: " 4-MAY-81 13:11")
(* Start by looking at \M44NEXTFILEFN)
(NOTIMP])
(\CORE.OPENFILE
[LAMBDA (NAME ACCESS RECOG PARAMETERS FDEV OLDSTREAM) (* rmk: "31-Jan-84 15:43")
(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)))
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.PEEKBIN
[LAMBDA (STREAM NOERRORFLG) (* rmk: "21-OCT-83 15:08")
(* Grabs next byte. Causes an error on EOF, unless NOERRORFLG (which is T from 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 (OR (fetch CPPTR of STREAM)
(\CORE.GETPAGEBASE STREAM (QUOTE READ)))
(PROG1 (fetch COFFSET of STREAM)
(COND
((ILESSP (fetch COFFSET of STREAM)
(fetch CBUFSIZE of STREAM)))
[(IGEQ (fetch CPAGE of STREAM)
(fetch EPAGE of STREAM))
(* Next page is past end of file)
(RETURN (AND (NULL NOERRORFLG)
(STREAMOP (QUOTE ENDOFSTREAMOP)
STREAM STREAM]
(T (UNINTERRUPTABLY
(replace CPPTR of STREAM with NIL)
(* Let current page go)
(replace CBUFSIZE of STREAM
with (replace COFFSET of STREAM with 0))
(* First byte. \CORE.GETPAGEBASE will fix CBUFSIZE.)
(add (fetch CPAGE of STREAM)
1) (* Next page)
)
(GO RETRY])
(\CORE.READPAGE
[LAMBDA (STREAM PAGENUMBER BUFFER) (* rmk: "24-OCT-83 13:19")
(\MOVEWORDS (\CORE.FINDPAGE STREAM PAGENUMBER)
0 BUFFER 0 WordsPerPage)
(COND
((ILESSP PAGENUMBER (fetch EPAGE of STREAM))
BYTESPERPAGE)
((EQ PAGENUMBER (fetch EPAGE of STREAM))
(fetch EOFFSET of STREAM))
(T 0])
(\CORE.READPAGES
[LAMBDA (STREAM FIRSTPAGE# BUFFERS) (* rmk: " 1-NOV-83 22:00")
(for BUF inside BUFFERS as PAGE from FIRSTPAGE# sum (\CORE.READPAGE STREAM PAGE BUF])
(\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.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.TURNPAGE
[LAMBDA (STREAM WHATFOR NOERRORFLG) (* rmk: "21-OCT-83 15:30")
(* 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] (* Let current page go)
(UNINTERRUPTABLY
(replace CPPTR of STREAM with NIL)
(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])
(\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])
(\CORE.WRITEPAGES
[LAMBDA (STREAM FIRSTPAGE BUFFERS) (* rmk: "24-OCT-83 13:19")
(bind P PPTR for B inside BUFFERS as PN from FIRSTPAGE
do (SETQ PPTR (\CORE.FINDPAGE STREAM PN))
(\MOVEWORDS B 0 PPTR 0 WordsPerPage])
)
(DEFINEQ
(COREDEVICE
[LAMBDA (NAME NODIRFLG) (* rmk: " 1-NOV-83 18:34")
(\DEFINEDEVICE NAME (\CREATECOREDEVICE NAME NODIRFLG])
(\CREATECOREDEVICE
[LAMBDA (NAME NODIRFLG) (* bvm: "12-NOV-83 18: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
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 \CORE.READPAGES)
SETFILEINFO ←(FUNCTION \CORE.SETFILEINFO)
TRUNCATEFILE ←(FUNCTION \CORE.RELEASEPAGES)
WRITEPAGES ←(FUNCTION \CORE.WRITEPAGES)
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 (LAMBDA (FDEV PATTERN)
(create FILEGENOBJ
NEXTFILEFN ←(FUNCTION NILL]
(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 \CORE.BIN)
BOUT ←(FUNCTION \CORE.BOUT)
PEEKBIN ←(FUNCTION \CORE.PEEKBIN)
BACKFILEPTR ←(FUNCTION \PAGEDBACKFILEPTR)
SETFILEPTR ←(FUNCTION \PAGEDSETFILEPTR)
GETFILEPTR ←(FUNCTION \PAGEDGETFILEPTR)
GETEOFPTR ←(FUNCTION \PAGEDGETEOFPTR)
EOFP ←(FUNCTION \PAGEDEOFP)
BLOCKIN ←(FUNCTION \CORE.BINS)
BLOCKOUT ←(FUNCTION \CORE.BOUTS)
FLUSHOUTPUT ←(FUNCTION NILL])
(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) (* rmk: "31-Jan-84 15:40")
(* 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]
(T (SELECTQ RECOG
[(NEW OLD/NEW)
(SETQ NAME (create CORESTREAM
DEVICE ← FDEV
INFOBLK ←(create COREFILEINFOBLK]
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))))
]
[/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 . T)
)
(PUTPROPS COREIO COPYRIGHT ("Xerox Corporation" 1981 1982 1983 1984))
(DECLARE: DONTCOPY
(FILEMAP (NIL (1265 26864 (\CORE.BIN 1275 . 2740) (\CORE.BINS 2742 . 4267) (\CORE.BOUT 4269 . 5624) (
\CORE.BOUTS 5626 . 6515) (\CORE.CLOSEFILE 6517 . 7240) (\CORE.DELETEFILE 7242 . 8556) (\CORE.FINDPAGE
8558 . 9746) (\CORE.GENERATEFILES 9748 . 10390) (\CORE.GETFILEHANDLE 10392 . 10909) (\CORE.GETFILEINFO
10911 . 12154) (\CORE.GETFILENAME 12156 . 13128) (\CORE.GETINFOBLOCK 13130 . 14739) (
\CORE.GETPAGEBASE 14741 . 16306) (\CORE.NAMESCAN 16308 . 17054) (\CORE.NAMESEGMENT 17056 . 17559) (
\CORE.NEXTFILEFN 17561 . 17792) (\CORE.OPENFILE 17794 . 19836) (\CORE.PACKFILENAME 19838 . 20108) (
\CORE.PEEKBIN 20110 . 21641) (\CORE.READPAGE 21643 . 22024) (\CORE.READPAGES 22026 . 22251) (
\CORE.RELEASEPAGES 22253 . 22714) (\CORE.SETACCESSTIME 22716 . 23341) (\CORE.SETFILEINFO 23343 . 24176
) (\CORE.TURNPAGE 24178 . 25415) (\CORE.UNPACKFILENAME 25417 . 26571) (\CORE.WRITEPAGES 26573 . 26862)
) (26865 31356 (COREDEVICE 26875 . 27045) (\CREATECOREDEVICE 27047 . 29084) (PRINTERDEVICE 29086 .
31354)) (31357 33476 (\NODIRCOREFDEV 31367 . 31978) (\NODIRCORE.OPENFILE 31980 . 33474)))))
STOP