(FILECREATED " 9-May-85 14:49:14" {ERIS}<LISPCORE>SOURCES>LLREAD.;8 32240
changes to: (MACROS \NSIN)
previous date: " 1-May-85 12:25:57" {ERIS}<LISPCORE>SOURCES>LLREAD.;7)
(* Copyright (c) 1981, 1982, 1983, 1984, 1985 by Xerox Corporation. All rights reserved.)
(PRETTYCOMPRINT LLREADCOMS)
(RPAQQ LLREADCOMS ((FNS INREADMACROP LASTC PEEKC PEEKCCODE RATEST RATOM READ READC READCCODE READP
RSTRING SETREADMACROFLG SKIPSEPRCODES SKIPSEPRS \APPLYREADMACRO \RSTRING2
\SUBREAD)
(DECLARE: DONTCOPY (CONSTANTS * READTYPES)
(MACROS FIXDOT RBCONTEXT PROPRB \RDCONC))
(DECLARE: DONTCOPY (EXPORT (MACROS \BACKCHAR \BACKNSCHAR \CHECKEOLC \INCHAR \INCCODE
\PEEKCCODE \NSIN \NSINTEMP \NSPEEK)))
(VARS (\RefillBufferFn (FUNCTION \READCREFILL)))
(* Act like READC if there is no binding of \RefillBufferFn--we must be doing a raw BIN
(or PEEKBIN?))
(LOCALVARS . T)
(SPECVARS \RefillBufferFn)))
(DEFINEQ
(INREADMACROP
[LAMBDA NIL (* edited: "26-MAY-79 00:12")
(PROG (TEM (\READDEPTH -1))
(DECLARE (SPECVARS \READDEPTH))
(COND
([NULL (SETQ TEM (STKPOS (QUOTE \APPLYREADMACRO]
(RETURN NIL)))
(MAPDL [FUNCTION (LAMBDA (NM POS)
(COND
((EQ NM (QUOTE \SUBREAD))
(SETQ \READDEPTH (ADD1 \READDEPTH]
TEM)
(RELSTK TEM)
(RETURN \READDEPTH])
(LASTC
[LAMBDA (FILE) (* rmk: "27-Mar-85 16:50")
(* Be careful only to do BIN's if we first were able to back up, so that an EOF doesn't happen.
This is really an inadequate implementation, because it fails for files that cannot be backed up.
Eventually, we must change the character reading functions READ, RATOM, READC to save the last character they read
in an STREAM field.)
(PROG [C SHIFTEDCHARSET (STREAM (\GETSTREAM FILE (QUOTE INPUT]
(SETQ SHIFTEDCHARSET (UNFOLD (ffetch CHARSET of STREAM)
256))
(RETURN
(FCHARACTER
(SELCHARQ (SETQ C (UNINTERRUPTABLY
(\BACKNSCHAR STREAM SHIFTEDCHARSET)
(\NSIN STREAM SHIFTEDCHARSET)))
(CR (SELECTC (ffetch EOLCONVENTION of STREAM)
(CR.EOLC (CHARCODE EOL))
C))
(LF (SELECTC (ffetch EOLCONVENTION of STREAM)
(LF.EOLC (CHARCODE EOL))
(CRLF.EOLC (COND
([EQ (CHARCODE CR)
(UNINTERRUPTABLY
(AND (\BACKNSCHAR STREAM SHIFTEDCHARSET)
(PROG1 (PROGN (\BACKNSCHAR STREAM
SHIFTEDCHARSET)
(\NSIN STREAM
SHIFTEDCHARSET))
(\NSIN STREAM SHIFTEDCHARSET)))
)]
(CHARCODE EOL))
(T C)))
C))
(NIL 0)
C])
(PEEKC
[LAMBDA (FILE FLG) (* rmk: "10-Apr-85 11:55")
(* FLG says to proceed as if Control were T--not
implemented correctly here NIL)
(LET [(\RefillBufferFn (FUNCTION \PEEKREFILL))
(STREAM (\GETSTREAM FILE (QUOTE INPUT]
(DECLARE (SPECVARS \RefillBufferFn))
(FCHARACTER (PEEKCCODE STREAM])
(PEEKCCODE
[LAMBDA (FILE FLG) (* rmk: " 5-Apr-85 09:31")
(* FLG says to proceed as if Control were T--not
implemented correctly here NIL)
(LET [(\RefillBufferFn (FUNCTION \PEEKREFILL))
(STREAM (\GETSTREAM FILE (QUOTE INPUT]
(DECLARE (SPECVARS \RefillBufferFn))
(\PEEKCCODE STREAM])
(RATEST
[LAMBDA (FLG) (* rmk: " 5-DEC-79 23:03")
(DECLARE (GLOBALVARS \SEPRFLG \BRKFLG \PERCENTFLG))
(SELECTQ FLG
(T \SEPRFLG)
(NIL \BRKFLG)
(1 \PERCENTFLG)
NIL])
(RATOM
[LAMBDA (FILE RDTBL) (* rmk: " 2-Apr-85 14:13")
(DECLARE (GLOBALVARS \PERCENTFLG \BRKFLG \SEPRFLG))
(WITH-RESOURCE (\PNAMESTRING)
(PROG ((STREAM (\GETSTREAM FILE (QUOTE INPUT)))
(#CURRENTRDTBL# (\GTREADTABLE RDTBL))
(\RefillBufferFn (QUOTE \RATOM/RSTRING-REFILL))
(PBASE (SELECTQ (SYSTEMTYPE)
(D (fetch (STRINGP XBASE) of \PNAMESTRING))
\PNAMESTRING))
(J 0)
SHIFTEDCHARSET SA CH SNX)
(DECLARE (SPECVARS #CURRENTRDTBL# \RefillBufferFn))
(SETQ SHIFTEDCHARSET (UNFOLD (ffetch CHARSET of STREAM)
256))
(SETQ \BRKFLG (SETQ \PERCENTFLG NIL))
(SETQ SA (ffetch READSA of #CURRENTRDTBL#))
(COND
[[EQ SEPRCHAR.RC (SETQ SNX (\SYNCODE SA (SETQ CH (\NSIN STREAM
SHIFTEDCHARSET
SHIFTEDCHARSET]
(SETQ \SEPRFLG T)
(while (EQ SEPRCHAR.RC (SETQ SNX (\SYNCODE SA (SETQ CH
(\NSIN STREAM
SHIFTEDCHARSET
SHIFTEDCHARSET]
(T (SETQ \SEPRFLG NIL)))
SCANLOOP
[COND
((EQ SNX OTHER.RC))
[(fetch STOPATOM of SNX)
(RETURN (COND
((EQ J 0) (* Atom is a single break (Sepr doesn't get here cause
of while-loop above))
(SETQ \BRKFLG T)
(\PNAMESTRINGPUTCHAR PBASE J CH)
(\MKATOM PBASE 0 1 \FATPNAMESTRINGP))
(T (\BACKNSCHAR STREAM SHIFTEDCHARSET)
(\MKATOM PBASE 0 J \FATPNAMESTRINGP]
((AND (EQ SNX ESCAPE.RC)
(fetch ESCAPEFLG of #CURRENTRDTBL#))
(SETQ \PERCENTFLG T)
(SETQ CH (\CHECKEOLC (\NSIN STREAM SHIFTEDCHARSET SHIFTEDCHARSET)
(fetch EOLCONVENTION of STREAM)
STREAM]
(COND
((EQ J \PNAMELIMIT)
(LISPERROR "ATOM TOO LONG" NIL)))
(\PNAMESTRINGPUTCHAR PBASE J CH)
(add J 1)
[COND
((AND (NOT (\INTERMP STREAM))
(\EOFP STREAM)) (* This differs from the 10: Treat EOF as an atom
terminator without causing error.)
(RETURN (\MKATOM PBASE 0 J \FATPNAMESTRINGP]
[SETQ SNX (\SYNCODE SA (SETQ CH (\NSIN STREAM SHIFTEDCHARSET SHIFTEDCHARSET]
(GO SCANLOOP])
(READ
[LAMBDA (FILE RDTBL FLG) (* rmk: " 2-Apr-85 14:14")
(DECLARE (SPECVARS FLG)
(GLOBALVARS \BRKFLG \PERCENTFLG)) (* FLG is used freely by \FILLBUFFER)
(PROG ((#CURRENTRDTBL# (\GTREADTABLE RDTBL))
(\RefillBufferFn (FUNCTION \READREFILL)))
(DECLARE (SPECVARS #CURRENTRDTBL# \RefillBufferFn))
(SETQ \BRKFLG (SETQ \PERCENTFLG NIL))
(RETURN (WITH-RESOURCE (\PNAMESTRING)
(\SUBREAD (\GETSTREAM FILE (QUOTE INPUT))
(fetch READSA of #CURRENTRDTBL#)
READ.RT \PNAMESTRING])
(READC
[LAMBDA (FILE RDTBL) (* rmk: " 4-Apr-85 11:29")
(PROG ((#CURRENTRDTBL# (\GTREADTABLE RDTBL))
(\RefillBufferFn (FUNCTION \READCREFILL)))
(DECLARE (SPECVARS #CURRENTRDTBL# \RefillBufferFn))
(RETURN (FCHARACTER (\INCCODE (\INSTREAMARG FILE])
(READCCODE
[LAMBDA (FILE RDTBL) (* rmk: " 4-Apr-85 11:29")
(* * returns a 16 bit character code. \INCHAR does the EOL conversion and this function converts to a 16 bit value)
(PROG ((#CURRENTRDTBL# (\GTREADTABLE RDTBL))
(\RefillBufferFn (FUNCTION \READCREFILL)))
(DECLARE (SPECVARS #CURRENTRDTBL# \RefillBufferFn))
(RETURN (\INCCODE (\INSTREAMARG FILE])
(READP
[LAMBDA (FILE FLG) (* rmk: " 5-Apr-85 09:09")
(* The 10 does not do the EOL check on the peeked
character.)
(LET* ((STREAM (\GETSTREAM FILE (QUOTE INPUT)))
(DEVICE (ffetch (STREAM DEVICE) of STREAM)))
(COND
((ffetch (FDEV READP) of DEVICE)
(FDEVOP (QUOTE READP)
DEVICE STREAM FLG))
(T (\GENERIC.READP STREAM FLG])
(RSTRING
[LAMBDA (FILE RDTBL) (* rmk: " 2-Apr-85 14:14")
(PROG ((#CURRENTRDTBL# (\GTREADTABLE RDTBL))
(\RefillBufferFn (QUOTE \RATOM/RSTRING-REFILL)))
(DECLARE (SPECVARS #CURRENTRDTBL# \RefillBufferFn))
(RETURN (WITH-RESOURCE (\PNAMESTRING)
(\RSTRING2 (\GETSTREAM FILE (QUOTE INPUT))
(fetch READSA of #CURRENTRDTBL#)
T \PNAMESTRING])
(SETREADMACROFLG
[LAMBDA (FLG) (* rmk: "25-OCT-83 16:13")
(* D doesn't cause the read-macro context error, hence
doesn't maintain this flag)
NIL])
(SKIPSEPRCODES
[LAMBDA (FILE RDTBL) (* rmk: " 4-Apr-85 09:36")
(* Passes over non-separators to peek at the first non-separator on FILE. Returns either last peeked character, or
NIL if no non-seprs left in the file.)
(bind C SHIFTEDCHARSET (STREAM ←(\GETSTREAM FILE (QUOTE INPUT)))
(SA ←(fetch (READTABLEP READSA) of (\GTREADTABLE RDTBL)))
(\RefillBufferFn ←(QUOTE \PEEKREFILL)) first (SETQ SHIFTEDCHARSET
(UNFOLD (ffetch (STREAM CHARSET)
of STREAM)
256))
declare (SPECVARS \RefillBufferFn) while [EQ SEPRCHAR.RC
(\SYNCODE SA (SETQ C
(OR (\NSPEEK STREAM SHIFTEDCHARSET
SHIFTEDCHARSET T)
(RETURN]
do (\NSIN STREAM SHIFTEDCHARSET SHIFTEDCHARSET) finally (RETURN C])
(SKIPSEPRS
[LAMBDA (FILE RDTBL) (* rmk: "27-Mar-85 16:31")
(* Passes over non-separators to peek at the first non-separator on FILE. Returns either last peeked character, or
NIL if no non-seprs left in the file.)
(bind C SHIFTEDCHARSET (STREAM ←(\GETSTREAM FILE (QUOTE INPUT)))
(SA ←(fetch (READTABLEP READSA) of (\GTREADTABLE RDTBL)))
(\RefillBufferFn ←(QUOTE \PEEKREFILL)) first (SETQ SHIFTEDCHARSET
(UNFOLD (ffetch (STREAM CHARSET)
of STREAM)
256))
declare (SPECVARS \RefillBufferFn) while [EQ SEPRCHAR.RC
(\SYNCODE SA (SETQ C
(OR (\NSPEEK STREAM SHIFTEDCHARSET
SHIFTEDCHARSET T)
(RETURN]
do (\NSIN STREAM SHIFTEDCHARSET SHIFTEDCHARSET) finally (RETURN (FCHARACTER C])
(\APPLYREADMACRO
[LAMBDA (STREAM MACDEF ANSCELL) (* edited: "13-Jan-85 00:56")
(* INREADMACROP searches for this framename)
(DECLARE (USEDFREE #CURRENTRDTBL#))
(APPLY* (fetch MACROFN of MACDEF)
(LET ((FULLNAME (fetch FULLNAME of STREAM)))
(if (EQ FULLNAME T)
then FULLNAME
else STREAM))
#CURRENTRDTBL# ANSCELL])
(\RSTRING2
[LAMBDA (STREAM SA RSFLG PNSTR) (* rmk: " 3-Apr-85 09:12")
(* PNSTR is an instance of the global resource
\PNAMESTRING, which we can reuse without confusion.)
(DECLARE (USEDFREE #CURRENTRDTBL#))
(PROG (CH SNX ANSLIST FATSEEN (EOLC (ffetch EOLCONVENTION of STREAM))
(PBASE (SELECTQ (SYSTEMTYPE)
(VAX PNSTR)
(ffetch (STRINGP XBASE) of PNSTR)))
(SHIFTEDCHARSET (UNFOLD (ffetch CHARSET of STREAM)
256))
(J 0))
RS2LP
(SETQ CH (\CHECKEOLC (\NSIN STREAM SHIFTEDCHARSET SHIFTEDCHARSET)
EOLC STREAM))
(SETQ SNX (\SYNCODE SA CH))
[COND
((EQ SNX OTHER.RC))
[(EQ SNX ESCAPE.RC)
(AND (fetch ESCAPEFLG of #CURRENTRDTBL#)
(SETQ CH (\CHECKEOLC (\NSIN STREAM SHIFTEDCHARSET SHIFTEDCHARSET)
EOLC STREAM]
((COND
(RSFLG (* if called from RSTRING, end check is break or sepr)
(fetch STOPATOM of SNX))
(T (* otherwise, end check is dbl quote)
(EQ SNX STRINGDELIM.RC)))
(COND
(RSFLG (* if from RSTRING must put delim back)
(\BACKNSCHAR STREAM SHIFTEDCHARSET)))
(RETURN (COND
[ANSLIST (CONCATLIST (DREVERSE (CONS (\SMASHSTRING (ALLOCSTRING J NIL NIL
FATSEEN)
0 PNSTR J)
ANSLIST]
(T (\SMASHSTRING (ALLOCSTRING J NIL NIL FATSEEN)
0 PNSTR J]
(COND
((EQ J \PNAMELIMIT) (* FILLED PNSTR)
(push ANSLIST (\SMASHSTRING (ALLOCSTRING \PNAMELIMIT NIL NIL FATSEEN)
0 PNSTR))
(SETQ J 0)))
(\PNAMESTRINGPUTCHAR PBASE J CH)
(OR FATSEEN (SETQ FATSEEN (IGREATERP CH \MAXTHINCHAR)))
(SETQ J (ADD1 J))
(GO RS2LP])
(\SUBREAD
[LAMBDA (STREAM SA READTYPE PNSTR) (* jds " 1-May-85 12:25")
(* Values of READTYPE are READ.RT for top level of READ, NOPROPRB.RT if right-bracket isn't to be propagated
(sublist beginning with left-bracket), and PROPRB.RT if propagation is not suppressed (sublist beginning with
left-paren). The \RBFLG is propagated for top-level calls, in case they are embedded in read-macros.
-
\RDCONC is a macro that adds a new element as specified by its first argument to the current sublist.
Its other arguments will be executed instead if we are the top-level call (READTYPE=READ.RT) -
PNSTR is an instance of the global resource \PNAMESTRING, acquired in READ and passed on from level to level.
It is released during read-macro applications, then reacquired.)
(DECLARE (USEDFREE #CURRENTRDTBL# \RBFLG)
(GLOBALVARS \PERCENTFLG \BRKFLG \SEPRFLG))
(PROG [CH J SNX LST END ELT DOTLOC (SHIFTEDCHARSET (UNFOLD (ffetch (STREAM CHARSET) of STREAM)
256))
(PBASE (SELECTQ (SYSTEMTYPE)
(VAX PNSTR)
(ffetch (STRINGP XBASE) of PNSTR]
[COND
((EQ READTYPE READ.RT)
(COND
([EQ SEPRCHAR.RC (SETQ SNX (\SYNCODE SA (SETQ CH (\NSIN STREAM SHIFTEDCHARSET
SHIFTEDCHARSET]
(SETQ \SEPRFLG T))
(T (SETQ \SEPRFLG NIL)
(GO STARTATOM]
SEPRLOOP
(AND [EQ SEPRCHAR.RC (SETQ SNX (\SYNCODE SA (SETQ CH (\NSIN STREAM SHIFTEDCHARSET
SHIFTEDCHARSET]
(GO SEPRLOOP))
STARTATOM
(COND
((EQ SNX OTHER.RC)
(SETQ J 0)
(COND
([AND (EQ CH (CHARCODE %.))
(fetch STOPATOM of (\SYNCODE SA (\NSPEEK STREAM SHIFTEDCHARSET SHIFTEDCHARSET]
(* An isolated, unescaped dot.
This special check on every atom could be eliminated if
%. had a special SNX code)
(SETQ DOTLOC END))) (* DOTLOC points to CONS cell one before the dot, NIL
for car of list, as desired.)
(GO FIRSTCHAR))
((fetch STOPATOM of SNX)
(GO BREAK))
((AND (SELECTC (fetch MACROCONTEXT of SNX)
(FIRST.RMC T)
[ALONE.RMC (fetch STOPATOM of (\SYNCODE SA (\NSPEEK STREAM SHIFTEDCHARSET
SHIFTEDCHARSET]
NIL)
(fetch READMACROFLG of #CURRENTRDTBL#))
(GO MACRO)))
(SETQ J 0)
SCANLOOP
[COND
((AND (EQ SNX ESCAPE.RC)
(fetch ESCAPEFLG of #CURRENTRDTBL#))
(AND (EQ READTYPE READ.RT)
(SETQ \PERCENTFLG T)) (* Only set PERCENTFLG at the top level of read)
(SETQ CH (\CHECKEOLC (\NSIN STREAM SHIFTEDCHARSET SHIFTEDCHARSET)
(ffetch EOLCONVENTION of STREAM)
STREAM]
OTHER
(COND
((EQ J \PNAMELIMIT) (* Skip length check on the first char)
(LISPERROR "ATOM TOO LONG" NIL)))
FIRSTCHAR
(\PNAMESTRINGPUTCHAR PBASE J CH)
(add J 1)
[COND
((AND (EQ READTYPE READ.RT)
(NOT (\INTERMP STREAM))
(\EOFP STREAM))
(RETURN (\MKATOM PBASE 0 J \FATPNAMESTRINGP]
(COND
([EQ OTHER.RC (SETQ SNX (\SYNCODE SA (SETQ CH (\NSIN STREAM SHIFTEDCHARSET SHIFTEDCHARSET]
(GO OTHER))
[(fetch STOPATOM of SNX)
(SETQ ELT (\MKATOM PBASE 0 J \FATPNAMESTRINGP))
(\RDCONC ELT (\BACKNSCHAR STREAM SHIFTEDCHARSET)
(* Put back the terminating character)
(RETURN ELT))
(COND
((EQ SNX SEPRCHAR.RC) (* Examine the terminating character)
(GO SEPRLOOP))
(T (GO BREAK]
(T (GO SCANLOOP)))
BREAK
[SELECTC SNX
[LEFTPAREN.RC (COND
((PROG1 (PROPRB (SETQ ELT (\SUBREAD STREAM SA PROPRB.RT PNSTR)))
(\RDCONC ELT (RETURN ELT)))
(FIXDOT)
(RETURN LST]
(LEFTBRACKET.RC (SETQ ELT (\SUBREAD STREAM SA NOPROPRB.RT PNSTR))
(\RDCONC ELT (RETURN ELT)))
[(LIST RIGHTPAREN.RC RIGHTBRACKET.RC)
(RETURN (COND
((NEQ READTYPE READ.RT)
(FIXDOT)
(AND (EQ SNX RIGHTBRACKET.RC)
(NEQ READTYPE NOPROPRB.RT)
(SETQ \RBFLG T))
LST]
(STRINGDELIM.RC (SETQ ELT (\RSTRING2 STREAM SA NIL PNSTR))
(\RDCONC ELT (RETURN ELT)))
(COND
((OR (EQ SNX BREAKCHAR.RC)
(NOT (fetch READMACROFLG of #CURRENTRDTBL#)))
(\PNAMESTRINGPUTCHAR PBASE 0 CH)
(SETQ ELT (\MKATOM PBASE 0 1 \FATPNAMESTRINGP))
(* A breakchar or a disabled always macro)
(\RDCONC ELT (SETQ \BRKFLG T)
(RETURN ELT)))
(T (GO MACRO]
(GO SEPRLOOP)
MACRO
(SELECTQ (fetch MACROTYPE of (SETQ SNX (\GETREADMACRODEF CH #CURRENTRDTBL#)))
[MACRO (COND
((PROPRB (SETQ ELT (RELEASERESOURCE \PNAMESTRING PNSTR (\APPLYREADMACRO
STREAM SNX)))
(* Ignore right-bracket if macro is called at top-level
read)
(\RDCONC ELT (AND \RBFLG (\BACKNSCHAR STREAM SHIFTEDCHARSET))
(* Back over right-bracket and return instead of
setting free \RBFLG)
(RETURN ELT)))
(FIXDOT)
(RETURN LST]
[INFIX (COND
[(EQ READTYPE READ.RT)
[RBCONTEXT (SETQ ELT (RELEASERESOURCE \PNAMESTRING PNSTR
(\APPLYREADMACRO STREAM SNX]
(* not reading a sublist, so don't need to handle rb)
(COND
((AND (LISTP ELT)
(CDR ELT))
(RETURN (COND
((EQ (CDR ELT)
(CAR ELT))
(CAAR ELT))
(T (CAR ELT]
(T (* Reading sublist)
[COND
([PROPRB (SETQ ELT (RELEASERESOURCE \PNAMESTRING PNSTR
(\APPLYREADMACRO STREAM SNX
(CONS LST END]
(FIXDOT)
(RETURN (CAR ELT]
(SETQ LST (CAR ELT))
(SETQ END (CDR ELT]
[SPLICE [RBCONTEXT (SETQ ELT (RELEASERESOURCE \PNAMESTRING PNSTR (\APPLYREADMACRO
STREAM SNX]
(* Note: we don't care if there was terminating
right-bracket)
(COND
((OR (NULL ELT)
(EQ READTYPE READ.RT))
(* On the 10, it actually returns ELT if it is a list and the next token is a closing paren or bracket.
Hard to see how to get that behavior--rmk)
(GO SEPRLOOP))
((NLISTP ELT) (* The 10 throws initial non-lists away
(What if LST/END aren't set?))
(SETQ ELT (AND LST (LIST (QUOTE %.)
ELT)))
(SETQ DOTLOC END)))
(COND
(LST (RPLACD END ELT))
(T (SETQ LST ELT)))
(SETQ END (LAST ELT))
(COND
((CDR END) (* A dotted pair)
(SETQ DOTLOC END)
(RPLACD END (CONS (QUOTE %.)
(SETQ END (CONS (CDR END]
(SHOULDNT))
(GO SEPRLOOP])
)
(DECLARE: DONTCOPY
(RPAQQ READTYPES (READ.RT NOPROPRB.RT PROPRB.RT))
(DECLARE: EVAL@COMPILE
(RPAQQ READ.RT NIL)
(RPAQQ NOPROPRB.RT T)
(RPAQQ PROPRB.RT 0)
(CONSTANTS READ.RT NOPROPRB.RT PROPRB.RT)
)
(DECLARE: EVAL@COMPILE
[PUTPROPS FIXDOT MACRO (NIL (PROGN (* Fix a non-first dot followed by a singleton)
(AND DOTLOC (CDDR DOTLOC)
(NULL (CDDDR DOTLOC))
(RPLACD DOTLOC (CADDR DOTLOC]
(PUTPROPS RBCONTEXT MACRO ((X . Y)
([LAMBDA (\RBFLG)
(DECLARE (SPECVARS \RBFLG))
(PROGN X . Y)
\RBFLG]
NIL)))
[PUTPROPS PROPRB MACRO ((X . Y)
(* Propagates the right-bracket flag)
(AND (RBCONTEXT X . Y)
(OR (EQ READTYPE NOPROPRB.RT)
(SETQ \RBFLG T]
[PUTPROPS \RDCONC MACRO ((ELT . TOPFORMS)
(COND [LST (RPLACD END (SETQ END (CONS ELT]
((EQ READTYPE READ.RT) . TOPFORMS)
(T (SETQ LST (SETQ END (CONS ELT]
)
)
(DECLARE: DONTCOPY
(* FOLLOWING DEFINITIONS EXPORTED)
(DECLARE: EVAL@COMPILE
[PUTPROPS \BACKCHAR MACRO (OPENLAMBDA (STREAM)
(* Backs up over an NS character)
(\BACKNSCHAR STREAM (UNFOLD (ffetch CHARSET of STREAM)
256]
[PUTPROPS \BACKNSCHAR MACRO ((STREAM SHIFTEDCHARSET COUNTERVAR)
(AND (\BACKFILEPTR STREAM)
(COND [[COND (SHIFTEDCHARSET (EQ SHIFTEDCHARSET (UNFOLD \NORUNCODE 256)))
(T (EQ \NORUNCODE (ffetch CHARSET of STREAM]
(COND ((\BACKFILEPTR STREAM)
(AND (QUOTE COUNTERVAR)
(add COUNTERVAR 2))
T)
((QUOTE COUNTERVAR)
(add COUNTERVAR 1]
((QUOTE COUNTERVAR)
(add COUNTERVAR 1]
(PUTPROPS \CHECKEOLC MACRO
(OPENLAMBDA
(CH EOLC STREAM PEEKBINFLG COUNTERVAR)
(* Subtracts number of bytes read from COUNTERVAR, which may be NIL. In fact, should be
NIL if PEEKBINFLG is T.)
(SELCHARQ CH
(CR (SELECTC EOLC (CR.EOLC (CHARCODE EOL))
[CRLF.EOLC (COND
[PEEKBINFLG
(* T from PEEKC, compile-time constant. In this
case, must leave the fileptr where it was,
except for possibly advancing over character set
shifts)
(COND ([EQ (CHARCODE LF)
(UNINTERRUPTABLY
(\NSIN STREAM
(UNFOLD (ffetch CHARSET
of STREAM)
256))
(* Read the NS CR. We know that there aren't any font-shift characters in front of the CR, because they would have
already been read by the \NSPEEK that got the CR character. Since we are going to NS back the CR character, we don't
need to update the counter variable)
(PROG1 (\PEEKBIN STREAM T)
(* LF must be in next BYTE after NS CR, regardless of coding. Character-set shifting bytes can't intervene.
Then we back up over the CR that was \NSINed above.)
(\BACKNSCHAR STREAM)))]
(CHARCODE EOL))
(T (CHARCODE CR]
((EQ (CHARCODE LF)
(\PEEKBIN STREAM T))
(\BIN STREAM)
(AND (QUOTE COUNTERVAR)
(SETQ COUNTERVAR (SUB1 COUNTERVAR)))
(CHARCODE EOL))
(T (CHARCODE CR]
(CHARCODE CR)))
[LF (COND ((EQ EOLC LF.EOLC)
(CHARCODE EOL))
(T (CHARCODE LF]
CH)))
(PUTPROPS \INCHAR MACRO (OPENLAMBDA (STREAM COUNTERVAR)
(* returns a 16 bit character code)
(\CHECKEOLC (\NSIN STREAM (UNFOLD (ffetch CHARSET of STREAM)
256)
NIL COUNTERVAR)
(ffetch EOLCONVENTION of STREAM)
STREAM NIL COUNTERVAR)))
(PUTPROPS \INCCODE MACRO (OPENLAMBDA (STREAM COUNTERVAR)
(* returns a 16 bit character code)
(\CHECKEOLC (\NSIN STREAM (UNFOLD (ffetch CHARSET of STREAM)
256)
NIL COUNTERVAR)
(ffetch EOLCONVENTION of STREAM)
STREAM NIL COUNTERVAR)))
(PUTPROPS \PEEKCCODE MACRO (OPENLAMBDA (STREAM NOERROR)
(\CHECKEOLC (\NSPEEK STREAM (UNFOLD (ffetch CHARSET of STREAM)
256)
NIL NOERROR)
(ffetch EOLCONVENTION of STREAM)
STREAM T)))
[PUTPROPS \NSIN MACRO ((STREAM SHIFTEDCSET SHIFTEDCSETVAR COUNTERVAR)
(* returns a 16 bit character code. Doesn't do EOL conversion--\INCHAR does that.)
(LET ((CHAR (\BIN STREAM)))
(COND [(EQ CHAR NSCHARSETSHIFT)
(* CHARSETVAR=NIL means don't set)
(COND [(QUOTE SHIFTEDCSETVAR)
(COND ((EQ NSCHARSETSHIFT (SETQ CHAR (\BIN STREAM)))
(* 2 shift-bytes means not run-encoded)
(OR (EQ 0 (\BIN STREAM))
(ERROR "24-bit extended NS encoding not supported" STREAM))
(SETQ SHIFTEDCSETVAR (UNFOLD (freplace CHARSET of STREAM with
\NORUNCODE)
256))
(AND (QUOTE COUNTERVAR)
(SETQ COUNTERVAR (IDIFFERENCE COUNTERVAR 5)))
(LOGOR (UNFOLD (\BIN STREAM)
256)
(\BIN STREAM)))
(T (AND (QUOTE COUNTERVAR)
(SETQ COUNTERVAR (IDIFFERENCE COUNTERVAR 3)))
(LOGOR (SETQ SHIFTEDCSETVAR
(UNFOLD (freplace CHARSET of STREAM with CHAR)
256))
(\BIN STREAM]
(T (COND ((EQ NSCHARSETSHIFT (SETQ CHAR (\BIN STREAM)))
(* 2 shift-bytes means not run-encoded)
(OR (EQ 0 (\BIN STREAM))
(ERROR "24-bit extended NS encoding not supported" STREAM))
(freplace CHARSET of STREAM with \NORUNCODE)
(AND (QUOTE COUNTERVAR)
(SETQ COUNTERVAR (IDIFFERENCE COUNTERVAR 5)))
(LOGOR (UNFOLD (\BIN STREAM)
256)
(\BIN STREAM)))
(T (AND (QUOTE COUNTERVAR)
(SETQ COUNTERVAR (IDIFFERENCE COUNTERVAR 3)))
(LOGOR (UNFOLD (freplace CHARSET of STREAM with CHAR)
256)
(\BIN STREAM]
((EQ SHIFTEDCSET (UNFOLD \NORUNCODE 256))
(* just read two bytes and combine them to a 16 bit value)
(AND (QUOTE COUNTERVAR)
(SETQ COUNTERVAR (IDIFFERENCE COUNTERVAR 2)))
(LOGOR (UNFOLD CHAR 256)
(\BIN STREAM)))
(CHAR (AND (QUOTE COUNTERVAR)
(SETQ COUNTERVAR (IDIFFERENCE COUNTERVAR 1)))
(AND CHAR (LOGOR SHIFTEDCSET CHAR]
[PUTPROPS \NSINTEMP MACRO (OPENLAMBDA (STREAM SHIFTEDCSET SHIFTEDCSETVAR)
(PROG1 (NSIN STREAM SHIFTEDCSET)
(AND (QUOTE SHIFTEDCSETVAR)
(SETQ SHIFTEDCSETVAR (UNFOLD (fetch (STREAM CHARSET)
of STREAM)
256]
[PUTPROPS \NSPEEK MACRO
((STREAM SHIFTEDCSET SHIFTEDCSETVAR NOERROR COUNTERVAR)
(* returns a 16 bit character code. Doesn't do EOL conversion--\INCHAR does that. May
actually read the character-set shift, storing the result in the stream. COUNTERVAR, if
given, is updated to reflect any such bytes that are actually read)
(PROG ((CHAR (\PEEKBIN STREAM NOERROR)))
(COND ((NULL CHAR)
(RETURN NIL))
[(EQ CHAR NSCHARSETSHIFT)
(* CHARSETVAR=NIL means don't set)
(\BIN STREAM)
(COND ((AND NOERROR (\EOFP STREAM))
(* If at the EOF after a shift character, don't bother backing up)
(AND (QUOTE COUNTERVAR)
(SETQ COUNTERVAR (IDIFFERENCE COUNTERVAR 1)))
(RETURN NIL)))
(COND [(QUOTE SHIFTEDCSETVAR)
(COND [(EQ NSCHARSETSHIFT (SETQ CHAR (\BIN STREAM)))
(* 2 shift-bytes means not run-encoded)
(COND ((AND NOERROR (\EOFP STREAM))
(AND (QUOTE COUNTERVAR)
(SETQ COUNTERVAR (IDIFFERENCE COUNTERVAR 2)))
(RETURN NIL)))
(OR (EQ 0 (\BIN STREAM))
(ERROR "24-bit extended NS encoding not supported" STREAM))
(AND (QUOTE COUNTERVAR)
(SETQ COUNTERVAR (IDIFFERENCE COUNTERVAR 3)))
(SETQ SHIFTEDCSETVAR (UNFOLD (freplace CHARSET of STREAM with
\NORUNCODE)
256))
(COND ((AND NOERROR (\EOFP STREAM))
(RETURN NIL)))
(RETURN (PROG1 [LOGOR (UNFOLD (\BIN STREAM)
256)
(OR (\PEEKBIN STREAM NOERROR)
(PROGN (\BACKFILEPTR STREAM)
(RETURN NIL]
(\BACKFILEPTR STREAM]
(T (AND (QUOTE COUNTERVAR)
(SETQ COUNTERVAR (IDIFFERENCE COUNTERVAR 2)))
(RETURN (LOGOR (SETQ SHIFTEDCSETVAR
(UNFOLD (freplace CHARSET of STREAM with
CHAR)
256))
(OR (\PEEKBIN STREAM NOERROR)
(RETURN NIL]
(T (COND [(EQ NSCHARSETSHIFT (SETQ CHAR (\BIN STREAM)))
(* 2 shift-bytes means not run-encoded)
(COND ((AND NOERROR (\EOFP STREAM))
(AND (QUOTE COUNTERVAR)
(SETQ COUNTERVAR (IDIFFERENCE COUNTERVAR 2)))
(RETURN NIL)))
(OR (EQ 0 (\BIN STREAM))
(ERROR "24-bit extended NS encoding not supported" STREAM)
)
(AND (QUOTE COUNTERVAR)
(SETQ COUNTERVAR (IDIFFERENCE COUNTERVAR 3)))
(freplace CHARSET of STREAM with \NORUNCODE)
(COND ((AND NOERROR (\EOFP STREAM))
(RETURN NIL)))
(RETURN (PROG1 [LOGOR (UNFOLD (\BIN STREAM)
256)
(OR (\PEEKBIN STREAM NOERROR)
(PROGN (\BACKFILEPTR STREAM)
(RETURN NIL]
(\BACKFILEPTR STREAM]
(T (AND (QUOTE COUNTERVAR)
(SETQ COUNTERVAR (IDIFFERENCE COUNTERVAR 2)))
(RETURN (LOGOR (UNFOLD (freplace CHARSET of STREAM with
CHAR)
256)
(OR (\PEEKBIN STREAM NOERROR)
(RETURN NIL]
[(EQ SHIFTEDCSET (UNFOLD \NORUNCODE 256))
(* just peek two bytes and combine them to a 16 bit value)
(\BIN STREAM)
(RETURN (PROG1 [LOGOR (UNFOLD CHAR 256)
(OR (\PEEKBIN STREAM NOERROR)
(PROGN (\BACKFILEPTR STREAM)
(* We should never be an odd-number of bytes
from the end of a 16-bit file)
(RETURN NIL]
(\BACKFILEPTR STREAM]
(T (RETURN (LOGOR SHIFTEDCSET CHAR]
)
(* END EXPORTED DEFINITIONS)
)
(RPAQ \RefillBufferFn (FUNCTION \READCREFILL))
(* Act like READC if there is no binding of \RefillBufferFn--we must be doing a raw BIN (or
PEEKBIN?))
(DECLARE: DOEVAL@COMPILE DONTCOPY
(LOCALVARS . T)
)
(DECLARE: DOEVAL@COMPILE DONTCOPY
(SPECVARS \RefillBufferFn)
)
(PUTPROPS LLREAD COPYRIGHT ("Xerox Corporation" 1981 1982 1983 1984 1985))
(DECLARE: DONTCOPY
(FILEMAP (NIL (940 22026 (INREADMACROP 950 . 1424) (LASTC 1426 . 2957) (PEEKC 2959 . 3434) (PEEKCCODE
3436 . 3896) (RATEST 3898 . 4150) (RATOM 4152 . 6679) (READ 6681 . 7346) (READC 7348 . 7701) (
READCCODE 7703 . 8177) (READP 8179 . 8697) (RSTRING 8699 . 9179) (SETREADMACROFLG 9181 . 9468) (
SKIPSEPRCODES 9470 . 10396) (SKIPSEPRS 10398 . 11336) (\APPLYREADMACRO 11338 . 11830) (\RSTRING2 11832
. 13984) (\SUBREAD 13986 . 22024)))))
STOP