github.com/Interlisp.medley
1
0
Fork 0
mirror of synced 2026-04-25 20:01:51 +00:00
Code Issues Projects Releases Wiki Activity

Minor compatibility adjustments

Browse Source
This commit is contained in:
rmkaplan
2025-09-11 23:50:13 -07:00
parent de0120ac30
commit 4020765fe7
14 changed files with 421 additions and 438 deletions
Download Patch File Download Diff File Expand all files Collapse all files

64
sources/IOCHAR
View File

@@ -1,15 +1,16 @@
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
(FILECREATED "11-Sep-2022 20:07:43" {DSK}<home>larry>medley>sources>IOCHAR.;2 100127
(FILECREATED "24-Aug-2025 11:45:37" 
{DSK}<Users>kaplan>Local>medley3.5>working-medley>sources>IOCHAR.;49 100320
:CHANGES-TO (VARS IOCHARCOMS)
:EDIT-BY rmk
:PREVIOUS-DATE "24-Jul-2022 14:56:20" {DSK}<home>larry>medley>sources>IOCHAR.;1)
:CHANGES-TO (RESOURCES \FFDELTA1)
(FNS MAKEBITTABLE \SETUP.FFILEPOS)
:PREVIOUS-DATE "24-Apr-2025 22:08:18"
{DSK}<Users>kaplan>Local>medley3.5>working-medley>sources>IOCHAR.;48)
(* ; "
Copyright (c) 1981-1988, 1990-1991, 2018, 2020 by Venue & Xerox Corporation.
")
(PRETTYCOMPRINT IOCHARCOMS)
@@ -203,17 +204,18 @@ Copyright (c) 1981-1988, 1990-1991, 2018, 2020 by Venue & Xerox Corporation.
)
(MAKEBITTABLE
[LAMBDA (L NEG A) (* ; "Edited 29-Apr-91 23:02 by jds")
[LAMBDA (L NEG A) (* ; "Edited 24-Aug-2025 11:45 by rmk")
(* ; "Edited 29-Apr-91 23:02 by jds")
[COND
[(type? CHARTABLE A) (* ; "Clear it")
[(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 (SMALLP X)
(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]
(CHCON1 X))
1)) (* ; "Invert 1 and 0 if NEG")
[AND NEG (for I from 0 to \MAXTHINCHAR do (\SETSYNCODE A I (LOGXOR 1 (\SYNCODE A I]
A])
)
(DECLARE%: DONTCOPY
@@ -258,13 +260,15 @@ DONTCOPY
(FILEPOS
[LAMBDA (PATTERN FILE START END SKIP TAIL CASEARRAY)
(* ;; "Edited 24-Apr-2025 22:08 by rmk")
(* ;; "Edited 10-Jul-2022 16:51 by rmk")
(* ;; "Edited 1-Jul-2022 11:55 by rmk")
(* ;; "Edited 25-Jun-2022 22:51 by rmk: The original version was a byte-level searcher, this upgrades to character searching as determined by the external format of the stream. (It is also a bit faster than the original).")
(* ;; "This provides accurate results if the stream's external format is stable, wherein each character code has a unique byte representation. If the stream's format is unstable (i.e. XCCS runcoding), then the result is accurate if the stream's initial charset (or other contextual information) is correct for the START byte position.")
(* ;; "This provides accurate results if the stream's external format is stable, wherein each character code has a unique byte representation. If the stream's format is unstable (i.e. MCCS runcoding), then the result is accurate if the stream's initial charset (or other contextual information) is correct for the START byte position.")
(* ;; "Otherwise, there may be some bad matches and some missing matches. The slow case will be accurate in those cases (and a NIL return for the format's \FORMATBYTESTRING function will kick it into the slow case (about 10 times slower). This always defers to the slow case if SKIP or CASEARRAY are non-NIL.")
@@ -382,7 +386,7 @@ DONTCOPY
(* ;; "Getting the character set for the start of the match is a little trickier. We know the character set at the byte that starts the beginning of the match (= character set of PATTERN's first character. If we set the stream to that charset, then back up one character, that should get it right. ")
(* ;; "This should only be necessary for an unstable format, maybe don't bother if it isn't XCCS. There is another special case here for XCCS: if the charset is 255 at the start (=2 byte encoding), then we assume that it didn't change, and nothing to worry about.")
(* ;; "This should only be necessary for an unstable format, maybe don't bother if it isn't XCCS. There is another special case here for MCCS: if the charset is 255 at the start (=2 byte encoding), then we assume that it didn't change, and nothing to worry about.")
(RETURN (IF TAIL
THEN (CL:UNLESS (EQ NSCHARSETSHIFT (ffetch (STREAM CHARSET) of STREAM))
@@ -412,6 +416,8 @@ DONTCOPY
(FFILEPOS
[LAMBDA (PATTERN FILE START END SKIP TAIL CASEARRAY)
(* ;; "Edited 24-Apr-2025 22:07 by rmk")
(* ;; "Edited 10-Jul-2022 10:17 by rmk")
(* ;; "Edited 1-Jul-2022 11:55 by rmk")
@@ -420,7 +426,7 @@ DONTCOPY
(* ;; "Edited 10-Aug-2020 21:44 by rmk:")
(* ;; "RMK: Added coercion from internal XCCS string to UTF8 if searching a UTF8 file")
(* ;; "RMK: Added coercion from internal MCCS string to UTF8 if searching a UTF8 file")
(* Pavel "12-Oct-86 15:20")
(PROG ((STREAM (\GETSTREAM FILE 'INPUT))
BYTEPATTERN BPATBASE BPATOFFSET BPATLEN ORGFILEPTR STARTBYTEPOS ENDBYTEPOS BIGENDOFFSET
@@ -587,6 +593,8 @@ DONTCOPY
(\SETUP.FFILEPOS
[LAMBDA (PATBASE PATOFFSET PATLEN PATCHAR DELTA1 DELTA2)
(* ;; "Edited 24-Aug-2025 11:45 by rmk")
(* ;; "Edited 24-Jun-2022 16:32 by rmk: Removing CASE argument. That forces the \SLOWFILEPOS, because the the alternative stream matches can't be anticipated.")
(* jop%: "25-Sep-86 11:44")
@@ -596,7 +604,7 @@ DONTCOPY
PATLEN))
(MAXPATINDEX (SUB1 PATLEN))
CHAR)
(for I from 0 to (FOLDLO \MAXCHAR BYTESPERWORD) do (PUTBASE DELTA1 I PATLEN,PATLEN))
(for I from 0 to (FOLDLO \MAXTHINCHAR 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")
@@ -780,7 +788,7 @@ DONTCOPY
(DECLARE%: EVAL@COMPILE DONTCOPY
(DECLARE%: EVAL@COMPILE
[PUTDEF '\FFDELTA1 'RESOURCES '(NEW (ARRAY (ADD1 \MAXCHAR)
[PUTDEF '\FFDELTA1 'RESOURCES '(NEW (ARRAY (ADD1 \MAXTHINCHAR)
'BYTE]
[PUTDEF '\FFDELTA2 'RESOURCES '(NEW (ARRAY \MAX.PATTERN.SIZE 'BYTE]
@@ -1567,18 +1575,16 @@ DONTCOPY
(ADDTOVAR LAMA PACK* CONCAT)
)
(PUTPROPS IOCHAR COPYRIGHT ("Venue & Xerox Corporation" 1981 1982 1983 1984 1985 1986 1987 1988 1990
1991 2018 2020))
(DECLARE%: DONTCOPY
(FILEMAP (NIL (3456 7250 (CHCON 3466 . 4316) (UNPACK 4318 . 5212) (DCHCON 5214 . 6481) (DUNPACK 6483
. 7248)) (7251 18766 (UALPHORDER 7261 . 7357) (ALPHORDER 7359 . 9162) (CONCAT 9164 . 9809) (
CONCATCODES 9811 . 9997) (PACKC 9999 . 12602) (PACK 12604 . 13183) (PACK* 13185 . 14907) (\PACK.ITEM
14909 . 15364) (STRPOS 15366 . 18764)) (18768 19057 (XCL:PACK 18768 . 19057)) (19059 19309 (XCL:PACK*
19059 . 19309)) (20016 22407 (STRPOSL 20026 . 21652) (MAKEBITTABLE 21654 . 22405)) (22569 23046 (
CASEARRAY 22579 . 22769) (UPPERCASEARRAY 22771 . 23044)) (23368 56745 (FILEPOS 23378 . 32619) (
FFILEPOS 32621 . 44842) (\SETUP.FFILEPOS 44844 . 48627) (\SLOWFILEPOS 48629 . 56743)) (57533 98780 (
DATE 57543 . 57629) (DATEFORMAT 57631 . 57723) (GDATE 57725 . 57836) (IDATE 57838 . 69509) (
\IDATESCANTOKEN 69511 . 70790) (\IDATE-PARSE-MONTH 70792 . 74488) (\OUTDATE 74490 . 87238) (
\OUTDATE-STRING 87240 . 87855) (\RPLRIGHT 87857 . 88095) (\UNPACKDATE 88097 . 93888) (\PACKDATE 93890
. 97210) (\DTSCAN 97212 . 97354) (\ISDST? 97356 . 97863) (\CHECKDSTCHANGE 97865 . 98778)))))
(FILEMAP (NIL (3501 7295 (CHCON 3511 . 4361) (UNPACK 4363 . 5257) (DCHCON 5259 . 6526) (DUNPACK 6528
. 7293)) (7296 18811 (UALPHORDER 7306 . 7402) (ALPHORDER 7404 . 9207) (CONCAT 9209 . 9854) (
CONCATCODES 9856 . 10042) (PACKC 10044 . 12647) (PACK 12649 . 13228) (PACK* 13230 . 14952) (\PACK.ITEM
14954 . 15409) (STRPOS 15411 . 18809)) (18813 19102 (XCL:PACK 18813 . 19102)) (19104 19354 (XCL:PACK*
19104 . 19354)) (20061 22561 (STRPOSL 20071 . 21697) (MAKEBITTABLE 21699 . 22559)) (22723 23200 (
CASEARRAY 22733 . 22923) (UPPERCASEARRAY 22925 . 23198)) (23522 57053 (FILEPOS 23532 . 32823) (
FFILEPOS 32825 . 45096) (\SETUP.FFILEPOS 45098 . 48935) (\SLOWFILEPOS 48937 . 57051)) (57845 99092 (
DATE 57855 . 57941) (DATEFORMAT 57943 . 58035) (GDATE 58037 . 58148) (IDATE 58150 . 69821) (
\IDATESCANTOKEN 69823 . 71102) (\IDATE-PARSE-MONTH 71104 . 74800) (\OUTDATE 74802 . 87550) (
\OUTDATE-STRING 87552 . 88167) (\RPLRIGHT 88169 . 88407) (\UNPACKDATE 88409 . 94200) (\PACKDATE 94202
. 97522) (\DTSCAN 97524 . 97666) (\ISDST? 97668 . 98175) (\CHECKDSTCHANGE 98177 . 99090)))))
STOP