mirror of
https://github.com/PDP-10/its.git
synced 2026-01-23 10:59:24 +00:00
85994ed770
Resolves #284. Commented out uses of time-origin in maxtul; mcldmp (init) until we can figure out why it gives arithmetic overflows under the emulators. Updated the expect script statements in build_macsyma_portion to not attempt to match expected strings, but simply sleep for some time since in some cases the matching appears not to work.
132 lines
4.1 KiB
Common Lisp
132 lines
4.1 KiB
Common Lisp
;;;;;;;;;;;;;;;;;;; -*- 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.")))) |