(FILECREATED " 5-Oct-85 10:33:31" {ERIS}<LISPCORE>SOURCES>ATBL.;11
 154052Q

      changes to:  (MACROS \CREATENSCHARHASH)
		   (FNS \ORIGTERMTABLE)

      previous date: " 3-Oct-85 17:25:09" {ERIS}<LISPCORE>SOURCES>ATBL.;10)


(* Copyright (c) 1982, 1983, 1984, 1985 by Xerox Corporation. All rights reserved.)

(PRETTYCOMPRINT ATBLCOMS)

(RPAQQ ATBLCOMS
 ((E (RESETSAVE (RADIX 8)))
	(* read and terminal tables)
	(DECLARE: DONTCOPY (EXPORT (MACROS \SYNCODE \SETSYNCODE)
				   (RECORDS CHARTABLE)))
	(FNS CONTROL COPYTERMTABLE DELETECONTROL GETDELETECONTROL ECHOCHAR ECHOCONTROL ECHOMODE 
	     GETECHOMODE GETCONTROL GETTERMTABLE RAISE GETRAISE RESETTERMTABLE SETTERMTABLE 
	     TERMTABLEP \GETTERMSYNTAX \GTTERMTABLE \ORIGTERMTABLE \SETTERMSYNTAX \TERMCLASSTOCODE 
	     \TERMCODETOCLASS)
	(DECLARE: DONTCOPY (EXPORT (CONSTANTS * CCECHOMODES)
				   (CONSTANTS * TERMCLASSES)
				   (RECORDS TERMCODE TERMTABLEP)))
	(INITRECORDS TERMTABLEP)
	(VARS (*READ-BASE* 10)
	      (*PRINT-RADIX* 10))
	(CONSTANTS \NSCHARHASHKEYS \NSCHARHASHOVERFLOW)
	(MACROS \CREATENSCHARHASH \MAPCHARTABLE)
	(FNS COPYREADTABLE ESCAPE GETBRK GETREADTABLE GETSEPR READMACROS READTABLEP RESETREADTABLE 
	     SETBRK SETREADTABLE SETSEPR \GETREADSYNTAX \GTREADTABLE \GTREADTABLE1 \ORIGREADTABLE 
	     \READCLASSTOCODE \SETMACROSYNTAX \SETREADSYNTAX)
	(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)))
	(INITRECORDS READTABLEP)
	(* for both read & term tables)
	(FNS GETSYNTAX SETSYNTAX SYNTAXP)
	(* utilities)
	(FNS \ATBLSET \COPYSYNTAX \GETCHARCODE \LITCHECK)
	(GLOBALVARS \ORIGREADTABLE \SYSREADTABLE \ORIGTERMTABLE)
	(DECLARE: DONTEVAL@LOAD DOCOPY (P (\ATBLSET)))
	(LOCALVARS . T)))



(* 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 (IF (FETCH (CHARTABLE NSCHARHASH)
							    OF TABLE)
						     THEN
						     (OR (GETHASH CHAR (FETCH (CHARTABLE NSCHARHASH)
									      OF TABLE))
							 0))
						 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))
					   ((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]
)
[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)

)
(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")

    (if
 (
LISTP
 CHARCODE)
	then
 (for
 X in
 CHARCODE do
 (ECHOCHAR
 X MODE TTBL))
      else
 (
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])
)
(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))

(RPAQQ *READ-BASE*
 12Q)

(RPAQQ *PRINT-RADIX*
 12Q)
(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

(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])

(RESETREADTABLE

  [LAMBDA (RDTBL FROM)                                       (* rmk: " 3-Jan-84 13:20")

    [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))
    [PROG ((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: " 9-Jul-85 00:37")

    (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)) <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                                               (* rmk: "28-SEP-81 23:32")

                                                            (* Creates a copy of the "original" read-table.)

    (PROG ((TBL (create
 READTABLEP
			READMACROFLG ← T
			ESCAPEFLG ← T)))
          (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)                                      (* gbn "15-Sep-85 20:30")

    (
PROG
 (TEM (B (\SYNCODE (fetch
 (READTABLEP
 READSA) of
 TBL)
			    C)))
          [
COND

	    ((
EQ
 CLASS (
QUOTE
 BREAK))
	      (
COND

		((fetch
 BREAK of
 B)
		  (
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
 B)                     (* No longer a macro)

		      (
PUTHASH
 C NIL (fetch
 READMACRODEFS of
 TBL]
		  (\SETSYNCODE (fetch
 READSA of
 TBL)
			       C TEM)))
	    (T (
\ILLEGAL.ARG
 CLASS])
)
(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))))

(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))))
(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))

(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)))
)

(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 READMACRODEFS (READMACROFLG FLAG)
			       (ESCAPEFLG FLAG)
			       (COMMONLISP FLAG)
			       (NUMBERBASE BITS 5))
		       READSA ←(create
 CHARTABLE)
		       [
ACCESSFNS
 READTABLEP ((*READ-BASE*(LET ((BASE (FETCH
 (
READTABLEP
 
										       NUMBERBASE)
									   OF
 DATUM)))
							         (IF
 (
EQ
 BASE 0)
								     THEN
 *READ-BASE*
								   ELSE
 BASE)))
				     (*PRINT-RADIX*(LET ((BASE (FETCH
 (
READTABLEP
 NUMBERBASE)
								  OF
 DATUM)))
						        (IF
 (
EQ
 BASE 0)
							    THEN
 *PRINT-RADIX*
							  ELSE
 BASE])
]
(/DECLAREDATATYPE (QUOTE READTABLEP)
		  (QUOTE (POINTER POINTER FLAG FLAG FLAG (BITS 5)))
		  [QUOTE ((READTABLEP 0 POINTER)
			  (READTABLEP 2 POINTER)
			  (READTABLEP 2 (FLAGBITS . 0))
			  (READTABLEP 2 (FLAGBITS . 20Q))
			  (READTABLEP 2 (FLAGBITS . 40Q))
			  (READTABLEP 2 (BITS . 64Q]
		  (QUOTE 4))


(* END EXPORTED DEFINITIONS)

)
(/DECLAREDATATYPE (QUOTE READTABLEP)
		  (QUOTE (POINTER POINTER FLAG FLAG FLAG (BITS 5)))
		  [QUOTE ((READTABLEP 0 POINTER)
			  (READTABLEP 2 POINTER)
			  (READTABLEP 2 (FLAGBITS . 0))
			  (READTABLEP 2 (FLAGBITS . 20Q))
			  (READTABLEP 2 (FLAGBITS . 40Q))
			  (READTABLEP 2 (BITS . 64Q]
		  (QUOTE 4))



(* for both read & term tables)


(DEFINEQ

(GETSYNTAX

  [LAMBDA (CH TABLE)                                         (* gbn "18-Sep-85 22:31")

    (
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)
				      (if
 (
EQ
 TEM VAL)
					  then
 (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)
				      (if
 (fetch
 BREAK of
 VAL)
					  then
 (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)
				      (if
 (
EQ
 TEM (fetch
 TERMCLASS of
 VAL))
					  then
 (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)
				      (IF
 (
EQ
 TEM (fetch
 MACROCONTEXT of
 VAL))
					  THEN
 (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)
				      (IF
 (
EQ
 TEM (fetch
 WAKEUP of
 VAL))
					  THEN
 (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)
				      (IF
 (
EQ
 TEM (fetch
 ESCAPE of
 VAL))
					  THEN
 (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])
)



(* utilities)


(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])

(\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))
    (if
 (fetch
 (CHARTABLE NSCHARHASH) of
 A)
	then
 (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])

(\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: DOEVAL@COMPILE DONTCOPY

(GLOBALVARS \ORIGREADTABLE \SYSREADTABLE \ORIGTERMTABLE)
)
(DECLARE: DONTEVAL@LOAD DOCOPY 
(\ATBLSET)
)
(DECLARE: DOEVAL@COMPILE DONTCOPY

(LOCALVARS . T)
)
(PUTPROPS ATBL COPYRIGHT ("Xerox Corporation" 3676Q 3677Q 3700Q 3701Q))
(DECLARE: DONTCOPY
  (FILEMAP (NIL (33604Q 62771Q (CONTROL 33616Q . 34201Q) (COPYTERMTABLE 34203Q . 34624Q) (DELETECONTROL 
34626Q . 40102Q) (GETDELETECONTROL 40104Q . 41526Q) (ECHOCHAR 41530Q . 43326Q) (ECHOCONTROL 43330Q . 
44216Q) (ECHOMODE 44220Q . 44575Q) (GETECHOMODE 44577Q . 45043Q) (GETCONTROL 45045Q . 45313Q) (
GETTERMTABLE 45315Q . 45420Q) (RAISE 45422Q . 46075Q) (GETRAISE 46077Q . 46341Q) (RESETTERMTABLE 
46343Q . 50417Q) (SETTERMTABLE 50421Q . 50770Q) (TERMTABLEP 50772Q . 51222Q) (\GETTERMSYNTAX 51224Q . 
51557Q) (\GTTERMTABLE 51561Q . 52246Q) (\ORIGTERMTABLE 52250Q . 60157Q) (\SETTERMSYNTAX 60161Q . 
61277Q) (\TERMCLASSTOCODE 61301Q . 62116Q) (\TERMCODETOCLASS 62120Q . 62767Q)) (70633Q 115273Q (
COPYREADTABLE 70645Q . 71144Q) (ESCAPE 71146Q . 71532Q) (GETBRK 71534Q . 71763Q) (GETREADTABLE 71765Q
 . 72174Q) (GETSEPR 72176Q . 72425Q) (READMACROS 72427Q . 73025Q) (READTABLEP 73027Q . 73261Q) (
RESETREADTABLE 73263Q . 74757Q) (SETBRK 74761Q . 77353Q) (SETREADTABLE 77355Q . 100463Q) (SETSEPR 
100465Q . 102721Q) (\GETREADSYNTAX 102723Q . 105250Q) (\GTREADTABLE 105252Q . 105571Q) (\GTREADTABLE1 
105573Q . 106174Q) (\ORIGREADTABLE 106176Q . 107743Q) (\READCLASSTOCODE 107745Q . 110546Q) (
\SETMACROSYNTAX 110550Q . 113441Q) (\SETREADSYNTAX 113443Q . 115271Q)) (134323Q 146546Q (GETSYNTAX 
134335Q . 142161Q) (SETSYNTAX 142163Q . 144057Q) (SYNTAXP 144061Q . 146544Q)) (146575Q 153414Q (
\ATBLSET 146607Q . 151115Q) (\COPYSYNTAX 151117Q . 152175Q) (\GETCHARCODE 152177Q . 152645Q) (
\LITCHECK 152647Q . 153412Q)))))
STOP