(DEFINE-FILE-INFO READTABLE "INTERLISP" PACKAGE "INTERLISP")
(FILECREATED "24-Apr-2021 17:06:30" 
{DSK}<Users>kaplan>Local>medley3.5>git-medley>lispusers>ISO8859IO.;3 36846  

      changes to%:  (FNS \8859OUTCHARFN \8859INCCODEFN \8859PEEKCCODEFN MAKEISOFORMAT)

      previous date%: "24-Apr-2021 17:06:06" 
{DSK}<Users>kaplan>Local>medley3.5>git-medley>lispusers>ISO8859IO.;2)


(* ; "
Copyright (c) 1995-1997, 1999, 2021 by Xerox Corporation.
")

(PRETTYCOMPRINT ISO8859IOCOMS)

(RPAQQ ISO8859IOCOMS
       (
        (* ;; "This package defines EXTERNALFORMATS for files that are encoded in either ISO8859/1, the standard IBM extended ascii, or the usual MAC encoding.")

        (COMS                                                (* ; "ISO8859/1")
              (FNS \8859OUTCHARFN \8859INCCODEFN \8859PEEKCCODEFN)
              (GLOBALVARS *XEROXTOISO8859MAP* *ISO8859TOXEROXMAP*)
              (FNS MAKEISOFORMAT)
              (P (MAKEISOFORMAT)))
        (COMS                                                (* ; "IBM-PC Extended Ascii")
              (FNS \IBMOUTCHARFN \IBMINCCODEFN \IBMPEEKCCODEFN)
              (GLOBALVARS *XEROXTOIBMMAP* *IBMTOXEROXMAP*)
              (FNS MAKEIBMFORMAT)
              (P (MAKEIBMFORMAT)))
        (COMS                                                (* ; "Macintosh")
              (FNS \MACOUTCHARFN \MACINCCODEFN \MACPEEKCCODEFN)
              (GLOBALVARS *XEROXTOMACMAP* *MACTOXEROXMAP*)
              (FNS MAKEMACFORMAT)
              (P (MAKEMACFORMAT)))
        (COMS                                                (* ; "Independent of char encoding")
              (FNS \COMMONBACKCHARFN \MAKERECODEMAP \RECODECCODE))
        (DECLARE%: EVAL@COMPILE DONTCOPY [P (EVAL (SYSRECLOOK1 'EXTERNALFORMAT]
               
               (* ;; "From FILEIO")

               (CONSTANTS (\NORUNCODE 255))
               
               (* ;; "From LLCHAR")

               (CONSTANTS (NSCHARSETSHIFT 255))
               
               (* ;; "From LLREAD")

               (MACROS \XCCSIN \XCCSPEEK \BACKXCCSCHAR)
               
               (* ;; "From MODARITH")

               (MACROS UNFOLD))))



(* ;; 
"This package defines EXTERNALFORMATS for files that are encoded in either ISO8859/1, the standard IBM extended ascii, or the usual MAC encoding."
)




(* ; "ISO8859/1")

(DEFINEQ

(\8859OUTCHARFN
  [LAMBDA (STREAM CHARCODE)
    (DECLARE (GLOBALVARS *XEROXTOISO8859MAP*))       (* ; "Edited  9-Mar-99 16:59 by rmk:")
                                                             (* ; "Edited  7-Dec-95 14:34 by ")
                                                             (* ; "Edited  7-Dec-95 14:32 by ")

    (* ;; "Converts CHARCODE from internal Xerox-rendering to ISO8859 before printing.  Unconverted codes are left unchanged (no error).  If any remaining codes are out of charset 0, the Xerox run-encoding is used (which means that y-umlaut (code 255 in iso) will confuse any readers).")

    (\FILEOUTCHARFN STREAM (IF (IGREATERP CHARCODE 127)
                               THEN 

                                 (* ;; "We know that ISO doesn't have floating accents, so only singletons are returned.  We also know that it agrees with Xerox on first 128")

                                     (\RECODECCODE CHARCODE *XEROXTOISO8859MAP*)
                             ELSE CHARCODE])

(\8859INCCODEFN
  [LAMBDA (STREAM COUNTP)                                (* ; "Edited  9-Mar-99 16:59 by rmk:")
                                                             (* ; "Edited  7-Dec-95 15:24 by ")
                                                             (* ; "Edited  7-Dec-95 15:19 by ")
    (IF COUNTP
        THEN 

              (* ;; "This is a little goofy.  \NSIN passes the COUNTP flag, not the variable.  It then takes the COUNT result and subtracts it out.  But \XCCSIN is already subtracting from 0, giving a negative count.  So we have to reverse the value here.  Sigh ")

              (LET ((COUNT 0))
                   (CL:VALUES (\RECODECCODE (\XCCSIN STREAM (UNFOLD (ACCESS-CHARSET STREAM)
                                                                       256)
                                                       NIL COUNT)
                                     *ISO8859TOXEROXMAP*)
                          (IMINUS COUNT)))
      ELSE (\RECODECCODE (\XCCSIN STREAM (UNFOLD (ACCESS-CHARSET STREAM)
                                                        256))
                      *ISO8859TOXEROXMAP*])

(\8859PEEKCCODEFN
  [LAMBDA (STREAM NOERROR COUNTP)                        (* ; "Edited  9-Mar-99 16:59 by rmk:")
                                                             (* ; "Edited  3-Jan-96 14:21 by ")
                                                             (* ; "Edited  7-Dec-95 15:51 by ")

    (* ;; "Uses \XCCSPEEK to handle Xerox run-coding")
                                                             (* ; "Edited  7-Dec-95 15:19 by ")
    (LET (PCODE (COUNT 0))
         (SETQ PCODE (IF COUNTP
                         THEN (\XCCSPEEK STREAM (UNFOLD (ACCESS-CHARSET STREAM)
                                                           256)
                                         NIL NOERROR COUNT)
                       ELSE (\XCCSPEEK STREAM (UNFOLD (ACCESS-CHARSET STREAM)
                                                         256)
                                       NIL NOERROR)))
         (IF COUNTP
             THEN (CL:VALUES (AND PCODE (\RECODECCODE PCODE *ISO8859TOXEROXMAP*))
                             COUNT)
           ELSE (AND PCODE (\RECODECCODE PCODE *ISO8859TOXEROXMAP*])
)
(DECLARE%: DOEVAL@COMPILE DONTCOPY

(GLOBALVARS *XEROXTOISO8859MAP* *ISO8859TOXEROXMAP*)
)
(DEFINEQ

(MAKEISOFORMAT
  [LAMBDA NIL                                           (* ; "Edited 24-Apr-2021 17:01 by rmk:")
                                                             (* ; "Edited  9-Mar-99 17:19 by rmk:")
                                                             (* ; "Edited  7-Dec-95 16:24 by ")
                                                             (* ; "Edited  7-Dec-95 16:20 by ")
    (LET [(XEROXTOISO '((61217 160)
                        (61291 166)
                        (8994 168)
                        (211 169)
                        (227 170)
                        (61290 172)
                        (61219 173)
                        (210 174)
                        (9086 175)
                        (8999 180)
                        (203 184)
                        (209 185)
                        (235 186)
                        (61729 192)
                        (61730 193)
                        (61731 194)
                        (61732 195)
                        (61735 196)
                        (61736 197)
                        (225 198)
                        (61741 199)
                        (61744 200)
                        (61745 201)
                        (61746 202)
                        (61749 203)
                        (61758 204)
                        (61759 205)
                        (61760 206)
                        (61764 207)
                        (226 208)
                        (61772 209)
                        (61775 210)
                        (61776 211)
                        (61777 212)
                        (61778 213)
                        (61780 214)
                        (180 215)
                        (233 216)
                        (61791 217)
                        (61792 218)
                        (61793 219)
                        (61797 220)
                        (61803 221)
                        (236 222)
                        (251 223)
                        (61857 224)
                        (61858 225)
                        (61859 226)
                        (61860 227)
                        (61863 228)
                        (61864 229)
                        (241 230)
                        (61869 231)
                        (61872 232)
                        (61873 233)
                        (61874 234)
                        (61877 235)
                        (61886 236)
                        (61887 237)
                        (61888 238)
                        (61892 239)
                        (243 240)
                        (61900 241)
                        (61903 242)
                        (61904 243)
                        (61905 244)
                        (61906 245)
                        (61908 246)
                        (184 247)
                        (249 248)
                        (61919 249)
                        (61920 250)
                        (61921 251)
                        (61925 252)
                        (61931 253)
                        (252 254)
                        (61933 255)
                        (61805 376]
         (SETQ *XEROXTOISO8859MAP* (\MAKERECODEMAP XEROXTOISO))
         (SETQ *ISO8859TOXEROXMAP* (\MAKERECODEMAP XEROXTOISO T)))
    (\INSTALL.EXTERNALFORMAT :ISO8859/1 (CREATE EXTERNALFORMAT
                                               INCCODEFN _ (FUNCTION \8859INCCODEFN)
                                               PEEKCCODEFN _ (FUNCTION \8859PEEKCCODEFN)
                                               BACKCHARFN _ (FUNCTION \COMMONBACKCHARFN)
                                               FILEOUTCHARFN _ (FUNCTION \8859OUTCHARFN])
)

(MAKEISOFORMAT)



(* ; "IBM-PC Extended Ascii")

(DEFINEQ

(\IBMOUTCHARFN
  [LAMBDA (STREAM CHARCODE)                              (* ; "Edited  9-Mar-99 16:59 by rmk:")

    (* ;; "Converts CHARCODE from internal Xerox-rendering to IBM before printing.  Unconverted codes are left unchanged (no error).  If any remaining codes are out of charset 0, the Xerox run-encoding is used (which means that y-umlaut (code 255 in iso) will confuse any readers).")

    (\FILEOUTCHARFN STREAM (IF (IGREATERP CHARCODE 127)
                               THEN 

                                 (* ;; "We know that IBM doesn't have floating accents, so only singletons are returned.  We also know that it agrees with Xerox on first 128")

                                     (\RECODECCODE CHARCODE *XEROXTOIBMMAP*)
                             ELSE CHARCODE])

(\IBMINCCODEFN
  [LAMBDA (STREAM COUNTP)                                (* ; "Edited  9-Mar-99 16:59 by rmk:")
                                                             (* ; "Edited  8-Dec-95 13:23 by ")

    (* ;; "Uses \XCCSIN to handle Xerox run-coding")
                                                             (* ; "Edited  7-Dec-95 15:19 by ")
    (IF COUNTP
        THEN (LET ((COUNT 0))
                      (CL:VALUES (\RECODECCODE (\XCCSIN STREAM (UNFOLD (ACCESS-CHARSET STREAM)
                                                                          256)
                                                          NIL COUNT)
                                        *IBMTOXEROXMAP*)
                             (IMINUS COUNT)))
      ELSE (\RECODECCODE (\XCCSIN STREAM (UNFOLD (ACCESS-CHARSET STREAM)
                                                        256))
                      *IBMTOXEROXMAP*])

(\IBMPEEKCCODEFN
  [LAMBDA (STREAM NOERROR COUNTP)                        (* ; "Edited  9-Mar-99 16:59 by rmk:")
                                                             (* ; "Edited  3-Jan-96 14:23 by ")
                                                             (* ; "Edited  8-Dec-95 13:24 by ")
                                                             (* ; "Edited  7-Dec-95 15:51 by ")

    (* ;; "Uses \XCCSPEEK to handle Xerox run-coding")
                                                             (* ; "Edited  7-Dec-95 15:19 by ")
    (LET (PCODE (COUNT 0))
         (SETQ PCODE (IF COUNTP
                         THEN (\XCCSPEEK STREAM (UNFOLD (ACCESS-CHARSET STREAM)
                                                           256)
                                         NIL NOERROR COUNT)
                       ELSE (\XCCSPEEK STREAM (UNFOLD (ACCESS-CHARSET STREAM)
                                                         256)
                                       NIL NOERROR)))
         (IF COUNTP
             THEN (CL:VALUES (AND PCODE (\RECODECCODE PCODE *IBMTOXEROXMAP*))
                             COUNT)
           ELSE (AND PCODE (\RECODECCODE PCODE *IBMTOXEROXMAP*])
)
(DECLARE%: DOEVAL@COMPILE DONTCOPY

(GLOBALVARS *XEROXTOIBMMAP* *IBMTOXEROXMAP*)
)
(DEFINEQ

(MAKEIBMFORMAT
  [LAMBDA NIL                                            (* ; "Edited  9-Mar-99 17:33 by rmk:")
    (LET [(XEROXTOIBM '((61217 255)
                        (61291 166)
                        (8994 168)
                        (211 169)
                        (227 166)
                        (61290 170)
                        (61219 173)
                        (210 174)
                        (9086 175)
                        (8999 180)
                        (203 184)
                        (235 167)
                        (61729 183)
                        (61730 181)
                        (61731 182)
                        (61732 199)
                        (61735 142)
                        (61736 143)
                        (225 146)
                        (61741 128)
                        (61744 212)
                        (61745 144)
                        (61746 210)
                        (61749 211)
                        (61758 222)
                        (61759 214)
                        (61760 215)
                        (61764 216)
                        (61772 165)
                        (61775 227)
                        (61776 224)
                        (61777 226)
                        (61778 229)
                        (61780 153)
                        (233 157)
                        (61791 235)
                        (61792 233)
                        (61793 234)
                        (61797 154)
                        (61803 194)
                        (251 225)
                        (61857 133)
                        (61858 160)
                        (61859 131)
                        (61860 198)
                        (61863 132)
                        (61864 134)
                        (241 145)
                        (61869 135)
                        (61872 138)
                        (61873 130)
                        (61874 136)
                        (61877 137)
                        (61886 141)
                        (61887 161)
                        (61888 140)
                        (61892 139)
                        (61900 164)
                        (61903 149)
                        (61904 162)
                        (61905 147)
                        (61906 228)
                        (61908 148)
                        (249 155)
                        (61919 151)
                        (61920 163)
                        (61921 150)
                        (61925 129)
                        (61931 194)
                        (61933 152)
                        (61805 376)
                        (161 173)
                        (162 155)
                        (163 156)
                        (165 157)
                        (167 21)
                        (171 174)
                        (176 248)
                        (177 241)
                        (178 253)
                        (181 230)
                        (182 20)
                        (183 250)
                        (187 175)
                        (188 172)
                        (189 171)
                        (191 168]
         (SETQ *XEROXTOIBMMAP* (\MAKERECODEMAP XEROXTOIBM))
         (SETQ *IBMTOXEROXMAP* (\MAKERECODEMAP XEROXTOIBM T))
         (\INSTALL.EXTERNALFORMAT :IBM (CREATE EXTERNALFORMAT
                                              INCCODEFN _ (FUNCTION \IBMINCCODEFN)
                                              PEEKCCODEFN _ (FUNCTION \IBMPEEKCCODEFN)
                                              BACKCHARFN _ (FUNCTION \COMMONBACKCHARFN)
                                              FILEOUTCHARFN _ (FUNCTION \IBMOUTCHARFN])
)

(MAKEIBMFORMAT)



(* ; "Macintosh")

(DEFINEQ

(\MACOUTCHARFN
  [LAMBDA (STREAM CHARCODE)                              (* ; "Edited  9-Mar-99 16:59 by rmk:")

    (* ;; "Converts CHARCODE from internal Xerox-rendering to MAC before printing.  Unconverted codes are left unchanged (no error).  If any remaining codes are out of charset 0, the Xerox run-encoding is used (which means that code 255 will confuse any readers).")

    (\FILEOUTCHARFN STREAM (IF (IGREATERP CHARCODE 127)
                               THEN 

                                 (* ;; "We know that MAC doesn't have floating accents, so only singletons are returned.  We also know that it agrees with Xerox on first 128")

                                     (\RECODECCODE CHARCODE *XEROXTOMACMAP*)
                             ELSE CHARCODE])

(\MACINCCODEFN
  [LAMBDA (STREAM COUNTP)                                (* ; "Edited  9-Mar-99 16:59 by rmk:")
                                                             (* ; "Edited  8-Dec-95 13:29 by ")

    (* ;; "Uses \XCCSIN to handle Xerox run-coding")

    (IF COUNTP
        THEN (LET ((COUNT 0))
                      (CL:VALUES (\RECODECCODE (\XCCSIN STREAM (UNFOLD (ACCESS-CHARSET STREAM)
                                                                          256)
                                                          NIL COUNT)
                                        *MACTOXEROXMAP*)
                             (IMINUS COUNT)))
      ELSE (\RECODECCODE (\XCCSIN STREAM (UNFOLD (ACCESS-CHARSET STREAM)
                                                        256))
                      *MACTOXEROXMAP*])

(\MACPEEKCCODEFN
  [LAMBDA (STREAM NOERROR COUNTP)                        (* ; "Edited  9-Mar-99 16:59 by rmk:")
                                                             (* ; "Edited  3-Jan-96 14:23 by ")
                                                             (* ; "Edited  8-Dec-95 13:29 by ")

    (* ;; "Uses \XCCSPEEK to handle Xerox run-coding")

    (LET (PCODE (COUNT 0))
         (SETQ PCODE (IF COUNTP
                         THEN (\XCCSPEEK STREAM (UNFOLD (ACCESS-CHARSET STREAM)
                                                           256)
                                         NIL NOERROR COUNT)
                       ELSE (\XCCSPEEK STREAM (UNFOLD (ACCESS-CHARSET STREAM)
                                                         256)
                                       NIL NOERROR)))
         (IF COUNTP
             THEN (CL:VALUES (AND PCODE (\RECODECCODE PCODE *MACTOXEROXMAP*))
                             COUNT)
           ELSE (AND PCODE (\RECODECCODE PCODE *MACTOXEROXMAP*])
)
(DECLARE%: DOEVAL@COMPILE DONTCOPY

(GLOBALVARS *XEROXTOMACMAP* *MACTOXEROXMAP*)
)
(DEFINEQ

(MAKEMACFORMAT
  [LAMBDA NIL                                            (* ; "Edited  9-Mar-99 17:32 by rmk:")
                                                             (* ; "Edited  7-Dec-95 16:24 by ")
                                                             (* ; "Edited  7-Dec-95 16:20 by ")

    (* ;; "Note:  This maps some characters into sequences--only the first in the sequence will appear.  Sigh.")

    (LET [(XEROXTOMAC '((211 212)
                        (227 187)
                        (61290 194)
                        (210 168)
                        (203 252)
                        (209 213)
                        (235 188)
                        (61729 203)
                        (61730 231)
                        (61731 171)
                        (61732 204)
                        (61735 128)
                        (61736 129)
                        (225 174)
                        (61741 130)
                        (61744 172)
                        (61745 131)
                        (61746 230)
                        (61749 232)
                        (61758 237)
                        (61759 234)
                        (61760 235)
                        (61764 236)
                        (61772 132)
                        (61775 241)
                        (61776 238)
                        (61777 170)
                        (61778 205)
                        (61780 133)
                        (233 175)
                        (61791 244)
                        (61792 242)
                        (61793 243)
                        (61797 134)
                        (61803 194 89)
                        (251 167)
                        (61857 136)
                        (61858 135)
                        (61859 137)
                        (61860 139)
                        (61863 138)
                        (61864 140)
                        (241 190)
                        (61869 141)
                        (61872 143)
                        (61873 142)
                        (61874 144)
                        (61877 145)
                        (61886 147)
                        (61887 146)
                        (61888 148)
                        (61892 149)
                        (61900 150)
                        (61903 152)
                        (61904 151)
                        (61905 153)
                        (61906 155)
                        (61908 154)
                        (184 214)
                        (249 191)
                        (61919 157)
                        (61920 156)
                        (61921 158)
                        (61925 159)
                        (61931 194 121)
                        (61933 216)
                        (61805 217)
                        (61232 160)
                        (176 161)
                        (167 164)
                        (61286 165)
                        (182 166)
                        (8546 173)
                        (8551 176)
                        (8549 178)
                        (8550 179)
                        (165 180)
                        (61370 182)
                        (61306 183)
                        (61307 184)
                        (9843 185)
                        (61301 186)
                        (191 192)
                        (161 193)
                        (61308 195)
                        (61346 196)
                        (61305 197)
                        (9797 198)
                        (171 199)
                        (187 200)
                        (8516 201)
                        (32 202)
                        (61220 208)
                        (61221 209)
                        (8574 215)
                        (47 218)
                        (164 219)
                        (61226 220)
                        (61227 221)
                        (61476 222)
                        (61477 223)
                        (61233 224)
                        (183 225)
                        (9138 226)
                        (61224 227)
                        (61249 228]
         (SETQ *XEROXTOMACMAP* (\MAKERECODEMAP XEROXTOMAC))
         (SETQ *MACTOXEROXMAP* (\MAKERECODEMAP XEROXTOMAC T))
         (\INSTALL.EXTERNALFORMAT :MACINTOSH (CREATE EXTERNALFORMAT
                                                    INCCODEFN _ (FUNCTION \MACINCCODEFN)
                                                    PEEKCCODEFN _ (FUNCTION \MACPEEKCCODEFN)
                                                    BACKCHARFN _ (FUNCTION \COMMONBACKCHARFN)
                                                    FILEOUTCHARFN _ (FUNCTION \MACOUTCHARFN])
)

(MAKEMACFORMAT)



(* ; "Independent of char encoding")

(DEFINEQ

(\COMMONBACKCHARFN
  [LAMBDA (STREAM COUNTP)                                    (* ; "Edited 29-Mar-96 10:55 by rmk")
                                                             (* ; "Edited  8-Dec-95 13:26 by ")

    (* ;; "Let \BACKXCCSCHAR handle the run-coding.  The charset in the stream is the charset byte, unconverted to ISO.  This is independent of the particular character translation.")

    (IF COUNTP
        THEN (LET ((COUNT 0))
                      (\BACKXCCSCHAR STREAM COUNT)
                      COUNT)
      ELSE (\BACKXCCSCHAR STREAM NIL])

(\MAKERECODEMAP
  [LAMBDA (CODEMAP INVERTED)                             (* ; "Edited  9-Mar-99 17:23 by rmk:")

    (* ;; "Produces a map array for use by \RECODECCODE.  The map array is a 256-array of either NIL or 256-arrays, so that space isn't allocated for widely separated codes.")

    (DECLARE (USEDFREE FASTRECODEMAPCACHE))
    (CL:WHEN INVERTED
        [SETQ CODEMAP (FOR C IN CODEMAP COLLECT (LIST (CADR C)
                                                                  (CAR C])
    (FOR M (MAPARRAY _ (CL:MAKE-ARRAY 256 :INITIAL-ELEMENT NIL))
           CSMAP IN CODEMAP UNLESS (EQ (CAR M)
                                               (CADR M))
       DO (CL:UNLESS (SETQ CSMAP (CL:SVREF MAPARRAY (LRSH (CAR M)
                                                              8)))
                  (SETQ CSMAP (CL:MAKE-ARRAY 256 :INITIAL-ELEMENT NIL))
                  (CL:SETF (CL:SVREF MAPARRAY (LRSH (CAR M)
                                                    8))
                         CSMAP))
             (CL:SETF (CL:SVREF CSMAP (LOGAND (CAR M)
                                             255))
                    (CADR M)) FINALLY (RETURN MAPARRAY])

(\RECODECCODE
  [LAMBDA (CODE MAPARRAY)                                (* ; "Edited  9-Mar-99 17:28 by rmk:")
                                                             (* ; "Edited 21-Jun-95 10:18 by rmk:")

    (* ;; "Recodes a singleton charcode.  Leaves everything else unchanged.")

    (LET [(CSMAP (CL:SVREF MAPARRAY (LRSH CODE 8]
         (OR (AND CSMAP (CL:SVREF CSMAP (LOGAND CODE 255)))
             CODE])
)
(DECLARE%: EVAL@COMPILE DONTCOPY 

(EVAL (SYSRECLOOK1 'EXTERNALFORMAT))

(DECLARE%: EVAL@COMPILE 

(RPAQQ \NORUNCODE 255)


(CONSTANTS (\NORUNCODE 255))
)

(DECLARE%: EVAL@COMPILE 

(RPAQQ NSCHARSETSHIFT 255)


(CONSTANTS (NSCHARSETSHIFT 255))
)

(DECLARE%: EVAL@COMPILE 

(PUTPROPS \XCCSIN MACRO [(STREAM SHIFTEDCSET SHIFTEDCSETVAR COUNTERVAR)

(* ;;; "returns a 16 bit character code.  SHIFTEDCSET is STREAM's char set left shifted 8, SHIFTEDCSETVAR if non-NIL is the variable to set if char set changes.  COUNTERVAR if non-NIL is decremented by number of bytes read.  Doesn't do EOL conversion -- \INCHAR and \INCCODE do that.")

                                 (LET ((CHAR (\BIN STREAM))
                                       SCSET)
                                      (COND
                                         [(EQ CHAR NSCHARSETSHIFT)
                                                             (* ; "Shifting character sets")
                                          [ACCESS-CHARSET STREAM
                                                 (SETQ SCSET (COND
                                                                ((NEQ NSCHARSETSHIFT (SETQ CHAR
                                                                                      (\BIN STREAM)))
                                                                 (AND 'COUNTERVAR (SETQ COUNTERVAR
                                                                                   (IDIFFERENCE
                                                                                    COUNTERVAR 2)))
                                                                 CHAR)
                                                                ((PROGN 
                                                             (* ; 
                                                           "2 shift-bytes means not run-encoded")
                                                                        (AND 'COUNTERVAR
                                                                             (SETQ COUNTERVAR
                                                                              (IDIFFERENCE COUNTERVAR
                                                                                     3)))
                                                                        (EQ 0 (\BIN STREAM)))
                                                                 \NORUNCODE)
                                                                (T (\NSIN.24BITENCODING.ERROR STREAM]
                                          (SETQ CHAR (\BIN STREAM))
                                          (SETQ SCSET (COND
                                                         ('SHIFTEDCSETVAR 
                                                             (* ; "CHARSETVAR=NIL means don't set")
                                                                (SETQ SHIFTEDCSETVAR (UNFOLD SCSET 
                                                                                            256)))
                                                         (T (UNFOLD SCSET 256]
                                         (T (SETQ SCSET SHIFTEDCSET)))
                                      (COND
                                         ((EQ SCSET (UNFOLD \NORUNCODE 256))
                                                             (* ; 
                                           "just read two bytes and combine them to a 16 bit value")
                                          (AND 'COUNTERVAR (SETQ COUNTERVAR (IDIFFERENCE COUNTERVAR 2
                                                                                   )))
                                          (LOGOR (UNFOLD CHAR 256)
                                                 (\BIN STREAM)))
                                         (CHAR (AND 'COUNTERVAR (SETQ COUNTERVAR (IDIFFERENCE 
                                                                                        COUNTERVAR 1)
                                                                 ))
                                               (AND CHAR (LOGOR SCSET CHAR])

(PUTPROPS \XCCSPEEK MACRO [(STREAM SHIFTEDCSET SHIFTEDCSETVAR NOERROR COUNTERVAR)

                                 (* ;; "Returns a 16 bit character code.  Doesn't do EOL conversion--\INCHAR does that.  May actually read the character-set shift, storing the result in the stream.  COUNTERVAR, if given, is updated to reflect any such bytes that are actually read")

                                   (PROG ((CHAR (\PEEKBIN STREAM NOERROR))
                                          SCSET)
                                         (COND
                                            ((NULL CHAR)
                                             (RETURN NIL))
                                            [(EQ CHAR NSCHARSETSHIFT)
                                                             (* ; "CHARSETVAR=NIL means don't set")
                                             (\BIN STREAM)   (* ; "Consume the char shift byte")
                                             [ACCESS-CHARSET STREAM
                                                    (SETQ SCSET (COND
                                                                   ((NEQ NSCHARSETSHIFT
                                                                         (SETQ CHAR (\BIN STREAM)))
                                                             (* ; 
     "Note: no eof error check on this \BIN -- an eof in the middle of a charset shift is an error")
                                                                    (AND 'COUNTERVAR
                                                                         (SETQ COUNTERVAR
                                                                          (IDIFFERENCE COUNTERVAR 2))
                                                                         )
                                                                    CHAR)
                                                                   ((PROGN 
                                                             (* ; 
                                                           "2 shift-bytes means not run-encoded")
                                                                           (AND 'COUNTERVAR
                                                                                (SETQ COUNTERVAR
                                                                                 (IDIFFERENCE 
                                                                                        COUNTERVAR 3)
                                                                                 ))
                                                                           (EQ 0 (\BIN STREAM)))
                                                                    \NORUNCODE)
                                                                   (T (\NSIN.24BITENCODING.ERROR
                                                                       STREAM]
                                             [SETQ SCSET (COND
                                                            ('SHIFTEDCSETVAR 
                                                             (* ; "CHARSETVAR=NIL means don't set")
                                                                   (SETQ SHIFTEDCSETVAR
                                                                    (UNFOLD SCSET 256)))
                                                            (T (UNFOLD SCSET 256]
                                             (COND
                                                ((NULL (SETQ CHAR (\PEEKBIN STREAM NOERROR)))
                                                 (RETURN NIL]
                                            (T (SETQ SCSET SHIFTEDCSET)))
                                         (RETURN (COND
                                                    ((EQ SCSET (UNFOLD \NORUNCODE 256))

                                              (* ;; "just peek two bytes and combine them to a 16 bit value.  Again, is an error if we hit eof in mid-character")

                                                     (\BIN STREAM)
                                                     (PROG1 (LOGOR (UNFOLD CHAR 256)
                                                                   (\PEEKBIN STREAM NOERROR))
                                                            (\BACKFILEPTR STREAM)))
                                                    (T (LOGOR SHIFTEDCSET CHAR])

(PUTPROPS \BACKXCCSCHAR MACRO [(STREAM SHIFTEDCHARSET COUNTERVAR)
                                       (AND (\BACKFILEPTR STREAM)
                                            (COND
                                               [[COND
                                                   (SHIFTEDCHARSET (EQ SHIFTEDCHARSET
                                                                       (UNFOLD \NORUNCODE 256)))
                                                   (T (EQ \NORUNCODE (ACCESS-CHARSET STREAM]
                                                (COND
                                                   ((\BACKFILEPTR STREAM)
                                                    (AND 'COUNTERVAR (add COUNTERVAR 2))
                                                    T)
                                                   ('COUNTERVAR (add COUNTERVAR 1]
                                               ('COUNTERVAR (add COUNTERVAR 1])
)

(DECLARE%: EVAL@COMPILE 

(PUTPROPS UNFOLD MACRO [X (PROG [(FORM (CAR X))
                                         (DIVISOR (CAR (CONSTANTEXPRESSIONP (CADR X]
                                        (OR (AND DIVISOR (POWEROFTWOP DIVISOR))
                                            (\ILLEGAL.ARG (CADR X)))
                                        (RETURN (LIST 'LLSH FORM (SUB1 (INTEGERLENGTH DIVISOR])
)
)
(PUTPROPS ISO8859IO COPYRIGHT ("Xerox Corporation" 1995 1996 1997 1999 2021))
(DECLARE%: DONTCOPY
  (FILEMAP (NIL (2391 5846 (\8859OUTCHARFN 2401 . 3463) (\8859INCCODEFN 3465 . 4657) (\8859PEEKCCODEFN 
4659 . 5844)) (5938 9711 (MAKEISOFORMAT 5948 . 9709)) (9771 12858 (\IBMOUTCHARFN 9781 . 10606) (
\IBMINCCODEFN 10608 . 11578) (\IBMPEEKCCODEFN 11580 . 12856)) (12942 16693 (MAKEIBMFORMAT 12952 . 
16691)) (16741 19512 (\MACOUTCHARFN 16751 . 17558) (\MACINCCODEFN 17560 . 18431) (\MACPEEKCCODEFN 
18433 . 19510)) (19596 24385 (MAKEMACFORMAT 19606 . 24383)) (24452 26736 (\COMMONBACKCHARFN 24462 . 
25057) (\MAKERECODEMAP 25059 . 26289) (\RECODECCODE 26291 . 26734)))))
STOP
