(FILECREATED "17-JUN-83 23:12:35" <NEWLISP>MSANALYZE.;1
 32831  

      changes to:  (VARS INITIALTEMPLATES)

      previous date: "13-DEC-82 23:46:49" <LISP>MSANALYZE.;155)


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

(PRETTYCOMPRINT MSANALYZECOMS)

(RPAQQ MSANALYZECOMS
 [(COMS (FNS VARS FREEVARS CALLS COLLECTFNDATA CALLS3)
			    (VARS MSMACROPROPS (NOPACKCALLSFLG))
			    (BLOCKS (CALLS CALLS COLLECTFNDATA CALLS3 (LOCALFREEVARS CALLSDATA)
					   (NOLINKFNS . T)
					   (GLOBALVARS INVISIBLEVARS COMPILEUSERFN NOPACKCALLSFLG 
						       LAMBDASPLST MSRECORDTRANFLG))
				    (NIL VARS FREEVARS MSVBNOTICED (LOCALVARS . T)))
			    (DECLARE: EVAL@COMPILE (FNS MSVBNOTICED)))
	[COMS (FNS ALLCALLS MSINITFNDATA MSPRGE MSPRGMACRO MSPRGCALL MSBINDVAR MSPRGRECORD MSPRGERR 
		   MSPRGTEMPLATE1 MSPRGTEMPLATE MSPRGLAMBDA MSPRGLST ADDTO NLAMBDAFNP MSPRGDWIM 
		   MSDWIMTRAN)
	      (E (MAPC MSFNDATA (FUNCTION RPLACD)))
	      (VARS MSFNDATA MSERRORFN (MSRECORDTRANFLG))
	      (ADDVARS (INVISIBLEVARS $$1 $$2 $$3 $$4 $$5 $$6 $$7 $$8 $$9 $$10 $$11 $$12 $$13 $$14 
				      $$15 $$16 $$17))
	      (DECLARE: DONTCOPY (MACROS INCLISP LTEMPLATE))
	      (BLOCKS (ALLCALLS ALLCALLS ADDTO MSBINDVAR MSDWIMTRAN MSPRGCALL MSPRGDWIM MSPRGE 
				MSPRGMACRO MSPRGERR MSPRGLAMBDA MSPRGLST MSPRGRECORD MSPRGTEMPLATE 
				MSPRGTEMPLATE1 NLAMBDAFNP (NOLINKFNS . T)
				(LOCALFREEVARS FNNAME ERRORS FNDEF INCLISP ONLYRELS PARENTCONTEXT 
					       TOPVARS PARENT EACHTIME VARS)
				(GLOBALVARS CLISPARRAY MSERRORFN MSRECORDTRANFLG MSFNDATA 
					    INVISIBLEVARS CLISPARRAY MSTEMPLATES USERTEMPLATES 
					    MSRECORDTRANFLG NLAMA NLAML DWIMFLG CLISPTRANFLG 
					    NOSPELLFLG DWIMESSGAG FILEPKGFLG)
				(NOLINKFNS . T))
		      (NIL MSINITFNDATA NLAMBDAFNP MSPRGDWIM (LOCALVARS . T)
			   (GLOBALVARS NLAMA NLAML MSFNDATA DWIMFLG NOSPELLFLG DWIMESSGAG FILEPKGFLG))
		      )
	      (P (PUTDQ? MSWORDNAME (LAMBDA (X)
					    X]
	(COMS [VARS (MSTEMPLATES (LIST (HARRAY 160)))
		    (USERTEMPLATES (LIST (HARRAY 10]
	      (FILEVARS INITIALTEMPLATES)
	      (* * INITIALTEMPLATES is not needed after loading up)
	      [P (MAPC INITIALTEMPLATES (FUNCTION (LAMBDA (X)
							  (MAPC (CDR X)
								(FUNCTION (LAMBDA
									    (Y)
									    (PUTHASH Y (CAR X)
										     MSTEMPLATES]
	      (DECLARE: EVAL@COMPILE DONTCOPY (PROP MACRO LTEMPLATE)))
	(COMS (FNS MSFINDP)
	      (BLOCKS (MSFINDP MSFINDP])
(DEFINEQ

(VARS

  [LAMBDA (FN USEDATABASE)                                  (* lmm: 29-DEC-75 23 22)

    (CDR (CALLS
 FN USEDATABASE T])

(FREEVARS

  [LAMBDA (FN USEDATABASE)                                  (* lmm: 5-DEC-75 11 8)

    (CADDR (CALLS
 FN USEDATABASE (QUOTE FREEVARS])

(CALLS

  [LAMBDA (EXPR USEDATABASE VARSFLG)                        (* rmk: " 1-AUG-79 09:55")

    (PROG (FREES FNDEF FLG)
          [COND
	    ((AND USEDATABASE (LITATOM EXPR)
		  (GETD (QUOTE UPDATEFN)))
	      (UPDATEFN EXPR NIL (QUOTE ERROR))
	      (RETURN (LIST [AND (NOT VARSFLG)
				 (GETRELATION EXPR (QUOTE (CALL NOTERROR]
			    (AND (NEQ VARSFLG (QUOTE FREEVARS))
				 (GETRELATION EXPR (QUOTE BIND)))
			    (GETRELATION EXPR (QUOTE (USE FREELY]
      GETDLP
          (SETQ FNDEF (COND
	      [(LITATOM EXPR)
		(OR (GETD (OR (GETP EXPR (QUOTE BROKEN))
			      EXPR))
		    (GETP EXPR (QUOTE EXPR))
		    (AND (NEQ EXPR (SETQ EXPR (FNCHECK EXPR NIL NIL T)))
			 (GO GETDLP]
	      (T EXPR)))
          (RETURN
	    (COND
	      ((NULL FNDEF)
		NIL)
	      ((SUBRP FNDEF)
		NIL)
	      ((CCODEP FNDEF)
		(SETQ FNDEF (CALLSCCODE FNDEF))
		[OR NOPACKCALLSFLG (for
 X on
 (CAR FNDEF) do
 (FRPLACA X (PACK* (QUOTE ;)
									      (CAR X)
									      (QUOTE ;]
		(FRPLACA (CDR FNDEF)
			 (NCONC (CADR FNDEF)
				(CAR FNDEF)))
		(SETQ FLG)
		(CALLS3
 (CDDR FNDEF))
		(CALLS3
 (CDDDR FNDEF))
		(CDR FNDEF))
	      [(EXPRP FNDEF)
		                                            (* Note that EXPR can be a piece of a function 

							    definition, and calls will still work.)

		(RESETVARS ((MSRECORDTRANFLG T))
		           (RETURN
			     (PROG (CALLSDATA LAMFLG)
			           [COND
				     ((FMEMB (CAR FNDEF)
					     LAMBDASPLST)
				       (SETQ LAMFLG T)
				       (COND
					 ((OR (AND (EQ (CAR (CADDR FNDEF))
						       (QUOTE *))
						   (EQ (CADR (CADDR FNDEF))
						       (QUOTE DECLARATIONS:)))
					      (EQ (CAR (CADDR FNDEF))
						  (QUOTE CLISP:)))
					   (MSPRGDWIM
 FNDEF EXPR FNDEF)))
				       (SELECTQ (CAR FNDEF)
						([LAMBDA NLAMBDA]
						  NIL)
						(SETQ FNDEF (OR (AND COMPILEUSERFN
								     (APPLY* COMPILEUSERFN NIL FNDEF))
								FNDEF]
			           (SETQ CALLSDATA
				     (ALLCALLS

				       FNDEF LAMFLG
				       [UNION (CONSTANT (MSVBNOTICED
 (QUOTE USE)
								     (QUOTE FREELY)))
					      (AND (NEQ VARSFLG (QUOTE FREEVARS))
						   (UNION (CONSTANT (MSVBNOTICED
 (QUOTE BIND)))
							  (AND (NULL VARSFLG)
							       (CONSTANT (MSVBNOTICED
 (QUOTE CALL)
										      (QUOTE NOTERROR]
				       EXPR T))
			           [SETQ FREES (NCONC FREES (COLLECTFNDATA

							(CONSTANT (MSVBNOTICED
 (QUOTE USE)
									       (QUOTE FREELY]
			           (RETURN (LIST [COLLECTFNDATA
 (CONSTANT (MSVBNOTICED
 (QUOTE CALL)
										       (QUOTE 
											 NOTERROR]
						 [COLLECTFNDATA
 (CONSTANT (MSVBNOTICED
 (QUOTE BIND]
						 FREES]
	      (T (QUOTE ?])

(COLLECTFNDATA

  [LAMBDA (LST)                                             (* lmm "21-DEC-78 22:56")

    (COND
      ((NLISTP LST)
	(CDR (FASSOC LST CALLSDATA)))
      (T (PROG (VAL)
	       (for
 X in
 LST do
 (SETQ VAL (UNION (COLLECTFNDATA
 X)
						 VAL)))
	       (RETURN VAL])

(CALLS3

  [LAMBDA (LST)                                             (* lmm " 6-JUL-78 00:23")

                                                            (* lmm: 13-DEC-75 4 51)

    (PROG (FLG)
          [for
 X on
 (CAR LST) do
 (OR (NOT (FMEMB (CAR X)
						 INVISIBLEVARS))
				     (SETQ FLG (FRPLACA X]
          (COND
	    (FLG (FRPLACA LST (DREMOVE NIL (CAR LST])
)

(RPAQQ MSMACROPROPS
 (MACRO))

(RPAQQ NOPACKCALLSFLG
 NIL)
[DECLARE: DONTEVAL@LOAD DOEVAL@COMPILE DONTCOPY
(BLOCK: CALLS CALLS COLLECTFNDATA CALLS3 (LOCALFREEVARS CALLSDATA)
	(NOLINKFNS . T)
	(GLOBALVARS INVISIBLEVARS COMPILEUSERFN NOPACKCALLSFLG LAMBDASPLST MSRECORDTRANFLG))
(BLOCK: NIL VARS FREEVARS MSVBNOTICED (LOCALVARS . T))
]
(DECLARE: EVAL@COMPILE 
(DEFINEQ

(MSVBNOTICED

  [LAMBDA (VERB MOD)                                        (* lmm "30-DEC-78 16:42")

    (CDR (FASSOC MOD (CDR (FASSOC VERB
				  (QUOTE ((BIND
 (NIL BIND ARG))
					   (CALL (DIRECTLY CALL EFFECT PREDICATE NLAMBDA)
						 (EFFECT EFFECT)
						 (INDIRECTLY APPLY STACK)
						 (NIL CALL ERROR APPLY EFFECT PREDICATE NLAMBDA STACK)
						 (NOTERROR APPLY CALL EFFECT PREDICATE NLAMBDA STACK)
						 (PREDICATE PREDICATE)
						 (TESTING PREDICATE)
						 (VALUE CALL)
						 [NLAMBDA NLAMBDA])
					   (CREATE
 (NIL CREATE))
					   (DECLARE
 (LOCALVARS LOCALVARS)
						    (NIL LOCALVARS SPECVARS)
						    (SPECVARS SPECVARS))
					   (FETCH
 (NIL FETCH))
					   (REFERENCE (FIELDS FETCH)
						      (FREELY REFFREE)
						      (LOCALLY REF)
						      (NIL REFFREE REF))
					   (REPLACE
 (NIL REPLACE))
					   (SET (FIELDS FETCH REPLACE)
						(FREELY SETFREE)
						(LOCALLY SET)
						(NIL SETFREE SET))
					   (SMASH (FIELDS FETCH REPLACE)
						  (FREELY SMASHFREE)
						  (LOCALLY SMASH)
						  (NIL SMASHFREE SMASH))
					   (TEST (FREELY TESTFREE)
						 (LOCALLY TEST)
						 (NIL TESTFREE TEST))
					   (USE (FIELDS FETCH REPLACE)
						(FREELY SETFREE SMASHFREE REFFREE TESTFREE)
						(I.S.OPRS CLISP)
						(INDIRECTLY LOCALFREEVARS)
						(LOCALLY SET SMASH REF TEST)
						(NIL SETFREE SET SMASHFREE SMASH REFFREE REF TESTFREE 
						     TEST)
						(PREDICATE TEST TESTFREE)
						(PROPNAMES PROP)
						(RECORDS RECORD CREATE)
						(TESTING TEST TESTFREE)
						(VALUE SMASH SMASHFREE REF REFFREE)
						(TYPE TYPE])
)
)
(DEFINEQ

(ALLCALLS

  [LAMBDA (FNDEF LAMFLG ONLYRELS FNNAME INTERNALFLG EACHTIME)
                                   (* lmm "22-DEC-78 13:02")

    (PROG (VARS
 TOPVARS INCLISP ERRORS (PARENT FNDEF))
          (MSINITFNDATA
)
          [COND
	    (LAMFLG (MSPRGLAMBDA
 FNDEF (QUOTE ARG)))
	    (T (MSPRGE
 FNDEF NIL (QUOTE RETURN]
          (RETURN (COND
		    (INTERNALFLG MSFNDATA)
		    (T (for
 X in
 MSFNDATA when
 (CDR X) collect
 (CONS (CAR X)
								     (CDR X])

(MSINITFNDATA

  [LAMBDA NIL                                               (* MSFNDATA is an association list of the "noticed" 

							    types, e.g. CALL, BIND, etc. -- the FRPLACD resets the 

							    pointer)

    (for
 Y in
 MSFNDATA do
 (FRPLACD Y NIL])

(MSPRGE

  [LAMBDA (EXPR SUPEXPR EVALCONTEXT)
                                   (* lmm "13-DEC-82 23:46")


          (* analyzes EXPR; SUPEXPR is the parent expression and is used in the SHOWUSE case where we are printing occurrances

	  of various things rather than updating data base; EVALCONTEXT is a type of reference for this expression from the 

	  template: SMASH etc)



    (PROG (TEM CALLED CLISP)
          [COND
	    ((NLISTP EXPR)
	      (RETURN (COND
			((AND (LITATOM EXPR)
			      EXPR
			      (NEQ EXPR T)
			      (NOT (FMEMB EXPR INVISIBLEVARS)))
                                   (* A variable reference)

			  (COND
			    ([OR (FMEMB EXPR VARS)
				 (SOME TOPVARS (FUNCTION (LAMBDA (Z)
                                   (* bound higher up in the function but but used in a functional argument)

					   (COND
					     ((FMEMB EXPR Z)
					       (ADDTO
 (QUOTE LOCALFREEVARS)
						      EXPR SUPEXPR)
					       T]
                                   (* Things were added to VARS only if they were "noticeable")

			      (SELECTQ EVALCONTEXT
				       ((SMASH TEST SET)
					 (ADDTO
 EVALCONTEXT EXPR SUPEXPR))
				       (CHANGE (ADDTO
 (QUOTE SET)
						      EXPR SUPEXPR))
				       (ADDTO
 (QUOTE REF)
					      EXPR SUPEXPR)))
			    (T (SELECTQ EVALCONTEXT
					(SMASH (ADDTO
 (QUOTE SMASHFREE)
						      EXPR SUPEXPR))
					(TEST (ADDTO
 (QUOTE TESTFREE)
						     EXPR SUPEXPR))
					((SET CHANGE)
					  (ADDTO
 (QUOTE SETFREE)
						 EXPR SUPEXPR))
					(ADDTO
 (QUOTE REFFREE)
					       EXPR SUPEXPR]
          (COND
	    ((EQ EVALCONTEXT (QUOTE SET))
                                   (* in a "SET" context, but not a variable)

	      (MSPRGERR
 PARENT)))
          (COND
	    ((LISTP (SETQ CALLED (CAR EXPR)))
	      (MSPRGLAMBDA
 CALLED NIL (SELECTQ EVALCONTEXT
					       ((TEST EFFECT SMASH)
						 EVALCONTEXT)
					       NIL))
	      (SELECTQ (CAR CALLED)
		       [LAMBDA (MSPRGLST
 (CDR EXPR)
					 EXPR]
		       NIL)
	      (RETURN)))
          [COND
	    ((SETQ TEM (LTEMPLATE CALLED))
	      (RETURN (MSPRGTEMPLATE
 EXPR TEM EVALCONTEXT]
          [COND
	    ((NOT (FGETD (OR (GETP CALLED (QUOTE BROKEN))
			     CALLED)))
	      (COND
		[[AND DWIMFLG (SETQ TEM (GETPROP CALLED (QUOTE CLISPWORD]
                                   (* E.G. IF, FOR, etc.)

		  (SETQ CLISP (MSDWIMTRAN
 EXPR))
		  (RETURN (COND
			    (CLISP [COND
				     (TEM (SELECTQ (CAR TEM)
						   (RECORDTRAN (OR (MSPRGRECORD
 EXPR EVALCONTEXT)
								   MSRECORDTRANFLG
								   (RETURN))
                                   (* optionally also look at translation)

							       )
						   (IFWORD)
						   (CHANGETRAN (MSPRGE
 (CADR EXPR)
								       EXPR
								       (QUOTE CHANGE)))
						   (for
 X in
 EXPR
						      when
 [AND (LITATOM X)
								(EQ (CAR TEM)
								    (CAR (GETPROP X (QUOTE CLISPWORD]
						      do
 (ADDTO
 (QUOTE CLISP)
								X EXPR]
                                   (* Analyze the CLISP translation)

				   (PROG ((INCLISP (INCLISP EXPR)))
				         (MSPRGE
 CLISP EXPR EVALCONTEXT)))
			    ((OR (NULL (GETPROP (CAR EXPR)
						(QUOTE CLISPWORD)))
				 (NEQ (CAR EXPR)
				      CALLED))
			      (RETURN (MSPRGE
 EXPR SUPEXPR EVALCONTEXT)))
			    (T (SELECTQ (CAR TEM)
					(RECORDTRAN (MSPRGRECORD
 EXPR EVALCONTEXT))
					(CHANGETRAN (MSPRGE
 (CADR EXPR)
							    EXPR
							    (QUOTE CHANGE))
						    (MSPRGLST
 (CDDR EXPR)
							      EXPR))
					(PROGN 
                                   (* CLISP word wouldn't DWIMIFY)

					       (MSPRGCALL
 CALLED EXPR EVALCONTEXT)
					       (MSPRGERR
 EXPR)
					       (MSPRGLST
 (CDR EXPR)
							 EXPR]
		((AND MSMACROPROPS (SETQ TEM (GETMACROPROP CALLED MSMACROPROPS))
		      (MSPRGMACRO
 EXPR TEM EVALCONTEXT))
		  (RETURN]
          (COND
	    ((NLAMBDAFNP
 CALLED)
	      (ADDTO
 (QUOTE NLAMBDA)
		     CALLED EXPR)
	      (COND
		((AND MSMACROPROPS (SETQ TEM (GETMACROPROP CALLED MSMACROPROPS))
		      (MSPRGMACRO
 EXPR TEM EVALCONTEXT))
		  (RETURN)))
	      (MSPRGCALL
 CALLED EXPR EVALCONTEXT))
	    (T                     (* normal lambda function call)

	       (MSPRGCALL
 CALLED EXPR EVALCONTEXT)
	       (MSPRGLST
 (CDR EXPR)
			 EXPR
			 (QUOTE EVAL])

(MSPRGMACRO

  [LAMBDA (FORM MACDEF CONTEXT)    (* lmm "13-DEC-82 23:45")

    (PROG ((ME (MACROEXPANSION FORM MACDEF)))
          (COND
	    ((AND (NOT (EQUAL ME FORM))
		  (NOT (EQUAL ME INCLISP)))
	      (MSPRGCALL
 (CAR FORM)
			 FORM CONTEXT)
	      (PROG ((INCLISP (INCLISP FORM))
		     (EXPR FORM))
		    (MSPRGE
 ME FORM (QUOTE EVAL)))
	      (RETURN T])

(MSPRGCALL

  [LAMBDA (FN PRNT CONTEXT)                                 (* lmm "22-DEC-78 12:57")

    (ADDTO
 [COND
	     (TOPVARS (QUOTE APPLY))
	     (T (SELECTQ CONTEXT
			 (TEST (QUOTE PREDICATE))
			 (EFFECT (QUOTE EFFECT))
			 (QUOTE CALL]
	   FN PRNT])

(MSBINDVAR

  [LAMBDA (VAR TYPE EXPR)                                   (* lmm " 6-JUL-78 00:23")

    (COND
      ((AND VAR (LITATOM VAR)
	    (NEQ VAR T))
	[COND
	  ((NOT (FMEMB VAR INVISIBLEVARS))
	    (ADDTO
 (OR TYPE (QUOTE BIND))
		   VAR
		   (OR EXPR PARENT]
	(SETQ VARS (CONS VAR VARS)))
      (T (MSPRGERR
 (COND
		     ((LITATOM VAR)
		       (OR EXPR PARENT))
		     (T VAR])

(MSPRGRECORD

  [LAMBDA (PRNT CNTXT)             (* lmm "25-FEB-82 11:24")

                                   (* ANALYZE RECORD EXPRESSION PRNT -

				   RETURN NIL IF ANALYZED SUCCESSFULLY)

    (PROG (Z)
          (MSPRGTEMPLATE

	    PRNT
	    (SELECTQ
	      (CAR PRNT)
	      ((create
 CREATE
)
		(ADDTO
 (QUOTE CREATE)
		       (CADR PRNT)
		       PRNT)
		(SETQ Z (CDDR PRNT))
		[while
 Z do
 (COND
			      ([EQ (QUOTE RECORDTRAN)
				   (CAR (GETPROP (CAR Z)
						 (QUOTE CLISPWORD]
                                   (* e.g. USING or COPYING)

				(MSPRGE
 (CADR Z)
					PRNT
					(SELECTQ (CAR Z)
						 ((smashing
 SMASHING
)
						   (QUOTE SMASH))
						 NIL))
				(SETQ Z (CDDR Z)))
			      ((EQ (CADR Z)
				   (QUOTE _))
                                   (* If dwimified correctly, the fields should be separated by _'s)

				(ADDTO
 (QUOTE REPLACE)
				       (CAR Z)
				       PRNT)
				(MSPRGE
 (CADDR Z)
					PRNT)
				(SETQ Z (CDDDR Z)))
			      ((EQ (CAAR Z)
				   (QUOTE SETQ))
                                   (* partially dwimified)

				(ADDTO
 (QUOTE REPLACE)
				       (CADAR Z)
				       PRNT)
				(MSPRGE
 (CADDAR Z)
					PRNT)
				(SETQ Z (CDR Z)))
			      (T 
                                   (* shouldn't happen, but)

				 (MSPRGE
 (CAR Z)
					 PRNT)
				 (SETQ Z (CDR Z]
		(RETURN))
	      [(fetch
 FETCH
 ffetch
 FFETCH
)
		(COND
		  ((EQ CNTXT (QUOTE CHANGE))
		    (QUOTE (NIL (IF
 LISTP (BOTH (NIL .. FETCH (BOTH FETCH REPLACE))
						(.. RECORD NIL))
				    (BOTH FETCH REPLACE))
				NIL EVAL)))
		  (T (QUOTE (NIL (IF
 LISTP (BOTH (NIL .. FETCH)
						 (.. RECORD NIL))
				     FETCH)
				 NIL EVAL]
	      ((REPLACE
 /REPLACE
 replace
 /replace
 freplace
 FREPLACE
)
		(QUOTE (NIL (IF
 LISTP (BOTH (NIL .. FETCH REPLACE)
					    (.. RECORD NIL))
				REPLACE)
			    NIL SMASH NIL EVAL)))
	      ((type?
 TYPE?
)
		(QUOTE (CLISP RECORD EVAL . PPE)))
	      ((initrecord
 INITRECORD
)
		(QUOTE (CLISP RECORD . PPE)))
	      [(WITH
 with
)
		(COND
		  ((SETQ Z (RECORDFIELDNAMES (CADR PRNT)))
		    (ADDTO
 (QUOTE RECORD)
			   (CADR PRNT)
			   PRNT)
		    (MSPRGE
 (CADDR PRNT)
			    PRNT)
		    (for
 X
		       in

			(PROG1 [for
 X on
 MSFNDATA when
 (FMEMB (CAAR X)
							      (QUOTE (SETFREE TESTFREE REFFREE)))
				  collect
 (LIST (CAR X)
						(RPLACA X (LIST (CAAR X]
			       (PROG [ONLYRELS
				       (EACHTIME
 (AND EACHTIME
						      (for
 X inside
 (PROGN EACHTIME)
							 when
 [NOT (FMEMB X (QUOTE (SETFREE TESTFREE 
											  REFFREE]
							 collect
 X]
				     (MSPRGLST
 (CDDDR PRNT)
					       PRNT)))
		       do
 (for
 Y in
 (PROG1 (CDR (CAADR X))
					   (RPLACA (CADR X)
						   (CAR X)))
			     do
 (ADDTO
 (COND
					 ((FMEMB Y Z)
					   (SELECTQ (CAAR X)
						    (SETFREE (QUOTE REPLACE))
						    (QUOTE FETCH)))
					 (T (CAAR X)))
				       Y PRNT)))
		    (RETURN))
		  (T (QUOTE (RECORD .. EVAL]
	      (RETURN T])

(MSPRGERR

  [LAMBDA (EXPR)                                            (* lmm "21-DEC-78 22:44")

    (SETQ ERRORS T)
    (ADDTO
 (QUOTE ERROR)
	   MSERRORFN EXPR])

(MSPRGTEMPLATE1

  [LAMBDA (X TEMPLATE)                                       (* lmm " 6-APR-82 21:35")

    (COND
      ((NLISTP TEMPLATE)
	(SELECTQ TEMPLATE
		 ((EVAL SMASH TEST EFFECT SET)
		   (MSPRGE
 X PARENT TEMPLATE))
		 [(FUNCTION FUNCTIONAL)

          (* This is a functional arg to something -

	  the marker FUNCTIONAL means that it will be a separate function while FUNCTION is reserved for those things which 

	  compile open -

	  e.g. MAPC is marked (EVAL FUNCTION FUNCTION . PPE) while SORT is marked (EVAL FUNCTIONAL . PPE))



		   (OR (COND
			 ((AND (LISTP X)
			       (NULL (CDDR X)))
			   (COND
			     ((EQ (CAR X)
				  (QUOTE F/L))
			       (MSPRGDWIM
 X FNNAME FNDEF)))
			   (SELECTQ (CAR X)
				    ((FUNCTION QUOTE)
				      (MSPRGTEMPLATE
 (CADR X)
						     (COND
						       ((LISTP (CADR X))
							 (SELECTQ TEMPLATE
								  (FUNCTIONAL (QUOTE (REMOTE LAMBDA)))
								  (QUOTE LAMBDA)))
						       ((OR (NEQ (CAR X)
								 (QUOTE FUNCTION))
							    (EQ TEMPLATE (QUOTE FUNCTIONAL)))
							 (QUOTE (REMOTE CALL)))
						       (T (QUOTE CALL)))
						     X)
				      T)
				    NIL)))
		       (EQ X T)
		       (NULL X)
		       (PROGN                                (* arbitrary expression as functional argument)

			      (ADDTO
 (QUOTE ERROR)
				     (QUOTE apply)
				     PARENT)
			      (MSPRGE
 X PARENT (QUOTE FUNCTIONAL]
		 [STACK                                      (* arg to stack fn, e.g. RETFROM)

			(OR (AND (LISTP X)
				 (SELECTQ (CAR X)
					  ((FUNCTION QUOTE)
					    (ADDTO
 (QUOTE STACK)
						   (CADR X)
						   PARENT)
					    T)
					  NIL))
			    (PROGN (ADDTO
 (QUOTE ERROR)
					  (QUOTE stackfn)
					  PARENT)
				   (MSPRGE
 X PARENT (QUOTE EVAL]
		 [PROP (COND
			 ((AND (LISTP X)
			       (EQ (CAR X)
				   (QUOTE QUOTE)))
			   (for
 Y inside
 (CADR X) do
 (ADDTO
 (QUOTE PROP)
							    Y PARENT)))
			 (T (MSPRGE
 X PARENT TEMPLATE]
		 (NIL                                        (* not used)

		      NIL)
		 [RETURN                                     (* this is sometimes the value of PARENT expression)

			 (MSPRGTEMPLATE1
 X (SELECTQ PARENTCONTEXT
						    ((TEST EFFECT)
						      PARENTCONTEXT)
						    (QUOTE EVAL]
		 [TESTRETURN                                 (* if PARENT is tested, then so is this)

			     (MSPRGTEMPLATE1
 X (SELECTQ PARENTCONTEXT
							(TEST PARENTCONTEXT)
							(QUOTE EVAL]
		 (BIND (MSBINDVAR
 X))
		 [LAMBDA (MSPRGLAMBDA
 X]
		 [PPE                                        (* paren error if not NIL)

		      (COND
			(X (MSPRGERR
 PARENT)
			   (MSPRGLST
 X PARENT]
		 (CALL (MSPRGCALL
 X PARENT PARENTCONTEXT))
		 [EVALQT (COND
			   ((EQ (CAR X)
				(QUOTE QUOTE))
			     (MSPRGTEMPLATE
 (CADR X)
					    (QUOTE (REMOTE EVAL))
					    PARENT))
			   (T (MSPRGE
 X PARENT (QUOTE EVAL]
		 (ADDTO
 TEMPLATE X PARENT T)))
      (T (SELECTQ (CAR TEMPLATE)
		  [IF (PROG ((EXPR X))
			    (DECLARE
 (SPECVARS EXPR))
			    (MSPRGTEMPLATE1
 X (COND
					      ((COND
						  ((LISTP (CADR TEMPLATE))
                                                             (* ASSERT: ((REMOTE EVAL) EXPR))

						    (EVAL (CADR TEMPLATE)))
						  (T (APPLY* (CADR TEMPLATE)
							     X)))
						(CADDR TEMPLATE))
					      (T (CADDDR TEMPLATE]
		  [.. (COND
			[(AND (CADR TEMPLATE)
			      (NULL (CDDR TEMPLATE)))        (* Special case to handle most common cases)

			  (MAPC X (FUNCTION (LAMBDA (X)
				    (MSPRGTEMPLATE1
 X (CADR TEMPLATE]
			(T (FRPTQ (IDIFFERENCE (LENGTH X)
					       (LENGTH (CDDR TEMPLATE)))
				  (MSPRGTEMPLATE1
 (CAR X)
						  (CADR TEMPLATE))
				  (SETQ X (CDR X)))
			   (MSPRGTEMPLATE1
 X (CDDR TEMPLATE]
		  (MACRO (ADDTO
 (QUOTE CALL)
				(CAR X)
				PARENT)
			 (MSPRGMACRO
 X (CDR TEMPLATE)))
		  (BOTH (MSPRGTEMPLATE1
 X (CADR TEMPLATE))
			(MSPRGTEMPLATE1
 X (CADDR TEMPLATE)))
		  [@ (PROG ((EXPR X))
		           (DECLARE
 (SPECVARS EXPR))
		           (MSPRGTEMPLATE1
 (EVAL (CADR TEMPLATE))
					   (EVAL (CADDR TEMPLATE]
		  [REMOTE (PROG (VARS
 (TOPVARS (CONS VARS TOPVARS)))
			        (MSPRGTEMPLATE1
 X (CADR TEMPLATE]
		  (COND
		    ((LISTP X)
		      (MSPRGTEMPLATE1
 (CAR X)
				      (CAR TEMPLATE))
		      (MSPRGTEMPLATE1
 (CDR X)
				      (CDR TEMPLATE])

(MSPRGTEMPLATE

  [LAMBDA (PARENT TEMPLATE PARENTCONTEXT)
                                   (* lmm "21-MAY-82 23:39")

    (PROG ((VARS
 VARS)
	   TEM)
          (COND
	    [(EQ TEMPLATE (QUOTE MACRO))
	      (COND
		((SETQ TEM (GETMACROPROP (CAR PARENT)
					 MSMACROPROPS))
		  (MSPRGMACRO
 PARENT TEM))
		(T (MSPRGTEMPLATE1
 PARENT (QUOTE (CALL .. EVAL]
	    (T (MSPRGTEMPLATE1
 PARENT TEMPLATE])

(MSPRGLAMBDA

  [LAMBDA (EXPR FLG TYPE)          (* DD: "28-Dec-81 10:41")

    (SELECTQ (CAR (LISTP EXPR))
	     ([LAMBDA NLAMBDA]
	       (MSPRGTEMPLATE
 EXPR (QUOTE (NIL (IF
 LISTP (.. BIND)
						   (IF
 (PROGN EXPR) BIND))
					       .. EFFECT RETURN))
			      TYPE))
	     (PROG (CLISP
)
	           (COND
		     ((AND DWIMFLG (SETQ CLISP (MSDWIMTRAN
 EXPR)))
                                   (* has a CLISP translation (e.g. DLAMBDA))

		       (PROG ((INCLISP (INCLISP EXPR)))
                                   (* rebind INCLISP, and try again on the translation)

			     (MSPRGLAMBDA
 CLISP FLG TYPE)))
		     (T (MSPRGERR
 EXPR)
			(MSPRGE
 EXPR])

(MSPRGLST

  [LAMBDA (L PARNT CNTX)                                    (* lmm "27-JUN-78 01:57")

    (for
 X in
 L do
 (MSPRGE
 X PARNT CNTX])

(ADDTO

  [LAMBDA (RELATION WHAT PRNT FLG)                          (* lmm "24-DEC-78 11:51")

    (PROG ((PTR (FASSOC RELATION MSFNDATA)))
          [OR PTR (COND
		(FLG (RETURN))
		(T (SHOULDNT]
          (OR (NULL ONLYRELS)
	      (FMEMB RELATION ONLYRELS)
	      (RETURN))
          (AND EACHTIME (EQMEMB RELATION (CAR EACHTIME))
	       (APPLY* (CADR EACHTIME)
		       WHAT
		       (CADDR EACHTIME)
		       (CADDDR EACHTIME)
		       PRNT INCLISP))
      LP  (COND
	    ((NULL (CDR PTR))
	      (FRPLACD PTR (LIST WHAT)))
	    ((EQ (CAR (SETQ PTR (CDR PTR)))
		 WHAT)
	      (RETURN))
	    (T (GO LP])

(NLAMBDAFNP

  [LAMBDA (FN)                     (* lmm " 6-DEC-80 15:39")

    (AND [NOT (EQMEMB (QUOTE EVAL)
		      (GETPROP FN (QUOTE INFO]
	 (COND
	   ([OR (FGETD (SETQ FN (OR (GETPROP FN (QUOTE BROKEN))
				    FN)))
		(SETQ FN (GETLIS FN (QUOTE (EXPR CODE SUBR]
                                   (* if the function is defined, check its argtype to tell you whether it is 

				   NLAMBDA or LAMBDA)

	     (SELECTQ (ARGTYPE FN)
		      ((1 3)
			T)
		      NIL))
	   (T                      (* otherwise, rely on NLAMA or NLAML)

	      (OR (FMEMB FN NLAMA)
		  (FMEMB FN NLAML])

(MSPRGDWIM

  [LAMBDA (X FN DEF)                                        (* lmm "24-DEC-78 14:36")

    (AND DWIMFLG (RESETVARS ((NOSPELLFLG T)
			     (DWIMESSGAG T)
			     FILEPKGFLG)
			    (PROG (LISPXHIST)               (* ASSERT: ((REMOTE EVAL) DWIMESSGAG FILEPKGFLG 

							    NOSPELLFLG))

			          (DWIMIFY0 X (OR (AND (LITATOM FN)
						       FN)
						  (QUOTE ?))
					    VARS DEF])

(MSDWIMTRAN

  [LAMBDA (EXPR)                   (* DD: "28-DEC-81 13:46")

    (AND DWIMFLG (COND
	   ((AND CLISPARRAY (GETHASH EXPR CLISPARRAY)))
	   ((AND CLISPTRANFLG (EQ (CAR (LISTP EXPR))
				  CLISPTRANFLG))
	     (CADR EXPR))
	   (T (MSPRGDWIM
 EXPR FNNAME FNDEF)
	      (OR (AND CLISPARRAY (GETHASH EXPR CLISPARRAY))
		  (AND CLISPTRANFLG (EQ (CAR (LISTP EXPR))
					CLISPTRANFLG)
		       (CADR EXPR])
)

(RPAQQ MSFNDATA
 ((BIND)
		 (CALL)
		 (EFFECT)
		 (PREDICATE)
		 (CLISP)
		 (PROP)
		 (SETFREE)
		 (SET)
		 (SMASHFREE)
		 (SMASH)
		 (REFFREE)
		 (REF)
		 (FETCH)
		 (REPLACE)
		 (RECORD)
		 (ERROR)
		 (ARG)
		 (CREATE)
		 (LOCALVARS)
		 (SPECVARS)
		 (APPLY)
		 (TESTFREE)
		 (TEST)
		 (LOCALFREEVARS)
		 [NLAMBDA]
		 (TYPE)
		 (STACK)))

(RPAQQ MSERRORFN
 ppe)

(RPAQQ MSRECORDTRANFLG
 NIL)

(ADDTOVAR INVISIBLEVARS
 $$1 $$2 $$3 $$4 $$5 $$6 $$7 $$8 $$9 $$10 $$11 $$12 $$13 $$14 $$15 $$16 $$17)
(DECLARE: DONTCOPY 
(DECLARE: EVAL@COMPILE 

(PUTPROPS INCLISP MACRO
 ((.X.)
			 (COND
			   ((AND INCLISP EACHTIME (NOT (MSFINDP INCLISP .X.)))
			     INCLISP)
			   (T .X.))))

(PUTPROPS LTEMPLATE MACRO
 [LAMBDA (Y)
			    (DECLARE
 (LOCALVARS Y))
			    (AND [NEQ T (SETQ Y (OR (GETHASH Y USERTEMPLATES)
						    (GETHASH Y MSTEMPLATES]
				 Y])
)
)
[DECLARE: DONTEVAL@LOAD DOEVAL@COMPILE DONTCOPY
(BLOCK: ALLCALLS ALLCALLS ADDTO MSBINDVAR MSDWIMTRAN MSPRGCALL MSPRGDWIM MSPRGE MSPRGMACRO MSPRGERR 
	MSPRGLAMBDA MSPRGLST MSPRGRECORD MSPRGTEMPLATE MSPRGTEMPLATE1 NLAMBDAFNP (NOLINKFNS . T)
	(LOCALFREEVARS FNNAME ERRORS FNDEF INCLISP ONLYRELS PARENTCONTEXT TOPVARS PARENT EACHTIME 
		       VARS)
	(GLOBALVARS CLISPARRAY MSERRORFN MSRECORDTRANFLG MSFNDATA INVISIBLEVARS CLISPARRAY 
		    MSTEMPLATES USERTEMPLATES MSRECORDTRANFLG NLAMA NLAML DWIMFLG CLISPTRANFLG 
		    NOSPELLFLG DWIMESSGAG FILEPKGFLG)
	(NOLINKFNS . T))
(BLOCK: NIL MSINITFNDATA NLAMBDAFNP MSPRGDWIM (LOCALVARS . T)
	(GLOBALVARS NLAMA NLAML MSFNDATA DWIMFLG NOSPELLFLG DWIMESSGAG FILEPKGFLG))
]
(PUTDQ? MSWORDNAME [LAMBDA (X)
			   X])

(RPAQ MSTEMPLATES
 (LIST (HARRAY 160)))

(RPAQ USERTEMPLATES
 (LIST (HARRAY 10)))

(RPAQQ INITIALTEMPLATES
 (((CALL (REMOTE (IF LITATOM CALL LAMBDA))
				(IF LITATOM EVAL NIL))
	 FUNCTION)
	([IF (EQ (CADR EXPR)
		 (QUOTE ASSERT:))
	     (NIL NIL .. (IF LISTP (@ (CDR EXPR)
				      (LIST (QUOTE ..)
					    (MSWORDNAME (CAR EXPR]
	 *)
	((NIL (BOTH (.. (IF LISTP (NIL EVAL .. EFFECT)
			    NIL))
		    (.. (IF LISTP (BIND)
			    BIND)))
	      ..
	      (IF LISTP EFFECT))
	 PROG)
	(MACRO RESETVARS)
	((CALL EVAL)
	 XNLSETQ NLSETQ ERSETQ)
	((CALL .. EVAL)
	 RESETFORM FRPTQ)
	((CALL EVAL EVAL FUNCTIONAL FUNCTIONAL . PPE)
	 MAP2C)
	((CALL EVAL EVAL SMASH . PPE)
	 /DSUBST DSUBST)
	((CALL EVAL FUNCTION FUNCTION . PPE)
	 MAPCAR MAPCON MAPCONC MAPLIST SUBSET EVERY NOTEVERY ANY NOTANY SOME MAPC MAP)
	((CALL EVAL FUNCTIONAL . PPE)
	 MAPHASH)
	((CALL EVAL PROP . PPE)
	 GETP GETLIS GET GETPROP LISTGET LISTGET1 REMPROP /REMPROP)
	((CALL EVAL PROP EVAL . PPE)
	 PUT /PUT PUTPROP /PUTPROP LISTPUT LISTPUT1)
	((CALL EVAL SMASH . PPE)
	 /ATTACH ATTACH)
	((CALL FUNCTIONAL . PPE)
	 MAPATOMS)
	((CALL FUNCTIONAL .. EVAL)
	 APPLY* BLKAPPLY* APPLY BLKAPPLY)
	((CALL NIL .. (@ EXPR (SELECTQ (CAR EXPR)
				       ((CQ CQ2 CV CV2)
					(QUOTE (NIL .. EVAL)))
				       [VAR (QUOTE (NIL (.. NIL EVAL]
				       (SETQ (QUOTE (NIL SET)))
				       NIL)))
	 ASSEMBLE)
	((CALL EVAL SMASH . PPE)
	 DREMOVE /DREMOVE)
	((CALL SET EVAL EVAL . PPE)
	 RESETVAR)
	((CALL SET EVAL . PPE)
	 SETN)
	((CALL SMASH . PPE)
	 DREVERSE)
	((CALL SMASH EVAL . PPE)
	 RPLACD /RPLACD RPLACA /RPLACA RPLNODE2 /RPLNODE2 FRPLACD FRPLNODE2 TCONC /TCONC LCONC /LCONC 
	 NCONC1 /NCONC1 FRPLACA)
	((CALL SMASH EVAL EVAL . PPE)
	 RPLNODE FRPLNODE /RPLNODE)
	((CALL SMASH FUNCTIONAL . PPE)
	 SORT)
	((CALL (BOTH SET EVAL) . PPE)
	 ADD1VAR SUB1VAR)
	((CALL (IF NULL NIL (IF ATOM SET EVAL))
	       EVAL . PPE)
	 RESETSAVE)
	((CALL (IF (EQ (CAR (LISTP EXPR))
		       (QUOTE QUOTE))
		   (NIL SET)
		   EVAL)
	       EVAL . PPE)
	 SET /SET SETTOPVAL /SETTOPVAL SETATOMVAL /SETATOMVAL)
	((CALL (IF (EQ (CAR (LISTP EXPR))
		       (QUOTE QUOTE))
		   (NIL SET)
		   EVAL)
	       EVAL EVAL EVAL . PPE)
	 SAVESET)
	((CALL (IF (EQ (CAR (LISTP EXPR))
		       (QUOTE QUOTE))
		   (NIL EVAL)
		   EVAL)
	       .. EVAL)
	 GETATOMVAL EVAL EVALV)
	((NIL .. TESTRETURN RETURN)
	 OR)
	((NIL .. TEST RETURN)
	 AND)
	((NIL .. EFFECT RETURN)
	 PROGN)
	((NIL .. (IF CDR (TEST .. EFFECT RETURN)
		     (TESTRETURN . PPE)))
	 COND)
	([CALL .. (@ EXPR (CONS NIL (SELECTQ (CAR (LISTP EXPR))
					     (LOCALVARS (QUOTE (IF LISTP (.. LOCALVARS)
								   LOCALVARS)))
					     (SPECVARS (QUOTE (IF LISTP (.. SPECVARS)
								  SPECVARS)))
					     NIL]
	 DECLARE)
	((NIL RETURN)
	 CLISP% )
	((NIL EVAL . PPE)
	 LISTP NLISTP RETURN)
	((NIL TEST . PPE)
	 NOT NULL)
	((CALL EVAL .. (NIL .. EFFECT RETURN)
	       RETURN)
	 SELECTQ SELCHARQ)
	((CALL EVAL .. (EVAL .. EFFECT RETURN)
	       RETURN)
	 SELECTC)
	((CALL EVAL .. ((IF LISTP (.. EVAL)
			    EVAL)
		.. EFFECT RETURN)
	       RETURN)
	 SELECT)
	((NIL EVAL EVAL . PPE)
	 EQ NEQ)
	((NIL NIL . PPE)
	 QUOTE GO)
	((NIL EVAL . PPE)
	 CAR CDR CAAR CADR CDAR CDDR CAAAR CAADR CADAR CDAAR CADDR CDADR CDDAR CDDDR CAAAAR CAAADR 
	 CAADAR CAADDR CADAAR CADADR CADDAR CADDDR CDAAAR CDAADR CDADAR CDADDR CDDAAR CDDADR CDDDAR 
	 CDDDDR)
	((NIL RETURN .. EFFECT)
	 PROG1)
	((NIL SET NIL . PPE)
	 SETQQ)
	((NIL SET EVAL . PPE)
	 SETQ ADV-SETQ SAVESETQ)
	((CALL EVAL (BOTH (@ (QUOTE RPTN)
			     (QUOTE BIND))
			  RETURN) . PPE)
	 RPTQ)
	((CALL EVALQT .. EVAL)
	 EVAL ERRORSET)
	((BOTH [IF (EQ (CAR (LISTP (CADDR EXPR)))
		       (QUOTE QUOTE))
		   (NIL NIL (NIL (.. (BIND]
	       (CALL EVALQT EVAL . PPE))
	 EVALA)
	((CALL EVALQT STACK STACK EVAL EVAL . PPE)
	 ENVEVAL)
	((CALL FUNCTIONAL EVALQT STACK STACK EVAL EVAL . PPE)
	 ENVAPPLY)
	((CALL STACK EVAL EVAL EVAL . PPE)
	 STKAPPLY)
	((CALL STACK EVALQT EVAL EVAL . PPE)
	 RETEVAL STKEVAL)
	((CALL STACK EVAL EVAL . PPE)
	 RETFROM RETTO)))
(* * INITIALTEMPLATES is not needed after loading up)


[MAPC INITIALTEMPLATES (FUNCTION (LAMBDA (X)
					 (MAPC (CDR X)
					       (FUNCTION (LAMBDA (Y)
								 (PUTHASH Y (CAR X)
									  MSTEMPLATES]
(DECLARE: EVAL@COMPILE DONTCOPY 

(PUTPROPS LTEMPLATE MACRO
 [LAMBDA (Y)
			    (DECLARE
 (LOCALVARS Y))
			    (AND [NEQ T (SETQ Y (OR (GETHASH Y USERTEMPLATES)
						    (GETHASH Y MSTEMPLATES]
				 Y])
)
(DEFINEQ

(MSFINDP

  [LAMBDA (SUB STRUC)                                       (* lmm "25-FEB-79 17:13")

    (PROG NIL
      LP  (RETURN (OR (EQ SUB STRUC)
		      (AND (LISTP STRUC)
			   (OR (MSFINDP
 SUB (CAR STRUC))
			       (PROGN (SETQ STRUC (CDR STRUC))
				      (GO LP])
)
[DECLARE: DONTEVAL@LOAD DOEVAL@COMPILE DONTCOPY
(BLOCK: MSFINDP MSFINDP)
]
(PUTPROPS MSANALYZE COPYRIGHT ("Xerox Corporation" 1982 1983))
(DECLARE: DONTCOPY
  (FILEMAP (NIL (2476 6288 (VARS 2488 . 2625) (FREEVARS 2629 . 2784) (CALLS 2788 . 5572) (COLLECTFNDATA 
5576 . 5884) (CALLS3 5888 . 6285)) (6666 8311 (MSVBNOTICED 6678 . 8308)) (8316 26085 (ALLCALLS 8328 . 
8832) (MSINITFNDATA 8836 . 9122) (MSPRGE 9126 . 13622) (MSPRGMACRO 13626 . 14012) (MSPRGCALL 14016 . 
14291) (MSBINDVAR 14295 . 14706) (MSPRGRECORD 14710 . 17921) (MSPRGERR 17925 . 18100) (MSPRGTEMPLATE1 
18104 . 22647) (MSPRGTEMPLATE 22651 . 23081) (MSPRGLAMBDA 23085 . 23800) (MSPRGLST 23804 . 23965) (
ADDTO 23969 . 24603) (NLAMBDAFNP 24607 . 25222) (MSPRGDWIM 25226 . 25648) (MSDWIMTRAN 25652 . 26082)) 
(32364 32665 (MSFINDP 32376 . 32662)))))
STOP