(FILECREATED " 2-Feb-86 18:37:41" {DSK}<LISPFILES2>IO.LSP;2 22910
changes to: (VARS IOCOMS)
(RECORDS QP.IO.RECORD))
(* 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.STRING)
(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.INTEGER
QP.PUT.TOKEN.OTHER QP.PUT.TOKEN.REF QP.PUT.TOKEN.SYMBOL 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
(COND ((EQ (QP.GET.STREAM
QP.CURRENT.INPUT)
(CHARCODE EOL))
(QP.UNGET0 (CHARCODE
EOL))
(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.STRING MACRO
(**MACROARG** (LET ((STREAM (CAR (NTH **MACROARG** 1)))
(TOKEN (CAR (NTH **MACROARG** 2)))
(QUOTE.NEEDED (CAR (NTH **MACROARG** 3))))
(BQUOTE (LET ((LENGTH (NCHARS (\, TOKEN)))
(ILISP.STREAM (QIO.STREAM (\, STREAM)))
(CONTAINS.NLS (STRPOS "
%
" (\, TOKEN))))
(COND ((\, QUOTE.NEEDED)
(PRINTCCODE 39 ILISP.STREAM)))
(COND ((NULL CONTAINS.NLS)
(PRIN1 (\, TOKEN)
ILISP.STREAM)
(INCF (QIO.LINEPOS (\, STREAM))
LENGTH)
(INCF (QIO.CHARPOS (\, STREAM))
LENGTH))
(T (FOR I FROM 1 DO
(LET ((CHAR (NTHCHARCODE (\, TOKEN)
I)))
(COND ((NULL CHAR)
(RETURN)))
(QP.PUT.STREAM (\, STREAM)
CHAR)))))
(COND ((\, QUOTE.NEEDED)
(PRINTCCODE 39 ILISP.STREAM)
(INCF (QIO.LINEPOS (\, STREAM))
2)
(INCF (QIO.CHARPOS (\, STREAM))
2))))))))
)
[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 (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 ← T
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 ← T
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 ← T
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 (OPENFILE NAME MODE NIL 8)
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 (LET ((TYPE (QP.CHARTYPE CHAR)))
(SELECTQ TYPE
((small←letter
capital←letter
digit underbar)
(QP.PUT.BYTE 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
(PRIN1 QP.SAVED.PROMPT T)))
(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))
(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.INTEGER QP.CURRENT.OUTPUT TOKEN))
(FLOATP (QP.PUT.TOKEN.FLOAT QP.CURRENT.OUTPUT TOKEN))
(NIL (QP.PUT.TOKEN.REF QP.CURRENT.OUTPUT TOKEN))
(QP.PUT.TOKEN.OTHER QP.CURRENT.OUTPUT 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.INTEGER
(LAMBDA (STREAM TOKEN)
(LET ((STRING (MKSTRING TOKEN)))
(FOR I FROM 1 DO (LET ((CHAR (NTHCHARCODE STRING I)))
(COND
((NULL CHAR)
(RETURN)))
(QP.PUT.STREAM STREAM CHAR))))))
(QP.PUT.TOKEN.OTHER
(LAMBDA (STREAM TOKEN)
(LET ((STRING (MKSTRING TOKEN)))
(QP.PUT.TOKEN.STRING STREAM TOKEN NIL))))
(QP.PUT.TOKEN.REF
(LAMBDA (STREAM TOKEN)
(LET* ((HILOC (\HILOC TOKEN))
(LOLOC (\LOLOC TOKEN))
(OFFSET (IQUOTIENT (IPLUS (LLSH (IDIFFERENCE HILOC (\HILOC QP.membot))
16)
(IDIFFERENCE LOLOC (\LOLOC QP.membot)))
2)))
(QP.PUT.STREAM STREAM (CHARCODE ←))
(QP.PUT.TOKEN.INTEGER STREAM OFFSET))))
(QP.PUT.TOKEN.SYMBOL
(LAMBDA (STREAM TOKEN QUOTEFLAG)
(COND
((EQ TOKEN QP.NULL.ATOM)
(COND
((ZEROP QUOTEFLAG))
(T (QP.PUT.TOKEN (QUOTE '')
0))))
((NULL TOKEN)
(QP.PUT.TOKEN (QUOTE %[%])
0))
(T (LET* ((ALPHAMERIC.SEEN NIL)
(AGGLUTINATING.SEEN NIL)
(QUOTE.NEEDED NIL))
(COND
((NOTZEROP QUOTEFLAG)
(LET* ((TYPE1 (QP.CHARTYPE (NTHCHARCODE TOKEN 1)))
CHAR)
(SELECTQ TYPE1
((capital←letter
underbar)
(SETQ QUOTE.NEEDED T))
(FOR I FROM 1 UNTIL (NULL (SETQ CHAR (NTHCHAR TOKEN I)
))
DO (LET ((TYPE (QP.CHARTYPE (CHCON1 CHAR))))
(SELECTQ TYPE
((small←letter
capital←letter
digit underbar)
(COND
(AGGLUTINATING.SEEN (SETQ
QUOTE.NEEDED T)
(RETURN))
(T (SETQ ALPHAMERIC.SEEN T))))
(agglutinating (COND
(ALPHAMERIC.SEEN
(SETQ QUOTE.NEEDED T)
(RETURN))
(T (SETQ
AGGLUTINATING.SEEN T)))
)
(PROGN (SETQ QUOTE.NEEDED T)
(RETURN)))))))))
(QP.PUT.TOKEN.STRING STREAM TOKEN QUOTE.NEEDED))))))
(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.LSP COPYRIGHT ("Quintus Computer Systems, Inc" 1986))
(DECLARE: DONTCOPY
(FILEMAP (NIL (8931 22788 (QP.CLOSE.STREAM 8941 . 9335) (QP.GET.CHAR 9337 . 9470) (QP.GET.CHAR.TOKEN
9472 . 10600) (QP.GET.STREAM 10602 . 11885) (QP.GET0 11887 . 11956) (QP.GET0.2 11958 . 12106) (
QP.GETPROMPT 12108 . 12157) (QP.INIT.IO 12159 . 13894) (QP.INPUT.KEY.CHECK 13896 . 13937) (
QP.NEW.STREAM 13939 . 15091) (QP.OPEN.APPEND 15093 . 15401) (QP.OPEN.NULL.WRITE 15403 . 15699) (
QP.OPEN.READ 15701 . 16006) (QP.OPEN.WRITE 16008 . 16315) (QP.OUTPUT.KEY.CHECK 16317 . 16359) (
QP.P.ALPHAMERIC 16361 . 16688) (QP.P.CLOSE 16690 . 16839) (QP.P.CURRENT.INPUT 16841 . 16997) (
QP.P.CURRENT.OUTPUT 16999 . 17158) (QP.P.FLUSH 17160 . 17329) (QP.P.SET.INPUT 17331 . 17493) (
QP.P.SET.OUTPUT 17495 . 17661) (QP.PCHAR.COUNT 17663 . 17801) (QP.PLINE.COUNT 17803 . 17941) (
QP.PLINE.POSITION 17943 . 18082) (QP.PROMPT 18084 . 18148) (QP.PUT 18150 . 18227) (QP.PUT.2 18229 .
18384) (QP.PUT.STREAM 18386 . 18844) (QP.PUT.TOKEN 18846 . 19291) (QP.PUT.TOKEN.FLOAT 19293 . 19649) (
QP.PUT.TOKEN.INTEGER 19651 . 19935) (QP.PUT.TOKEN.OTHER 19937 . 20077) (QP.PUT.TOKEN.REF 20079 . 20471
) (QP.PUT.TOKEN.SYMBOL 20473 . 21843) (QP.SETPROMPT 21845 . 21921) (QP.STR.OPENED 21923 . 22481) (
QP.TIME.STATISTIC 22483 . 22704) (QP.UNGET0 22706 . 22786)))))
STOP