; -*- Mode:LISP;Lowercase:T-*-

(herald DEBMAC /1)

(defvar *CURSOR*)
(defvar *FRAME*)
(defvar *TOP-FRAME*)
(defvar *BOTTOM-FRAME*)
(defvar **ARG** () "Argument to debug commands")
(declare (fixnum (*readch2)))

(defvar debug-prinlevel)
(defvar debug-prinlength)
(defvar debug-prin1)
(defvar debug-sprinter-mode)
(defvar debug-indent-max)
(defvar debug-prompt)

(defvar debug-frame-suppression-alist)

(defvar debug-suppression-reasons)

(defvar si:ignored-error-funs)

(and (fboundp 'special) (special error-io))

;; The following function is defined for run time in DEBUG, make any changes
;; there as well.

(defun debug-name-char (ch)
  (caseq ch
    (#\HELP "Help")
    (#\RETURN "Return")
    (#\TAB "Tab")
    (#\SPACE "Space")
    (#\LINEFEED "Linefeed")
    (#\BACKSPACE "Backspace")
    (#\RUBOUT "Rubout")
    (#\FORM "Form")
    (T (if (> ch #\SPACE)
	   (format () "~C" ch)
	   (format () "^~C" (+ ch #o100))))))


(defvst debug-frame
  next
  previous
  next-interesting
  previous-interesting
  type
  form
  function
  arguments
  bindstk
  callstk
  frame-list
  plist)

(defvst debug-command-spec
  chars
  fun
  doc)

(defmacro def-debug-command (chars doc &body fun)
  (if (atom chars)
      (setq chars (ncons chars)))
  (let ((command-fun-sym (symbolconc 'DEBUG-COMMAND-
				     (debug-name-char (car chars)))))
    `(progn 'compile
	    (defun ,command-fun-sym ()
		   ,@fun)
	    (enter-debug-command ',chars ',command-fun-sym ',doc))))