(FILECREATED " 3-Jan-84 13:36:51" {PHYLUM}<LISPCORE>SOURCES>ATBL.;12 112205Q

      changes to:  (FNS RESETREADTABLE \SETMACROSYNTAX)

      previous date: " 2-SEP-83 11:55:02" {PHYLUM}<LISPCORE>SOURCES>ATBL.;10)


(* Copyright (c) 1982, 1983, 1984 by Xerox Corporation)

(PRETTYCOMPRINT ATBLCOMS)

(RPAQQ ATBLCOMS ((E (RESETSAVE (RADIX 8)))
	(* read and terminal tables)
	(DECLARE: DONTCOPY (EXPORT (MACROS \SYNCODE \SETSYNCODE)
				   (RECORDS CHARTABLE)))
	(FNS CONTROL COPYTERMTABLE DELETECONTROL ECHOCHAR ECHOCONTROL ECHOMODE GETCONTROL 
	     GETTERMTABLE RAISE RESETTERMTABLE SETTERMTABLE TERMTABLEP \GETTERMSYNTAX \GTTERMTABLE 
	     \ORIGTERMTABLE \SETTERMSYNTAX \TERMCLASSTOCODE \TERMCODETOCLASS)
	(DECLARE: DONTCOPY (EXPORT (CONSTANTS * CCECHOMODES)
				   (CONSTANTS * TERMCLASSES)
				   (RECORDS TERMCODE TERMTABLEP)))
	(INITRECORDS TERMTABLEP)
	(FNS COPYREADTABLE ESCAPE GETBRK GETREADTABLE GETSEPR READMACROS READTABLEP RESETREADTABLE 
	     SETBRK SETREADTABLE SETSEPR \GETREADSYNTAX \GTREADTABLE \GTREADTABLE1 \ORIGREADTABLE 
	     \READCLASSTOCODE \SETMACROSYNTAX \SETREADSYNTAX)
	(DECLARE: DONTCOPY (RECORDS CONTEXTS ESCAPES WAKEUPS)
		  (EXPORT (MACROS \GETREADMACRODEF \GTREADTABLE \GTREADTABLE1)
			  (CONSTANTS MACROBIT BREAKBIT STOPATOMBIT ESCAPEBIT)
			  (CONSTANTS * READCODEMASKS)
			  (CONSTANTS * READMACROCONTEXTS)
			  (DECLARE: DONTCOPY (P (* OTHER.RC must be 0 cause of initialization.)))
			  (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))
				      (\GETBASEBYTE TABLE CHAR)))

(PUTPROPS \SYNCODE VAXMACRO (OPENLAMBDA (TABLE CHAR)
					(CHECK (type? CHARTABLE TABLE))
					(0GetBaseByte TABLE CHAR)))

(PUTPROPS \SETSYNCODE DMACRO ((TABLE CHAR CODE)
			      (CHECK (type? CHARTABLE TABLE))
			      (\PUTBASEBYTE TABLE CHAR CODE)))

(PUTPROPS \SETSYNCODE VAXMACRO ((TABLE CHAR CODE)
				(CHECK (type? CHARTABLE TABLE))
				(0SetBaseByte TABLE CHAR CODE)))
)
[DECLARE: EVAL@COMPILE 

(DATATYPE CHARTABLE ((TABLE 400Q BYTE)))
]
(/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)))


(* 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)                               (* rmk: "12-FEB-82 08:53")
    (PROG (VAL (TBL (\GTTERMTABLE TTBL)))
          (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])

(ECHOCHAR
  [LAMBDA (CHARCODE MODE TTBL)     (* lmm " 5-MAR-83 01:06")
    (IF (LISTP CHARCODE)
	THEN (FOR X IN CHARCODE DO (ECHOCHAR X MODE TTBL))
      ELSE (PROG ((C (LOGAND CHARCODE \CHARMASK))
		  (SA (fetch TERMSA of (\GTTERMTABLE TTBL)))
		  B)
	         (RETURN (PROG1 (SELECTC (fetch CCECHO of (SETQ B (\SYNCODE SA C)))
					 (REAL.CCE (QUOTE REAL))
					 (IGNORE.CCE (QUOTE IGNORE))
					 (SIMULATE.CCE (QUOTE SIMULATE))
					 (QUOTE INDICATE))
				(AND MODE (\SETSYNCODE SA C (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: "28-SEP-81 23:54")
    (PROG ((C (\GETCHARCODE CHAR)))
          (OR [AND (SMALLP 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])

(GETCONTROL
  [LAMBDA (TTBL)                                            (* rmk: " 8-FEB-80 11:35")
    (fetch CONTROLFLG of (\GTTERMTABLE TTBL])

(GETTERMTABLE
  [LAMBDA (TTBL)
    (\GTTERMTABLE TTBL NIL])

(RAISE
  [LAMBDA (FLG TTBL)                                        (* rmk: " 8-FEB-80 11:55")
    (PROG1 (fetch RAISEFLG of (SETQ TTBL (\GTTERMTABLE TTBL)))
	   (replace RAISEFLG of TTBL with (COND
					    ((ZEROP FLG)
					      0)
					    (FLG 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                      (* lmm " 5-MAR-83 01:07")
                                   (* Creates the original terminal table)
    (PROG ((TBL (create TERMTABLEP
			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 ↑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 \MAXCHAR do (ECHOCHAR C (QUOTE INDICATE)
						    TBL))
          (RETURN TBL])

(\SETTERMSYNTAX
  [LAMBDA (C CLASS TBL)                                     (* rmk: "11-FEB-82 22:18")
    (PROG [(D (OR (\TERMCLASSTOCODE CLASS)
		  (LISPERROR "ILLEGAL ARG" CLASS]           (* Changes the terminal syntax class for charcode C)
          (SELECTQ CLASS
		   ((NONE WORDSEPR)                         (* Don't turn off the previous one)
		     )
		   (for I IC (ST ←(fetch TERMSA of TBL)) from 0 to \MAXCHAR
		      when [EQ D (fetch TERMCLASS of (SETQ IC (\SYNCODE ST I]
		      do (\SETSYNCODE ST I (create TERMCODE using IC TERMCLASS ← NONE.TC))
			 (RETURN)))
          (\SETSYNCODE (fetch TERMSA of TBL)
		       C
		       (create TERMCODE using (\SYNCODE (fetch TERMSA of TBL)
							C)
					      TERMCLASS ← D])

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


(* END EXPORTED DEFINITIONS)

)
(/DECLAREDATATYPE (QUOTE TERMTABLEP)
		  (QUOTE (POINTER POINTER POINTER POINTER POINTER POINTER POINTER POINTER FLAG FLAG)))
(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)                                           (* rmk: "28-JUL-80 10:09")
    (PROG (E (B (\SYNCODE (fetch READSA of TBL)
			  C)))
          (RETURN (SELECTC B
			   (OTHER.RC (QUOTE OTHER))
			   (BREAKCHAR.RC (QUOTE BREAKCHAR))
			   (LEFTPAREN.RC (QUOTE LEFTPAREN))
			   (RIGHTPAREN.RC (QUOTE RIGHTPAREN))
			   (LEFTBRACKET.RC (QUOTE LEFTBRACKET))
			   (RIGHTBRACKET.RC (QUOTE RIGHTBRACKET))
			   (ESCAPE.RC (QUOTE ESCAPE))
			   (STRINGDELIM.RC (QUOTE STRINGDELIM))
			   (SEPRCHAR.RC (QUOTE SEPRCHAR))
			   (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)                                           (* rmk: " 3-JUN-80 22:43")
    (SELECTQ CLASS
	     (OTHER OTHER.RC)
	     (BREAKCHAR BREAKCHAR.RC)
	     (LEFTPAREN LEFTPAREN.RC)
	     (RIGHTPAREN RIGHTPAREN.RC)
	     (LEFTBRACKET LEFTBRACKET.RC)
	     (RIGHTBRACKET RIGHTBRACKET.RC)
	     (ESCAPE ESCAPE.RC)
	     (STRINGDELIM STRINGDELIM.RC)
	     ((SEPRCHAR SEPR)
	       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)                                     (* rmk: " 8-JUN-80 07:12")
    (PROG (TEM (B (\SYNCODE (fetch 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: DONTCOPY 
[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)

(CONSTANTS MACROBIT BREAKBIT STOPATOMBIT ESCAPEBIT)
)

(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)))
)
(DECLARE: DONTCOPY 
(* OTHER.RC must be 0 cause of initialization.)
)

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

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

(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 (NOT (ZEROP (LOGAND DATUM ESCAPEBIT]
		     [STOPATOM (NOT (ZEROP (LOGAND DATUM STOPATOMBIT]
		     (MACROCONTEXT (LOGAND DATUM CONTEXTMASK))
		     [MACROP (NOT (ZEROP (LOGAND DATUM MACROBIT]
		     (WAKEUP (LOGAND DATUM WAKEUPMASK))
		     (BREAK (NOT (ZEROP (LOGAND DATUM BREAKBIT])

(RECORD READMACRODEF (MACROTYPE . MACROFN))

(DATATYPE READTABLEP (READSA READMACRODEFS (READMACROFLG FLAG)
			     (ESCAPEFLG FLAG))
		     READSA ←(create CHARTABLE))
]
(/DECLAREDATATYPE (QUOTE READTABLEP)
		  (QUOTE (POINTER POINTER FLAG FLAG)))


(* END EXPORTED DEFINITIONS)

)
(/DECLAREDATATYPE (QUOTE READTABLEP)
		  (QUOTE (POINTER POINTER FLAG FLAG)))



(* for both read & term tables)

(DEFINEQ

(GETSYNTAX
  [LAMBDA (CH TABLE)                                        (* rmk: "11-FEB-82 22:20")
    (COND
      [(NUMBERP (SETQ CH (\GETCHARCODE CH)))
	(COND
	  ((type? TERMTABLEP TABLE)
	    (\GETTERMSYNTAX CH TABLE))
	  (T (\GETREADSYNTAX CH (\GTREADTABLE TABLE T]
      (T (PROG (TEM)
	       (RETURN (COND
			 ((SETQ TEM (\READCLASSTOCODE CH))
			   (for I (ST ←(fetch READSA of (\GTREADTABLE TABLE T))) from 0 to \MAXCHAR
			      when (EQ TEM (\SYNCODE ST I)) collect I))
			 ((EQ CH (QUOTE BREAK))
			   (for I (ST ←(fetch READSA of (\GTREADTABLE TABLE T))) from 0 to \MAXCHAR
			      when (fetch BREAK of (\SYNCODE ST I)) collect I))
			 [(SETQ TEM (\TERMCLASSTOCODE CH))
			   (for I (ST ←(fetch TERMSA of (\GTTERMTABLE TABLE T))) from 0 to \MAXCHAR
			      when (EQ TEM (fetch TERMCLASS of (\SYNCODE ST I)))
			      collect (SELECTC TEM
					       ((LIST NONE.TC WORDSEPR.TC)
                                                            (* Only these classes have multiple members)
						 I)
					       (RETURN (CONS I]
			 [(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))
			   (for I (ST ←(fetch READSA of (\GTREADTABLE TABLE T))) from 0 to \MAXCHAR
			      when (EQ TEM (fetch MACROCONTEXT of (\SYNCODE ST I))) collect I))
			 ((SETQ TEM (fetch (WAKEUPS VAL) of CH))
			   (for I (ST ←(fetch READSA of (\GTREADTABLE TABLE T))) from 0 to \MAXCHAR
			      when (EQ TEM (fetch WAKEUP of (\SYNCODE ST I))) collect I))
			 ((SETQ TEM (fetch (ESCAPES VAL) of CH))
			   (for I (ST ←(fetch READSA of (\GTREADTABLE TABLE T))) from 0 to \MAXCHAR
			      when (EQ TEM (fetch ESCAPE of (\SYNCODE ST I))) collect I))
			 (T (\ILLEGAL.ARG CH])

(SETSYNTAX
  [LAMBDA (CHAR CLASS TBL)                                  (* rmk: "24-APR-80 09:41")
    (OR (NUMBERP (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)))
      ((NUMBERP (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)                                             (* rmk: " 5-MAY-81 23:38")
                                                            (* Copies chartable A into chartable B)
    (CHECK (AND (type? CHARTABLE A)
		(type? CHARTABLE B)))
    (\MOVEBYTES A 0 B 0 (ADD1 \MAXCHAR])

(\GETCHARCODE
  [LAMBDA (C)                                               (* rmk: "28-SEP-81 23:31")
    (COND
      ((NUMBERP C)
	(LOGAND C \CHARMASK))
      ((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

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

(LOCALVARS . T)
)
(PUTPROPS ATBL COPYRIGHT ("Xerox Corporation" 3676Q 3677Q 3700Q))
(DECLARE: DONTCOPY
  (FILEMAP (NIL (10070Q 33130Q (CONTROL 10102Q . 10465Q) (COPYTERMTABLE 10467Q . 11076Q) (DELETECONTROL 
11100Q . 14203Q) (ECHOCHAR 14205Q . 15677Q) (ECHOCONTROL 15701Q . 16466Q) (ECHOMODE 16470Q . 17045Q) (
GETCONTROL 17047Q . 17313Q) (GETTERMTABLE 17315Q . 17420Q) (RAISE 17422Q . 20055Q) (RESETTERMTABLE 
20057Q . 22133Q) (SETTERMTABLE 22135Q . 22504Q) (TERMTABLEP 22506Q . 22736Q) (\GETTERMSYNTAX 22740Q . 
23272Q) (\GTTERMTABLE 23274Q . 23761Q) (\ORIGTERMTABLE 23763Q . 27745Q) (\SETTERMSYNTAX 27747Q . 
31436Q) (\TERMCLASSTOCODE 31440Q . 32255Q) (\TERMCODETOCLASS 32257Q . 33126Q)) (36056Q 61713Q (
COPYREADTABLE 36070Q . 36367Q) (ESCAPE 36371Q . 36755Q) (GETBRK 36757Q . 37206Q) (GETREADTABLE 37210Q
 . 37417Q) (GETSEPR 37421Q . 37650Q) (READMACROS 37652Q . 40250Q) (READTABLEP 40252Q . 40504Q) (
RESETREADTABLE 40506Q . 42202Q) (SETBRK 42204Q . 44576Q) (SETREADTABLE 44600Q . 45706Q) (SETSEPR 
45710Q . 50144Q) (\GETREADSYNTAX 50146Q . 51715Q) (\GTREADTABLE 51717Q . 52236Q) (\GTREADTABLE1 52240Q
 . 52641Q) (\ORIGREADTABLE 52643Q . 54410Q) (\READCLASSTOCODE 54412Q . 55303Q) (\SETMACROSYNTAX 55305Q
 . 60176Q) (\SETREADSYNTAX 60200Q . 61711Q)) (74565Q 105350Q (GETSYNTAX 74577Q . 101066Q) (SETSYNTAX 
101070Q . 102661Q) (SYNTAXP 102663Q . 105346Q)) (105377Q 111544Q (\ATBLSET 105411Q . 107717Q) (
\COPYSYNTAX 107721Q . 110421Q) (\GETCHARCODE 110423Q . 110775Q) (\LITCHECK 110777Q . 111542Q)))))
STOP