(FILECREATED "28-Jun-85 18:07:58" {ERIS}<LISPCORE>SOURCES>IOCHAR.;10 68291
changes to: (FNS \UNPACKDATE IDATE \OUTDATE \PACKDATE PACK PACK* \PACK.ITEM CHCON UNPACK)
(VARS IOCHARCOMS)
previous date: "11-Apr-85 17:40:25" {ERIS}<LISPCORE>SOURCES>IOCHAR.;7)
(* Copyright (c) 1981, 1982, 1983, 1984, 1985 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)
(MACROS 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)
(DECLARE: DONTEVAL@LOAD DOEVAL@COMPILE DONTCOPY COMPILERVARS
(ADDVARS (NLAMA DATEFORMAT)
(NLAML)
(LAMA PACK* CONCAT])
(DEFINEQ
(CHCON
[LAMBDA (X FLG RDTBL) (* bvm: "27-Jun-85 15:45")
(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
(\MAPCHARS [FUNCTION (LAMBDA (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: "27-Jun-85 15:47")
(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
(\MAPCHARS [FUNCTION (LAMBDA (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) (* rmk: "26-Mar-85 19:01")
(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 (\MAPCHARS (FUNCTION [LAMBDA (CODE)
(ADDTOSCRATCHLIST CODE])
X FLG RDTBL])
(DUNPACK
[LAMBDA (X SCRATCHLIST FLG RDTBL) (* rmk: "26-Mar-85 19:00")
(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 (\MAPCHARS [FUNCTION (LAMBDA (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: "27-Jun-85 13:08")
(DECLARE (USEDFREE N \PNAMESTRING))
(* * Slow case for PACK and PACK* -- append characters of ITEM to \PNAMESTRING, updating N accordingly)
(\MAPCHARS (FUNCTION [LAMBDA (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) (* rmk: "26-Mar-85 10:05")
(* 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 (OR (IGREATERP (SETQ CH (\GETBASECHAR STRFAT BASE I))
\MAXTHINCHAR)
(EQ NEG (\SYNCODE A CH)))
then (RETURN (IDIFFERENCE I OFFST)))
(GO LP])
(MAKEBITTABLE
[LAMBDA (L NEG A) (* rmk: "20-NOV-81 15:19")
[COND
((type? CHARTABLE A) (* Clear it)
(\ZEROBYTES A 0 \MAXCHAR))
(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) (* rmk: " 4-Apr-85 11:40")
(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 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: "14-Feb-85 00:20")
(* 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]
[OFD (\GETOFD (OR FILE (INPUT]
CHAR FIRSTCHAR STRBASE STRINDEX PATLEN PATINDEX ENDOFFSET ORGFILEPTR LASTINDEX STARTOFFSET
ENDOFFSET BIGENDOFFSET STARTSEG ENDSEG) (* calculate start addr and set file ptr.)
[SETQ STARTOFFSET (COND
(START (COND
((NOT (AND (FIXP START)
(IGEQ START 0)))
(LISPERROR "ILLEGAL ARG" START)))
(SETQ ORGFILEPTR (\GETFILEPTR OFD))
(\SETFILEPTR OFD START)
START)
(T (SETQ ORGFILEPTR (\GETFILEPTR OFD]
[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 the character address of the character
after the last possible match.)
[SETQ ENDOFFSET (ADD1 (COND
((NULL END) (* Default is end of file)
(IDIFFERENCE (\GETEOFPTR OFD)
PATLEN))
((IGEQ END 0) (* Absolute byte pointer given)
(IMIN END (IDIFFERENCE (\GETEOFPTR OFD)
PATLEN)))
((IGREATERP PATLEN (IMINUS END))
(* END is too far, use eof less length)
(IDIFFERENCE (\GETEOFPTR OFD)
PATLEN))
(T (IDIFFERENCE (IPLUS (\GETEOFPTR OFD)
END 1)
PATLEN] (* use STARTOFFSET and ENDOFFSET instead of START and
END because vm functions shouldn't change their
arguments.)
(COND
((IGEQ STARTOFFSET ENDOFFSET) (* 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 OFD) (* Move forward a character.)
(add STRINDEX 1)
(add STARTOFFSET 1)
(GO SKIPLP)))
(SETQ LASTINDEX (IPLUS LASTINDEX STRINDEX)) (* Used for end of pattern check, comparing against
current INDEX)
[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
(can get around that here by decrementing everyone, but can't in FFILEPOS). 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]
FIRSTCHARLP
(* STARTOFFSET is the possible beginning of a match. the file ptr of the file is always at STARTOFFSET position when
the FIRSTCHAR loop is passed.)
(COND
[(EQ STARTOFFSET ENDOFFSET) (* end of this part of search)
(COND
((EQ STARTSEG ENDSEG) (* failed)
(GO FAILED))
(T (* Finished this segment, roll over into new one)
(add STARTSEG 1)
(SETQ STARTOFFSET 0) (* = STARTOFFSET-FILEPOS.SEGMENT.SIZE)
(COND
((EQ STARTSEG ENDSEG)
(COND
((EQ (SETQ ENDOFFSET BIGENDOFFSET)
0)
(GO FAILED]
((NEQ FIRSTCHAR (GETBASEBYTE CA (\BIN OFD)))
(add STARTOFFSET 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 OFD)))
(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 OFD (IDIFFERENCE (\GETFILEPTR OFD)
(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 STARTOFFSET 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 OFD (IDIFFERENCE (\GETFILEPTR OFD)
PATLEN]
(RETURN (\GETFILEPTR OFD))
FAILED (* return the fileptr to its initial position.)
(\SETFILEPTR OFD 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: "28-Jun-85 16:53")
(* 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 (IGREATERP YR 1900)))
(RETURN)))
(RETURN
(ALTO.TO.LISP.DATE
(IPLUS
SEC
(LLSH
[ITIMES
30
(IPLUS MIN
(ITIMES 60
(IPLUS HR
[ITIMES 24
(SETQ DAYSSINCEDAY0
(IPLUS (SETQ YDAY
(IPLUS (COND
((AND (IGREATERP MONTH 1)
(EQ 0 (IREMAINDER YR 4)))
(* 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
(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]
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])
)
(DECLARE: EVAL@COMPILE
[PUTPROPS DATEFORMAT DMACRO (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)
)
(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))
(DECLARE: DONTCOPY
(FILEMAP (NIL (2297 7370 (CHCON 2307 . 3554) (UNPACK 3556 . 4868) (DCHCON 4870 . 6092) (DUNPACK 6094
. 7368)) (7371 19437 (UALPHORDER 7381 . 7531) (ALPHORDER 7533 . 10351) (PACKC 10353 . 10991) (CONCAT
10993 . 11995) (PACK 11997 . 12865) (PACK* 12867 . 13691) (\PACK.ITEM 13693 . 14238) (STRPOS 14240 .
19435)) (19811 23201 (STRPOSL 19821 . 22643) (MAKEBITTABLE 22645 . 23199)) (23390 24143 (CASEARRAY
23400 . 23687) (UPPERCASEARRAY 23689 . 24141)) (24498 30090 (SKREAD 24508 . 27094) (SKBRACKET 27096 .
27577) (SKREADC 27579 . 30088)) (30182 48773 (FILEPOS 30192 . 37486) (FFILEPOS 37488 . 45386) (
\SETUP.FFILEPOS 45388 . 48771)) (49583 67412 (DATE 49593 . 49745) (DATEFORMAT 49747 . 49895) (GDATE
49897 . 50066) (IDATE 50068 . 54233) (\IDATESCANTOKEN 54235 . 55219) (\OUTDATE 55221 . 59874) (
\RPLRIGHT 59876 . 60187) (\UNPACKDATE 60189 . 63812) (\PACKDATE 63814 . 65634) (\DTSCAN 65636 . 65866)
(\ISDST? 65868 . 66266) (\CHECKDSTCHANGE 66268 . 67410)))))
STOP