(FILECREATED "10-Feb-86 18:44:21" {DSK}<LISPFILES2>IO.;1 23356
changes to: (VARS IOCOMS)
previous date: " 8-Feb-86 15:51:16" {DSK}<LISPFILES2>IO.;2)
(* Copyright (c) 1986 by Quintus Computer Systems, Inc. All rights reserved.)
(PRETTYCOMPRINT IOCOMS)
(RPAQQ IOCOMS ((MACROS DO.FOREVER IO.CHANNEL NEXTCHAR NOTZEROP QIO.CHANNEL QIO.CHARPOS QIO.EOF
QIO.KEY QIO.LINENUM QIO.LINEPOS QIO.MODE QIO.NAME QIO.PUSHBACK QIO.STREAM
QP.GOBBLE./*COMMENT QP.GOBBLE.PCT.COMMENT QP.IN.KEY.CHECK QP.KEY.CHECK
QP.OUT.KEY.CHECK QP.PUT.TOKEN.QUOTED QP.PUT.TOKEN.REF QP.PUT.TOKEN.STRING
QP.PUT.TOKEN.SYMBOL QP.READCCODE)
(RECORDS QP.IO.RECORD)
(PROP SETFDEF QIO.CHANNEL QIO.CHARPOS QIO.EOF QIO.KEY QIO.LINENUM QIO.LINEPOS QIO.MODE
QIO.NAME QIO.PUSHBACK QIO.STREAM)
(ADDVARS (GLOBALVARS QP.BUFFERED.HIDDEN.INPUT)
(GLOBALVARS QP.SAVED.PROMPT)
(GLOBALVARS QP.STANDARD.ERROR)
(GLOBALVARS QP.STANDARD.OUTPUT)
(GLOBALVARS QP.STANDARD.INPUT)
(GLOBALVARS QP.PUT.TOKEN.STRING)
(GLOBALVARS QP.PERMANENT.STREAMS)
(GLOBALVARS QP.IO.TABLE)
(GLOBALVARS QP.IO.CHANNEL.LIMIT)
(GLOBALVARS QP.CURRENT.OUTPUT)
(GLOBALVARS QP.CURRENT.INPUT)
(GLOBALVARS QP.NULL.ATOM)
(GLOBALVARS QP.NEWLINE.LAST))
(FNS QP.CLOSE.STREAM QP.GET.CHAR QP.GET.CHAR.TOKEN QP.GET.STREAM QP.GET0 QP.GET0.2
QP.GETPROMPT QP.INIT.IO QP.INPUT.KEY.CHECK QP.NEW.STREAM QP.OPEN.APPEND
QP.OPEN.NULL.WRITE QP.OPEN.READ QP.OPEN.WRITE QP.OUTPUT.KEY.CHECK QP.P.ALPHAMERIC
QP.P.CLOSE QP.P.CURRENT.INPUT QP.P.CURRENT.OUTPUT QP.P.FLUSH QP.P.SET.INPUT
QP.P.SET.OUTPUT QP.PCHAR.COUNT QP.PLINE.COUNT QP.PLINE.POSITION QP.PROMPT QP.PUT
QP.PUT.2 QP.PUT.STREAM QP.PUT.TOKEN QP.PUT.TOKEN.FLOAT QP.PUT.TOKEN.SIMPLE
QP.RESET.USER.STREAMS QP.SETPROMPT QP.STR.OPENED QP.TIME.STATISTIC QP.UNGET0)
(VARS (QP.SAVED.PROMPT NIL))))
(DECLARE: EVAL@COMPILE
(PUTPROPS DO.FOREVER MACRO (**MACROARG** (LET ((BODY (NTH **MACROARG** 1)))
(BQUOTE (PROG NIL TAG (\,@ BODY)
(GO TAG))))))
(PUTPROPS IO.CHANNEL MACRO (**MACROARG** (LET ((NUMBER (CAR (NTH **MACROARG** 1))))
(BQUOTE (ELT QP.IO.TABLE (\, NUMBER))))))
(PUTPROPS NEXTCHAR MACRO (**MACROARG** (LET ((STR (CAR (NTH **MACROARG** 1))))
(BQUOTE (CHCON1 (READC (\, STR)))))))
(PUTPROPS NOTZEROP MACRO (**MACROARG** (LET ((N (CAR (NTH **MACROARG** 1))))
(BQUOTE (NOT (ZEROP (\, N)))))))
(PUTPROPS QIO.CHANNEL MACRO (**MACROARG** (LET ((X (CAR (NTH **MACROARG** 1))))
(LIST (QUOTE FETCH)
(QUOTE QIO.CHANNEL)
(QUOTE OF)
X))))
(PUTPROPS QIO.CHARPOS MACRO (**MACROARG** (LET ((X (CAR (NTH **MACROARG** 1))))
(LIST (QUOTE FETCH)
(QUOTE QIO.CHARPOS)
(QUOTE OF)
X))))
(PUTPROPS QIO.EOF MACRO (**MACROARG** (LET ((X (CAR (NTH **MACROARG** 1))))
(LIST (QUOTE FETCH)
(QUOTE QIO.EOF)
(QUOTE OF)
X))))
(PUTPROPS QIO.KEY MACRO (**MACROARG** (LET ((X (CAR (NTH **MACROARG** 1))))
(LIST (QUOTE FETCH)
(QUOTE QIO.KEY)
(QUOTE OF)
X))))
(PUTPROPS QIO.LINENUM MACRO (**MACROARG** (LET ((X (CAR (NTH **MACROARG** 1))))
(LIST (QUOTE FETCH)
(QUOTE QIO.LINENUM)
(QUOTE OF)
X))))
(PUTPROPS QIO.LINEPOS MACRO (**MACROARG** (LET ((X (CAR (NTH **MACROARG** 1))))
(LIST (QUOTE FETCH)
(QUOTE QIO.LINEPOS)
(QUOTE OF)
X))))
(PUTPROPS QIO.MODE MACRO (**MACROARG** (LET ((X (CAR (NTH **MACROARG** 1))))
(LIST (QUOTE FETCH)
(QUOTE QIO.MODE)
(QUOTE OF)
X))))
(PUTPROPS QIO.NAME MACRO (**MACROARG** (LET ((X (CAR (NTH **MACROARG** 1))))
(LIST (QUOTE FETCH)
(QUOTE QIO.NAME)
(QUOTE OF)
X))))
(PUTPROPS QIO.PUSHBACK MACRO (**MACROARG** (LET ((X (CAR (NTH **MACROARG** 1))))
(LIST (QUOTE FETCH)
(QUOTE QIO.PUSHBACK)
(QUOTE OF)
X))))
(PUTPROPS QIO.STREAM MACRO (**MACROARG** (LET ((X (CAR (NTH **MACROARG** 1))))
(LIST (QUOTE FETCH)
(QUOTE QIO.STREAM)
(QUOTE OF)
X))))
(PUTPROPS QP.GOBBLE./*COMMENT MACRO (**MACROARG**
(LET NIL (QUOTE (DO.FOREVER (COND ((EQ (QP.GET.STREAM QP.CURRENT.INPUT)
(CHARCODE *))
(LET ((CH (QP.GET.STREAM QP.CURRENT.INPUT)))
(COND ((EQ CH (CHARCODE /))
(RETURN))
(T (QP.UNGET0 CH)))))
(T NIL)))))))
(PUTPROPS QP.GOBBLE.PCT.COMMENT MACRO (**MACROARG**
(LET NIL (QUOTE (DO.FOREVER (LET ((CHAR (QP.GET.STREAM QP.CURRENT.INPUT)))
(COND ((EQ CHAR (CHARCODE EOL))
(QP.UNGET0 (CHARCODE EOL))
(RETURN))
((EQ CHAR -1)
(QP.UNGET0 -1)
(RETURN))
(T NIL))))))))
(PUTPROPS QP.IN.KEY.CHECK MACRO (**MACROARG**
(LET ((KEY (CAR (NTH **MACROARG** 1)))
(CHANNEL (CAR (NTH **MACROARG** 2)))
(ERROR (CAR (NTH **MACROARG** 3))))
(BQUOTE (PROGN (QP.KEY.CHECK (\, KEY)
(\, CHANNEL)
(\, ERROR))
(COND ((NEQ (QIO.MODE (IO.CHANNEL (\, CHANNEL)))
(QUOTE READ))
(QP.NERROR (\, ERROR)
(\, KEY)))))))))
(PUTPROPS QP.KEY.CHECK MACRO (**MACROARG** (LET ((KEY (CAR (NTH **MACROARG** 1)))
(CHANNEL (CAR (NTH **MACROARG** 2)))
(ERROR (CAR (NTH **MACROARG** 3))))
(BQUOTE (COND
((OR (LESSP (\, CHANNEL)
0)
(GREATERP (\, CHANNEL)
19)
(NEQ (QIO.KEY (IO.CHANNEL
(\, CHANNEL)))
(\, KEY)))
(QP.NERROR (\, ERROR)
(\, KEY))))))))
(PUTPROPS QP.OUT.KEY.CHECK MACRO (**MACROARG**
(LET ((KEY (CAR (NTH **MACROARG** 1)))
(CHANNEL (CAR (NTH **MACROARG** 2)))
(ERROR (CAR (NTH **MACROARG** 3))))
(BQUOTE (PROGN (QP.KEY.CHECK (\, KEY)
(\, CHANNEL)
(\, ERROR))
(COND ((EQ (QIO.MODE (IO.CHANNEL (\, CHANNEL)))
(QUOTE READ))
(QP.NERROR (\, ERROR)
(\, KEY)))))))))
(PUTPROPS QP.PUT.TOKEN.QUOTED MACRO (OPENLAMBDA (STREAM STRING)
(LET ((ILISP.STREAM (QIO.STREAM STREAM)))
(QP.PUT.STREAM STREAM 39)
(FOR I FROM 1 TO (NCHARS STRING)
DO
(LET ((CHAR (NTHCHARCODE STRING I)))
(QP.PUT.STREAM STREAM CHAR)
(IF (EQ CHAR 39)
THEN
(QP.PUT.STREAM STREAM CHAR))))
(QP.PUT.STREAM STREAM 39))))
(PUTPROPS QP.PUT.TOKEN.REF MACRO (OPENLAMBDA (STREAM TOKEN)
(QP.PUT.STREAM STREAM (CHARCODE ←))
(QP.PUT.TOKEN.SIMPLE
STREAM
(MKSTRING (IPLUS (LLSH (IDIFFERENCE (\HILOC TOKEN)
(\HILOC QP.membot))
15)
(LRSH (IDIFFERENCE (\LOLOC TOKEN)
(\LOLOC QP.membot))
1))))))
(PUTPROPS QP.PUT.TOKEN.STRING MACRO (OPENLAMBDA (STREAM STRING)
(LET ((LENGTH (NCHARS STRING)))
(if (NOT (STRPOS "
" STRING))
then
(PRIN1 STRING (QIO.STREAM STREAM))
(INCF (QIO.LINEPOS STREAM)
LENGTH)
(INCF (QIO.CHARPOS STREAM)
LENGTH)
(if (EQ STREAM QP.STANDARD.OUTPUT)
then
(SETQ QP.NEWLINE.LAST NIL))
else
(for I from 1 to LENGTH do
(QP.PUT.STREAM STREAM (NTHCHARCODE
STRING I)))))))
(PUTPROPS QP.PUT.TOKEN.SYMBOL MACRO
(OPENLAMBDA (STREAM TOKEN QUOTEFLAG)
(if (EQ TOKEN QP.NULL.ATOM)
then
(if (NEQ QUOTEFLAG 0)
then
(QP.PUT.TOKEN.SIMPLE STREAM "''"))
elseif
(EQ TOKEN NIL)
then
(QP.PUT.TOKEN.SIMPLE STREAM "[]")
elseif
(EQ QUOTEFLAG 0)
then
(QP.PUT.TOKEN.STRING STREAM TOKEN)
elseif
(LET ((LENGTH (NCHARS TOKEN)))
(SELECTQ (QP.CHARTYPE (NTHCHARCODE TOKEN 1))
(small←letter (for I from 2 to LENGTH always
(SELECTQ (QP.CHARTYPE (NTHCHARCODE TOKEN I)
)
((small←letter capital←letter
underbar digit)
T)
NIL)))
(agglutinating (for I from 2 to LENGTH always
(EQ (QP.CHARTYPE (NTHCHARCODE TOKEN I))
(QUOTE agglutinating))))
(PROGN NIL)))
then
(QP.PUT.TOKEN.STRING STREAM TOKEN)
else
(QP.PUT.TOKEN.QUOTED STREAM TOKEN))))
(PUTPROPS QP.READCCODE MACRO (**MACROARG** (LET ((STREAM (CAR (NTH **MACROARG** 1))))
(BQUOTE (PROG ((\RefillBufferFn
(FUNCTION \READCREFILL)))
(DECLARE (SPECVARS #CURRENTRDTBL#
\RefillBufferFn))
(RETURN (\INCCODE (\, STREAM))))))))
)
[DECLARE: EVAL@COMPILE
(DATATYPE QP.IO.RECORD (QIO.STREAM QIO.NAME QIO.PUSHBACK QIO.CHARPOS QIO.LINENUM QIO.LINEPOS
QIO.KEY QIO.CHANNEL QIO.MODE QIO.EOF))
]
(/DECLAREDATATYPE (QUOTE QP.IO.RECORD)
(QUOTE (POINTER POINTER POINTER POINTER POINTER POINTER POINTER POINTER POINTER
POINTER))
(QUOTE ((QP.IO.RECORD 0 POINTER)
(QP.IO.RECORD 2 POINTER)
(QP.IO.RECORD 4 POINTER)
(QP.IO.RECORD 6 POINTER)
(QP.IO.RECORD 8 POINTER)
(QP.IO.RECORD 10 POINTER)
(QP.IO.RECORD 12 POINTER)
(QP.IO.RECORD 14 POINTER)
(QP.IO.RECORD 16 POINTER)
(QP.IO.RECORD 18 POINTER)))
(QUOTE 20))
(PUTPROPS QIO.CHANNEL SETFDEF (REPLACE QIO.CHANNEL OF DATUM WITH NEWVALUE))
(PUTPROPS QIO.CHARPOS SETFDEF (REPLACE QIO.CHARPOS OF DATUM WITH NEWVALUE))
(PUTPROPS QIO.EOF SETFDEF (REPLACE QIO.EOF OF DATUM WITH NEWVALUE))
(PUTPROPS QIO.KEY SETFDEF (REPLACE QIO.KEY OF DATUM WITH NEWVALUE))
(PUTPROPS QIO.LINENUM SETFDEF (REPLACE QIO.LINENUM OF DATUM WITH NEWVALUE))
(PUTPROPS QIO.LINEPOS SETFDEF (REPLACE QIO.LINEPOS OF DATUM WITH NEWVALUE))
(PUTPROPS QIO.MODE SETFDEF (REPLACE QIO.MODE OF DATUM WITH NEWVALUE))
(PUTPROPS QIO.NAME SETFDEF (REPLACE QIO.NAME OF DATUM WITH NEWVALUE))
(PUTPROPS QIO.PUSHBACK SETFDEF (REPLACE QIO.PUSHBACK OF DATUM WITH NEWVALUE))
(PUTPROPS QIO.STREAM SETFDEF (REPLACE QIO.STREAM OF DATUM WITH NEWVALUE))
(ADDTOVAR GLOBALVARS QP.BUFFERED.HIDDEN.INPUT)
(ADDTOVAR GLOBALVARS QP.SAVED.PROMPT)
(ADDTOVAR GLOBALVARS QP.STANDARD.ERROR)
(ADDTOVAR GLOBALVARS QP.STANDARD.OUTPUT)
(ADDTOVAR GLOBALVARS QP.STANDARD.INPUT)
(ADDTOVAR GLOBALVARS QP.PUT.TOKEN.STRING)
(ADDTOVAR GLOBALVARS QP.PERMANENT.STREAMS)
(ADDTOVAR GLOBALVARS QP.IO.TABLE)
(ADDTOVAR GLOBALVARS QP.IO.CHANNEL.LIMIT)
(ADDTOVAR GLOBALVARS QP.CURRENT.OUTPUT)
(ADDTOVAR GLOBALVARS QP.CURRENT.INPUT)
(ADDTOVAR GLOBALVARS QP.NULL.ATOM)
(ADDTOVAR GLOBALVARS QP.NEWLINE.LAST)
(DEFINEQ
(QP.CLOSE.STREAM
(LAMBDA (STREAM)
(COND
((FMEMB STREAM QP.PERMANENT.STREAMS))
(T (REPLACE QIO.MODE OF STREAM WITH NIL)
(CLOSEF? (QIO.STREAM STREAM))))
(COND
((EQ STREAM QP.CURRENT.INPUT)
(SETQ QP.CURRENT.INPUT QP.STANDARD.INPUT))
((EQ STREAM QP.CURRENT.OUTPUT)
(SETQ QP.CURRENT.OUTPUT QP.STANDARD.OUTPUT)))))
(QP.GET.CHAR
(LAMBDA NIL
(LET ((CHAR (QP.GET.STREAM QP.CURRENT.INPUT)))
(VALUES (QP.CHARTYPE CHAR)
CHAR))))
(QP.GET.CHAR.TOKEN
(LAMBDA NIL
(QP.CLEAR.BYTE.BUFFER)
(LET ((CH (QP.GET.STREAM QP.CURRENT.INPUT)))
(SELECTQ CH
(40 (VALUES (QUOTE individual←char)
40))
(-1 (VALUES (QUOTE end←of←stream)
-1))
(PROGN (QP.UNGET0 CH)
(DO.FOREVER
(LET* ((CH (QP.GET.STREAM QP.CURRENT.INPUT))
(TYPE (QP.CHARTYPE CH)))
(SELECTQ TYPE
(white←space NIL)
(individual←char
(SELECTQ CH
(40 (QP.UNGET0 40)
(RETURN (VALUES (QUOTE
white←space)
32)))
(RETURN (VALUES TYPE CH))))
(agglutinating
(COND
((EQ CH (CHARCODE /))
(LET ((CH1 (QP.GET.STREAM QP.CURRENT.INPUT)))
(COND
((EQ CH1 (CHARCODE *))
(QP.GOBBLE./*COMMENT))
(T (QP.UNGET0 CH1)
(RETURN (VALUES TYPE CH))))))
(T (RETURN (VALUES TYPE CH)))))
(percent (QP.GOBBLE.PCT.COMMENT))
(RETURN (VALUES TYPE CH))))))))))
(QP.GET.STREAM
(LAMBDA (STREAM)
(LET (HOLD (IL.STREAM (QIO.STREAM STREAM)))
(COND
((SETQ HOLD (QIO.PUSHBACK STREAM))
(SETF (QIO.PUSHBACK STREAM)
NIL)
HOLD)
((NOT (NULL QP.BUFFERED.HIDDEN.INPUT))
(POP QP.BUFFERED.HIDDEN.INPUT))
((QIO.EOF STREAM)
(QP.CLOSE.STREAM STREAM)
(COND
((NOT (EQ STREAM QP.STANDARD.INPUT))
(QP.NERROR (QUOTE END.OF.FILE)
(QIO.NAME STREAM)))))
((AND (EOFP IL.STREAM)
(NEQ STREAM QP.STANDARD.INPUT))
(INCF (QIO.CHARPOS STREAM))
(INCF (QIO.LINEPOS STREAM))
(SETF (QIO.EOF STREAM)
T)
-1)
(T (COND
((AND QP.NEWLINE.LAST (EQ STREAM QP.STANDARD.INPUT))
(QP.PROMPT)))
(LET ((CHAR (QP.READCCODE IL.STREAM)))
(INCF (QIO.CHARPOS STREAM))
(COND
((EQ CHAR 13)
(SETQ QP.NEWLINE.LAST T)
(INCF (QIO.LINENUM STREAM))
(SETF (QIO.LINEPOS STREAM)
0)
13)
((AND (EQ CHAR 4)
(EQ STREAM QP.STANDARD.INPUT)
(NOT (ZEROP QP.EDITOR.STATE)))
(INCF (QIO.LINEPOS STREAM))
-1)
(T (INCF (QIO.LINEPOS STREAM))
CHAR))))))))
(QP.GET0
(LAMBDA NIL
(QP.GET.STREAM QP.CURRENT.INPUT)))
(QP.GET0.2
(LAMBDA (KEY CHANNEL)
(QP.IN.KEY.CHECK KEY CHANNEL (QUOTE IO←GET0))
(QP.GET.STREAM (ELT QP.IO.TABLE CHANNEL))))
(QP.GETPROMPT
(LAMBDA NIL QP.SAVED.PROMPT))
(QP.INIT.IO
(LAMBDA NIL
(SETQ QP.BUFFERED.HIDDEN.INPUT NIL)
(SETQ QP.NULL.ATOM (MKATOM ""))
(SETQ QP.PUT.TOKEN.STRING (ALLOCSTRING 100))
(SETQ QP.NEWLINE.LAST NIL)
(SETQ QP.IO.CHANNEL.LIMIT 20)
(SETQ QP.IO.TABLE (ARRAY QP.IO.CHANNEL.LIMIT (QUOTE POINTER)
NIL 0))
(FOR I FROM 3 TO (SUB1 QP.IO.CHANNEL.LIMIT)
DO (SETA QP.IO.TABLE I
(CREATE QP.IO.RECORD
QIO.CHANNEL ← I
QIO.KEY ← 0
QIO.PUSHBACK ← NIL
QIO.CHARPOS ← 0
QIO.LINENUM ← 0
QIO.LINEPOS ← 0)))
(SETQ QP.STANDARD.INPUT
(CREATE QP.IO.RECORD
QIO.KEY ← -1
QIO.CHANNEL ← 0
QIO.CHARPOS ← 0
QIO.LINENUM ← 0
QIO.LINEPOS ← 0
QIO.STREAM ← (\GETSTREAM T (QUOTE INPUT))
QIO.PUSHBACK ← NIL
QIO.NAME ← (QUOTE USER)
QIO.MODE ← (QUOTE READ)))
(SETA QP.IO.TABLE 0 QP.STANDARD.INPUT)
(SETQ QP.STANDARD.OUTPUT
(CREATE QP.IO.RECORD
QIO.KEY ← -1
QIO.CHANNEL ← 1
QIO.CHARPOS ← 0
QIO.LINENUM ← 0
QIO.LINEPOS ← 0
QIO.STREAM ← (\GETSTREAM T (QUOTE OUTPUT))
QIO.PUSHBACK ← NIL
QIO.NAME ← (QUOTE USER)
QIO.MODE ← (QUOTE WRITE)))
(SETA QP.IO.TABLE 1 QP.STANDARD.OUTPUT)
(SETQ QP.STANDARD.ERROR
(CREATE QP.IO.RECORD
QIO.KEY ← -1
QIO.CHANNEL ← 2
QIO.CHARPOS ← 0
QIO.LINENUM ← 0
QIO.LINEPOS ← 0
QIO.STREAM ← (\GETSTREAM T (QUOTE OUTPUT))
QIO.PUSHBACK ← NIL
QIO.NAME ← (QUOTE USER←ERROR)
QIO.MODE ← (QUOTE WRITE)))
(SETA QP.IO.TABLE 2 QP.STANDARD.ERROR)
(SETQ QP.CURRENT.INPUT QP.STANDARD.INPUT)
(SETQ QP.CURRENT.OUTPUT QP.STANDARD.OUTPUT)
(SETQ QP.PERMANENT.STREAMS (LIST QP.STANDARD.INPUT QP.STANDARD.OUTPUT QP.STANDARD.ERROR))
T))
(QP.INPUT.KEY.CHECK
(LAMBDA NIL T))
(QP.NEW.STREAM
(LAMBDA (NAME MODE)
(LET (STRUCT)
(FOR STR FROM 3 TO 19
DO (COND
((NULL (FETCH QIO.MODE OF (SETQ STRUCT (ELT QP.IO.TABLE STR))))
(COND
((EQ MODE (QUOTE NULL))
(SETF (QIO.MODE STRUCT)
(QUOTE NULL))
(SETF (QIO.NAME STRUCT)
(QUOTE {NULL}))
(RETURN))
(T (SETF (QIO.STREAM STRUCT)
(\GETSTREAM (COND
((SYMBOLP NAME)
(OPENFILE NAME MODE NIL 8))
(T NAME))
MODE))
(SETF (QIO.MODE STRUCT)
(SELECTQ MODE
(INPUT (QUOTE READ))
(OUTPUT (QUOTE WRITE))
(APPEND (QUOTE APPEND))
(SHOULDNT)))
(SETF (QIO.NAME STRUCT)
NAME)
(RETURN))))))
(COND
((NOT STRUCT)
(VALUES NIL (GETHASH QP.ERROR.TABLE (QUOTE IO←TOOMANY))))
(T (SETF (QIO.CHARPOS STRUCT)
0)
(SETF (QIO.LINENUM STRUCT)
0)
(SETF (QIO.LINEPOS STRUCT)
0)
(SETF (QIO.EOF STRUCT)
NIL)
(VALUES STRUCT 0))))))
(QP.OPEN.APPEND
(LAMBDA (FILENAME KEY)
(MULTIPLE.VALUE.BIND (STRUCTURE STATUS)
(QP.NEW.STREAM FILENAME (QUOTE APPEND))
(COND
((EQ STATUS 0)
(SETF (QIO.KEY STRUCTURE)
KEY)
(VALUES STATUS (QIO.CHANNEL STRUCTURE)))
(T (VALUES STATUS NIL))))))
(QP.OPEN.NULL.WRITE
(LAMBDA (KEY)
(MULTIPLE.VALUE.BIND (STRUCTURE STATUS)
(QP.NEW.STREAM NIL (QUOTE NULL))
(COND
((EQ STATUS 0)
(SETF (QIO.KEY STRUCTURE)
KEY)
(VALUES STATUS (QIO.CHANNEL STRUCTURE)))
(T (VALUES STATUS NIL))))))
(QP.OPEN.READ
(LAMBDA (FILENAME KEY)
(MULTIPLE.VALUE.BIND (STRUCTURE STATUS)
(QP.NEW.STREAM FILENAME (QUOTE INPUT))
(COND
((EQ STATUS 0)
(SETF (QIO.KEY STRUCTURE)
KEY)
(VALUES STATUS (QIO.CHANNEL STRUCTURE)))
(T (VALUES STATUS NIL))))))
(QP.OPEN.WRITE
(LAMBDA (FILENAME KEY)
(MULTIPLE.VALUE.BIND (STRUCTURE STATUS)
(QP.NEW.STREAM FILENAME (QUOTE OUTPUT))
(COND
((EQ STATUS 0)
(SETF (QIO.KEY STRUCTURE)
KEY)
(VALUES STATUS (QIO.CHANNEL STRUCTURE)))
(T (VALUES STATUS NIL))))))
(QP.OUTPUT.KEY.CHECK
(LAMBDA NIL T))
(QP.P.ALPHAMERIC
(LAMBDA (CHAR)
(DO.FOREVER (SELECTQ (QP.CHARTYPE CHAR)
((small←letter
capital←letter
digit underbar)
(SETQ BYTE.BUFFER.LENGTH (IPLUS BYTE.BUFFER.LENGTH 1))
(RPLCHARCODE BYTE.BUFFER BYTE.BUFFER.LENGTH CHAR)
(SETQ CHAR (QP.GET.STREAM QP.CURRENT.INPUT)))
(PROGN (QP.UNGET0 CHAR)
(RETURN))))))
(QP.P.CLOSE
(LAMBDA (KEY CHANNEL)
(QP.KEY.CHECK KEY CHANNEL (QUOTE IO←CLOSE))
(QP.CLOSE.STREAM (ELT QP.IO.TABLE CHANNEL))))
(QP.P.CURRENT.INPUT
(LAMBDA NIL
(LET ((NUMBER (QIO.CHANNEL QP.CURRENT.INPUT))
(KEY (QIO.KEY QP.CURRENT.INPUT)))
(VALUES NUMBER KEY))))
(QP.P.CURRENT.OUTPUT
(LAMBDA NIL
(LET ((NUMBER (QIO.CHANNEL QP.CURRENT.OUTPUT))
(KEY (QIO.KEY QP.CURRENT.OUTPUT)))
(VALUES NUMBER KEY))))
(QP.P.FLUSH
(LAMBDA (KEY CHANNEL)
(QP.OUT.KEY.CHECK KEY CHANNEL (QUOTE IO←FLUSH))
(FLUSHOUTPUT (QIO.STREAM (ELT QP.IO.TABLE CHANNEL))
T)))
(QP.P.SET.INPUT
(LAMBDA (KEY CHANNEL)
(QP.IN.KEY.CHECK KEY CHANNEL (QUOTE IO←SETIN))
(SETQ QP.CURRENT.INPUT (ELT QP.IO.TABLE CHANNEL))))
(QP.P.SET.OUTPUT
(LAMBDA (KEY CHANNEL)
(QP.OUT.KEY.CHECK KEY CHANNEL (QUOTE IO←SETOUT))
(SETQ QP.CURRENT.OUTPUT (ELT QP.IO.TABLE CHANNEL))))
(QP.PCHAR.COUNT
(LAMBDA (KEY CHANNEL)
(QP.KEY.CHECK KEY CHANNEL (QUOTE IO←CHCOUNT))
(QIO.CHARPOS (IO.CHANNEL CHANNEL))))
(QP.PLINE.COUNT
(LAMBDA (KEY CHANNEL)
(QP.KEY.CHECK KEY CHANNEL (QUOTE IO←LNCOUNT))
(QIO.LINENUM (IO.CHANNEL CHANNEL))))
(QP.PLINE.POSITION
(LAMBDA (KEY CHANNEL)
(QP.KEY.CHECK KEY CHANNEL (QUOTE IO←LNPOS))
(QIO.LINEPOS (IO.CHANNEL CHANNEL))))
(QP.PROMPT
(LAMBDA NIL
(QP.PUT.TOKEN.SIMPLE QP.STANDARD.OUTPUT QP.SAVED.PROMPT)))
(QP.PUT
(LAMBDA (CHAR)
(QP.PUT.STREAM QP.CURRENT.OUTPUT CHAR)))
(QP.PUT.2
(LAMBDA (KEY CHANNEL CHAR)
(QP.OUT.KEY.CHECK KEY CHANNEL (QUOTE IO←PUT))
(QP.PUT.STREAM (IO.CHANNEL CHANNEL)
CHAR)))
(QP.PUT.STREAM
(LAMBDA (STREAM CHAR)
(COND
((EQ CHAR 13)
(INCF (QIO.LINENUM STREAM))
(SETF (QIO.LINEPOS STREAM)
0)
(COND
((EQ STREAM QP.STANDARD.OUTPUT)
(SETQ QP.NEWLINE.LAST T))))
(T (INCF (QIO.LINEPOS STREAM))
(COND
((EQ STREAM QP.STANDARD.OUTPUT)
(SETQ QP.NEWLINE.LAST NIL)))))
(INCF (QIO.CHARPOS STREAM))
(COND
((NEQ (QIO.MODE STREAM)
(QUOTE NULL))
(PRINTCCODE CHAR (QIO.STREAM STREAM))))))
(QP.PUT.TOKEN
(LAMBDA (TOKEN QUOTEFLAG)
(SELECTQ (TYPENAME TOKEN)
(LITATOM (QP.PUT.TOKEN.SYMBOL QP.CURRENT.OUTPUT TOKEN QUOTEFLAG))
((SMALLP FIXP BIGNUM)
(QP.PUT.TOKEN.SIMPLE QP.CURRENT.OUTPUT (MKSTRING TOKEN)))
(FLOATP (QP.PUT.TOKEN.FLOAT QP.CURRENT.OUTPUT TOKEN))
(NIL (QP.PUT.TOKEN.REF QP.CURRENT.OUTPUT TOKEN))
(PROGN (QP.PUT.TOKEN.SIMPLE QP.CURRENT.OUTPUT (MKSTRING TOKEN))))))
(QP.PUT.TOKEN.FLOAT
(LAMBDA (STREAM TOKEN)
(LET ((LENGTH (QP.FLOAT.TO.STRING TOKEN QP.PUT.TOKEN.STRING)))
(FOR I FROM 1 TO LENGTH DO (LET ((CHAR (NTHCHARCODE QP.PUT.TOKEN.STRING I)))
(COND
((EQ CHAR 13)
(RETURN))
(T (QP.PUT.STREAM STREAM CHAR))))))))
(QP.PUT.TOKEN.SIMPLE
(LAMBDA (STREAM STRING)
(PRIN1 STRING (QIO.STREAM STREAM))
(LET ((LENGTH (NCHARS STRING)))
(INCF (QIO.LINEPOS STREAM)
LENGTH)
(INCF (QIO.CHARPOS STREAM)
LENGTH)
(if (EQ STREAM QP.STANDARD.OUTPUT)
then (SETQ QP.NEWLINE.LAST NIL)))))
(QP.RESET.USER.STREAMS
(LAMBDA NIL
(SETF (QIO.STREAM QP.STANDARD.INPUT)
(\GETSTREAM T (QUOTE INPUT)))
(SETF (QIO.STREAM QP.STANDARD.OUTPUT)
(\GETSTREAM T (QUOTE OUTPUT)))
(SETF (QIO.STREAM QP.STANDARD.ERROR)
(\GETSTREAM T (QUOTE OUTPUT)))))
(QP.SETPROMPT
(LAMBDA (ATOM)
(SETQ QP.SAVED.PROMPT ATOM)))
(QP.STR.OPENED
(LAMBDA (CHAN.INDEX)
(LET ((RETURN (FOR I FROM CHAN.INDEX TO 19
DO (COND
((NULL (FETCH QIO.MODE OF (ELT QP.IO.TABLE I))))
(T (LET ((STREAM (ELT QP.IO.TABLE I)))
(RETURN (VALUES 1 (QIO.KEY STREAM)
(QIO.CHANNEL STREAM)
(QIO.NAME STREAM)
(SELECTQ (QIO.MODE STREAM)
(READ 0)
(WRITE 1)
(APPEND 2))))))))))
(COND
(RETURN RETURN)
(T (VALUES 0 NIL NIL NIL NIL))))))
(QP.TIME.STATISTIC
(LAMBDA NIL
(LET ((PREV.TIME QP.PREVIOUS.TIME)
(THIS.TIME (CLOCK 0)))
(SETQ QP.PREVIOUS.TIME THIS.TIME)
(VALUES THIS.TIME (IDIFFERENCE THIS.TIME PREV.TIME)))))
(QP.UNGET0
(LAMBDA (CH)
(SETF (QIO.PUSHBACK QP.CURRENT.INPUT)
CH)))
)
(RPAQQ QP.SAVED.PROMPT NIL)
(PUTPROPS IO COPYRIGHT ("Quintus Computer Systems, Inc" 1986))
(DECLARE: DONTCOPY
(FILEMAP (NIL (10614 23238 (QP.CLOSE.STREAM 10624 . 11018) (QP.GET.CHAR 11020 . 11157) (
QP.GET.CHAR.TOKEN 11159 . 12287) (QP.GET.STREAM 12289 . 13575) (QP.GET0 13577 . 13646) (QP.GET0.2
13648 . 13796) (QP.GETPROMPT 13798 . 13847) (QP.INIT.IO 13849 . 15691) (QP.INPUT.KEY.CHECK 15693 .
15734) (QP.NEW.STREAM 15736 . 16873) (QP.OPEN.APPEND 16875 . 17183) (QP.OPEN.NULL.WRITE 17185 . 17481)
(QP.OPEN.READ 17483 . 17788) (QP.OPEN.WRITE 17790 . 18097) (QP.OUTPUT.KEY.CHECK 18099 . 18141) (
QP.P.ALPHAMERIC 18143 . 18563) (QP.P.CLOSE 18565 . 18714) (QP.P.CURRENT.INPUT 18716 . 18872) (
QP.P.CURRENT.OUTPUT 18874 . 19033) (QP.P.FLUSH 19035 . 19204) (QP.P.SET.INPUT 19206 . 19368) (
QP.P.SET.OUTPUT 19370 . 19536) (QP.PCHAR.COUNT 19538 . 19676) (QP.PLINE.COUNT 19678 . 19816) (
QP.PLINE.POSITION 19818 . 19957) (QP.PROMPT 19959 . 20054) (QP.PUT 20056 . 20137) (QP.PUT.2 20139 .
20294) (QP.PUT.STREAM 20296 . 20812) (QP.PUT.TOKEN 20814 . 21293) (QP.PUT.TOKEN.FLOAT 21295 . 21655) (
QP.PUT.TOKEN.SIMPLE 21657 . 22000) (QP.RESET.USER.STREAMS 22002 . 22293) (QP.SETPROMPT 22295 . 22371)
(QP.STR.OPENED 22373 . 22931) (QP.TIME.STATISTIC 22933 . 23154) (QP.UNGET0 23156 . 23236)))))
STOP