(FILECREATED "24-Sep-86 18:24:31" {ERIS}<LISPCORE>SOURCES>IOCHAR.;16 96130
changes to: (FNS SKREAD)
(VARS IOCHARCOMS)
previous date: "28-Mar-86 13:41:12" {ERIS}<LISPCORE>SOURCES>IOCHAR.;14)
(* Copyright (c) 1981, 1982, 1983, 1984, 1985, 1986 by Xerox Corporation. All rights reserved.)
(PRETTYCOMPRINT IOCHARCOMS)
(RPAQQ IOCHARCOMS ((COMS (FNS CHCON UNPACK DCHCON DUNPACK)
(FNS UALPHORDER ALPHORDER PACKC CONCAT PACK PACK* \PACK.ITEM STRPOS)
(GLOBALVARS \SIGNFLAG \PRINTRADIX)
(DECLARE: DONTCOPY (MACROS \CATRANSLATE)))
(COMS (FNS STRPOSL MAKEBITTABLE)
(DECLARE: DONTCOPY (RESOURCES \STRPOSLARRAY))
(INITRESOURCES \STRPOSLARRAY))
(COMS (FNS CASEARRAY UPPERCASEARRAY)
(P (MOVD? (QUOTE SETA)
(QUOTE SETCASEARRAY))
(MOVD? (QUOTE ELT)
(QUOTE GETCASEARRAY)))
(DECLARE: DONTEVAL@LOAD DOCOPY (VARS (\TRANSPARENT (CASEARRAY))
(UPPERCASEARRAY (UPPERCASEARRAY))))
(DECLARE: EVAL@COMPILE (PROP GLOBALVAR UPPERCASEARRAY)
DONTCOPY
(GLOBALVARS \TRANSPARENT)))
(COMS (FNS SKREAD SKBRACKET SKREADC)
(BLOCKS (SKREAD SKREAD SKBRACKET SKREADC)))
(COMS (FNS FILEPOS FFILEPOS \SETUP.FFILEPOS)
(DECLARE: EVAL@COMPILE DONTCOPY (RESOURCES \FFDELTA1 \FFDELTA2 \FFPATCHAR)
(CONSTANTS (\MAX.PATTERN.SIZE 128)
(\MIN.PATTERN.SIZE 3)
(FILEPOS.SEGMENT.SIZE 32768)
(\MIN.SEARCH.LENGTH 100)))
(INITRESOURCES \FFDELTA1 \FFDELTA2 \FFPATCHAR))
(COMS (* DATE)
(FNS DATE DATEFORMAT GDATE IDATE \IDATESCANTOKEN \OUTDATE \RPLRIGHT
\UNPACKDATE \PACKDATE \DTSCAN \ISDST? \CHECKDSTCHANGE)
(OPTIMIZERS DATEFORMAT)
(INITVARS (\TimeZoneComp 8)
(\BeginDST 120)
(\EndDST 304)
(\DayLightSavings T))
(ADDVARS (TIME.ZONES (8 . P)
(7 . M)
(6 . C)
(5 . E)
(0 . GMT)))
(DECLARE: EVAL@COMPILE DONTCOPY (GLOBALVARS \TimeZoneComp \BeginDST \EndDST
\DayLightSavings TIME.ZONES)
(CONSTANTS (\4YearsDays (ADD1 (ITIMES 365 4))))))
(LOCALVARS . T)
(PROP FILETYPE IOCHAR)
(DECLARE: DONTEVAL@LOAD DOEVAL@COMPILE DONTCOPY COMPILERVARS
(ADDVARS (NLAMA DATEFORMAT)
(NLAML)
(LAMA PACK* CONCAT)))))
(DEFINEQ
(CHCON
[LAMBDA (X FLG RDTBL) (* bvm: "24-Mar-86 16:29")
(PROG (BASE OFFST LEN \CHCONLST \CHCONLSTAIL FATP)
(COND
(FLG (GO SLOWCASE)))
(SELECTC (NTYPX X)
(\LITATOM (SETQ BASE (ffetch (LITATOM PNAMEBASE) of X))
(SETQ OFFST 1)
(SETQ FATP (ffetch (LITATOM FATPNAMEP) of X))
(SETQ LEN (ffetch (LITATOM PNAMELENGTH) of X)))
(\STRINGP (SETQ BASE (ffetch (STRINGP BASE) of X))
(SETQ FATP (ffetch (STRINGP FATSTRINGP) of X))
(SETQ OFFST (ffetch (STRINGP OFFST) of X))
(SETQ LEN (ffetch (STRINGP LENGTH) of X)))
(GO SLOWCASE))
(RETURN (for I from OFFST to (IPLUS OFFST LEN -1) collect (\GETBASECHAR FATP BASE I)))
SLOWCASE
(\MAPPNAME [FUNCTION (LAMBDA (DUMMY CODE) (* Open code COLLECT)
(COND
[\CHCONLSTAIL (FRPLACD \CHCONLSTAIL (SETQ \CHCONLSTAIL
(LIST CODE]
(T (SETQ \CHCONLST (SETQ \CHCONLSTAIL (LIST CODE]
X FLG RDTBL)
(RETURN \CHCONLST])
(UNPACK
[LAMBDA (X FLG RDTBL) (* bvm: "24-Mar-86 16:29")
(PROG (BASE OFFST LEN \CHCONLST \CHCONLSTAIL FATP)
(COND
(FLG (GO SLOWCASE)))
(SELECTC (NTYPX X)
(\LITATOM (SETQ BASE (ffetch (LITATOM PNAMEBASE) of X))
(SETQ OFFST 1)
(SETQ FATP (ffetch (LITATOM FATPNAMEP) of X))
(SETQ LEN (ffetch (LITATOM PNAMELENGTH) of X)))
(\STRINGP (SETQ BASE (ffetch (STRINGP BASE) of X))
(SETQ OFFST (ffetch (STRINGP OFFST) of X))
(SETQ FATP (ffetch (STRINGP FATSTRINGP) of X))
(SETQ LEN (ffetch (STRINGP LENGTH) of X)))
(GO SLOWCASE))
[RETURN (for I from OFFST to (IPLUS OFFST LEN -1) collect (FCHARACTER (\GETBASECHAR FATP
BASE I]
SLOWCASE
(\MAPPNAME [FUNCTION (LAMBDA (DUMMY CODE)
(SETQ CODE (FCHARACTER CODE))
(* Open code COLLECT)
(COND
[\CHCONLSTAIL (FRPLACD \CHCONLSTAIL (SETQ \CHCONLSTAIL
(LIST CODE]
(T (SETQ \CHCONLST (SETQ \CHCONLSTAIL (LIST CODE]
X FLG RDTBL)
(RETURN \CHCONLST])
(DCHCON
[LAMBDA (X SCRATCHLIST FLG RDTBL) (* bvm: "24-Mar-86 16:30")
(SCRATCHLIST SCRATCHLIST (PROG (BASE OFFST LEN FATP)
(COND
(FLG (GO SLOWCASE)))
(SELECTC (NTYPX X)
(\LITATOM (SETQ BASE (ffetch (LITATOM PNAMEBASE) of X))
(SETQ OFFST 1)
(SETQ FATP (ffetch (LITATOM FATPNAMEP) of X))
(SETQ LEN (ffetch (LITATOM PNAMELENGTH) of X)))
(\STRINGP (SETQ BASE (ffetch (STRINGP BASE) of X))
(SETQ OFFST (ffetch (STRINGP OFFST) of X))
(SETQ OFFST (ffetch (STRINGP OFFST) of X))
(SETQ LEN (ffetch (STRINGP LENGTH) of X)))
(GO SLOWCASE))
[RETURN (for I from OFFST to (IPLUS OFFST LEN -1)
do (ADDTOSCRATCHLIST (\GETBASECHAR FATP BASE I]
SLOWCASE
(RETURN (\MAPPNAME [FUNCTION (LAMBDA (DUMMY CODE)
(ADDTOSCRATCHLIST CODE]
X FLG RDTBL])
(DUNPACK
[LAMBDA (X SCRATCHLIST FLG RDTBL) (* bvm: "24-Mar-86 16:30")
(SCRATCHLIST SCRATCHLIST (PROG (BASE OFFST LEN FATP)
(COND
(FLG (GO SLOWCASE)))
(SELECTC (NTYPX X)
(\LITATOM (SETQ BASE (ffetch (LITATOM PNAMEBASE) of X))
(SETQ OFFST 1)
(SETQ FATP (ffetch (LITATOM FATPNAMEP) of X))
(SETQ LEN (ffetch (LITATOM PNAMELENGTH) of X)))
(\STRINGP (SETQ BASE (ffetch (STRINGP BASE) of X))
(SETQ OFFST (ffetch (STRINGP OFFST) of X))
(SETQ FATP (ffetch (STRINGP FATSTRINGP) of X))
(SETQ LEN (ffetch (STRINGP LENGTH) of X)))
(GO SLOWCASE))
[RETURN (for I from OFFST to (IPLUS OFFST LEN -1)
do (ADDTOSCRATCHLIST (FCHARACTER (\GETBASECHAR FATP
BASE I]
SLOWCASE
(RETURN (\MAPPNAME [FUNCTION (LAMBDA (DUMMY CODE)
(ADDTOSCRATCHLIST (FCHARACTER
CODE]
X FLG RDTBL])
)
(DEFINEQ
(UALPHORDER
[LAMBDA (ARG1 B) (* rmk: " 2-Apr-85 11:20")
(ALPHORDER ARG1 B UPPERCASEARRAY])
(ALPHORDER
[LAMBDA (A B CASEARRAY) (* rmk: "27-Mar-85 17:43")
(DECLARE (GLOBALVARS \TRANSPARENT))
(PROG (CABASE ABASE ALEN AOFFSET AFATP BBASE BLEN BOFFSET BFATP C1 C2)
[COND
((LITATOM A)
(SETQ ABASE (ffetch (LITATOM PNAMEBASE) of A))
(SETQ AOFFSET 1)
(SETQ ALEN (ffetch (LITATOM PNAMELENGTH) of A))
(SETQ AFATP (ffetch (LITATOM FATPNAMEP) of A)))
((STRINGP A)
(SETQ ABASE (ffetch (STRINGP BASE) of A))
(SETQ AOFFSET (ffetch (STRINGP OFFST) of A))
(SETQ ALEN (ffetch (STRINGP LENGTH) of A))
(SETQ AFATP (ffetch (STRINGP FATSTRINGP) of A)))
(T (RETURN (COND
[(NUMBERP A) (* Numbers are less than all other
types)
(OR (NOT (NUMBERP B))
(NOT (GREATERP A B]
((OR (NUMBERP B)
(LITATOM B)
(STRINGP B))
NIL)
(T T]
[COND
((LITATOM B)
(SETQ BBASE (ffetch (LITATOM PNAMEBASE) of B))
(SETQ BOFFSET 1)
(SETQ BLEN (ffetch (LITATOM PNAMELENGTH) of B))
(SETQ BFATP (ffetch (LITATOM FATPNAMEP) of B)))
((STRINGP B)
(SETQ BBASE (ffetch (STRINGP BASE) of B))
(SETQ BOFFSET (ffetch (STRINGP OFFST) of B))
(SETQ BLEN (ffetch (STRINGP LENGTH) of B))
(SETQ BFATP (ffetch (STRINGP FATSTRINGP) of B)))
(T (* Only numbers are "less than" atoms
and strings)
(RETURN (NOT (NUMBERP B]
[SETQ CABASE (fetch (ARRAYP BASE) of (SETQ CASEARRAY (\DTEST (OR CASEARRAY \TRANSPARENT)
(QUOTE ARRAYP]
(RETURN (for I (CAFAT ←(EQ \ST.POS16 (fetch (ARRAYP TYP) of CASEARRAY)))
(CASIZE ←(fetch (ARRAYP LENGTH) of CASEARRAY)) from 0
do (COND
[(IGEQ I ALEN)
(RETURN (COND
((EQ ALEN BLEN)
(QUOTE EQUAL))
(T (QUOTE LESSP]
((IGEQ I BLEN)
(RETURN NIL))
[(EQ [SETQ C1 (\CATRANSLATE CABASE CASIZE CAFAT (\GETBASECHAR AFATP ABASE
(IPLUS I AOFFSET]
(SETQ C2 (\CATRANSLATE CABASE CASIZE CAFAT (\GETBASECHAR BFATP BBASE
(IPLUS I BOFFSET]
((ILESSP C1 C2)
(RETURN (QUOTE LESSP)))
(T (* "Greater")
(RETURN NIL])
(PACKC
[LAMBDA (X) (* rmk: "11-Apr-85 15:35")
(* Takes character codes in X, stuffs
them into the \PNAMESTRING, and then
calls \MKATOM)
(WITH-RESOURCE (\PNAMESTRING)
(BIND (PBASE ←(ffetch (STRINGP XBASE) of \PNAMESTRING)) for N from 0 as C in X
do (AND (IGREATERP N \PNAMELIMIT)
(LISPERROR "ATOM TOO LONG"))
(\PNAMESTRINGPUTCHAR PBASE N C) finally (RETURN (\MKATOM PBASE 0 N \FATPNAMESTRINGP])
(CONCAT
[LAMBDA N (* rmk: "26-Mar-85 19:08")
(PROG ((J N)
(LEN 0)
(POS 1)
S NM FATSEENP)
L1 (COND
((NEQ J 0)
[COND
[(STRINGP (SETQ NM (ARG N J)))
(OR FATSEENP (SETQ FATSEENP (ffetch (STRINGP FATSTRINGP) of NM]
[(LITATOM NM)
(OR FATSEENP (SETQ FATSEENP (ffetch (LITATOM FATPNAMEP) of NM]
(T (SETARG N J (SETQ NM (MKSTRING NM)))
(OR FATSEENP (SETQ FATSEENP (ffetch (STRINGP FATSTRINGP) of NM]
(SETQ LEN (IPLUS LEN (NCHARS NM)))
(SETQ J (SUB1 J))
(GO L1)))
(SETQ S (ALLOCSTRING LEN NIL NIL FATSEENP))
L2 (COND
((NEQ J N)
(SETQ J (ADD1 J))
(RPLSTRING S POS (ARG N J))
[SETQ POS (IPLUS POS (NCHARS (ARG N J]
(GO L2)))
(RETURN S])
(PACK
[LAMBDA (X) (* bvm: "27-Jun-85 13:10")
(AND X (NLISTP X)
(\ILLEGAL.ARG X))
(DECLARE (SPECVARS N \PNAMESTRING))
(WITH-RESOURCE (\PNAMESTRING)
(PROG ((N 1)
ITEM)
LP [COND
((NULL X)
(RETURN (\MKATOM (fetch (STRINGP XBASE) of \PNAMESTRING)
0
(SUB1 N)
\FATPNAMESTRINGP]
(COND
((OR (STRINGP (SETQ ITEM (CAR X)))
(LITATOM ITEM))
(RPLSTRING \PNAMESTRING (PROG1 N (AND (IGREATERP (add N (NCHARS ITEM))
(ADD1 \PNAMELIMIT))
(LISPERROR "ATOM TOO LONG")))
ITEM))
(T (\PACK.ITEM ITEM)))
(SETQ X (LISTP (CDR X)))
(GO LP])
(PACK*
[LAMBDA U (* bvm: "27-Jun-85 13:10")
(DECLARE (SPECVARS N \PNAMESTRING))
(WITH-RESOURCE (\PNAMESTRING)
(PROG ((N 1)
(M 1)
ITEM)
LP [COND
((IGREATERP M U)
(RETURN (\MKATOM (fetch (STRINGP XBASE) of \PNAMESTRING)
0
(SUB1 N)
\FATPNAMESTRINGP]
(COND
((OR (STRINGP (SETQ ITEM (ARG U M)))
(LITATOM ITEM))
(RPLSTRING \PNAMESTRING (PROG1 N (AND (IGREATERP (add N (NCHARS ITEM))
(ADD1 \PNAMELIMIT))
(LISPERROR "ATOM TOO LONG")))
ITEM))
(T (\PACK.ITEM ITEM)))
(SETQ M (ADD1 M))
(GO LP])
(\PACK.ITEM
[LAMBDA (ITEM) (* bvm: "24-Mar-86 16:30")
(DECLARE (USEDFREE N \PNAMESTRING))
(* * Slow case for PACK and PACK* -- append characters of ITEM to \PNAMESTRING,
updating N accordingly)
(\MAPPNAME [FUNCTION (LAMBDA (DUMMY CODE)
(AND (IGREATERP N \PNAMELIMIT)
(LISPERROR "ATOM TOO LONG"))
(\PNAMESTRINGPUTCHAR (fetch (STRINGP BASE) of \PNAMESTRING)
(SUB1 N)
CODE)
(add N 1]
ITEM])
(STRPOS
[LAMBDA (PAT STRING START SKIP ANCHOR TAIL CASEARRAY BACKWARDSFLG)
(* rmk: "26-Mar-85 09:54")
(DECLARE (GLOBALVARS \TRANSPARENT))
(PROG (PATLEN PATBASE PATOFFST STRINGLEN STRINGBASE STRINGOFFST MAXI JMAX 1stPATchar jthPATchar
STRFAT PATFAT)
(if (LITATOM PAT)
then (SETQ PATBASE (fetch (LITATOM PNAMEBASE) of PAT))
(SETQ PATOFFST 1)
(SETQ PATLEN (fetch (LITATOM PNAMELENGTH) of PAT))
(SETQ PATFAT (FETCH (LITATOM FATPNAMEP) OF PAT))
else (OR (STRINGP PAT)
(SETQ PAT (MKSTRING PAT)))
(SETQ PATBASE (fetch (STRINGP BASE) of PAT))
(SETQ PATOFFST (fetch (STRINGP OFFST) of PAT))
(SETQ PATLEN (fetch (STRINGP LENGTH) of PAT))
(SETQ PATFAT (FETCH (STRINGP FATSTRINGP) OF PAT)))
(if (LITATOM STRING)
then (SETQ STRINGBASE (fetch (LITATOM PNAMEBASE) of STRING))
(SETQ STRINGOFFST 1)
(SETQ STRINGLEN (fetch (LITATOM PNAMELENGTH) of STRING))
(SETQ STRFAT (FETCH (LITATOM FATPNAMEP) OF STRING))
else (OR (STRINGP STRING)
(SETQ STRING (MKSTRING STRING)))
(SETQ STRINGBASE (fetch (STRINGP BASE) of STRING))
(SETQ STRINGOFFST (fetch (STRINGP OFFST) of STRING))
(SETQ STRINGLEN (fetch (STRINGP LENGTH) of STRING))
(SETQ STRFAT (FETCH (STRINGP FATSTRINGP) OF STRING)))
(if [IGEQ 0 (SETQ MAXI (ADD1 (IDIFFERENCE STRINGLEN PATLEN]
then (* Who's he kidding? The PATTERN
length is greater than the STRING
length)
(RETURN))
(if (NULL START)
then (SETQ START (if BACKWARDSFLG
then MAXI
else 1))
elseif (ILESSP START 0)
then (add START (ADD1 STRINGLEN))
(if (ILESSP START 1)
then (RETURN))
elseif (IGREATERP START MAXI)
then (RETURN)) (* Normalize start to a 1-origin index
between 1 and LEN)
(if (ILEQ PATLEN 0)
then (RETURN START)) (* Null pattern matches anything)
(AND SKIP (SETQ SKIP (CHCON1 SKIP)))
(if (NULL CASEARRAY)
then (SETQ CASEARRAY \TRANSPARENT)
elseif [NOT (AND (ARRAYP CASEARRAY)
(OR (EQ \ST.BYTE (fetch (ARRAYP TYP) of CASEARRAY))
(EQ \ST.POS16 (fetch (ARRAYP TYP) of CASEARRAY]
then (\ILLEGAL.ARG CASEARRAY)) (* Oh, for a LET here!)
(add STRINGOFFST -1)
(add PATOFFST -1)
(RETURN (PROG ((CAOFFST (fetch (ARRAYP OFFST) of CASEARRAY))
(CABASE (fetch (ARRAYP BASE) of CASEARRAY))
(CAFAT (EQ \ST.POS16 (fetch (ARRAYP TYP) of CASEARRAY)))
(CASIZE (fetch (ARRAYP LENGTH) of CASEARRAY))
(OFFST.I (IPLUS STRINGOFFST START (if BACKWARDSFLG
then 1
else -1)))
(LASTI (IPLUS STRINGOFFST
(if ANCHOR
then START
elseif BACKWARDSFLG
then 1
else MAXI)))
(JSTART (IPLUS PATOFFST 2))
(JMAX (IPLUS PATOFFST PATLEN))) (* Remember! START is a 1-origin index)
(* There will be at least one pass
thru the following loop, or else we
would have (RETURN) before now)
(OR (EQ 0 CAOFFST)
(ERROR "CASEARRAY can't be a sub-array: " CASEARRAY))
[SETQ 1stPATchar (\CATRANSLATE CABASE CASIZE CAFAT (\GETBASECHAR PATFAT
PATBASE
(ADD1 PATOFFST]
LP (if (if BACKWARDSFLG
then (ILESSP (add OFFST.I -1)
LASTI)
else (IGREATERP (add OFFST.I 1)
LASTI))
then (RETURN)
elseif [AND [OR (EQ 1stPATchar SKIP)
(EQ 1stPATchar (\CATRANSLATE CABASE CASIZE CAFAT
(\GETBASECHAR STRFAT STRINGBASE
OFFST.I]
(for J from JSTART to JMAX as K from (ADD1 OFFST.I)
always (OR [EQ SKIP (SETQ jthPATchar
(\CATRANSLATE CABASE CASIZE CAFAT
(\GETBASECHAR PATFAT PATBASE J]
(EQ jthPATchar (\CATRANSLATE CABASE CASIZE CAFAT
(\GETBASECHAR STRFAT
STRINGBASE K]
then (RETURN (IDIFFERENCE (if TAIL
then (IPLUS OFFST.I PATLEN)
else OFFST.I)
STRINGOFFST)))
(GO LP) (* Fall out thru bottom if didn't find
it)
])
)
(DECLARE: DOEVAL@COMPILE DONTCOPY
(GLOBALVARS \SIGNFLAG \PRINTRADIX)
)
(DECLARE: DONTCOPY
(DECLARE: EVAL@COMPILE
(PUTPROPS \CATRANSLATE MACRO (OPENLAMBDA (CABASE CASIZE CAFAT CHAR)
(COND ((ILEQ CHAR CASIZE)
(* If it's in the table, use the table value)
(\GETBASEBYTE CABASE CHAR))
(T (* Off the end -- assume it's itself)
CHAR))))
)
)
(DEFINEQ
(STRPOSL
[LAMBDA (A STRING START NEG BACKWARDSFLG) (* edited: "18-Mar-86 17:20")
(* Given a list of charcodes, A, find
the first one in STRING.)
(GLOBALRESOURCE \STRPOSLARRAY (PROG (BASE OFFST LEN I LASTI STRFAT CH)
(OR (type? CHARTABLE A)
(SETQ A (MAKEBITTABLE A NIL \STRPOSLARRAY)))
(if (LITATOM STRING)
then (SETQ BASE (fetch (LITATOM PNAMEBASE) of STRING))
(SETQ LEN (fetch (LITATOM PNAMELENGTH) of STRING))
(SETQ OFFST 1)
(SETQ STRFAT (fetch (LITATOM FATPNAMEP) of STRING))
else (OR (STRINGP STRING)
(SETQ STRING (MKSTRING STRING)))
(SETQ BASE (fetch (STRINGP BASE) of STRING))
(SETQ LEN (fetch (STRINGP LENGTH) of STRING))
(SETQ OFFST (fetch (STRINGP OFFST) of STRING))
(SETQ STRFAT (fetch (STRINGP FATSTRINGP) of STRING)))
(if (NULL START)
then (SETQ START (if BACKWARDSFLG
then LEN
else 1))
elseif (ILESSP START 0)
then (add START (ADD1 LEN))
(if (ILESSP START 1)
then (RETURN))
elseif (IGREATERP START LEN)
then (RETURN)) (* Normalize start to a 1-origin index
between 1 and LEN)
(add OFFST -1) (* Bias the OFFST since START is
1-origin and the loop deals in
0-origin)
(SETQ NEG (if NEG
then (* Convert NEG to match the correct
value returned by \SYNCODE)
0
else 1))
(SETQ I (IPLUS OFFST START))
(SETQ LASTI (IPLUS OFFST (if BACKWARDSFLG
then (add I 1)
1
else (add I -1)
LEN)))
(* There will be at least one pass
thru the following loop, or else we
would have (RETURN) before now)
LP (if (if BACKWARDSFLG
then (ILESSP (add I -1)
LASTI)
else (IGREATERP (add I 1)
LASTI))
then (RETURN)
elseif (EQ NEG (\SYNCODE A (\GETBASECHAR STRFAT BASE I)))
then (RETURN (IDIFFERENCE I OFFST)))
(GO LP])
(MAKEBITTABLE
[LAMBDA (L NEG A) (* edited: "18-Mar-86 18:49")
[COND
[(type? CHARTABLE A) (* Clear it)
(\ZEROBYTES A 0 \MAXTHINCHAR)
(if (fetch (CHARTABLE NSCHARHASH) of A)
then (CLRHASH (fetch (CHARTABLE NSCHARHASH) of A]
(T (SETQ A (create CHARTABLE]
(for X in L do (\SETSYNCODE A (OR (AND (SMALLP X)
(LOGAND X \MAXCHAR))
(CHCON1 X))
1)) (* Invert 1 and 0 if NEG)
[AND NEG (for I from 0 to \MAXCHAR do (\SETSYNCODE A I (LOGXOR 1 (\SYNCODE A I]
A])
)
(DECLARE: DONTCOPY
(DECLARE: EVAL@COMPILE
(PUTDEF (QUOTE \STRPOSLARRAY)
(QUOTE RESOURCES)
(QUOTE (NEW (NCREATE (QUOTE CHARTABLE)))))
)
)
(/SETTOPVAL (QUOTE \\STRPOSLARRAY.GLOBALRESOURCE))
(DEFINEQ
(CASEARRAY
[LAMBDA (OLDAR) (* lmm "20-MAR-81 10:21")
(COND
(OLDAR (COPYARRAY OLDAR))
(T (PROG ((AR (ARRAY 256 (QUOTE BYTE)
0 0)))
(for I from 0 to 255 do (SETA AR I I))
(RETURN AR])
(UPPERCASEARRAY
[LAMBDA NIL (* rmk: " 2-Apr-85 11:22")
(OR (ARRAYP UPPERCASEARRAY)
(LET ((CA (CASEARRAY)))
[for I from (CHARCODE a) to (CHARCODE z)
do (SETCASEARRAY CA I (IDIFFERENCE I (CONSTANT (IDIFFERENCE (CHARCODE a)
(CHARCODE A]
(SETQ UPPERCASEARRAY CA])
)
(MOVD? (QUOTE SETA)
(QUOTE SETCASEARRAY))
(MOVD? (QUOTE ELT)
(QUOTE GETCASEARRAY))
(DECLARE: DONTEVAL@LOAD DOCOPY
(RPAQ \TRANSPARENT (CASEARRAY))
(RPAQ UPPERCASEARRAY (UPPERCASEARRAY))
)
(DECLARE: EVAL@COMPILE
(PUTPROPS UPPERCASEARRAY GLOBALVAR T)
DONTCOPY
(DECLARE: DOEVAL@COMPILE DONTCOPY
(GLOBALVARS \TRANSPARENT)
)
)
(DEFINEQ
(SKREAD
(LAMBDA (FILE REREADSTRING RDTBL) (* Pavel "24-Sep-86 18:22")
(DECLARE (SPECVARS RRPTR REREADSTRING)
(GLOBALVARS FILERDTBL)) (* ;
"RDTBL defaults to FILERDTBL; not an argument in Interlisp-10")
(PROG (SNX (STRM (\GETSTREAM FILE (QUOTE INPUT)))
(RRPTR (AND REREADSTRING 1)))
(COND
((\INTERMP STRM) (* mainly because of the backfileptr)
(ERROR "SKREAD NOT LEGAL FROM TTY" FILE)))
(SETQ RDTBL (\GTREADTABLE (OR RDTBL FILERDTBL)))
TOP (SETQ SNX (SKREADC RRPTR STRM RDTBL))
RETRY
(RETURN (SELECTC SNX
(LEFTBRACKET.RC
(SKBRACKET STRM RDTBL))
(RIGHTBRACKET.RC
(QUOTE %]))
(LEFTPAREN.RC (PROG ((PARENCOUNT 1))
PRN (SELECTC (SKREADC RRPTR STRM RDTBL)
(LEFTBRACKET.RC
(SKBRACKET STRM RDTBL))
(RIGHTBRACKET.RC
(RETURN (QUOTE %])))
(LEFTPAREN.RC (add PARENCOUNT 1))
(RIGHTPAREN.RC (COND
((EQ 0 (SETQ PARENCOUNT (SUB1
PARENCOUNT
)))
(RETURN))))
(STRINGDELIM.RC
(until (EQ STRINGDELIM.RC (SKREADC RRPTR STRM
RDTBL))))
NIL)
(GO PRN)))
(RIGHTPAREN.RC (QUOTE %)))
(SEPRCHAR.RC (GO TOP))
(BREAKCHAR.RC NIL)
(STRINGDELIM.RC
(until (EQ STRINGDELIM.RC (SKREADC RRPTR STRM RDTBL))))
(OTHER.RC (* Only macros and others left.
If necessary, the file will be backed
up so that the terminating character
can be re-read)
(while (EQ OTHER.RC (SKREADC RRPTR STRM RDTBL)))
(OR RRPTR (\BACKCHAR STRM))
NIL)
(COND
(SNX
(* SKREADC returns a skip-function or NIL for macros.
This is a kludge that follows the pdp-10 implementation.
Note, for example, that macro-contexts are not handled properly.)
(AND (SETQ REREADSTRING (APPLY* SNX (fetch (STREAM FULLNAME)
of STRM)
RDTBL REREADSTRING))
(GO TOP)))
(RRPTR (* Reading from the rereadstring and a
top level MACRO found.
For right now, bomb out, fix it up
later.)
(while (EQ OTHER.RC (SKREADC RRPTR STRM RDTBL))))
(T (\BACKCHAR STRM)
(READ STRM RDTBL)
NIL)))))))
(SKBRACKET
[LAMBDA (STRM RDTBL) (* rmk: "26-Mar-85 21:36")
(PROG ((BRACKETCOUNT 1))
BRKT
(SELECTC (SKREADC RRPTR STRM RDTBL)
(LEFTBRACKET.RC
(add BRACKETCOUNT 1))
(RIGHTBRACKET.RC
(COND
((EQ 0 (SETQ BRACKETCOUNT (SUB1 BRACKETCOUNT)))
(RETURN))))
(STRINGDELIM.RC
(until (EQ STRINGDELIM.RC (SKREADC RRPTR STRM RDTBL))))
NIL)
(GO BRKT])
(SKREADC
[LAMBDA (USERRPTRFLG STRM RDTBL) (* rmk: " 4-Apr-85 11:40")
(* Returns the syntax class for non-macro characters, and the a skipfn or NIL
for macros. -
USERRPTRFLG is actually the RRPTR of the caller.
Free variable lookup done only when using the re-read string, which is rare.)
(PROG (SNX CHAR)
[COND
(USERRPTRFLG [SETQ CHAR (NTHCHARCODE REREADSTRING (PROG1 RRPTR (add RRPTR 1]
(COND
((NULL CHAR) (* Set the free variable that all
callers use to pass in the string, and
fall thru to the file case)
(SETQ RRPTR NIL))
((EQ (SETQ SNX (\SYNCODE (fetch READSA of RDTBL)
CHAR))
ESCAPE.RC)
[AND (fetch ESCAPEFLG of RDTBL)
(COND
([NULL (NTHCHARCODE REREADSTRING (PROG1 RRPTR (add RRPTR 1]
(SETQ RRPTR NIL)
(\INCCODE STRM] (* Treat escape as other if escapeflg
is NIL)
(RETURN OTHER.RC))
[(fetch MACROP of SNX) (* A macro--return either the
associated skip-function or NIL.
(could be SNX instead of NIL, but who
cares?))
(RETURN (AND [LITATOM (SETQ CHAR (fetch MACROFN of (\GETREADMACRODEF CHAR
RDTBL]
(GETPROP CHAR (QUOTE SKREAD]
(T (RETURN SNX]
(SETQ CHAR (\INCCODE STRM))
(SETQ SNX (\SYNCODE (fetch READSA of RDTBL)
CHAR))
(RETURN (COND
((EQ SNX ESCAPE.RC)
(AND (fetch ESCAPEFLG of RDTBL)
(\INCCODE STRM))
(* The effect is that the character following the %% is treated as what skreadc
read, but special interpretation is suppresed.
We could read another character, e.g. when encountering %(FOO we could return
with CHAR corresponding to F, but if we were to do this, then we probaby should
also have SKREADC simply filter out all non--breaks and separators as well as
handle escape characters. basically, feels better to have one call to skreadc
correspond to each character.)
OTHER.RC)
[(fetch MACROP of SNX) (* Macro)
(AND [LITATOM (SETQ CHAR (fetch MACROFN of (\GETREADMACRODEF CHAR RDTBL]
(GETPROP CHAR (QUOTE SKREAD]
(T SNX])
)
[DECLARE: DONTEVAL@LOAD DOEVAL@COMPILE DONTCOPY
(BLOCK: SKREAD SKREAD SKBRACKET SKREADC)
]
(DEFINEQ
(FILEPOS
[LAMBDA (STR FILE START END SKIP TAIL CASEARRAY) (* bvm: "28-Mar-86 12:51")
(* NB this function now works on
non-PAGEMAPPED files.
It must use only IO functions that
respect that.)
(PROG ((SKIPCHAR (AND SKIP (CHCON1 SKIP)))
[CA (fetch (ARRAYP BASE) of (COND
[CASEARRAY (COND
((AND (ARRAYP CASEARRAY)
(EQ (fetch (ARRAYP TYP) of CASEARRAY)
\ST.BYTE))
CASEARRAY)
(T (CASEARRAY CASEARRAY]
(T \TRANSPARENT]
(STREAM (\GETSTREAM FILE (QUOTE INPUT)))
CHAR FIRSTCHAR STRBASE STRINDEX PATLEN PATINDEX ORGFILEPTR LASTINDEX STARTBYTE ENDBYTE
BIGENDBYTE STARTSEG ENDSEG)
[COND
((LITATOM STR)
(SETQ STRBASE (fetch (LITATOM PNAMEBASE) of STR))
(SETQ STRINDEX 1)
(SETQ PATLEN (fetch (LITATOM PNAMELENGTH) of STR)))
(T (OR (STRINGP STR)
(SETQ STR (MKSTRING STR)))
(SETQ STRBASE (fetch (STRINGP BASE) of STR))
(SETQ STRINDEX (fetch (STRINGP OFFST) of STR))
(SETQ PATLEN (fetch (STRINGP LENGTH) of STR] (* calculate start addr and set file
ptr.)
[SETQ STARTBYTE (COND
(START (COND
((NOT (AND (FIXP START)
(IGEQ START 0)))
(LISPERROR "ILLEGAL ARG" START)))
(SETQ ORGFILEPTR (\GETFILEPTR STREAM))
(\SETFILEPTR STREAM START)
START)
(T (SETQ ORGFILEPTR (\GETFILEPTR STREAM]
(* calculate the character address of
the character after the last possible
match.)
[SETQ ENDBYTE (ADD1 (COND
((NULL END) (* Default is end of file)
(IDIFFERENCE (\GETEOFPTR STREAM)
PATLEN))
((IGEQ END 0) (* Absolute byte pointer given)
(IMIN END (IDIFFERENCE (\GETEOFPTR STREAM)
PATLEN)))
((IGREATERP PATLEN (IMINUS END))
(* END is too far, use eof less length)
(IDIFFERENCE (\GETEOFPTR STREAM)
PATLEN))
(T (IDIFFERENCE (IPLUS (\GETEOFPTR STREAM)
END 1)
PATLEN] (* use STARTBYTE and ENDBYTE instead
of START and END because vm functions
shouldn't change their arguments.)
(COND
((IGEQ STARTBYTE ENDBYTE) (* nothing to search)
(GO FAILED)))
(SETQ LASTINDEX PATLEN)
SKIPLP
(* set the first character to
FIRSTCHAR, handling leading skips.)
(COND
((EQ LASTINDEX 0) (* null case)
(GO FOUNDIT))
((EQ (SETQ FIRSTCHAR (\GETBASEBYTE CA (\GETBASEBYTE STRBASE STRINDEX)))
SKIPCHAR) (* first character in pattern is skip.)
(SETQ LASTINDEX (SUB1 LASTINDEX))
(\BIN STREAM) (* Move forward a character.)
(add STRINDEX 1)
(add STARTBYTE 1)
(GO SKIPLP)))
(SETQ LASTINDEX (IPLUS LASTINDEX STRINDEX)) (* Used for end of pattern check,
comparing against current INDEX)
[COND
((SMALLP ENDBYTE)
(SETQ STARTSEG (SETQ ENDSEG 0)))
(T
(* The search will be in the large integers at least part of the time, so split
the start and end fileptrs into hi and lo parts.
The "segment" size we choose is smaller than 2↑16 so that we are still smallp
near the boundary (can get around that here by decrementing everyone, but can't
in FFILEPOS)%. Note that STARTBYTE and ENDBYTE are never actually used as file
ptrs, just for counting.)
(SETQ ENDSEG (FOLDLO ENDBYTE FILEPOS.SEGMENT.SIZE))
(SETQ BIGENDBYTE (IMOD ENDBYTE FILEPOS.SEGMENT.SIZE))
(SETQ STARTSEG (FOLDLO STARTBYTE FILEPOS.SEGMENT.SIZE))
(SETQ STARTBYTE (IMOD STARTBYTE FILEPOS.SEGMENT.SIZE))
(SETQ ENDBYTE (COND
((EQ STARTSEG ENDSEG)
BIGENDBYTE)
(T
(* In different segments, so we'll have to search all the way to the end of
this seg; hence, "end" is currently as big as it gets)
FILEPOS.SEGMENT.SIZE]
FIRSTCHARLP
(* STARTBYTE is the possible beginning of a match.
the file ptr of the file is always at STARTBYTE position when the FIRSTCHAR
loop is passed.)
(COND
((EQ STARTBYTE ENDBYTE) (* end of this part of search)
(COND
((EQ STARTSEG ENDSEG) (* failed)
(GO FAILED))) (* Finished this segment, roll over
into new one)
(SETQ STARTBYTE 0) (* = STARTBYTE-FILEPOS.SEGMENT.SIZE)
[COND
((EQ (add STARTSEG 1)
ENDSEG) (* Entering final segment, so set
ENDBYTE to actual end instead of
segment end)
(COND
((EQ (SETQ ENDBYTE BIGENDBYTE)
0)
(GO FAILED]
(GO FIRSTCHARLP))
((NEQ FIRSTCHAR (\GETBASEBYTE CA (\BIN STREAM)))
(add STARTBYTE 1)
(GO FIRSTCHARLP)))
(SETQ PATINDEX STRINDEX)
MATCHLP
(* At this point, STR is matched thru
offset PATINDEX)
(COND
((EQ (SETQ PATINDEX (ADD1 PATINDEX))
LASTINDEX) (* matched for entire length)
(GO FOUNDIT))
((OR (EQ (SETQ CHAR (\GETBASEBYTE CA (\GETBASEBYTE STRBASE PATINDEX)))
(\GETBASEBYTE CA (\BIN STREAM)))
(EQ CHAR SKIPCHAR)) (* Char from file matches char from
STR)
(GO MATCHLP))
(T (* Match failed, so we have to start
again with first char)
(\SETFILEPTR STREAM (IDIFFERENCE (\GETFILEPTR STREAM)
(IDIFFERENCE PATINDEX STRINDEX)))
(* Back up over the chars we have just read in trying to match, less one.
I.e. go back to one past the previous starting point)
(add STARTBYTE 1)
(GO FIRSTCHARLP)))
FOUNDIT
(* set fileptr, adjust for beginning
skips and return proper value.)
[COND
((NOT TAIL) (* Fileptr wants to be at start of
string)
(\SETFILEPTR STREAM (IDIFFERENCE (\GETFILEPTR STREAM)
PATLEN]
(RETURN (\GETFILEPTR STREAM))
FAILED
(* return the fileptr to its initial
position.)
(\SETFILEPTR STREAM ORGFILEPTR)
(RETURN NIL])
(FFILEPOS
[LAMBDA (PATTERN FILE START END SKIP TAIL CASEARRAY) (* rmk: " 2-Apr-85 11:33")
(PROG ([OFD (\GETOFD (OR FILE (INPUT]
PATBASE PATOFFSET PATLEN ORGFILEPTR STARTOFFSET ENDOFFSET BIGENDOFFSET STARTSEG ENDSEG EOF
)
(COND
(SKIP (* Slow case--use FILEPOS)
(GO TRYFILEPOS))
((NOT (fetch PAGEMAPPED of (fetch DEVICE of OFD)))
(* This is a non-page-oriented file.
Use FILEPOS instead.)
(GO TRYFILEPOS))) (* calculate start addr and set file
ptr.)
[COND
((LITATOM PATTERN)
(SETQ PATBASE (fetch (LITATOM PNAMEBASE) of PATTERN))
(SETQ PATOFFSET 1)
(SETQ PATLEN (fetch (LITATOM PNAMELENGTH) of PATTERN)))
(T (OR (STRINGP PATTERN)
(SETQ PATTERN (MKSTRING PATTERN)))
(SETQ PATBASE (fetch (STRINGP BASE) of PATTERN))
(SETQ PATOFFSET (fetch (STRINGP OFFST) of PATTERN))
(SETQ PATLEN (fetch (STRINGP LENGTH) of PATTERN]
(COND
((OR (IGREATERP PATLEN \MAX.PATTERN.SIZE)
(ILESSP PATLEN \MIN.PATTERN.SIZE))
(GO TRYFILEPOS)))
(SETQ ORGFILEPTR (\GETFILEPTR OFD))
(SETQ STARTOFFSET (IPLUS (COND
(START (COND
((NOT (AND (FIXP START)
(IGEQ START 0)))
(LISPERROR "ILLEGAL ARG" START)))
START)
(T ORGFILEPTR))
(SUB1 PATLEN))) (* STARTOFFSET is the address of the
character corresponding to the last
character of PATTERN.)
(SETQ EOF (\GETEOFPTR OFD)) (* calculate the character address of
the character after the last possible
match.)
[SETQ ENDOFFSET (COND
((NULL END) (* Default is end of file)
EOF)
(T (IMIN (IPLUS (COND
((ILESSP END 0)
(IPLUS EOF END 1))
(T END))
PATLEN)
EOF] (* use STARTOFFSET and ENDOFFSET
instead of START and END because vm
functions shouldn't change their
arguments.)
(COND
((IGEQ STARTOFFSET ENDOFFSET) (* nothing to search)
(RETURN))
((ILESSP (IDIFFERENCE ENDOFFSET STARTOFFSET)
\MIN.SEARCH.LENGTH) (* too small to make FFILEPOS
worthwhile)
(GO TRYFILEPOS)))
(\SETFILEPTR OFD STARTOFFSET)
[RETURN (GLOBALRESOURCE
(\FFDELTA1 \FFDELTA2 \FFPATCHAR)
(PROG ([CASE (fetch (ARRAYP BASE)
of (COND
[CASEARRAY (COND
((AND (ARRAYP CASEARRAY)
(EQ (fetch (ARRAYP TYP) of CASEARRAY)
\ST.BYTE))
CASEARRAY)
(T (CASEARRAY CASEARRAY]
(T \TRANSPARENT]
(DELTA1 (fetch (ARRAYP BASE) of \FFDELTA1))
(DELTA2 (fetch (ARRAYP BASE) of \FFDELTA2))
(PATCHAR (fetch (ARRAYP BASE) of \FFPATCHAR))
(MAXPATINDEX (SUB1 PATLEN))
CHAR CURPATINDEX LASTCHAR INC)
(* Use Boyer-Moore string search algorithm.
Use two auxiliary tables, DELTA1 and DELTA2, to tell how far ahead to move in
the file when a partial match fails. DELTA1 contains, for each character code,
the distance of that character from the right end of the pattern, or PATLEN if
the character does not occur in the pattern.
DELTA2 contains, for each character position in the pattern, how far ahead to
move such that the partial substring discovered to the right of the position
now matches some other substring (to the left) in the pattern.
PATCHAR is just PATTERN translated thru CASEARRAY)
(\SETUP.FFILEPOS PATBASE PATOFFSET PATLEN PATCHAR DELTA1 DELTA2 CASE)
[COND
((SMALLP ENDOFFSET)
(SETQ STARTSEG (SETQ ENDSEG 0)))
(T
(* The search will be in the large integers at least part of the time, so split
the start and end fileptrs into hi and lo parts.
The "segment" size we choose is smaller than 2↑16 so that we are still smallp
near the boundary. Note that STARTOFFSET and ENDOFFSET are never actually used
as file ptrs, just for counting.)
(SETQ ENDSEG (FOLDLO ENDOFFSET FILEPOS.SEGMENT.SIZE))
(SETQ BIGENDOFFSET (MOD ENDOFFSET FILEPOS.SEGMENT.SIZE))
(SETQ STARTSEG (FOLDLO STARTOFFSET FILEPOS.SEGMENT.SIZE))
(SETQ STARTOFFSET (MOD STARTOFFSET FILEPOS.SEGMENT.SIZE))
(SETQ ENDOFFSET (COND
((EQ STARTSEG ENDSEG)
BIGENDOFFSET)
(T
(* In different segments, so we'll have to search all the way to the end of
this seg; hence, "end" is currently as big as it gets)
FILEPOS.SEGMENT.SIZE]
(SETQ LASTCHAR (GETBASEBYTE PATCHAR MAXPATINDEX))
FIRSTCHARLP
(COND
[(IGEQ STARTOFFSET ENDOFFSET) (* End of this chunk)
(COND
((EQ STARTSEG ENDSEG) (* failed)
(GO FAILED))
(T (* Finished this segment, roll over
into new one)
(add STARTSEG 1)
(SETQ STARTOFFSET (IDIFFERENCE STARTOFFSET FILEPOS.SEGMENT.SIZE))
(COND
((EQ STARTSEG ENDSEG)
(SETQ ENDOFFSET BIGENDOFFSET)))
(GO FIRSTCHARLP]
((NEQ (SETQ CHAR (GETBASEBYTE CASE (\BIN OFD)))
LASTCHAR)
(add STARTOFFSET (SETQ INC (GETBASEBYTE DELTA1 CHAR)))
(OR (EQ INC 1)
(\INCFILEPTR OFD (SUB1 INC)))
(* advance file pointer accordingly
(\BIN already advanced it one))
(GO FIRSTCHARLP)))
(SETQ CURPATINDEX (SUB1 MAXPATINDEX))
MATCHLP
(COND
((ILESSP CURPATINDEX 0)
(GO FOUNDIT)))
(\DECFILEPTR OFD 2) (* back up to read previous char)
(COND
((NEQ (SETQ CHAR (GETBASEBYTE CASE (\BIN OFD)))
(GETBASEBYTE PATCHAR CURPATINDEX))
(* Mismatch, advance by greater of
delta1 and delta2)
(add STARTOFFSET (IDIFFERENCE (SETQ INC (IMAX (GETBASEBYTE DELTA1 CHAR)
(GETBASEBYTE DELTA2
CURPATINDEX)))
(IDIFFERENCE MAXPATINDEX CURPATINDEX)))
(OR (EQ INC 1)
(\INCFILEPTR OFD (SUB1 INC)))
(GO FIRSTCHARLP)))
(SETQ CURPATINDEX (SUB1 CURPATINDEX))
(GO MATCHLP)
FOUNDIT
(* set fileptr, adjust for beginning
skips and return proper value.)
(\INCFILEPTR OFD (COND
(TAIL (* Put fileptr at end of string)
(SUB1 PATLEN))
(T (* back up over the last char we
looked at, i.e. the first char of
string)
-1)))
(RETURN (\GETFILEPTR OFD))
FAILED
(* return the fileptr to its initial
position.)
(\SETFILEPTR OFD ORGFILEPTR)
(RETURN NIL]
TRYFILEPOS
(RETURN (FILEPOS PATTERN OFD START END SKIP TAIL CASEARRAY])
(\SETUP.FFILEPOS
[LAMBDA (PATBASE PATOFFSET PATLEN PATCHAR DELTA1 DELTA2 CASE)
(* rmk: " 2-Apr-85 11:23")
(* * Set up PATCHAR, DELTA1 and DELTA2 arrays from string.
This is a separate function currently so I can gather stats on it)
(PROG ((PATLEN,PATLEN (IPLUS (LLSH PATLEN BITSPERBYTE)
PATLEN))
(MAXPATINDEX (SUB1 PATLEN))
CHAR)
(for I from 0 to (FOLDLO \MAXCHAR BYTESPERWORD) do (PUTBASE DELTA1 I PATLEN,PATLEN))
(* DELTA1 initially all PATLEN, the
default for chars not in the pattern.
I assume array is word-aligned)
(for I from 0 to MAXPATINDEX do [PUTBASEBYTE PATCHAR I (SETQ CHAR
(GETBASEBYTE CASE
(GETBASEBYTE PATBASE
(IPLUS PATOFFSET I]
(* Translate STR now so we don't have
to do it repeatedly)
(PUTBASEBYTE DELTA1 CHAR (IDIFFERENCE MAXPATINDEX I))
(* DELTA1 = how far ahead to move when
we mismatch with this char))
(* * Now set up DELTA2. Scan pattern backwards.
For each character, we want to find the rightmost reoccurrence of the substring
consisting of the chars to the right of the current char.
This is slightly different than Boyer-Moore, in that we do not insist that it
be the rightmost reoccurrence that is not preceded by the current char.
Small difference, noticeable only in patterns that contain multiple occurrences
of tails of the pattern. The following loop calculates DELTA2 in almost the
obvious way, using the observation that DELTA2 is strictly increasing
(by our definition) as the pattern index decreases.
This algorithm is potentially quadratic, as it amounts to searching a string
(PATTERN, backwards) for a given substring in the "dumb" way;
fortunately, it is rarely so in practice for "normal" patterns)
(for P from (SUB1 MAXPATINDEX) to 0 by -1 bind LASTD2←1
LASTMATCHPOS←MAXPATINDEX
do (PUTBASEBYTE DELTA2 P
(SETQ LASTD2
(COND
([OR (IGEQ LASTD2 PATLEN)
(EQ (GETBASEBYTE PATCHAR (IDIFFERENCE MAXPATINDEX LASTD2))
(GETBASEBYTE PATCHAR (ADD1 P]
(* The last time around we matched a terminal substring somehow, and now the
next char matches the char before that substring, so DELTA2 is just one more,
i.e. the match continues. Once we've overflowed the pattern, the "match"
continues trivially)
(ADD1 LASTD2))
(T [do (SETQ LASTMATCHPOS (SUB1 LASTMATCHPOS))
repeatuntil (for I from MAXPATINDEX to (ADD1 P) by -1 as J
from LASTMATCHPOS to 0 by -1
always (EQ (GETBASEBYTE PATCHAR I)
(GETBASEBYTE PATCHAR J]
(* Substring from P+1 onward matches
substring that ends at LASTMATCHPOS)
(IPLUS (IDIFFERENCE MAXPATINDEX LASTMATCHPOS)
(IDIFFERENCE MAXPATINDEX P])
)
(DECLARE: EVAL@COMPILE DONTCOPY
(DECLARE: EVAL@COMPILE
(PUTDEF (QUOTE \FFDELTA1)
(QUOTE RESOURCES)
(QUOTE (NEW (ARRAY (ADD1 \MAXCHAR)
(QUOTE BYTE)))))
(PUTDEF (QUOTE \FFDELTA2)
(QUOTE RESOURCES)
(QUOTE (NEW (ARRAY \MAX.PATTERN.SIZE (QUOTE BYTE)))))
(PUTDEF (QUOTE \FFPATCHAR)
(QUOTE RESOURCES)
(QUOTE (NEW (ARRAY \MAX.PATTERN.SIZE (QUOTE BYTE)))))
)
(DECLARE: EVAL@COMPILE
(RPAQQ \MAX.PATTERN.SIZE 128)
(RPAQQ \MIN.PATTERN.SIZE 3)
(RPAQQ FILEPOS.SEGMENT.SIZE 32768)
(RPAQQ \MIN.SEARCH.LENGTH 100)
(CONSTANTS (\MAX.PATTERN.SIZE 128)
(\MIN.PATTERN.SIZE 3)
(FILEPOS.SEGMENT.SIZE 32768)
(\MIN.SEARCH.LENGTH 100))
)
)
(/SETTOPVAL (QUOTE \\FFDELTA1.GLOBALRESOURCE))
(/SETTOPVAL (QUOTE \\FFDELTA2.GLOBALRESOURCE))
(/SETTOPVAL (QUOTE \\FFPATCHAR.GLOBALRESOURCE))
(* DATE)
(DEFINEQ
(DATE
[LAMBDA (FORMAT) (* bvm: " 2-NOV-80 16:10")
(\OUTDATE (\UNPACKDATE)
FORMAT])
(DATEFORMAT
[NLAMBDA FORMAT (* bvm: "21-NOV-83 17:54")
(CONS (QUOTE DATEFORMAT)
FORMAT])
(GDATE
[LAMBDA (DATE FORMAT STRPTR) (* bvm: " 6-DEC-80 16:55")
(\OUTDATE (\UNPACKDATE DATE)
FORMAT STRPTR])
(IDATE
[LAMBDA (STR) (* bvm: "28-Jun-85 16:56")
(DECLARE (SPECVARS POS STR))
(COND
((NULL STR)
(DAYTIME))
(T (PROG ((POS 1)
MONTH DAY YEAR HOUR MINUTES SECONDS N1 N2 CH DLS TIMEZONE)
(OR (SETQ N1 (\IDATESCANTOKEN))
(RETURN))
(SELCHARQ (NTHCHARCODE STR POS)
((/ - SPACE)
(* Okay to put inside date)
(add POS 1))
NIL)
(OR (SETQ N2 (\IDATESCANTOKEN))
(RETURN))
(SELCHARQ (NTHCHARCODE STR POS)
((/ - SPACE ,)
(add POS 1))
NIL)
(OR (FIXP (SETQ YEAR (\IDATESCANTOKEN)))
(RETURN))
(COND
((ILESSP YEAR 100)
(add YEAR 1900))
((OR (ILESSP YEAR 1900)
(IGREATERP YEAR 2037))
(RETURN))) (* Now figure out day and month)
[COND
((FIXP N2) (* Must be month-day)
(SETQ DAY N2)
(SETQ MONTH N1))
(T (SETQ MONTH N2)
(SETQ DAY (OR (FIXP N1)
(RETURN]
[COND
[(FIXP MONTH)
(COND
((OR (EQ 0 MONTH)
(IGREATERP MONTH 12))
(RETURN]
(T (SETQ MONTH (SELECTQ MONTH
(JAN 1)
(FEB 2)
(MAR 3)
(APR 4)
(MAY 5)
(JUN 6)
(JUL 7)
(AUG 8)
(SEP 9)
(OCT 10)
(NOV 11)
(DEC 12)
(RETURN]
(COND
((OR (EQ 0 DAY)
(IGREATERP DAY (SELECTQ MONTH
((1 3 5 7 8 10 12)
31)
(2 (COND
((EQ 0 (IREMAINDER YEAR 4))
29)
(T 28)))
30)))
(RETURN))) (* Now scan time)
(OR (FIXP (SETQ HOUR (\IDATESCANTOKEN)))
(RETURN))
[COND
[(EQ (SETQ CH (NTHCHARCODE STR POS))
(CHARCODE :))
(add POS 1)
(OR (FIXP (SETQ MINUTES (\IDATESCANTOKEN)))
(RETURN))
(COND
((EQ (SETQ CH (NTHCHARCODE STR POS))
(CHARCODE :))
(add POS 1)
(OR (FIXP (SETQ SECONDS (\IDATESCANTOKEN)))
(RETURN))
(SETQ CH (NTHCHARCODE STR POS]
(T (* break apart time given without
colon)
(SETQ MINUTES (IREMAINDER HOUR 100))
(SETQ HOUR (IQUOTIENT HOUR 100]
[COND
(CH (SELCHARQ CH
((A P a p)
(* AM or PM appended)
(SELCHARQ (NTHCHARCODE STR (ADD1 POS))
((M m)
[SELCHARQ CH
((P p)
(COND
((ILESSP HOUR 12)
(add HOUR 12))))
(COND
((EQ HOUR 12)
(add HOUR -12))
((IGREATERP HOUR 12)
(RETURN])
NIL))
((SPACE -)
[COND
((SETQ TIMEZONE (\IDATESCANTOKEN))
(SETQ TIMEZONE
(for X in TIME.ZONES
do (COND
((EQ (CDR X)
TIMEZONE)
(RETURN (CAR X)))
((AND (EQ (NTHCHAR TIMEZONE 1)
(CDR X))
(EQ (NTHCHAR TIMEZONE 3)
(QUOTE T)))
(SELECTQ (NTHCHAR TIMEZONE 2)
(D (* Daylight time, subtract 1 hour)
(RETURN (SUB1 (CAR X))))
(S (* Standard time)
(RETURN (CAR X)))
NIL])
(RETURN]
(COND
((OR (IGREATERP HOUR 23)
(IGREATERP MINUTES 59)
(AND SECONDS (IGREATERP SECONDS 59)))
(RETURN)))
(RETURN (\PACKDATE YEAR (SUB1 MONTH)
DAY HOUR MINUTES (OR SECONDS 0)
TIMEZONE])
(\IDATESCANTOKEN
[LAMBDA NIL (* bvm: "26-OCT-82 14:36")
(DECLARE (USEDFREE STR POS)) (* Returns next token in STR, starting
at POS. Is either a number or word.
Skips blanks)
(PROG (RESULT CH)
LP (SETQ CH (NTHCHARCODE STR POS))
(RETURN (COND
((NULL CH)
NIL)
((EQ CH (CHARCODE SPACE)) (* Skip leading spaces)
(add POS 1)
(GO LP))
((DIGITCHARP CH)
(SETQ RESULT (IDIFFERENCE CH (CHARCODE 0)))
[while (AND (SETQ CH (NTHCHARCODE STR (add POS 1)))
(DIGITCHARP CH)) do (SETQ RESULT (IPLUS (ITIMES RESULT 10)
(IDIFFERENCE CH
(CHARCODE 0]
RESULT)
((ALPHACHARP CH)
(PACKC (CONS (UCASECODE CH)
(while (AND (SETQ CH (NTHCHARCODE STR (add POS 1)))
(ALPHACHARP CH)) collect (UCASECODE CH])
(\OUTDATE
[LAMBDA (UD FORMAT STRING) (* bvm: "28-Jun-85 17:23")
(PROG ((TIME (CDDDR UD))
(SEPR (CHARCODE -))
YEAR SIZE DAY MONTH S N NO.DATE NO.TIME NO.LEADING.SPACES TIME.ZONE TIME.ZONE.LENGTH
YEAR.LENGTH MONTH.LENGTH NO.SECONDS NUMBER.OF.MONTH YEAR.LONG DAY.OF.WEEK DAY.SHORT)
[COND
((NOT FORMAT)
NIL)
((NEQ (CAR (LISTP FORMAT))
(QUOTE DATEFORMAT))
(LISPERROR "ILLEGAL ARG" FORMAT))
(T (for TOKEN in FORMAT do (SELECTQ TOKEN
(NO.DATE (SETQ NO.DATE T))
(NO.TIME (SETQ NO.TIME T))
(NUMBER.OF.MONTH
(SETQ NUMBER.OF.MONTH T))
(YEAR.LONG (SETQ YEAR.LONG T))
(SLASHES (SETQ SEPR (CHARCODE /)))
(SPACES (SETQ SEPR (CHARCODE SPACE)))
(NO.LEADING.SPACES
(SETQ NO.LEADING.SPACES T))
(TIME.ZONE (SETQ TIME.ZONE (CDR (ASSOC \TimeZoneComp
TIME.ZONES))))
(NO.SECONDS (SETQ NO.SECONDS T))
(DAY.OF.WEEK (SETQ DAY.OF.WEEK T))
(DAY.SHORT (SETQ DAY.SHORT T))
NIL]
[SETQ SIZE
(IPLUS (COND
(NO.DATE 0)
(T (IPLUS (SETQ YEAR.LENGTH (COND
((IGREATERP (SETQ YEAR (CAR UD))
1999)
(SETQ YEAR.LONG T)
4)
(YEAR.LONG 4)
(T (SETQ YEAR (IREMAINDER YEAR 100))
2)))
(COND
((AND (ILESSP (SETQ DAY (CADDR UD))
10)
NO.LEADING.SPACES)
1)
(T 2))
(PROGN (SETQ MONTH (ADD1 (CADR UD)))
(COND
[NUMBER.OF.MONTH (SETQ MONTH.LENGTH
(COND
((AND NO.LEADING.SPACES
(ILESSP MONTH 10))
1)
(T 2]
(T 3)))
(COND
[DAY.OF.WEEK [SETQ DAY.OF.WEEK
(CAR (NTH (QUOTE ("Monday" "Tuesday" "Wednesday"
"Thursday" "Friday"
"Saturday" "Sunday"))
(ADD1 (CAR (CDDDDR TIME]
(IPLUS 3 (SETQ DAY.SHORT (COND
(DAY.SHORT (SETQ DAY.OF.WEEK
(SUBSTRING
DAY.OF.WEEK 1
3))
3)
(T (NCHARS DAY.OF.WEEK]
(T 0))
2)))
(COND
(NO.TIME 0)
(T (IPLUS (COND
(NO.DATE 5)
(T 6))
(COND
(NO.SECONDS 0)
(T 3))
(COND
((NULL TIME.ZONE)
0)
((EQ (SETQ TIME.ZONE.LENGTH (NCHARS TIME.ZONE))
1)
4)
(T (ADD1 TIME.ZONE.LENGTH]
(SETQ S (ALLOCSTRING SIZE (CHARCODE SPACE)))
(COND
[(NOT NO.DATE)
(\RPLRIGHT S (SETQ N (COND
((AND NO.LEADING.SPACES (ILESSP DAY 10))
1)
(T 2)))
DAY 1)
(RPLCHARCODE S (add N 1)
SEPR)
(COND
(NUMBER.OF.MONTH (\RPLRIGHT S (add N MONTH.LENGTH)
MONTH MONTH.LENGTH))
(T (RPLSTRING S (ADD1 N)
(CAR (NTH (QUOTE ("Jan" "Feb" "Mar" "Apr" "May" "Jun" "Jul" "Aug" "Sep"
"Oct" "Nov" "Dec"))
MONTH)))
(add N 3)))
(RPLCHARCODE S (add N 1)
SEPR)
(\RPLRIGHT S (add N YEAR.LENGTH)
YEAR 2)
(OR NO.TIME (add N 1))
(COND
(DAY.OF.WEEK (* Day of week at very end in parens)
(RPLCHARCODE S (SUB1 (IDIFFERENCE SIZE DAY.SHORT))
(CHARCODE "("))
(RPLSTRING S (IDIFFERENCE SIZE DAY.SHORT)
DAY.OF.WEEK)
(RPLCHARCODE S SIZE (CHARCODE ")"]
(T (SETQ N 0)))
[COND
((NOT NO.TIME)
(\RPLRIGHT S (IPLUS N 2)
(CAR TIME)
2)
(RPLCHARCODE S (IPLUS N 3)
(CHARCODE :))
(\RPLRIGHT S (add N 5)
(CADR TIME)
2)
(COND
((NOT NO.SECONDS)
(RPLCHARCODE S (ADD1 N)
(CHARCODE :))
(\RPLRIGHT S (add N 3)
(CADDR TIME)
2)))
(COND
(TIME.ZONE (RPLSTRING S (IPLUS N 2)
TIME.ZONE)
(COND
((EQ TIME.ZONE.LENGTH 1) (* Fill in daylight or standard)
(RPLSTRING S (IPLUS N 3)
(COND
((CADDDR TIME)
"DT")
(T "ST"]
(RETURN (COND
(STRING (SUBSTRING S 1 -1 STRING))
(T S])
(\RPLRIGHT
[LAMBDA (S AT N MINDIGITS) (* bvm: "21-NOV-83 17:19")
(RPLCHARCODE S AT (IPLUS (CHARCODE 0)
(IREMAINDER N 10)))
(COND
((OR (IGREATERP MINDIGITS 1)
(IGEQ N 10))
(\RPLRIGHT S (SUB1 AT)
(IQUOTIENT N 10)
(SUB1 MINDIGITS])
(\UNPACKDATE
[LAMBDA (D) (* bvm: "28-Jun-85 18:07")
(* Converts an internal Lisp date D into a list of integers
(Year Month Day Hours Minutes Seconds daylightp DayOfWeek)%.
D defaults to current date. -
DayOfWeek is zero for Monday -
-
D is first converted to the alto standard, a 32-bit unsigned integer,
representing the number of seconds since jan 1, 1901-Gmt.
We have to be a little tricky in our computations to avoid the sign bit.)
(SETQ D (OR D (DAYTIME)))
(PROG ((CHECKDLS \DayLightSavings)
(DQ (IQUOTIENT (LOGAND MAX.FIXP (LRSH (LISP.TO.ALTO.DATE D)
1))
30))
MONTH SEC HR DAY4 YDAY WDAY YEAR4 TOTALDAYS MIN DLS)
(* DQ is number of minutes since day
0, getting us past the sign bit
problem.)
(SETQ SEC (IMOD [IPLUS D (CONSTANT (IDIFFERENCE 60 (IMOD MIN.FIXP 60]
60))
(SETQ MIN (IREMAINDER DQ 60))
(* No we can adjust to the current time zone.
Since this might cause DQ to go negative, first add in 4 years worth of hours,
making the base date be Jan 1, 1897)
(SETQ HR (IREMAINDER (SETQ DQ (IDIFFERENCE (IPLUS (IQUOTIENT DQ 60)
(CONSTANT (ITIMES 24 \4YearsDays)))
\TimeZoneComp))
24))
(SETQ TOTALDAYS (IQUOTIENT DQ 24))
DTLOOP
(SETQ DAY4 (IREMAINDER TOTALDAYS \4YearsDays)) (* DAY4 = number of days since last
leap year day 0)
[SETQ DAY4 (IPLUS DAY4 (CDR (\DTSCAN DAY4 (QUOTE ((789 . 3)
(424 . 2)
(59 . 1)
(0 . 0]
(* pretend every year is a leap year,
adding one for days after Feb 28)
(SETQ YEAR4 (IQUOTIENT TOTALDAYS \4YearsDays)) (* YEAR4 = number of years til that
last leap year / 4)
(SETQ YDAY (IREMAINDER DAY4 366)) (* YDAY is the ordinal day in the year
(jan 1 = zero))
(SETQ WDAY (IREMAINDER (IPLUS TOTALDAYS 3)
7))
[COND
((AND CHECKDLS (SETQ DLS (\ISDST? YDAY HR WDAY)))
(* This date is during daylight savings, so add 1 hour.
Third arg is day of the week, which we determine by taking days mod 7 plus
offset. Monday = zero in this scheme. Jan 1 1897 was actually a Friday
(not Thursday=3), but we're cheating--1900 was not a leap year)
(COND
((IGREATERP (SETQ HR (ADD1 HR))
23)
(* overflowed into the next day. This case is too hard
(we might have overflowed the month, for example), so just go back and
recompute)
(SETQ TOTALDAYS (ADD1 TOTALDAYS))
(SETQ HR 0)
(SETQ CHECKDLS NIL)
(GO DTLOOP]
[SETQ MONTH (\DTSCAN YDAY (QUOTE ((335 . 11)
(305 . 10)
(274 . 9)
(244 . 8)
(213 . 7)
(182 . 6)
(152 . 5)
(121 . 4)
(91 . 3)
(60 . 2)
(31 . 1)
(0 . 0] (* Now return year, month, day, hr,
min, sec)
(RETURN (LIST (IPLUS 1897 (ITIMES YEAR4 4)
(IQUOTIENT DAY4 366))
(CDR MONTH)
(ADD1 (IDIFFERENCE YDAY (CAR MONTH)))
HR MIN SEC DLS WDAY])
(\PACKDATE
[LAMBDA (YR MONTH DAY HR MIN SEC TIMEZONE) (* bvm: "27-Jan-86 17:36")
(* Packs indicated date into a single
integer in Lisp date format.
Returns NIL on errors.)
(PROG (YDAY DAYSSINCEDAY0)
(COND
((NOT (AND YR MONTH DAY HR MIN SEC))
(RETURN)))
(SETQ DAYSSINCEDAY0 (IPLUS (SETQ YDAY (IPLUS (COND
((AND (IGREATERP MONTH 1)
(EQ 0 (IREMAINDER YR 4))
(NEQ YR 1900))
(* After Feb 28 of a leap year)
1)
(T 0))
(SELECTQ MONTH
(0 0)
(1 31)
(2 59)
(3 90)
(4 120)
(5 151)
(6 181)
(7 212)
(8 243)
(9 273)
(10 304)
(11 334)
NIL)
(SUB1 DAY)))
(ITIMES 365 (SETQ YR (IDIFFERENCE YR 1901)))
(IQUOTIENT YR 4)))
(COND
((OR (LESSP DAYSSINCEDAY0 -1)
(LESSP (add HR (ITIMES 24 DAYSSINCEDAY0)
(COND
(TIMEZONE)
((AND \DayLightSavings (\ISDST? YDAY HR (IREMAINDER (IPLUS
DAYSSINCEDAY0
1)
7)))
(* Subtract one to go from daylight to standard time.
This time we computed weekday based on day 0 = Jan 1, 1901, which was a Tuesday
= 1)
(SUB1 \TimeZoneComp))
(T \TimeZoneComp)))
0)) (* Earlier than day 0 --
second check is needed because day 0
west of GMT is sometime during Dec 31,
1900)
(RETURN)))
(RETURN (IPLUS SEC (PROGN
(* Add the seconds to the converted date, rather than the raw one, and use LLSH
instead of multiplying by 60, to avoid creating a bignum)
(ALTO.TO.LISP.DATE (LLSH (ITIMES 30 (IPLUS MIN (ITIMES 60 HR)))
1])
(\DTSCAN
[LAMBDA (X L) (* lmm: 22 NOV 75 1438)
(PROG NIL
LP (COND
((IGREATERP (CAAR L)
X)
(SETQ L (CDR L))
(GO LP)))
(RETURN (CAR L])
(\ISDST?
[LAMBDA (YDAY HOUR WDAY) (* bvm: " 2-NOV-80 15:35")
(* Returns true if YDAY, HOUR is
during the daylight savings period.
WDAY is day of week, zero = Monday.)
(AND (\CHECKDSTCHANGE YDAY HOUR WDAY \BeginDST)
(NOT (\CHECKDSTCHANGE YDAY HOUR WDAY \EndDST])
(\CHECKDSTCHANGE
[LAMBDA (YDAY HOUR WDAY DSTDAY) (* bvm: " 2-NOV-80 15:34")
(* Tests to see if YDAY, HOUR is after the start of daylight
(or standard) time. WDAY is the day of the week, Monday=zero.
DSTDAY is the last day of the month in which time changes, as a YDAY, usually
Apr 30 or Oct 31)
(COND
((IGREATERP YDAY DSTDAY) (* Day is in the next month already)
T)
((ILESSP YDAY (IDIFFERENCE DSTDAY 6)) (* day is at least a week before end
of month, so time hasn't changed yet)
NIL)
((EQ WDAY 6)
(* It's Sunday, so time changes today at 2am.
Check for hour being past that. Note that there is a hopeless ambiguity when
the time is between 1:00 and 2:00 am the day that DST goes into effect, as that
hour happens twice)
(IGREATERP HOUR 1))
(T (* okay if last Monday
(YDAY-WDAY) is less than a week before
end of month)
(IGREATERP (IDIFFERENCE YDAY WDAY)
(IDIFFERENCE DSTDAY 6])
)
(DEFOPTIMIZER DATEFORMAT (&REST X) (KWOTE (CONS (QUOTE DATEFORMAT)
X)))
(RPAQ? \TimeZoneComp 8)
(RPAQ? \BeginDST 120)
(RPAQ? \EndDST 304)
(RPAQ? \DayLightSavings T)
(ADDTOVAR TIME.ZONES (8 . P)
(7 . M)
(6 . C)
(5 . E)
(0 . GMT))
(DECLARE: EVAL@COMPILE DONTCOPY
(DECLARE: DOEVAL@COMPILE DONTCOPY
(GLOBALVARS \TimeZoneComp \BeginDST \EndDST \DayLightSavings TIME.ZONES)
)
(DECLARE: EVAL@COMPILE
(RPAQ \4YearsDays (ADD1 (ITIMES 365 4)))
(CONSTANTS (\4YearsDays (ADD1 (ITIMES 365 4))))
)
)
(DECLARE: DOEVAL@COMPILE DONTCOPY
(LOCALVARS . T)
)
(PUTPROPS IOCHAR FILETYPE COMPILE-FILE)
(DECLARE: DONTEVAL@LOAD DOEVAL@COMPILE DONTCOPY COMPILERVARS
(ADDTOVAR NLAMA DATEFORMAT)
(ADDTOVAR NLAML )
(ADDTOVAR LAMA PACK* CONCAT)
)
(PUTPROPS IOCHAR COPYRIGHT ("Xerox Corporation" 1981 1982 1983 1984 1985 1986))
(DECLARE: DONTCOPY
(FILEMAP (NIL (3385 9900 (CHCON 3395 . 4817) (UNPACK 4819 . 6455) (DCHCON 6457 . 8076) (DUNPACK 8078
. 9898)) (9901 25239 (UALPHORDER 9911 . 10065) (ALPHORDER 10067 . 13549) (PACKC 13551 . 14306) (
CONCAT 14308 . 15335) (PACK 15337 . 16433) (PACK* 16435 . 17509) (\PACK.ITEM 17511 . 18213) (STRPOS
18215 . 25237)) (25788 31151 (STRPOSL 25798 . 30347) (MAKEBITTABLE 30349 . 31149)) (31356 32166 (
CASEARRAY 31366 . 31698) (UPPERCASEARRAY 31700 . 32164)) (32521 40790 (SKREAD 32531 . 36786) (
SKBRACKET 36788 . 37380) (SKREADC 37382 . 40788)) (40882 66428 (FILEPOS 40892 . 50762) (FFILEPOS 50764
. 62001) (\SETUP.FFILEPOS 62003 . 66426)) (67315 95118 (DATE 67325 . 67486) (DATEFORMAT 67488 . 67647
) (GDATE 67649 . 67827) (IDATE 67829 . 74469) (\IDATESCANTOKEN 74471 . 75957) (\OUTDATE 75959 . 83745)
(\RPLRIGHT 83747 . 84119) (\UNPACKDATE 84121 . 89005) (\PACKDATE 89007 . 92864) (\DTSCAN 92866 .
93141) (\ISDST? 93143 . 93669) (\CHECKDSTCHANGE 93671 . 95116)))))
STOP