(FILECREATED " 4-Aug-85 03:58:15" {ERIS}<LISPCORE>SOURCES>WTFIX.;4 17564  

      changes to:  (FNS HELPFIX)

      previous date: "13-Jun-85 19:48:08" {ERIS}<LISPCORE>SOURCES>WTFIX.;2)


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

(PRETTYCOMPRINT WTFIXCOMS)

(RPAQQ WTFIXCOMS ((FNS HELPFIX HELPFIX1 HELPFIX2 FINDATOM FIXAPPLY1 FIXLISPX/)
		  (SPECVARS TYPE-IN? VARS EXPR PARENT BREAKFLG SUBPARENT FORMSFLG TAIL HELPFIXTAIL 
			    HELPFIXFLG TYPE-IN? VARS EXPR PARENT)
		  (GLOBALVARS CLEARSTKLST SPELLINGS2 FILEPKGFLG USERWORDS SPELLINGS3 ADDSPELLFLG 
			      LISPXHISTORY)))
(DEFINEQ

(HELPFIX
  [LAMBDA (NOEDITFLG)                                        (* lmm " 4-Aug-85 03:57")

          (* Calls editor on last interpreted function or argument to EVAL, and searches for the last interpreted form, i.e. 
	  the one currently being interpreted. If user exits from editor via OK, and if this eval-blip was responsible for the
	  BREAK, also resets BRKEXP so user can continue computation via OK.)


    (PROG (POS POS1 RESETFLG TEM)
          (SETQ POS (BRKLASTPOS T))                          (* first functon before the call to break1.)
          [SETQ POS1 (FSTKNTH -1 (COND
				([SETQ RESETFLG (NOT (EQP LASTPOS (SETQ TEM (BRKLASTPOS]
                                                             (* user has reset lastpos via @ command)
				  LASTPOS)
				(T POS]
          (RELSTK TEM)                                       (* true if the user reset LASTPOS via an @ command)
          (RETURN
	    (PROG1
	      (PROG (FORM FN EXPR TYPE-IN? HELPFIXTAIL PARENT HELPFIXFLG NOCHANGEFLG TEM FORMSFLG 
			  SUBPARENT)
		LP  (COND
		      ((OR (NLISTP BRKTYPE)
			   RESETFLG)

          (* All types of breaks except u.b.a. or u.d.f. Breaks, or else user has reset LASTPOS. Procedure is to search for 
	  *FORM* and then find super expression containing it.)


			(SETQ FORM (BLIPVAL (QUOTE *FORM*)
					    POS1))
			(COND
			  ((AND FORM (NULL (CDR FORM))
				(GENSYM? (CAR FORM))
				(SETQ TEM (STKPOS (CAR FORM)
						  -1 POS1)))
                                                             (* this "form" comes from a compiled errorset)
			    (RELSTK POS1)
			    (SETQ POS1 (STKNTH -2 TEM TEM))
			    (GO LP)))
			[SETQ NOCHANGEFLG (NEQ (CAR FORM)
					       (EVALV (QUOTE BRKFN]

          (* Indicates whether to reset BRKEXP, i.e. did the scan find the FORM causing the BREAK. For example, if performed 
	  (ADD1 T) BRKEXP would be (ADD1 X), so after editing, it should be reset to whatever (ADD1 T) now is.
	  The situation where the FORM found does not correspond occurs for example if an APPLY caused the error, or if the 
	  error occurs out of a compiled function -
	  In this case the FORM obtained by edit is the last interpreted one. note that for U.B.A. Or U.D.F.
	  Breaks, FORM is given to BREAK1.)


			)
		      [(LISTP BRKEXP)                        (* U.D.F. BREAK)
			(COND
			  [(EQ (CAR BRKEXP)
			       (QUOTE APPLY))
			    (SETQ FORM (CADADR BRKEXP))
			    (OR (SETQ HELPFIXTAIL (FIXAPPLY1 (FSTKNTH 0 POS)
							     FORM FORM (CAR BRKTYPE)))
				(RETURN (QUOTE can't]
			  (T (SETQ FORM BRKEXP]
		      ((SETQ HELPFIXTAIL (FINDATOM BRKEXP POS (CAR BRKTYPE)))
                                                             (* U.B.A. BREAK. The value of BRKTYPE is a BLIPEVAL for
							     eval-blip performed in FAULT1 before the BREAK was 
							     induced by a RETEVAL.)
			(SETQ FORM BRKEXP)))
		    [COND
		      ([OR (NULL FORM)
			   (NULL (SETQ FN (FINDFN (COND
						    ((AND (LISTP BRKTYPE)
							  (NULL RESETFLG))
                                                             (* The only time to consider the function at LASTPOS as
							     a possible candidate is on error breaks when LASTPOS 
							     has not been reset.)
						      POS)
						    (T POS1]
			(RETURN (QUOTE can't)))
		      ((NLISTP EXPR)                         (* Set in FINDFN.)
			(RETURN (QUOTE can't]
		    [COND
		      (NOEDITFLG                             (* For use with IN? command: find and print parent form
							     but do not call editor.)
				 (PRIN2 FN T T)
				 (PRIN1 (QUOTE ":  ")
					T)
				 (RETURN (COND
					   ((NLISTP FORM)
					     PARENT)
					   (T FORM]
		    (PRIN1 (QUOTE "in ")
			   T)
		    (PRIN2 FN T T)
		    (PRINT (QUOTE ...)
			   T)
		    (if
		      [NULL
			(NLSETQ
			  (LET [(COMS (NCONC [if (EQ EXPR FORM)
						 then (SETQ HELPFIXTAIL (LIST FORM))
						      NIL
					       elseif (NLISTP FORM)
						 then        (* The IF makes sure you find the right atom.)
						      (LIST [BQUOTE (LC F , FORM
									(IF (EQ (##)
										HELPFIXTAIL]
							    0)
					       else 

          (* Set HELPFIXTAIL so that if the user replaces the entire offending expression, e.g. via MBD or XTR, 
	  (instead of just changing portions of it), can pick up the corresponding expression to for resetting BRKEXP.)


						    (LIST (BQUOTE (F= , FORM T))
							  (QUOTE (E (SETQ HELPFIXTAIL (## UP))
								    T]
					     (QUOTE ((ORR (P)
							  NIL)
						      (E (SETQ HELPFIXFLG L)
							 T)
						      TTY:]

          (* Explanation of EDIT commands: NEQ is because EXPR may in fact be the offending FORM, e.g. do EVAL of an 
	  expression whose CAR is undefined. The F= is to make sure you find the FORM that is EQ to FORM.
	  The lc and if is necessary because if FORM is an atom, HELPFIXTAIL will be non-nil, and must check to make sure have
	  found that u.b.a. If HELPFIXTAIL is non-nil,)


			       (if [AND (LITATOM FN)
					(EQUAL EXPR (GETDEF FN (QUOTE FNS)
							    (QUOTE CURRENT)
							    (QUOTE (NOCOPY NOERROR NODWIM]
				   then (EDITDEF FN (QUOTE FNS)
						 NIL COMS)
				 else (if (NEQ FN (QUOTE TYPE-IN))
					  then (PRINTOUT T 
					   "Warning: context of edited expression not determined"
							 T))
				      (EDITE EXPR COMS]
			then (AND (NULL HELPFIXFLG)
				  (PRINT (QUOTE (not found))
					 T))
			     (RETURN))                       (* Reset BRKEXP.)
		    (COND
		      (NOCHANGEFLG (GO NOCHANGE)))
		    (SETQ TEM (CAR HELPFIXTAIL))
		    [COND
		      (TYPE-IN? (SETQ TEM (LISPX/ TEM NIL (VARSBOUNDINEDITCHAIN HELPFIXFLG]
                                                             (* HELPFIXFLG is L, the edit push-down list, leding up 
							     to BRKEXP. VARSBOUNDINEDITCHAIN climbs it and returns 
							     list of bound variables.)
		    (COND
		      ((LISTP BRKTYPE)                       (* U.B.A. or U.D.F. break.)

          (* Note that the / substitution will not affect any editing changes made beyond the scope of BRKEXP.
	  The only way to catch these would be to destructively substitute throughout EXPR.)


			(COND
			  ((EQ (CAR BRKEXP)
			       (QUOTE APPLY))                (* Fixes stack so if in mapping function won't get 
							     another u.d.f. Error)
			    (/RPLNODE (CDADR BRKEXP)
				      TEM NIL)
			    (FIXAPPLY1 (FSTKNTH 0 POS)
				       FORM TEM (CAR BRKTYPE)))
			  (T (SETQ BRKEXP TEM)))
			(RETURN FN))
		      (T 

          (* STKEVAL is used in the new BRKEXP because the lambda variables of the function broken may clash with variables in
	  FORM. E.g. User gets a BREAK on FOO, looks at its arguments, finds a bug. So he does an EDIT to get to the place 
	  where FOO was called, say it is (FOO (CAR X)), and changes CAR to CADR to correct it. Now even if FOO has an 
	  argument named X, he can continue in the FOO BREAK because the new BRKEXP is (STKEVAL (FSTKNTH -1 POS) 
	  (QUOTE (FOO (CADR X)))))


			 (SETQ BRKEXP (FSTKNTH -1 POS))
			 (AND (NEQ CLEARSTKLST T)
			      (SETQ CLEARSTKLST (CONS BRKEXP CLEARSTKLST)))
			 (SETQ BRKEXP (LIST (QUOTE STKEVAL)
					    BRKEXP
					    (LIST (QUOTE QUOTE)
						  TEM)
					    T))
			 (RETURN FN)))
		NOCHANGE
		    (PRIN1 (QUOTE "Note: BRKEXP not changed.
")
			   T)
		    (RETURN FN))
	      (RELSTK POS)
	      (RELSTK POS1])

(HELPFIX1
  [LAMBDA (X HIST)                                          (* rrb "25-NOV-81 09:39")
                                                            (* Designed for use with UBA and UDF breaks.
							    Performs the changes that would have been done in 
							    spelling corrector.)
    (COND
      ((OR (NLISTP BRKTYPE)
	   (NULL X))                                        (* Not a u.b.a. Or u.d.f. BREAK, or else nothing typed 
							    on line following ->)
	(PRINT (QUOTE ?)
	       T)
	NIL)
      (T (PROG (FAULTFN TAIL PARENT VARS EXPR TYPE-IN? (POS (BRKLASTPOS T))
			TEM FORMSFLG SUBPARENT)
	       (SETQ FAULTFN (FINDFN (FSTKNTH 0 POS)))
	       (COND
		 ((ATOM BRKEXP)
		   (COND
		     ((AND [NULL (SETQ TAIL (FINDATOM BRKEXP POS (CAR BRKTYPE]
			   (CDR X))
		       (GO CAN'T)))
		   (SETQ BRKEXP (CAR X))
		   (AND ADDSPELLFLG (NEQ (EVALV (CAR X)
						POS)
					 (QUOTE NOBIND))
			(ADDSPELL (CAR X)
				  T)
			(MOVETOP (CAR X)
				 SPELLINGS3)
			(MOVETOP (CAR X)
				 USERWORDS))
		   (COND
		     (TAIL (HELPFIX2 TAIL (CAR X)
				     (NCONC (CDR X)
					    (CDR TAIL))
				     HIST)))
		   (GO OUT)))
	       (COND
		 ((EQ (CAR BRKEXP)
		      (QUOTE APPLY))
		   (COND
		     ((CDR X)                               (* Since this is an APPLY error, it doesn't make sense 
							    to replace the function name by a function and an 
							    argument.)
		       (GO CAN'T)))
		   (AND ADDSPELLFLG (GETD (CAR X))
			(ADDSPELL (CAR X)
				  2)
			(MOVETOP (CAR X)
				 SPELLINGS2))

          (* SPELLINGS2 are used because the APPLY error comes from within a function and is more likely to be a function like
	  CONS, or ADD1, or print, than MAKEFILE, or LOAD.)


		   (FIXAPPLY1 POS (CAR (SETQ TEM (CDADR BRKEXP)))
			      (FIXLISPX/ (CAR X))
			      (CAR BRKTYPE))
		   (HELPFIX2 TEM (FIXLISPX/ (CAR X))
			     NIL HIST)
		   (HELPFIX2 (SETQ TEM (CDADDR BRKEXP))
			     (FIXLISPX/ (CAR TEM)
					(CAR X))
			     (CDR TEM)
			     HIST))
		 (T (AND ADDSPELLFLG (GETD (CAR X))
			 (ADDSPELL (CAR X)
				   2)
			 (MOVETOP (CAR X)
				  SPELLINGS2))              (* Adds to SPELLINGS2, list used to correct misspellings
							    of functions inside of other forms.)
		    (HELPFIX2 BRKEXP (FIXLISPX/ (CAR X))
			      (NCONC (CDR X)
				     (CDR BRKEXP))
			      HIST)                         (* E.g. User can say MEMBX -> MEMB X)
		    ))
	   OUT (AND FILEPKGFLG (LITATOM FAULTFN)
		    (EXPRP FAULTFN)
		    (MARKASCHANGED FAULTFN (QUOTE FNS)))
	       (RELSTK POS)
	       (RELSTK LASTPOS)
	       (BREAKRETEVAL (QUOTE BREAK1)
			     BRKEXP)
	   CAN'T
	       (PRINT (QUOTE can't)
		      T)
	       (RELSTK POS)
	       (RETURN])

(HELPFIX2
  [LAMBDA (X A D LISPXHIST0)
    (AND (LISTP X)
	 LISPXHIST0
	 (UNDOSAVE (CONS X (CONS (CAR X)
				 (CDR X)))
		   LISPXHIST0))

          (* So that the undoinformation will be saved on the parent event as well as 
	  on the -> event.)


    (/RPLNODE X A D])

(FINDATOM
  [LAMBDA (ATOM POS BLIP)          (* J.Gibbons " 9-Jun-83 23:27")
                                   (* Returns TAIL for which atom is CAR. If found on *form* BLIP, also sets free 
				   variable PARENT to this form.)
    (PROG (XTAIL TEM NAME REALPOS)
          (COND
	    ((NULL BLIP))
	    ((SETQ XTAIL (FMEMB ATOM (LISTP BLIP)))
	      (SETQ PARENT BLIP)
	      (SETQ SUBPARENT (AND (OR (EQ (CAR PARENT)
					   (QUOTE SETQ))
				       (EQ (CAR PARENT)
					   (QUOTE SAVESETQ)))
				   (CDDR PARENT)))
	      (RETURN XTAIL)))

          (* The EQ checks for no eval-blip on the stack, the NULL check checks for whether ATM is in that binding.
	  In either case, must try something else.)


          [COND
	    ((EQ [SETQ NAME (STKNAME (SETQ REALPOS (SELECTQ (SYSTEMTYPE)
							    ((D JERICHO)
                                   (* Skip over internal interpreter frames)
							      (REALSTKNTH -1 POS T))
							    POS]
		 (QUOTE PROG))     (* Error of form (PROG (.. (VAR U.B.A.) ..) ..))
	      [SOME (CADR (LISTP BLIP))
		    (FUNCTION (LAMBDA (X)
			(AND (LISTP X)
			     (SETQ XTAIL (FMEMB ATOM (SETQ PARENT X]
	      (SETQ SUBPARENT XTAIL))
	    [[EQ ATOM (CAR (SETQ TEM (BLIPVAL (QUOTE *TAIL*)
					      POS]

          (* U.B.A. occurs at top level of COND clause but in consequent, e.g. (COND (& .. U.B.A. ..)), or at top level of 
	  SELECTQ clause, e.g. (SELECTQ & .. (& .. U.B.A.) ..), or at top level of lambda expression.)


	      (SETQ XTAIL TEM)
	      (COND
		((EXPRP NAME)
		  [SETQ PARENT (COND
		      ((LISTP NAME)
                                   (* open lambda expression, e.g. error occurred at top level of lambda expression 
				   which was passed as functonal argument and then apply'ed.)
			NAME)
		      ((LITATOM NAME)
			(FGETD NAME))
		      (T (HELP (QUOTE FINDATOM]
		  (SETQ SUBPARENT (AND (EQ XTAIL (CDDR PARENT))
				       XTAIL)))
		[(SETQ FORMSFLG (EQ NAME (QUOTE COND)))
		  (SETQ PARENT (CAR (SOME (STKARG 1 REALPOS)
					  (FUNCTION (LAMBDA (X)
					      (TAILP XTAIL X]
		([AND (EQ NAME (QUOTE PROGN))
		      (EQ (STKNAME (SETQ REALPOS (FSTKNTH -2 REALPOS REALPOS)))
			  (QUOTE SELECTQ))
		      (SETQ PARENT (CAR (SOME (STKARG 1 REALPOS)
					      (FUNCTION (LAMBDA (X)
						  (TAILP XTAIL X]

          (* SELECTQs are a mess: e.g. (SELECTQ X (key ... atom← (expr) ...)) in this case, need to find the tail of the 
	  SELECTQ and it is not bound anywhere easily accessible on the stack. SELECTQs are implemented via a call to PROGN 
	  from APPLY)


		  (SETQ SUBPARENT (AND (EQ XTAIL (CDR PARENT))
				       XTAIL]
	    ((AND (LISTP TEM)
		  (EQ ATOM (CAAR TEM)))
                                   (* This is necessary for u.b.a.'s as predicate in COND clause, e.g. 
				   (COND .. (U.B.A. ..)))
	      (SETQ PARENT (SETQ XTAIL (CAR TEM)))
	      (SETQ FORMSFLG T))
	    ([AND (LISTP EXPR)
		  (SETQ XTAIL (FMEMB ATOM (SETQ PARENT EXPR]

          (* Desperation. Will work for case like SETQ (FOO 8CONS A B) where there is no higher PARENT containing ATM, but it 
	  is contained in EXPR.)


	      (SETQ SUBPARENT (AND (EQ XTAIL (CDR PARENT))
				   XTAIL))
	      (SETQ FORMSFLG T)    (* e.g. EDITFNS (' (FOO FIE) --) should go to 
				   ((QUOTE --)) not (QUOTE -))
	      ]
          (SELECTQ (SYSTEMTYPE)
		   ((D JERICHO)
		     (RELSTK REALPOS))
		   NIL)
          (RETURN (AND PARENT XTAIL])

(FIXAPPLY1
  [LAMBDA (POS OLD NEW *FORM*BLIP)
                                   (* lmm "11-JUN-81 11:32")

          (* Analagous to FINDATOM. Finds the XTAIL for which the u.d.f. OLD is CAR, and replaces it with NEW.
	  Also changes places where OLD appears on the stack to NEW. Sets PARENT to be the element containing OLD, and returns
	  with the TAIL. Releases POS in all cases.)


    (PROG (XTAIL LST)
          (PROG ((N (STKNARGS POS)))
	    LP  (COND
		  ((ZEROP N)
		    (RETURN))
		  ((EQ (FSTKARG N POS)
		       OLD)
		    (SETSTKARG N POS NEW)))
	        (SETQ N (SUB1 N))
	        (GO LP))
      NX  

          (* Attempts to find the occurrence of the u.d.f. in the user's program, e.g. if (MAPC X (FUNCTION PRINNT)) caused 
	  the error, this will change (FUNCTION PRINNT) to (FUNCTION PRINT))


          (COND
	    ((EQ (CAAAAR LISPXHISTORY)
		 OLD)
	      (GO OUT)))
          [SETQ LST (COND
	      (TYPE-IN? EXPR)
	      (T (OR *FORM*BLIP (BLIPVAL (QUOTE *FORM*)
					 POS]
                                   (* POS0 is used because want to find the form from which the function before 
				   FAULTAPPLY, e.g. MAPC, was called.)
          (COND
	    ([SOME (CDR LST)
		   (FUNCTION (LAMBDA (X)
		       (AND (EQ (CAR X)
				(QUOTE FUNCTION))
			    (EQ (CADR X)
				OLD)
			    (SETQ XTAIL (CDR X]
	      (SETQ PARENT LST))
	    ((AND (LISTP EXPR)
		  (SETQ XTAIL (FMEMB OLD EXPR)))
                                   (* Second case corresponds to where MAPC 
				   ((A B C) PRINNT) is typed in.)
	      )
	    (T (GO OUT)))
          (/RPLNODE XTAIL NEW (CDR XTAIL))
      OUT (RELSTK POS)
          (RETURN XTAIL])

(FIXLISPX/
  [LAMBDA (X FN)                                            (* wt: 25-FEB-76 2 2)
    (COND
      ((NULL TYPE-IN?)
	X)
      (T (LISPX/ X FN VARS])
)
(DECLARE: DOEVAL@COMPILE DONTCOPY

(SPECVARS TYPE-IN? VARS EXPR PARENT BREAKFLG SUBPARENT FORMSFLG TAIL HELPFIXTAIL HELPFIXFLG TYPE-IN? 
	  VARS EXPR PARENT)
)
(DECLARE: DOEVAL@COMPILE DONTCOPY

(GLOBALVARS CLEARSTKLST SPELLINGS2 FILEPKGFLG USERWORDS SPELLINGS3 ADDSPELLFLG LISPXHISTORY)
)
(PUTPROPS WTFIX COPYRIGHT ("Xerox Corporation" 1982 1983 1985))
(DECLARE: DONTCOPY
  (FILEMAP (NIL (624 17188 (HELPFIX 634 . 8797) (HELPFIX1 8799 . 11579) (HELPFIX2 11581 . 11861) (
FINDATOM 11863 . 15332) (FIXAPPLY1 15334 . 17020) (FIXLISPX/ 17022 . 17186)))))
STOP