(FILECREATED "13-Aug-84 17:20:34" {ERIS}<LISPCORE>SOURCES>ATBL.;3
 114314Q

      changes to:  (FNS GETDELETECONTROL)

      previous date: "30-Jun-84 01:32:49" {ERIS}<LISPCORE>SOURCES>ATBL.;2)


(* Copyright (c) 1982, 1983, 1984 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)
	(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])

(GETDELETECONTROL

  [LAMBDA (TYPE TTBL)                                        (* lmm "13-Aug-84 17:19")

    (PROG (TBL VAL)
          (SETQ TBL (\GTTERMTABLE
 TTBL))
          (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 " 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])

(GETECHOMODE

  [LAMBDA (TTBL)                                             (* lmm "30-Jun-84 01:31")

    (fetch
 ECHOFLG of
 (SETQ TTBL (\GTTERMTABLE
 TTBL])

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

(GETRAISE

  [LAMBDA (TTBL)                                             (* lmm "30-Jun-84 01:23")

    (fetch
 RAISEFLG of
 (\GTTERMTABLE
 TTBL])

(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 (BITTEST DATUM ESCAPEBIT))
		     (STOPATOM (BITTEST DATUM STOPATOMBIT))
		     (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))
		     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 (10147Q 35306Q (CONTROL 10161Q . 10544Q) (COPYTERMTABLE 10546Q . 11155Q) (DELETECONTROL 
11157Q . 14262Q) (GETDELETECONTROL 14264Q . 15640Q) (ECHOCHAR 15642Q . 17334Q) (ECHOCONTROL 17336Q . 
20123Q) (ECHOMODE 20125Q . 20502Q) (GETECHOMODE 20504Q . 20761Q) (GETCONTROL 20763Q . 21227Q) (
GETTERMTABLE 21231Q . 21334Q) (RAISE 21336Q . 21771Q) (GETRAISE 21773Q . 22233Q) (RESETTERMTABLE 
22235Q . 24311Q) (SETTERMTABLE 24313Q . 24662Q) (TERMTABLEP 24664Q . 25114Q) (\GETTERMSYNTAX 25116Q . 
25450Q) (\GTTERMTABLE 25452Q . 26137Q) (\ORIGTERMTABLE 26141Q . 32123Q) (\SETTERMSYNTAX 32125Q . 
33614Q) (\TERMCLASSTOCODE 33616Q . 34433Q) (\TERMCODETOCLASS 34435Q . 35304Q)) (40234Q 64071Q (
COPYREADTABLE 40246Q . 40545Q) (ESCAPE 40547Q . 41133Q) (GETBRK 41135Q . 41364Q) (GETREADTABLE 41366Q
 . 41575Q) (GETSEPR 41577Q . 42026Q) (READMACROS 42030Q . 42426Q) (READTABLEP 42430Q . 42662Q) (
RESETREADTABLE 42664Q . 44360Q) (SETBRK 44362Q . 46754Q) (SETREADTABLE 46756Q . 50064Q) (SETSEPR 
50066Q . 52322Q) (\GETREADSYNTAX 52324Q . 54073Q) (\GTREADTABLE 54075Q . 54414Q) (\GTREADTABLE1 54416Q
 . 55017Q) (\ORIGREADTABLE 55021Q . 56566Q) (\READCLASSTOCODE 56570Q . 57461Q) (\SETMACROSYNTAX 57463Q
 . 62354Q) (\SETREADSYNTAX 62356Q . 64067Q)) (76674Q 107457Q (GETSYNTAX 76706Q . 103175Q) (SETSYNTAX 
103177Q . 104770Q) (SYNTAXP 104772Q . 107455Q)) (107506Q 113653Q (\ATBLSET 107520Q . 112026Q) (
\COPYSYNTAX 112030Q . 112530Q) (\GETCHARCODE 112532Q . 113104Q) (\LITCHECK 113106Q . 113651Q)))))
STOP