(FILECREATED "19-Jun-86 15:12:37" {ERIS}<LISPCORE>SOURCES>MASTERSCOPE.;24
 119832 

      changes to:  (VARS MASTERSCOPECOMS)

      previous date: "13-Jan-86 16:59:34" {ERIS}<LISPCORE>SOURCES>MASTERSCOPE.;23)


(* Copyright (c) 1983, 1984, 1985, 1986 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 [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 
                                   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 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 MSHASHFILE 
                            ANALYZEUSERFNS)
                     [DECLARE: EVAL@COMPILE (P (CLISPDEC (QUOTE FAST]
                     (FILES (LOADCOMP)
                            MSANALYZE)))
        (DECLARE: DONTEVAL@LOAD DOEVAL@COMPILE DONTCOPY COMPILERVARS (ADDVARS (NLAMA %.)
                                                                            (NLAML)
                                                                            (LAMA])

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

(UPDATEFN

  [LAMBDA (FN EVENIFVALID IFCANT)                            (* lmm "22-Jul-85 18:37")

                                                             (* 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 (
GETDEF
 FN (
QUOTE
 FNS)
					    (
SELECTQ
 IFCANT
						       (0 (
QUOTE
 CURRENT))
						       (
QUOTE
 ?))
					    (
QUOTE
 (NOERROR NOCOPY MASTERSCOPE]
                                                             (* 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])

(MSNOTICEFILE

  [LAMBDA (FILE)                                             (* lmm "22-Jul-85 18:24")

    (DECLARE
 (
GLOBALVARS
 MSHASHFILE LOADDBFLG))
    (
PROG
 (FULL COMS TEM)
	LP  (
COND

	      ((
SETQ
 TEM (
FASSOC
 FILE MSFILELST))        (* already noticed)

		(
RETURN
 TEM)))
	    (
OR
 COMS (
SETQ
 COMS (
FILECOMS
 FILE)))
	    (
SETQ
 FULL (
FINDFILE
 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]                         (* either the file has never been loaded, or an 

							     explicit <FOO> was given)

		(
OR
 FULL (
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

						     (MSHASHFILE 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 " 1-Jul-85 20:48")

    (
PROG
 (DEF ANYFOUND)
	    (
COND

	      ([
SETQ
 DEF (
OR
 (
GETDEF
 SHOWFN (
QUOTE
 FNS)
					   (if
 (
EQ
 SHOWEDIT (
QUOTE
 SHOW))
					       then
 (
QUOTE
 ?)
					     else
 (
QUOTE
 CURRENT))
					   (
QUOTE
 (NOERROR NODWIM NOCOPY)))
				 (
AND
 (
EQ
 SHOWEDIT (
QUOTE
 EDIT))
					(LET ((FILE (
EDITLOADFNS?
 SHOWFN)))
					     (
COND

					       (FILE (
LOADFNS
 SHOWFN FILE (
QUOTE
 PROP))
						     (
GETPROP
 SHOWFN (
QUOTE
 EXPR]
                                                             (* was (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-Jul-85 18:40")

                                                             (* Subfunction of UPDATEFN -- notices all of the "new" 

							     functions called by FN)

    (MSUPDATE
 FN DEF EACHTIME)
    (
AND
 DOSUBFNS (for
 X in
 (GETRELQ (CALL NOTERROR)
				     FN)
		     when
 (
NOT
 (TESTRELQ KNOWN X))
		     do
 (
PROG
 (DEF)
			      (
AND
 [
SETQ
 DEF (
GETDEF
 X (
QUOTE
 FNS)
						     (
QUOTE
 CURRENT)
						     (
QUOTE
 (NOCOPY NODWIM NOERROR MASTERSCOPE]
				   (MSUPDATEFN1
 X DEF EACHTIME T])

(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 "22-Jul-85 18:15")

    (
COND

      [(
OR
 (
EQ
 VAL T)
	     (TESTRELQ KNOWN KEY)
	     (TESTRELQ (CALL NOTERROR)
		       KEY T))
	(
COND

	  ([
SETQ
 VAL (
GETDEF
 KEY (
QUOTE
 FNS)
				 (
QUOTE
 ?)
				 (
QUOTE
 (NOERROR NOCOPY MASTERSCOPE]
	    (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 MSHASHFILE
 )

(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 "22-Jul-85 18:16")

                                                             (* 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]
	    (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]
                       (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)                                         (* lmm "29-Jul-85 21:06")

                                                             (* This function should be called at the beginning of 

							     any function which accesses the data base)

    (
COND

      ((
OR
 (
NULL
 MSDATABASELST)
	   (
LISTP
 DATABASE))
	(
SETQ
 MSDATABASELST)
	(pushnew
 MARKASCHANGEDFNS (
QUOTE
 MSMARKCHANGED))
	(
SETQ
 MSCHANGEDARRAY (
HASHARRAY
 128))

          (* 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]
			       finally
 (
SETQ
 MSFILETABLE (
ASSOC
 (
QUOTE
 FILE)
								$$VAL))
				       (
SETQ
 MSARGTABLE (
ASSOC
 (
QUOTE
 ARGS)
							       $$VAL]
	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% + 62Q 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
) 62Q)))

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

(MSVBTABLES

  [LAMBDA (
VERB
 MOD)                                         (* gbn " 5-Jun-85 20:39")

    [
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)                                            (* lmm "22-Jul-85 18:25")

    (
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
 (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) 36Q)) 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 12Q)))) (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 "21-Mar-85 08:29") (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 ARG (CDR 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 24Q)) 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 24Q) (PRIN1 (QUOTE -))) (
PRIN1 (COND ((LISTP MARKER) (* OR (EQMEMB (QUOTE NOLINE) PRINTOPTIONS)) (PRIN1 "------------   ") (OR 
(CAR MARKER) (QUOTE ""))) (T (PRIN1 "--- overflow - ") MARKER)))))

(DOTABS

(LAMBDA (LST) (* lmm: 23Q MAY 113Q 222Q) (COND ((NULL LST) NIL) (T (DOTABS (CDR LST)) (TAB (CAR LST) 0
) (PRIN1 "|")))))

(BELOWMARKER

(LAMBDA NIL (* lmm "22-JUN-78 00:15") (* lmm: 32Q MAY 113Q 3327Q) (PROG1 (COND ((ILESSP BELOWCNT 32Q) 
(FCHARACTER (IPLUS 141Q BELOWCNT))) (T (PACK* (FCHARACTER (IPLUS 141Q (IREMAINDER BELOWCNT 32Q))) (
IQUOTIENT BELOWCNT 32Q)))) (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)                                 (* lmm "29-Jul-85 21:44")

                                                             (* Called from inside MARKASCHANGED)

    (
AND
 MSDATABASELST (
SELECTQ
 REASON
				    (
SELECTQ
 TYPE
					       ((FNS NIL)
						 (if
 (
EQ
 REASON (
QUOTE
 DELETED))
						     then
 (MSERASE
 NAME)
						   else
 (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)                                              (* lmm "22-Jul-85 18:18")

    (
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)
		          (if
 (
HASDEF
 FN (
QUOTE
 FNS)
					  (
QUOTE
 SAVED))
			      then
 (
PRINT
 (
LIST
 (
QUOTE
 unsaving)
						      FN)
					      T T)
				     (
UNSAVEDEF
 FN (
QUOTE
 FNS))
			    else
 (
PRINT
 (
LIST
 (
QUOTE
 loading)
						    FN)
					    T T)
				   (
LOADDEF
 FN (
QUOTE
 FNS)
					      (
QUOTE
 ?]
	    (
/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
 "19-Jun-86")

(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)                                       (* DECLARATIONS: (RECORDS SENTENCE SETPHRASE))

                                                             (* lmm "29-Jul-85 21: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
 (
SETPHRASE
 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)                                          (* DECLARATIONS: (RECORDS SETPHRASE))

                                                             (* lmm "29-Jul-85 21:36")

    (
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
)                                              (* DECLARATIONS: (RECORDS SETPHRASE))

                                                             (* lmm "29-Jul-85 21:36")

    (
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 "22-Jul-85 18:25")

                                                             (* MSHASHFILE uses cause GETRELATION barfs if CONTAINS 

							     table doesn't exist.)

    (
PROG
 (VAL)
          [for
 FILE (FNSONLY _ (
AND
 MSHASHFILE (
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 (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
 MSHASHFILE (
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 
[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 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 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 MSHASHFILE ANALYZEUSERFNS)
)
(DECLARE: EVAL@COMPILE 
(CLISPDEC (QUOTE FAST))
)
(FILESLOAD (LOADCOMP)
       MSANALYZE)
)
(DECLARE: DONTEVAL@LOAD DOEVAL@COMPILE DONTCOPY COMPILERVARS 

(ADDTOVAR NLAMA
 %.)

(ADDTOVAR NLAML
 )

(ADDTOVAR LAMA
 )
)
(PUTPROPS MASTERSCOPE COPYRIGHT ("Xerox Corporation" 1983 1984 1985 1986))
(DECLARE: DONTCOPY
  (FILEMAP (NIL (5913 16716 (UPDATEFN 5923 . 7174) (MSNOTICEFILE 7176 . 9499) (MSSHOWUSE 9501 . 12810) (
MSUPDATEFN1 12812 . 13462) (MSUPDATE 13464 . 15640) (MSNLAMBDACHECK 15642 . 16290) (MSCOLLECTDATA 
16292 . 16714)) (16717 17553 (UPDATECHANGED 16727 . 17034) (UPDATECHANGED1 17036 . 17551)) (18409 
18875 (MSCLOSEFILES 18419 . 18873)) (19759 23467 (MSDESCRIBE 19769 . 22009) (MSDESCRIBE1 22011 . 22877
) (FMAPRINT 22879 . 23465)) (23587 24058 (MSPRINTHELPFILE 23597 . 24056)) (24172 26510 (TEMPLATE 24182
 . 25380) (GETTEMPLATE 25382 . 25517) (SETTEMPLATE 25519 . 26508)) (29288 33503 (MSMARKCHANGE1 29298
 . 29891) (MSINIT 29893 . 31577) (GETVERBTABLES 31579 . 31938) (MSSTOREDATA 31940 . 32859) (STORETABLE
 32861 . 33501)) (34819 38431 (PARSERELATION 34829 . 35294) (PARSERELATION1 35296 . 36523) (
GETRELATION 36525 . 37137) (MAPRELATION 37139 . 37869) (TESTRELATION 37871 . 38429)) (38467 39422 (
ADDHASH 38477 . 38708) (SUBHASH 38710 . 38867) (MAKEHASH 38869 . 38957) (MSREHASH 38959 . 39281) (
EQMEMBHASH 39283 . 39420)) (39803 43647 (MSVBTABLES 39813 . 43645)) (46939 47322 (MSERASE 46949 . 
47320)) (47350 49766 (DUMPDATABASE 47360 . 48512) (DUMPDATABASE1 48514 . 48844) (READATABASE 48846 . 
49764)) (51162 64569 (MSCHECKBLOCKS 51172 . 53200) (MSCHECKBLOCK 53202 . 56851) (MSCHECKFNINBLOCK 
56853 . 58462) (MSCHECKBLOCKBASIC 58464 . 59867) (MSCHECKBOUNDFREE 59869 . 60514) (GLOBALVARP 60516 . 
60627) (PRINTERROR 60629 . 61906) (MSCHECKVARS1 61908 . 63150) (UNECCSPEC 63152 . 63331) (NECCSPEC 
63333 . 63583) (SPECVARP 63585 . 63908) (SHORTLST 63910 . 64134) (DOERROR 64136 . 64567)) (65852 72687
 (MSPATHS 65862 . 67051) (MSPATHS1 67053 . 68754) (MSPATHS2 68756 . 70573) (MSONPATH 70575 . 71226) (
MSPATHS4 71228 . 71843) (DASHES 71845 . 72127) (DOTABS 72129 . 72261) (BELOWMARKER 72263 . 72544) (
MSPATHSPRINTFN 72546 . 72685)) (73070 73214 (MSFIND 73080 . 73212)) (73875 79564 (MSMARKCHANGED 73885
 . 74527) (CHANGEMACRO 74529 . 75233) (CHANGEVAR 75235 . 75567) (CHANGEI.S. 75569 . 76411) (
CHANGERECORD 76413 . 76981) (MSNEEDUNSAVE 76983 . 77834) (UNSAVEFNS 77836 . 79562)) (81551 84188 (%. 
81561 . 81657) (MASTERSCOPE 81659 . 82095) (MASTERSCOPE1 82097 . 82642) (MASTERSCOPEXEC 82644 . 84186)
) (84223 104402 (MSINTERPRETSET 84233 . 97806) (MSINTERPA 97808 . 98335) (MSGETBLOCKDEC 98337 . 99741)
 (LISTHARD 99743 . 100426) (MSMEMBSET 100428 . 100595) (MSLISTSET 100597 . 100974) (MSHASHLIST 100976
 . 101151) (MSHASHLIST1 101153 . 101489) (CHECKPATHS 101491 . 102001) (ONFILE 102003 . 104400)) (
104403 116761 (MSINTERPRET 104413 . 112481) (VERBNOTICELIST 112483 . 113095) (MSOUTPUT 113097 . 113573
) (MSCHECKEMPTY 113575 . 114647) (CHECKFORCHANGED 114649 . 115122) (MSSOLVE 115124 . 116759)))))
STOP