(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)


(FILECREATED "17-May-2023 08:29:55" {DSK}<home>larry>il>medley>sources>AOFD.;5
 36263  

      :EDIT-BY "lmm"

      :PREVIOUS-DATE "17-May-2023 08:05:56" {DSK}<home>larry>il>medley>sources>AOFD.;4)


(PRETTYCOMPRINT AOFDCOMS)

(RPAQQ AOFDCOMS

       [

(* ;;; "streams (= OpenFileDescriptors)")


        (COMS (FNS \ADD-OPEN-STREAM \GENERIC-UNREGISTER-STREAM)
              (INITVARS (*ISSUE-CLOSE-WARNINGS* NIL))
              (FNS CLOSEALL CLOSEF EOFCLOSEF INPUT OPENP OUTPUT POSITION RANDACCESSP \IOMODEP 
                   WHENCLOSE)
              (FNS STREAMADDPROP)
              (INITVARS (DEFAULTEOFCLOSE 'NILL))
              (GLOBALVARS DEFAULTEOFCLOSE \STREAMSTRING.FDEV))
        (COMS 
              (* ;; "STREAM interface to Read and Write to random memory")


              (DECLARE%: DONTCOPY (EXPORT (RECORDS BASEBYTESTREAM)))
              (FNS \BASEBYTES.IO.INIT \MAKEBASEBYTESTREAM \MBS.OUTCHARFN \BASEBYTES.NAME.FROM.STREAM
                   \BASEBYTES.BOUT \BASEBYTES.SETFILEPTR \BASEBYTES.READP \BASEBYTES.BIN 
                   \BASEBYTES.PEEKBIN \BASEBYTES.TRUNCATEFN \BASEBYTES.OPENFN \BASEBYTES.BLOCKIO)
              (GLOBALVARS \BASEBYTESDEVICE)
              (DECLARE%: DONTEVAL@LOAD (P (\BASEBYTES.IO.INIT)))
              (FNS OPENSTRINGSTREAM MAKE-STRING-FORMAT)
              (P (MAKE-STRING-FORMAT)))
        (COMS 
              (* ;; "STREAM interface for old-style strings.  However (RMK), it appears never to be used, and even commonlisp string-streams are created using the Interlisp OPENSTRINGSTREAM above.  For now, keep the function, but don't execute it")


              (FNS \STRINGSTREAM.INIT)
              
              (* ;; "(DECLARE%%: DONTEVAL@LOAD DOCOPY (P (\STRINGSTREAM.INIT)))")

)
        (COMS (FNS GETSTREAM \CLEAROFD \GETSTREAM)
              (DECLARE%: DONTCOPY (EXPORT (MACROS \INSTREAMARG \OUTSTREAMARG \STREAMARG)))
              (MACROS GETOFD \GETOFD))
        (LOCALVARS . T)
        (DECLARE%: DONTEVAL@LOAD DOEVAL@COMPILE DONTCOPY COMPILERVARS (ADDVARS (NLAMA)
                                                                             (NLAML)
                                                                             (LAMA WHENCLOSE])



(* ;;; "streams (= OpenFileDescriptors)")


(DEFINEQ

(\ADD-OPEN-STREAM

  [LAMBDA (DEVICE STREAM)                                    (* hdj "28-May-86 11:22")

    (if
 (NOT (STREAMP STREAM))
        then
 (\ILLEGAL.ARG STREAM))
    (pushnew
 (fetch
 (FDEV OPENFILELST) of
 DEVICE)
           STREAM)
    STREAM])

(\GENERIC-UNREGISTER-STREAM

  [LAMBDA (DEVICE STREAM)                                    (* hdj "22-Sep-86 18:30")


(* ;;; "Remove an open stream from the list of streams kept by DEVICE.  Assumes the use of the FDEV's OPENFILELSTto store the streams.  Errors if passed a stream the device doesn't know about if *ISSUE-CLOSE-WARNINGS* is non-NIL.")


    (DECLARE
 (GLOBALVARS *ISSUE-CLOSE-WARNINGS*))
    (if
 (NOT (STREAMP STREAM))
        then
 (\ILLEGAL.ARG STREAM))
    (LET ((OPENFILELST (fetch
 (FDEV OPENFILELST) of
 DEVICE)))
         (if
 (AND *ISSUE-CLOSE-WARNINGS* (NOT (FMEMB STREAM OPENFILELST)))
             then
 (ERROR "Closing a stream that's not open!" STREAM))
         (replace
 (FDEV OPENFILELST) of
 DEVICE with
 (DREMOVE STREAM OPENFILELST))
         STREAM])
)

(RPAQ? *ISSUE-CLOSE-WARNINGS*
 NIL)
(DEFINEQ

(CLOSEALL

  [LAMBDA (ALLFLG)
                                           (* ; "Edited 28-Apr-2023 20:51 by lmm")

    (for
 STREAM in
 (OPENP
) when
 [AND (fetch
 USERVISIBLE of
 STREAM)
                                     (fetch
 USERCLOSEABLE of
 STREAM)
                                     (\IOMODEP
 STREAM NIL T)
                                     (OR ALLFLG (NOT (STREAMPROP STREAM 'CLOSEALL]
       collect
 (CLOSEF
 STREAM])

(CLOSEF

  [LAMBDA (FILE)
                                             (* ; "Edited 11-May-2023 21:18 by lmm")


                                                            (* ; "Edited 13-Jun-2021 11:26 by rmk:")

    (PROG ((STREAM (\GETSTREAM
 FILE)))
          (COND
             ((OR (\OUTTERMP STREAM)
                  (NOT (fetch
 (STREAM USERCLOSEABLE) of
 STREAM)))
              (RETURN NIL)))
          [MAPC (STREAMPROP STREAM 'BEFORECLOSE)
                (FUNCTION (LAMBDA (FN)
                            (APPLY* FN STREAM]
          (\CLEAROFD
)
          (COND
             ((EQ STREAM *STANDARD-INPUT*)
              (SETQ *STANDARD-INPUT* \LINEBUF.OFD)))
          (COND
             ((EQ STREAM *STANDARD-OUTPUT*)
              (SETQ *STANDARD-OUTPUT* \TERM.OFD)))

     (* ;; "Logical close before physical close;  otherwise, we might have a logically open file with no physically open file behind it.  (Device LPT depends on this)")


          (\CLOSEFILE STREAM)
          [MAPC (STREAMPROP STREAM 'AFTERCLOSE)
                (FUNCTION (LAMBDA (FN)
                            (APPLY* FN STREAM]
          (RETURN (fetch
 (STREAM FULLNAME) of
 STREAM])

(EOFCLOSEF

  [LAMBDA (FILE)                                             (* bvm%: "15-Jan-85 17:58")

    (DECLARE
 (LOCALVARS . T))
    (PROG ((STREAM (GETSTREAM
 FILE)))
          (APPLY* (OR (STREAMPROP STREAM 'EOFCLOSE)
                      DEFAULTEOFCLOSE)
                 STREAM])

(INPUT

  [LAMBDA (FILE)
                                            (* ; "Edited 13-Jun-2021 11:27 by rmk:")

    (PROG1 (if
 (EQ *STANDARD-INPUT* \LINEBUF.OFD)
               then
 T
             else
 (if
 MULTIPLE.STREAMS.PER.FILE.ALLOWED
                      then
 *STANDARD-INPUT*
                    else
 (fetch
 (STREAM FULLNAME) of
 *STANDARD-INPUT*)))
        [COND
           (FILE (SETQ *STANDARD-INPUT* (COND
                                           ((EQ FILE T)      (* ; 

                                                 "Check explicitly for T to avoid needless creations")

                                            \LINEBUF.OFD)
                                           (T (\GETSTREAM
 FILE 'INPUT])])

(OPENP

  [LAMBDA (FILE ACCESS)                                      (* hdj "29-Sep-86 17:41")

    (DECLARE
 (GLOBALVARS MULTIPLE.STREAMS.PER.FILE.ALLOWED \FILEDEVICES))
    (if
 (AND FILE (type?
 STREAM FILE))
        then
 (\GETSTREAM
 FILE ACCESS T)
      elseif
 FILE
        then
 NIL
      else
 (\MAP-OPEN-STREAMS (FUNCTION EVQ)
                  \FILEDEVICES NIL])

(OUTPUT

  [LAMBDA (FILE)
                                            (* ; "Edited 13-Jun-2021 11:27 by rmk:")

    (PROG1 (if
 (EQ *STANDARD-OUTPUT* \TERM.OFD)
               then
 T
             else
 (if
 MULTIPLE.STREAMS.PER.FILE.ALLOWED
                      then
 *STANDARD-OUTPUT*
                    else
 (fetch
 (STREAM FULLNAME) of
 *STANDARD-OUTPUT*)))
        [COND
           (FILE (SETQ *STANDARD-OUTPUT* (COND
                                            ((EQ FILE T)     (* ; 

                                  "Check for this special so we don't create a tty window needlessly")

                                             \TERM.OFD)
                                            (T (\GETSTREAM
 FILE 'OUTPUT])])

(POSITION

  [LAMBDA (FILE N)
                                           (* ; "Edited 17-Jan-87 16:08 by bvm:")

    (PROG [(STRM (COND
                    (FILE (\GETSTREAM
 FILE))
                    (T *STANDARD-OUTPUT*]
          (RETURN (PROG1 (fetch
 CHARPOSITION of
 STRM)
                      [COND
                         (N (replace
 CHARPOSITION of
 STRM with
 (COND
                                                                  ((IGREATERP N 0)
                                                                   N)
                                                                  (T 
                                                             (* ; "compatible with PDP-10 version")

                                                                     0])])

(RANDACCESSP

  [LAMBDA (FILE)
                                            (* ; "Edited 13-Jun-2021 11:28 by rmk:")

    (PROG ((STREAM (\GETSTREAM
 FILE)))
          (RETURN (AND (fetch
 (FDEV RANDOMACCESSP) of
 (fetch
 (STREAM DEVICE) of
 STREAM))
                       (NEQ STREAM \LINEBUF.OFD)
                       (fetch
 (STREAM FULLNAME) of
 STREAM])

(\IOMODEP

  [LAMBDA (STREAM ACCESS NOERROR)                            (* rmk%: "21-OCT-83 11:10")


    (* ;; "Returns STREAM if it represents a File open with access mode ACCESS")


    (COND
       ([COND
           ((NOT ACCESS)
            (fetch
 ACCESS of
 STREAM))
           ((EQ ACCESS (fetch
 ACCESS of
 STREAM)))
           [(EQ (fetch
 ACCESS of
 STREAM)
                'BOTH)
            (FMEMB ACCESS '(INPUT
 OUTPUT]
           ((EQ (fetch
 ACCESS of
 STREAM)
                'APPEND)
            (EQ ACCESS 'OUTPUT]
        STREAM)
       (T (\FILE.NOT.OPEN STREAM NOERROR])

(WHENCLOSE

  [LAMBDA NARGS
                                              (* ; "Edited 28-Apr-2023 21:19 by lmm")

                                                             (* lmm " 2-Sep-84 16:07")

    (DECLARE
 (LOCALVARS . T))
    (PROG [(STREAM (AND (IGREATERP NARGS 0)
                        (GETSTREAM
 (ARG NARGS 1]
          [for
 I FN from
 2 to
 NARGS by
 2
             do
 [SETQ FN (AND (IGREATERP NARGS I)
                              (ARG NARGS (ADD1 I]
                (SELECTQ (ARG NARGS I)
                    (CLOSEALL [STREAMPROP STREAM 'CLOSEALL (SELECTQ FN
                                                               (NO T)
                                                               (YES NIL)
                                                               (ERRORX (LIST 27 FN])
                    (BEFORE (COND
                               (FN (STREAMADDPROP
 STREAM 'BEFORECLOSE FN))))
                    (AFTER (COND
                              (FN (STREAMADDPROP
 STREAM 'AFTERCLOSE FN))))
                    (STATUS (STREAMPROP STREAM 'STATUSFN FN))
                    (EOF (STREAMPROP STREAM 'EOFCLOSE FN))
                    (ERRORX (LIST 27 (ARG NARGS I]
          (RETURN STREAM])
)
(DEFINEQ

(STREAMADDPROP

  [LAMBDA (STREAM PROP VAL)
    (STREAMPROP STREAM PROP (CONS VAL (STREAMPROP STREAM PROP])
)

(RPAQ? DEFAULTEOFCLOSE
 'NILL)
(DECLARE%: DOEVAL@COMPILE DONTCOPY

(GLOBALVARS DEFAULTEOFCLOSE \STREAMSTRING.FDEV)
)



(* ;; "STREAM interface to Read and Write to random memory")


(DECLARE%: DONTCOPY 
(* "FOLLOWING DEFINITIONS EXPORTED")(DECLARE%: EVAL@COMPILE

(RECORD BASEBYTESTREAM
 STREAM (SUBRECORD STREAM)
                             [ACCESSFNS ((BIASOFFST (fetch
 (STREAM FW6) of
 DATUM)
                                                (replace
 (STREAM FW6) of
 DATUM with
 NEWVALUE))
                                         (BBSNCHARS (fetch
 (STREAM FW7) of
 DATUM)
                                                (replace
 (STREAM FW7) of
 DATUM with
 NEWVALUE))
                                         (WRITEXTENSIONFN (fetch
 (STREAM F1) of
 DATUM)
                                                (replace
 (STREAM F1) of
 DATUM with
 NEWVALUE])
)

(* "END EXPORTED DEFINITIONS")

)
(DEFINEQ

(\BASEBYTES.IO.INIT

  [LAMBDA NIL
    (DECLARE
 (GLOBALVARS \BASECHARDEVICE))
                   (* ; "Edited 13-Sep-90 16:27 by jds")


    (* ;; "Initialize the FDEV for base-bytes type devices (e.g. string streams).")


    (SETQ \BASEBYTESDEVICE
     (create
 FDEV
            DEVICENAME _ 'BASEBYTES
            RESETABLE _ T
            RANDOMACCESSP _ T
            PAGEMAPPED _ NIL
            FDBINABLE _ T
            FDBOUTABLE _ T
            FDEXTENDABLE _ NIL
            CLOSEFILE _ (FUNCTION NILL)
            DELETEFILE _ (FUNCTION NILL)
            DIRECTORYNAMEP _ (FUNCTION NILL)
            EVENTFN _ (FUNCTION NILL)
            GENERATEFILES _ (FUNCTION \GENERATENOFILES)
            GETFILEINFO _ (FUNCTION NILL)
            GETFILENAME _ (FUNCTION \BASEBYTES.NAME.FROM.STREAM)
            HOSTNAMEP _ (FUNCTION NILL)
            OPENFILE _ (FUNCTION \BASEBYTES.OPENFN)
            READPAGES _ (FUNCTION NILL)
            REOPENFILE _ [FUNCTION (LAMBDA (FILE ACCESS RECOG OTHERINFO FDEV STREAM)
                                     STREAM]
            SETFILEINFO _ (FUNCTION NILL)
            TRUNCATEFILE _ [FUNCTION (LAMBDA (STREAM I]
            WRITEPAGES _ (FUNCTION \ILLEGAL.DEVICEOP)
            BIN _ (FUNCTION \BASEBYTES.BIN)
            BOUT _ (FUNCTION \BASEBYTES.BOUT)
            PEEKBIN _ (FUNCTION \BASEBYTES.PEEKBIN)
            READP _ (FUNCTION \BASEBYTES.READP)
            BACKFILEPTR _ [FUNCTION (LAMBDA (STREAM)

                                      (* ;; "Back up the file pointer")


                                      (AND (NEQ (fetch
 COFFSET of
 STREAM)
                                                (fetch
 BIASOFFST of
 STREAM))
                                           (\PAGEDBACKFILEPTR STREAM))

                                      (* ;; "And fix charposition.")


                                      (replace
 BBSNCHARS of
 STREAM
                                         with
 (IDIFFERENCE (fetch
 COFFSET of
 STREAM)
                                                     (fetch
 BIASOFFST of
 STREAM]
            SETFILEPTR _ (FUNCTION \BASEBYTES.SETFILEPTR)
            GETFILEPTR _ [FUNCTION (LAMBDA (STREAM)
                                     (IDIFFERENCE (fetch
 COFFSET of
 STREAM)
                                            (fetch
 BIASOFFST of
 STREAM]
            GETEOFPTR _ [FUNCTION (LAMBDA (STREAM)
                                    (IDIFFERENCE (fetch
 EOFFSET of
 STREAM)
                                           (fetch
 BIASOFFST of
 STREAM]
            EOFP _ [FUNCTION (LAMBDA (STREAM)
                               (IGEQ (fetch
 COFFSET of
 STREAM)
                                     (fetch
 EOFFSET of
 STREAM]
            BLOCKIN _ [FUNCTION (LAMBDA (STREAM BASE OFFST N)
                                  (\BASEBYTES.BLOCKIO
 STREAM BASE OFFST N 'INPUT]
            BLOCKOUT _ [FUNCTION (LAMBDA (STREAM BASE OFFST N)
                                   (\BASEBYTES.BLOCKIO
 STREAM BASE OFFST N 'OUTPUT]
            RENAMEFILE _ (FUNCTION \ILLEGAL.DEVICEOP)))
    (\DEFINEDEVICE NIL \BASEBYTESDEVICE])

(\MAKEBASEBYTESTREAM

  [LAMBDA (BASE OFFST LEN ACCESS WRITEXTENSIONFN OSTREAM)
   (* ; "Edited 13-Jun-2021 11:33 by rmk:")


    (* ;; "If an error is to occur due to non-numeric arg or range restrictions, then let it happen outside the UNINTERRUPTABLY")


    (OR BASE (EQ LEN 0)
        (SHOULDNT))
    (OR (AND (SMALLP OFFST)
             (SMALLP LEN)
             (SMALLP (add
 LEN OFFST)))
        (SHOULDNT "Currently can't support fixp-sized offsets"))
    (SELECTQ ACCESS
        (NIL (SETQ ACCESS 'INPUT))
        ((INPUT OUTPUT BOTH))
        (\ILLEGAL.ARG ACCESS))
    (if
 (type?
 STREAM OSTREAM)
        then
 (if
 (EQ (ffetch
 (STREAM DEVICE) of
 OSTREAM)
                     \BASEBYTESDEVICE)
                 then
 (replace
 (STREAM ACCESS) of
 OSTREAM with
 NIL)
               else
 (CLOSEF
 OSTREAM)
                    (SETQ OSTREAM (create
 BASEBYTESTREAM
                                         DEVICE _ \BASEBYTESDEVICE smashing
 OSTREAM)))
      else
 (SETQ OSTREAM (create
 BASEBYTESTREAM
                                DEVICE _ \BASEBYTESDEVICE)))
    (UNINTERRUPTABLY
        (freplace
 (STREAM USERCLOSEABLE) of
 OSTREAM with
 NIL)
        (freplace
 (STREAM USERVISIBLE) of
 OSTREAM with
 NIL)
        (freplace
 (STREAM BYTESIZE) of
 OSTREAM with
 BITSPERBYTE)
        (freplace
 (STREAM CPAGE) of
 OSTREAM with
 (freplace
 (STREAM EPAGE) of
 OSTREAM with
 0))
        (freplace
 (STREAM CBUFPTR) of
 OSTREAM with
 BASE)
        (freplace
 (STREAM COFFSET) of
 OSTREAM with
 (freplace
 (BASEBYTESTREAM BIASOFFST) of
 OSTREAM
                                                      with
 OFFST))
        (freplace
 (STREAM CBUFSIZE) of
 OSTREAM with
 (freplace
 (STREAM EOFFSET) of
 OSTREAM
                                                       with
 LEN))
        (replace
 (STREAM ACCESS) of
 OSTREAM with
 ACCESS)

        (* ;; "Insures that the BINABLE BOUTABLE and EXTENDABLE bits are setup setup, and that the correct BIN and BOUT fns are 'inherited' from the FDEV as well")


        (freplace
 (STREAM FULLFILENAME) of
 OSTREAM with
 NIL)
        (freplace
 (STREAM OUTCHARFN) of
 OSTREAM with
 (FUNCTION \MBS.OUTCHARFN))
        (freplace
 (STREAM LINELENGTH) of
 OSTREAM with
 0)
        (freplace
 (STREAM CHARPOSITION) of
 OSTREAM with
 0)
        (freplace
 (BASEBYTESTREAM WRITEXTENSIONFN) of
 OSTREAM with
 (SELECTQ ACCESS
                                                                       ((OUTPUT BOTH) 
                                                                            WRITEXTENSIONFN)
                                                                       NIL))
        (freplace
 (BASEBYTESTREAM BBSNCHARS) of
 OSTREAM with
 0))
    OSTREAM])

(\MBS.OUTCHARFN

  [LAMBDA (STREAM CHAR)                                      (* JonL " 7-NOV-83 21:54")

    (BOUT (SETQ STREAM (\DTEST STREAM 'STREAM))
          CHAR)                                              (* ; 

                "The BBSNCHARS field *may* just be paralleling the CHARPOSITION field of the stream.")

    (add
 (ffetch
 BBSNCHARS of
 STREAM)
         1])

(\BASEBYTES.NAME.FROM.STREAM

  [LAMBDA (STREAM)
                                           (* ; "Edited 17-Jan-87 16:08 by bvm:")


    (* ;; "STRING streams have a FULLFILENAME which is just the string itself;  other random basebytes streams have this field null")


    (OR (fetch
 FULLFILENAME of
 STREAM)
        (LIST (fetch
 CBUFPTR of
 STREAM)
              (fetch
 BIASOFFST of
 STREAM)
              (GETEOFPTR STREAM])

(\BASEBYTES.BOUT

  [LAMBDA (STREAM BYTE)
                                      (* ; "Edited 17-Jan-87 16:08 by bvm:")

    (PROG (CO)
      A   (if
 (IGEQ (SETQ CO (fetch
 COFFSET of
 STREAM))
                    (fetch
 EOFFSET of
 STREAM))
              then
 (if
 (SETQ CO (fetch
 (BASEBYTESTREAM WRITEXTENSIONFN) of
 STREAM))
                       then
 (APPLY* CO STREAM)
                            (GO A)
                     else
 (ERROR "Attempt to write past end of bytes block")))
          (RETURN (\PUTBASEBYTE (fetch
 CBUFPTR of
 STREAM)
                         (PROG1 CO
                             (freplace
 COFFSET of
 STREAM with
 (ADD1 CO)))
                         BYTE])

(\BASEBYTES.SETFILEPTR

  [LAMBDA (STREAM I)
                                         (* ; "Edited 13-Sep-90 16:30 by jds")


    (* ;; "SETFILEPTR for string streams &c.")


    (PROG ((I' I))
          (add
 I' (fetch
 BIASOFFST of
 STREAM))
          (if
 (IGREATERP I' (fetch
 EOFFSET of
 STREAM))
              then
 (ERROR "Beyond end of byte range" I)
            else
 
                 (* ;; "Fix both FILEPTR and CHARPOSITION to match.")


                 (replace
 COFFSET of
 STREAM with
 I')
                 (replace
 BBSNCHARS of
 STREAM with
 I'])

(\BASEBYTES.READP

  [LAMBDA (STREAM FLG)
                                       (* ; "Edited 17-Jan-87 16:08 by bvm:")

    (PROG ((CO (fetch
 COFFSET of
 STREAM))
           (%#LEFT (fetch
 EOFFSET of
 STREAM)))
          (add
 %#LEFT (IMINUS CO))
          (RETURN (OR (IGEQ %#LEFT 2)
                      (if
 (EQ %#LEFT 0)
                          then
 NIL
                        elseif
 FLG
                        else
 (NEQ (\GETBASEBYTE (fetch
 CBUFPTR of
 STREAM)
                                         (fetch
 COFFSET of
 STREAM))
                                  (CHARCODE CR])

(\BASEBYTES.BIN

  [LAMBDA (STREAM)                                           (* JonL " 7-NOV-83 22:49")


    (* ;; "Normally, the microcoded version of BIN will handle this, since the BINABLE flag is set and since the COFFSET etc fields are setup appropriately")


    (* ;; 

    "Remember also that the VAX version installs a different STRMBINFN for the stringstream case")


    (PROG1 (\BASEBYTES.PEEKBIN
 STREAM)
        (add
 (fetch
 COFFSET of
 STREAM)
             1))])

(\BASEBYTES.PEEKBIN

  [LAMBDA (STREAM NOERRORFLG)
                               (* ; "Edited 13-Jun-2021 11:34 by rmk:")

    (PROG ((CO (fetch
 (STREAM COFFSET) of
 STREAM)))
          (SELECTQ (SYSTEMTYPE)
              (VAX (if
 (fetch
 (STREAM FULLNAME) of
 STREAM)
                       then
                                  (* ; "Aha, it's a string stream")

                            (RETURN (\STRINGPEEKBIN STREAM NOERRORFLG))))
              NIL)
          (RETURN (if
 (IGEQ CO (fetch
 (STREAM EOFFSET) of
 STREAM))
                      then
 (if
 (NOT NOERRORFLG)
                               then
 (STREAMOP 'ENDOFSTREAMOP STREAM STREAM))
                    else
 (\GETBASEBYTE (fetch
 (STREAM CBUFPTR) of
 STREAM)
                                CO])

(\BASEBYTES.TRUNCATEFN

  [LAMBDA (STREAM I)                                         (* JonL " 7-NOV-83 22:20")

    ([LAMBDA (I' BO EO)
       (add
 I' BO)
       (if
 (ILESSP I 0)
           then
 (add
 I' EO))
       (if
 (OR (ILESSP I BO)
               (IGREATERP I' EO))
           then
 (ERROR "Beyond end of byte range" I)
         else
 (replace
 EOFFSET of
 STREAM with
 I']
     I
     (fetch
 BIASOFFST of
 STREAM)
     (fetch
 EOFFSET of
 STREAM])

(\BASEBYTES.OPENFN

  [LAMBDA (NAME ACCESS RECOG OTHERINFO FDEV)
                 (* ; "Edited  8-May-2023 14:05 by rmk")


                                                             (* ; "Edited 17-Jan-87 16:08 by bvm:")

    (if
 (STREAMP NAME)
        then
 (CL:UNLESS (\IOMODEP
 NAME ACCESS T)
                    (\SETACCESS NAME ACCESS))
             (\SETFILEPTR NAME 0)
             NAME
      elseif
 (fetch
 FULLFILENAME of
 NAME)
        then
 (OPENSTRINGSTREAM
 NAME ACCESS)
      else
 (\MAKEBASEBYTESTREAM
 (fetch
 CBUFPTR of
 NAME)
                  (fetch
 BIASOFFST of
 NAME)
                  (GETEOFPTR NAME)
                  ACCESS
                  (fetch
 WRITEXTENSIONFN of
 NAME)
                  NAME])

(\BASEBYTES.BLOCKIO

  [LAMBDA (STREAM BASE OFFST N DIRECTION)
                    (* ; "Edited 17-Jan-87 16:08 by bvm:")

    (PROG (SBASE CO EO)
      A   (if
 (ILEQ N 0)
              then
 (RETURN))
          (SETQ SBASE (fetch
 CBUFPTR of
 STREAM))
          (SETQ CO (fetch
 COFFSET of
 STREAM))
          (SETQ EO (fetch
 EOFFSET of
 STREAM))
          (if
 (IGREATERP N (IDIFFERENCE EO (SUB1 CO)))
              then
 (if
 (EQ DIRECTION 'INPUT)
                       then
 (STREAMOP 'ENDOFSTREAMOP STREAM STREAM)
                     else
                                    (* ; 

                                      "Do a single BOUT to see if the WRITEXTENSIONFN will fix it up")

                          (BOUT STREAM (\GETBASEBYTE BASE OFFST))
                          (add
 OFFST 1)
                          (add
 N -1)
                          (GO A)))
          (replace
 COFFSET of
 STREAM with
 (IPLUS CO N))
          (if
 (EQ DIRECTION 'OUTPUT)
              then
 (swap
 SBASE BASE)
                   (swap
 CO OFFST))
          (\MOVEBYTES SBASE CO BASE OFFST N])
)
(DECLARE%: DOEVAL@COMPILE DONTCOPY

(GLOBALVARS \BASEBYTESDEVICE)
)
(DECLARE%: DONTEVAL@LOAD 

(\BASEBYTES.IO.INIT
)
)
(DEFINEQ

(OPENSTRINGSTREAM

  [LAMBDA (STR ACCESS)
                                      (* ; "Edited  8-Aug-2021 00:02 by rmk:")

                                                             (* rmk%: "28-Mar-85 08:40")


    (* ;; "We fatten thin strings at the start so that the byte-level functions (bin, bout, getfileptr, setfrileptr) give the same (2-bytes per character) picture of the byte sequence even if we started out thin.")


    (* ;; "Does not register the stream on \OPENFILES, nor does it search \OPENFILES for a previously opened stream. ")


    (SELECTQ ACCESS
        ((INPUT OUTPUT BOTH))
        (NIL (SETQ ACCESS 'INPUT))
        (\ILLEGAL.ARG ACCESS))
    (CL:UNLESS (STRINGP STR)
           (\ILLEGAL.ARG STR))
    (LET (STREAM)
         (IF
 (AND (EQ ACCESS 'INPUT)
                  (NOT (ffetch
 (STRINGP FATSTRINGP) of
 STR)))
             THEN
 (\FATTENSTRING STR)
           ELSE
 (\SMASHABLESTRING STR T))

         (* ;; "String storage is now fat")


         (SETQ STREAM (\MAKEBASEBYTESTREAM
 (OR (ffetch
 (STRINGP BASE) of
 STR)
                                               T)
                             (UNFOLD (ffetch
 (STRINGP OFFST) of
 STR)
                                    BYTESPERWORD)
                             (UNFOLD (ffetch
 (STRINGP LENGTH) of
 STR)
                                    BYTESPERWORD)
                             ACCESS))

         (* ;; "Differences between a basebytestream and a stringstream")


         (\EXTERNALFORMAT STREAM :STRING)
         (freplace
 USERCLOSEABLE of
 STREAM with
 T)
         (freplace
 USERVISIBLE of
 STREAM with
 T)
         STREAM])

(MAKE-STRING-FORMAT

  [LAMBDA NIL
                                               (* ; "Edited  8-Aug-2021 00:10 by rmk:")


    (* ;; "We are looking at an in-core string, we know that EOL is CR, that the characters have the internal (XCCS) encoding, and that the string is fat. ")


    (MAKE-EXTERNALFORMAT :STRING [FUNCTION (LAMBDA (STRM COUNTP)
                                             (DECLARE
 (USEDFREE *BYTECOUNTER*))
                                             (CL:WHEN COUNTP (SETQ *BYTECOUNTER* 2))
                                             (\WIN STRM]
           [FUNCTION (LAMBDA (STRM NOERROR)
                       (CL:WHEN (\PEEKBIN STRM NOERROR)

                           (* ;; "This guards against the EOF error")


                           (PROG1 (LOGOR (LLSH (\BIN STRM)
                                               8)
                                         (\PEEKBIN STRM NOERROR))
                                  (\BACKFILEPTR STRM)))]
           [FUNCTION (LAMBDA (STRM COUNTP)
                       (DECLARE
 (USEDFREE *BYTECOUNTER*))
                       (CL:WHEN (\BACKFILEPTR STRM)
                           (IF
 (\BACKFILEPTR STRM)
                               THEN
 (CL:WHEN COUNTP (SETQ *BYTECOUNTER* 2))
                                    T
                             ELSEIF
 COUNTP
                               THEN
 (SETQ *BYTECOUNTER* 1)))]
           [FUNCTION (LAMBDA (STRM CODE)
                       (\WOUT STRM CODE)
                       CODE]
           NIL
           'CR])
)

(MAKE-STRING-FORMAT
)



(* ;; 
"STREAM interface for old-style strings.  However (RMK), it appears never to be used, and even commonlisp string-streams are created using the Interlisp OPENSTRINGSTREAM above.  For now, keep the function, but don't execute it"
)


(DEFINEQ

(\STRINGSTREAM.INIT

  [LAMBDA NIL
                                               (* ; "Edited  9-Aug-2021 23:30 by rmk:")


    (* ;; "RMK: This is described as creating a file device for %"old style%" strings.  But the variable that it sets is never referenced.  The common lisp functions that treat strings as streams all seem to go through OPENSTRINGSTREAM, which now has a proper external format.")


    (* ;; "Moreover, it appears that the BIN function defined here, in terms of GNC, would have had the effect of updating the string pointer of the string as visible using ordinary string functions.  ")


    (* ;; "Finally, this appears to be read only.  No BOUT is provided.")


    (* ;; "")


    (* ;; " In sum:  this is a candidate for removal.")


    (SETQ \STRINGSTREAM.FDEV (create
 FDEV
                                    DEVICENAME _ 'STRING
                                    CLOSEFILE _ (FUNCTION NILL)
                                    DELETEFILE _ (FUNCTION NILL)
                                    DIRECTORYNAMEP _ (FUNCTION NILL)
                                    EVENTFN _ (FUNCTION NILL)
                                    GENERATEFILES _ (FUNCTION \NULLFILEGENERATOR)
                                    GETFILEINFO _ (FUNCTION NILL)
                                    GETFILENAME _ (FUNCTION NILL)
                                    HOSTNAMEP _ (FUNCTION NILL)
                                    OPENFILE _ (FUNCTION NILL)
                                    READPAGES _ (FUNCTION \ILLEGAL.DEVICEOP)
                                    REOPENFILE _ [FUNCTION (LAMBDA (FILE ACCESS RECOG OTHERINFO FDEV
                                                                         STREAM)
                                                             STREAM]
                                    SETFILEINFO _ (FUNCTION NILL)
                                    TRUNCATEFILE _ (FUNCTION NILL)
                                    WRITEPAGES _ (FUNCTION \ILLEGAL.DEVICEOP)
                                    BIN _ [FUNCTION (LAMBDA (STREAM)
                                                      (replace
 F2 of
 STREAM
                                                         with
 (COND
                                                                 ((fetch
 F1 of
 STREAM)
                                                                  (PROG1 (fetch
 F1 of
 STREAM)
                                                                         (replace
 F1 of
 STREAM
                                                                            with
 NIL)))
                                                                 ((GNCCODE (fetch
 FULLFILENAME
                                                                              of
 STREAM)))
                                                                 (T (\EOF.ACTION STREAM]
                                    PEEKBIN _ [FUNCTION (LAMBDA (STREAM NOERRORFLG)
                                                          (OR (fetch
 F1 of
 STREAM)
                                                              (CHCON1 (fetch
 FULLFILENAME
                                                                         of
 STREAM))
                                                              (AND (NOT NOERRORFLG)
                                                                   (\EOF.ACTION STREAM]
                                    READP _ [FUNCTION (LAMBDA (STREAM)
                                                        (NOT (EOFP STREAM]
                                    BACKFILEPTR _ [FUNCTION (LAMBDA (STREAM)
                                                              (replace
 F1 of
 STREAM
                                                                 with
 (fetch
 F2 of
 STREAM]
                                    EOFP _ (FUNCTION (LAMBDA (STREAM)
                                                       (AND (NOT (fetch
 F1 of
 STREAM))
                                                            (EQ (NCHARS (fetch
 FULLFILENAME
                                                                           of
 STREAM))
                                                                0])
)



(* ;; "(DECLARE%%: DONTEVAL@LOAD DOCOPY (P (\STRINGSTREAM.INIT)))")


(DEFINEQ

(GETSTREAM

  [LAMBDA (FILE ACCESS NOERROR)                              (* rrb "31-Oct-85 09:36")

                                                             (* ; "USER ENTRY")

    (\GETSTREAM
 FILE ACCESS NOERROR])

(\CLEAROFD

  [LAMBDA NIL                                                (* lmm "30-SEP-80 20:08")

                                                             (* ; 

                                                "If GETOFD caches its args, this can clear the cache")

    NIL])

(\GETSTREAM

  [LAMBDA (X ACCESS NOERROR)
                                 (* ; "Edited 17-Jan-87 16:08 by bvm:")


    (* ;; "\GETSTREAM accepts a stream, NIL, T, or a window, and returns a corresponding stream.  ACCESS is INPUT, OUTPUT, APPEND, BOTH or NIL.  NOERROR, if non-NIL, means to return NIL if the file is not open in the specified access mode; otherwise, an error is caused.")


    (DECLARE
 (GLOBALVARS \DEFAULTLINEBUF \DEFAULTTTYDISPLAYSTREAM))
    (COND
       ((NULL X)
        (SELECTQ ACCESS
            (INPUT (COND
                      ((AND (EQ *STANDARD-INPUT* \DEFAULTLINEBUF)
                            (EQ \KEYBOARD.STREAM (fetch
 (LINEBUFFER KEYBOARDSTREAM) of
 \LINEBUF.OFD))
                            )
                       (\CREATE.TTYDISPLAYSTREAM)))
                   *STANDARD-INPUT*)
            (OUTPUT (COND
                       ((AND \DEFAULTTTYDISPLAYSTREAM (EQ *STANDARD-OUTPUT* \DEFAULTTTYDISPLAYSTREAM)
                             )
                        (\CREATE.TTYDISPLAYSTREAM)))
                    *STANDARD-OUTPUT*)
            (\IOMODEP
 (COND
                         ((NOT (EQ *STANDARD-INPUT* \LINEBUF.OFD))
                          *STANDARD-INPUT*)
                         (T *STANDARD-OUTPUT*))
                   ACCESS NOERROR)))
       ((EQ X T)
        (SELECTQ ACCESS
            (INPUT (COND
                      ((EQ \LINEBUF.OFD \DEFAULTLINEBUF)
                       (\CREATE.TTYDISPLAYSTREAM)))
                   \LINEBUF.OFD)
            ((OUTPUT NIL) 
                 (COND
                    ((AND \DEFAULTTTYDISPLAYSTREAM (EQ \TERM.OFD \DEFAULTTTYDISPLAYSTREAM))
                     (\CREATE.TTYDISPLAYSTREAM)))
                 \TERM.OFD)
            (\FILE.NOT.OPEN X NOERROR)))
       ((type?
 STREAM X)
        (\IOMODEP
 X ACCESS NOERROR))
       ((LITATOM X)
        (AND (NOT NOERROR)
             (ERROR "LITATOM 'streams' no longer supported" X)))
       ((AND (OR (EQ ACCESS 'OUTPUT)
                 (NULL ACCESS))
             (type?
 WINDOW X))
        (fetch
 (WINDOW DSP) of
 X))
       (T (\FILE.NOT.OPEN X NOERROR])
)
(DECLARE%: DONTCOPY 
(* "FOLLOWING DEFINITIONS EXPORTED")(DECLARE%: EVAL@COMPILE 

(PUTPROPS \INSTREAMARG
 MACRO
 ((STRM NOERRORFLG)
                              (\GETSTREAM
 STRM 'INPUT NOERRORFLG)))

(PUTPROPS \OUTSTREAMARG
 MACRO
 ((STRM NOERRORFLG)
                               (\GETSTREAM
 STRM 'OUTPUT NOERRORFLG)))

(PUTPROPS \STREAMARG
 MACRO
 [OPENLAMBDA (STRM NOERRORFLG)
                             (COND
                                (NOERRORFLG (\GETSTREAM
 STRM NIL T))
                                (T (\DTEST STRM 'STREAM])
)

(* "END EXPORTED DEFINITIONS")

)
(DECLARE%: EVAL@COMPILE 

(PUTPROPS GETOFD
 MACRO
 (= . GETSTREAM))

(PUTPROPS \GETOFD
 MACRO
 (= . \GETSTREAM))
)
(DECLARE%: DOEVAL@COMPILE DONTCOPY

(LOCALVARS . T)
)
(DECLARE%: DONTEVAL@LOAD DOEVAL@COMPILE DONTCOPY COMPILERVARS 

(ADDTOVAR NLAMA
 )

(ADDTOVAR NLAML
 )

(ADDTOVAR LAMA
 WHENCLOSE)
)
(DECLARE%: DONTCOPY
  (FILEMAP (NIL (2363 3482 (\ADD-OPEN-STREAM 2373 . 2654) (\GENERIC-UNREGISTER-STREAM 2656 . 3480)) (
3523 10587 (CLOSEALL 3533 . 4011) (CLOSEF 4013 . 5227) (EOFCLOSEF 5229 . 5529) (INPUT 5531 . 6301) (
OPENP 6303 . 6706) (OUTPUT 6708 . 7480) (POSITION 7482 . 8290) (RANDACCESSP 8292 . 8682) (\IOMODEP 
8684 . 9313) (WHENCLOSE 9315 . 10585)) (10588 10710 (STREAMADDPROP 10598 . 10708)) (11668 24521 (
\BASEBYTES.IO.INIT 11678 . 14878) (\MAKEBASEBYTESTREAM 14880 . 17808) (\MBS.OUTCHARFN 17810 . 18210) (
\BASEBYTES.NAME.FROM.STREAM 18212 . 18671) (\BASEBYTES.BOUT 18673 . 19427) (\BASEBYTES.SETFILEPTR 
19429 . 20050) (\BASEBYTES.READP 20052 . 20696) (\BASEBYTES.BIN 20698 . 21205) (\BASEBYTES.PEEKBIN 
21207 . 22037) (\BASEBYTES.TRUNCATEFN 22039 . 22547) (\BASEBYTES.OPENFN 22549 . 23343) (
\BASEBYTES.BLOCKIO 23345 . 24519)) (24644 27948 (OPENSTRINGSTREAM 24654 . 26363) (MAKE-STRING-FORMAT 
26365 . 27946)) (28220 32528 (\STRINGSTREAM.INIT 28230 . 32526)) (32605 35305 (GETSTREAM 32615 . 32846
) (\CLEAROFD 32848 . 33141) (\GETSTREAM 33143 . 35303)))))
STOP