(FILECREATED "24-Mar-86 16:32:27" {ERIS}<LISPCORE>BVM>ATBL.;8 257724Q
changes to: (RECORDS READTABLEP)
previous date: "15-Mar-86 19:35:38" {ERIS}<LISPCORE>BVM>ATBL.;7)
(* Copyright (c) 1982, 1983, 1984, 1985, 1986 by Xerox Corporation. All rights reserved.)
(PRETTYCOMPRINT ATBLCOMS)
(RPAQQ ATBLCOMS
[(E (RESETSAVE (RADIX 8)))
(COMS (* Common features of read and terminal tables)
(DECLARE: DONTCOPY (EXPORT (MACROS \SYNCODE \SETSYNCODE)
(RECORDS CHARTABLE))
(CONSTANTS \NSCHARHASHKEYS \NSCHARHASHOVERFLOW)
(MACROS \CREATENSCHARHASH \MAPCHARTABLE))
(FNS GETSYNTAX SETSYNTAX SYNTAXP \COPYSYNTAX \GETCHARCODE \SETFATSYNCODE))
(COMS (* terminal tables)
(FNS CONTROL COPYTERMTABLE DELETECONTROL GETDELETECONTROL ECHOCHAR ECHOCONTROL ECHOMODE
GETECHOMODE GETCONTROL GETTERMTABLE RAISE GETRAISE RESETTERMTABLE SETTERMTABLE
TERMTABLEP \GETTERMSYNTAX \GTTERMTABLE \ORIGTERMTABLE \SETTERMSYNTAX
\TERMCLASSTOCODE \TERMCODETOCLASS \LITCHECK)
(DECLARE: DONTCOPY (EXPORT (CONSTANTS * CCECHOMODES)
(CONSTANTS * TERMCLASSES)
(RECORDS TERMCODE TERMTABLEP)))
(INITRECORDS TERMTABLEP))
(COMS (* read tables)
(VARS (*READ-BASE* 10)
(*PRINT-RADIX* 10))
(FNS COPYREADTABLE ESCAPE GETBRK GETREADTABLE GETSEPR READMACROS READTABLEP
READTABLEPROP RESETREADTABLE SETBRK SETREADTABLE SETSEPR \GETREADSYNTAX
\GTREADTABLE \GTREADTABLE1 \ORIGREADTABLE \READCLASSTOCODE \SETMACROSYNTAX
\SETREADSYNTAX)
(PROP ARGNAMES READTABLEPROP)
(DECLARE: EVAL@COMPILE DONTCOPY (* READCLASSTOKENS Generates READCLASSES and some
interesting SELECTQ's)
(* OTHER must be zero because of initialization.)
[VARS READCLASSTOKENS (READCLASSES (MAPCAR READCLASSTOKENS
(FUNCTION (LAMBDA
(PAIR)
(LIST (PACK* (CAR PAIR)
".RC")
(CADR PAIR]
(MACROS \COMPUTED.FORM)
(* This macro ought to be official somehow)
(RECORDS CONTEXTS ESCAPES WAKEUPS)
(EXPORT (MACROS \GETREADMACRODEF \GTREADTABLE \GTREADTABLE1)
(CONSTANTS MACROBIT BREAKBIT STOPATOMBIT ESCAPEBIT INNERESCAPEBIT)
(CONSTANTS * READCODEMASKS)
(CONSTANTS * READMACROCONTEXTS)
(CONSTANTS * READCLASSES)
(CONSTANTS * READMACROWAKEUPS)
(CONSTANTS * READMACROESCAPES)
(RECORDS READCODE READMACRODEF READTABLEP))
(GLOBALVARS \ORIGREADTABLE \ORIGTERMTABLE))
(INITRECORDS READTABLEP))
[COMS (FNS \ATBLSET)
(DECLARE: DONTEVAL@LOAD DOCOPY (P (\ATBLSET]
(LOCALVARS . T)
(DECLARE: DONTEVAL@LOAD DOEVAL@COMPILE DONTCOPY COMPILERVARS (ADDVARS (NLAMA)
(NLAML)
(LAMA READTABLEPROP])
(* Common features of read and terminal tables)
(DECLARE: DONTCOPY
(* FOLLOWING DEFINITIONS EXPORTED)
(DECLARE: EVAL@COMPILE
[PUTPROPS \SYNCODE DMACRO (OPENLAMBDA (TABLE CHAR)
(CHECK (type? CHARTABLE TABLE))
(* 0 is either NONE.TC, REAL.CCE, or OTHER.RC)
(COND ((IGREATERP CHAR \MAXTHINCHAR)
(OR (AND (fetch (CHARTABLE NSCHARHASH)
of TABLE)
(GETHASH CHAR (fetch (CHARTABLE NSCHARHASH)
of TABLE)))
0))
(T (\GETBASEBYTE TABLE CHAR]
[PUTPROPS \SETSYNCODE DMACRO (LAMBDA (TABLE CHAR CODE)
(CHECK (type? CHARTABLE TABLE))
(* 0 is REAL.CCE, NONE.TC, OTHER.RC)
(COND ((ILEQ CHAR \MAXTHINCHAR)
(\PUTBASEBYTE TABLE CHAR CODE))
(T (\SETFATSYNCODE TABLE CHAR CODE]
)
[DECLARE: EVAL@COMPILE
(DATATYPE CHARTABLE ((CHARSET0 400Q BYTE)
(NSCHARHASH FULLPOINTER)))
]
(/DECLAREDATATYPE (QUOTE CHARTABLE)
(QUOTE (BYTE BYTE BYTE BYTE BYTE BYTE BYTE BYTE BYTE BYTE BYTE BYTE BYTE BYTE BYTE BYTE BYTE
BYTE BYTE BYTE BYTE BYTE BYTE BYTE BYTE BYTE BYTE BYTE BYTE BYTE BYTE BYTE BYTE
BYTE BYTE BYTE BYTE BYTE BYTE BYTE BYTE BYTE BYTE BYTE BYTE BYTE BYTE BYTE BYTE
BYTE BYTE BYTE BYTE BYTE BYTE BYTE BYTE BYTE BYTE BYTE BYTE BYTE BYTE BYTE BYTE
BYTE BYTE BYTE BYTE BYTE BYTE BYTE BYTE BYTE BYTE BYTE BYTE BYTE BYTE BYTE BYTE
BYTE BYTE BYTE BYTE BYTE BYTE BYTE BYTE BYTE BYTE BYTE BYTE BYTE BYTE BYTE BYTE
BYTE BYTE BYTE BYTE BYTE BYTE BYTE BYTE BYTE BYTE BYTE BYTE BYTE BYTE BYTE BYTE
BYTE BYTE BYTE BYTE BYTE BYTE BYTE BYTE BYTE BYTE BYTE BYTE BYTE BYTE BYTE BYTE
BYTE BYTE BYTE BYTE BYTE BYTE BYTE BYTE BYTE BYTE BYTE BYTE BYTE BYTE BYTE BYTE
BYTE BYTE BYTE BYTE BYTE BYTE BYTE BYTE BYTE BYTE BYTE BYTE BYTE BYTE BYTE BYTE
BYTE BYTE BYTE BYTE BYTE BYTE BYTE BYTE BYTE BYTE BYTE BYTE BYTE BYTE BYTE BYTE
BYTE BYTE BYTE BYTE BYTE BYTE BYTE BYTE BYTE BYTE BYTE BYTE BYTE BYTE BYTE BYTE
BYTE BYTE BYTE BYTE BYTE BYTE BYTE BYTE BYTE BYTE BYTE BYTE BYTE BYTE BYTE BYTE
BYTE BYTE BYTE BYTE BYTE BYTE BYTE BYTE BYTE BYTE BYTE BYTE BYTE BYTE BYTE BYTE
BYTE BYTE BYTE BYTE BYTE BYTE BYTE BYTE BYTE BYTE BYTE BYTE BYTE BYTE BYTE BYTE
BYTE BYTE BYTE BYTE BYTE BYTE BYTE BYTE BYTE BYTE BYTE BYTE BYTE BYTE BYTE
FULLPOINTER))
(QUOTE ((CHARTABLE 0 (BITS . 7))
(CHARTABLE 0 (BITS . 207Q))
(CHARTABLE 1 (BITS . 7))
(CHARTABLE 1 (BITS . 207Q))
(CHARTABLE 2 (BITS . 7))
(CHARTABLE 2 (BITS . 207Q))
(CHARTABLE 3 (BITS . 7))
(CHARTABLE 3 (BITS . 207Q))
(CHARTABLE 4 (BITS . 7))
(CHARTABLE 4 (BITS . 207Q))
(CHARTABLE 5 (BITS . 7))
(CHARTABLE 5 (BITS . 207Q))
(CHARTABLE 6 (BITS . 7))
(CHARTABLE 6 (BITS . 207Q))
(CHARTABLE 7 (BITS . 7))
(CHARTABLE 7 (BITS . 207Q))
(CHARTABLE 10Q (BITS . 7))
(CHARTABLE 10Q (BITS . 207Q))
(CHARTABLE 11Q (BITS . 7))
(CHARTABLE 11Q (BITS . 207Q))
(CHARTABLE 12Q (BITS . 7))
(CHARTABLE 12Q (BITS . 207Q))
(CHARTABLE 13Q (BITS . 7))
(CHARTABLE 13Q (BITS . 207Q))
(CHARTABLE 14Q (BITS . 7))
(CHARTABLE 14Q (BITS . 207Q))
(CHARTABLE 15Q (BITS . 7))
(CHARTABLE 15Q (BITS . 207Q))
(CHARTABLE 16Q (BITS . 7))
(CHARTABLE 16Q (BITS . 207Q))
(CHARTABLE 17Q (BITS . 7))
(CHARTABLE 17Q (BITS . 207Q))
(CHARTABLE 20Q (BITS . 7))
(CHARTABLE 20Q (BITS . 207Q))
(CHARTABLE 21Q (BITS . 7))
(CHARTABLE 21Q (BITS . 207Q))
(CHARTABLE 22Q (BITS . 7))
(CHARTABLE 22Q (BITS . 207Q))
(CHARTABLE 23Q (BITS . 7))
(CHARTABLE 23Q (BITS . 207Q))
(CHARTABLE 24Q (BITS . 7))
(CHARTABLE 24Q (BITS . 207Q))
(CHARTABLE 25Q (BITS . 7))
(CHARTABLE 25Q (BITS . 207Q))
(CHARTABLE 26Q (BITS . 7))
(CHARTABLE 26Q (BITS . 207Q))
(CHARTABLE 27Q (BITS . 7))
(CHARTABLE 27Q (BITS . 207Q))
(CHARTABLE 30Q (BITS . 7))
(CHARTABLE 30Q (BITS . 207Q))
(CHARTABLE 31Q (BITS . 7))
(CHARTABLE 31Q (BITS . 207Q))
(CHARTABLE 32Q (BITS . 7))
(CHARTABLE 32Q (BITS . 207Q))
(CHARTABLE 33Q (BITS . 7))
(CHARTABLE 33Q (BITS . 207Q))
(CHARTABLE 34Q (BITS . 7))
(CHARTABLE 34Q (BITS . 207Q))
(CHARTABLE 35Q (BITS . 7))
(CHARTABLE 35Q (BITS . 207Q))
(CHARTABLE 36Q (BITS . 7))
(CHARTABLE 36Q (BITS . 207Q))
(CHARTABLE 37Q (BITS . 7))
(CHARTABLE 37Q (BITS . 207Q))
(CHARTABLE 40Q (BITS . 7))
(CHARTABLE 40Q (BITS . 207Q))
(CHARTABLE 41Q (BITS . 7))
(CHARTABLE 41Q (BITS . 207Q))
(CHARTABLE 42Q (BITS . 7))
(CHARTABLE 42Q (BITS . 207Q))
(CHARTABLE 43Q (BITS . 7))
(CHARTABLE 43Q (BITS . 207Q))
(CHARTABLE 44Q (BITS . 7))
(CHARTABLE 44Q (BITS . 207Q))
(CHARTABLE 45Q (BITS . 7))
(CHARTABLE 45Q (BITS . 207Q))
(CHARTABLE 46Q (BITS . 7))
(CHARTABLE 46Q (BITS . 207Q))
(CHARTABLE 47Q (BITS . 7))
(CHARTABLE 47Q (BITS . 207Q))
(CHARTABLE 50Q (BITS . 7))
(CHARTABLE 50Q (BITS . 207Q))
(CHARTABLE 51Q (BITS . 7))
(CHARTABLE 51Q (BITS . 207Q))
(CHARTABLE 52Q (BITS . 7))
(CHARTABLE 52Q (BITS . 207Q))
(CHARTABLE 53Q (BITS . 7))
(CHARTABLE 53Q (BITS . 207Q))
(CHARTABLE 54Q (BITS . 7))
(CHARTABLE 54Q (BITS . 207Q))
(CHARTABLE 55Q (BITS . 7))
(CHARTABLE 55Q (BITS . 207Q))
(CHARTABLE 56Q (BITS . 7))
(CHARTABLE 56Q (BITS . 207Q))
(CHARTABLE 57Q (BITS . 7))
(CHARTABLE 57Q (BITS . 207Q))
(CHARTABLE 60Q (BITS . 7))
(CHARTABLE 60Q (BITS . 207Q))
(CHARTABLE 61Q (BITS . 7))
(CHARTABLE 61Q (BITS . 207Q))
(CHARTABLE 62Q (BITS . 7))
(CHARTABLE 62Q (BITS . 207Q))
(CHARTABLE 63Q (BITS . 7))
(CHARTABLE 63Q (BITS . 207Q))
(CHARTABLE 64Q (BITS . 7))
(CHARTABLE 64Q (BITS . 207Q))
(CHARTABLE 65Q (BITS . 7))
(CHARTABLE 65Q (BITS . 207Q))
(CHARTABLE 66Q (BITS . 7))
(CHARTABLE 66Q (BITS . 207Q))
(CHARTABLE 67Q (BITS . 7))
(CHARTABLE 67Q (BITS . 207Q))
(CHARTABLE 70Q (BITS . 7))
(CHARTABLE 70Q (BITS . 207Q))
(CHARTABLE 71Q (BITS . 7))
(CHARTABLE 71Q (BITS . 207Q))
(CHARTABLE 72Q (BITS . 7))
(CHARTABLE 72Q (BITS . 207Q))
(CHARTABLE 73Q (BITS . 7))
(CHARTABLE 73Q (BITS . 207Q))
(CHARTABLE 74Q (BITS . 7))
(CHARTABLE 74Q (BITS . 207Q))
(CHARTABLE 75Q (BITS . 7))
(CHARTABLE 75Q (BITS . 207Q))
(CHARTABLE 76Q (BITS . 7))
(CHARTABLE 76Q (BITS . 207Q))
(CHARTABLE 77Q (BITS . 7))
(CHARTABLE 77Q (BITS . 207Q))
(CHARTABLE 100Q (BITS . 7))
(CHARTABLE 100Q (BITS . 207Q))
(CHARTABLE 101Q (BITS . 7))
(CHARTABLE 101Q (BITS . 207Q))
(CHARTABLE 102Q (BITS . 7))
(CHARTABLE 102Q (BITS . 207Q))
(CHARTABLE 103Q (BITS . 7))
(CHARTABLE 103Q (BITS . 207Q))
(CHARTABLE 104Q (BITS . 7))
(CHARTABLE 104Q (BITS . 207Q))
(CHARTABLE 105Q (BITS . 7))
(CHARTABLE 105Q (BITS . 207Q))
(CHARTABLE 106Q (BITS . 7))
(CHARTABLE 106Q (BITS . 207Q))
(CHARTABLE 107Q (BITS . 7))
(CHARTABLE 107Q (BITS . 207Q))
(CHARTABLE 110Q (BITS . 7))
(CHARTABLE 110Q (BITS . 207Q))
(CHARTABLE 111Q (BITS . 7))
(CHARTABLE 111Q (BITS . 207Q))
(CHARTABLE 112Q (BITS . 7))
(CHARTABLE 112Q (BITS . 207Q))
(CHARTABLE 113Q (BITS . 7))
(CHARTABLE 113Q (BITS . 207Q))
(CHARTABLE 114Q (BITS . 7))
(CHARTABLE 114Q (BITS . 207Q))
(CHARTABLE 115Q (BITS . 7))
(CHARTABLE 115Q (BITS . 207Q))
(CHARTABLE 116Q (BITS . 7))
(CHARTABLE 116Q (BITS . 207Q))
(CHARTABLE 117Q (BITS . 7))
(CHARTABLE 117Q (BITS . 207Q))
(CHARTABLE 120Q (BITS . 7))
(CHARTABLE 120Q (BITS . 207Q))
(CHARTABLE 121Q (BITS . 7))
(CHARTABLE 121Q (BITS . 207Q))
(CHARTABLE 122Q (BITS . 7))
(CHARTABLE 122Q (BITS . 207Q))
(CHARTABLE 123Q (BITS . 7))
(CHARTABLE 123Q (BITS . 207Q))
(CHARTABLE 124Q (BITS . 7))
(CHARTABLE 124Q (BITS . 207Q))
(CHARTABLE 125Q (BITS . 7))
(CHARTABLE 125Q (BITS . 207Q))
(CHARTABLE 126Q (BITS . 7))
(CHARTABLE 126Q (BITS . 207Q))
(CHARTABLE 127Q (BITS . 7))
(CHARTABLE 127Q (BITS . 207Q))
(CHARTABLE 130Q (BITS . 7))
(CHARTABLE 130Q (BITS . 207Q))
(CHARTABLE 131Q (BITS . 7))
(CHARTABLE 131Q (BITS . 207Q))
(CHARTABLE 132Q (BITS . 7))
(CHARTABLE 132Q (BITS . 207Q))
(CHARTABLE 133Q (BITS . 7))
(CHARTABLE 133Q (BITS . 207Q))
(CHARTABLE 134Q (BITS . 7))
(CHARTABLE 134Q (BITS . 207Q))
(CHARTABLE 135Q (BITS . 7))
(CHARTABLE 135Q (BITS . 207Q))
(CHARTABLE 136Q (BITS . 7))
(CHARTABLE 136Q (BITS . 207Q))
(CHARTABLE 137Q (BITS . 7))
(CHARTABLE 137Q (BITS . 207Q))
(CHARTABLE 140Q (BITS . 7))
(CHARTABLE 140Q (BITS . 207Q))
(CHARTABLE 141Q (BITS . 7))
(CHARTABLE 141Q (BITS . 207Q))
(CHARTABLE 142Q (BITS . 7))
(CHARTABLE 142Q (BITS . 207Q))
(CHARTABLE 143Q (BITS . 7))
(CHARTABLE 143Q (BITS . 207Q))
(CHARTABLE 144Q (BITS . 7))
(CHARTABLE 144Q (BITS . 207Q))
(CHARTABLE 145Q (BITS . 7))
(CHARTABLE 145Q (BITS . 207Q))
(CHARTABLE 146Q (BITS . 7))
(CHARTABLE 146Q (BITS . 207Q))
(CHARTABLE 147Q (BITS . 7))
(CHARTABLE 147Q (BITS . 207Q))
(CHARTABLE 150Q (BITS . 7))
(CHARTABLE 150Q (BITS . 207Q))
(CHARTABLE 151Q (BITS . 7))
(CHARTABLE 151Q (BITS . 207Q))
(CHARTABLE 152Q (BITS . 7))
(CHARTABLE 152Q (BITS . 207Q))
(CHARTABLE 153Q (BITS . 7))
(CHARTABLE 153Q (BITS . 207Q))
(CHARTABLE 154Q (BITS . 7))
(CHARTABLE 154Q (BITS . 207Q))
(CHARTABLE 155Q (BITS . 7))
(CHARTABLE 155Q (BITS . 207Q))
(CHARTABLE 156Q (BITS . 7))
(CHARTABLE 156Q (BITS . 207Q))
(CHARTABLE 157Q (BITS . 7))
(CHARTABLE 157Q (BITS . 207Q))
(CHARTABLE 160Q (BITS . 7))
(CHARTABLE 160Q (BITS . 207Q))
(CHARTABLE 161Q (BITS . 7))
(CHARTABLE 161Q (BITS . 207Q))
(CHARTABLE 162Q (BITS . 7))
(CHARTABLE 162Q (BITS . 207Q))
(CHARTABLE 163Q (BITS . 7))
(CHARTABLE 163Q (BITS . 207Q))
(CHARTABLE 164Q (BITS . 7))
(CHARTABLE 164Q (BITS . 207Q))
(CHARTABLE 165Q (BITS . 7))
(CHARTABLE 165Q (BITS . 207Q))
(CHARTABLE 166Q (BITS . 7))
(CHARTABLE 166Q (BITS . 207Q))
(CHARTABLE 167Q (BITS . 7))
(CHARTABLE 167Q (BITS . 207Q))
(CHARTABLE 170Q (BITS . 7))
(CHARTABLE 170Q (BITS . 207Q))
(CHARTABLE 171Q (BITS . 7))
(CHARTABLE 171Q (BITS . 207Q))
(CHARTABLE 172Q (BITS . 7))
(CHARTABLE 172Q (BITS . 207Q))
(CHARTABLE 173Q (BITS . 7))
(CHARTABLE 173Q (BITS . 207Q))
(CHARTABLE 174Q (BITS . 7))
(CHARTABLE 174Q (BITS . 207Q))
(CHARTABLE 175Q (BITS . 7))
(CHARTABLE 175Q (BITS . 207Q))
(CHARTABLE 176Q (BITS . 7))
(CHARTABLE 176Q (BITS . 207Q))
(CHARTABLE 177Q (BITS . 7))
(CHARTABLE 177Q (BITS . 207Q))
(CHARTABLE 200Q FULLPOINTER)))
(QUOTE 202Q))
(* END EXPORTED DEFINITIONS)
(DECLARE: EVAL@COMPILE
(RPAQQ \NSCHARHASHKEYS 12Q)
(RPAQQ \NSCHARHASHOVERFLOW 1.3)
(CONSTANTS \NSCHARHASHKEYS \NSCHARHASHOVERFLOW)
)
(DECLARE: EVAL@COMPILE
[PUTPROPS \CREATENSCHARHASH MACRO (ARGS (* added size argument for creation of \ORIGTERMTABLE during
initialization.)
(LIST (QUOTE HASHARRAY)
(OR (CAR ARGS)
(QUOTE \NSCHARHASHKEYS))
(QUOTE \NSCHARHASHOVERFLOW]
[PUTPROPS \MAPCHARTABLE MACRO (LAMBDA (FN CHARTBL)
(for I from 0 to \MAXTHINCHAR do (APPLY* FN (\GETBASEBYTE
CHARTBL I)
I))
(COND ((fetch (CHARTABLE NSCHARHASH)
of CHARTBL)
(MAPHASH (fetch (CHARTABLE NSCHARHASH)
of CHARTBL)
FN]
)
)
(DEFINEQ
(GETSYNTAX
[LAMBDA (CH TABLE) (* bvm:
" 8-Mar-86 17:22")
(COND
[(FIXP (SETQ CH (\GETCHARCODE CH)))
(COND
((type? TERMTABLEP TABLE)
(\GETTERMSYNTAX CH TABLE))
(T (\GETREADSYNTAX CH (\GTREADTABLE TABLE T]
(T (PROG (TEM CHARTBL RESULT)
(COND
((SETQ TEM (\READCLASSTOCODE CH))
(SETQ CHARTBL (fetch READSA of (\GTREADTABLE TABLE T)))
(\MAPCHARTABLE [FUNCTION (LAMBDA (VAL KEY)
(DECLARE (USEDFREE TEM RESULT))
(COND
((EQ TEM VAL)
(push RESULT KEY]
CHARTBL))
((EQ CH (QUOTE BREAK))
(SETQ CHARTBL (fetch READSA of (\GTREADTABLE TABLE T)))
(\MAPCHARTABLE [FUNCTION (LAMBDA (VAL KEY)
(DECLARE (USEDFREE TEM RESULT))
(COND
((fetch BREAK of VAL)
(push RESULT KEY]
CHARTBL))
((SETQ TEM (\TERMCLASSTOCODE CH))
(SETQ CHARTBL (fetch TERMSA of (\GTTERMTABLE TABLE T)))
(\MAPCHARTABLE [FUNCTION (LAMBDA (VAL KEY)
(DECLARE (USEDFREE TEM RESULT))
(COND
((EQ TEM (fetch TERMCLASS of VAL))
(push RESULT (PROG1 KEY
(* SELECTC TEM
((LIST NONE.TC
WORDSEPR.TC) (* Only
these classes have
multiple members) KEY)
(RETURN (CONS KEY)))]
CHARTBL))
[(FMEMB CH (QUOTE (MACRO SPLICE INFIX)))
(PROG [LST (A (fetch READMACRODEFS of (\GTREADTABLE TABLE T]
(COND
(A [MAPHASH A (FUNCTION (LAMBDA (DEF C)
(AND (EQ CH (fetch MACROTYPE of DEF))
(push LST C]
(RETURN LST]
((SETQ TEM (fetch (CONTEXTS VAL) of CH))
(SETQ CHARTBL (fetch READSA of (\GTREADTABLE TABLE T)))
(\MAPCHARTABLE [FUNCTION (LAMBDA (VAL KEY)
(DECLARE (USEDFREE TEM RESULT))
(COND
((EQ TEM (fetch MACROCONTEXT of VAL))
(push RESULT KEY]
CHARTBL))
((SETQ TEM (fetch (WAKEUPS VAL) of CH))
(SETQ CHARTBL (fetch READSA of (\GTREADTABLE TABLE T)))
(\MAPCHARTABLE [FUNCTION (LAMBDA (VAL KEY)
(DECLARE (USEDFREE TEM RESULT))
(COND
((EQ TEM (fetch WAKEUP of VAL))
(push RESULT KEY]
CHARTBL))
((SETQ TEM (fetch (ESCAPES VAL) of CH))
(SETQ CHARTBL (fetch READSA of (\GTREADTABLE TABLE T)))
(\MAPCHARTABLE [FUNCTION (LAMBDA (VAL KEY)
(DECLARE (USEDFREE TEM RESULT))
(COND
((EQ TEM (fetch ESCAPE of VAL))
(push RESULT KEY]
CHARTBL))
(T (\ILLEGAL.ARG CH)))
(RETURN RESULT])
(SETSYNTAX
[LAMBDA (CHAR CLASS TBL) (* rmk:
"20-Nov-84 15:47")
(OR (FIXP (SETQ CHAR (\GETCHARCODE CHAR)))
(\ILLEGAL.ARG CHAR))
[OR (type? READTABLEP TBL)
(type? TERMTABLEP TBL)
(SETQ TBL (COND
((OR (type? TERMTABLEP CLASS)
(\TERMCLASSTOCODE CLASS))
(\GTTERMTABLE TBL))
(T (\GTREADTABLE TBL]
[COND
((OR (type? READTABLEP CLASS)
(type? TERMTABLEP CLASS)
(SELECTQ CLASS
((NIL T ORIG)
T)
NIL))
(SETQ CLASS (GETSYNTAX CHAR CLASS)))
((FIXP (SETQ CLASS (\GETCHARCODE CLASS)))
(SETQ CLASS (GETSYNTAX CLASS TBL]
(COND
((type? READTABLEP TBL)
(PROG1 (\GETREADSYNTAX CHAR TBL)
(\SETREADSYNTAX CHAR CLASS TBL)))
(T (PROG1 (\GETTERMSYNTAX CHAR TBL)
(\SETTERMSYNTAX CHAR CLASS TBL])
(SYNTAXP
[LAMBDA (CODE CLASS TABLE) (* rmk:
" 5-JUN-80 22:40")
(PROG (D)
(RETURN (COND
((EQ CLASS (QUOTE BREAK))
(fetch BREAK of (\SYNCODE (fetch READSA of (\GTREADTABLE
TABLE))
CODE)))
((SETQ D (\READCLASSTOCODE CLASS))
(EQ D (\SYNCODE (fetch READSA of (\GTREADTABLE TABLE))
CODE)))
[(SETQ D (\TERMCLASSTOCODE CLASS))
(EQ D (fetch TERMCLASS of (\SYNCODE (fetch TERMSA
of (\GTTERMTABLE TABLE))
CODE]
[(FMEMB CLASS (QUOTE (MACRO SPLICE INFIX)))
(AND (SETQ D (fetch READMACRODEFS of (\GTREADTABLE TABLE)))
(EQ CLASS (fetch MACROTYPE of (GETHASH CODE D]
[(SETQ D (fetch (CONTEXTS VAL) of CLASS))
(EQ D (fetch MACROCONTEXT of (\SYNCODE (fetch READSA
of (\GTREADTABLE
TABLE))
CODE]
[(SETQ D (fetch (WAKEUPS VAL) of CLASS))
(EQ D (fetch WAKEUP of (\SYNCODE (fetch READSA of (
\GTREADTABLE
TABLE))
CODE]
[(SETQ D (fetch (ESCAPES VAL) of CLASS))
(EQ D (fetch ESCAPE of (\SYNCODE (fetch READSA of (
\GTREADTABLE
TABLE))
CODE]
(T (\ILLEGAL.ARG CLASS])
(\COPYSYNTAX
[LAMBDA (A B) (* gbn
"15-Sep-85 22:36")
(* Copies chartable A
into chartable B)
(CHECK (AND (type? CHARTABLE A)
(type? CHARTABLE B)))
(\MOVEBYTES A 0 B 0 (ADD1 \MAXTHINCHAR))
(COND
((fetch (CHARTABLE NSCHARHASH) of A)
(replace (CHARTABLE NSCHARHASH) of B with (REHASH (fetch (CHARTABLE
NSCHARHASH)
of A)
(\CREATENSCHARHASH])
(\GETCHARCODE
[LAMBDA (C) (* rmk:
"20-Nov-84 15:46")
(COND
((AND (NUMBERP C)
(\CHARCODEP (FIX C)))
(FIX C))
((AND (LITATOM C)
(EQ 1 (NCHARS C)))
(CHCON1 C))
(T C])
(\SETFATSYNCODE
[LAMBDA (TABLE CHAR CODE) (* bvm:
" 8-Mar-86 17:03")
(* * Called by \SETSYNCODE macro for fat characters)
(SETQ TABLE (\DTEST TABLE (QUOTE CHARTABLE))) (* CODE = 0 is
REAL.CCE, NONE.TC,
OTHER.RC)
(COND
((ILEQ CHAR \MAXTHINCHAR)
(\PUTBASEBYTE TABLE CHAR CODE))
((EQ 0 CODE)
(COND
((fetch (CHARTABLE NSCHARHASH) of TABLE) (* there was already a
table here so record the
change)
(PUTHASH CHAR CODE (fetch (CHARTABLE NSCHARHASH) of TABLE)))
(T (* No hashtable yet,
and only the default is
being stored, so don't
build the hashtable)
0)))
(T (PUTHASH CHAR CODE (OR (fetch (CHARTABLE NSCHARHASH) of TABLE)
(replace (CHARTABLE NSCHARHASH) of TABLE with (
\CREATENSCHARHASH
])
)
(* terminal tables)
(DEFINEQ
(CONTROL
[LAMBDA (MODE TTBL) (* rmk:
" 8-FEB-80 11:59")
(PROG1 (fetch CONTROLFLG of (SETQ TTBL (\GTTERMTABLE TTBL)))
(replace CONTROLFLG of TTBL with (AND MODE T])
(COPYTERMTABLE
[LAMBDA (TTBL) (* lmm
"14-APR-81 14:27")
(create TERMTABLEP using (SETQ TTBL (\GTTERMTABLE TTBL T))
TERMSA ←(create CHARTABLE using (fetch TERMSA
of TTBL])
(DELETECONTROL
[LAMBDA (TYPE MESSAGE TTBL) (* lmm
" 1-Jan-85 21:34")
(PROG [VAL (TBL (\GTTERMTABLE TTBL (NULL MESSAGE]
(SETQ VAL (SELECTQ TYPE
((ECHO NOECHO)
(PROG1 (fetch DELCHARECHO of TBL)
(replace DELCHARECHO of TBL with TYPE)))
(DELCHARECHO (PROG1 (fetch DELCHARECHO of TBL)
(SELECTQ MESSAGE
(NIL (* Called only to get
current value))
((ECHO NOECHO)
(replace DELCHARECHO of TBL with
MESSAGE))
(LISPERROR "ILLEGAL ARG" MESSAGE))))
((LINEDELETE DELETELINE)
[PROG1 (fetch LINEDELETE of TBL)
(AND MESSAGE (replace LINEDELETE of TBL
with (\LITCHECK MESSAGE])
(1STCHDEL [PROG1 (fetch 1STCHDEL of TBL)
(AND MESSAGE (replace 1STCHDEL of TBL
with (\LITCHECK MESSAGE])
(NTHCHDEL [PROG1 (fetch NTHCHDEL of TBL)
(AND MESSAGE (replace NTHCHDEL of TBL
with (\LITCHECK MESSAGE])
(POSTCHDEL [PROG1 (fetch POSTCHDEL of TBL)
(AND MESSAGE (replace POSTCHDEL of TBL
with (\LITCHECK MESSAGE])
(EMPTYCHDEL [PROG1 (fetch EMPTYCHDEL of TBL)
(AND MESSAGE (replace EMPTYCHDEL of TBL
with (\LITCHECK MESSAGE])
(LISPERROR "ILLEGAL ARG" TYPE)))
(RETURN (COND
((STRINGP VAL)
(CONCAT VAL))
(T VAL])
(GETDELETECONTROL
[LAMBDA (TYPE TTBL) (* lmm
" 1-Jan-85 21:20")
(PROG (TBL VAL)
(SETQ TBL (\GTTERMTABLE TTBL T))
(SETQ VAL (SELECTQ TYPE
((ECHO NOECHO)
(fetch DELCHARECHO of TBL))
(DELCHARECHO (fetch DELCHARECHO of TBL))
((LINEDELETE DELETELINE)
(fetch LINEDELETE of TBL))
(1STCHDEL (fetch 1STCHDEL of TBL))
(NTHCHDEL (fetch NTHCHDEL of TBL))
(POSTCHDEL (fetch POSTCHDEL of TBL))
(EMPTYCHDEL (fetch EMPTYCHDEL of TBL))
(LISPERROR "ILLEGAL ARG" TYPE)))
(RETURN (COND
((STRINGP VAL)
(CONCAT VAL))
(T VAL])
(ECHOCHAR
[LAMBDA (CHARCODE MODE TTBL) (* lmm
" 1-Jan-85 21:29")
(COND
((LISTP CHARCODE)
(for X in CHARCODE do (ECHOCHAR X MODE TTBL)))
(T (PROG [B (SA (fetch TERMSA of (\GTTERMTABLE TTBL (NULL MODE]
(RETURN (PROG1 (SELECTC (fetch CCECHO of (SETQ B (\SYNCODE SA CHARCODE)))
(REAL.CCE (QUOTE REAL))
(IGNORE.CCE (QUOTE IGNORE))
(SIMULATE.CCE (QUOTE SIMULATE))
(QUOTE INDICATE))
(AND MODE (\SETSYNCODE SA CHARCODE (create TERMCODE
using B CCECHO ←(SELECTQ
MODE
(REAL
REAL.CCE)
(IGNORE
IGNORE.CCE)
(
SIMULATE
SIMULATE.CCE)
((
INDICATE
UPARROW
)
INDICATE.CCE)
(
\ILLEGAL.ARG
MODE])
(ECHOCONTROL
[LAMBDA (CHAR MODE TTBL) (* rmk:
"20-Nov-84 15:14")
(PROG ((C (\GETCHARCODE CHAR)))
(OR [AND (\THINCHARCODEP C)
(OR (ILESSP C 40Q)
(AND (IGEQ C (CHARCODE A))
(ILEQ C (CHARCODE Z))
(SETQ C (IDIFFERENCE C 100Q]
(\ILLEGAL.ARG C))
(RETURN (ECHOCHAR C MODE TTBL])
(ECHOMODE
[LAMBDA (FLG TTBL) (* rmk:
" 8-FEB-80 11:57")
(PROG1 (fetch ECHOFLG of (SETQ TTBL (\GTTERMTABLE TTBL)))
(replace ECHOFLG of TTBL with (AND FLG T])
(GETECHOMODE
[LAMBDA (TTBL) (* lmm
" 1-Jan-85 21:21")
(fetch ECHOFLG of (\GTTERMTABLE TTBL T])
(GETCONTROL
[LAMBDA (TTBL) (* lmm
" 1-Jan-85 21:21")
(fetch CONTROLFLG of (\GTTERMTABLE TTBL T])
(GETTERMTABLE
[LAMBDA (TTBL)
(\GTTERMTABLE TTBL NIL])
(RAISE
[LAMBDA (FLG TTBL) (* bvm:
"14-Feb-85 00:17")
(PROG1 (fetch RAISEFLG of (SETQ TTBL (\GTTERMTABLE TTBL)))
(replace RAISEFLG of TTBL with (COND
((EQ FLG 0)
0)
(FLG T])
(GETRAISE
[LAMBDA (TTBL) (* lmm
" 1-Jan-85 21:21")
(fetch RAISEFLG of (\GTTERMTABLE TTBL T])
(RESETTERMTABLE
[LAMBDA (TTBL FROM) (* lmm
"14-APR-81 14:34")
(PROG ((FR (\GTTERMTABLE FROM T))
(TT (\GTTERMTABLE TTBL)))
(\COPYSYNTAX (fetch TERMSA of FR)
(fetch TERMSA of TT))
(replace RAISEFLG of TT with (fetch RAISEFLG of FR))
(replace DELCHARECHO of TT with (fetch DELCHARECHO of FR))
(replace LINEDELETE of TT with (fetch LINEDELETE of FR))
(replace 1STCHDEL of TT with (fetch 1STCHDEL of FR))
(replace NTHCHDEL of TT with (fetch NTHCHDEL of FR))
(replace POSTCHDEL of TT with (fetch POSTCHDEL of FR))
(replace EMPTYCHDEL of TT with (fetch EMPTYCHDEL of FR))
(replace CONTROLFLG of TT with (fetch CONTROLFLG of FR))
(replace ECHOFLG of TT with (fetch ECHOFLG of FR))
(RETURN TT])
(SETTERMTABLE
[LAMBDA (TBL) (* rmk:
" 8-FEB-80 12:16")
(PROG1 \PRIMTERMTABLE (SETQ \PRIMTERMSA (fetch TERMSA of (SETQ \PRIMTERMTABLE
(\GTTERMTABLE TBL])
(TERMTABLEP
[LAMBDA (TTBL) (* rmk:
"20-FEB-80 12:29")
(AND (type? TERMTABLEP TTBL)
TTBL])
(\GETTERMSYNTAX
[LAMBDA (C TBL) (* rmk:
"24-APR-80 09:44")
(\TERMCODETOCLASS (fetch TERMCLASS of (\SYNCODE (fetch TERMSA of TBL)
C])
(\GTTERMTABLE
[LAMBDA (TTBL FLG) (* lmm
" 6-MAY-80 20:35")
(COND
((type? TERMTABLEP TTBL)
TTBL)
((NULL TTBL)
\PRIMTERMTABLE)
((AND (EQ TTBL (QUOTE ORIG))
FLG)
\ORIGTERMTABLE)
(T (LISPERROR "ILLEGAL TERMINAL TABLE" TTBL])
(\ORIGTERMTABLE
[LAMBDA NIL (* rrb
" 5-Oct-85 10:33")
(* Creates the
original terminal table)
(* must be created with a hash table big enough to hold all of the
indicates in character set 1 because this gets evaluated in the loadup
before HASHOVERFLOW is defined. rrb 5-oct-85)
(PROG ((TBL (create TERMTABLEP
TERMSA ←(create CHARTABLE
NSCHARHASH ←(\CREATENSCHARHASH 454Q))
DELCHARECHO ←(QUOTE ECHO)
ECHOFLG ← T
LINEDELETE ←"##
"
1STCHDEL ←"\"
NTHCHDEL ←""
POSTCHDEL ←"\"
EMPTYCHDEL ←"##
")))
(PROGN (\SETTERMSYNTAX (SELECTQ (SYSTEMTYPE)
((TENEX D)
(CHARCODE ↑A))
((JERICHO VAX TOPS-20)
(CHARCODE DEL))
(SHOULDNT))
(QUOTE CHARDELETE)
TBL)
(\SETTERMSYNTAX (CHARCODE ↑H)
(QUOTE CHARDELETE)
TBL) (* Added ↑H as a
CHARDELETE character
9/30/85)
(\SETTERMSYNTAX (CHARCODE ↑W)
(QUOTE WORDDELETE)
TBL)
(\SETTERMSYNTAX (SELECTQ (SYSTEMTYPE)
((TENEX D)
(CHARCODE ↑Q))
((JERICHO VAX)
(CHARCODE ↑U))
(SHOULDNT))
(QUOTE LINEDELETE)
TBL)
(\SETTERMSYNTAX (CHARCODE ↑R)
(QUOTE RETYPE)
TBL)
(\SETTERMSYNTAX (CHARCODE ↑V)
(QUOTE CTRLV)
TBL)
(\SETTERMSYNTAX (CHARCODE EOL)
(QUOTE WAKEUPCHAR)
TBL)
(for C
in (CHARCODE (SPACE TAB ! @ # $ ~ & * - = + %| { } ↑ ← : ; < > , %. ? /))
do (\SETTERMSYNTAX C (QUOTE WORDSEPR)
TBL)))
(PROGN (ECHOCHAR (CHARCODE (NULL ↑A ↑B ↑C ↑D ↑E ↑F ↑H ↑K ↑L ↑N ↑O ↑P ↑Q ↑R ↑S ↑T ↑U ↑V
↑W ↑X ↑Y ↑Z ↑\ ↑%] ↑↑))
(QUOTE INDICATE)
TBL)
(ECHOCHAR (CHARCODE (BELL TAB LF CR))
(QUOTE REAL)
TBL)
(SELECTQ (SYSTEMTYPE)
(D (ECHOCHAR (CHARCODE (NULL ↑A ↑W ↑Q ↑R))
(QUOTE IGNORE)
TBL)
(ECHOCHAR (CHARCODE (BELL TAB ESCAPE LF TENEXEOL))
(QUOTE SIMULATE)
TBL))
(JERICHO (ECHOCHAR [CONSTANT (CONS ERASECHARCODE
(CHARCODE (BELL TAB ESCAPE EOL]
(QUOTE SIMULATE)
TBL))
(VAX (ECHOCHAR (CHARCODE (TAB ESCAPE EOL DEL))
(QUOTE SIMULATE)
TBL))
NIL))
(for C from 200Q to \MAXTHINCHAR do (ECHOCHAR C (QUOTE REAL)
TBL))
(for C from (CHARCODE 1,0) to (CHARCODE 1,377) do (ECHOCHAR
C
(QUOTE INDICATE)
TBL))
(RETURN TBL])
(\SETTERMSYNTAX
[LAMBDA (C CLASS TBL) (* rmk:
"26-Mar-85 23:45")
(* Changes the
terminal syntax class
for charcode C.
Unlike Interlisp-10,
does not turn off
previous characters for
CHARDELETE, etc.
classes)
(\SETSYNCODE (fetch TERMSA of TBL)
C
(create TERMCODE using (\SYNCODE (fetch TERMSA of TBL)
C)
TERMCLASS ←(OR (\TERMCLASSTOCODE CLASS)
(LISPERROR "ILLEGAL ARG" CLASS])
(\TERMCLASSTOCODE
[LAMBDA (CLASS) (* rmk:
"11-FEB-82 21:24")
(SELECTQ CLASS
((EOL WAKEUPCHAR)
EOL.TC)
(NONE NONE.TC)
(CHARDELETE CHARDELETE.TC)
(WORDDELETE WORDDELETE.TC)
(WORDSEPR WORDSEPR.TC)
(LINEDELETE LINEDELETE.TC)
(RETYPE RETYPE.TC)
((CTRLV CNTRLV)
CTRLV.TC)
NIL])
(\TERMCODETOCLASS
[LAMBDA (CODE) (* rmk:
"11-FEB-82 21:24")
(SELECTC CODE
(EOL.TC (QUOTE EOL))
(NONE.TC (QUOTE NONE))
(CHARDELETE.TC
(QUOTE CHARDELETE))
(WORDDELETE.TC
(QUOTE WORDDELETE))
(WORDSEPR.TC (QUOTE WORDSEPR))
(LINEDELETE.TC
(QUOTE LINEDELETE))
(RETYPE.TC (QUOTE RETYPE))
(CTRLV.TC (QUOTE CNTRLV))
NIL])
(\LITCHECK
[LAMBDA (X) (* rmk:
"11-FEB-82 21:26")
(COND
((EQ X (QUOTE BACKUP)) (* Means take
terminal/implementation
dependent backup action)
X)
((LITATOM X)
(MKSTRING X))
((STRINGP X)
(CONCAT X))
(T (\ILLEGAL.ARG X])
)
(DECLARE: DONTCOPY
(* FOLLOWING DEFINITIONS EXPORTED)
(RPAQQ CCECHOMODES (REAL.CCE IGNORE.CCE SIMULATE.CCE INDICATE.CCE))
(DECLARE: EVAL@COMPILE
(RPAQQ REAL.CCE 0)
(RPAQQ IGNORE.CCE 10Q)
(RPAQQ SIMULATE.CCE 20Q)
(RPAQQ INDICATE.CCE 30Q)
(CONSTANTS REAL.CCE IGNORE.CCE SIMULATE.CCE INDICATE.CCE)
)
(RPAQQ TERMCLASSES (NONE.TC EOL.TC CHARDELETE.TC WORDDELETE.TC WORDSEPR.TC LINEDELETE.TC RETYPE.TC
CTRLV.TC))
(DECLARE: EVAL@COMPILE
(RPAQQ NONE.TC 0)
(RPAQQ EOL.TC 1)
(RPAQQ CHARDELETE.TC 2)
(RPAQQ WORDDELETE.TC 6)
(RPAQQ WORDSEPR.TC 7)
(RPAQQ LINEDELETE.TC 3)
(RPAQQ RETYPE.TC 4)
(RPAQQ CTRLV.TC 5)
(CONSTANTS NONE.TC EOL.TC CHARDELETE.TC WORDDELETE.TC WORDSEPR.TC LINEDELETE.TC RETYPE.TC CTRLV.TC)
)
[DECLARE: EVAL@COMPILE
(ACCESSFNS TERMCODE ((CCECHO (LOGAND DATUM 30Q))
(TERMCLASS (LOGAND DATUM 7))) (* We assume that
values are
appropriately shifted)
(CREATE (LOGOR CCECHO TERMCLASS)))
(DATATYPE TERMTABLEP (TERMSA RAISEFLG DELCHARECHO LINEDELETE 1STCHDEL NTHCHDEL POSTCHDEL EMPTYCHDEL
(CONTROLFLG FLAG)
(ECHOFLG FLAG))
TERMSA ←(create CHARTABLE))
]
(/DECLAREDATATYPE (QUOTE TERMTABLEP)
(QUOTE (POINTER POINTER POINTER POINTER POINTER POINTER POINTER POINTER FLAG FLAG))
[QUOTE ((TERMTABLEP 0 POINTER)
(TERMTABLEP 2 POINTER)
(TERMTABLEP 4 POINTER)
(TERMTABLEP 6 POINTER)
(TERMTABLEP 10Q POINTER)
(TERMTABLEP 12Q POINTER)
(TERMTABLEP 14Q POINTER)
(TERMTABLEP 16Q POINTER)
(TERMTABLEP 16Q (FLAGBITS . 0))
(TERMTABLEP 16Q (FLAGBITS . 20Q]
(QUOTE 20Q))
(* END EXPORTED DEFINITIONS)
)
(/DECLAREDATATYPE (QUOTE TERMTABLEP)
(QUOTE (POINTER POINTER POINTER POINTER POINTER POINTER POINTER POINTER FLAG FLAG))
[QUOTE ((TERMTABLEP 0 POINTER)
(TERMTABLEP 2 POINTER)
(TERMTABLEP 4 POINTER)
(TERMTABLEP 6 POINTER)
(TERMTABLEP 10Q POINTER)
(TERMTABLEP 12Q POINTER)
(TERMTABLEP 14Q POINTER)
(TERMTABLEP 16Q POINTER)
(TERMTABLEP 16Q (FLAGBITS . 0))
(TERMTABLEP 16Q (FLAGBITS . 20Q]
(QUOTE 20Q))
(* read tables)
(RPAQQ *READ-BASE* 12Q)
(RPAQQ *PRINT-RADIX* 12Q)
(DEFINEQ
(COPYREADTABLE
[LAMBDA (RDTBL) (* rmk:
" 2-FEB-80 12:26")
(RESETREADTABLE (create READTABLEP)
(\GTREADTABLE RDTBL T])
(ESCAPE
[LAMBDA (FLG RDTBL) (* rmk:
" 1-FEB-80 13:12")
(PROG1 (fetch ESCAPEFLG of (SETQ RDTBL (\GTREADTABLE RDTBL)))
(replace ESCAPEFLG of RDTBL with (NEQ FLG NIL])
(GETBRK
[LAMBDA (RDTBL) (* rmk:
" 2-MAY-80 17:04")
(GETSYNTAX (QUOTE BREAK)
RDTBL])
(GETREADTABLE
[LAMBDA (RDTBL) (* lmm: 4-FEB-76 3 62Q)
(\GTREADTABLE RDTBL])
(GETSEPR
[LAMBDA (RDTBL) (* rmk:
" 2-MAY-80 17:05")
(GETSYNTAX (QUOTE SEPR)
RDTBL])
(READMACROS
[LAMBDA (FLG RDTBL) (* rmk:
" 1-FEB-80 13:11")
(PROG1 (fetch READMACROFLG of (SETQ RDTBL (\GTREADTABLE RDTBL)))
(replace READMACROFLG of RDTBL with (NEQ FLG NIL])
(READTABLEP
[LAMBDA (RDTBL) (* rmk:
"20-FEB-80 12:32")
(AND (type? READTABLEP RDTBL)
RDTBL])
(READTABLEPROP
[LAMBDA ARGS (* bvm:
"10-Mar-86 17:35")
(COND
((LESSP ARGS 2)
(\ILLEGAL.ARG NIL))
((GREATERP ARGS 3)
(\ILLEGAL.ARG (ARG ARGS 4)))
(T (LET [(RDTBL (\GTREADTABLE (ARG ARGS 1)))
(NEWVALUEP (EQ ARGS 3))
(NEWVALUE (AND (EQ ARGS 3)
(ARG ARGS 3]
(SELECTQ (ARG ARGS 2)
(NUMBERBASE [PROG1 (fetch (READTABLEP NUMBERBASE) of RDTBL)
(COND
(NEWVALUEP (replace (READTABLEP NUMBERBASE) of RDTBL
with NEWVALUE])
(COMMONLISP [PROG1 (fetch (READTABLEP COMMONLISP) of RDTBL)
(COND
(NEWVALUEP (replace (READTABLEP COMMONLISP) of RDTBL
with NEWVALUE])
(CASEINSENSITIVE
[PROG1 (fetch (READTABLEP CASEINSENSITIVE) of RDTBL)
(COND
(NEWVALUEP (replace (READTABLEP CASEINSENSITIVE) of RDTBL
with NEWVALUE])
(ESCAPECHAR [PROG1 (fetch (READTABLEP ESCAPECHAR) of RDTBL)
(COND
(NEWVALUEP (\SETREADSYNTAX NEWVALUE (QUOTE ESCAPE)
RDTBL)
(replace (READTABLEP ESCAPECHAR) of RDTBL
with NEWVALUE])
(MULTIPLE-ESCAPECHAR
[PROG1 (fetch (READTABLEP MULTESCAPECHAR) of RDTBL)
(COND
(NEWVALUEP (\SETREADSYNTAX NEWVALUE (QUOTE MULTIPLE-ESCAPE)
RDTBL)
(replace (READTABLEP MULTESCAPECHAR) of RDTBL with NEWVALUE])
(PACKAGECHAR [PROG1 (fetch (READTABLEP PACKAGECHAR) of RDTBL)
(COND
(NEWVALUEP (\SETREADSYNTAX NEWVALUE (QUOTE PACKAGEDELIM)
RDTBL)
(replace (READTABLEP PACKAGECHAR) of RDTBL
with NEWVALUE])
(HASHMACROCHAR
[PROG1 (fetch (READTABLEP HASHMACROCHAR) of RDTBL)
(COND
(NEWVALUEP (\SETREADSYNTAX NEWVALUE
(QUOTE (INFIX ALWAYS NONIMMEDIATE ESCQUOTE
READVBAR))
RDTBL)
(replace (READTABLEP HASHMACROCHAR) of RDTBL with NEWVALUE])
(\ILLEGAL.ARG (ARG ARGS 2])
(RESETREADTABLE
[LAMBDA (RDTBL FROM) (* bvm:
" 8-Mar-86 16:48")
[replace READMACROFLG of (SETQ RDTBL (\GTREADTABLE RDTBL))
with (fetch READMACROFLG of (SETQ FROM (\GTREADTABLE FROM T]
(replace ESCAPEFLG of RDTBL with (fetch ESCAPEFLG of FROM))
(replace (READTABLEP COMMONLISP) of RDTBL with (fetch (READTABLEP
COMMONLISP)
of FROM))
(replace (READTABLEP NUMBERBASE) of RDTBL with (fetch (READTABLEP
NUMBERBASE)
of FROM))
(replace (READTABLEP CASEINSENSITIVE) of RDTBL with (fetch (READTABLEP
CASEINSENSITIVE)
of FROM))
(replace (READTABLEP HASHMACROCHAR) of RDTBL with (fetch (READTABLEP
HASHMACROCHAR)
of FROM))
(replace (READTABLEP ESCAPECHAR) of RDTBL with (fetch (READTABLEP
ESCAPECHAR)
of FROM))
(replace (READTABLEP MULTESCAPECHAR) of RDTBL with (fetch (READTABLEP
MULTESCAPECHAR)
of FROM))
(replace (READTABLEP PACKAGECHAR) of RDTBL with (fetch (READTABLEP
PACKAGECHAR)
of FROM))
[LET ((RDEFS (fetch (READTABLEP READMACRODEFS) of RDTBL))
(FDEFS (fetch (READTABLEP READMACRODEFS) of FROM))
N)
(COND
(RDEFS (CLRHASH RDEFS)))
(AND FDEFS (REHASH FDEFS (OR RDEFS (replace (READTABLEP READMACRODEFS) of RDTBL
with (HASHARRAY (HARRAYSIZE FDEFS)
7]
(\COPYSYNTAX (fetch READSA of FROM)
(fetch READSA of RDTBL))
RDTBL])
(SETBRK
[LAMBDA (LST FLG RDTBL) (* rmk:
"13-AUG-81 00:01")
(* This is a very ugly
def which needs to be
cleaned up cause a lot
of people call SETBRK)
(COND
[(EQ LST T)
[MAPC (GETSYNTAX (QUOTE BREAK)
RDTBL)
(FUNCTION (LAMBDA (X)
(SETSYNTAX X (QUOTE OTHER)
RDTBL]
(MAPC (GETSYNTAX (QUOTE BREAK)
(COND
((EQ RDTBL T)
(QUOTE ORIG))
(T T)))
(FUNCTION (LAMBDA (X)
(SETSYNTAX X (QUOTE BREAK)
RDTBL]
(T (SELECTQ FLG
(NIL (* reset)
[MAPC (GETSYNTAX (QUOTE BREAK)
RDTBL)
(FUNCTION (LAMBDA (X)
(OR (MEMB X LST)
(SETSYNTAX X (QUOTE OTHER)
RDTBL]
[MAPC LST (FUNCTION (LAMBDA (X)
(SETSYNTAX X (QUOTE BREAK)
RDTBL])
(0 (* clear out lst)
[MAPC LST (FUNCTION (LAMBDA (X)
(SETSYNTAX X (QUOTE OTHER)
RDTBL])
(1 (* add chars)
[MAPC LST (FUNCTION (LAMBDA (X)
(SETSYNTAX X (QUOTE BREAK)
RDTBL])
NIL])
(SETREADTABLE
[LAMBDA (RDTBL FLG)
(DECLARE (GLOBALVARS \SYSREADTABLE)) (* rrb
"22-JUL-83 14:54")
(COND
[FLG (PROG1 \SYSREADTABLE (SETQ \SYSREADTABLE (\GTREADTABLE RDTBL]
(T (PROG1 \PRIMREADTABLE (SETQ \PRIMREADTABLE (\GTREADTABLE RDTBL))
(* #CURRENTRDTBL# is
set so that an eof on
the linebuffer not
under another
read-function will fill
the buffer
appropriately)
(SETTOPVAL (QUOTE #CURRENTRDTBL#)
\PRIMREADTABLE])
(SETSEPR
[LAMBDA (LST FLG RDTBL) (* rmk:
" 8-JUN-80 07:16")
(* This one also needs
to be cleaned up)
(COND
[(EQ LST T)
[MAPC (GETSYNTAX (QUOTE SEPR)
RDTBL)
(FUNCTION (LAMBDA (X)
(SETSYNTAX X (QUOTE OTHER)
RDTBL]
(MAPC (GETSYNTAX (QUOTE SEPR)
(COND
((EQ RDTBL T)
(QUOTE ORIG))
(T T)))
(FUNCTION (LAMBDA (X)
(SETSYNTAX X (QUOTE SEPR)
RDTBL]
(T (SELECTQ FLG
(NIL (* reset)
[MAPC (GETSYNTAX (QUOTE SEPR)
RDTBL)
(FUNCTION (LAMBDA (X)
(SETSYNTAX X (QUOTE OTHER)
RDTBL]
[MAPC LST (FUNCTION (LAMBDA (X)
(SETSYNTAX X (QUOTE SEPR)
RDTBL])
(0 (* clear out lst)
[MAPC LST (FUNCTION (LAMBDA (X)
(SETSYNTAX X (QUOTE OTHER)
RDTBL])
(1 (* add chars)
[MAPC LST (FUNCTION (LAMBDA (X)
(SETSYNTAX X (QUOTE SEPR)
RDTBL])
NIL])
(\GETREADSYNTAX
[LAMBDA (C TBL) (* bvm:
"11-Mar-86 12:56")
(LET ((B (\SYNCODE (fetch READSA of TBL)
C))
E)(* This will turn into a SELECTQ that keys off syntax code numbers and
produces class tokens. The default clause at the end: if it's not a
built-in class, must be a macro)
(* Sample code: (SELECTQ B (0 (QUOTE OTHER))
(140Q (QUOTE SEPRCHAR)) (160Q (QUOTE BREAKCHAR))
(161Q (QUOTE STRINGDELIM)) (162Q (QUOTE LEFTPAREN))
(163Q (QUOTE RIGHTPAREN)) (164Q (QUOTE LEFTBRACKET))
(165Q (QUOTE RIGHTBRACKET)) (106Q (QUOTE ESCAPE))
(107Q (QUOTE MULTIPLE-ESCAPE)) (105Q (QUOTE PACKAGEDELIM)) <default>))
(\COMPUTED.FORM (BQUOTE (SELECTQ B
(\,@ [for PAIR in READCLASSTOKENS
collect (LIST (EVAL (CADR PAIR))
(KWOTE (CAR PAIR])
(LIST (fetch MACROTYPE of (SETQ E (\GETREADMACRODEF C TBL)))
(fetch (CONTEXTS KEY) of (fetch MACROCONTEXT of B))
(fetch (WAKEUPS KEY) of (fetch WAKEUP of B))
(fetch (ESCAPES KEY) of (fetch ESCAPE of B))
(fetch MACROFN of E])
(\GTREADTABLE
[LAMBDA (X FLG) (* rmk:
" 1-FEB-80 13:27")
(SELECTQ X
(NIL \PRIMREADTABLE)
(T \SYSREADTABLE)
(\GTREADTABLE1 X FLG])
(\GTREADTABLE1
[LAMBDA (X FLG) (* lmm
" 6-MAY-80 20:36")
(COND
((type? READTABLEP X)
X)
((AND (EQ X (QUOTE ORIG))
FLG)
\ORIGREADTABLE)
(T (LISPERROR "ILLEGAL READTABLE" X])
(\ORIGREADTABLE
[LAMBDA NIL (* bvm:
"12-Mar-86 13:03")
(* Creates a copy of the
"original" read-table.)
(PROG [(TBL (create READTABLEP
READMACROFLG ← T
ESCAPEFLG ← T
NUMBERBASE ← 12Q
ESCAPECHAR ←(CHARCODE %%)
HASHMACROCHAR ←(CHARCODE "|"]
(* Actually, "|" is not defined in ORIG table, but rather later.
But the radix printer and others want it, and this is better than nothing)
(SETSEPR (CHARCODE (SPACE TENEXEOL CR ↑L LF TAB))
1 TBL)
(\SETREADSYNTAX (CHARCODE %])
(QUOTE RIGHTBRACKET)
TBL)
(\SETREADSYNTAX (CHARCODE %[)
(QUOTE LEFTBRACKET)
TBL)
(\SETREADSYNTAX (CHARCODE %))
(QUOTE RIGHTPAREN)
TBL)
(\SETREADSYNTAX (CHARCODE %()
(QUOTE LEFTPAREN)
TBL)
(\SETREADSYNTAX (CHARCODE %%)
(QUOTE ESCAPE)
TBL)
(\SETREADSYNTAX (CHARCODE %")
(QUOTE STRINGDELIM)
TBL)
(RETURN TBL])
(\READCLASSTOCODE
[LAMBDA (CLASS) (* bvm:
" 9-Jul-85 00:43")
(* * This turns into a SELECTQ that goes from CLASS token to numeric
code)
(\COMPUTED.FORM (BQUOTE (SELECTQ CLASS
(\,@ READCLASSTOKENS)
(SEPR (* Synonym for
SEPRCHAR)
SEPRCHAR.RC)
NIL])
(\SETMACROSYNTAX
[LAMBDA (C CLASS TBL) (* rmk:
" 3-Jan-84 13:20")
(OR (AND (FMEMB (CAR CLASS)
(QUOTE (MACRO SPLICE INFIX)))
(CDR CLASS))
(\ILLEGAL.ARG CLASS))
(PROG (CONTEXT WAKEUP ESCAPE (LST CLASS)
(A (fetch READMACRODEFS of TBL)))
LP (COND
([CDR (SETQ LST (LISTP (CDR LST]
(OR [AND (NULL CONTEXT)
(SETQ CONTEXT (fetch (CONTEXTS VAL) of (CAR LST]
[AND (NULL WAKEUP)
(SETQ WAKEUP (fetch (WAKEUPS VAL) of (CAR LST]
[AND (NULL ESCAPE)
(SETQ ESCAPE (fetch (ESCAPES VAL) of (CAR LST]
(\ILLEGAL.ARG CLASS))
(GO LP)))
(OR (LISTP LST)
(\ILLEGAL.ARG CLASS))
[COND
(A
(* This hack guarantees that the hasharray will not overflow and cause
an error in the uninterruptable PUTHASH below.
If it didn't already have a value for C, then the macro bits are not set
in C's syntax code, so the T value is harmless.)
(OR (GETHASH C A)
(PUTHASH C T A)))
(T (replace READMACRODEFS of TBL with (SETQ A (HASHARRAY 7 7]
(UNINTERRUPTABLY
(PUTHASH C (create READMACRODEF
MACROTYPE ←(CAR CLASS)
MACROFN ←(CAR LST))
A)
(\SETSYNCODE (fetch READSA of TBL)
C
(LOGOR (OR CONTEXT ALWAYS.RMC)
(OR ESCAPE ESC.RME)
(OR WAKEUP NONIMMEDIATE.RMW))))])
(\SETREADSYNTAX
[LAMBDA (C CLASS TBL) (* bvm:
" 8-Mar-86 16:37")
(PROG ((OLDSYNTAX (\SYNCODE (fetch (READTABLEP READSA) of TBL)
C))
TEM)
[COND
((EQ CLASS (QUOTE BREAK))
(COND
((fetch BREAK of OLDSYNTAX)
(RETURN))
(T (SETQ CLASS (QUOTE BREAKCHAR] (* If already a BREAK
character but also
something else, like
LPAR, leave it alone)
(COND
((LISTP CLASS)
(\SETMACROSYNTAX C CLASS TBL))
((SETQ TEM (\READCLASSTOCODE CLASS))
(UNINTERRUPTABLY
[COND
((fetch MACROP of OLDSYNTAX) (* No longer a macro)
(REMHASH C (fetch READMACRODEFS of TBL]
(\SETSYNCODE (fetch READSA of TBL)
C TEM)))
(T (\ILLEGAL.ARG CLASS])
)
(PUTPROPS READTABLEPROP ARGNAMES (RDTBL PROP NEWVALUE))
(DECLARE: EVAL@COMPILE DONTCOPY
(RPAQQ READCLASSTOKENS ((OTHER 0)
(SEPRCHAR (LOGOR ESCAPEBIT STOPATOMBIT 0))
(BREAKCHAR (LOGOR ESCAPEBIT STOPATOMBIT BREAKBIT 0))
(STRINGDELIM (LOGOR ESCAPEBIT STOPATOMBIT BREAKBIT 1))
(LEFTPAREN (LOGOR ESCAPEBIT STOPATOMBIT BREAKBIT 2))
(RIGHTPAREN (LOGOR ESCAPEBIT STOPATOMBIT BREAKBIT 3))
(LEFTBRACKET (LOGOR ESCAPEBIT STOPATOMBIT BREAKBIT 4))
(RIGHTBRACKET (LOGOR ESCAPEBIT STOPATOMBIT BREAKBIT 5))
(ESCAPE (LOGOR ESCAPEBIT INNERESCAPEBIT 6))
(MULTIPLE-ESCAPE (LOGOR ESCAPEBIT INNERESCAPEBIT 7))
(PACKAGEDELIM (LOGOR ESCAPEBIT INNERESCAPEBIT 1))))
(RPAQ READCLASSES [MAPCAR READCLASSTOKENS (FUNCTION (LAMBDA (PAIR)
(LIST (PACK* (CAR PAIR)
".RC")
(CADR PAIR])
(DECLARE: EVAL@COMPILE
[PUTPROPS \COMPUTED.FORM MACRO (X (CONS (QUOTE PROGN)
(MAPCAR X (FUNCTION EVAL]
)
[DECLARE: EVAL@COMPILE
(ACCESSFNS CONTEXTS ((KEY (SELECTC DATUM
(ALWAYS.RMC (QUOTE ALWAYS))
(FIRST.RMC (QUOTE FIRST))
(ALONE.RMC (QUOTE ALONE))
NIL))
(VAL (SELECTQ DATUM
(ALWAYS ALWAYS.RMC)
(FIRST FIRST.RMC)
(ALONE ALONE.RMC)
NIL))))
(ACCESSFNS ESCAPES ((KEY (SELECTC DATUM
(ESC.RME (QUOTE ESCQUOTE))
(NOESC.RME (QUOTE NOESCQUOTE))
NIL))
(VAL (SELECTQ DATUM
((ESCQUOTE ESC)
ESC.RME)
((NOESCQUOTE NOESC)
NOESC.RME)
NIL))))
(ACCESSFNS WAKEUPS ((KEY (SELECTC DATUM
(IMMEDIATE.RMW
(QUOTE IMMEDIATE))
(NONIMMEDIATE.RMW
(QUOTE NONIMMEDIATE))
NIL))
(VAL (SELECTQ DATUM
((IMMEDIATE IMMED WAKEUP)
IMMEDIATE.RMW)
((NONIMMEDIATE NONIMMED NOWAKEUP)
NONIMMEDIATE.RMW)
NIL))))
]
(* FOLLOWING DEFINITIONS EXPORTED)
(DECLARE: EVAL@COMPILE
[PUTPROPS \GETREADMACRODEF MACRO ((C TBL)
(GETHASH C (fetch READMACRODEFS of TBL]
[PUTPROPS \GTREADTABLE MACRO (ARGS (COND [(LITATOM (CAR ARGS))
(LIST (QUOTE PROGN)
(QUOTE (DECLARE (GLOBALVARS \SYSREADTABLE)))
(SUBPAIR (QUOTE (X . FLG))
ARGS
(QUOTE (SELECTQ X (NIL \PRIMREADTABLE)
(T \SYSREADTABLE)
(\GTREADTABLE1 X . FLG]
(T (QUOTE IGNOREMACRO]
[PUTPROPS \GTREADTABLE1 DMACRO (ARGS (COND [(NULL (CDR ARGS))
(LIST (QUOTE \DTEST)
(CAR ARGS)
(QUOTE (QUOTE READTABLEP]
(T (QUOTE IGNOREMACRO]
)
(DECLARE: EVAL@COMPILE
(RPAQQ MACROBIT 10Q)
(RPAQQ BREAKBIT 20Q)
(RPAQQ STOPATOMBIT 40Q)
(RPAQQ ESCAPEBIT 100Q)
(RPAQQ INNERESCAPEBIT 4)
(CONSTANTS MACROBIT BREAKBIT STOPATOMBIT ESCAPEBIT INNERESCAPEBIT)
)
(RPAQQ READCODEMASKS ((CONTEXTMASK (LOGOR MACROBIT STOPATOMBIT BREAKBIT 1))
(WAKEUPMASK (LOGOR MACROBIT 2))))
(DECLARE: EVAL@COMPILE
(RPAQ CONTEXTMASK (LOGOR MACROBIT STOPATOMBIT BREAKBIT 1))
(RPAQ WAKEUPMASK (LOGOR MACROBIT 2))
(CONSTANTS (CONTEXTMASK (LOGOR MACROBIT STOPATOMBIT BREAKBIT 1))
(WAKEUPMASK (LOGOR MACROBIT 2)))
)
(RPAQQ READMACROCONTEXTS ((ALWAYS.RMC (LOGOR MACROBIT STOPATOMBIT BREAKBIT 0))
(FIRST.RMC (LOGOR MACROBIT 0))
(ALONE.RMC (LOGOR MACROBIT 1))))
(DECLARE: EVAL@COMPILE
(RPAQ ALWAYS.RMC (LOGOR MACROBIT STOPATOMBIT BREAKBIT 0))
(RPAQ FIRST.RMC (LOGOR MACROBIT 0))
(RPAQ ALONE.RMC (LOGOR MACROBIT 1))
(CONSTANTS (ALWAYS.RMC (LOGOR MACROBIT STOPATOMBIT BREAKBIT 0))
(FIRST.RMC (LOGOR MACROBIT 0))
(ALONE.RMC (LOGOR MACROBIT 1)))
)
(RPAQQ READCLASSES ((OTHER.RC 0)
(SEPRCHAR.RC (LOGOR ESCAPEBIT STOPATOMBIT 0))
(BREAKCHAR.RC (LOGOR ESCAPEBIT STOPATOMBIT BREAKBIT 0))
(STRINGDELIM.RC (LOGOR ESCAPEBIT STOPATOMBIT BREAKBIT 1))
(LEFTPAREN.RC (LOGOR ESCAPEBIT STOPATOMBIT BREAKBIT 2))
(RIGHTPAREN.RC (LOGOR ESCAPEBIT STOPATOMBIT BREAKBIT 3))
(LEFTBRACKET.RC (LOGOR ESCAPEBIT STOPATOMBIT BREAKBIT 4))
(RIGHTBRACKET.RC (LOGOR ESCAPEBIT STOPATOMBIT BREAKBIT 5))
(ESCAPE.RC (LOGOR ESCAPEBIT INNERESCAPEBIT 6))
(MULTIPLE-ESCAPE.RC (LOGOR ESCAPEBIT INNERESCAPEBIT 7))
(PACKAGEDELIM.RC (LOGOR ESCAPEBIT INNERESCAPEBIT 1))))
(DECLARE: EVAL@COMPILE
(RPAQQ OTHER.RC 0)
(RPAQ SEPRCHAR.RC (LOGOR ESCAPEBIT STOPATOMBIT 0))
(RPAQ BREAKCHAR.RC (LOGOR ESCAPEBIT STOPATOMBIT BREAKBIT 0))
(RPAQ STRINGDELIM.RC (LOGOR ESCAPEBIT STOPATOMBIT BREAKBIT 1))
(RPAQ LEFTPAREN.RC (LOGOR ESCAPEBIT STOPATOMBIT BREAKBIT 2))
(RPAQ RIGHTPAREN.RC (LOGOR ESCAPEBIT STOPATOMBIT BREAKBIT 3))
(RPAQ LEFTBRACKET.RC (LOGOR ESCAPEBIT STOPATOMBIT BREAKBIT 4))
(RPAQ RIGHTBRACKET.RC (LOGOR ESCAPEBIT STOPATOMBIT BREAKBIT 5))
(RPAQ ESCAPE.RC (LOGOR ESCAPEBIT INNERESCAPEBIT 6))
(RPAQ MULTIPLE-ESCAPE.RC (LOGOR ESCAPEBIT INNERESCAPEBIT 7))
(RPAQ PACKAGEDELIM.RC (LOGOR ESCAPEBIT INNERESCAPEBIT 1))
(CONSTANTS (OTHER.RC 0)
(SEPRCHAR.RC (LOGOR ESCAPEBIT STOPATOMBIT 0))
(BREAKCHAR.RC (LOGOR ESCAPEBIT STOPATOMBIT BREAKBIT 0))
(STRINGDELIM.RC (LOGOR ESCAPEBIT STOPATOMBIT BREAKBIT 1))
(LEFTPAREN.RC (LOGOR ESCAPEBIT STOPATOMBIT BREAKBIT 2))
(RIGHTPAREN.RC (LOGOR ESCAPEBIT STOPATOMBIT BREAKBIT 3))
(LEFTBRACKET.RC (LOGOR ESCAPEBIT STOPATOMBIT BREAKBIT 4))
(RIGHTBRACKET.RC (LOGOR ESCAPEBIT STOPATOMBIT BREAKBIT 5))
(ESCAPE.RC (LOGOR ESCAPEBIT INNERESCAPEBIT 6))
(MULTIPLE-ESCAPE.RC (LOGOR ESCAPEBIT INNERESCAPEBIT 7))
(PACKAGEDELIM.RC (LOGOR ESCAPEBIT INNERESCAPEBIT 1)))
)
(RPAQQ READMACROWAKEUPS ((IMMEDIATE.RMW (LOGOR MACROBIT 2))
(NONIMMEDIATE.RMW (LOGOR MACROBIT 0))))
(DECLARE: EVAL@COMPILE
(RPAQ IMMEDIATE.RMW (LOGOR MACROBIT 2))
(RPAQ NONIMMEDIATE.RMW (LOGOR MACROBIT 0))
(CONSTANTS (IMMEDIATE.RMW (LOGOR MACROBIT 2))
(NONIMMEDIATE.RMW (LOGOR MACROBIT 0)))
)
(RPAQQ READMACROESCAPES ((ESC.RME ESCAPEBIT)
(NOESC.RME 0)))
(DECLARE: EVAL@COMPILE
(RPAQ ESC.RME ESCAPEBIT)
(RPAQQ NOESC.RME 0)
(CONSTANTS (ESC.RME ESCAPEBIT)
(NOESC.RME 0))
)
[DECLARE: EVAL@COMPILE
(ACCESSFNS READCODE ((ESCAPE (LOGAND DATUM ESCAPEBIT))
(ESCQUOTE (BITTEST DATUM ESCAPEBIT))
(STOPATOM (BITTEST DATUM STOPATOMBIT))
(INNERESCQUOTE (BITTEST DATUM (LOGOR STOPATOMBIT INNERESCAPEBIT)))
(MACROCONTEXT (LOGAND DATUM CONTEXTMASK))
(MACROP (BITTEST DATUM MACROBIT))
(WAKEUP (LOGAND DATUM WAKEUPMASK))
(BREAK (BITTEST DATUM BREAKBIT))))
(RECORD READMACRODEF (MACROTYPE . MACROFN))
(DATATYPE READTABLEP ((READSA POINTER)
(READMACRODEFS POINTER)
(READMACROFLG FLAG)
(ESCAPEFLG FLAG)
(COMMONLISP FLAG)
(NUMBERBASE BITS 5)
(CASEINSENSITIVE FLAG)
(NIL 7 FLAG)
(DISPATCHMACRODEFS POINTER)
(HASHMACROCHAR BYTE)
(ESCAPECHAR BYTE)
(MULTESCAPECHAR BYTE)
(PACKAGECHAR BYTE))
READSA ←(create CHARTABLE)
[ACCESSFNS READTABLEP ([*READ-BASE*(LET ((BASE (fetch (READTABLEP NUMBERBASE)
of DATUM)))
(DECLARE (LOCALVARS BASE))
(COND
((EQ BASE 0)
*READ-BASE*)
(T BASE]
(*PRINT-RADIX*(LET ((BASE (fetch (READTABLEP NUMBERBASE)
of DATUM)))
(DECLARE (LOCALVARS BASE))
(COND
((EQ BASE 0)
*PRINT-RADIX*)
(T BASE])
]
(/DECLAREDATATYPE (QUOTE READTABLEP)
(QUOTE (POINTER POINTER FLAG FLAG FLAG (BITS 5)
FLAG FLAG FLAG FLAG FLAG FLAG FLAG FLAG POINTER BYTE BYTE BYTE BYTE))
[QUOTE ((READTABLEP 0 POINTER)
(READTABLEP 2 POINTER)
(READTABLEP 2 (FLAGBITS . 0))
(READTABLEP 2 (FLAGBITS . 20Q))
(READTABLEP 2 (FLAGBITS . 40Q))
(READTABLEP 2 (BITS . 64Q))
(READTABLEP 0 (FLAGBITS . 0))
(READTABLEP 0 (FLAGBITS . 20Q))
(READTABLEP 0 (FLAGBITS . 40Q))
(READTABLEP 0 (FLAGBITS . 60Q))
(READTABLEP 0 (FLAGBITS . 100Q))
(READTABLEP 0 (FLAGBITS . 120Q))
(READTABLEP 0 (FLAGBITS . 140Q))
(READTABLEP 0 (FLAGBITS . 160Q))
(READTABLEP 4 POINTER)
(READTABLEP 4 (BITS . 7))
(READTABLEP 6 (BITS . 7))
(READTABLEP 6 (BITS . 207Q))
(READTABLEP 7 (BITS . 7]
(QUOTE 10Q))
(* END EXPORTED DEFINITIONS)
(DECLARE: DOEVAL@COMPILE DONTCOPY
(GLOBALVARS \ORIGREADTABLE \ORIGTERMTABLE)
)
)
(/DECLAREDATATYPE (QUOTE READTABLEP)
(QUOTE (POINTER POINTER FLAG FLAG FLAG (BITS 5)
FLAG FLAG FLAG FLAG FLAG FLAG FLAG FLAG POINTER BYTE BYTE BYTE BYTE))
[QUOTE ((READTABLEP 0 POINTER)
(READTABLEP 2 POINTER)
(READTABLEP 2 (FLAGBITS . 0))
(READTABLEP 2 (FLAGBITS . 20Q))
(READTABLEP 2 (FLAGBITS . 40Q))
(READTABLEP 2 (BITS . 64Q))
(READTABLEP 0 (FLAGBITS . 0))
(READTABLEP 0 (FLAGBITS . 20Q))
(READTABLEP 0 (FLAGBITS . 40Q))
(READTABLEP 0 (FLAGBITS . 60Q))
(READTABLEP 0 (FLAGBITS . 100Q))
(READTABLEP 0 (FLAGBITS . 120Q))
(READTABLEP 0 (FLAGBITS . 140Q))
(READTABLEP 0 (FLAGBITS . 160Q))
(READTABLEP 4 POINTER)
(READTABLEP 4 (BITS . 7))
(READTABLEP 6 (BITS . 7))
(READTABLEP 6 (BITS . 207Q))
(READTABLEP 7 (BITS . 7]
(QUOTE 10Q))
(DEFINEQ
(\ATBLSET
[LAMBDA NIL (* rrb
"22-JUL-83 14:40")
(DECLARE (GLOBALVARS \ORIGREADTABLE \SYSREADTABLE \ORIGTERMTABLE))
(COND
((NULL (BOUNDP (QUOTE \PRIMREADTABLE)))
(initrecord CHARTABLE)
(* * Read tables)
(SETQ \ORIGREADTABLE (\ORIGREADTABLE))
(SETQ \PRIMREADTABLE (COPYREADTABLE \ORIGREADTABLE))
(SETTOPVAL (QUOTE #CURRENTRDTBL#)
\PRIMREADTABLE)
(SETQ \SYSREADTABLE (COPYREADTABLE \ORIGREADTABLE))
(* * Terminal tables)
(SETQ \ORIGTERMTABLE (\ORIGTERMTABLE))
(SETQ \PRIMTERMTABLE (COPYTERMTABLE \ORIGTERMTABLE))
(SETQ \PRIMTERMSA (fetch TERMSA of \PRIMTERMTABLE))
(PUTD (QUOTE \ATBLSET))
(PUTD (QUOTE \ORIGREADTABLE))
(PUTD (QUOTE \ORIGTERMTABLE))
(SELECTQ (SYSTEMTYPE)
((JERICHO VAX)
[RPAQ FILERDTBL (OR (READTABLEP (EVALV (QUOTE FILERDTBL)))
(COPYREADTABLE (QUOTE ORIG]
(SETSYNTAX (CHARCODE ↑T)
(QUOTE SEPR)
FILERDTBL)
(SETSYNTAX (CHARCODE %|)
(QUOTE SEPR)
FILERDTBL)
(RPAQ EDITRDTBL (OR (READTABLEP (EVALV (QUOTE EDITRDTBL)))
(COPYREADTABLE T))))
NIL)
NIL])
)
(DECLARE: DONTEVAL@LOAD DOCOPY
(\ATBLSET)
)
(DECLARE: DOEVAL@COMPILE DONTCOPY
(LOCALVARS . T)
)
(DECLARE: DONTEVAL@LOAD DOEVAL@COMPILE DONTCOPY COMPILERVARS
(ADDTOVAR NLAMA )
(ADDTOVAR NLAML )
(ADDTOVAR LAMA READTABLEPROP)
)
(PUTPROPS ATBL COPYRIGHT ("Xerox Corporation" 3676Q 3677Q 3700Q 3701Q 3702Q))
(DECLARE: DONTCOPY
(FILEMAP (NIL (46063Q 75051Q (GETSYNTAX 46075Q . 57457Q) (SETSYNTAX 57461Q . 61671Q) (SYNTAXP 61673Q
. 66735Q) (\COPYSYNTAX 66737Q . 70622Q) (\GETCHARCODE 70624Q . 71413Q) (\SETFATSYNCODE 71415Q .
75047Q)) (75106Q 143673Q (CONTROL 75120Q . 75643Q) (COPYTERMTABLE 75645Q . 76554Q) (DELETECONTROL
76556Q . 103724Q) (GETDELETECONTROL 103726Q . 105762Q) (ECHOCHAR 105764Q . 113216Q) (ECHOCONTROL
113220Q . 114263Q) (ECHOMODE 114265Q . 115002Q) (GETECHOMODE 115004Q . 115402Q) (GETCONTROL 115404Q .
116004Q) (GETTERMTABLE 116006Q . 116111Q) (RAISE 116113Q . 117124Q) (GETRAISE 117126Q . 117522Q) (
RESETTERMTABLE 117524Q . 121752Q) (SETTERMTABLE 121754Q . 122551Q) (TERMTABLEP 122553Q . 123143Q) (
\GETTERMSYNTAX 123145Q . 123713Q) (\GTTERMTABLE 123715Q . 124576Q) (\ORIGTERMTABLE 124600Q . 135761Q)
(\SETTERMSYNTAX 135763Q . 140413Q) (\TERMCLASSTOCODE 140415Q . 141421Q) (\TERMCODETOCLASS 141423Q .
142517Q) (\LITCHECK 142521Q . 143671Q)) (151112Q 223566Q (COPYREADTABLE 151124Q . 151561Q) (ESCAPE
151563Q . 152307Q) (GETBRK 152311Q . 152674Q) (GETREADTABLE 152676Q . 153124Q) (GETSEPR 153126Q .
153511Q) (READMACROS 153513Q . 154251Q) (READTABLEP 154253Q . 154645Q) (READTABLEPROP 154647Q .
163572Q) (RESETREADTABLE 163574Q . 171436Q) (SETBRK 171440Q . 176027Q) (SETREADTABLE 176031Q . 200215Q
) (SETSEPR 200217Q . 204173Q) (\GETREADSYNTAX 204175Q . 207422Q) (\GTREADTABLE 207424Q . 210102Q) (
\GTREADTABLE1 210104Q . 210671Q) (\ORIGREADTABLE 210673Q . 213733Q) (\READCLASSTOCODE 213735Q .
215210Q) (\SETMACROSYNTAX 215212Q . 221022Q) (\SETREADSYNTAX 221024Q . 223564Q)) (254033Q 257175Q (
\ATBLSET 254045Q . 257173Q)))))
STOP