(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "XCL" BASE 10) (FILECREATED "20-Jan-2022 09:16:52"  |{DSK}kaplan>Local>medley3.5>my-medley>sources>CLSTREAMS.;4| 53233 :PREVIOUS-DATE "27-Nov-2021 13:30:46" |{DSK}kaplan>Local>medley3.5>my-medley>sources>CLSTREAMS.;3|) ; Copyright (c) 1985-1988, 1990-1991 by Venue & Xerox Corporation. (PRETTYCOMPRINT CLSTREAMSCOMS) (RPAQQ CLSTREAMSCOMS ( (* |;;;| "Implements a number of stream functions from CommonLisp. See CLtL chapter 21") (COMS (* |;;| "documented functions and macros") (FUNCTIONS OPEN CL:CLOSE CL:STREAM-EXTERNAL-FORMAT) (FUNCTIONS CL:STREAM-ELEMENT-TYPE CL:INPUT-STREAM-P CL:OUTPUT-STREAM-P XCL:OPEN-STREAM-P) (COMS (FUNCTIONS FILE-STREAM-POSITION) (SETFS FILE-STREAM-POSITION)) (FUNCTIONS CL:MAKE-SYNONYM-STREAM XCL:SYNONYM-STREAM-P XCL:SYNONYM-STREAM-SYMBOL XCL:FOLLOW-SYNONYM-STREAMS) (FUNCTIONS CL:MAKE-BROADCAST-STREAM XCL:BROADCAST-STREAM-P XCL:BROADCAST-STREAM-STREAMS ) (FUNCTIONS CL:MAKE-CONCATENATED-STREAM XCL:CONCATENATED-STREAM-P XCL:CONCATENATED-STREAM-STREAMS) (FUNCTIONS CL:MAKE-TWO-WAY-STREAM XCL:TWO-WAY-STREAM-P XCL:TWO-WAY-STREAM-OUTPUT-STREAM XCL:TWO-WAY-STREAM-INPUT-STREAM) (FUNCTIONS CL:MAKE-ECHO-STREAM XCL:ECHO-STREAM-P XCL:ECHO-STREAM-INPUT-STREAM XCL:ECHO-STREAM-OUTPUT-STREAM) (FUNCTIONS CL:MAKE-STRING-INPUT-STREAM MAKE-CONCATENATED-STRING-INPUT-STREAM) (FUNCTIONS %MAKE-INITIAL-STRING-STREAM-CONTENTS) (FUNCTIONS CL:WITH-OPEN-STREAM CL:WITH-INPUT-FROM-STRING CL:WITH-OUTPUT-TO-STRING CL:WITH-OPEN-FILE) (FUNCTIONS CL:MAKE-STRING-OUTPUT-STREAM MAKE-FILL-POINTER-OUTPUT-STREAM CL:GET-OUTPUT-STREAM-STRING \\STRING-STREAM-OUTCHARFN \\ADJUSTABLE-STRING-STREAM-OUTCHARFN)) (COMS (* |;;| "helpers") (FUNCTIONS %NEW-FILE PREDICT-NAME) (DECLARE\: EVAL@COMPILE DONTCOPY (FUNCTIONS INTERLISP-ACCESS))) (COMS (* |;;| "methods for the special devices") (FNS %BROADCAST-STREAM-DEVICE-BOUT %BROADCAST-STREAM-DEVICE-OUTCHARFN %BROADCAST-STREAM-DEVICE-CLOSEFILE %BROADCAST-STREAM-DEVICE-FORCEOUTPUT) (FUNCTIONS %BROADCAST-STREAM-DEVICE-CHARSETFN) (FNS %CONCATENATED-STREAM-DEVICE-BIN %CONCATENATED-STREAM-DEVICE-CLOSEFILE %CONCATENATED-STREAM-DEVICE-EOFP %CONCATENATED-STREAM-DEVICE-PEEKBIN %CONCATENATED-STREAM-DEVICE-BACKFILEPTR) (FUNCTIONS %CONCATENATED-STREAM-DEVICE-CHARSETFN) (FNS %ECHO-STREAM-DEVICE-BIN) (FUNCTIONS %SYNONYM-STREAM-DEVICE-GET-INDIRECT-STREAM) (FNS %SYNONYM-STREAM-DEVICE-BIN %SYNONYM-STREAM-DEVICE-BOUT %SYNONYM-STREAM-DEVICE-OUTCHARFN %SYNONYM-STREAM-DEVICE-CLOSEFILE %SYNONYM-STREAM-DEVICE-EOFP %SYNONYM-STREAM-DEVICE-FORCEOUTPUT %SYNONYM-STREAM-DEVICE-GETFILEINFO %SYNONYM-STREAM-DEVICE-PEEKBIN %SYNONYM-STREAM-DEVICE-READP %SYNONYM-STREAM-DEVICE-BACKFILEPTR %SYNONYM-STREAM-DEVICE-SETFILEINFO %SYNONYM-STREAM-DEVICE-CHARSETFN) (FNS %TWO-WAY-STREAM-DEVICE-BIN %TWO-WAY-STREAM-DEVICE-INPUTSTREAM %TWO-WAY-STREAM-DEVICE-BOUT %TWO-WAY-STREAM-DEVICE-OUTPUTSTREAM %TWO-WAY-STREAM-DEVICE-OUTCHARFN %TWO-WAY-STREAM-DEVICE-CLOSEFILE %TWO-WAY-STREAM-DEVICE-EOFP %TWO-WAY-STREAM-DEVICE-READP %TWO-WAY-STREAM-DEVICE-BACKFILEPTR %TWO-WAY-STREAM-DEVICE-FORCEOUTPUT %TWO-WAY-STREAM-DEVICE-PEEKBIN %TWO-WAY-STREAM-DEVICE-CHARSETFN) (FUNCTIONS %FILL-POINTER-STREAM-DEVICE-CLOSEFILE %FILL-POINTER-STREAM-DEVICE-GETFILEPTR ) (GLOBALVARS %SYNONYM-STREAM-DEVICE %BROADCAST-STREAM-DEVICE %CONCATENATED-STREAM-DEVICE %TWO-WAY-STREAM-DEVICE %ECHO-STREAM-DEVICE \\FILL-POINTER-STREAM-DEVICE)) (COMS (* |;;| "helper stuff") (FNS %SYNONYM-STREAM-DEVICE-GET-STREAM)) (COMS (* |;;| "module initialization") (VARIABLES *DEBUG-IO* *QUERY-IO* *TERMINAL-IO* *ERROR-OUTPUT* *STANDARD-OUTPUT* *STANDARD-INPUT*) (FUNCTIONS %INITIALIZE-STANDARD-STREAMS) (FNS %INITIALIZE-CLSTREAM-TYPES) (DECLARE\: DONTEVAL@LOAD DOCOPY (* \; "initialization") (P (%INITIALIZE-CLSTREAM-TYPES) (%INITIALIZE-STANDARD-STREAMS)))) (PROP FILETYPE CLSTREAMS))) (* |;;;| "Implements a number of stream functions from CommonLisp. See CLtL chapter 21") (* |;;| "documented functions and macros") (CL:DEFUN OPEN (FILENAME &KEY (DIRECTION :INPUT) (ELEMENT-TYPE 'CL:STRING-CHAR) (IF-EXISTS NIL EXISTS-P) (IF-DOES-NOT-EXIST NIL DOES-NOT-EXIST-P) (EXTERNAL-FORMAT :DEFAULT)) (* |;;;| "Return a stream which reads from or writes to Filename. Defined keywords: :direction (one of :input, :output or :probe :element-type), Type of object to read or write, default String-Char, :if-exists (one of :error, :new-version, :overwrite, :append or nil), :if-does-not-exist (one of :error, :create or nil). :external-format (one of :DEFAULT, :EUC, :JIS, :W-MS, :MS or :XCCS). The specification of :external-format is based on the JEIDA proposal. See the manual for details.") (CL:UNLESS (MEMQ DIRECTION '(:INPUT :OUTPUT :IO :PROBE)) (CL:ERROR "~S isn't a valid direction for open." DIRECTION)) (CL:UNLESS (CL:MEMBER ELEMENT-TYPE '(CL:STRING-CHAR CL:SIGNED-BYTE CL:UNSIGNED-BYTE ( CL:UNSIGNED-BYTE 8) (CL:SIGNED-BYTE 8) CL:CHARACTER :DEFAULT) :TEST 'CL:EQUAL) (CL:ERROR "~S isn't an implemented element-type for open." ELEMENT-TYPE)) (LET ((PATHNAME (PATHNAME FILENAME)) (FOR-INPUT (MEMQ DIRECTION '(:IO :INPUT))) (FOR-OUTPUT (MEMQ DIRECTION '(:IO :OUTPUT))) (ACCESS (INTERLISP-ACCESS DIRECTION)) (FILE-TYPE (IF (CL:MEMBER ELEMENT-TYPE '(CL:UNSIGNED-BYTE CL:SIGNED-BYTE (CL:UNSIGNED-BYTE 8) (CL:SIGNED-BYTE 8)) :TEST 'CL:EQUAL) THEN 'BINARY ELSE 'TEXT)) (STREAM NIL)) (* |;;;| "Do hairy defaulting of :if-exists and :if-does-not-exist keywords.") (CL:UNLESS EXISTS-P (SETQ IF-EXISTS (CL:IF (EQ (CL:PATHNAME-VERSION PATHNAME) :NEWEST) :NEW-VERSION :ERROR))) (* \;  "If the file does not exist, it is OK to have :if-exists :overwrite. ") (CL:UNLESS DOES-NOT-EXIST-P (SETQ IF-DOES-NOT-EXIST (COND ((OR (EQ IF-EXISTS :APPEND) (EQ DIRECTION :INPUT)) :ERROR) ((EQ DIRECTION :PROBE) NIL) (T :CREATE)))) (CL:LOOP (* \;  "See if the file exists and handle the existential keywords.") (LET* ((NAME (PREDICT-NAME PATHNAME)) (CL:NAMESTRING (MKSTRING NAME))) (IF NAME THEN (* \; "file exists") (IF FOR-OUTPUT THEN (* |;;| "open for output/both") (CASE IF-EXISTS (:ERROR (CL:CERROR "write it anyway." "File ~A already exists." CL:NAMESTRING) (SETQ STREAM (OPENSTREAM CL:NAMESTRING ACCESS NIL `((TYPE ,FILE-TYPE) (EXTERNALFORMAT ,EXTERNAL-FORMAT)))) (RETURN NIL)) ((:NEW-VERSION :SUPERSEDE :RENAME :RENAME-AND-DELETE) (SETQ STREAM (OPENSTREAM PATHNAME ACCESS 'NEW `((TYPE ,FILE-TYPE) (EXTERNALFORMAT ,EXTERNAL-FORMAT)))) (RETURN NIL)) (:OVERWRITE (SETQ STREAM (OPENSTREAM CL:NAMESTRING ACCESS 'OLD `((TYPE ,FILE-TYPE) (EXTERNALFORMAT ,EXTERNAL-FORMAT)))) (RETURN NIL)) (:APPEND (IF (EQ DIRECTION :OUTPUT) THEN (* \;  "if the direction is output it is the same as interlisp append") (SETQ STREAM (OPENSTREAM CL:NAMESTRING 'APPEND 'OLD `((TYPE ,FILE-TYPE) (EXTERNALFORMAT ,EXTERNAL-FORMAT)) )) ELSE (* \;  "if direction is io it opens the file for both and goes to the end of the file") (SETQ STREAM (OPENSTREAM CL:NAMESTRING 'BOTH 'OLD `((TYPE ,FILE-TYPE) (EXTERNALFORMAT ,EXTERNAL-FORMAT)))) (SETFILEPTR STREAM -1)) (RETURN NIL)) ((NIL) (CL:RETURN-FROM OPEN NIL)) (T (CL:ERROR "~S is not a valid value for :if-exists." IF-EXISTS))) |elseif| FOR-INPUT |then| (* |;;| "open for input/both") (SETQ STREAM (OPENSTREAM CL:NAMESTRING ACCESS 'OLD `((TYPE ,FILE-TYPE) (EXTERNALFORMAT ,EXTERNAL-FORMAT)))) (RETURN NIL) |else| (* |;;| "open for probe") (SETQ STREAM (|create| STREAM FULLFILENAME _ (FULLNAME CL:NAMESTRING))) (RETURN NIL)) |else| (* |;;| "file does not exist") (|if| FOR-OUTPUT |then| (CASE IF-DOES-NOT-EXIST (:ERROR (CL:CERROR "prompt for a new name." 'XCL:FILE-NOT-FOUND :PATHNAME PATHNAME) (CL:FORMAT *QUERY-IO* "~&New file name: ") (SETQ PATHNAME (PATHNAME (CL:READ-LINE *QUERY-IO*)))) (:CREATE (SETQ STREAM (OPENSTREAM PATHNAME ACCESS 'NEW `((TYPE ,FILE-TYPE) (EXTERNALFORMAT ,EXTERNAL-FORMAT)))) (RETURN NIL)) ((NIL) (CL:RETURN-FROM OPEN NIL)) (T (CL:ERROR "~S is not a valid value for :if-does-not-exist." IF-DOES-NOT-EXIST))) |elseif| FOR-INPUT |then| (CASE IF-DOES-NOT-EXIST (:ERROR (CL:CERROR "prompt for a new name." 'XCL:FILE-NOT-FOUND :PATHNAME PATHNAME) (CL:FORMAT *QUERY-IO* "~&New file name: ") (SETQ PATHNAME (PATHNAME (CL:READ-LINE *QUERY-IO*)))) (:CREATE (%NEW-FILE PATHNAME)) ((NIL) (CL:RETURN-FROM OPEN NIL)) (T (CL:ERROR "~S is not a valid value for :if-does-not-exist." IF-DOES-NOT-EXIST))) |else| (* \; "Open for probe.") (RETURN NIL))))) (STREAMPROP STREAM :FILE-STREAM-P T) STREAM)) (CL:DEFUN CL:CLOSE (STREAM &KEY ABORT) (* |;;;| "Close a stream. If ABORT, then don't keep the file") (|if| (STREAMP STREAM) |then| (|if| (OPENP STREAM) |then| (* |;;|  "determine 'deletability' of stream's file before closing, as that trashes the info") (LET ((ABORTABLE (AND (DIRTYABLE STREAM) (NOT (APPENDONLY STREAM))))) (CLOSEF STREAM) (|if| (AND ABORT ABORTABLE) |then| (* \;  "eventually we will change device CLOSEF methods to take an ABORT arg. For now, simulate it.") (DELFILE (CL:NAMESTRING STREAM))))) |else| (ERROR "Closing a non-stream" STREAM)) T) (CL:DEFUN CL:STREAM-EXTERNAL-FORMAT (STREAM) (\\EXTERNALFORMAT STREAM)) (CL:DEFUN CL:STREAM-ELEMENT-TYPE (STREAM) 'CL:UNSIGNED-BYTE) (CL:DEFUN CL:INPUT-STREAM-P (STREAM) (CL:WHEN (NOT (STREAMP STREAM)) (\\ILLEGAL.ARG STREAM)) (* |;;| "we return T instead of the stream because Symbolics does") (AND (\\IOMODEP STREAM 'INPUT T) T)) (CL:DEFUN CL:OUTPUT-STREAM-P (STREAM) (CL:WHEN (NOT (STREAMP STREAM)) (\\ILLEGAL.ARG STREAM)) (* |;;| "we return T instead of the stream because Symbolics does") (AND (\\IOMODEP STREAM 'OUTPUT T) T)) (CL:DEFUN XCL:OPEN-STREAM-P (STREAM) (* |;;| "is stream an open stream?") (AND (STREAMP STREAM) (OPENED STREAM))) (CL:DEFUN FILE-STREAM-POSITION (STREAM) (GETFILEPTR STREAM)) (CL:DEFSETF FILE-STREAM-POSITION SETFILEPTR) (CL:DEFUN CL:MAKE-SYNONYM-STREAM (CL:SYMBOL) (* |;;| "A CommonLisp function for shadowing a stream. See CLtL p. 329") (LET ((STREAM (|create| STREAM DEVICE _ %SYNONYM-STREAM-DEVICE ACCESS _ 'BOTH F1 _ CL:SYMBOL LINELENGTH _ (|fetch| (STREAM LINELENGTH) |of| (CL:SYMBOL-VALUE CL:SYMBOL)) OUTCHARFN _ (FUNCTION %SYNONYM-STREAM-DEVICE-OUTCHARFN)))) (STREAMPROP STREAM 'XCL:SYNONYM-STREAM-P T) (* |;;| "save the synonym stream in the OPENFILELST field of %SYNONYM-STREAM-DEVICE") (|replace| (FDEV OPENFILELST) |of| %SYNONYM-STREAM-DEVICE |with| (CONS STREAM (|fetch| (FDEV OPENFILELST ) |of| %SYNONYM-STREAM-DEVICE ))) STREAM)) (CL:DEFUN XCL:SYNONYM-STREAM-P (STREAM) (STREAMPROP STREAM 'XCL:SYNONYM-STREAM-P)) (CL:DEFUN XCL:SYNONYM-STREAM-SYMBOL (STREAM) (AND (XCL:SYNONYM-STREAM-P STREAM) (FETCH (STREAM F1) OF STREAM))) (CL:DEFUN XCL:FOLLOW-SYNONYM-STREAMS (STREAM) (* |;;;| "Return the non-synonym stream at the heart of STREAM.") (CL:IF (XCL:SYNONYM-STREAM-P STREAM) (XCL:FOLLOW-SYNONYM-STREAMS (CL:SYMBOL-VALUE (XCL:SYNONYM-STREAM-SYMBOL STREAM))) STREAM)) (CL:DEFUN CL:MAKE-BROADCAST-STREAM (&REST STREAMS) (* |;;| "CommonLisp function that makes a broadcast stream. See CLtL p329") (IF (FOR STREAM? IN STREAMS ALWAYS (STREAMP STREAM?)) THEN (LET ((STREAM (|create| STREAM DEVICE _ %BROADCAST-STREAM-DEVICE ACCESS _ 'OUTPUT F1 _ STREAMS OUTCHARFN _ (FUNCTION %BROADCAST-STREAM-DEVICE-OUTCHARFN)))) (STREAMPROP STREAM 'XCL:BROADCAST-STREAM-P T) STREAM) ELSE (\\ILLEGAL.ARG (FOR STREAM? IN STREAMS WHEN (NOT (STREAMP STREAM?)) DO (RETURN STREAM?))))) (CL:DEFUN XCL:BROADCAST-STREAM-P (STREAM) (* |;;| "is stream a broadcast stream?") (STREAMPROP STREAM 'XCL:BROADCAST-STREAM-P)) (CL:DEFUN XCL:BROADCAST-STREAM-STREAMS (STREAM) (* |;;| "return all of the streams that STREAM broadcasts to") (AND (XCL:BROADCAST-STREAM-P STREAM) (FETCH (STREAM F1) OF STREAM))) (CL:DEFUN CL:MAKE-CONCATENATED-STREAM (&REST STREAMS) (* |;;| "CommonLisp function that creates a concatenated stream. See CLtL p. 329") (IF (FOR STREAM? IN STREAMS ALWAYS (STREAMP STREAM?)) THEN (LET ((STREAM (|create| STREAM DEVICE _ %CONCATENATED-STREAM-DEVICE ACCESS _ 'INPUT F1 _ STREAMS))) (STREAMPROP STREAM 'XCL:CONCATENATED-STREAM-P T) STREAM) ELSE (\\ILLEGAL.ARG (FOR STREAM? IN STREAMS WHEN (NOT (STREAMP STREAM?)) DO (RETURN STREAM?))))) (CL:DEFUN XCL:CONCATENATED-STREAM-P (STREAM) (STREAMPROP STREAM 'XCL:CONCATENATED-STREAM-P)) (CL:DEFUN XCL:CONCATENATED-STREAM-STREAMS (STREAM) (* |;;| "return all of STREAM's concatenated streams") (AND (XCL:CONCATENATED-STREAM-P STREAM) (FETCH (STREAM F1) OF STREAM))) (CL:DEFUN CL:MAKE-TWO-WAY-STREAM (CL::INPUT-STREAM CL::OUTPUT-STREAM) (* |;;| "A CommonLisp function for splicing together two streams. See CLtL p. 329") (CL:UNLESS (STREAMP CL::INPUT-STREAM) (\\ILLEGAL.ARG CL::INPUT-STREAM)) (CL:UNLESS (STREAMP CL::OUTPUT-STREAM) (\\ILLEGAL.ARG CL::OUTPUT-STREAM)) (LET ((STREAM (|create| STREAM DEVICE _ %TWO-WAY-STREAM-DEVICE ACCESS _ 'BOTH F1 _ CL::INPUT-STREAM F2 _ CL::OUTPUT-STREAM LINELENGTH _ (|fetch| (STREAM LINELENGTH) |of| CL::OUTPUT-STREAM) OUTCHARFN _ (FUNCTION %TWO-WAY-STREAM-DEVICE-OUTCHARFN)))) (STREAMPROP STREAM 'XCL:TWO-WAY-STREAM-P T) (* |;;| "save STREAM in the OPENFILELST field of %TWO-WAY-STREAM-DEVICE") (|replace| (FDEV OPENFILELST) |of| %TWO-WAY-STREAM-DEVICE |with| (CONS STREAM (|fetch| (FDEV OPENFILELST ) |of| %TWO-WAY-STREAM-DEVICE ))) STREAM)) (CL:DEFUN XCL:TWO-WAY-STREAM-P (STREAM) (* |;;| "is STREAM a two-way stream?") (STREAMPROP STREAM 'XCL:TWO-WAY-STREAM-P)) (CL:DEFUN XCL:TWO-WAY-STREAM-OUTPUT-STREAM (STREAM) (AND (XCL:TWO-WAY-STREAM-P STREAM) (FETCH (STREAM F2) OF STREAM))) (CL:DEFUN XCL:TWO-WAY-STREAM-INPUT-STREAM (STREAM) (AND (XCL:TWO-WAY-STREAM-P STREAM) (FETCH (STREAM F1) OF STREAM))) (CL:DEFUN CL:MAKE-ECHO-STREAM (CL::INPUT-STREAM CL::OUTPUT-STREAM) (* |;;| "A CommonLisp function for making an echo stream. See CLtL p. 329") (CL:UNLESS (STREAMP CL::INPUT-STREAM) (\\ILLEGAL.ARG CL::INPUT-STREAM)) (CL:UNLESS (STREAMP CL::OUTPUT-STREAM) (\\ILLEGAL.ARG CL::OUTPUT-STREAM)) (LET ((STREAM (|create| STREAM DEVICE _ %ECHO-STREAM-DEVICE ACCESS _ 'BOTH F1 _ CL::INPUT-STREAM F2 _ CL::OUTPUT-STREAM LINELENGTH _ (|fetch| (STREAM LINELENGTH) |of| CL::OUTPUT-STREAM) OUTCHARFN _ (FUNCTION %TWO-WAY-STREAM-DEVICE-OUTCHARFN)))) (STREAMPROP STREAM 'XCL:ECHO-STREAM-P T) (* |;;| "save STREAM in the OPENFILELST field of %ECHO-STREAM-DEVICE") (|replace| (FDEV OPENFILELST) |of| %ECHO-STREAM-DEVICE |with| (CONS STREAM (|fetch| (FDEV OPENFILELST ) |of| %ECHO-STREAM-DEVICE ))) STREAM)) (CL:DEFUN XCL:ECHO-STREAM-P (STREAM) (* |;;| "is stream an echo stream?") (STREAMPROP STREAM 'XCL:ECHO-STREAM-P)) (CL:DEFUN XCL:ECHO-STREAM-INPUT-STREAM (STREAM) (AND (XCL:ECHO-STREAM-P STREAM) (FETCH (STREAM F1) OF STREAM))) (CL:DEFUN XCL:ECHO-STREAM-OUTPUT-STREAM (STREAM) (AND (XCL:ECHO-STREAM-P STREAM) (FETCH (STREAM F2) OF STREAM))) (CL:DEFUN CL:MAKE-STRING-INPUT-STREAM (STRING &OPTIONAL (CL::START 0) (CL::END NIL)) (* |;;;| "A CommonLisp function for producing a stream from a string. See CLtL p. 330") (OPENSTRINGSTREAM (|if| (OR (NOT (CL:ZEROP CL::START)) (NOT (NULL CL::END))) |then| (* |;;| "A displaced array is ok here because the stream's uses GETBASEBYTE directly and doesn't go through the array code at all. ") (SUBSTRING STRING (CL:1+ CL::START) CL::END) |else| STRING) 'INPUT)) (CL:DEFUN MAKE-CONCATENATED-STRING-INPUT-STREAM (STRINGS) (COND ((NULL STRINGS) NIL) ((NULL (CL:REST STRINGS)) (CL:MAKE-STRING-INPUT-STREAM (CL:FIRST STRINGS))) (T (CL:APPLY 'CL:MAKE-CONCATENATED-STREAM (FOR STRING IN STRINGS COLLECT (  CL:MAKE-STRING-INPUT-STREAM STRING)))))) (CL:DEFUN %MAKE-INITIAL-STRING-STREAM-CONTENTS () (CL:MAKE-ARRAY '(256) :ELEMENT-TYPE 'CL:STRING-CHAR :EXTENDABLE T :FILL-POINTER 0)) (DEFMACRO CL:WITH-OPEN-STREAM ((VAR STREAM) &BODY (BODY DECLS)) (LET ((ABORTP (GENSYM))) `(LET ((,VAR ,STREAM) (,ABORTP T)) ,@DECLS (CL:UNWIND-PROTECT (CL:MULTIPLE-VALUE-PROG1 (PROGN ,@BODY) (SETQ ,ABORTP NIL)) (CL:CLOSE ,VAR :ABORT ,ABORTP))))) (DEFMACRO CL:WITH-INPUT-FROM-STRING ((CL::VAR STRING &KEY (CL::INDEX NIL CL::INDEXP) (CL::START 0 CL::STARTP) (CL::END NIL CL:ENDP)) &BODY (CL::BODY CL::DECLS)) `(LET* ((CL::$STRING$ ,STRING) (CL::$START$ ,CL::START)) (DECLARE (LOCALVARS CL::$STRING$ CL::$START$)) (CL:WITH-OPEN-STREAM (,CL::VAR (CL:MAKE-STRING-INPUT-STREAM CL::$STRING$ CL::$START$ ,CL::END)) ,@CL::DECLS ,@(CL:IF CL::INDEXP (* |;;| "This exists as a fudge for the fat string problem. It WILL GO AWAY when STRINGSTREAMS HAVE THEIR OWN DEVICE.") `((CL:MULTIPLE-VALUE-PROG1 (PROGN ,@CL::BODY) (* |;;| "(IF (FASL::FAT-STRING-P $STRING$) (SETF ,INDEX (+ $START$ (IL:IQUOTIENT (IL:GETFILEPTR ,VAR) 2))) (SETF ,INDEX (+ $START$ (IL:GETFILEPTR ,VAR))))") (CL:SETF ,CL::INDEX (+ CL::$START$ (GETFILEPTR ,CL::VAR))))) CL::BODY)))) (DEFMACRO CL:WITH-OUTPUT-TO-STRING ((VAR &OPTIONAL (STRING NIL ST-P)) &BODY (FORMS DECLS)) (COND (ST-P `(CL:WITH-OPEN-STREAM (,VAR (MAKE-FILL-POINTER-OUTPUT-STREAM ,STRING)) ,@DECLS ,@FORMS)) (T `(CL:WITH-OPEN-STREAM (,VAR (CL:MAKE-STRING-OUTPUT-STREAM)) ,@DECLS (PROGN ,@FORMS (CL:GET-OUTPUT-STREAM-STRING ,VAR)))))) (DEFMACRO CL:WITH-OPEN-FILE ((VAR &REST OPEN-ARGS) &BODY (FORMS DECLS)) (* |;;;| "The file whose name is File-Name is opened using the OPEN-ARGS and bound to the variable VAR. The Forms are executed, and when they terminate, normally or otherwise, the file is closed.") (LET ((ABORTP (GENSYM))) `(LET ((,VAR (OPEN ,@OPEN-ARGS)) (,ABORTP T)) ,@DECLS (CL:UNWIND-PROTECT (CL:MULTIPLE-VALUE-PROG1 (PROGN ,@FORMS) (SETQ ,ABORTP NIL)) (CL:CLOSE ,VAR :ABORT ,ABORTP))))) (DEFINLINE CL:MAKE-STRING-OUTPUT-STREAM () (* |;;;| "A function for producing a string stream. See also the function get-output-stream-string. Also, see CLtL p. 330") (MAKE-FILL-POINTER-OUTPUT-STREAM)) (CL:DEFUN MAKE-FILL-POINTER-OUTPUT-STREAM (&OPTIONAL (STRING (%MAKE-INITIAL-STRING-STREAM-CONTENTS))) (DECLARE (GLOBALVARS \\FILL-POINTER-STREAM-DEVICE)) (|if| (NOT (CL:ARRAY-HAS-FILL-POINTER-P STRING)) |then| (\\ILLEGAL.ARG STRING) |else| (LET ((STREAM (|create| STREAM DEVICE _ \\FILL-POINTER-STREAM-DEVICE F1 _ STRING ACCESS _ 'OUTPUT OTHERPROPS _ '(STRING-OUTPUT-STREAM T)))) (* \;  "give it a canned property list to save some consing.") (|replace| (STREAM OUTCHARFN) |of| STREAM |with| (|if| (EXTENDABLE-ARRAY-P STRING) |then| (FUNCTION \\ADJUSTABLE-STRING-STREAM-OUTCHARFN ) |else| (FUNCTION \\STRING-STREAM-OUTCHARFN ))) (|replace| (STREAM STRMBOUTFN) |of| STREAM |with| (FUNCTION \\OUTCHAR)) STREAM))) (CL:DEFUN CL:GET-OUTPUT-STREAM-STRING (STRING-OUTPUT-STREAM) (* |;;;| "A CommonLisp function for getting the contents of the buffer created by a call to make-string-output-stream. See CLtL p. 330") (|if| (NOT (STREAMPROP STRING-OUTPUT-STREAM 'STRING-OUTPUT-STREAM)) |then| (ERROR "Stream not a string-output-stream" STRING-OUTPUT-STREAM) |else| (PROG1 (|fetch| (STREAM F1) |of| STRING-OUTPUT-STREAM) (|replace| (STREAM F1) |of| STRING-OUTPUT-STREAM |with| (  %MAKE-INITIAL-STRING-STREAM-CONTENTS ))))) (CL:DEFUN \\STRING-STREAM-OUTCHARFN (STREAM CHAR) (IF (OR (IEQP (FETCH (STREAM CHARPOSITION) OF STREAM) (FETCH (STREAM LINELENGTH) OF STREAM)) (EQ CHAR (CHARCODE EOL))) THEN (REPLACE (STREAM CHARPOSITION) OF STREAM WITH 0) ELSE (ADD (FETCH (STREAM CHARPOSITION) OF STREAM) 1)) (CL:VECTOR-PUSH (CL:CHARACTER CHAR) (FETCH (STREAM F1) OF STREAM))) (CL:DEFUN \\ADJUSTABLE-STRING-STREAM-OUTCHARFN (STREAM CHAR) (LET ((STRING (FETCH (STREAM F1) OF STREAM)) (CH (CL:CHARACTER CHAR))) (IF (OR (IEQP (FETCH (STREAM CHARPOSITION) OF STREAM) (FETCH (STREAM LINELENGTH) OF STREAM)) (EQ CHAR (CHARCODE EOL))) THEN (REPLACE (STREAM CHARPOSITION) OF STREAM WITH 0) ELSE (ADD (FETCH (STREAM CHARPOSITION) OF STREAM) 1)) (* |;;| "Do the equivalent of VECTOR-PUSH-EXTEND inline to save the significant! overhead of calculating the new length at each character.") (CL:UNLESS (CL:VECTOR-PUSH CH STRING) (LET ((CURRENT-LENGTH (CL:ARRAY-TOTAL-SIZE STRING))) (IF (>= CURRENT-LENGTH (CL:1- CL:ARRAY-TOTAL-SIZE-LIMIT)) THEN (PROCEED-CASE (CL:ERROR 'END-OF-FILE :STREAM STREAM) (SI::RETRY-OUTCHAR NIL :REPORT "VECTOR-PUSH the character anyway" :CONDITION END-OF-FILE (CL:VECTOR-PUSH CH (FETCH (STREAM F1) OF STREAM)))) ELSE (CL:ADJUST-ARRAY STRING (MIN (CL:1- CL:ARRAY-TOTAL-SIZE-LIMIT) (+ CURRENT-LENGTH (MAX (LRSH CURRENT-LENGTH 1) *DEFAULT-PUSH-EXTENSION-SIZE* )))) (CL:VECTOR-PUSH CH STRING)))))) (* |;;| "helpers") (CL:DEFUN %NEW-FILE (FILENAME) (CLOSEF (OPENSTREAM FILENAME 'OUTPUT 'NEW))) (CL:DEFUN PREDICT-NAME (PATHNAME) (LET ((PATH (CL:PROBE-FILE PATHNAME))) (IF PATH THEN (CL:NAMESTRING PATH)))) (DECLARE\: EVAL@COMPILE DONTCOPY (DEFMACRO INTERLISP-ACCESS (DIRECTION) `(CASE ,DIRECTION (:INPUT 'INPUT) (:OUTPUT 'OUTPUT) (:IO 'BOTH) (T NIL))) ) (* |;;| "methods for the special devices") (DEFINEQ (%broadcast-stream-device-bout (lambda (stream byte) (* \; "Edited 13-Jan-87 14:45 by hdj") (* |;;| "The BOUT method for the broadcast-stream device") (|for| s |in| (|fetch| f1 |of| stream) |do| (\\bout s byte)) byte) ) (%broadcast-stream-device-outcharfn (lambda (stream charcode) (* \; "Edited 18-Mar-87 11:00 by lal") (* |;;| "outcharfn for broadcast streams") (* |;;| "Using the charposition from the first stream in the broadcast stream list") (|for| s |in| (|fetch| (stream f1) |of| stream) |do| (\\outchar s charcode)) (|replace| (stream charposition) |of| stream |with| (|fetch| (stream charposition) |of| (car (|fetch| (stream f1) |of| stream)))) charcode) ) (%broadcast-stream-device-closefile (lambda (stream) (* |hdj| "26-Mar-86 16:28") (* |;;;| "The CLOSEFILE method for the broadcast-stream device") (|replace| access |of| stream |with| nil) (|replace| f1 |of| stream |with| nil) stream) ) (%broadcast-stream-device-forceoutput (lambda (|stream| |waitForFinish?|) (* |smL| "14-Aug-85 15:55") (* |;;;| "The FORCEOUTPUT method for the broadcast-stream device") (|for| \s |in| (|fetch| f1 |of| |stream|) |do| (forceoutput \s |waitForFinish?|))) ) ) (CL:DEFUN %BROADCAST-STREAM-DEVICE-CHARSETFN (STREAM NEWVALUE) (* |;;| "charset function for broadcast streams. Not clear what the value should be, so we arbitrarily return the value of the last stream.") (FOR S IN (FETCH (STREAM F1) OF STREAM) DO (SETQ $$VAL (ACCESS-CHARSET S NEWVALUE)))) (DEFINEQ (%concatenated-stream-device-bin (lambda (stream) (* \; "Edited 13-Jan-87 14:52 by hdj") (* |;;| "The BIN method for the concatenated-stream device") (while (fetch (stream f1) of stream) do (if (eofp (car (fetch (stream f1) of stream))) then (closef (pop (fetch (stream f1) of stream))) else (return (\\bin (car (fetch (stream f1) of stream))))) finally (* \; "the EOF case") (\\eof.action stream))) ) (%concatenated-stream-device-closefile (lambda (|stream|) (* |smL| "14-Aug-85 16:53") (* |;;;| "The CLOSEFILE method for the concatenated-stream device") (|replace| access |of| |stream| |with| nil) (|for| \s |in| (|fetch| f1 |of| |stream|) |do| (closef \s)) (|replace| f1 |of| |stream| |with| nil) |stream|) ) (%concatenated-stream-device-eofp (lambda (|stream|) (* \; "Edited 17-Mar-87 09:20 by lal") (* |;;;| "The EOFP method for the concatenated-stream device") (|while| (|fetch| f1 |of| |stream|) |do| (|if| (eofp (car (|fetch| f1 |of| |stream|))) |then| (closef (|pop| (|fetch| f1 |of| |stream|))) |else| (return nil)) |finally| (* \; "the EOF case") (return t))) ) (%concatenated-stream-device-peekbin (lambda (|stream| |noErrorFlg?|) (* |smL| "14-Aug-85 16:53") (* |;;;| "The PEEKBIN method for the concatenated-stream device") (|while| (|fetch| f1 |of| |stream|) |do| (|if| (eofp (car (|fetch| f1 |of| |stream|))) |then| (closef (|pop| (|fetch| f1 |of| |stream|))) |else| (return (\\peekbin (car (|fetch| f1 |of| |stream|))))) |finally| (* \; "the EOF case") (|if| |noErrorFlg?| |then| (return nil) |else| (\\eof.action |stream|)))) ) (%concatenated-stream-device-backfileptr (lambda (|stream|) (* \; "Edited 24-Mar-87 10:47 by lal") (* |;;| "concatenated streams are read sequentially and a list of them are kept in F1. as they are read, the used stream is removed from the list. \\backfileptr will work because 1) when a file is stream is used up the new one is read, at least one character's worth and 2) \\backfileptr only needs to back up one character") (\\backfileptr (car (|fetch| f1 |of| |stream|)))) ) ) (CL:DEFUN %CONCATENATED-STREAM-DEVICE-CHARSETFN (STREAM NEWVALUE) (* |;;| "the charset method for concatenated stream devices") (LET ((STREAMS (FETCH (STREAM F1) OF STREAM))) (IF STREAMS THEN (ACCESS-CHARSET (CAR STREAMS) NEWVALUE) ELSE 0))) (DEFINEQ (%echo-stream-device-bin (lambda (stream) (* |hdj| "21-Apr-86 18:33") (* |;;;| "The BIN method for the echo-stream device") (let ((byte (%two-way-stream-device-bin stream))) (\\bout stream byte) byte)) ) ) (CL:DEFUN %SYNONYM-STREAM-DEVICE-GET-INDIRECT-STREAM (SYNONYM-STREAM) (* |;;| "given a synonym-stream, find out what it is currently tracking") (CL:SYMBOL-VALUE (XCL:SYNONYM-STREAM-SYMBOL SYNONYM-STREAM))) (DEFINEQ (%synonym-stream-device-bin (lambda (stream) (* |hdj| "19-Mar-86 17:19") (* |;;;| "The BIN method for the synonym-stream device.") (\\bin (%synonym-stream-device-get-stream stream))) ) (%synonym-stream-device-bout (lambda (stream byte) (* |hdj| "19-Mar-86 17:20") (* |;;;| "The BOUT method for the synonym-stream device.") (\\bout (%synonym-stream-device-get-stream stream) byte)) ) (%SYNONYM-STREAM-DEVICE-OUTCHARFN (LAMBDA (STREAM CHARCODE) (* \; "Edited 3-Jan-90 15:25 by jds") (* |;;| " OUTCHARFN for synonym streams") (LET ((OTHER-STREAM (%SYNONYM-STREAM-DEVICE-GET-STREAM STREAM))) (\\OUTCHAR OTHER-STREAM CHARCODE) (|freplace| (STREAM CHARPOSITION) |of| STREAM |with| (|ffetch| (STREAM CHARPOSITION ) |of| OTHER-STREAM))) )) (%SYNONYM-STREAM-DEVICE-CLOSEFILE (LAMBDA (STREAM) (* \; "Edited 18-Dec-87 12:17 by sye") (* |;;;| "the CLOSEFILE method for the synonym-stream device") (|replace| F1 |of| STREAM |with| NIL) (* |;;|  "remove the synonym stream STREAM from the OPENFILELST field of %SYNONYM-STREAM-DEVICE") (|replace| (FDEV OPENFILELST) |of| %SYNONYM-STREAM-DEVICE |with| (DREMOVE STREAM (|fetch| (FDEV OPENFILELST) |of| %SYNONYM-STREAM-DEVICE))) STREAM)) (%synonym-stream-device-eofp (lambda (stream) (* |hdj| "19-Mar-86 17:20") (* |;;;| "The EOFP method for the synonym-stream device.") (\\eofp (%synonym-stream-device-get-stream stream))) ) (%synonym-stream-device-forceoutput (lambda (stream waitforfinish) (* |hdj| "19-Mar-86 17:09") (* |;;;| "The FORCEOUTPUT method for the synonym-stream device.") (forceoutput (%synonym-stream-device-get-stream stream) waitforfinish)) ) (%synonym-stream-device-getfileinfo (lambda (stream attribute device) (* |hdj| "19-Mar-86 17:10") (* |;;;| "The GETFILEINFO method for the synonym-stream device.") (getfileinfo (%synonym-stream-device-get-stream stream) attribute)) ) (%synonym-stream-device-peekbin (lambda (stream noerrorflg?) (* |hdj| "19-Mar-86 17:12") (* |;;;| "The PEEKBIN method for the synonym-stream device") (\\peekbin (%synonym-stream-device-get-stream stream) noerrorflg?)) ) (%synonym-stream-device-readp (lambda (stream flg) (readp (%synonym-stream-device-get-stream stream) flg))) (%synonym-stream-device-backfileptr (lambda (stream) (* |hdj| "26-Aug-86 17:35") (\\backfileptr (%synonym-stream-device-get-stream stream))) ) (%synonym-stream-device-setfileinfo (lambda (stream attribute value device) (* |hdj| "19-Mar-86 17:17") (* |;;;| "The SETFILEINFO method for the synonym-stream device.") (setfileinfo (%synonym-stream-device-get-stream stream) attribute value)) ) (%synonym-stream-device-charsetfn (lambda (stream newvalue) (* \; "Edited 11-Sep-87 16:01 by bvm:") (* |;;| "The charset method for the synonym-stream device.") (access-charset (%synonym-stream-device-get-stream stream) newvalue)) ) ) (DEFINEQ (%two-way-stream-device-bin (lambda (|stream|) (* |smL| "14-Aug-85 16:44") (* |;;;| "The BIN method for the two-way-stream device") (\\bin (|fetch| f1 |of| |stream|))) ) (%two-way-stream-device-inputstream (lambda (|stream|) (* \; "Edited 14-Apr-87 16:59 by bvm:") (* |;;;| "Fetch the real input for the two-way-stream device") (|fetch| f1 |of| |stream|)) ) (%two-way-stream-device-bout (lambda (stream byte) (* |hdj| "17-Sep-86 15:28") (* |;;| " the BOUT method for two-way streams") (\\bout (|fetch| f2 |of| stream) byte)) ) (%two-way-stream-device-outputstream (lambda (stream byte) (* \; "Edited 14-Apr-87 16:59 by bvm:") (* |;;| "Fetch the real output stream for two-way streams") (|fetch| f2 |of| stream)) ) (%TWO-WAY-STREAM-DEVICE-OUTCHARFN (LAMBDA (STREAM CHARCODE) (* \; "Edited 3-Jan-90 15:26 by jds") (* |;;| "outcharfn for two-way streams") (\\OUTCHAR (|fetch| (STREAM F2) |of| STREAM) CHARCODE) (|freplace| (STREAM CHARPOSITION) |of| STREAM |with| (|ffetch| (STREAM CHARPOSITION ) |of| (|ffetch| (STREAM F2) |of| STREAM)) ))) (%TWO-WAY-STREAM-DEVICE-CLOSEFILE (LAMBDA (|stream|) (* \; "Edited 18-Dec-87 12:32 by sye") (* |;;;| "The CLOSEFILE method for the two-way-stream device and echo-stream device") (LET ((STREAMDEVICE (|if| (XCL:TWO-WAY-STREAM-P |stream|) |then| %TWO-WAY-STREAM-DEVICE |else| %ECHO-STREAM-DEVICE))) (|replace| ACCESS |of| |stream| |with| NIL) (CLOSEF? (|fetch| F1 |of| |stream|)) (|replace| F1 |of| |stream| |with| NIL) (CLOSEF? (|fetch| F2 |of| |stream|)) (|replace| F2 |of| |stream| |with| NIL) (* |;;|  "remove STREAM from the OPENFILELST field of %TWO-WAY-STREAM-DEVICE or %ECHO-STREAM-DEVICE") (|replace| (FDEV OPENFILELST) |of| STREAMDEVICE |with| (DREMOVE |stream| (|fetch| (FDEV OPENFILELST ) |of| STREAMDEVICE))) |stream|))) (%two-way-stream-device-eofp (lambda (|stream|) (* |smL| "14-Aug-85 16:47") (* |;;;| "The EOFP method for the two-way-stream device") (\\eofp (|fetch| f1 |of| |stream|))) ) (%two-way-stream-device-readp (lambda (stream flg) (* \; "Edited 14-Apr-87 17:01 by bvm:") (* |;;;| "The READP method for the two-way-stream device") (readp (|fetch| f1 |of| stream) flg)) ) (%two-way-stream-device-backfileptr (lambda (stream) (* |hdj| "15-Sep-86 15:02") (\\backfileptr (|fetch| (stream f1) |of| stream)))) (%two-way-stream-device-forceoutput (lambda (|stream| |waitForFinish?|) (* |smL| "14-Aug-85 16:49") (* |;;;| "the FORCEOUTPUT method for the two-way-stream device") (forceoutput (|fetch| f2 |of| |stream|) |waitForFinish?|)) ) (%two-way-stream-device-peekbin (lambda (|stream| |noErrorFlg?|) (* |smL| "14-Aug-85 16:46") (* |;;;| "The PEEKBIN method for the two-way-stream device") (\\peekbin (|fetch| f1 |of| |stream|) |noErrorFlg?|)) ) (%two-way-stream-device-charsetfn (lambda (stream newvalue) (* \; "Edited 11-Sep-87 16:00 by bvm:") (* |;;| "The charset method for two-way streams. Unclear what this is supposed to mean--let's apply it only to the input side (in which case newvalue is senseless)") (access-charset (|fetch| (stream f1) |of| stream) newvalue)) ) ) (CL:DEFUN %FILL-POINTER-STREAM-DEVICE-CLOSEFILE (STREAM &OPTIONAL ABORTFLAG) (* |;;;| "the CLOSEFILE method for the fill-pointer-string-stream device") (|replace| F1 |of| STREAM |with| NIL) STREAM) (CL:DEFUN %FILL-POINTER-STREAM-DEVICE-GETFILEPTR (STREAM) (CL:LENGTH (|fetch| (STREAM F1) |of| STREAM))) (DECLARE\: DOEVAL@COMPILE DONTCOPY (GLOBALVARS %SYNONYM-STREAM-DEVICE %BROADCAST-STREAM-DEVICE %CONCATENATED-STREAM-DEVICE %TWO-WAY-STREAM-DEVICE %ECHO-STREAM-DEVICE \\FILL-POINTER-STREAM-DEVICE) ) (* |;;| "helper stuff") (DEFINEQ (%synonym-stream-device-get-stream (lambda (|stream|) (* \; "Edited 12-Jan-87 14:46 by hdj") (* |;;| "given a synonym-stream, find out what it is currently tracking") (cl:symbol-value (|fetch| (stream f1) |of| |stream|))) ) ) (* |;;| "module initialization") (CL:DEFVAR *DEBUG-IO*) (CL:DEFVAR *QUERY-IO*) (CL:DEFVAR *TERMINAL-IO*) (CL:DEFVAR *ERROR-OUTPUT*) (CL:DEFVAR *STANDARD-OUTPUT*) (CL:DEFVAR *STANDARD-INPUT*) (CL:DEFUN %INITIALIZE-STANDARD-STREAMS () (* |;;|  "Called when CLSTREAMS is loaded. Almost everything is same as *TERMINAL-IO* to start with.") (CL:SETQ *QUERY-IO* (CL:MAKE-TWO-WAY-STREAM (CL:MAKE-SYNONYM-STREAM '\\LINEBUF.OFD) (CL:MAKE-SYNONYM-STREAM '\\TERM.OFD))) (CL:SETQ *DEBUG-IO* *QUERY-IO*) (CL:SETQ *TERMINAL-IO* *QUERY-IO*) (CL:SETQ *ERROR-OUTPUT* (CL:MAKE-SYNONYM-STREAM '\\TERM.OFD))) (DEFINEQ (%initialize-clstream-types (lambda nil (* \; "Edited 14-Apr-87 17:08 by bvm:") (* |;;| "Initialize the CLSTREAMS package. This sets up some file devices for the functions make-two-way-stream-device, etc. See CLtL chapter 21") (setq %broadcast-stream-device (|create| fdev devicename _ (quote broadcast-stream-device) resetable _ nil randomaccessp _ nil nodirectories _ t buffered _ nil pagemapped _ nil fdbinable _ nil fdboutable _ nil fdextendable _ nil deviceinfo _ nil hostnamep _ (function nill) eventfn _ (function nill) directorynamep _ (function nill) reopenfile _ (function nill) closefile _ (function %broadcast-stream-device-closefile) getfilename _ (function nill) deletefile _ (function nill) generatefiles _ (function \\generatenofiles) renamefile _ (function nill) bin _ (function nill) bout _ (function %broadcast-stream-device-bout) peekbin _ (function nill) readp _ (function nill) eofp _ (function true) blockin _ (function \\generic.bins) blockout _ (function nill) forceoutput _ (function %broadcast-stream-device-forceoutput) getfileinfo _ (function nill) setfileinfo _ (function nill) charsetfn _ (function %broadcast-stream-device-charsetfn))) (setq %concatenated-stream-device (|create| fdev devicename _ (quote concatenated-stream-device) resetable _ nil randomaccessp _ nil nodirectories _ t buffered _ nil pagemapped _ nil fdbinable _ nil fdboutable _ nil fdextendable _ nil deviceinfo _ nil hostnamep _ (function nill) eventfn _ (function nill) directorynamep _ (function nill) reopenfile _ (function nill) closefile _ (function %concatenated-stream-device-closefile) getfilename _ (function nill) deletefile _ (function nill) generatefiles _ (function \\generatenofiles) renamefile _ (function nill) bin _ (function %concatenated-stream-device-bin) bout _ (function nill) peekbin _ (function %concatenated-stream-device-peekbin) readp _ (function \\generic.readp) backfileptr _ (function %concatenated-stream-device-backfileptr) eofp _ (function %concatenated-stream-device-eofp) blockin _ (function \\generic.bins) blockout _ (function nill) forceoutput _ (function nill) getfileinfo _ (function nill) setfileinfo _ (function nill) charsetfn _ (function %concatenated-stream-device-charsetfn))) (setq %two-way-stream-device (|create| fdev devicename _ (quote two-way-stream-device) resetable _ nil randomaccessp _ nil nodirectories _ t buffered _ nil pagemapped _ nil fdbinable _ nil fdboutable _ nil fdextendable _ nil input-indirected _ t output-indirected _ t deviceinfo _ nil hostnamep _ (function nill) eventfn _ (function nill) directorynamep _ (function nill) reopenfile _ (function nill) closefile _ (function %two-way-stream-device-closefile) getfilename _ (function nill) deletefile _ (function nill) generatefiles _ (function \\generatenofiles) renamefile _ (function nill) bin _ (function %two-way-stream-device-bin) bout _ (function %two-way-stream-device-bout) peekbin _ (function %two-way-stream-device-peekbin) readp _ (function %two-way-stream-device-readp) backfileptr _ (function %two-way-stream-device-backfileptr) eofp _ (function %two-way-stream-device-eofp) blockin _ (function \\generic.bins) blockout _ (function \\generic.bouts) forceoutput _ (function %two-way-stream-device-forceoutput) getfileinfo _ (function nill) setfileinfo _ (function nill) charsetfn _ (function %two-way-stream-device-charsetfn) inputstream _ (function %two-way-stream-device-inputstream) outputstream _ (function %two-way-stream-device-outputstream))) (setq %echo-stream-device (|create| fdev |using| %two-way-stream-device devicename _ (quote echo-stream-device) bin _ (function %echo-stream-device-bin))) (setq %synonym-stream-device (|create| fdev devicename _ (quote synonym-stream-device) resetable _ nil randomaccessp _ nil nodirectories _ t buffered _ nil pagemapped _ nil fdbinable _ nil fdboutable _ nil fdextendable _ nil deviceinfo _ nil input-indirected _ t output-indirected _ t hostnamep _ (function nill) eventfn _ (function nill) directorynamep _ (function nill) reopenfile _ (function nill) closefile _ (function %synonym-stream-device-closefile) getfilename _ (function nill) deletefile _ (function nill) generatefiles _ (function \\generatenofiles) renamefile _ (function nill) bin _ (function %synonym-stream-device-bin) bout _ (function %synonym-stream-device-bout) peekbin _ (function %synonym-stream-device-peekbin) readp _ (function %synonym-stream-device-readp) backfileptr _ (function %synonym-stream-device-backfileptr) eofp _ (function %synonym-stream-device-eofp) blockin _ (function \\generic.bins) blockout _ (function \\generic.bouts) forceoutput _ (function %synonym-stream-device-forceoutput) getfileinfo _ (function %synonym-stream-device-getfileinfo) setfileinfo _ (function %synonym-stream-device-setfileinfo) inputstream _ (function %synonym-stream-device-get-indirect-stream) outputstream _ (function %synonym-stream-device-get-indirect-stream) charsetfn _ (function %synonym-stream-device-charsetfn))) (setq \\fill-pointer-stream-device (|create| fdev devicename _ (quote fill-pointer-stream-device) resetable _ nil randomaccessp _ nil nodirectories _ t buffered _ nil pagemapped _ nil fdbinable _ nil fdboutable _ nil fdextendable _ nil deviceinfo _ nil hostnamep _ (function nill) eventfn _ (function nill) directorynamep _ (function nill) openfile _ (function nill) reopenfile _ (function nill) closefile _ (function %fill-pointer-stream-device-closefile) getfilename _ (function nill) deletefile _ (function nill) generatefiles _ (function \\generatenofiles) renamefile _ (function nill) bin _ (function \\illegal.deviceop) bout _ (function nill) peekbin _ (function \\illegal.deviceop) readp _ (function \\illegal.deviceop) eofp _ (function nill) blockin _ (function \\illegal.deviceop) blockout _ (function \\generic.bouts) forceoutput _ (function nill) getfileptr _ (function %fill-pointer-stream-device-getfileptr) setfileinfo _ (function \\illegal.deviceop)))) ) ) (DECLARE\: DONTEVAL@LOAD DOCOPY (%INITIALIZE-CLSTREAM-TYPES) (%INITIALIZE-STANDARD-STREAMS) ) (PUTPROPS CLSTREAMS FILETYPE CL:COMPILE-FILE) (PUTPROPS CLSTREAMS COPYRIGHT ("Venue & Xerox Corporation" 1985 1986 1987 1988 1990 1991)) (DECLARE\: DONTCOPY (FILEMAP (NIL (5165 14140 (OPEN 5165 . 14140)) (14142 15068 (CL:CLOSE 14142 . 15068)) (15070 15148 ( CL:STREAM-EXTERNAL-FORMAT 15070 . 15148)) (15150 15217 (CL:STREAM-ELEMENT-TYPE 15150 . 15217)) (15219 15453 (CL:INPUT-STREAM-P 15219 . 15453)) (15455 15691 (CL:OUTPUT-STREAM-P 15455 . 15691)) (15693 15830 (XCL:OPEN-STREAM-P 15693 . 15830)) (15832 15899 (FILE-STREAM-POSITION 15832 . 15899)) (15951 17294 ( CL:MAKE-SYNONYM-STREAM 15951 . 17294)) (17296 17385 (XCL:SYNONYM-STREAM-P 17296 . 17385)) (17387 17525 (XCL:SYNONYM-STREAM-SYMBOL 17387 . 17525)) (17527 17805 (XCL:FOLLOW-SYNONYM-STREAMS 17527 . 17805)) ( 17807 18566 (CL:MAKE-BROADCAST-STREAM 17807 . 18566)) (18568 18711 (XCL:BROADCAST-STREAM-P 18568 . 18711)) (18713 18928 (XCL:BROADCAST-STREAM-STREAMS 18713 . 18928)) (18930 19615 ( CL:MAKE-CONCATENATED-STREAM 18930 . 19615)) (19617 19716 (XCL:CONCATENATED-STREAM-P 19617 . 19716)) ( 19718 19931 (XCL:CONCATENATED-STREAM-STREAMS 19718 . 19931)) (19933 21517 (CL:MAKE-TWO-WAY-STREAM 19933 . 21517)) (21519 21656 (XCL:TWO-WAY-STREAM-P 21519 . 21656)) (21658 21803 ( XCL:TWO-WAY-STREAM-OUTPUT-STREAM 21658 . 21803)) (21805 21949 (XCL:TWO-WAY-STREAM-INPUT-STREAM 21805 . 21949)) (21951 23501 (CL:MAKE-ECHO-STREAM 21951 . 23501)) (23503 23632 (XCL:ECHO-STREAM-P 23503 . 23632)) (23634 23772 (XCL:ECHO-STREAM-INPUT-STREAM 23634 . 23772)) (23774 23913 ( XCL:ECHO-STREAM-OUTPUT-STREAM 23774 . 23913)) (23915 24642 (CL:MAKE-STRING-INPUT-STREAM 23915 . 24642) ) (24644 25137 (MAKE-CONCATENATED-STRING-INPUT-STREAM 24644 . 25137)) (25139 25299 ( %MAKE-INITIAL-STRING-STREAM-CONTENTS 25139 . 25299)) (25301 25731 (CL:WITH-OPEN-STREAM 25301 . 25731)) (25733 26962 (CL:WITH-INPUT-FROM-STRING 25733 . 26962)) (26964 27466 (CL:WITH-OUTPUT-TO-STRING 26964 . 27466)) (27468 28122 (CL:WITH-OPEN-FILE 27468 . 28122)) (28346 29872 ( MAKE-FILL-POINTER-OUTPUT-STREAM 28346 . 29872)) (29874 30595 (CL:GET-OUTPUT-STREAM-STRING 29874 . 30595)) (30597 31076 (\\STRING-STREAM-OUTCHARFN 30597 . 31076)) (31078 32933 ( \\ADJUSTABLE-STRING-STREAM-OUTCHARFN 31078 . 32933)) (32962 33044 (%NEW-FILE 32962 . 33044)) (33046 33191 (PREDICT-NAME 33046 . 33191)) (33227 33378 (INTERLISP-ACCESS 33227 . 33378)) (33432 34620 ( %BROADCAST-STREAM-DEVICE-BOUT 33442 . 33665) (%BROADCAST-STREAM-DEVICE-OUTCHARFN 33667 . 34118) ( %BROADCAST-STREAM-DEVICE-CLOSEFILE 34120 . 34359) (%BROADCAST-STREAM-DEVICE-FORCEOUTPUT 34361 . 34618) ) (34622 34949 (%BROADCAST-STREAM-DEVICE-CHARSETFN 34622 . 34949)) (34950 37009 ( %CONCATENATED-STREAM-DEVICE-BIN 34960 . 35365) (%CONCATENATED-STREAM-DEVICE-CLOSEFILE 35367 . 35680) ( %CONCATENATED-STREAM-DEVICE-EOFP 35682 . 36046) (%CONCATENATED-STREAM-DEVICE-PEEKBIN 36048 . 36523) ( %CONCATENATED-STREAM-DEVICE-BACKFILEPTR 36525 . 37007)) (37011 37342 ( %CONCATENATED-STREAM-DEVICE-CHARSETFN 37011 . 37342)) (37343 37562 (%ECHO-STREAM-DEVICE-BIN 37353 . 37560)) (37564 37789 (%SYNONYM-STREAM-DEVICE-GET-INDIRECT-STREAM 37564 . 37789)) (37790 41135 ( %SYNONYM-STREAM-DEVICE-BIN 37800 . 37988) (%SYNONYM-STREAM-DEVICE-BOUT 37990 . 38191) ( %SYNONYM-STREAM-DEVICE-OUTCHARFN 38193 . 38900) (%SYNONYM-STREAM-DEVICE-CLOSEFILE 38902 . 39486) ( %SYNONYM-STREAM-DEVICE-EOFP 39488 . 39679) (%SYNONYM-STREAM-DEVICE-FORCEOUTPUT 39681 . 39919) ( %SYNONYM-STREAM-DEVICE-GETFILEINFO 39921 . 40158) (%SYNONYM-STREAM-DEVICE-PEEKBIN 40160 . 40383) ( %SYNONYM-STREAM-DEVICE-READP 40385 . 40496) (%SYNONYM-STREAM-DEVICE-BACKFILEPTR 40498 . 40644) ( %SYNONYM-STREAM-DEVICE-SETFILEINFO 40646 . 40895) (%SYNONYM-STREAM-DEVICE-CHARSETFN 40897 . 41133)) ( 41136 45461 (%TWO-WAY-STREAM-DEVICE-BIN 41146 . 41319) (%TWO-WAY-STREAM-DEVICE-INPUTSTREAM 41321 . 41512) (%TWO-WAY-STREAM-DEVICE-BOUT 41514 . 41686) (%TWO-WAY-STREAM-DEVICE-OUTPUTSTREAM 41688 . 41878) (%TWO-WAY-STREAM-DEVICE-OUTCHARFN 41880 . 42742) (%TWO-WAY-STREAM-DEVICE-CLOSEFILE 42744 . 44167) ( %TWO-WAY-STREAM-DEVICE-EOFP 44169 . 44345) (%TWO-WAY-STREAM-DEVICE-READP 44347 . 44540) ( %TWO-WAY-STREAM-DEVICE-BACKFILEPTR 44542 . 44678) (%TWO-WAY-STREAM-DEVICE-FORCEOUTPUT 44680 . 44909) ( %TWO-WAY-STREAM-DEVICE-PEEKBIN 44911 . 45124) (%TWO-WAY-STREAM-DEVICE-CHARSETFN 45126 . 45459)) (45463 45688 (%FILL-POINTER-STREAM-DEVICE-CLOSEFILE 45463 . 45688)) (45690 45809 ( %FILL-POINTER-STREAM-DEVICE-GETFILEPTR 45690 . 45809)) (46049 46288 (%SYNONYM-STREAM-DEVICE-GET-STREAM 46059 . 46286)) (46519 46995 (%INITIALIZE-STANDARD-STREAMS 46519 . 46995)) (46996 52959 ( %INITIALIZE-CLSTREAM-TYPES 47006 . 52957))))) STOP