;;;;;;;;;;;;;;;;;;; -*- Mode: Lisp; Package: Macsyma -*- ;;;;;;;;;;;;;;;;;;;
;;;     (c) Copyright 1980 Massachusetts Institute of Technology         ;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

(macsyma-module trdebg)

;;; Debugging environment for translated code, and also
;;; debugger for walking the translator's stacks.
;;; 8:22pm  Thursday, 11 December 1980 -gjc

(defvar error-switch-alist
	;; list of maclisp only so-called error channels, and
	;; their debugging mode values.
	#+maclisp
	'((undf-fnctn    . +internal-udf-break)
	  (unbnd-vrbl    . +internal-ubv-break)
	  (wrng-type-arg . +internal-wta-break)
	  (unseen-go-tag . +internal-ugt-break)
	  (wrng-no-args  . +internal-wna-break)
	  (fail-act      . +internal-fac-break)
	  (*rset-trap    . +internal-*rset-break)
	  (pdl-overflow  . +internal-pdl-break)
	  (io-lossage    . +internal-iol-break)
	  )
	#-maclisp nil
	)


(mapc #'(lambda (slot) (putprop (car slot) (symeval (car slot))
				'losing-old-value))
      error-switch-alist)

(defprop debug (debug fasl dsk liblsp) autoload)
(defprop funprint (funpr fasl dsk libmax) autoload)

(defmfun $debug ()
	 "Calls the lisp stack debugger"
	 "Takes single character commands, /"?/" lists them."
	 (DEBUG))

(DEFUN NIL-OR-POS-FIXNUM-FILTER (X)
       (COND ((OR (NULL X)
		  (AND (FIXP X) (PLUSP X)))
	      X)
	     (T
	      (NIL-OR-POS-FIXNUM-FILTER
	       (MERROR "Argument not FALSE or a positive fixnum:~%~M" X)))))

(DEFUN PRINSTATE ()
       `((MLIST)
	 ,(CASEQ PRIN1
		 (FUNPRINT
		  "&PRINTMODE is MACSYMA")
		 ((NIL SPRIN1)
		  "&PRINTMODE is LISP")
		 (T
		  "&PRINTMODE is unknown"))
	 ((MEQUAL) $PRINT_LENGTH ,PRINLENGTH)
	 ((MEQUAL) $PRINT_DEPTH ,PRINLEVEL)))

(DEFMFUN $DEBUGPRINTMODE (&OPTIONAL (ARG NIL ARG-P)
				    (arg-2 nil arg-2-p))

	 "DEBUGPRINTMODE() returns current printing mode
	 used by the DEBUG() function.
	 DEBUGPRINTMODE(LISP) sets it to lisp printing (the default),
	 DEBUGPRINTMODE(<x>,<y>) where <x> is FALSE or a positive
	 fixnum, sets the maximum length to which LISP expressions
	 are printed to <x>, and the maximum depth to <y>.
	 This is used to abreviate printout. FALSE means INFINITY.
	 DEBUGPRINTMODE(MACSYMA) sets it to try printing
	 expressions as they would be displayed at macsyma
	 level, except with more information and a slightly
	 different notation. See LIBMAX;FUNPR >."

	 (COND ((NULL ARG-P) (PRINSTATE))
	       ((NULL ARG-2-P)
		(CASEQ ARG
		       ($LISP
			(SETQ PRIN1 NIL)
			(PRINSTATE))
		       ($MACSYMA
			(SETQ PRIN1 'FUNPRINT)
			(PRINSTATE))
		       (T
			"&Unknown printmode requested")))
	       (T
		(SETQ PRINLENGTH (NIL-OR-POS-FIXNUM-FILTER ARG)
		      PRINLEVEL (NIL-OR-POS-FIXNUM-FILTER ARG-2))
		(PRINSTATE))))

(DEFMFUN $LISPDEBUGMODE (&OPTIONAL (ARG NIL ARG-P))
	 
	 "LISPDEBUGMODE(TRUE) will cause lisp errors to enter
	 normal lisp break points, from which it is normal to
	 call the lisp function (DEBUG) which prompts for single
	 character commands to move up and down the evaluation
	 stack at the point of the error. The following are some
	 of its commands:
	 U .... move up the stack.
	 D .... move down the stack.
	 S .... pretty-print the expression current stack level.
	 A .... print indented list of function calls on stack.
	 ? .... type out list of commands.

         LISPDEBUGMODE is useful for debugging translated
	 macsyma code. It is possible to do sophisticated 
	 error recovery from inside these break loops.

	 LISPDEBUGMODE(FALSE) to turn off.
	 LISPDEBUGMODE() returns present debugging state.
	 Note: LISPDEBUGMODE also passes its argument
	 to DEBUGMODE."

	 (COND (ARG-P
		($DEBUGMODE ARG)
		(COND (ARG
		       (MAPC #'(LAMBDA (SLOT)
				       (SET (CAR SLOT) (CDR SLOT)))
			     ERROR-SWITCH-ALIST)
		       "&LISPDEBUGMODE turned on")
		      (T
		       (MAPC #'(LAMBDA (SLOT)
				       (SET (CAR SLOT)
					    (GET (CAR SLOT) 'LOSING-OLD-VALUE)))
			     ERROR-SWITCH-ALIST)
		       "&LISPDEBUGMODE turned off.")))
	       (t
		(IF (EQ (SYMEVAL (CAAR ERROR-SWITCH-ALIST))
			(CDAR ERROR-SWITCH-ALIST))
		    "&LISPDEBUGMODE is on."
		    "&LISPDEBUGMODE is off."))))