(FILECREATED " 7-Dec-84 13:11:43" {ERIS}<LISPNEW>SOURCES>MASTERSCOPE.;1 118112 

      changes to:  (FNS UNSAVEFNS)

      previous date: "15-Aug-84 00:55:26" {ERIS}<LISPCORE>SOURCES>MASTERSCOPE.;5)


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

(PRETTYCOMPRINT MASTERSCOPECOMS)

(RPAQQ MASTERSCOPECOMS [(COMS * MSDATABASECOMS)
			(COMS * MSAUXCOMS)
			(COMS * MSDBCOMS)
			(COMS * MSCHECKBLOCKSCOMS)
			(COMS * MSPATHSCOMS)
			[COMS (FNS MSFIND)
			      (VARS MSBLIP)
			      (COMS (* SCRATCHASH)
				    (INITVARS (MSCRATCHASH))
				    (DECLARE: DONTCOPY (MACROS SCRATCHASH]
			(COMS (* marking changed)
			      (FNS MSMARKCHANGED CHANGEMACRO CHANGEVAR CHANGEI.S. CHANGERECORD 
				   MSNEEDUNSAVE UNSAVEFNS)
			      (ADDVARS (COMPILE.TIME.CONSTANTS))
			      (VARS (RECORDCHANGEFN (QUOTE CHANGERECORD)))
			      (INITVARS (CHECKUNSAVEFLG T)
					(MSNEEDUNSAVE)))
			(DECLARE: EVAL@COMPILE DONTCOPY (RECORDS * PARSERRECORDS)
				  (MACROS GETWORDTYPE))
			(COMS (* interactive routines)
			      [VARS * (LIST (LIST (QUOTE MASTERSCOPEDATE)
						  (SUBSTRING (DATE)
							     1 9]
			      (ADDVARS (HISTORYCOMS %.))
			      (FNS %. MASTERSCOPE MASTERSCOPE1 MASTERSCOPEXEC)
			      (* Interpreting commands)
			      (FNS MSINTERPRETSET MSINTERPA MSGETBLOCKDEC LISTHARD MSMEMBSET 
				   MSLISTSET MSHASHLIST MSHASHLIST1 CHECKPATHS ONFILE)
			      (FNS MSINTERPRET VERBNOTICELIST MSOUTPUT MSCHECKEMPTY CHECKFORCHANGED 
				   MSSOLVE)
			      (DECLARE: DONTCOPY (RECORDS GETHASH INRELATION PATHOPTIONS)))
			(DECLARE: DONTCOPY (COMS * MSCOMPILETIME))
			(DECLARE: DONTEVAL@LOAD DOEVAL@COMPILE DONTCOPY COMPILERVARS
				  (ADDVARS (NLAMA %.)
					   (NLAML)
					   (LAMA])

(RPAQQ MSDATABASECOMS ((FNS UPDATEFN MSGETDEF MSNOTICEFILE MSSHOWUSE MSUPDATEFN1 MSUPDATE 
			    MSNLAMBDACHECK MSCOLLECTDATA)
		       (FNS UPDATECHANGED UPDATECHANGED1)
		       (VARS TABLE.TO.NOTICED)
		       (FNS MSCLOSEFILES)
		       (VARS (MSFILELST)
			     (MSOPENFILES))
		       (VARS (MSPRINTFLG (QUOTE %.))
			     (MSPRINTCNT 0))
		       (ADDVARS (MSHASHFILENAME)
				(ANALYZEUSERFNS))))
(DEFINEQ

(UPDATEFN
  [LAMBDA (FN EVENIFVALID IFCANT)                      (* lmm "20-JAN-79 12:23")
                                                       (* Update the analysis of a particular function -
						       this is a "user" entry)
    (PROG (DEF)
          (OR (AND FN (LITATOM FN))
	      (RETURN))
          (MSINIT)
          (COND
	    ((AND (NOT EVENIFVALID)
		  (NOT (GETHASH FN MSCHANGEDARRAY))
		  (TESTRELQ KNOWN FN))                 (* Previous valid analysis -- return)
	      (RETURN)))
          (COND
	    ((NOT (SETQ DEF (MSGETDEF FN IFCANT T)))   (* No definition can be found -- look at IFCANT)
	      (SELECTQ IFCANT
		       (ERROR (ERROR FN "can't be analyzed " T))
		       ((NIL PRINT)
			 (printout T "Sorry, the function " .P2 FN " can't be analyzed!" T))
		       NIL)
	      (COND
		((TESTRELQ KNOWN FN)
		  (MSERASE (LIST FN)))
		(T (PUTHASH FN NIL MSCHANGEDARRAY)))
	      (RETURN)))
          (MSUPDATEFN1 FN DEF])

(MSGETDEF
  [LAMBDA (FN IFCANT NOSAVE ARGLISTFLG)                (* lmm " 8-APR-81 00:00")

          (* This is the function which obtains the definition for a function. NOSAVE says that if the def is loaded from a file it need not be 
	  saved, since this is for an analysis or SHOW command -
	  IFCANT is either 0, meaning don't try to load, want only in-core def or something else, meaning to just return NIL if it can't be found 
	  on a file (will be handled by the calling function))


    (PROG (DEF FILE)
          (OR (AND FN (LITATOM FN))
	      (RETURN))
          (COND
	    ((EXPRP (SETQ DEF (VIRGINFN FN)))
	      (RETURN DEF)))
          (COND
	    ((ZEROP IFCANT)
	      (RETURN)))
          (COND
	    [(NULL NOSAVE)
	      (AND (NEQ IFCANT (QUOTE PATHS))
		   (RETURN (COND
			     ([SETQ FILE
				 (OR (EDITLOADFNS? FN)
				     (find X in (GETRELQ CONTAINS FN T)
					suchthat (OR (FINDFILE X)
						     (FINDFILE (SETQ X
								 (CDR (GETTABLE X (CADR MSFILETABLE]

          (* The file known to the database might not be loaded. FILE is now bound to a full-filename less the version, so the most recent version
	  will be used by both MSNOTICEFILE (which ignores versions anyway) and lOADFNS, which doesn't)


			       (MSNOTICEFILE FILE)     (* This causes a LOADFROM if necessary)
			       (LOADFNS FN FILE (QUOTE PROP))
			       (GETPROP FN (QUOTE EXPR]
	    (T (RETURN (PROG (COMS PRINTFLG FL STARTPOS MAP)
			 RETRY
			     [COND
			       ((find old FL in MSOPENFILES when [find PAIR in (CDADR (CDDR FL))
								    suchthat
                                                       (* the (CDDR FL) gets the filemap. The CDADR then gets the list of 
						       pairs)
								     (SETQ STARTPOS
								       (CADR (ASSOC FN (CDDR PAIR]
				   do (RETURN T))
				 (SETFILEPTR [SETQ FILE (OR (OPENP (SETQ FILE (CADDR FL))
								   (QUOTE INPUT))
							    (PROGN (FRPLACA (CDR FL)
									    NIL)
								   (INPUT (INFILE FILE]
					     STARTPOS)
				 (RETURN (COND
					   [ARGLISTFLG (RATOM FILE FILERDTBL)
                                                       (* skip paren)
						       (READ FILE FILERDTBL)
                                                       (* and first thing)
						       (RATOM FILE FILERDTBL)
                                                       (* and next paren)
                                                       (* return LAMBDA & args)
						       (RETURN (LIST (READ FILE FILERDTBL)
								     (READ FILE FILERDTBL]
					   (T (CADR (READ FILE FILERDTBL]
			     [for X in MSFILELST do (COND
						      ((FASSOC (CAR X)
							       MSOPENFILES))
						      ((INFILECOMS? FN (QUOTE FNS)
								    (CDR X))
							(SETQ FL (CAR X))
							(GO OPEN]
			     [for X in FILELST when (AND (NOT (FASSOC X MSFILELST))
							 (NOT (FASSOC X MSOPENFILES)))
				do (COND
				     ((INFILECOMS? FN (QUOTE FNS)
						   (SETQ COMS (FILECOMS X)))
				       (SETQ FL X)
				       (MSNOTICEFILE FL)
				       (SETQ PRINTFLG T)
				       (GO OPEN]
			     (for FL in (GETRELQ CONTAINS FN T)
				when (AND (NOT (FMEMB FL FILELST))
					  (NOT (FASSOC FL MSFILELST))
					  (NOT (FASSOC FL MSOPENFILES)))
				do (MSNOTICEFILE FL) 
                                                       (* Last chance: A file that only the database knows contains FN.)
				   (SETQ PRINTFLG T)
				   (GO OPEN))
			     (RETURN)
			 OPEN[SETQ FILE (CDAR (LISTP (GETP FL (QUOTE FILEDATES]
			     (COND
			       (PRINTFLG (LISPXPRIN1 "reading from " T)
					 (LISPXPRINT FILE T T)))
			     (OR [EQ FILE (CAR (SETQ MAP (GETPROP FL (QUOTE FILEMAP]
				 (GO LOADEFS))         (* Wrong map)
			     (OR (SETQ PRINTFLG (OPENP FILE (QUOTE INPUT)))
				 (XNLSETQ (SETQ FILE (INPUT (INFILE FILE)))
					  NOBREAK)
				 (RETURN))
			     [OR MSOPENFILES (RESETSAVE NIL (CONSTANT (LIST (FUNCTION MSCLOSEFILES]
			     (SETQ MSOPENFILES (CONS (CONS FL (CONS PRINTFLG MAP))
						     MSOPENFILES))
			     (GO RETRY)
			 LOADEFS
			     (RETURN (CADR (FASSOC FN (LOADEFS FN (OR FILE FL])

(MSNOTICEFILE
  [LAMBDA (FILE)                   (* lmm " 8-APR-81 00:01")
    (DECLARE (GLOBALVARS MSHASHFILENAME LOADDBFLG))
    (PROG (FULL COMS TEM)
      LP  (COND
	    ((SETQ TEM (FASSOC FILE MSFILELST))
                                   (* already noticed)
	      (RETURN TEM)))
          (OR COMS (SETQ COMS (FILECOMS FILE)))
          [SETQ FULL (INFILEP (COND
				([SETQ TEM (CDR (GETRELQ FILE (NAMEFIELD FILE]
                                   (* All but the version comes from the database)
				  (PACKFILENAME (QUOTE VERSION)
						NIL
						(QUOTE BODY)
						TEM))
				(T FILE]
          [COND
	    ((NOT (FMEMB FILE FILELST))
                                   (* two possibilities: either FILE is something like <LISP>FOO or it has not been 
				   loaded yet)
	      [COND
		((AND (NOT FULL)
		      (EQ FILE (NAMEFIELD FILE T)))
		  (COND
		    ((LISTP (GETATOMVAL COMS))
                                   (* dummy or new file since COMS set but not on filelst)
		      (GO DUMMY))
		    ((SETQ TEM (FIXSPELL FILE 70 FILELST))
		      (SETQ FILE TEM)
		      (GO LP]      (* either the file has never been loaded, or an explicit <FOO> was given)
	      (OR FULL (SETQ FULL (FINDFILE FILE))
		  (ERROR FILE "not found"))
	      [SETQ COMS (FILECOMS (SETQ FILE (NAMEFIELD FULL T]
	      (OR (AND [EQ FULL (CDAR (GETPROP FILE (QUOTE FILEDATES]
		       (LISTP (EVALV COMS)))
		  (COND
		    ((EQ (QUOTE Y)
			 (ASKUSER DWIMWAIT (QUOTE Y)
				  (LIST "should I LOADFROM" FULL)))
		      (RESETVARS [(LOADDBFLG (COND
					       (MSHASHFILENAME LOADDBFLG)
					       (T (QUOTE NO]
                                   (* Should bring the hashfile up-to-date if we are noticing the file)
			         (LOADFROM FULL)))
		    (T (ERROR!]
          [COND
	    ((EQ [CDAR (SETQ TEM (GETPROP FILE (QUOTE FILE]
		 (QUOTE Compiled))
                                   (* If only the compiled version of the file has been loaded, still want to know 
				   about GLOBALVARS or other things)
	      (LOADVARS (QUOTE ((DECLARE: -- DONTCOPY --)))
			(OR (AND (SETQ FULL (GETP FILE (QUOTE FILEDATES)))
				 (INFILEP (CDAR FULL)))
			    FILE))
	      (/RPLACD (CAR TEM)
		       (QUOTE COMPILED]
      DUMMY
          (RETURN (OR (FASSOC FILE MSFILELST)
		      (CAR (SETQ MSFILELST (CONS (CONS FILE COMS)
						 MSFILELST])

(MSSHOWUSE
  (LAMBDA (SHOWFN SHOWTYPE SHOWSET SHOWEDIT IFCANT EDITCOMS)
                                                            (* lmm "24-JAN-79 15:16")
    (PROG (DEF ANYFOUND)
          (COND
	    ((SETQ DEF (MSGETDEF SHOWFN IFCANT (EQ SHOWEDIT (QUOTE SHOW))))
	                                                    (* The SHOW command does not need to save)
	      (MSUPDATEFN1 SHOWFN DEF (LIST SHOWTYPE
					    (FUNCTION (LAMBDA (ITEM SS SE PRNT INCLISP)
						(COND
						  ((MSMEMBSET ITEM SS)
						    (COND
						      ((NOT ANYFOUND)
							(TAB 0 0 T)
							(PRIN2 SHOWFN)
							(PRIN1 " :
")))
						    (SETQ ANYFOUND
						      (CONS (CONS PRNT
								  (AND INCLISP
								       (NOT (MSFIND INCLISP PRNT))
								       INCLISP))
							    ANYFOUND))
						    (COND
						      ((AND (EQ SE (QUOTE SHOW))
							    (NOT (FASSOC PRNT (CDR ANYFOUND))))
							

          (* The EDIT command works by collecting a list of the expressions, and then doing a (*ORF* (= . lst1) 
	  (= . lst2)) -
	  if within a CLISP translation (determined by the binding of the INCLISP variable) then want to point at the CLISP if
	  the expression is not actually embedded in the expression)


							(SPACES 3)
							(LVLPRINT PRNT (OUTPUT)
								  2)
							(COND
							  ((CDAR ANYFOUND)
							    
                                                            (* This is under a clisp)
							    (PRIN1 "   {under ")
							    (LVLPRIN2 INCLISP (OUTPUT)
								      2)
							    (PRIN1 "}
")))))))))
					    SHOWSET SHOWEDIT)))
	    (T (printout T "Can't find a definition for " SHOWFN "!" T)
	       (RETURN)))
          (COND
	    ((NOT ANYFOUND)
	      (RETURN))
	    ((EQ SHOWEDIT (QUOTE EDIT))
	      (MAPC ANYFOUND (FUNCTION (LAMBDA (X)
			(FRPLNODE X (QUOTE ==)
				  (OR (CDR X)
				      (CAR X))))))
	      (SETQ ANYFOUND (CONS (QUOTE *ANY*)
				   ANYFOUND))
	      (PRINT (APPLY* (QUOTE EDITF)
			     SHOWFN
			     (LIST (QUOTE BIND)
				   (QUOTE (E (SETQ #1)
					     T))
				   (LIST (QUOTE F)
					 ANYFOUND T)
				   (LIST (QUOTE LPQ)
					 (LIST (QUOTE IF)
					       (QUOTE (NEQ (##)
							   #1))
					       (LIST (QUOTE (ORR (P)
								 NIL))
						     (QUOTE (S #1))
						     (COND
						       (EDITCOMS (CONS (QUOTE BIND)
								       EDITCOMS))
						       (T (QUOTE TTY:))))
					       NIL)
					 (LIST (QUOTE F)
					       ANYFOUND
					       (QUOTE N)))))
		     T T)))
          (RETURN T))))

(MSUPDATEFN1
  (LAMBDA (FN DEF EACHTIME DOSUBFNS)                        (* lmm "22-DEC-78 11:42")
                                                            (* Subfunction of UPDATEFN -- notices all of the "new" 
							    functions called by FN)
    (MSUPDATE FN DEF EACHTIME)
    (for X in (GETRELQ (CALL NOTERROR)
		       FN)
       when (NOT (TESTRELQ KNOWN X)) do (PROG (DEF)
					      (AND (SETQ DEF (MSGETDEF X 0 T))
						   (COND
						     (DOSUBFNS (MSUPDATEFN1 X DEF EACHTIME T))
						     (T (PUTHASH X T MSCHANGEDARRAY))))))))

(MSUPDATE
  [LAMBDA (FNNAME FNDEF EACHTIME)                           (* rmk: "21-NOV-79 10:30")
                                                            (* This is the main internal entry to the analysis 
							    routines.)
    (PROG (VARS ERS TEM PRFLG DATA)

          (* VARS is used to mark the CURRENT variables bound. INCLISP and EACHTIME need to be bound by ADDTO which checks to 
	  see if we are in a SHOW or EDIT)


          (MSNLAMBDACHECK FNNAME)
          [COND
	    ([OR (EQ DWIMIFYCOMPFLG T)
		 (EQ CLISPIFYPRETTYFLG T)
		 (EQ (CAR (SETQ TEM (CADDR FNDEF)))
		     (QUOTE CLISP:))
		 (AND (EQ (CAR TEM)
			  COMMENTFLG)
		      (EQ (CADR TEM)
			  (QUOTE DECLARATIONS:)))
		 (NOT (FMEMB (CAR FNDEF)
			     (QUOTE (LAMBDA NLAMBDA]
	                                                    (* Check if the whole definition needs to be DWIMIFIED)
	      (PROG (VARS)
		    (MSPRGDWIM FNDEF FNNAME FNDEF]
          [COND
	    ((NOT EACHTIME)
	      (COND
		((OR (EQ MSPRINTFLG T)
		     (AND (FIXP MSPRINTFLG)
			  (NOT (IGREATERP (SETQ MSPRINTCNT (SUB1 MSPRINTCNT))
					  0))
			  (SETQ MSPRINTCNT MSPRINTFLG)))
		  (SETQ PRFLG (PRIN2 FNNAME T)))
		((EQ MSPRINTFLG (QUOTE %.))
		  (PRIN1 (QUOTE %.)
			 T]
          (SETQ DATA (ALLCALLS FNDEF (QUOTE ARG)
			       NIL FNNAME T EACHTIME))
          (for F in ANALYZEUSERFNS do (SETQ DATA (APPLY* F FNNAME FNDEF DATA)))
          [SETQ ERS (FMEMB MSERRORFN (CDR (FASSOC (QUOTE ERRORS)
						  DATA]
          [SELECTQ MSPRINTFLG
		   (NIL)
		   (%. (AND ERS (PRIN1 (QUOTE ?)
				       T)))
		   (PROGN [OR PRFLG (COND
				((OR ERS (AND EACHTIME (NOT ANYFOUND)))
				  (SETQ PRFLG (PRIN2 FNNAME T]
                                                            (* always print if errors)
			  (COND
			    (ERS (PRIN1 " (CALLS ppe)" T)))
			  (AND PRFLG (PRIN1 (QUOTE ", ")
					    T]
          (MSSTOREDATA FNNAME DATA])

(MSNLAMBDACHECK
  (LAMBDA (FN)                                              (* lmm "22-DEC-78 13:11")
    (COND
      ((AND (NOT (TEMPLATE FN T))
	    (SETQ FN (COND
		((NLAMBDAFNP FN)
		  (SUBSET (GETRELQ (CALL DIRECTLY)
				   FN T)
			  (FUNCTION (LAMBDA (FN2)           (* the set of functions which call this one, but don't 
							    call it as an nlambda)
			      (NOT (FMEMB FN (GETRELQ (CALL NLAMBDA)
						      FN2)))))))
		(T                                          (* someone calls it as an NLAMBDA)
		   (GETRELQ (CALL NLAMBDA)
			    FN T))))
	    (MSMARKCHANGE1 FN))))))

(MSCOLLECTDATA
  [LAMBDA (TNAME FLG)              (* lmm "30-OCT-80 10:00")
    (COND
      ((LISTP TNAME)
	(SELECTQ (CAR TNAME)
		 (- (LDIFFERENCE (MSCOLLECTDATA (CADR TNAME)
						T)
				 (MSCOLLECTDATA (CADDR TNAME)
						T)))
		 (+ (UNION (MSCOLLECTDATA (CADR TNAME)
					  T)
			   (MSCOLLECTDATA (CADDR TNAME)
					  T)))
		 (SHOULDNT 2)))
      (T (PROG NIL
	       (RETURN (MSCOLLECTDATA (CADR (OR (AND (NULL FLG)
						     (FASSOC TNAME TABLE.TO.NOTICED))
						(RETURN (CDR (FASSOC TNAME FNDATA])
)
(DEFINEQ

(UPDATECHANGED
  (LAMBDA NIL                                               (* lmm "16-JUL-78 05:07")
                                                            (* Update all functions marked as changed)
    (MSINIT)
    (MAPHASH MSCHANGEDARRAY (FUNCTION UPDATECHANGED1))
    NIL))

(UPDATECHANGED1
  (LAMBDA (VAL KEY)                                         (* lmm "20-JAN-79 13:47")
    (COND
      ((OR (EQ VAL T)
	   (TESTRELQ KNOWN KEY)
	   (TESTRELQ (CALL NOTERROR)
		     KEY T))
	(COND
	  ((SETQ VAL (MSGETDEF KEY NIL T))
	    (MSUPDATEFN1 KEY VAL NIL T))
	  (T (printout T KEY " disappeared!" T)
	     (MSERASE (LIST KEY)))))
      (T (PUTHASH KEY NIL MSCHANGEDARRAY)))))
)

(RPAQQ TABLE.TO.NOTICED ((BIND (- (- (- (- (+ BIND ARG)
					   REF)
					SMASH)
				     SET)
				  TEST))
			 (REFFREE (- (- (- REFFREE SETFREE)
					SMASHFREE)
				     TESTFREE))
			 (REF (- (- (- REF SET)
				    SMASH)
				 TEST))
			 (PREDICATE (- PREDICATE CALL))
			 (EFFECT (- (- EFFECT CALL)
				    PREDICATE))
			 (CALL (- CALL NLAMBDA))
			 (0 TYPE)
			 (APPLY (+ APPLY STACK))
			 (ARGS ARG)))
(DEFINEQ

(MSCLOSEFILES
  (LAMBDA NIL                                               (* lmm "24-JUN-78 17:18")
                                                            (* this is RESETSAVE'd from MSGETDEF to close any files 
							    that MSGETDEF leaves open)
    (for X in MSOPENFILES when (AND (NOT (CADR X))
				    (OPENP (CADDR X)))
       do (CLOSEF (CADDR X)))
    (SETQ MSOPENFILES)))
)

(RPAQQ MSFILELST NIL)

(RPAQQ MSOPENFILES NIL)

(RPAQQ MSPRINTFLG %.)

(RPAQQ MSPRINTCNT 0)

(ADDTOVAR MSHASHFILENAME )

(ADDTOVAR ANALYZEUSERFNS )

(RPAQQ MSAUXCOMS ((* things which are not in the "main stream" of MASTERSCOPE)
		  (COMS (* Describe command)
			(FNS MSDESCRIBE MSDESCRIBE1 FMAPRINT)
			(ADDVARS (DESCRIBELST))
			(GLOBALVARS DESCRIBELST))
		  (COMS (* Print help file)
			(FNS MSPRINTHELPFILE)
			(VARS MSHELPFILE))
		  (COMS (* templates - export TEMPLATE GETTEMPLATE SETTEMPLATE)
			(FNS TEMPLATE GETTEMPLATE SETTEMPLATE)
			(FILEPKGCOMS TEMPLATES))))



(* things which are not in the "main stream" of MASTERSCOPE)




(* Describe command)

(DEFINEQ

(MSDESCRIBE
  [LAMBDA (FN SN)                                            (* lmm "20-Jul-84 15:06")
                                                             (* Prints function name, arguments, local and free 
							     variables. etc)
    (DECLARE (SPECVARS FN))                                  (* Make FN available to user DESCRIBELST forms)
    (PROG (GLOBALS FREES ARGS LINE)
          [SETQ ARGS (COND
	      ((SETQ ARGS (GETRELQ ARGS FN))                 (* The args in the argtable have precedence, even if the
							     function is resident, cause they correspond to what was 
							     actually analyzed.)
                                                             (* T is for an arglist of NIL)
		(AND (NEQ ARGS T)
		     ARGS))
	      ((GETD FN)
		(SMARTARGLIST FN))
	      (T (CADR (MSGETDEF FN NIL T T]
          (printout NIL "(" .FONT BOLDFONT .P2 FN .FONT DEFAULTFONT)
          (FMAPRINT ARGS NIL " " ")")
          (OR (TESTRELQ KNOWN FN)
	      (PRIN1 " (not analyzed)" T))
          (COND
	    ([AND [OR (HARRAYP SN)
		      (HARRAYP (CAR (LISTP SN]
		  (SMALLP (SETQ LINE (GETHASH FN SN]
	      (TAB 45 T)
	      (PRIN1 " {line ")
	      (PRIN1 (ABS LINE))
	      (PRIN1 "}")))
          (TERPRI)
          (MSDESCRIBE1 (GETRELQ (CALL NOTERROR)
				FN)
		       (QUOTE "calls:    "))
          (MSDESCRIBE1 (GETRELQ (CALL NOTERROR)
				FN T)
		       (QUOTE "called by:"))
          (MSDESCRIBE1 (for VAR in (GETRELQ BIND FN) when (NOT (EQMEMB VAR ARGS)) collect VAR)
		       (QUOTE "binds:    "))
          [for VAR in (GETRELQ (USE FREELY)
			       FN)
	     do (COND
		  ((OR (FMEMB VAR GLOBALVARS)
		       (GETPROP VAR (QUOTE GLOBALVAR)))
		    (SETQ GLOBALS (CONS VAR GLOBALS)))
		  (T (SETQ FREES (CONS VAR FREES]
          (MSDESCRIBE1 FREES (QUOTE "uses free:"))
          (MSDESCRIBE1 GLOBALS (QUOTE "globals:  "))
          (MSDESCRIBE1 (GETRELQ (USE FIELDS)
				FN)
		       (QUOTE "fields:   "))
          (for D L in DESCRIBELST when (SETQ L (EVAL (CADR D))) do (MSDESCRIBE1 L (CAR D)))
          (TERPRI])

(MSDESCRIBE1
  (LAMBDA (LST STR)                                         (* lmm " 9-AUG-77 04:45")
                                                            (* lmm: 15 NOV 75 2248)
    (COND
      (LST (SPACES 2)
	   (PRIN1 STR)
	   (SPACES 1)
	   (PROG (LL P)
	         (COND
		   ((NULL LST)
		     (GO EXIT))
		   ((NLISTP LST)
		     (PRIN2 LST)
		     (GO EXIT)))
	         (SETQ LL (LINELENGTH))
	         (SETQ P (POSITION))
	     LP  (COND
		   ((IGREATERP (IPLUS (POSITION)
				      5
				      (NCHARS (CAR LST)))
			       LL)
		     (TAB P)))
	         (PRIN2 (CAR LST))
	         (COND
		   ((NULL (SETQ LST (CDR LST)))
		     (GO EXIT)))
	         (PRIN1 (QUOTE ,))
	         (GO LP)
	     EXIT(TERPRI))))))

(FMAPRINT
  (LAMBDA (LST FILE LEFT RIGHT SEP)                         (* lmm: 28 OCT 75 757)
    (PROG NIL
          (AND LEFT (PRIN1 LEFT FILE))
          (OR SEP (SETQ SEP (QUOTE % )))
          (COND
	    ((NULL LST)
	      (GO EXIT))
	    ((NLISTP LST)
	      (PRIN2 LST)
	      (GO EXIT)))
      LP  (PRIN2 (CAR LST)
		 FILE)
          (COND
	    ((NULL (SETQ LST (CDR LST)))
	      (GO EXIT)))
          (PRIN1 SEP FILE)
          (GO LP)
      EXIT(AND RIGHT (PRIN1 RIGHT FILE)))))
)

(ADDTOVAR DESCRIBELST )
(DECLARE: DOEVAL@COMPILE DONTCOPY

(GLOBALVARS DESCRIBELST)
)



(* Print help file)

(DEFINEQ

(MSPRINTHELPFILE
  (LAMBDA NIL                                               (* lmm "20-JAN-79 13:48")
    (PROG (FL)
          (SETQ FL (OR (INFILEP MSHELPFILE)
		       (RETURN (PROGN (printout T "Sorry, HELP file not available!" T)
				      NIL))))
          (SETQ FL (INPUT (INFILE FL)))
          (RESETSAVE NIL (LIST (QUOTE CLOSEF)
			       FL))
          (COPYBYTES FL T 0 (GETEOFPTR FL)))))
)

(RPAQQ MSHELPFILE <LISP>MASTERSCOPE.SYNTAX)



(* templates - export TEMPLATE GETTEMPLATE SETTEMPLATE)

(DEFINEQ

(TEMPLATE
  (LAMBDA (FN TEMPLATE FLG)                                 (* lmm "23-DEC-78 14:06")

          (* MSTEMPLATES is the hash table for pre-defined templates. USERTEMPLATES contains user defined templates.
	  The split is so that DUMPDATABASE can dump the templates as well -
	  check for MSDATABASE is so CALLS doesn't need to init database)


    (PROG ((OLD (OR (GETHASH FN USERTEMPLATES)
		    (GETHASH FN MSTEMPLATES))))
          (COND
	    ((EQ OLD T)
	      (SETQ OLD)))
          (COND
	    ((AND (NOT (EQUAL TEMPLATE OLD))
		  (NEQ TEMPLATE T))
	      (COND
		((NOT FLG)
		  (AND FILEPKGFLG (MARKASCHANGED FN (QUOTE TEMPLATES)
						 (NOT (NULL OLD))))
		  (AND MSDATABASELST (MSMARKCHANGED (GETRELATION FN (QUOTE (CALL DIRECTLY))
								 T)
						    (QUOTE FNS)))))
	      (PUTHASH FN (COND
			 ((NLISTP TEMPLATE)
			   (SELECTQ TEMPLATE
				    (MACRO TEMPLATE)
				    (NIL (AND (GETHASH FN MSTEMPLATES)
					      T))
				    (ERROR TEMPLATE "Invalid template")))
			 (T TEMPLATE))
		       USERTEMPLATES)))
          (RETURN OLD))))

(GETTEMPLATE
  (LAMBDA (FN)                                              (* lmm " 9-AUG-77 06:20")
    (SETTEMPLATE FN T)))

(SETTEMPLATE
  (LAMBDA (FN TEMPLATE)                                     (* lmm "16-FEB-78 14:56")
    (PROG ((OLD (COPY (TEMPLATE FN (COND
				  ((NLISTP TEMPLATE)
				    (SELECTQ TEMPLATE
					     (EVAL (QUOTE (CALL .. EVAL)))
					     ((NIL T MACRO)
					       TEMPLATE)
					     (ERROR TEMPLATE "Invalid template")))
				  (T (SELECTQ (CAR TEMPLATE)
					      (MACRO TEMPLATE)
					      (! (CDR TEMPLATE))
					      (CONS (QUOTE CALL)
						    (AND (OR (CAR TEMPLATE)
							     (CDR TEMPLATE))
							 TEMPLATE))))))))
	   VAL)
          (SETQ VAL (COND
	      ((NLISTP OLD)
		OLD)
	      (T (SELECTQ (CAR OLD)
			  (MACRO OLD)
			  (CALL (OR (CDR OLD)
				    (CONS)))
			  (CONS (QUOTE !)
				OLD)))))
          (OR (EQ TEMPLATE T)
	      (AND LISPXHIST (UNDOSAVE (LIST (QUOTE SETTEMPLATE)
					     FN OLD))))
          (RETURN VAL))))
)
(PUTDEF (QUOTE TEMPLATES) (QUOTE FILEPKGCOMS) (QUOTE
						((COM
						   MACRO
						   [X (P * (MAPCAR (QUOTE X)
								   (FUNCTION
								     (LAMBDA
								       (FN)
								       (LIST (QUOTE SETTEMPLATE)
									     (KWOTE FN)
									     (KWOTE (GETTEMPLATE
										      FN]
						   CONTENTS NILL)
						 (TYPE DESCRIPTION "masterscope templates"))))

(RPAQQ MSDBCOMS [(* functions for manipulating the data base)
		 (FNS MSMARKCHANGE1 MSINIT GETVERBTABLES MSSTOREDATA STORETABLE)
		 (ADDVARS (MSCHANGEDARRAY)
			  (MSDATABASELST))
		 (INITVARS (MSDBEMPTY T))
		 (VARS MSDATABASEINIT NODUMPRELATIONS)
		 (FNS PARSERELATION PARSERELATION1 GETRELATION MAPRELATION TESTRELATION)
		 [COMS (* table lookup functions)
		       (FNS ADDHASH SUBHASH MAKEHASH MSREHASH EQMEMBHASH)
		       [P (MAPC (QUOTE ((GETHASH GETTABLE)
					(GETHASH TESTTABLE)
					(PUTHASH PUTTABLE)
					(ADDHASH ADDTABLE)
					(SUBHASH SUBTABLE)
					(MAPHASH MAPTABLE)
					(MAKEHASH MAKETABLE)
					(EQMEMBHASH EQMEMBTABLE)))
				(FUNCTION (LAMBDA (X)
						  (MOVD? (CAR X)
							 (CADR X]
		       (DECLARE: EVAL@COMPILE DONTCOPY (FNS MSVBTABLES))
		       (DECLARE: DONTCOPY (MACROS GETRELQ TESTRELQ))
		       (BLOCKS (NIL ADDHASH SUBHASH MAKEHASH MSREHASH MSVBTABLES (LOCALVARS . T]
		 (COMS (* erase function)
		       (FNS MSERASE))
		 (COMS (* dump data base)
		       (FNS DUMPDATABASE DUMPDATABASE1 READATABASE)
		       (VARS DATABASECOMS))
		 (ADDVARS (GAINSPACEFORMS (MSDATABASELST "erase current Masterscope database"
							 (%. ERASE])



(* functions for manipulating the data base)

(DEFINEQ

(MSMARKCHANGE1
  [LAMBDA (FNS FLG)                                    (* rmk: "19-FEB-81 14:53")

          (* mark the selected functions as "changed" -
	  FLG=T in MSCHANGEDARRAY means to complain if the definition can't be found, 0 means give up quietly.)


    (OR FLG (SETQ FLG T))
    (for FN inside FNS do (PUTHASH FN FLG MSCHANGEDARRAY))

          (* This isn't undone by simply restoring the pevious entry in the hash array because the user might have asked a question that caused 
	  the functions to be reanalyzed. Against this possibility, we "undo" by re-marking the functions for reanalysis.)


    (UNDOSAVE (LIST (FUNCTION MSMARKCHANGE1)
		    FNS FLG])

(MSINIT
  [LAMBDA (DATABASE)                                         (* rmk: " 3-Jan-84 21:31")
                                                             (* This function should be called at the beginning of 
							     any function which accesses the data base)
    (COND
      ((OR (NULL MSDATABASELST)
	   (LISTP DATABASE))
	(SETQ MSDATABASELST)
	(SETQ MSCHANGEDARRAY (HASHARRAY 20))

          (* MSDATABASEINIT is a pattern for how the data base list should look. The data base is stored in multiple hash 
	  tables. These hash tables are pointed to both by a list, MSDATABASELST which is an a-list of 
	  (TableName ForwardTable . BackTable) while the array, MSDATABASE, is an array of the same length as the list, with
	  ELT's the forward htables, and ELTD's the back tables.)


	(OR DATABASE (SETQ MSDBEMPTY))
	[SETQ MSDATABASELST (for X in MSDATABASEINIT
			       collect (CONS (CAR X)
					     (CONS [OR (CADR (ASSOC (CAR X)
								    DATABASE))
						       (SELECTQ (CAR X)
								(USERTEMPLATES USERTEMPLATES)
								(MAKETABLE (CADR X)
									   (CAR X]
						   (COND
						     ((FIXP (CDDR X))
						       (OR (CDDR (ASSOC (CAR X)
									DATABASE))
							   (MAKETABLE (CDDR X)
								      (CAR X)
								      T)))
						     (T (CDDR X]
	(SETQ MSFILETABLE (ASSOC (QUOTE FILE)
				 MSDATABASELST))
	(SETQ MSARGTABLE (ASSOC (QUOTE ARGS)
				MSDATABASELST))
	T])

(GETVERBTABLES
  (LAMBDA (ROOT MODIFIER)                                   (* lmm "28-FEB-79 16:08")
    (for Y in (OR (MSVBTABLES ROOT MODIFIER)
		  (SHOULDNT 3))
       collect (COND
		 ((LISTP Y)
		   (LIST (CDDR (FASSOC (CAR Y)
				       MSDATABASELST))))
		 (T (CDR (FASSOC Y MSDATABASELST)))))))

(MSSTOREDATA
  [LAMBDA (FNNAME FNDATA)          (* lmm " 1-JUN-81 23:19")
    (PROG [NEWREL (KWN (PARSERELATION (QUOTE KNOWN]
          (SETQ MSDBEMPTY NIL)     (* Database for FNNAME about to become inconsistant -
				   mark it as changed)
          (PUTHASH FNNAME T MSCHANGEDARRAY)

          (* * Now update the database)


          (for TAB in MSDATABASELST when (AND (NOT (FMEMB (CAR TAB)
							  NODUMPRELATIONS))
					      (NEQ (CDDR TAB)
						   T))
	     do (SETQ NEWREL (MSCOLLECTDATA (CAR TAB)))
		(STORETABLE FNNAME TAB NEWREL))
          [OR (TESTRELATION FNNAME KWN)
	      (PUTTABLE FNNAME T (CADR (FASSOC (QUOTE NOBIND)
					       MSDATABASELST]

          (* Table NOBIND is for those functions which don't do very much. The idea is that the test that a function has been 
	  analyzed is whether it binds variables are calls functions, etc. However, for those functions which have no such 
	  entries, (e.g. their definition is (LAMBDA NIL NIL)) need to still be able to know that they were.)


          (PUTHASH FNNAME NIL MSCHANGEDARRAY])

(STORETABLE
  [LAMBDA (KEY TABLST VALUE)       (* lmm "10-APR-81 08:46")
    (PROG [(OLDREL (GETTABLE KEY (CADR TABLST]
          (PUTTABLE KEY VALUE (CADR TABLST))
          (COND
	    ((CDDR TABLST)
	      (for Z in VALUE do 

          (* Used to test here (NOT (EQMEMB Z OLDREL)) but occasionally found the data base was out of synch & A calls B but B
	  doesn't show being called by A; thus we always add KEY to Z's back pointers (nothing will be done if it is already 
	  there))


				 (ADDTABLE Z KEY (CDDR TABLST)))
	      (for Z in OLDREL do 
                                   (* However, we must rely on the previous value to tell who values must be DELETED
				   from)
				  (AND (NOT (FMEMB Z VALUE))
				       (SUBTABLE Z KEY (CDDR TABLST])
)

(ADDTOVAR MSCHANGEDARRAY )

(ADDTOVAR MSDATABASELST )

(RPAQ? MSDBEMPTY T)

(RPAQQ MSDATABASEINIT ((CALL 25 . 50)
		       (BIND 10 . 10)
		       [NLAMBDA 10 . 10]
		       (NOBIND 10)
		       (RECORD 20 . 10)
		       (CREATE 2 . 2)
		       (FETCH 10 . 10)
		       (REPLACE 10 . 10)
		       (REFFREE 10 . 1)
		       (REF 10 . 25)
		       (SETFREE 1 . 1)
		       (SET 20 . 30)
		       (SMASHFREE 1 . 1)
		       (SMASH 1 . 1)
		       (PROP 1 . 1)
		       (TEST 1 . 1)
		       (TESTFREE 1 . 1)
		       (PREDICATE 10 . 10)
		       (EFFECT 10 . 10)
		       (CLISP 10 . 10)
		       (SPECVARS 10 . 10)
		       (LOCALVARS 10 . 10)
		       (APPLY 10 . 10)
		       (ERROR 10 . 10)
		       (LOCALFREEVARS 10 . 10)
		       (CONTAINS 10 . 10)
		       (FILE 10)
		       (ARGS 10)
		       (USERTEMPLATES NIL . T)
		       (0 10 . 10)))

(RPAQQ NODUMPRELATIONS (CONTAINS FILE))
(DEFINEQ

(PARSERELATION
  (LAMBDA (RELATION)                                        (* lmm "31-DEC-78 15:26")
    (MSINIT)
    (COND
      ((EQ (CAR RELATION)
	   (QUOTE TABLES))
	RELATION)
      (T (CONS (QUOTE TABLES)
	       (for Y in (PARSERELATION1 RELATION) collect (COND
							     ((LISTP Y)
							       (CDR (CDR (FASSOC (CAR Y)
										 MSDATABASELST))))
							     (T (CDR (FASSOC Y MSDATABASELST))))))))))

(PARSERELATION1
  (LAMBDA (ROOT MOD TAIL)                                   (* lmm "30-DEC-78 17:06")
    (COND
      (TAIL (APPLY* (SELECTQ (CAR TAIL)
			     (ANDNOT (FUNCTION LDIFFERENCE))
			     (AND (COND
				    ((EQ (CADR TAIL)
					 (QUOTE NOT))
				      (SETQ TAIL (CDR TAIL))
				      (FUNCTION LDIFFERENCE))
				    (T (FUNCTION INTERSECTION))))
			     (OR (FUNCTION UNION))
			     (ERROR TAIL (QUOTE ?)))
		    (PARSERELATION1 ROOT MOD)
		    (PARSERELATION1 (CADR TAIL)
				    (CDDR TAIL))))
      ((LISTP ROOT)
	(PARSERELATION1 (CAR ROOT)
			(CDR ROOT)))
      ((LISTP MOD)
	(SELECTQ (CAR MOD)
		 ((A AS AN FOR)
		   (PARSERELATION1 ROOT (CDR MOD)))
		 ((AND OR ANDNOT)
		   (PARSERELATION1 ROOT NIL MOD))
		 (PARSERELATION1 ROOT (CAR MOD)
				 (CDR MOD))))
      (T (OR (MSVBTABLES ROOT MOD)
	     (MSVBTABLES (GETWORDTYPE ROOT (QUOTE S))
			 (CAR (OR (GETWORDTYPE MOD (QUOTE V))
				  (GETWORDTYPE MOD (QUOTE AS))
				  (GETWORDTYPE MOD (QUOTE FOR))
				  (ERROR MOD (QUOTE ?)))))
	     (ERROR ROOT (QUOTE ?)))))))

(GETRELATION
  (LAMBDA (ITEM RELATION INVERTED)                          (* lmm "25-JUN-78 00:39")
    (PROG (VAL)
          (for TABLE in (CDR (COND
			       ((EQ (CAR RELATION)
				    (QUOTE TABLES))
				 RELATION)
			       (T (PARSERELATION RELATION))))
	     do (SETQ VAL (UNION (GETTABLE ITEM (COND
					     (INVERTED (COND
							 ((LITATOM (CDR TABLE))
							   (ERROR RELATION "CAN'T BE INVERTED")))
						       (CDR TABLE))
					     (T (CAR TABLE))))
				 VAL)))
          (RETURN VAL))))

(MAPRELATION
  (LAMBDA (RELATION MAPFN)                                  (* lmm "21-SEP-78 04:20")
    (DECLARE (SPECVARS MAPZ MAPW MAPFN2 MAPFN))
    (PROG ((MAPZ (NARGS MAPFN))
	   (MAPW (PARSERELATION RELATION)))
          (MAP (CDR MAPW)
	       (FUNCTION (LAMBDA (MAPFN2)
		   (MAPTABLE (CAAR MAPFN2)
			     (FUNCTION (LAMBDA (DUMMY MAPX)
				 (OR (SOME (CDR MAPFN2)
					   (FUNCTION (LAMBDA (HT2)
					       (TESTTABLE MAPX (CAR HT2)))))
				     (COND
				       ((EQ MAPZ 1)
					 (APPLY* MAPFN MAPX))
				       (T (MAPC (GETRELATION MAPX MAPW)
						(FUNCTION (LAMBDA (Z)
						    (APPLY* MAPFN MAPX Z))))))))))))))))

(TESTRELATION
  (LAMBDA (ITEM RELATION ITEM2 INVERTED)                    (* lmm "25-JUN-78 01:16")
    (AND (SOME (CDR (COND
		      ((EQ (CAR RELATION)
			   (QUOTE TABLES))
			RELATION)
		      (T (PARSERELATION RELATION))))
	       (FUNCTION (LAMBDA (TABLE)
		   (COND
		     (ITEM2 (FMEMB ITEM2 (GETTABLE ITEM (COND
						     (INVERTED (CDR TABLE))
						     (T (CAR TABLE))))))
		     (T (TESTTABLE ITEM (COND
				     (INVERTED (CDR TABLE))
				     (T (CAR TABLE)))))))))
	 T)))
)



(* table lookup functions)

(DEFINEQ

(ADDHASH
  (LAMBDA (ITEM VAL ARRAY)                                  (* lmm "10-JUL-78 03:03")
                                                            (* Add VAL to the hash-key of ITEM in ARRAY)
    (PROG ((OV (GETHASH ITEM ARRAY)))
          (COND
	    (OV (OR (FMEMB VAL OV)
		    (NCONC1 OV VAL)))
	    (T (PUTHASH ITEM (LIST VAL)
			ARRAY))))))

(SUBHASH
  (LAMBDA (ITEM VAL ARRAY)                                  (* lmm "10-JUL-78 03:03")
    (PROG ((OV (GETHASH ITEM ARRAY)))
          (AND OV (OR (DREMOVE VAL OV)
		      (PUTHASH ITEM NIL ARRAY))))))

(MAKEHASH
  [LAMBDA (N)                                                (* rmk: " 3-Jan-84 21:31")
    (HASHARRAY N (FUNCTION MSREHASH])

(MSREHASH
  [LAMBDA (HA)                                               (* rmk: "30-Dec-83 11:45")

          (* The hash tables in the database rehash using this algorithm; they increase size by 25% + 50 This insures that 
	  even though some tables start out small (e.g. 1 or 2 elements) they will rehash to larger ones.)


    (IPLUS (IQUOTIENT (ITIMES 5 (HARRAYSIZE HA))
		      4)
	   50])

(EQMEMBHASH
  [LAMBDA (X V H)                  (* rmk: "10-JUN-79 21:00")
                                   (* Provided in case MSHASH is loaded without MSSWAP)
    (MEMB V (GETHASH X H])
)
[MAPC (QUOTE ((GETHASH GETTABLE)
	      (GETHASH TESTTABLE)
	      (PUTHASH PUTTABLE)
	      (ADDHASH ADDTABLE)
	      (SUBHASH SUBTABLE)
	      (MAPHASH MAPTABLE)
	      (MAKEHASH MAKETABLE)
	      (EQMEMBHASH EQMEMBTABLE)))
      (FUNCTION (LAMBDA (X)
			(MOVD? (CAR X)
			       (CADR X]
(DECLARE: EVAL@COMPILE DONTCOPY 
(DEFINEQ

(MSVBTABLES
  [LAMBDA (VERB MOD)               (* lmm " 7-APR-81 23:44")
    [COND
      ((LISTP VERB)
	(SETQ MOD (CADR VERB))
	(SETQ VERB (CAR VERB]
    (MKLIST (SELECTQ VERB
		     (BIND (SELECTQ MOD
				    (NIL (QUOTE (BIND REF SET SMASH TEST)))
				    (NOTUSE (QUOTE BIND))
				    NIL))
		     (CALL (SELECTQ MOD
				    (DIRECTLY (QUOTE (CALL EFFECT PREDICATE NLAMBDA)))
				    (EFFECT (QUOTE EFFECT))
				    (INDIRECTLY (QUOTE APPLY))
				    (NIL (QUOTE (APPLY CALL EFFECT ERROR PREDICATE NLAMBDA)))
				    (NOTERROR (QUOTE (APPLY CALL EFFECT PREDICATE NLAMBDA)))
				    (PREDICATE (QUOTE PREDICATE))
				    (TESTING (QUOTE PREDICATE))
				    (VALUE (QUOTE (CALL NLAMBDA)))
				    [NLAMBDA (QUOTE NLAMBDA]
				    NIL))
		     (CREATE (SELECTQ MOD
				      (NIL (QUOTE CREATE))
				      NIL))
		     (DECLARE (SELECTQ MOD
				       (LOCALLY (QUOTE LOCALVARS))
				       (LOCALVARS (QUOTE LOCALVARS))
				       (NIL (QUOTE (LOCALVARS SPECVARS)))
				       (SPECVARS (QUOTE SPECVARS))
				       NIL))
		     (FETCH (SELECTQ MOD
				     (NIL (QUOTE FETCH))
				     NIL))
		     (IS (SELECTQ MOD
				  [FIELDS (QUOTE ((FETCH)
						   (REPLACE]
				  [FNS (QUOTE (CALL NOBIND REF (CALL)
						    (APPLY]
				  (KNOWN (QUOTE (CALL NOBIND REF)))
				  [NIL (QUOTE (CALL NOBIND REF (CALL)
						    (BIND)
						    (REFFREE)
						    (REF)
						    (SETFREE)
						    (SET)
						    (SMASHFREE)
						    (SMASH)
						    (RECORDS)
						    (FETCH)
						    (REPLACE)
						    (PROP)
						    (APPLY)
						    (TEST)
						    (TESTFREE]
				  [PROPS (QUOTE ((PROP]
				  [RECORDS (QUOTE ((RECORD)
						    (CREATE]
				  [VARS (QUOTE ((BIND)
						 (REFFREE)
						 (REF)
						 (SETFREE)
						 (SET)
						 (SMASHFREE)
						 (SMASH)
						 (TEST)
						 (TESTFREE]
				  [TYPE (QUOTE ((0]
				  NIL))
		     (KNOWN (SELECTQ MOD
				     (NIL (QUOTE (CALL NOBIND REF)))
				     NIL))
		     (PROG (SELECTQ MOD
				    (NIL (QUOTE PROG))
				    NIL))
		     (REFERENCE (SELECTQ MOD
					 (FIELDS (QUOTE FETCH))
					 (FREELY (QUOTE (REFFREE TESTFREE SMASHFREE)))
					 (LOCALLY (QUOTE (REF TEST SMASH)))
					 (NIL (QUOTE (REF REFFREE TEST TESTFREE SMASH SMASHFREE)))
					 NIL))
		     (REPLACE (SELECTQ MOD
				       (NIL (QUOTE REPLACE))
				       NIL))
		     (SET (SELECTQ MOD
				   (FIELDS (QUOTE REPLACE))
				   (FREELY (QUOTE SETFREE))
				   (LOCALLY (QUOTE SET))
				   (NIL (QUOTE (SET SETFREE)))
				   NIL))
		     (SMASH (SELECTQ MOD
				     (FIELDS (QUOTE REPLACE))
				     (FREELY (QUOTE SMASHFREE))
				     (LOCALLY (QUOTE SMASH))
				     (NIL (QUOTE (SMASH SMASHFREE)))
				     NIL))
		     (TEST (SELECTQ MOD
				    (FREELY (QUOTE TESTFREE))
				    (LOCALLY (QUOTE TEST))
				    (NIL (QUOTE (TEST TESTFREE)))
				    NIL))
		     (USE (SELECTQ MOD
				   (FIELDS (QUOTE (FETCH REPLACE)))
				   (FREELY (QUOTE (REFFREE SETFREE SMASHFREE TESTFREE)))
				   (I.S.OPRS (QUOTE CLISP))
				   (INDIRECTLY (QUOTE LOCALFREEVARS))
				   (LOCALLY (QUOTE (REF SET SMASH TEST)))
				   (NIL (QUOTE (REF REFFREE SET SETFREE SMASH SMASHFREE TEST TESTFREE)
					       ))
				   (PREDICATE (QUOTE (TEST TESTFREE)))
				   (PROPNAMES (QUOTE PROP))
				   (RECORDS (QUOTE (CREATE RECORD)))
				   (TESTING (QUOTE (TEST TESTFREE)))
				   (VALUE (QUOTE (REF REFFREE SMASH SMASHFREE)))
				   (TYPE (QUOTE 0))
				   NIL))
		     VERB])
)
)
(DECLARE: DONTCOPY 
(DECLARE: EVAL@COMPILE 

(PUTPROPS GETRELQ MACRO [X (PROG ([VAR (COND
					 ((LITATOM (CADR X))
					   (CADR X))
					 (T (QUOTE $$1]
				  FORM F1)
			         [for REL in (MSVBTABLES (CAR X))
				    do [SETQ F1 (LIST (QUOTE GETTABLE)
						      VAR
						      (LIST (COND
							      ((CADDR X)
								(QUOTE CDDR))
							      (T (QUOTE CADR)))
							    (LIST (QUOTE FASSOC)
								  (KWOTE REL)
								  (QUOTE MSDATABASELST]
				       (SETQ FORM (COND
					   (FORM (LIST (QUOTE UNION)
						       F1 FORM))
					   (T F1]
			         (RETURN (COND
					   ((EQ VAR (CADR X))
					     FORM)
					   (T (LIST (LIST (QUOTE LAMBDA)
							  (LIST VAR)
							  FORM)
						    (CADR X])

(PUTPROPS TESTRELQ MACRO [X (PROG ([VAR (COND
					  ((LITATOM (CADR X))
					    (CADR X))
					  (T (QUOTE $$1]
				   FORM)
			          [SETQ FORM (CONS (QUOTE OR)
						   (for REL in (MSVBTABLES (CAR X))
						      collect (LIST (QUOTE TESTTABLE)
								    VAR
								    (LIST (COND
									    ((CADDR X)
									      (QUOTE CDDR))
									    (T (QUOTE CADR)))
									  (LIST (QUOTE FASSOC)
										(KWOTE REL)
										(QUOTE MSDATABASELST]
			          (RETURN (COND
					    ((EQ VAR (CADR X))
					      FORM)
					    (T (LIST (LIST (QUOTE LAMBDA)
							   (LIST VAR)
							   FORM)
						     (CADR X])
)
)
[DECLARE: DONTEVAL@LOAD DOEVAL@COMPILE DONTCOPY
(BLOCK: NIL ADDHASH SUBHASH MAKEHASH MSREHASH MSVBTABLES (LOCALVARS . T))
]



(* erase function)

(DEFINEQ

(MSERASE
  [LAMBDA (ATOMS)                  (* lmm " 1-JUN-81 22:56")
    (DECLARE (SPECVARS ERASESET))
    (COND
      ((EQ ATOMS T)
	(SETQ MSCHANGEDARRAY)
	(SETQ MSDATABASELST)
	(SETQ MSFILETABLE)
	(SETQ MSARGTABLE)
	(SETQ MSDBEMPTY T))
      (T (for AT in ATOMS do (MSSTOREDATA AT])
)



(* dump data base)

(DEFINEQ

(DUMPDATABASE
  [LAMBDA (FNLST)                  (* lmm "12-APR-81 15:57")
    (PROG (DUMPEDFLG)
          (DECLARE (SPECVARS DUMPEDFLG DUMPTABLE))
          (COND
	    (FNLST (MAPC FNLST (FUNCTION UPDATEFN)))
	    (T (UPDATECHANGED)))
          (PRINT (QUOTE (READATABASE)))
          (PRIN1 (QUOTE %())
          (TERPRI)
          [for DUMPTABLE in MSDATABASELST when (NOT (MEMB (CAR DUMPTABLE)
							  NODUMPRELATIONS))
	     do (SETQ DUMPEDFLG NIL)
		[COND
		  ((OR (NOT FNLST)
		       (EQ (CDDR DUMPTABLE)
			   T))     (* either dumping everything, or this is a permanent table which should be dumped
				   in entirity (e.g. templates))
		    (MAPTABLE (CADR DUMPTABLE)
			      (FUNCTION DUMPDATABASE1)))
		  (T (MAPC FNLST (FUNCTION (LAMBDA (FN)
			       (DUMPDATABASE1 (GETTABLE FN (CADR DUMPTABLE))
					      FN]
		(COND
		  (DUMPEDFLG (PRINT]
          (TERPRI)
          (PRIN1 (QUOTE %)))
          (TERPRI])

(DUMPDATABASE1
  [LAMBDA (VALUE FN)                                        (* rmk: "24-OCT-79 10:02")
    (COND
      (FN (COND
	    ((NOT DUMPEDFLG)
	      (SETQ DUMPEDFLG (PRIN2 (CAR DUMPTABLE)))
	      (SPACES 1)))
	  (PRIN2 FN)
	  (SPACES 1)
	  (PRIN2 VALUE)
	  (SPACES 1])

(READATABASE
  [LAMBDA NIL                      (* lmm " 5-APR-81 19:39")
    [SELECTQ (RATOM)
	     ((%[ %())
	     (HELP (QUOTE (BAD DATABASE]
    (MSINIT)
    (SETQ MSDBEMPTY)
    (PROG (TAB FN NEWREL NAME)
          (while (SETQ NAME (READ)) do (SELECTQ NAME
						(USERTEMPLATES (while (SETQ FN (READ))
								  do (TEMPLATE FN (READ)
									       T)))
						(COND
						  ((SETQ TAB (FASSOC NAME MSDATABASELST))
						    (while (SETQ FN (READ))
						       do (PUTHASH FN T MSCHANGEDARRAY)
							  (SETQ NEWREL (MKLIST (READ)))
							  (STORETABLE FN TAB NEWREL)
							  (PUTHASH FN NIL MSCHANGEDARRAY)))
						  (T (LISPXPRINT (QUOTE (*** incompatible MASTERSCOPE 
									     data base))
								 T T)
						     (while (READ])
)

(RPAQQ DATABASECOMS ((E (DUMPDATABASE))))

(ADDTOVAR GAINSPACEFORMS (MSDATABASELST "erase current Masterscope database" (%. ERASE)))

(RPAQQ MSCHECKBLOCKSCOMS ((* blocks checker)
	(FNS MSCHECKBLOCKS MSCHECKBLOCK MSCHECKFNINBLOCK MSCHECKBLOCKBASIC MSCHECKBOUNDFREE 
	     GLOBALVARP PRINTERROR MSCHECKVARS1 UNECCSPEC NECCSPEC SPECVARP SHORTLST DOERROR)
	(BLOCKS (MSCHECKBLOCKS MSCHECKBLOCKS MSCHECKBLOCK MSCHECKFNINBLOCK MSCHECKBLOCKBASIC 
			       MSCHECKBOUNDFREE PRINTERROR MSCHECKVARS1 UNECCSPEC NECCSPEC SPECVARP 
			       SHORTLST DOERROR
			       (LOCALFREEVARS SEEN BLKFNS V ERRORS SFLG LF BLKAPPLYCALLERS U LF1 
					      SHOULDBESPECVARS)
			       (NOLINKFNS . T)
			       (SPECVARS SPECVARS LOCALVARS RETFNS BLKAPPLYFNS BLKLIBRARY NOLINKFNS 
					 LINKFNS LOCALFREEVARS DONTCOMPILEFNS ENTRIES)
			       (GLOBALVARS SYSLOCALVARS SYSSPECVARS FILELST MSCRATCHASH)
			       GLOBALVARP))))



(* blocks checker)

(DEFINEQ

(MSCHECKBLOCKS
  [LAMBDA (FILES)                                            (* bvm: "26-Mar-84 12:34")
    (PROG ((LOCALVARS SYSLOCALVARS)
	   (SPECVARS T)
	   FNS BLOCKS NOBLOCKFNS TEM)
          [COND
	    ((NULL FILES)
	      (SETQ FILES FILELST))
	    ((NLISTP FILES)
	      (SETQ FILES (OR (GETP FILES (QUOTE FILEGROUP))
			      (LIST FILES]
          [for FL in FILES
	     do (SETQ FL (CAR (MSNOTICEFILE FL)))
		(SETQ BLOCKS (NCONC (FILECOMSLST FL (QUOTE BLOCKS))
				    BLOCKS))
		(MAPC (SETQ TEM (FILEFNSLST FL))
		      (FUNCTION UPDATEFN))
		(SETQ FNS (NCONC TEM FNS))
		(COND
		  ((SETQ TEM (FILECOMSLST FL (QUOTE LOCALVARS)))
		    (APPLY (FUNCTION LOCALVARS)
			   TEM)))
		(COND
		  ((SETQ TEM (FILECOMSLST FL (QUOTE SPECVARS)))
		    (APPLY (FUNCTION SPECVARS)
			   TEM)))
		(COND
		  ((SETQ TEM (FILECOMSLST FL (QUOTE GLOBALVARS)))

          (* Ordinarily a noop, since noticing the file sets up GLOBALVARS (unlike SPECVARS and LOCALVARS, which are 
	  EVAL@COMPILE); however, user might have edited coms since then)


		    (APPLY (FUNCTION ADDTOVAR)
			   (CONS (QUOTE GLOBALVARS)
				 TEM]
          (UPDATECHANGED)
          (TAB 0 0)
          (COND
	    ((SETQ NOBLOCKFNS (for FN in FNS unless [OR (MEMB FN DONTCOMPILEFNS)
							(for BLOCK in BLOCKS
							   thereis (MEMB FN (CDR BLOCK]
				 collect FN))
	      (MSCHECKBLOCK (CONS (COND
				    [BLOCKS (APPEND (QUOTE (no block -))
						    (COND
						      [(CDDDDR NOBLOCKFNS)
							(APPEND (LDIFF NOBLOCKFNS (CDDDDR NOBLOCKFNS))
								(QUOTE (--]
						      (T NOBLOCKFNS]
				    (T (CONS (QUOTE File)
					     FILES)))
				  NOBLOCKFNS)
			    FNS BLOCKS)))
          (for BLOCK in BLOCKS do (MSCHECKBLOCK BLOCK FNS BLOCKS])

(MSCHECKBLOCK
  [LAMBDA (BLOCK FNS BLOCKS)                                 (* bvm: "26-Mar-84 12:36")
    (RESETVARS ((GLOBALVARS GLOBALVARS)
		(RETFNS RETFNS)
		(BLKLIBRARY BLKLIBRARY)
		(NOLINKFNS NOLINKFNS)
		(LINKFNS LINKFNS)
		(DONTCOMPILEFNS DONTCOMPILEFNS))
	       (PROG ((SPECVARS SPECVARS)
		      (LOCALVARS LOCALVARS)
		      (BLKNAME (CAR BLOCK))
		      BLKAPPLYFNS ENTRIES LOCALFREEVARS BLKFNS FREEVARS TEM TEM2 BOUNDFREE 
		      BLKAPPLYCALLERS ERRORS SHOULDBESPECVARS)
		     (COND
		       ((LISTP BLKNAME)
			 (SETQ BLKNAME NIL)))
		     [COND
		       (BLKNAME (SETQ LOCALVARS T)
				(SETQ SPECVARS (COND
				    ((NEQ SPECVARS T)
				      (UNION SYSSPECVARS SPECVARS))
				    (T SYSSPECVARS]
		     [for X in (CDR BLOCK)
			do                                   (* set up declarations and BLKFNS)
			   (COND
			     ((LISTP X)
			       [SETQ TEM (COND
				   ((EQ (CADR X)
					(QUOTE *))
				     (EVAL (CADDR X)))
				   (T (CDR X]
			       (SET (CAR X)
				    (COND
				      ((NLISTP (CDR X))
					(CDR X))
				      ([LISTP (SETQ TEM2 (EVALV (CAR X]
					(APPEND TEM TEM2))
				      (T TEM)))              (* ASSERT: ((REMOTE EVAL) SPECVARS LOCALVARS 
							     LOCALFREEVARS GLOBALVARS BLKLIBRARY SYSSPECVARS 
							     BLKAPPLYFNS ENTRIES LINKFNS NOLINKFNS RETFNS 
							     SYSLOCALVARS))
			       (SELECTQ (CAR X)
					[SPECVARS (COND
						    ((EQ TEM T)
						      (SETQ LOCALVARS SYSLOCALVARS]
					[LOCALVARS (COND
						     ((EQ TEM T)
						       (SETQ SPECVARS SYSSPECVARS]
					((LOCALFREEVARS GLOBALVARS BLKLIBRARY SYSSPECVARS BLKAPPLYFNS 
							ENTRIES LINKFNS NOLINKFNS RETFNS SYSLOCALVARS)
					  )
					(DOERROR (CAR X)
						 "unrecognized item in block declaration")))
			     ((MEMB X BLKFNS)
			       (DOERROR X "on block twice"))
			     (T (SETQ BLKFNS (CONS X BLKFNS]
		     (COND
		       (BLKNAME (MSCHECKBLOCKBASIC BLOCK BLKNAME))
		       (T (COND
			    (BLKAPPLYFNS (DOERROR BLKAPPLYFNS "BLKAPPLYFNS but not a real block" NIL 
						  T)))
			  (SETQ BLKLIBRARY NIL)))
		     (for FN in BLKFNS
			do (OR (FMEMB FN FNS)
			       (FMEMB FN BLKLIBRARY)
			       (DOERROR FN "not on the file"))
			   (COND
			     (BLKNAME                        (* a real block)
				      (MSCHECKFNINBLOCK FN BLOCK BLOCKS)))
			   [for VAR in (UNION (SETQ TEM (GETRELQ (BIND NOTUSE)
								 FN))
					      (GETRELQ (USE LOCALLY)
						       FN))
			      do [OR (FMEMB VAR BOUNDFREE)
				     (FMEMB VAR SYSSPECVARS)
				     (GLOBALVARP VAR)
				     (COND
				       ((TESTRELQ (USE FREELY)
						  VAR T)     (* i.e. it is bound in this block, and used freely by 
							     someone else)
					 (SETQ BOUNDFREE (CONS VAR BOUNDFREE)))
				       ((SPECVARP VAR FN)
					 (AND (NEQ SPECVARS T)
					      (UNECCSPEC FN VAR)))
				       ((FMEMB VAR TEM)
					 (DOERROR FN "binds and never uses" VAR T]
				 (COND
				   ((AND (FMEMB VAR (GETRELQ (USE INDIRECTLY)
							     FN))
					 (NOT (SPECVARP VAR FN)))
				     (DOERROR VAR "should be SPECVAR (used in functional arg) in" FN 
					      T]
			   (SETQ FREEVARS (UNION (GETRELQ (USE FREELY)
							  FN)
						 FREEVARS)))
		     (MSCHECKBOUNDFREE BOUNDFREE BLKNAME)
		     [for VAR in FREEVARS unless (OR (FMEMB VAR SHOULDBESPECVARS)
						     (FMEMB VAR SYSSPECVARS)
						     (FMEMB VAR (LISTP SPECVARS))
						     (FMEMB VAR LOCALFREEVARS)
						     (FMEMB VAR GLOBALVARS)
						     (GETPROP VAR (QUOTE GLOBALVAR))
						     (CONSTANTEXPRESSIONP VAR))
			do (COND
			     ((NULL (SETQ TEM (for FN in (GETRELQ (USE FREELY)
								  VAR T)
						 when (FMEMB FN BLKFNS) collect FN)))
                                                             (* Nobody uses it??)
			       )
			     ((TESTRELQ BIND VAR T)
			       (DOERROR VAR "not declared, used freely by " TEM 0))
			     ((NOT (BOUNDP VAR))
			       (DOERROR VAR 
				  "not declared, never bound, no top-level value, used freely by"
					TEM T))
			     (T (DOERROR VAR "not bound, not a GLOBALVAR, used freely by" TEM T]
		     (for DEC in BLOCK when (LISTP DEC)
			do (SELECTQ (CAR DEC)
				    ((SPECVARS LOCALVARS LOCALFREEVARS GLOBALVARS)
				      (for VAR in (CDR DEC)
					 unless (OR (FMEMB VAR BOUNDFREE)
						    (FMEMB VAR FREEVARS)
						    (for FN in (GETRELQ BIND VAR T)
						       thereis (FMEMB FN BLKFNS)))
					 do (DOERROR VAR "not mentioned in block, but on"
						     (CAR DEC)
						     T)))
				    NIL))
		     (COND
		       (ERRORS (OR (ZEROP (POSITION))
				   (TERPRI))
			       (TERPRI)
			       (PRIN1 "<<<<< In ")))
		     [PRIN2 (OR (CAR BLOCK)
				(CONS NIL (NCONC (for X in (CDR BLOCK) collect X repeatuntil
										  (NLISTP X))
						 (QUOTE (--]
		     (COND
		       (ERRORS (PRIN1 ": >>>>>")
			       (MAPC (SETQ ERRORS (DREVERSE ERRORS))
				     (FUNCTION PRINTERROR))
			       (PRIN1 "----------------

"))
		       (T (PRIN1 ", "])

(MSCHECKFNINBLOCK
  [LAMBDA (FN BLOCK BLOCKS)                                  (* bvm: "26-Mar-84 12:02")

          (* * Checks things related to FN in a real block)


    (PROG (INDIRECTCALLERS MACRODEF ISCALLEDP)
          (COND
	    ([AND (SETQ MACRODEF (GETPROP FN (QUOTE MACRO)))
		  (OR (NULL (CAR MACRODEF))
		      (LISTP (CAR MACRODEF)))
		  (NOT (FMEMB FN ENTRIES))
		  (NOT (MSFIND MACRODEF (QUOTE IGNOREMACRO]

          (* no point in having it in the block, since all of the other block fns would get the -
	  however, computed macros might return IGNOREMACRO)


	      (DOERROR FN "internal block function with MACRO property" NIL T)))
          (COND
	    ((AND (NOT (FMEMB FN ENTRIES))
		  (NOT (FMEMB FN BLKLIBRARY)))               (* Check that internal FN is not called from outside the
							     block)
	      (SETQ ISCALLEDP NIL)
	      [for FN2 in (UNION (SETQ INDIRECTCALLERS (GETRELQ (CALL INDIRECTLY)
								FN T))
				 (GETRELQ (CALL DIRECTLY)
					  FN T))
		 do                                          (* FN2 calls FN)
		    (COND
		      ((AND (NEQ FN2 FN)
			    (FMEMB FN2 BLKFNS))              (* is called by somebody in the block)
			(SETQ ISCALLEDP T)))
		    (COND
		      [(NOT (FMEMB FN2 BLKFNS))
			(COND
			  ([NOT (for OTHERBLOCK in BLOCKS thereis (AND (NEQ OTHERBLOCK BLOCK)
								       (MEMB FN (CDR OTHERBLOCK))
								       (OR (NULL (CAR OTHERBLOCK))
									   (MEMB FN2 (CDR OTHERBLOCK]
                                                             (* called by FN2 outside the block, and FN is not also a
							     member of a block containing FN2)
			    (DOERROR FN "not an entry, called from outside the block by" FN2]
		      ((FMEMB FN2 INDIRECTCALLERS)           (* called indirectly)
			(OR (FMEMB FN RETFNS)
			    (FMEMB FN BLKAPPLYFNS)
			    (DOERROR FN 
				 "not an entry or on RETFNS or BLKAPPLYFNS, called indirectly by"
				     FN2]
	      (COND
		((AND (NOT ISCALLEDP)
		      (NOT (FMEMB FN BLKAPPLYFNS)))
		  (DOERROR FN "not an entry, not called from inside the block"])

(MSCHECKBLOCKBASIC
  [LAMBDA (BLOCK BLKNAME)                                    (* bvm: "26-Mar-84 11:45")
                                                             (* check for things having to do with real blocks)
    [COND
      ((AND (NULL ENTRIES)
	    (MEMB BLKNAME BLKFNS))
	(COND
	  ((NEQ BLKNAME (CADR BLOCK))
	    (DOERROR BLKNAME "must also be the FIRST function in the block"]
    [COND
      ((AND (EQ BLKNAME (CAR ENTRIES))
	    (NULL (CDR ENTRIES))
	    (NULL BLKAPPLYFNS))                              (* MKENTRIES treats the case of ENTRIES=NIL specially by
							     not setting up a separate BLOCK.)
	(SETQ ENTRIES NIL))
      ((AND (NULL ENTRIES)
	    BLKAPPLYFNS)                                     (* Above caper only works if no BLKAPPLYFNS)
	(SETQ ENTRIES (LIST BLKNAME]
    (COND
      ((MEMB BLKNAME ENTRIES)
	(DOERROR BLKNAME "can't be both entry and block name")))
    (for X in [APPEND BLKAPPLYFNS (OR ENTRIES (SETQ ENTRIES (LIST BLKNAME]
       do (OR (MEMB X BLKFNS)
	      (DOERROR X "on ENTRIES or BLKAPPLYFNS but not in block")))
    (for FN in BLKLIBRARY when (AND [NOT (FMEMB FN (QUOTE (EQUAL GETPROP GETP NTH TAILP MEMBER]
				    (for Y in (GETRELQ (CALL NOTERROR)
						       FN T)
				       thereis (FMEMB Y BLKFNS)))
       do (COND
	    ((NULL (GETPROP FN (QUOTE BLKLIBRARYDEF)))
	      (DOERROR FN "on BLKLIBRARY but no BLKLIBRARYDEF property" NIL T)))
	  (SETQ BLKFNS (NCONC1 BLKFNS FN)))
    (COND
      ([AND BLKAPPLYFNS (NOT (SETQ BLKAPPLYCALLERS (for X in (QUOTE (BLKAPPLY BLKAPPLY*))
						      join (for Y in (GETRELQ (CALL NOTERROR)
									      X T)
							      when (FMEMB Y BLKFNS) collect Y]
	(DOERROR BLKAPPLYFNS "BLKAPPLYFNS but no calls to BLKAPPLY in block" NIL T])

(MSCHECKBOUNDFREE
  [LAMBDA (BOUNDFREE BLKNAME)                                (* bvm: "26-Mar-84 12:08")
    (for V in BOUNDFREE do (SCRATCHASH SEEN (PROG ((USERS (GETRELQ (USE FREELY)
								   V T))
						   (LF (FMEMB V LOCALFREEVARS))
						   (BINDERS (GETRELQ BIND V T))
						   LF1 SFLG)
					          (CLRHASH SEEN)
					          (for X in USERS do (PUTHASH X -1 SEEN))
					          (for X in BINDERS do (PUTHASH X 1 SEEN))
					          (for U in USERS
						     do (COND
							  ((FMEMB U BLKFNS)
							    (COND
							      ((FMEMB U BINDERS)
								(NECCSPEC V U U)))
							    (SETQ LF1 LF)))
							(MSCHECKVARS1 U))
					          (COND
						    ((AND (NULL SFLG)
							  (OR BLKNAME (EQ LOCALVARS T))
							  (NEQ SPECVARS T))
						      (for X in BINDERS when (FMEMB X BLKFNS)
							 do (SELECTQ (GETHASH X SEEN)
								     (2)
								     (-1)
								     (AND (SPECVARP V X)
									  (UNECCSPEC X V])

(GLOBALVARP
  (LAMBDA (X)                                               (* lmm "31-DEC-78 15:23")
    (OR (FMEMB X GLOBALVARS)
	(GETPROP X (QUOTE GLOBALVAR)))))

(PRINTERROR
  (LAMBDA (ERR)                                             (* lmm "24-FEB-79 21:15")
    (PROG ((MSG (CAR ERR))
	   (VALS (CDDR ERR))
	   NEWPRS PR POS POS2 (LL (IDIFFERENCE (LINELENGTH)
					       30))
	   POS3)
          (SELECTQ (CAR MSG)
		   (0 (SETQ MSG (CDR MSG))
		      (PRIN1 "
(note) "))
		   (T (SETQ MSG (CDR MSG))
		      (PRIN1 "
(possible error) "))
		   (PRIN1 "
(probable error) "))
          (COND
	    (VALS (for X inside VALS do (PRIN2 X)
					(SPACES 1))
		  (PRIN1 (QUOTE -))
		  (for X inside MSG do (SPACES 1)
				       (PRIN1 X))
		  (PRIN1 (QUOTE %.))
		  (TERPRI)))
          (for PRL on (DREVERSE (CADR ERR)) do (COND
						 ((NULL (CDDR (SETQ PR (CAR PRL))))
						   (for ERR in (CDR PRL)
						      do (COND
							   ((EQUAL (CDR ERR)
								   (CDR PR))
							     (FRPLACA ERR (CONS (CAR PR)
										(CAR ERR)))
							     (FRPLACA PR NIL)
							     (RETURN))))))
					       (AND (CAR PR)
						    (SETQ NEWPRS (CONS PR NEWPRS))))
          (COND
	    (NEWPRS (TAB 0 0)
		    (SHORTLST (CAAR NEWPRS)
			      4)
		    (SETQ POS (POSITION))
		    (PRIN1 " - ")
		    (for X inside MSG do (PRIN1 X)
					 (SPACES 1))
		    (SETQ POS2 (POSITION))
		    (COND
		      ((OR (ILESSP POS2 (IDIFFERENCE POS 3))
			   (IGREATERP POS2 LL))
			(SETQ POS2 (IPLUS POS 10))))
		    (SETQ POS3 (IDIFFERENCE (IQUOTIENT (IPLUS POS POS2)
						       2)
					    4))
		    (PRIN1 " -")
		    (SHORTLST (CDAR NEWPRS)
			      4)
		    (PRIN1 (QUOTE ".
"))
		    (MAPC (CDR NEWPRS)
			  (FUNCTION (LAMBDA (PR)
			      (SHORTLST (CAR PR)
					4)
			      (TAB POS T)
			      (PRIN1 " -")
			      (TAB POS3 T)
			      (PRIN1 "    %"%"    ")
			      (TAB POS2 T)
			      (PRIN1 "-")
			      (SHORTLST (CDR PR)
					4)
			      (PRIN1 ".
")))))))))

(MSCHECKVARS1
  [LAMBDA (FN)                                               (* lmm "16-Jul-84 14:54")
    [COND
      ((AND LF1 (FMEMB FN ENTRIES))
	(DOERROR V [CONS "on LOCALFREEVARS" (COND
			   ((EQ U FN)
			     "but used freely by the entry")
			   (T (LIST "but the entry" FN "can reach functions using it freely"]
		 U T)
	(SETQ LF (SETQ LF1 NIL]
    (PROG ((CALLERS (GETRELQ (CALL NOTERROR)
			     FN T))
	   (VAL 3))
          [COND
	    ((FMEMB FN BLKAPPLYFNS)
	      (SETQ CALLERS (UNION BLKAPPLYCALLERS CALLERS]

          (* interpretation of SEEN codes -
	  0 recursive call -
	  -1 uses var -
	  1 binds var -
	  2 binds var, path from it to user -
	  T always bound above -
	  3 no callers -
	  4 not always bound above)


          (for X in CALLERS do (SELECTQ (GETHASH X SEEN)
					((0 -1 4))
					(3 (SETQ VAL 4))
					[1 

          (* we have found a path from a user up to a binder -
	  if the path is entirely in the block, then LOCALFREEVAR is ok, -
	  if the path is outside the block, then it doesn't matter, otherwise SPECVAR)


					   (COND
					     ((FMEMB X BLKFNS)
                                                             (* if the binder isn't in this block, ignore)
                                                             (* should just be SPECVAR if not entirely within the 
							     block)
					       (NECCSPEC V X U)))
					   (PUTHASH X 2 SEEN)
					   (COND
					     ((EQ VAL 3)
					       (SETQQ VAL T]
					[(T 2)
					  (COND
					    ((EQ VAL 3)
					      (SETQQ VAL T]
					(NIL                 (* now check recursively)
					     (PUTHASH X 0 SEEN)
					     (PUTHASH X (MSCHECKVARS1 X)
						      SEEN))
					(SHOULDNT 4)))
          (RETURN VAL])

(UNECCSPEC
  (LAMBDA (FN VAR)                                          (* lmm "30-AUG-78 03:36")
    (OR (GLOBALVARP VAR)
	(FMEMB VAR (GETRELQ (USE INDIRECTLY)
			    FN))
	(DOERROR VAR "might not need to be a specvar in" FN T))))

(NECCSPEC
  (LAMBDA (VAR BINDER)                                      (* lmm "21-SEP-78 04:21")
    (COND
      ((NOT (OR SFLG (SPECVARP VAR BINDER)))
	(SETQ SFLG T)
	(SETQ SHOULDBESPECVARS (CONS VAR SHOULDBESPECVARS))
	(DOERROR VAR (LIST "(used freely in)" U "is not a SPECVAR in")
		 BINDER T)))))

(SPECVARP
  (LAMBDA (X FN)                                            (* lmm "25-JUN-78 01:15")
    (COND
      ((FMEMB X (GETRELQ (DECLARE LOCALVARS)
			 FN))
	NIL)
      ((FMEMB X (GETRELQ (DECLARE SPECVARS)
			 FN))
	T)
      ((NEQ LOCALVARS T)
	(NOT (FMEMB X LOCALVARS)))
      (T (OR (EQ SPECVARS T)
	     (FMEMB X SPECVARS)
	     (FMEMB X LOCALFREEVARS)
	     (FMEMB X GLOBALVARS)
	     (GETP X (QUOTE GLOBALVAR)))))))

(SHORTLST
  (LAMBDA (X N)                                             (* lmm " 9-AUG-77 03:18")
    (COND
      ((NULL X)
	N)
      ((LISTP X)
	(SHORTLST (CDR X)
		  (SHORTLST (CAR X)
			    N)))
      (T (COND
	   ((IGREATERP (SETQ N (SUB1 N))
		       0)
	     (SPACES 1)
	     (PRIN2 X))
	   ((ZEROP N)
	     (PRIN1 " etc")))
	 N))))

(DOERROR
  (LAMBDA (AT MSG ARG QUESTIONABLE)                         (* lmm "24-FEB-79 21:14")
    (COND
      (QUESTIONABLE (SETQ MSG (CONS QUESTIONABLE MSG))))
    (PROG ((L (CDR (OR (SASSOC MSG ERRORS)
		       (CAR (SETQ ERRORS (CONS (CONS MSG (CONS))
					       ERRORS))))))
	   (AT AT))
          (COND
	    (ARG (SETQ AT (OR (FASSOC AT (CAR L))
			      (CAAR (FRPLACA L (CONS (CONS AT)
						     (CAR L))))))
		 (OR (MEMBER (CDR ARG)
			     AT)
		     (NCONC1 AT ARG)))
	    ((NOT (FMEMB AT (CDR L)))
	      (FRPLACD L (CONS AT (CDR L))))))))
)
[DECLARE: DONTEVAL@LOAD DOEVAL@COMPILE DONTCOPY
(BLOCK: MSCHECKBLOCKS MSCHECKBLOCKS MSCHECKBLOCK MSCHECKFNINBLOCK MSCHECKBLOCKBASIC MSCHECKBOUNDFREE 
	PRINTERROR MSCHECKVARS1 UNECCSPEC NECCSPEC SPECVARP SHORTLST DOERROR
	(LOCALFREEVARS SEEN BLKFNS V ERRORS SFLG LF BLKAPPLYCALLERS U LF1 SHOULDBESPECVARS)
	(NOLINKFNS . T)
	(SPECVARS SPECVARS LOCALVARS RETFNS BLKAPPLYFNS BLKLIBRARY NOLINKFNS LINKFNS LOCALFREEVARS 
		  DONTCOMPILEFNS ENTRIES)
	(GLOBALVARS SYSLOCALVARS SYSSPECVARS FILELST MSCRATCHASH)
	GLOBALVARP)
]

(RPAQQ MSPATHSCOMS [(* PATHS)
	(FNS MSPATHS MSPATHS1 MSPATHS2 MSONPATH MSPATHS4 DASHES DOTABS BELOWMARKER MSPATHSPRINTFN)
	(BLOCKS (MSPATHSBLOCK (ENTRIES MSPATHS MSONPATH MSPATHS2)
			      MSPATHS MSPATHS1 MSPATHS2 MSONPATH MSPATHS4 DASHES DOTABS BELOWMARKER 
			      MSPATHSPRINTFN
			      (LOCALFREEVARS TABS NAMED LINENUM LL BELOWCNT MARKING SEEN INVERTED TO 
					     NOTRACE AVOIDING SEPARATE)
			      (GLOBALVARS MSBLIP MSCRATCHASH)
			      (NOLINKFNS . T])



(* PATHS)

(DEFINEQ

(MSPATHS
  [LAMBDA (FROM TO INVERTED AVOIDING SEPARATE NOTRACE MARKING)
                                   (* lmm "21-JAN-79 14:28")

          (* Display paths; must print all of FROM, with separate tree for all of SEPARATE (considered as a subset of FROM). 
	  Stop when you get to a function in NOTRACE, or if DEPTH is exceeded -- unless TO is NIL, only print paths that 
	  eventually reach an element of TO. If INVERTED is not NIL, print inverted tree. Do not print out functions in 
	  AVOIDING)


    (SCRATCHASH SEEN (PROG (TABS (LL (LINELENGTH))
				 (BELOWCNT 0)
				 (LINENUM 0)
				 (FIRST T)
				 X NAMED TEM (UNDONE (MSLISTSET FROM T)))
		           [COND
			     (INVERTED (PRINT (QUOTE (inverted tree]
		           [MAPC UNDONE (FUNCTION (LAMBDA (X)
				     (PUTHASH X (COND
						((AND NOTRACE (MSMEMBSET X NOTRACE))
						  -1)
						(T 0))
					      SEEN]
		           (TAB 0 0)
		           [RESETVARS ((MSPRINTFLG))
				      (do (COND
					    (NAMED (OR FIRST (DASHES (GETHASH (CAR NAMED)
									      SEEN)))
						   (SETQ FIRST)
						   (PUTHASH (CAR NAMED)
							    0 SEEN)
						   (MSPATHS1 (CAR NAMED)
							     NIL T)
						   (SETQ NAMED (CDR NAMED)))
					    (UNDONE [COND
						      ([OR (NULL (SETQ TEM (GETHASH (CAR UNDONE)
										    SEEN)))
							   (EQ TEM 0)
							   (AND (LISTP TEM)
								(NULL (CAR TEM]
							(PUTHASH (CAR UNDONE)
								 (LIST NIL)
								 SEEN)
							(SETQ NAMED (LIST (CAR UNDONE]
						    (SETQ UNDONE (CDR UNDONE)))
					    (T (TERPRI)
					       (RETURN]
		           (RETURN])

(MSPATHS1
  [LAMBDA (FROM FIRST LAST)        (* lmm " 4-AUG-83 23:45")
    (PROG (TEM THISLINE POS (XT TABS))
          [COND
	    ((NOT FIRST)
	      (TERPRI)
	      (SETQ LINENUM (ADD1 LINENUM))
                                   (* if NOT (EQMEMB (QUOTE NOLINE) PRINTOPTIONS) then)
	      (PRIN1 LINENUM)
	      (PRIN1 ".")
	      (DOTABS (CDR TABS]
          (SETQ THISLINE LINENUM)
          (AND TABS (TAB (CAR TABS)
			 0))
          (AND LAST (SETQ TABS (CDR TABS)))
          (SETQ POS (MSPATHSPRINTFN FROM))
          (MSPATHS2 FROM)
          (COND
	    [(NEQ (SETQ TEM (GETHASH FROM SEEN))
		  0)               (* Already expanded on a previous line -
				   or is a NOTRACE)
	      (COND
		((EQ TEM MSBLIP)
		  (SHOULDNT 5))
		((OR (NOT (NUMBERP TEM))
		     (NOT (MINUSP TEM)))
		  (PRIN1 " {")
		  (PRIN1 (COND
			   ((NLISTP TEM)
                                   (* Either line number or overflow line letter)
			     TEM)
			   [(LISTP TEM)
                                   (* A list means that this must be a sub-tree)
			     (COND
			       ((CAR TEM))
			       (T (FRPLACA TEM (BELOWMARKER))
				  (SETQ NAMED (NCONC1 NAMED FROM))
				  (CAR TEM]
			   (T TEM)))
		  (PRIN1 "}"]
	    (T (PROG ((TABS TABS)
		      (FIRST T)
		      NEXTLEVEL TEM)
		     (PUTHASH FROM (IDIFFERENCE -1 THISLINE)
			      SEEN)
		     (OR (SETQ NEXTLEVEL (for Y in (COND
						     ((NOT INVERTED)
						       (GETRELQ CALL FROM))
						     (T (GETRELQ CALL FROM T)))
					    when (MSPATHS2 Y) collect Y))
			 (RETURN))
                                   (* AND (SETQ TEM (FASSOC (QUOTE SORT) PRINTOPTIONS)) 
				   (SORT NEXTLEVEL (CDR TEM)))
		     (COND
		       ([AND XT (OR (SETQ TEM (AND SEPARATE (MSMEMBSET FROM SEPARATE)))
				    (SOME NEXTLEVEL (FUNCTION (LAMBDA (FN)
					      (IGREATERP (IPLUS (NCHARS FN)
								POS 6)
							 LL]
                                   (* NOT (EQMEMB (QUOTE NOLINE) PRINTOPTIONS))
			 (SETQ NAMED (NCONC1 NAMED FROM))
			 (PRIN1 " {")
			 [PRIN1 (COND
				  (TEM (CAR (PUTHASH FROM (LIST (BELOWMARKER))
						     SEEN)))
				  (T (PUTHASH FROM (BELOWMARKER)
					      SEEN]
			 (PRIN1 "}")
			 (RETURN)))
		     (SETQ TABS (CONS POS TABS))
		     (PUTHASH FROM THISLINE SEEN)
		     (for X on NEXTLEVEL
			do (MSPATHS1 (CAR X)
				     FIRST
				     (NULL (CDR X)))
			   (SETQ FIRST])

(MSPATHS2
  [LAMBDA (FN FLG)                                           (* lmm "20-Jul-84 14:36")

          (* Returns T if FN should be PRINTED -
	  The SEEN table contains one of the following entries for a function -
	  MSBLIP : don't print the function at all -
	  n a number : don't trace it, it was expanded previously -
	  -n : don't trace it, it was printed earlier, though it had no sub-functions -
	  0 : yes, print and trace it -
	  -1 : yes, print it, but don't trace it -
	  (NIL): it should be given a separate tree, as yet unnamed -
	  (letter): give it a separate tree with this letter name -
	  letter : the function is expanded in an OVERFLOW table below)



          (* When below MSPATHS4 for ON PATH sets (and CALL SOMEHOW) the SEEN table contains either 0 : not traced yet, 
	  MSBLIP : don't print, -1 print, don't trace, T : top set (e.g. for CALLED SOMEHOW BY X, X is originally marked T) 
	  1 already seen and traced)


    (NEQ [OR (GETHASH FN SEEN)
	     (PROGN (OR INVERTED (UPDATEFN FN NIL 0))
		    (COND
		      ((AND AVOIDING (MSMEMBSET FN AVOIDING))
                                                             (* If it is avoiding, then no)
			(PUTHASH FN MSBLIP SEEN))
		      ((AND (NULL FLG)
			    NOTRACE
			    (MSMEMBSET FN NOTRACE))          (* Will not be traced: entry should be either MSBLIP or 
							     -1 depending on whether the function should be printed)
			(COND
			  ((MSPATHS2 FN T)
			    (PUTHASH FN -1 SEEN))
			  (T MSBLIP)))
		      ((NULL TO)
			(PUTHASH FN (COND
				   ((AND (NULL INVERTED)
					 (GETD FN)
					 (NOT (TESTRELQ KNOWN FN)))
				     MSBLIP)
				   (T 0))
				 SEEN))
		      ((MSMEMBSET FN TO)                     (* If it is in the TO set, then definitly YES)
			(PUTHASH FN 0 SEEN))
		      (T                                     (* Will a path through this function eventually print 
							     out an element of TO?)
			 (PUTHASH FN MSBLIP SEEN)            (* assume not)
			 (COND
			   ((OR (NULL FLG)
				(NULL NOTRACE)
				(NOT (MSMEMBSET FN NOTRACE)))
			     (for Y in (COND
					 ((NOT INVERTED)
					   (GETRELQ CALL FN))
					 (T (GETRELQ CALL FN T)))
				when (MSPATHS2 Y) do (RETURN (PUTHASH FN 0 SEEN))
				finally (RETURN MSBLIP)))
			   (T MSBLIP]
	 MSBLIP])

(MSONPATH
  [LAMBDA (SETREP)                                           (* rmk: " 3-Jan-84 21:31")
    (PROG ((FROM (fetch FROM of (fetch PATHOPTIONS of SETREP)))
	   (TO (fetch TO of (fetch PATHOPTIONS of SETREP)))
	   (AVOIDING (fetch AVOIDING of (fetch PATHOPTIONS of SETREP)))
	   (NOTRACE (fetch NOTRACE of (fetch PATHOPTIONS of SETREP)))
	   INVERTED
	   (TOPFLG (fetch TOPFLG of (fetch PATHOPTIONS of SETREP)))
	   (SEEN (HASHARRAY 20))
	   TEM)
          (COND
	    ((NULL FROM)
	      (SETQ INVERTED T)
	      (SETQ FROM TO)
	      (SETQ TO NIL)))
          (SETQ TEM (MSLISTSET FROM T))
          [MAPC TEM (FUNCTION (LAMBDA (X)
		    (PUTHASH X 0 SEEN]                       (* 0 means yes expand, not expanded yet)
          [MAPC TEM (FUNCTION (LAMBDA (X)
		    (MSPATHS4 X TOPFLG]
          (RETURN SEEN])

(MSPATHS4
  (LAMBDA (FROM TOP)                                        (* lmm "25-JUN-78 01:10")

          (* traces paths from FROM. When done, the SEEN array will contain MSBLIP or NIL for entries not expanded, 0 for 
	  entries which should be expanded but weren't for some reason (probably a bug), 1 for entries which were below the 
	  "top" and T for entries which were above the top only)


    (PROG (TEM)
          (COND
	    ((MSPATHS2 FROM)
	      (COND
		((EQ (SETQ TEM (GETHASH FROM SEEN))
		     0)
		  (PUTHASH FROM (COND
			     (TOP T)
			     (T 1))
			   SEEN)
		  (for Y in (COND
			      (INVERTED (GETRELQ CALL FROM T))
			      (T (GETRELQ CALL FROM)))
		     do (MSPATHS4 Y)))
		((AND (EQ TEM T)
		      (NOT TOP))
		  (PUTHASH FROM 1 SEEN))))))))

(DASHES
  (LAMBDA (MARKER)                                          (* lmm "21-JAN-79 14:28")
    (TERPRI)
    (FRPTQ (IDIFFERENCE LL 20)
	   (PRIN1 (QUOTE -)))
    (PRIN1 (COND
	     ((LISTP MARKER)
	                                                    (* OR (EQMEMB (QUOTE NOLINE) PRINTOPTIONS))
	       (PRIN1 "------------   ")
	       (OR (CAR MARKER)
		   (QUOTE "")))
	     (T (PRIN1 "--- overflow - ")
		MARKER)))))

(DOTABS
  (LAMBDA (LST)                                             (* lmm: 19 MAY 75 146)
    (COND
      ((NULL LST)
	NIL)
      (T (DOTABS (CDR LST))
	 (TAB (CAR LST)
	      0)
	 (PRIN1 "|")))))

(BELOWMARKER
  (LAMBDA NIL                                               (* lmm "22-JUN-78 00:15")
                                                            (* lmm: 26 MAY 75 1751)
    (PROG1 (COND
	     ((ILESSP BELOWCNT 26)
	       (FCHARACTER (IPLUS 97 BELOWCNT)))
	     (T (PACK* (FCHARACTER (IPLUS 97 (IREMAINDER BELOWCNT 26)))
		       (IQUOTIENT BELOWCNT 26))))
	   (SETQ BELOWCNT (ADD1 BELOWCNT)))))

(MSPATHSPRINTFN
  (LAMBDA (FN)                                              (* lmm "16-MAY-78 02:27")
    (AND MARKING (MSMEMBSET FN MARKING)
	 (PRIN1 ">"))
    (PRIN2 FN)
    (ADD1 (POSITION))))
)
[DECLARE: DONTEVAL@LOAD DOEVAL@COMPILE DONTCOPY
(BLOCK: MSPATHSBLOCK (ENTRIES MSPATHS MSONPATH MSPATHS2)
	MSPATHS MSPATHS1 MSPATHS2 MSONPATH MSPATHS4 DASHES DOTABS BELOWMARKER MSPATHSPRINTFN
	(LOCALFREEVARS TABS NAMED LINENUM LL BELOWCNT MARKING SEEN INVERTED TO NOTRACE AVOIDING 
		       SEPARATE)
	(GLOBALVARS MSBLIP MSCRATCHASH)
	(NOLINKFNS . T))
]
(DEFINEQ

(MSFIND
  (LAMBDA (IN X)                                            (* lmm "24-JAN-79 15:16")
    (OR (EQ IN X)
	(AND (LISTP IN)
	     (OR (MSFIND (CAR IN)
			 X)
		 (MSFIND (CDR IN)
			 X))))))
)

(RPAQQ MSBLIP "sysout and inform Masinter@PARC")



(* SCRATCHASH)


(RPAQ? MSCRATCHASH )
(DECLARE: DONTCOPY 
(DECLARE: EVAL@COMPILE 

(PUTPROPS SCRATCHASH MACRO [(ARRAYNAME . FORMS)
			    ([LAMBDA (ARRAYNAME)
				(SETQ MSCRATCHASH)
				(PROG1 (PROGN . FORMS)
				       (SETQ MSCRATCHASH ARRAYNAME]
			      (COND
				(MSCRATCHASH (CLRHASH MSCRATCHASH)
					     MSCRATCHASH)
				(T (HASHARRAY 20 (FUNCTION MSREHASH])
)
)



(* marking changed)

(DEFINEQ

(MSMARKCHANGED
  [LAMBDA (NAME TYPE REASON)                           (* rmk: "20-FEB-81 09:31")
                                                       (* Called from inside MARKASCHANGED)
    (AND MSDATABASELST (SELECTQ TYPE
				((FNS NIL)
				  (MSMARKCHANGE1 NAME 0))
				((VARS T)
				  (CHANGEVAR NAME TYPE REASON))
				(MACROS (CHANGEMACRO NAME TYPE REASON))
				(I.S.OPRS (CHANGEI.S. NAME TYPE REASON))
				NIL])

(CHANGEMACRO
  [LAMBDA (NAME TYPE REASON)                           (* rmk: "19-FEB-81 14:59")

          (* We don't do anything if the item is being defined. This is a heuristic that compensates for the fact that a database can be loaded 
	  from a file before the definitions that it knows about come in. We don't want a subsequent LOADFROM of a file to generate all sorts of 
	  probably spurious messages.)


    (AND MSDATABASELST (NEQ REASON (QUOTE DEFINED))
	 (MSNEEDUNSAVE (GETRELATION NAME (QUOTE (CALL DIRECTLY))
				    T)
		       (FILEPKGTYPE TYPE (QUOTE DESCRIPTION))
		       (EQ (TEMPLATE NAME T)
			   (QUOTE MACRO])

(CHANGEVAR
  [LAMBDA (NAME TYPE REASON)                           (* rmk: "19-FEB-81 15:22")
    (DECLARE (GLOBALVARS COMPILE.TIME.CONSTANTS))
    (AND MSDATABASELST (FMEMB NAME COMPILE.TIME.CONSTANTS)
	 (MSNEEDUNSAVE (GETRELATION NAME (QUOTE (USE FREELY))
				    T)
		       "constants"])

(CHANGEI.S.
  [LAMBDA (NAME TYPE REASON)                           (* rmk: "19-FEB-81 15:13")
    (AND MSDATABASELST (SELECTQ REASON
				(DEFINED               (* If it has a function definition, then defining it as an i.s.opr has 
						       no effect (at least for interpreted code))
					 (AND (NOT (GETD NAME))
					      (MSNEEDUNSAVE (GETRELATION NAME (QUOTE (CALL DIRECTLY))
									 T)
							    (QUOTE (i.s.oprs as functions))
							    T)))
				((CHANGED DELETED)
				  (MSNEEDUNSAVE (UNION (GETRELATION NAME (QUOTE (USE I.S.OPRS))
								    T)
						       (AND (U-CASEP NAME)
							    (GETRELATION (L-CASE NAME)
									 (QUOTE (USE I.S.OPRS))
									 T)))
						(QUOTE i.s.oprs)
						T))
				NIL])

(CHANGERECORD
  (LAMBDA (RNAME RFIELDS OLDFLG)                            (* lmm "20-JAN-79 18:00")
    (AND MSDATABASELST OLDFLG (MSNEEDUNSAVE (PROG ((FNLIST (GETRELATION RNAME (QUOTE (USE RECORDS))
									T)))
					          (for F in RFIELDS
						     do (SETQ FNLIST
							  (UNION (GETRELATION F (QUOTE (USE FIELDS))
									      T)
								 FNLIST)))
					          (RETURN FNLIST))
					    (QUOTE records)
					    MSRECORDTRANFLG))))

(MSNEEDUNSAVE
  [LAMBDA (FNS MSG MARKCHANGEFLG)                      (* rmk: "22-MAY-81 13:23")
    (AND MARKCHANGEFLG (MSMARKCHANGE1 FNS))
    (COND
      ((AND CHECKUNSAVEFLG (SETQ FNS (for FN inside FNS
					when (NOT (OR (EXPRP (OR (GETP FN (QUOTE BROKEN))
								 (GETP FN (QUOTE ADVISED))
								 FN))
						      (FMEMB FN MSNEEDUNSAVE)))
					collect FN)))
	(COND
	  ((EQ CHECKUNSAVEFLG (QUOTE !))
	    (UNSAVEFNS FNS))
	  (T (printout T "The functions " .PARA2 0 0 FNS " use " MSG " which have changed." T 
		       "Call UNSAVEFNS() to load and/or UNSAVEDEF them."
		       T)
	     (/SETATOMVAL (QUOTE MSNEEDUNSAVE)
			  (NCONC FNS MSNEEDUNSAVE])

(UNSAVEFNS
  [LAMBDA (FNS)                                              (* rmk: " 7-Dec-84 13:10")
    (OR FNS (SETQ FNS (APPEND MSNEEDUNSAVE)))
    (for FN in FNS when FN
       do [OR (EXPRP (OR (GETP FN (QUOTE BROKEN))
			 (GETP FN (QUOTE ADVISED))
			 FN))
	      (PROG NIL
		    (COND
		      ((FGETD FN)
			(VIRGINFN FN T)
			(SAVEDEF FN)))
		    (SELECTQ RECOMPILEDEFAULT
			     [CHANGES                        (* don't mark as changed)
				      (RESETVARS (MSDATABASELST)
                                                             (* ASSERT: ((REMOTE CALL) MSMARKCHANGED))
					         (MARKASCHANGED FN (QUOTE FNS]
			     [EXPRS (for FL in (WHEREIS FN (QUOTE FNS)
							FILELST)
				       unless [OR (FMEMB FL NOTCOMPILEDFILES)
						  (CDR (GETP FL (QUOTE FILE]
				       do (/SETATOMVAL (QUOTE NOTCOMPILEDFILES)
						       (CONS FL NOTCOMPILEDFILES]
			     NIL)
		    (PRINT (LIST (QUOTE loading)
				 FN)
			   T T)
		    (/PUTD FN (OR (MSGETDEF FN T T)
				  (PROGN (PRIN1 "Can't find a definition for " T)
					 (PRIN2 FN T T)
					 (PRINT (QUOTE !)
						T T)
					 (RETURN]
	  (/SETATOMVAL (QUOTE MSNEEDUNSAVE)
		       (REMOVE FN MSNEEDUNSAVE)))
    (AND FNS (EQ RECOMPILEDEFAULT (QUOTE CHANGES))
	 (printout T 
"WARNING:  you must set RECOMPILEDEFAULT to EXPRS in order to have these functions recompiled automatically"
		   T])
)

(ADDTOVAR COMPILE.TIME.CONSTANTS )

(RPAQQ RECORDCHANGEFN CHANGERECORD)

(RPAQ? CHECKUNSAVEFLG T)

(RPAQ? MSNEEDUNSAVE )
(DECLARE: EVAL@COMPILE DONTCOPY 

(RPAQQ PARSERRECORDS (SENTENCE CONJUNCTION PARSED SETPHRASE VERB VPART CVERB THAT QUOTE IN NOT PATHS 
			       APPLY CSET BLOCKS FIELDS))
[DECLARE: EVAL@COMPILE 

(RECORD SENTENCE (ID SUBJECT PREDICATE . OTHERSTUFF))

(RECORD CONJUNCTION (C START PARSED . POSSIBLES))

(RECORD PARSED (SOUGHT ITEM . ENDING))

(RECORD SETPHRASE (DET (TYPE KNOWN . DEFAULTTYPE) . REP)     (* represents a set of things)
		  (TYPE? (EQLENGTH (CADR DATUM)
				   2)))

(RECORD VERB (TENSE . VPART)
	     (SUBRECORD VPART))

(RECORD VPART (ROOT . MODIFIER))

(RECORD CVERB (C VB1 . VB2)
	      [TYPE? (FMEMB (CAR DATUM)
			    (QUOTE (OR AND ANDNOT])

(RECORD THAT (ID VERB . OTHERSET)
	     ID ←(QUOTE THAT)
	     (TYPE? (EQ (CAR DATUM)
			(QUOTE THAT))))

(RECORD QUOTE (ID . QUOTED)
	      ID ←(QUOTE QUOTE))

(RECORD IN (ID . EXPRESSION)
	   ID ←(QUOTE IN))

(RECORD NOT (ID . NEGATED)
	    ID ←(QUOTE NOT)
	    (TYPE? (EQ (CAR DATUM)
		       (QUOTE NOT))))

(RECORD PATHS (ID . PATHOPTIONS)
	      ID ←(QUOTE PATHS))

(RECORD APPLY (ID . PRED)
	      ID ←(QUOTE APPLY))

(RECORD CSET (ID SET1 . SET2))

(RECORD BLOCKS (ID TYPES FNS . FILES)
	       ID ←(QUOTE BLOCKS)                            (* e.g. ENTRIES ON FOO)
	       )

(RECORD FIELDS (ID . RECS)
	       ID ←(QUOTE FIELDS))
]

(DECLARE: EVAL@COMPILE 

(PUTPROPS GETWORDTYPE MACRO [(WORD TYPE)
			     (CDR (FASSOC TYPE (GETHASH WORD MSWORDS])
)
)



(* interactive routines)


(RPAQ MASTERSCOPEDATE " 7-Dec-84")

(ADDTOVAR HISTORYCOMS %.)
(DEFINEQ

(%.
  (NLAMBDA MASTERSCOPECOMMAND                               (* lmm "16-MAY-78 01:07")
    (MASTERSCOPE MASTERSCOPECOMMAND)))

(MASTERSCOPE
  (LAMBDA (MASTERSCOPECOMMAND TOPFLG)                       (* lmm "26-FEB-79 22:39")
                                                            (* Top level entry. If given a sentence, parse it and 
							    return; otherwise, enter into USEREXEC-like loop)
    (COND
      (MASTERSCOPECOMMAND (MSINTERPRET (MKLIST MASTERSCOPECOMMAND)
				       (NOT TOPFLG)))
      (T (MASTERSCOPE1)))))

(MASTERSCOPE1
  [LAMBDA NIL                                                (* lmm "15-Aug-84 00:35")
    (printout T "Masterscope " MASTERSCOPEDATE T)
    (PROG (X)
      ERLP[ERSETQ (PROGN (PROMPTCHAR "←. " T LISPXHISTORY)
			 (SELECTQ (SETQ X (LISPXREAD T T))
				  ((E ←)
				    (LISPX (LISPXREAD T T)
					   (QUOTE ←)))
				  ((OK STOP)
				    (RETFROM (FUNCTION MASTERSCOPE1)))
				  (LISPX X (QUOTE ←)
					 NIL
					 (FUNCTION MASTERSCOPEXEC]
          (GO ERLP])

(MASTERSCOPEXEC
  (LAMBDA (X LINE)                                          (* lmm "20-DEC-78 20:01")
                                                            (* Called via the LISPX in MASTERSCOPE)
    (PROG (MASTERSCOPECOMMAND)
          (AND (OR (COND
		     ((NULL LINE)
		                                            (* Single entry on line)
		       (OR (NOT (LITATOM X))
			   (OR (NEQ (EVALV X)
				    (QUOTE NOBIND))
			       (STRPOSL CLISPCHARRAY X)))))
		   (AND (LITATOM X)
			(FGETD X)
			(LISTP LINE)
			(OR (COND
			      ((NULL (CDR LINE))
				                            (* "EDITF ] " OR SETQ (A B) TYPE ENTRY)
				(OR (NULL (CAR LINE))
				    (LISTP (CAR LINE)))))
			    (EQ (ARGTYPE X)
				3))))
	       (RETURN))                                    (* If MASTERSCOPEXEC returns NIL, then LISPX will handle
							    the event as a normal typin)
          (SETQ MASTERSCOPECOMMAND (CONS X LINE))
          (SELECTQ (CAR MASTERSCOPECOMMAND)
		   ((OK STOP BYE ok stop)
		     (RETFROM (QUOTE MASTERSCOPE1)
			      NIL T))
		   NIL)
      LISPXVALUE
          (AND (LISTP LISPXHIST)
	       (FRPLACA LISPXHIST (CONS (QUOTE %.)
					(CAR LISPXHIST))))
                                                            (* Make sure the event shows up with a %.
							    in it)
          (SETQ LISPXVALUE (MSINTERPRET MASTERSCOPECOMMAND))
          (RETURN T))))
)



(* Interpreting commands)

(DEFINEQ

(MSINTERPRETSET
  (LAMBDA (SET OP ARG)                                      (* lmm "16-MAR-79 12:34")
    (PROG (TEM TYPE (REP (fetch (SETPHRASE REP) of SET)))
      START
          (COND
	    ((NLISTP REP)
	      (OR (NULL REP)
		  (SHOULDNT (LIST REP TEM TYPE ARG)))
	      (COND
		((fetch (SETPHRASE TYPE) of SET)
		  (replace (SETPHRASE REP) of SET with (create INRELATION
							       HTABLES ←(for TYPE
									   inside (fetch TYPE
										     of SET)
									   join (GETVERBTABLES
										  (QUOTE IS)
										  TYPE))
							       OSET ←(create SETPHRASE
									     DET ←(QUOTE ANY))))
		  (RETURN (MSINTERPRETSET SET OP ARG))))
	      (RETURN (SELECTQ OP
			       (CHECK ARG)
			       (LIST MSBLIP)
			       (HARD (LISTHARD SET))
			       (MEMB T)
			       (SHOULDNT 8))))
	    (T
	      (RETURN
		(SELECTQ
		  (fetch ID of REP)
		  (APPLY (SELECTQ OP
				  (CHECK ARG)
				  (HARD (LISTHARD SET))
				  (LIST MSBLIP)
				  (MEMB (APPLY* (fetch (APPLY PRED) of REP)
						ARG))
				  (SHOULDNT 9)))
		  (NOT (SELECTQ OP
				(CHECK (MSINTERPRETSET (fetch NEGATED of REP)
						       (QUOTE CHECK)
						       ARG))
				(HARD (LISTHARD SET))
				(LIST MSBLIP)
				(MEMB (NOT (MSINTERPRETSET (fetch NEGATED of REP)
							   (QUOTE MEMB)
							   ARG)))
				(SHOULDNT 10)))
		  (INRELATION
		    (SELECTQ OP
			     (CHECK ARG)
			     ((LIST HARD)
			       

          (* got a list of dotted pairs of hash tables and another set; want to know the set of all things which have the 
	  given relation to any in the other set)


			       (PROG ((HTABS (fetch (INRELATION HTABLES) of REP))
				      (INVERTED (fetch (INRELATION INVERTED) of REP))
				      (OTHERSET (fetch (INRELATION OSET) of REP))
				      V SET2VAL)
				     (SETQ SET2VAL (MSINTERPRETSET OTHERSET (QUOTE LIST)))
				     (COND
				       ((EQ SET2VAL MSBLIP)
					 (for R in HTABS do (MAPTABLE (COND
									(INVERTED (CDR R))
									(T (CAR R)))
								      (FUNCTION MSINTERPA))))
				       (T (for R in HTABS
					     do (for X in SET2VAL
						   do (SETQ V (UNION (GETTABLE X
									       (COND
										 (INVERTED
										   (CAR R))
										 (T (CDR R))))
								     V))))))
				     (RETURN V)))
			     (MEMB (PROG ((HTABS (fetch (INRELATION HTABLES) of REP))
					  (OTHERSET (fetch (INRELATION OSET) of REP))
					  (INVERTED (fetch (INRELATION INVERTED) of REP)))
				         (RETURN (find R in HTABS
						    suchthat (find Z
								in (GETTABLE ARG
									     (COND
									       (INVERTED
										 (CDR R))
									       (T (CAR R))))
								suchthat (MSINTERPRETSET
									   OTHERSET
									   (QUOTE MEMB)
									   Z))))))
			     (SHOULDNT 11)))
		  (GETHASH (SELECTQ OP
				    (CHECK ARG)
				    ((LIST HARD)
				      (PROG (V)
					    (for X in (fetch (GETHASH HTABLE) of REP)
					       do (SETQ V (MSHASHLIST X V NIL (fetch BADMARKS
										 of REP))))
					    (RETURN V)))
				    (MEMB (SOME (fetch HTABLE of REP)
						(FUNCTION (LAMBDA (H)
						    (AND (SETQ H (GETTABLE ARG H))
							 (NEQ H MSBLIP)
							 (NOT (EQMEMB H (fetch BADMARKS of REP))))))))
				    (SHOULDNT 12)))
		  (QUOTE (SELECTQ OP (CHECK (COND
					      (ARG (SETQ NEEDUPDATE (UNION NEEDUPDATE
									   (fetch QUOTED
									      of REP)))
						   NIL)))
				  ((HARD LIST)
				    (SETQ TYPE (OR (fetch (SETPHRASE TYPE) of SET)
						   (fetch (SETPHRASE DEFAULTTYPE) of SET)))
				    (COND
				      ((AND ARG (NEQ ARG (QUOTE FILES))
					    (NEQ TYPE (QUOTE FILES))
					    (FMEMB (SETQ TEM (fetch QUOTED of REP))
						   FILELST)
					    (COND
					      ((EQ ARG (QUOTE KNOWN))
						(NOT (OR (TESTRELQ KNOWN TEM)
							 (GETD TEM))))))
					(replace (SETPHRASE TYPE) of SET
					   with (COND
						  ((EQ ARG (QUOTE KNOWN))
						    (QUOTE FNS))
						  (T ARG)))
					(SETQ TEM (for FILE in (fetch QUOTED of REP)
						     join (ONFILE FILE ARG)))
					(printout T (fetch QUOTED of REP)
						  " => ON "
						  (fetch QUOTED of REP)
						  T)
					(replace QUOTED of (fetch (SETPHRASE REP) of SET)
					   with TEM))
				      (T (COND
					   ((AND (EQ TYPE (QUOTE FNS))
						 (GETP (fetch QUOTED of REP)
						       (QUOTE CLISPWORD))
						 (NOT (GETD (fetch QUOTED of REP))))
					     (printout T "Warning: " (fetch QUOTED of REP)
						       
					    "is a CLISP word and is not treated like a function!"
						       T)))
					 (fetch QUOTED of REP))))
				  (MEMB (FMEMB ARG (fetch QUOTED of REP)))
				  (SHOULDNT 13)))
		  (OR 

          (* I.e. WHO ON MYFILE OR @ EXPRP CALL X -
	  if either of the sets need to be KNOWN and are "vague" then the entire world needs to be updated)


		      (SELECTQ OP
			       (CHECK ((LAMBDA (X)
					  (OR (MSINTERPRETSET (fetch (CSET SET2) of REP)
							      (QUOTE CHECK)
							      ARG)
					      X))
					(MSINTERPRETSET (fetch (CSET SET1) of REP)
							(QUOTE CHECK)
							ARG)))
			       ((LIST HARD)
				 (PROG (S1 S2)
				       (RETURN (COND
						 ((EQ MSBLIP (SETQ S1 (MSINTERPRETSET
							  (fetch (CSET SET1) of REP)
							  OP)))
						   MSBLIP)
						 ((EQ MSBLIP (SETQ S2 (MSINTERPRETSET
							  (fetch (CSET SET2) of REP)
							  OP)))
						   (OR (EQ (QUOTE QUOTE)
							   (fetch ID
							      of (fetch (SETPHRASE REP)
								    of (fetch (CSET SET1)
									  of REP))))
						       (replace (SETPHRASE REP)
							  of (fetch (CSET SET1) of REP)
							  with (create QUOTE
								       QUOTED ← S1)))
						   MSBLIP)
						 (T (UNION S1 S2))))))
			       (MEMB (OR (MSINTERPRETSET (fetch (CSET SET1) of REP)
							 (QUOTE MEMB)
							 ARG)
					 (MSINTERPRETSET (fetch (CSET SET2) of REP)
							 (QUOTE MEMB)
							 ARG)))
			       (SHOULDNT 14)))
		  (AND                                      (* I.e. WHO ON MYFILE AND @ EXPRP CALL Z -- only if both
							    sets are vague does the world need updating)
		       (SELECTQ OP
				(CHECK ((LAMBDA (X)
					   (OR (MSINTERPRETSET (fetch (CSET SET2) of REP)
							       (QUOTE CHECK)
							       ARG)
					       X))
					 (MSINTERPRETSET (fetch (CSET SET1) of REP)
							 (QUOTE CHECK)
							 ARG)))
				((HARD LIST)
				  (PROG (S1 S2)
				        (RETURN (COND
						  ((EQ MSBLIP (SETQ S1 (MSINTERPRETSET
							   (fetch (CSET SET1) of REP)
							   (QUOTE LIST))))
						    (COND
						      ((EQ MSBLIP (SETQ S2
							     (MSINTERPRETSET (fetch (CSET SET2)
										of REP)
									     OP)))
							MSBLIP)
						      (T (SUBSET S2 (FUNCTION (LAMBDA (X)
								     (MSINTERPRETSET
								       (fetch (CSET SET1)
									  of REP)
								       (QUOTE MEMB)
								       X)))))))
						  (T (SUBSET S1 (FUNCTION (LAMBDA (X)
								 (MSINTERPRETSET (fetch (CSET SET2)
										    of REP)
										 (QUOTE MEMB)
										 X)))))))))
				(MEMB (AND (MSINTERPRETSET (fetch (CSET SET1) of REP)
							   (QUOTE MEMB)
							   ARG)
					   (MSINTERPRETSET (fetch (CSET SET2) of REP)
							   (QUOTE MEMB)
							   ARG)))
				(SHOULDNT 15)))
		  (ANDNOT (replace ID of REP with (QUOTE AND))
			  (replace (SETPHRASE REP) of (fetch SET2 of REP)
			     with (create NOT
					  NEGATED ←(create SETPHRASE
						      using (fetch SET2 of REP)
							    REP ←(fetch (SETPHRASE REP)
								    of (fetch SET2 of REP)))))
			  (GO RETRY))
		  (IN (SETQ REP (create QUOTE
					QUOTED ←(MKLIST (EVAL (fetch (IN EXPRESSION) of REP)))))
		      (GO RETRY))
		  (BLOCKS                                   (* Block set)
			  (SELECTQ OP
				   (CHECK ((LAMBDA (X Y)
					      (OR X Y))
					    (AND (fetch FNS of REP)
						 (MSINTERPRETSET (fetch FNS of REP)
								 (QUOTE CHECK)))
					    (AND (fetch FILES of REP)
						 (MSINTERPRETSET (fetch FILES of REP)
								 (QUOTE CHECK)))))
				   (PROGN (SETQ REP
					    (create QUOTE
						    QUOTED ←(MSGETBLOCKDEC
						      (fetch TYPES of REP)
						      (fetch FNS of REP)
						      (AND (fetch FILES of REP)
							   (MSINTERPRETSET (fetch FILES of REP)
									   (QUOTE HARD))))))
					  (GO RETRY))))
		  (FIELDS (SELECTQ OP
				   (CHECK (MSINTERPRETSET (fetch RECS of REP)
							  OP))
				   (PROGN (SETQ REP
					    (create QUOTE
						    QUOTED ←(PROG (VAL)
							          (for X
								     in (MSLISTSET (fetch RECS
										      of REP)
										   T)
								     do (SETQ VAL
									  (UNION (RECORDFIELDNAMES
										   X)
										 VAL)))
							          (RETURN VAL))))
					  (GO RETRY))))
		  (THAT
		    (PROG (TABLES (VERB (fetch (THAT VERB) of REP))
				  VALUE
				  (OS (fetch (THAT OTHERSET) of REP)))
		          (SELECTQ (fetch (VERB ROOT) of VERB)
				   ((AND OR ANDNOT)
				     (SETQ REP
				       (create CSET
					       ID ←(fetch C of (fetch VPART of VERB))
					       SET1 ←(create SETPHRASE
							using SET REP ←(create
								THAT
								VERB ←(create VERB
									      TENSE ←(fetch TENSE
											of VERB)
									      VPART ←(fetch VB1
											of
											 (fetch
											   VPART
											    of VERB)))
								OTHERSET ← OS))
					       SET2 ←(create SETPHRASE
							using SET REP ←(create
								THAT
								VERB ←(create VERB
									      TENSE ←(fetch TENSE
											of VERB)
									      VPART ←(fetch VB2
											of
											 (fetch
											   VPART
											    of VERB)))
								OTHERSET ← OS))))
				     (GO RETRY))
				   (CALL (COND
					   ((EQ (fetch (VERB MODIFIER) of VERB)
						(QUOTE SOMEHOW))
					     (SETQ REP
					       (create PATHS
						       PATHOPTIONS ←(COND
							 ((EQ (fetch TENSE of VERB)
							      (QUOTE ED))
							   (create PATHOPTIONS
								   FROM ← OS
								   TO ←(create SETPHRASE)
								   TOPFLG ← T))
							 (T (create PATHOPTIONS
								    TO ← OS
								    TOPFLG ← T)))))
					     (GO RETRY))))
				   (CONTAIN (COND
					      ((EQ (fetch DET of OS)
						   (QUOTE WHICH))
						(SHOULDNT 16)))
					    (SETQ REP
					      (create
						QUOTE
						QUOTED ←(SELECTQ
						  (fetch TENSE of VERB)
						  (ED (ONFILE (MSINTERPRETSET OS (QUOTE HARD))
							      (OR (fetch (VERB MODIFIER)
								     of VERB)
								  (fetch TYPE of SET)
								  (fetch DEFAULTTYPE of SET)
								  (QUOTE FNS))))
						  (ONFILE NIL (OR (fetch (VERB MODIFIER)
								     of VERB)
								  (fetch TYPE of OS)
								  (fetch DEFAULTTYPE of OS)
								  (QUOTE FNS))
							  (OR (MSINTERPRETSET OS (QUOTE HARD))
							      T)))))
					    (GO RETRY))
				   NIL)
		          (SELECTQ OP
				   (CHECK (SETQ VALUE (MSINTERPRETSET OS (QUOTE CHECK)
								      (fetch KNOWN of OS))))
				   NIL)
		          (SETQ TABLES (GETVERBTABLES (fetch (VERB ROOT) of VERB)
						      (fetch (VERB MODIFIER) of VERB)))
		          (replace REP of SET with (SETQ REP (create INRELATION
								     INVERTED ←(EQ (fetch TENSE
										      of VERB)
										   (QUOTE ED))
								     HTABLES ← TABLES
								     OSET ← OS)))
		      OUT (RETURN (OR (MSINTERPRETSET SET OP ARG)
				      VALUE))))
		  (PATHS (COND
			   ((EQ OP (QUOTE CHECK))
			     (CHECKPATHS (fetch PATHOPTIONS of REP)))
			   (T (SETQ REP (create GETHASH
						HTABLE ←(LIST (MSONPATH REP))
						BADMARKS ← T))
			      (GO RETRY))))
		  (SHOULDNT 17)))))
      RETRY
          (replace REP of SET with REP)
          (GO START))))

(MSINTERPA
  (LAMBDA (VAL KEY)                                         (* lmm "25-JUN-78 01:09")
    (AND (NOT (FMEMB KEY V))
	 (COND
	   ((AND (NULL (fetch TYPE of OTHERSET))
		 (NULL (fetch REP of OTHERSET)))
	     VAL)
	   (T (find Z in VAL suchthat (MSINTERPRETSET OTHERSET (QUOTE MEMB)
						      Z))))
	 (SETQ V (CONS KEY V)))))

(MSGETBLOCKDEC
  (LAMBDA (TYPE FNSET FILES)                                (* lmm "24-FEB-79 20:50")
    (PROG (VAL)
          (for FILE inside (OR FILES FILELST)
	     do (for BLOCK in (FILECOMSLST FILE (QUOTE BLOCKS))
		   when (OR (NULL FNSET)
			    (SOME BLOCK (FUNCTION (LAMBDA (FILE)
				      (AND (LITATOM FILE)
					   (MSMEMBSET FILE FNSET))))))
		   do (SELECTQ TYPE
			       ((BLKFNS BLOCK NIL)
				 (for FILE in (CDR BLOCK) when (AND (LITATOM FILE)
								    (NOT (FMEMB FILE VAL)))
				    do (SETQ VAL (CONS FILE VAL))))
			       (for Y in BLOCK when (AND (LISTP Y)
							 (EQMEMB (CAR Y)
								 TYPE))
				  do (SETQ VAL (UNION (COND
							((EQ (CADR Y)
							     (QUOTE *))
							  (EVAL (CADDR Y)))
							(T (CDR Y)))
						      VAL))))
		      (COND
			((AND (EQ TYPE (QUOTE ENTRIES))
			      (CAR BLOCK)
			      (FMEMB (CAR BLOCK)
				     (CDR BLOCK))
			      (NOT (FMEMB (CAR BLOCK)
					  VAL)))
			  (SETQ VAL (CONS (CAR BLOCK)
					  VAL)))))
		(OR FNSET (SETQ VAL (UNION (FILECOMSLST FILE (SELECTQ TYPE
								      (BLKFNS (QUOTE FNS))
								      TYPE))
					   VAL))))
          (RETURN VAL))))

(LISTHARD
  (LAMBDA (SET)                                             (* lmm "19-SEP-78 05:41")
    (PROG (VAL)
          (for TYPE inside (OR (fetch TYPE of SET)
			       (fetch DEFAULTTYPE of SET))
	     do (for TABLE in (GETVERBTABLES (QUOTE IS)
					     (COND
					       ((AND (EQ TYPE (QUOTE FNS))
						     (fetch KNOWN of SET))
						 (QUOTE KNOWN))
					       (T TYPE)))
		   do (SETQ VAL (MSHASHLIST (CAR TABLE)
					    VAL SET))))
          (RETURN VAL))))

(MSMEMBSET
  (LAMBDA (ITEM SET)                                        (* lmm: 25-JAN-76 2 20)
    (MSINTERPRETSET SET (QUOTE MEMB)
		    ITEM)))

(MSLISTSET
  (LAMBDA (SET TRYHARD TYPE)                                (* lmm " 8-JUL-78 02:11")
                                                            (* Interpret set as List -
							    return list of elements in set S, or MSBLIP if can't)
    (MSINTERPRETSET SET (COND
		      (TRYHARD (QUOTE HARD))
		      (T (QUOTE LIST)))
		    TYPE)))

(MSHASHLIST
  (LAMBDA (HTABLE PREVVALUE OTHERSET BADMARKS)              (* lmm " 8-AUG-77 15:17")
    (MAPTABLE HTABLE (FUNCTION MSHASHLIST1))
    PREVVALUE))

(MSHASHLIST1
  (LAMBDA (VAL KEY)                                         (* lmm " 8-AUG-77 15:16")
    (AND (NEQ VAL MSBLIP)
	 (NOT (EQMEMB VAL BADMARKS))
	 (NOT (FMEMB KEY PREVVALUE))
	 (OR (NULL OTHERSET)
	     (MSMEMBSET KEY OTHERSET))
	 (SETQ PREVVALUE (CONS KEY PREVVALUE)))))

(CHECKPATHS
  (LAMBDA (OPTIONS VAL)                                     (* lmm "20-DEC-78 20:03")
    (PROG (VAL)
          (for PR in OPTIONS when (FMEMB (CAR PR)
					 (QUOTE (FROM TO AVOIDING NOTRACE MARKING SEPARATE)))
	     do (AND (MSINTERPRETSET (CDR PR)
				     (QUOTE CHECK)
				     (EQ (CAR PR)
					 (QUOTE FROM)))
		     (SETQ VAL T)))
          (RETURN (OR VAL (NULL (FASSOC (QUOTE FROM)
					OPTIONS)))))))

(ONFILE
  [LAMBDA (FILES TYPES FINDITEMS)
                                   (* lmm " 1-JUN-81 23:06")
                                   (* MSHASHFILENAME uses cause GETRELATION barfs if CONTAINS table doesn't exist.)
    (PROG (VAL)
          [for FILE (FNSONLY ←(AND MSHASHFILENAME (SELECTQ (COND
							     ((AND (LISTP TYPES)
								   (NULL (CDR TYPES))
								   (CAR TYPES)))
							     (T TYPES))
							   ((FNS KNOWN NIL)
							     T)
							   NIL)))
	     inside (OR FILES FILELST)
	     do                    (* Don't notice the file if we only care about FNS and the file is known to the 
				   database.)
		[COND
		  [(AND FNSONLY (NOT (MEMB FILE FILELST))
			(GETRELATION FILE (QUOTE CONTAINS]
		  (T (SETQ FILE (CAR (MSNOTICEFILE FILE]
		(for TYPE inside TYPES do (SETQ TYPE (SELECTQ TYPE
							      ((FNS KNOWN NIL)
								(QUOTE FNS))
							      TYPE))
					  (COND
					    [FINDITEMS (OR (FMEMB FILE VAL)
							   (AND (find X inside FINDITEMS
								   suchthat (INFILECOMS?
									      X TYPE (FILECOMS FILE)))
								(SETQ VAL (CONS FILE VAL]
					    (T (SETQ VAL (UNION (FILECOMSLST FILE TYPE)
								VAL]
          [COND
	    ((AND MSHASHFILENAME (NULL VAL)
		  (find TYPE inside TYPES suchthat (SELECTQ TYPE
							    ((FNS KNOWN NIL)
							      T)
							    NIL)))
                                   (* Didn't find it in core; perhaps the CONTAINS table knows)
	      (COND
		[FILES (for FILE inside FILES do (COND
						   (FINDITEMS (for X inside FINDITEMS
								 when (TESTRELATION X (QUOTE CONTAINS)
										    FILE T)
								 do (pushnew VAL FILE)))
						   (T (SETQ VAL (UNION (GETRELATION FILE
										    (QUOTE CONTAINS))
								       VAL]
		(FINDITEMS 

          (* No files: should use all known files, but that information isn't explicitly kept by MSHASH.
	  Soooo, we'll only do the case where FINDITEMS is given)


			   (for X inside FINDITEMS do (SETQ VAL (UNION (GETRELATION X (QUOTE CONTAINS)
										    T)
								       VAL]
          (RETURN VAL])
)
(DEFINEQ

(MSINTERPRET
  [LAMBDA (COMMAND SUBROUTINE)                               (* lmm "15-Aug-84 00:39")
    (RESETLST
      (RESETSAVE (OUTPUT T))
      (RESETSAVE (LINELENGTH))
      (RESETSAVE (SETREADTABLE T))
      (RESETVARS ((EDITQUIETFLG EDITQUIETFLG))
	         (RETURN
		   (PROG (VAL)
		         (SELECTQ (CAR COMMAND)
				  ((; * -)
				    (RETURN))
				  NIL)
		         (SETQ VAL (MSPARSE COMMAND))
		         (COND
			   ((EQ MSPRINTFLG T)
			     (PRINT VAL T)))
		         (COND
			   ((EQ (CAR VAL)
				(QUOTE OUTPUT))
			     (MSOUTPUT (CADR VAL))
			     (SETQ VAL (CDDR VAL))
			     (MAPRINT COMMAND NIL ". " "
")))                                                         (* Now to interpret)
		         [COND
			   ((AND (EQ (CAR VAL)
				     (QUOTE ERASE))
				 (NULL (CDR VAL)))
			     (MSERASE T)
			     (RETURN (QUOTE ok]
		         (MSINIT)
		         (RETURN
			   (SELECTQ
			     (fetch ID of VAL)
			     (REANALYZE                      (* Definitly don't want to CHECKFORCHANGED before the 
							     ANALYZE is done)
					[MAPC (MSLISTSET (CDR VAL)
							 T
							 (QUOTE KNOWN))
					      (FUNCTION (LAMBDA (X)
						  (UPDATEFN X T]
					(QUOTE done))
			     (ANALYZE (CHECKFORCHANGED (SETQ VAL (CDR VAL)))
				      (COND
					((EQ (SETQ VAL (MSLISTSET VAL NIL (QUOTE KNOWN)))
					     MSBLIP)
					  (printout T 
					      "Sorry, can't figure out which functions you mean."
						    T)
					  (ERROR!)))
				      (MAPC VAL (FUNCTION UPDATEFN))
				      (QUOTE done))
			     ((EDIT SHOW)
			       [PROG (DONE NEEDUPDATE UPDATEALL TYPE (EDIT (fetch ID of VAL))
					   REL SHOWSET (EDITCOMS (fetch OTHERSTUFF of VAL))
					   (SUBJECT (fetch (SENTENCE SUBJECT) of VAL))
					   (PREDICATE (fetch (SENTENCE PREDICATE) of VAL))
					   REP)
				     (DECLARE (SPECVARS TYPE SHOWSET EDIT EDITCOMS DONE))
				     [COND
				       ((NULL PREDICATE)     (* EDIT ANY CALLING FOO -- just call EDITFNS)
					 (CHECKFORCHANGED SUBJECT)
					 (RETURN (MAPC (MSLISTSET SUBJECT T)
						       (FUNCTION (LAMBDA (FN)
							   (PRIN2 FN T)
							   (PRIN1 " :
" T)
							   (OR (NLSETQ (PRINT (APPLY (QUOTE EDITF)
										     (CONS FN 
											 EDITCOMS))
									      T))
							       (PRINT (QUOTE failed)
								      T]
				     [SETQ REL (fetch (THAT VERB) of (SETQ REP (fetch (SETPHRASE
											REP)
										  of PREDICATE]
				     (SETQ SHOWSET (fetch (THAT OTHERSET) of REP))
				     [COND
				       ((EQ (fetch TENSE of REL)
					    (QUOTE ED))
					 (replace TENSE of REL with (QUOTE S))
					 (SETQ PREDICATE (create SETPHRASE
								 REP ←(create THAT
									      VERB ← REL
									      OTHERSET ←(SETQ SHOWSET
										(PROG1 SUBJECT
										       (SETQ SUBJECT 
											 SHOWSET]
				     (SETQ TYPE (VERBNOTICELIST (fetch VPART of REL)))
				     (SETQ UPDATEALL (MSINTERPRETSET SUBJECT (QUOTE CHECK)
								     T))
				     [for FN in NEEDUPDATE
					do (COND
					     ((GETHASH FN MSCHANGEDARRAY)
					       (MSSHOWUSE FN TYPE SHOWSET EDIT NIL EDITCOMS)
					       (SETQ DONE (CONS FN DONE)))
					     (T (UPDATEFN FN]
				     (COND
				       (UPDATEALL [MAPHASH MSCHANGEDARRAY
							   (FUNCTION (LAMBDA (VAL KEY)
							       (AND (OR (EQ VAL T)
									(TESTRELQ KNOWN KEY)
									(TESTRELQ (CALL NOTERROR)
										  KEY T))
								    (COND
								      ((MSSHOWUSE KEY TYPE SHOWSET 
										  EDIT (QUOTE CHANGED)
										  EDITCOMS)
									(SETQ DONE (CONS KEY DONE]
						  (MSCHECKEMPTY)))
				     (MAPC (MSLISTSET (MSJOINSET (QUOTE AND)
								 PREDICATE SUBJECT)
						      T)
					   (FUNCTION (LAMBDA (AT)
					       (AND (NOT (FMEMB AT DONE))
						    (MSSHOWUSE AT TYPE SHOWSET EDIT NIL EDITCOMS]
			       (QUOTE done))
			     (? [CHECKFORCHANGED (SETQ VAL (MSJOINSET (QUOTE AND)
								      (fetch PREDICATE of VAL)
								      (fetch SUBJECT of VAL]
				(OR SUBROUTINE (TAB 0 0))
				(MSSOLVE VAL))
			     (PATHS
			       (PROG ([INVERTED
					(for X on (CDR VAL) bind FROMFOUND
					   do (SELECTQ (CAAR X)
						       (FROM (SETQ FROMFOUND T))
						       (TO (RETURN (NOT FROMFOUND)))
						       NIL)
					   finally
					    (RETURN
					      (COND
						(FROMFOUND NIL)
						(T
						  (FRPLACD
						    VAL
						    (CONS [CONS (QUOTE FROM)
								(create SETPHRASE
									REP ←(create
									  THAT
									  VERB ←(create VERB
											ROOT ←(QUOTE
											  IS)
											MODIFIER ←(
											  QUOTE
											  KNOWN))
									  OTHERSET ←(create SETPHRASE]
							  (CDR VAL)))
						  NIL]
				      NEEDUPDATE UPDATEALL TEM)
				     (SETQ UPDATEALL (CHECKPATHS (fetch PATHOPTIONS of VAL)))
				     (for X in NEEDUPDATE do (UPDATEFN X))
				     (COND
				       (UPDATEALL (UPDATECHANGED)
						  (MSCHECKEMPTY)))
				     (COND
				       ((SETQ TEM (fetch OUTPUT of (CDR VAL)))
					 (MSOUTPUT TEM)))
				     (AND (SETQ TEM (fetch (PATHOPTIONS LINELENGTH)
						       of (CDR VAL)))
					  (RESETSAVE (LINELENGTH TEM)))

          (* Display paths; must print all of FROM, with separate tree for all of SEPARATE (considered as a subset of FROM).
	  Stop when you get to a function in NOTRACE, -- unless TO is NIL, only print paths that eventually reach an element
	  of TO. If INVERTED is not NIL, print inverted tree. Do not print out functions in AVOIDING)


				     [SETQ MSTHOSE (MSPATHS [COND
							      (INVERTED (fetch TO
									   of (fetch PATHOPTIONS
										 of VAL)))
							      (T (fetch FROM
								    of (fetch PATHOPTIONS
									  of VAL]
							    [COND
							      (INVERTED (fetch FROM
									   of (fetch PATHOPTIONS
										 of VAL)))
							      (T (fetch TO
								    of (fetch PATHOPTIONS
									  of VAL]
							    INVERTED
							    (fetch AVOIDING
							       of (fetch PATHOPTIONS of VAL))
							    (fetch SEPARATE
							       of (fetch PATHOPTIONS of VAL))
							    (fetch NOTRACE
							       of (fetch PATHOPTIONS of VAL))
							    (fetch MARKING
							       of (fetch PATHOPTIONS of VAL]
				     (QUOTE done)))
			     (ERASE                          (* case of plain ERASE taken care of earlier)
				    (MSERASE (MSLISTSET (CDR VAL)
							T
							(QUOTE KNOWN)))
				    (QUOTE ok))
			     (DESCRIBE (CHECKFORCHANGED (CDR VAL)
							NIL T)
                                                             (* Need to update the world since will print out CALLED 
							     BY:)
				       (TAB 0 0)
				       (MAPC (MSLISTSET (CDR VAL)
							T)
					     (FUNCTION MSDESCRIBE)))
			     (FOR (CHECKFORCHANGED (CADDDR VAL))
				  (FRPLACA (CDDDR VAL)
					   (KWOTE (MSLISTSET (CADDDR VAL)
							     T)))
				  (EVAL VAL))
			     [CHECK (CHECKFORCHANGED (CDR VAL))
				    (MSCHECKBLOCKS (AND (CDR VAL)
							(MSLISTSET (CDR VAL)
								   (QUOTE HARD)
								   (QUOTE FILES]
			     (SHOULDNT 18])

(VERBNOTICELIST
  (LAMBDA (VPART)                                           (* lmm "31-DEC-78 15:10")
    (COND
      ((type? CVERB VPART)
	(UNION (VERBNOTICELIST (fetch VB1 of VPART))
	       (VERBNOTICELIST (fetch VB2 of VPART))))
      (T (OR (MSVBNOTICED (fetch (VPART ROOT) of VPART)
			  (fetch (VPART MODIFIER) of VPART))
	     (PROGN (printout T "can't SHOW or EDIT where things " (fetch (VPART ROOT) of VPART)
			      ,
			      (OR (fetch (VPART MODIFIER) of VPART)
				  "")
			      "!" T)
		    (ERROR!)))))))

(MSOUTPUT
  (LAMBDA (FILE)                                            (* lmm "13-AUG-77 12:16")
                                                            (* OUTPUT is already RESETSAVE'd)
    (COND
      ((OPENP FILE (QUOTE OUTPUT))
	(OUTPUT FILE))
      (T (OUTFILE FILE)
	 (RESETSAVE NIL (LIST (QUOTE CLOSEF)
			      FILE))))                      (* output to file, reset LINELENGTH)
    (LINELENGTH FILELINELENGTH)))

(MSCHECKEMPTY
  (LAMBDA NIL                                               (* lmm "20-JAN-79 14:08")
    (PROG (Q CF)
          (COND
	    (MSDBEMPTY (printout T "No functions have been analyzed!" T)
		       (UPDATEFILES)
		       (SETQ CF (FILEPKGCHANGES (QUOTE FNS)))
		       (COND
			 ((AND (SETQ Q (APPEND (AND FILELST (LIST (QUOTE ON)
								  (QUOTE ')
								  FILELST))
					       (AND CF FILELST (QUOTE (OR)))
					       (AND CF (LIST (QUOTE IN)
							     (QUOTE ')
							     CF))))
			       (EQ (ASKUSER (AND (FIXP DWIMWAIT)
						 (ITIMES 10 DWIMWAIT))
					    (QUOTE (Y))
					    (CONS "want to ." (SETQ Q (APPEND (QUOTE (ANALYZE THE FNS)
										     )
									      Q)))
					    (QUOTE ((Y "es
")
						     (N "o
"))))
				   (QUOTE Y)))
			   (MASTERSCOPE Q)
			   (COND
			     (MSDBEMPTY (printout T "Sorry, no functions were found to analyze!" T))
			     (T (RETURN)))))
		       (ERROR!))))))

(CHECKFORCHANGED
  (LAMBDA (SET NOTTHISONE UPDATEALL)                        (* lmm "25-JUN-78 01:03")
    (PROG (NEEDUPDATE)
          (SETQ UPDATEALL (OR (MSINTERPRETSET SET (QUOTE CHECK)
					      (AND (NOT NOTTHISONE)
						   (fetch KNOWN of SET)))
			      UPDATEALL))
          (for X in NEEDUPDATE do (UPDATEFN X))
          (COND
	    (UPDATEALL (UPDATECHANGED)
		       (MSCHECKEMPTY))))))

(MSSOLVE
  (LAMBDA (SET)                                             (* lmm "21-DEC-78 22:16")
    (SETQ MSTHOSE (MSLISTSET SET T))
    (PROG (ND QT OSET REP)
          (SETQ REP (fetch REP of SET))
          (OR (SELECTQ (fetch ID of REP)
		       (AND (SETQ ND (fetch SET2 of REP))
			    (AND (EQ (fetch ID of (SETQ REP (fetch REP of (fetch SET1 of REP))))
				     (QUOTE INRELATION))
				 (EQ (fetch DET of (SETQ OSET (fetch OSET of REP)))
				     (QUOTE WHICH))))
		       (INRELATION (EQ (fetch DET of (SETQ OSET (fetch OSET of REP)))
				       (QUOTE WHICH)))
		       NIL)
	      (RETURN (PROGN (SETQ ND (COND
				 ((EQ (fetch (SETPHRASE DET) of SET)
				      (QUOTE WHICH))
				   MSTHOSE)
				 (T (NOT (NULL MSTHOSE)))))
			     (COND
			       ((EQ (OUTPUT)
				    T)
				 ND)
			       (T (PRINT ND)
				  (QUOTE done))))))
          (replace REP of SET with REP)
          (replace INVERTED of REP with (NOT (fetch INVERTED of REP)))
          (replace OSET of REP with (create SETPHRASE
					    REP ←(create QUOTE
							 QUOTED ←(SETQ QT (LIST NIL)))))
          (MAPC MSTHOSE (FUNCTION (LAMBDA (FN)
		    (PRIN2 FN)
		    (PRIN1 " -- ")
		    (FRPLACA QT FN)
		    (PRINT (SUBSET (MSLISTSET SET T)
				   (FUNCTION (LAMBDA (X)
				       (MSMEMBSET X OSET))))))))
          (RETURN (QUOTE done)))))
)
(DECLARE: DONTCOPY 
[DECLARE: EVAL@COMPILE 

(RECORD GETHASH (ID HTABLE . BADMARKS)
		ID ←(QUOTE GETHASH))

(RECORD INRELATION (ID (INVERTED . HTABLES) . OSET)
		   ID ←(QUOTE INRELATION))

(ASSOCRECORD PATHOPTIONS (TO FROM AVOIDING SEPARATE NOTRACE TOPFLG OUTPUT LINELENGTH MARKING)
                                                             (* CHECKPATHS assumes that this is an ASSOCRECORD)
			 )
]
)
(DECLARE: DONTCOPY 

(RPAQQ MSCOMPILETIME [[P (MAPC (QUOTE (GETRELQ TESTRELQ SCRATCHASH))
			       (FUNCTION (LAMBDA (X)
						 (PUTHASH X (QUOTE MACRO)
							  USERTEMPLATES]
	(BLOCKS (NIL %. MSMARKCHANGE1 MSFIND (LOCALVARS . T))
		(MSSTOREDATA MSSTOREDATA MSCOLLECTDATA (LOCALFREEVARS FNDATA)
			     (NOLINKFNS . T))
		(MASTERSCOPEBLOCK MSINTERPRETSET CHANGEI.S. CHANGEMACRO CHANGERECORD CHANGEVAR 
				  CHECKFORCHANGED CHECKPATHS DUMPDATABASE DUMPDATABASE1 FMAPRINT 
				  GETRELATION GETTEMPLATE GETVERBTABLES LISTHARD MAPRELATION 
				  MASTERSCOPE MASTERSCOPE1 MASTERSCOPEXEC MSCHECKEMPTY MSCLOSEFILES 
				  MSDESCRIBE MSDESCRIBE1 MSERASE MSGETBLOCKDEC MSGETDEF MSHASHLIST 
				  MSHASHLIST1 MSINIT MSINTERPA MSINTERPRET MSLISTSET MSMARKCHANGED 
				  MSMEMBSET MSNEEDUNSAVE MSNLAMBDACHECK MSNOTICEFILE MSOUTPUT 
				  MSPRINTHELPFILE MSSHOWUSE MSSOLVE MSUPDATE MSUPDATEFN1 ONFILE 
				  PARSERELATION PARSERELATION1 READATABASE SETTEMPLATE TEMPLATE 
				  TESTRELATION UNSAVEFNS UPDATECHANGED UPDATECHANGED1 UPDATEFN 
				  VERBNOTICELIST
				  (ENTRIES CHANGERECORD DUMPDATABASE DUMPDATABASE1 GETRELATION 
					   GETTEMPLATE MAPRELATION MASTERSCOPE MASTERSCOPEXEC 
					   MSCLOSEFILES MSHASHLIST1 MSINTERPA MSMARKCHANGED MSMEMBSET 
					   MSLISTSET MSNEEDUNSAVE MSNOTICEFILE MSSHOWUSE 
					   PARSERELATION READATABASE SETTEMPLATE TESTRELATION 
					   UNSAVEFNS UPDATECHANGED UPDATECHANGED1 UPDATEFN MSLISTSET 
					   MSDESCRIBE)
				  (RETFNS MASTERSCOPE1)
				  (SPECVARS ANYFOUND BADMARKS FNDATA NEEDUPDATE OTHERSET PREVVALUE 
					    SHOWFN V VARS)
				  (NOLINKFNS . T)))
	(GLOBALVARS RETFNS BLKLIBRARY NOLINKFNS LINKFNS DONTCOMPILEFNS CHECKUNSAVEFLG CLISPCHARRAY 
		    CLISPIFYPRETTYFLG DWIMIFYCOMPFLG DWIMWAIT FILELINELENGTH FILELST FILEPKGFLG 
		    FILERDTBL LISPXHISTORY MASTERSCOPEDATE MSBLIP MSCHANGEDARRAY MSDATABASEINIT 
		    NODUMPRELATIONS MSDBEMPTY MSERRORFN MSFILELST MSHELPFILE MSNEEDUNSAVE MSOPENFILES 
		    MSPRINTCNT MSPRINTFLG MSRECORDTRANFLG MSTEMPLATES MSTHOSE NOTCOMPILEDFILES 
		    RECOMPILEDEFAULT TABLE.TO.NOTICED USERTEMPLATES MSDATABASELST GLOBALVARS 
		    EDITQUIETFLG MSHASHFILENAME ANALYZEUSERFNS)
	(DECLARE: EVAL@COMPILE (P (CLISPDEC (QUOTE FAST])
[MAPC (QUOTE (GETRELQ TESTRELQ SCRATCHASH))
      (FUNCTION (LAMBDA (X)
			(PUTHASH X (QUOTE MACRO)
				 USERTEMPLATES]
[DECLARE: DONTEVAL@LOAD DOEVAL@COMPILE DONTCOPY
(BLOCK: NIL %. MSMARKCHANGE1 MSFIND (LOCALVARS . T))
(BLOCK: MSSTOREDATA MSSTOREDATA MSCOLLECTDATA (LOCALFREEVARS FNDATA)
	(NOLINKFNS . T))
(BLOCK: MASTERSCOPEBLOCK MSINTERPRETSET CHANGEI.S. CHANGEMACRO CHANGERECORD CHANGEVAR CHECKFORCHANGED 
	CHECKPATHS DUMPDATABASE DUMPDATABASE1 FMAPRINT GETRELATION GETTEMPLATE GETVERBTABLES LISTHARD 
	MAPRELATION MASTERSCOPE MASTERSCOPE1 MASTERSCOPEXEC MSCHECKEMPTY MSCLOSEFILES MSDESCRIBE 
	MSDESCRIBE1 MSERASE MSGETBLOCKDEC MSGETDEF MSHASHLIST MSHASHLIST1 MSINIT MSINTERPA 
	MSINTERPRET MSLISTSET MSMARKCHANGED MSMEMBSET MSNEEDUNSAVE MSNLAMBDACHECK MSNOTICEFILE 
	MSOUTPUT MSPRINTHELPFILE MSSHOWUSE MSSOLVE MSUPDATE MSUPDATEFN1 ONFILE PARSERELATION 
	PARSERELATION1 READATABASE SETTEMPLATE TEMPLATE TESTRELATION UNSAVEFNS UPDATECHANGED 
	UPDATECHANGED1 UPDATEFN VERBNOTICELIST
	(ENTRIES CHANGERECORD DUMPDATABASE DUMPDATABASE1 GETRELATION GETTEMPLATE MAPRELATION 
		 MASTERSCOPE MASTERSCOPEXEC MSCLOSEFILES MSHASHLIST1 MSINTERPA MSMARKCHANGED 
		 MSMEMBSET MSLISTSET MSNEEDUNSAVE MSNOTICEFILE MSSHOWUSE PARSERELATION READATABASE 
		 SETTEMPLATE TESTRELATION UNSAVEFNS UPDATECHANGED UPDATECHANGED1 UPDATEFN MSLISTSET 
		 MSDESCRIBE)
	(RETFNS MASTERSCOPE1)
	(SPECVARS ANYFOUND BADMARKS FNDATA NEEDUPDATE OTHERSET PREVVALUE SHOWFN V VARS)
	(NOLINKFNS . T))
]
(DECLARE: DOEVAL@COMPILE DONTCOPY

(GLOBALVARS RETFNS BLKLIBRARY NOLINKFNS LINKFNS DONTCOMPILEFNS CHECKUNSAVEFLG CLISPCHARRAY 
	    CLISPIFYPRETTYFLG DWIMIFYCOMPFLG DWIMWAIT FILELINELENGTH FILELST FILEPKGFLG FILERDTBL 
	    LISPXHISTORY MASTERSCOPEDATE MSBLIP MSCHANGEDARRAY MSDATABASEINIT NODUMPRELATIONS 
	    MSDBEMPTY MSERRORFN MSFILELST MSHELPFILE MSNEEDUNSAVE MSOPENFILES MSPRINTCNT MSPRINTFLG 
	    MSRECORDTRANFLG MSTEMPLATES MSTHOSE NOTCOMPILEDFILES RECOMPILEDEFAULT TABLE.TO.NOTICED 
	    USERTEMPLATES MSDATABASELST GLOBALVARS EDITQUIETFLG MSHASHFILENAME ANALYZEUSERFNS)
)
(DECLARE: EVAL@COMPILE 
(CLISPDEC (QUOTE FAST))
)
)
(DECLARE: DONTEVAL@LOAD DOEVAL@COMPILE DONTCOPY COMPILERVARS 

(ADDTOVAR NLAMA %.)

(ADDTOVAR NLAML )

(ADDTOVAR LAMA )
)
(PUTPROPS MASTERSCOPE COPYRIGHT ("Xerox Corporation" 1983 1984))
(DECLARE: DONTCOPY
  (FILEMAP (NIL (2136 15924 (UPDATEFN 2146 . 3135) (MSGETDEF 3137 . 7348) (MSNOTICEFILE 7350 . 9727) (
MSSHOWUSE 9729 . 12239) (MSUPDATEFN1 12241 . 12829) (MSUPDATE 12831 . 14770) (MSNLAMBDACHECK 14772 . 
15387) (MSCOLLECTDATA 15389 . 15922)) (15925 16653 (UPDATECHANGED 15935 . 16230) (UPDATECHANGED1 16232
 . 16651)) (17068 17497 (MSCLOSEFILES 17078 . 17495)) (18196 21618 (MSDESCRIBE 18206 . 20384) (
MSDESCRIBE1 20386 . 21120) (FMAPRINT 21122 . 21616)) (21738 22160 (MSPRINTHELPFILE 21748 . 22158)) (
22274 24377 (TEMPLATE 22284 . 23371) (GETTEMPLATE 23373 . 23506) (SETTEMPLATE 23508 . 24375)) (25981 
30407 (MSMARKCHANGE1 25991 . 26695) (MSINIT 26697 . 28139) (GETVERBTABLES 28141 . 28465) (MSSTOREDATA 
28467 . 29596) (STORETABLE 29598 . 30405)) (31317 34524 (PARSERELATION 31327 . 31767) (PARSERELATION1 
31769 . 32843) (GETRELATION 32845 . 33371) (MAPRELATION 33373 . 34022) (TESTRELATION 34024 . 34522)) (
34560 35908 (ADDHASH 34570 . 34933) (SUBHASH 34935 . 35150) (MAKEHASH 35152 . 35295) (MSREHASH 35297
 . 35706) (EQMEMBHASH 35708 . 35906)) (36233 39665 (MSVBTABLES 36243 . 39663)) (41472 41797 (MSERASE 
41482 . 41795)) (41825 43889 (DUMPDATABASE 41835 . 42808) (DUMPDATABASE1 42810 . 43093) (READATABASE 
43095 . 43887)) (44833 62570 (MSCHECKBLOCKS 44843 . 46644) (MSCHECKBLOCK 46646 . 51770) (
MSCHECKFNINBLOCK 51772 . 53917) (MSCHECKBLOCKBASIC 53919 . 55771) (MSCHECKBOUNDFREE 55773 . 56805) (
GLOBALVARP 56807 . 56973) (PRINTERROR 56975 . 58848) (MSCHECKVARS1 58850 . 60654) (UNECCSPEC 60656 . 
60900) (NECCSPEC 60902 . 61215) (SPECVARP 61217 . 61655) (SHORTLST 61657 . 62007) (DOERROR 62009 . 
62568)) (63581 73092 (MSPATHS 63591 . 65216) (MSPATHS1 65218 . 67677) (MSPATHS2 67679 . 70076) (
MSONPATH 70078 . 71004) (MSPATHS4 71006 . 71819) (DASHES 71821 . 72253) (DOTABS 72255 . 72462) (
BELOWMARKER 72464 . 72883) (MSPATHSPRINTFN 72885 . 73090)) (73446 73670 (MSFIND 73456 . 73668)) (74172
 79141 (MSMARKCHANGED 74182 . 74627) (CHANGEMACRO 74629 . 75293) (CHANGEVAR 75295 . 75603) (CHANGEI.S.
 75605 . 76362) (CHANGERECORD 76364 . 76842) (MSNEEDUNSAVE 76844 . 77539) (UNSAVEFNS 77541 . 79139)) (
81003 83488 (%. 81013 . 81151) (MASTERSCOPE 81153 . 81580) (MASTERSCOPE1 81582 . 82067) (
MASTERSCOPEXEC 82069 . 83486)) (83523 101835 (MSINTERPRETSET 83533 . 96078) (MSINTERPA 96080 . 96457) 
(MSGETBLOCKDEC 96459 . 97672) (LISTHARD 97674 . 98212) (MSMEMBSET 98214 . 98373) (MSLISTSET 98375 . 
98742) (MSHASHLIST 98744 . 98908) (MSHASHLIST1 98910 . 99201) (CHECKPATHS 99203 . 99651) (ONFILE 99653
 . 101833)) (101836 113140 (MSINTERPRET 101846 . 109232) (VERBNOTICELIST 109234 . 109827) (MSOUTPUT 
109829 . 110265) (MSCHECKEMPTY 110267 . 111214) (CHECKFORCHANGED 111216 . 111658) (MSSOLVE 111660 . 
113138)))))
STOP