(FILECREATED " 6-Dec-83 23:04:56" {PHYLUM}<LISPCORE>SOURCES>MACROAUX.;6 20866  

      changes to:  (MACROS NNLITATOM CANONICAL.TIMERUNITS CARCDR.FNP)
		   (FNS CARCDR.FNP NO.SIDEEFFECTS.FNP)
		   (VARS MACROAUXCOMS)

      previous date: "10-NOV-83 20:16:11" {PHYLUM}<LISPCORE>SOURCES>MACROAUX.;5)


(* Copyright (c) 1983 by Xerox Corporation)

(PRETTYCOMPRINT MACROAUXCOMS)

(RPAQQ MACROAUXCOMS ((EXPORT (DECLARE: DONTCOPY (MACROS NNLITATOM \NULL.OR.FIXP \CHECKTYPE 
							CANONICAL.TIMERUNITS))
			     (COMS (* Macros which do, respectively, macro-expansion and evaluation 
				      of their "argument")
				   (DECLARE: DONTCOPY (FNS \MACRO...ppmacro)
					     (MACROS \MACRO.MX \MACRO.EVAL)
					     (ADDVARS (PRETTYPRINTMACROS (\MACRO.MX  . 
										 \MACRO...ppmacro)
									 (\MACRO.EVAL  . 
										 \MACRO...ppmacro)))))
			     )
		     (COMS (* functions which help macro and compiler writers.)
			   (FNS LISPFORM.SIMPLIFY NO.SIDEEFFECTS.FNP CARCDR.FNP CODE.SUBST 
				CODE.SUBPAIR)
			   (GLOBALRESOURCES \NSE.STRPTR)
			   (FNS ARGS.COMMUTABLEP ARGS.COMMUTABLEP.LIST VAR.NOT.USED \VARNOTUSED 
				\VARNOTUSED.LIST EVALUABLE.CONSTANTP EVALUABLE.CONSTANT.FIXP)
			   (MACROS EVALUABLE.CONSTANT.FIXP CARCDR.FNP)
			   (FNS \DECL.COMNT.PROCESS)
			   (FNS \WALKOVER.SPECIALFORMS \WALKOVER.SF.LIST \WALKOVER.FUNCTION)
			   (DECLARE: DONTCOPY (CONSTANTS \QUOTIFYING.NLS \WALKABLE.SPECIALFORMS)
				     (MACROS \WALKABLE.SPECIALFORMP))
			   (ADDVARS (CONSTANTFOLDFNS IMIN IMAX IABS LOGOR LOGXOR LOGAND))
			   (UGLYVARS NO.SIDEEFFECTS.HARRAY)
			   (PROP GLOBALVAR NO.SIDEEFFECTS.HARRAY)
			   (GLOBALVARS CLISPARRAY CONSTANTFOLDFNS))))
(* FOLLOWING DEFINITIONS EXPORTED)


(DECLARE: DONTCOPY 
(DECLARE: EVAL@COMPILE 

(PUTPROPS NNLITATOM MACRO (OPENLAMBDA (X)
  (AND X (LITATOM X))))

(PUTPROPS \NULL.OR.FIXP MACRO (OPENLAMBDA (X)
  (OR (NULL X)
      (FIXP X))))

(PUTPROPS \CHECKTYPE MACRO (X
  (PROG ((VAR (CAR X))
	 (PRED (CADR X)))
        (if (AND (LISTP PRED)
		 (MEMB (CAR PRED)
		       (QUOTE (QUOTE FUNCTION))))
	    then (SETQ PRED (LIST (CADR PRED)
				  VAR)))
        (RETURN (SUBPAIR (QUOTE (MSG VAR PRED))
			 (LIST (CONCAT "
 is not a suitable value for the variable:  " VAR)
			       VAR PRED)
			 (QUOTE (until PRED do (SETQ VAR (ERROR VAR MSG)))))))))

(PUTPROPS CANONICAL.TIMERUNITS MACRO (OPENLAMBDA (X)
                                                             (* Checks for common abbreviations before calling 
							     \CanonicalizeTimerUnits)
  (SELECTQ X
	   ((TICKS MILLISECONDS SECONDS)                     (* These are the canonical forms)
	     X)
	   ((NIL MS MILLISECS)
	     (QUOTE MILLISECONDS))
	   ((TICS)
	     (QUOTE TICKS))
	   ((SECS)
	     (QUOTE SECONDS))
	   (\CanonicalizeTimerUnits X))))
)
)



(* Macros which do, respectively, macro-expansion and evaluation of their "argument")

(DECLARE: DONTCOPY 
(DEFINEQ

(\MACRO...ppmacro
  (LAMBDA (L)                                                (* JonL "19-NOV-82 21:46")
    (PROG ((POS (POSITION))
	   (LNL (LINELENGTH)))
          (printout NIL (QUOTE %()
		    .FONT CLISPFONT (CAR L)
		    .FONT SYSTEMFONT (PROGN (if (NOT (FITP (CADR L)
							   LNL))
						then (TAB (IPLUS POS 1)))
					    (QUOTE % ))
		    .PPFTL
		    (CDR L)
		    (QUOTE %))))))
)

(DECLARE: EVAL@COMPILE 

(PUTPROPS \MACRO.MX MACRO (Z
  (PROG ((X (EXPANDMACRO (CAR Z)
			 T)))
        (COND
	  ((EQ X (CAR Z))
	    (ERROR "No macro property -- \MACRO.MX" X))
	  (T (RETURN X))))))

(PUTPROPS \MACRO.EVAL MACRO (Z
  (PROG ((X (EXPANDMACRO (CAR Z)
			 T)))
        (if (EQ X (CAR Z))
	    then (ERROR "No macro property -- \MACRO.EVAL" X)
	  else (RETURN (EVAL X))))))
)


(ADDTOVAR PRETTYPRINTMACROS (\MACRO.MX  . \MACRO...ppmacro)
			    (\MACRO.EVAL  . \MACRO...ppmacro))
)


(* END EXPORTED DEFINITIONS)




(* functions which help macro and compiler writers.)

(DEFINEQ

(LISPFORM.SIMPLIFY
  (LAMBDA (X QUIETFLG DWIMIFYFLGORLST)                       (* JonL "14-JAN-83 18:51")
                                                             (* Reduce some LISP code to its more primitive form.
							     Currently, supporst macroexpansion, dwimmification, and 
							     evaluation of compile-time constants.)
    (OR (LISTP DWIMIFYFLGORLST)
	(SETQ DWIMIFYFLGORLST (NEQ DWIMIFYFLGORLST (QUOTE DONT))))
    (PROG (Y (CLISPIFTRANFLG T))
          (DECLARE (SPECVARS CLISPIFTRANFLG))
      A   (if (AND (LISTP X)
		   (LITATOM (SETQ Y (CAR X)))
		   (SETQ Y (GETMACROPROP Y COMPILERMACROPROPS))
		   (NEQ X (SETQ X (MACROEXPANSION X Y))))
	      then                                           (* Causes form to be macroexpanded until it is no longer
							     a macro call)
		   (GO A))
          (if (SETQ Y (CONSTANTEXPRESSIONP X))
	      then (SETQ X (KWOTE (CAR Y)))
	    elseif (AND (LISTP X)
			DWIMIFYFLGORLST
			(OR (SETQ Y (GETHASH X CLISPARRAY))
			    (PROG2 (DWIMIFY X T (LISTP DWIMIFYFLGORLST))
				   (SETQ Y (GETHASH X CLISPARRAY))
                                                             (* Keep the CLISP hasharry clean)
				   (PUTHASH X NIL CLISPARRAY))))
	      then (SETQ X Y)
		   (GO A))
          (if (NOT QUIETFLG)
	      then (PRINTDEF X NIL T)
		   (TERPRI)
	    else (RETURN X)))))

(NO.SIDEEFFECTS.FNP
  (LAMBDA (X)                                                (* JonL " 6-Dec-83 22:55")
                                                             (* Fast-case-test for simple memory access fns)
    (AND (NNLITATOM X)
	 (OR (CARCDR.FNP X)
	     (AND (EQ (NTHCHARCODE X 1)
		      (CHARCODE \))
		  (EQ (NTHCHARCODE X 8)
		      (CHARCODE E))
		  (GLOBALRESOURCE (\NSE.STRPTR)
				  (EQUAL "\GETBASE" (SUBSTRING X 1 8 \NSE.STRPTR))))
	     (GETHASH X NO.SIDEEFFECTS.HARRAY)))))

(CARCDR.FNP
  (LAMBDA (X)                                                (* JonL " 6-Dec-83 22:47")
                                                             (* All versions of compiler have the CROPS property set 
							     for CAR/CDR fns)
    (\MACRO.MX (CARCDR.FNP X))))

(CODE.SUBST
  (LAMBDA (X Y FORM)                                         (* JonL "21-NOV-82 14:24")
                                                             (* Ho Hum, someday this ought to be made to work!)
    (SUBST X Y FORM)))

(CODE.SUBPAIR
  (LAMBDA (L1 L2 FORM)                                       (* JonL "21-NOV-82 14:24")
                                                             (* Ho Hum, someday this ought to be made to work!)
    (SUBPAIR L1 L2 FORM)))
)
(DECLARE: DOEVAL@COMPILE DONTCOPY 
(PUTDEF (QUOTE \NSE.STRPTR)
	(QUOTE GLOBALRESOURCES)
	(QUOTE (ALLOCSTRING 0)))
)
(DECLARE: DOEVAL@COMPILE DONTCOPY

(ADDTOVAR GLOBALVARS \NSE.STRPTR)
)

(RPAQQ \NSE.STRPTR NIL)
(DEFINEQ

(ARGS.COMMUTABLEP
  (LAMBDA (X Y)                                              (* JonL "25-FEB-83 20:53")
                                                             (* non-NIL iff the evaluation of X and Y can be done in 
							     either order without any change in effects or value.)
    (PROG (FN)
          (if (NLISTP Y)
	      then (if (NLISTP X)
		       then                                  (* If both args are atoms, then we can just punt out 
							     here with the answer.)
			    (RETURN T))                      (* Switch args so that we don't have to handle the case 
							     of Y an atom)
		   (SETQ X (PROG1 Y (SETQ Y X))))
          (if (if (LISTP X)
		  then                                       (* Fast check for quoted frobs.
							     Remember, Y can't be an atom.)
		       (MEMB (CAR X)
			     \QUOTIFYING.NLS)
		else                                         (* Cases like random, non-variable atoms)
		     (NOT (NNLITATOM X)))
	      then (RETURN T))
          (SETQ Y (LISPFORM.SIMPLIFY Y T))
          (RETURN (if (LISTP (SETQ FN (CAR Y)))
		      then (if (EQ (CAR FN)
				   (QUOTE LAMBDA))
			       then (ARGS.COMMUTABLEP.LIST Y (LISPFORM.SIMPLIFY X T)))
		    elseif (MEMB FN \QUOTIFYING.NLS)
		      then (QUOTE T)
		    elseif (EQ FN (QUOTE SETQ))
		      then (AND (\VARNOTUSED X (CADR Y))
				(ARGS.COMMUTABLEP.LIST (CDDR Y)
						       (LISPFORM.SIMPLIFY X T)))
		    elseif (\WALKABLE.SPECIALFORMP FN)
		      then (\WALKOVER.SPECIALFORMS (FUNCTION ARGS.COMMUTABLEP)
						   Y
						   (LISPFORM.SIMPLIFY X T))
		    else (AND (NO.SIDEEFFECTS.FNP FN)
			      (ARGS.COMMUTABLEP.LIST (CDR Y)
						     (LISPFORM.SIMPLIFY X T))))))))

(ARGS.COMMUTABLEP.LIST
  (LAMBDA (L Y)                                              (* JonL "21-NOV-82 15:07")
    (EVERY L (FUNCTION (LAMBDA (X)
	       (ARGS.COMMUTABLEP X Y))))))

(VAR.NOT.USED
  (LAMBDA (FORM VAR SETQONLY?)                               (* JonL "21-NOV-82 14:01")
    (PROG NIL
      A   (if (NOT (LITATOM VAR))
	      then (SETERRORN 14 VAR)
		   (SETQ VAR (ERRORX))
		   (GO A))
          (if (MEMB VAR (QUOTE (NIL T)))
	      then (SETERRORN 27 VAR)
		   (SETQ VAR (ERRORX))
		   (GO A))
          (RETURN (\VARNOTUSED FORM VAR SETQONLY?)))))

(\VARNOTUSED
  (LAMBDA (FORM VAR SETQONLY?)                               (* JonL "21-NOV-82 16:10")
                                                             (* Look for free occurances of a variable VAR which may 
							     be evaluable in FORM)
    (if (NLISTP FORM)
	then (AND (NOT SETQONLY?)
		  (NEQ VAR FORM))
      elseif (LISTP (CAR FORM))
	then (\VARNOTUSED.LIST FORM VAR SETQONLY?)
      elseif (EQ (CAR FORM)
		 (QUOTE LAMBDA))
	then                                                 (* Note that if a LAMBDA form bind a var X, then VAR 
							     can't be "used inside" the form.)
	     (OR (MEMB VAR (CADR FORM))
		 (\VARNOTUSED (CDDR FORM)
			      VAR SETQONLY?))
      elseif (MEMB (CAR FORM)
		   \QUOTIFYING.NLS)
	then T
      elseif (MEMB (CAR FORM)
		   (QUOTE (SETQ)))
	then                                                 (* Stupid Interlisp SETQ format -- You really wound't 
							     believe it!)
	     (AND (NEQ VAR (CADR FORM))
		  (\VARNOTUSED.LIST FORM VAR SETQONLY?))
      elseif (\WALKABLE.SPECIALFORMP (CAR FORM))
	then (\WALKOVER.SPECIALFORMS (FUNCTION \VARNOTUSED)
				     FORM VAR SETQONLY?)
      elseif (NO.SIDEEFFECTS.FNP (CAR FORM))
	then (\VARNOTUSED.LIST (CDR FORM)
			       VAR SETQONLY?))))

(\VARNOTUSED.LIST
  (LAMBDA (L X SETQONLY?)                                    (* JonL "21-NOV-82 15:06")
    (EVERY L (FUNCTION (LAMBDA (FORM)
	       (\VARNOTUSED FORM X SETQONLY?))))))

(EVALUABLE.CONSTANTP
  (LAMBDA (X)                                                (* JonL "26-FEB-83 13:44")
    (if (OR (NLISTP X)
	    (EQ (CAR X)
		(QUOTE QUOTE))
	    (EQ (CAR X)
		(QUOTE CONSTANT))
	    (FMEMB (CAR X)
		   CONSTANTFOLDFNS))
	then                                                 (* Unfortunately, CONSTANT has a macro property which 
							     may conflict with the action of LISPFORM.SIMPLIFY)
	     (CONSTANTEXPRESSIONP X)
      else (if (LISTP X)
	       then (SETQ X (LISPFORM.SIMPLIFY X T)))
	   (if (NLISTP X)
	       then (CONSTANTEXPRESSIONP X)
	     elseif (NNLITATOM (CAR X))
	       then (if (\WALKABLE.SPECIALFORMP (CAR X))
			then (if (\WALKOVER.SPECIALFORMS (FUNCTION EVALUABLE.CONSTANTP)
							 X)
				 then 

          (* This branch currently has a bug in it -- we'd like a version of EVAL which didn't just do an EVALV on litatoms,
	  but first check CONSTANTEXPRESSIONP on them. The problem occurs in cross-compilation.)


				      (LIST (EVAL X)))
		      elseif (AND (NOT (FMEMB (CAR X)
					      (QUOTE (CONS LIST CREATECELL \ALLOCKBLOCK ARRAY 
							   MKSTRING MKATOM ALLOCSTRING SYSTEMTYPE 
							   MACHINETYPE GETD))))
				  (NO.SIDEEFFECTS.FNP (CAR X)))
			then                                 (* If a random function without side-effects, then it is
							     constant when applied to constant args, except for 
							     consers of various kinds.)
			     (PROG ((VALS (for Z in (CDR X) collect (CAR (OR (EVALUABLE.CONSTANTP
									       Z)
									     (RETURN))))))
			           (RETURN (if VALS
					       then (LIST (APPLY (CAR X)
								 VALS))))))
	     elseif (AND (LISTP (CAR X))
			 (EQ (CAAR X)
			     (QUOTE LAMBDA)))
	       then (if (NLISTP (CADAR X))
			then                                 (* Arglist is NIL or some non-list.)
			     (EVALUABLE.CONSTANTP (CONS (QUOTE PROGN)
							(APPEND (CDR X)
								(CDDAR X))))
		      else (for Z VALS in (CDR X)
			      do                             (* Be sure that any "arguments" are all constant.
							     Then do "beta" reduction.)
				 (push VALS (KWOTE (CAR (OR (EVALUABLE.CONSTANTP Z)
							    (RETURN)))))
			      finally (RETURN (EVALUABLE.CONSTANTP (CODE.SUBPAIR (CADAR X)
										 VALS
										 (CONS (QUOTE PROGN)
										       (CDDAR X)))))))
	       ))))

(EVALUABLE.CONSTANT.FIXP
  (LAMBDA (X)                                                (* JonL "25-FEB-83 20:36")
    (FIXP (CAR (EVALUABLE.CONSTANTP X)))))
)
(DECLARE: EVAL@COMPILE 

(PUTPROPS EVALUABLE.CONSTANT.FIXP MACRO ((X)
  (FIXP (CAR (EVALUABLE.CONSTANTP X)))))

(PUTPROPS CARCDR.FNP MACRO ((X)
  (GETPROP X (QUOTE CROPS))))
)
(DEFINEQ

(\DECL.COMNT.PROCESS
  (LAMBDA (FORMS)                                            (* JonL "17-OCT-83 22:01")

          (* Returns a list whose first element is the list of all declarations preceeding significand, whose second element
	  is the list of all comments preceeding significand, and whose remaining elements are the "body" of FORMS)


    (for L DECLS COMNTS Y on FORMS while (AND (LISTP (SETQ Y (CAR L)))
					      (OR (EQ COMMENTFLG (SETQ Y (CAR Y)))
						  (EQ Y (QUOTE DECLARE))))
       do (if (EQ COMMENTFLG Y)
	      then (push COMNTS (CAR L))
	    elseif (EQ Y (QUOTE DECLARE))
	      then (push DECLS (CAR L)))
       finally (RETURN (CONS DECLS (CONS COMNTS L))))))
)
(DEFINEQ

(\WALKOVER.SPECIALFORMS
  (LAMBDA (PRED FORM REST1 REST2 REST3)                      (* JonL "29-JAN-83 21:30")
                                                             (* Loser! What I really need is a &REST argument L, and 
							     use (APPLY PRED <specific-item> L) instead of the 
							     APPLY*)
    (SELECTQ (CAR (LISTP FORM))
	     (COND (EVERY (CDR FORM)
			  (FUNCTION (LAMBDA (CLZ)
			      (OR (NLISTP CLZ)
				  (\WALKOVER.SF.LIST PRED CLZ REST1 REST2 REST3))))))
	     ((SELECTQ SELECTC)
	       (AND (APPLY* PRED (CADR FORM)
			    REST1 REST2 REST3)
		    (APPLY* PRED (CAR (LAST FORM))
			    REST1 REST2 REST3)
		    (for LL on (CDDR FORM) until (NULL (CDR LL)) do (OR (\WALKOVER.SF.LIST
									  PRED
									  (CDAR LL)
									  REST1 REST2 REST3)
									(RETURN))
		       finally (RETURN T))))
	     ((AND OR FRPTQ SETQ)
	       (\WALKOVER.SF.LIST PRED (CDR FORM)
				  REST1 REST2 REST3))
	     ((APPLY APPLY*)
	       (AND (\WALKOVER.FUNCTION PRED (CADR FORM)
					REST1 REST2 REST3)
		    (\WALKOVER.SF.LIST PRED (CDDR FORM)
				       REST1 REST2 REST3)))
	     ((MAP MAPLIST MAPC MAPCAR MAPCON MAPCONC MAPHASH EVERY SOME NOTEVERY NOTANY)
	       (AND (APPLY* PRED (CADR FORM)
			    REST1 REST2 REST3)
		    (CAR (SETQ FORM (CDDR FORM)))
		    (\WALKOVER.FUNCTION PRED (CAR FORM)
					REST1 REST2 REST3)
		    (OR (NLISTP (CDR FORM))
			(\WALKOVER.FUNCTION PRED (CADR FORM)
					    REST1 REST2 REST3))))
	     ((MAPATOMS)
	       (\WALKOVER.FUNCTION PRED (CADR FORM)
				   REST1 REST2 REST3))
	     ((PROG)                                         (* FooBar! Note that we can't currently walk over a PROG
							     -- 30 JAN 1983)
	       (AND (EVERY (CADR FORM)
			   (FUNCTION (LAMBDA (L)
			       (OR (NLISTP L)
				   (NLISTP (CDR L))
				   (APPLY* PRED (CADR L)
					   REST1 REST2 REST3)))))
		    (EVERY (CDDR FORM)
			   (FUNCTION (LAMBDA (L)
			       (OR (NLISTP L)
				   (APPLY* PRED L REST1 REST2 REST3)))))))
	     (SHOULDNT))))

(\WALKOVER.SF.LIST
  (LAMBDA (PRED L REST1 REST2 REST3)                         (* JonL "21-NOV-82 15:04")
    (EVERY L (FUNCTION (LAMBDA (X)
	       (APPLY* PRED X REST1 REST2 REST3))))))

(\WALKOVER.FUNCTION
  (LAMBDA (PRED FN REST1 REST2 REST3)                        (* JonL "21-NOV-82 15:11")
                                                             (* Analyze case where FN is being applied 
							     (e.g. as in MAPCAR))
    (if (OR (NLISTP FN)
	    (NOT (MEMB (CAR FN)
		       (QUOTE (QUOTE FUNCTION)))))
	then (AND (APPLY* PRED FN REST1 REST2 REST3)
		  (APPLY* PRED (QUOTE (\TypicalUnknownFunction))
			  REST1 REST2 REST3))
      else (APPLY* PRED (if (NLISTP (SETQ FN (CADR FN)))
			    then (LIST FN)
			  else FN)
		   REST1 REST2 REST3))))
)
(DECLARE: DONTCOPY 
(DECLARE: EVAL@COMPILE 

(RPAQQ \QUOTIFYING.NLS (QUOTE FUNCTION DECLARE CONSTANT DEFERREDCONSTANT))

(RPAQQ \WALKABLE.SPECIALFORMS (COND SELECTQ SELECTC AND OR SETQ FRPTQ APPLY APPLY* MAP MAPLIST MAPC 
				    MAPCAR MAPCON MAPCONC MAPHASH MAPATOMS EVERY SOME NOTEVERY NOTANY)
)

(CONSTANTS \QUOTIFYING.NLS \WALKABLE.SPECIALFORMS)
)

(DECLARE: EVAL@COMPILE 

(PUTPROPS \WALKABLE.SPECIALFORMP MACRO ((FORM)
  (MEMB FORM \WALKABLE.SPECIALFORMS)))
)
)

(ADDTOVAR CONSTANTFOLDFNS IMIN IMAX IABS LOGOR LOGXOR LOGAND)
(READVARS NO.SIDEEFFECTS.HARRAY)
(({H2047 258 T MACHINETYPE T VARIABLES T STRINGWIDTH T CONSCOUNT T BOXCOUNT T FETCHFIELD T DPB T LDB T
 COPY T GETDEF T NEGATE T ROT T BYTEPOSITION T DEPOSITBYTE T LOADBYTE T LOGNOT T BITCLEAR T BITSET T 
BITTEST T MASK.0'S T MASK.1'S T TYPENAMEFROMNUMBER T ARRAYBEG T COPYSTK T ARCTAN T ARCCOS T ARCSIN T 
ARCTAN2 T LOG T TAN T COS T SIN T GETTYPEDESCRIPTION T TYPENUMBERFROMNAME T NTYP T SCODEP T 
COPYDEFCOPYREADTABLE T COVERS T GETQ T NCHAR T SUBTYPES T SUPERTYPES T HARRAYSIZE T HARRAY T ELTD T 
COPYARRAY T HARRAYP T ARRAYTYP T ARRAYSIZE T \ALLOCKBLOCK T BIT T U-CASEP T L-CASE T STREQUAL T READP 
T READTABLEP T ALLOCSTRING T PEEKC T EQUALALL T ARRAY T EXPT T SQRT T IDATE T FNTH T FTIMES T FLOAT T 
FPLUS T FMINUS T LESSP T FREMAINDER T REMAINDER T ABS T IEQP T MINUS T GCD T ADD1 T SUB1 T LOGXOR T 
LOGOR T ITIMES T IPLUS T IMINUS T ILESSP T MINUSP T RSH T LSH T LRSH T EQP T IQUOTIENT T IGREATERP T 
IDIFFERENCE T ASSOC T NTH T ARGTYPE T FNTYP T SUBRP T CCODEP T VARS T EXPRP T REALSTKNTH T REALFRAMEP 
T PROG1 T BOUNDP T TYPENAME T LOWERCASE T ARG T GETATOMVAL T PAGEFAULTS T DISMISS T DATE T CLOCK T 
NCHARS T GETD T FLESSP T FMAX T IMAX T MAX T GETTOPVAL T LEQ T IMIN T NARGS T FMIN T NUMBERP T ATOM T 
NLISTP T PROG2 T MKLIST T FREEVARS T COPYALL T EQMEMB T BYTESIZE T LENGTH T COUNTDOWN T PROGN T SUBLIS
 T MKATOM T CHCON1 T MEMB T MKSTRING T EQUALN T CONCAT T PACK* T SUBSTRING T EQUAL T PROPNAMES T 
FULLNAME T INFILEP T SUBATOM T CHARACTER T STRPOS T PACKFILENAME T U-CASE T FASSOC T APPEND T EQLENGTH
 T NOT T LOGAND T ZEROP T UNION T SUBSET T GETPROPLIST T VAG T LOC T REMOVE T EQ T LLSH T LISTPUT1 T 
LISTPUT T LISTGET1 T LDIFFERENCE T LDIFF T LASTN T KWOTE T MEMBER T INTERSECTION T GETLIS T GENSYM T 
LSUBST T SUBST T FIELDLOOK T GETTEMPLATE T RECLOOK T HASDEF T COUNT T LIST T FGETD T NULL T TYPENAMEP 
T TYPESOF T RPT T FLTFMT T FIX T LINELENGTH T MINFS T LAST T FCHARACTER T SASSOC T TYPEP T 
UNPACKFILENAME T IGEQ T ILEQ T OPENP T LISTGET T GREATERP T FGREATERP T FQUOTIENT T FDIFFERENCE T 
IREMAINDER T QUOTIENT T TIMES T DIFFERENCE T PLUS T \VAG2 T NILL T NTHCHARCODE T ELT T CONS T GETHASH 
T FMEMB T GETPROP T MIN T STACKP T STRINGP T ARRAYP T LISTP T LITATOM T FLOATP T FIXP T SMALLP T GDATE
 T DATEFORMAT T FONTNAME T MAKEBITTABLE T STRPOSL T PACK T PACKC T ALPHORDER T FLAST T UNPACK T CHCON 
T TAILP T NLEFT T FLENGTH T VALUEOF T SYNTAXP T OPENR T GETSEPR T GETREADTABLE T GETSYNTAX T 
GETTERMTABLE T COPYTERMTABLE T FFETCHFIELD T EXPANDMACRO T NEQ T SUBPAIR T \GETBITS T 
COMPILEDFETCHFIELD T FRAMESCAN }))

(PUTPROPS NO.SIDEEFFECTS.HARRAY GLOBALVAR T)
(DECLARE: DOEVAL@COMPILE DONTCOPY

(ADDTOVAR GLOBALVARS CLISPARRAY CONSTANTFOLDFNS)
)
(PUTPROPS MACROAUX COPYRIGHT ("Xerox Corporation" 1983))
(DECLARE: DONTCOPY
  (FILEMAP (NIL (2947 3372 (\MACRO...ppmacro 2957 . 3370)) (3997 6743 (LISPFORM.SIMPLIFY 4007 . 5422) (
NO.SIDEEFFECTS.FNP 5424 . 5938) (CARCDR.FNP 5940 . 6239) (CODE.SUBST 6241 . 6487) (CODE.SUBPAIR 6489
 . 6741)) (6960 13677 (ARGS.COMMUTABLEP 6970 . 8825) (ARGS.COMMUTABLEP.LIST 8827 . 9020) (VAR.NOT.USED
 9022 . 9433) (\VARNOTUSED 9435 . 10791) (\VARNOTUSED.LIST 10793 . 10992) (EVALUABLE.CONSTANTP 10994
 . 13506) (EVALUABLE.CONSTANT.FIXP 13508 . 13675)) (13866 14626 (\DECL.COMNT.PROCESS 13876 . 14624)) (
14627 17523 (\WALKOVER.SPECIALFORMS 14637 . 16709) (\WALKOVER.SF.LIST 16711 . 16907) (
\WALKOVER.FUNCTION 16909 . 17521)))))
STOP