[Gcl-devel] Re: Advice on error handling

[Camm Maguire]

Greetins, and thanks!

Robert Boyer <address@hidden> writes:

> Although the GCL user can redefine trace, read, and even eval, he
> cannot, according to my dim understanding of things, touch the
> underlying C system code of GCL.  So it seems to me that one solution
> for debugging in pathological cases, and maybe even in more general
> cases, is to write a simple debugger that is not written in Lisp but
> only in C.  What one wants here is simply read-eval-print to and from
> *terminal-io*.  Can these be tied together in some way that does not
> pass through function cells that the user may have clobbered?
> 

Not to my knowledge.  I.e. we could provide hard-coded read, eval, and
print functions in C, but anything that is read will pass through
read-macro functions, and anything that is eval'ed of course will use
the user's potentially damaged heap.  So then the question arises --
what gain is there from doing this in C, or the equivalent in lisp:

(defconstant +critical-fns+ (mapcar (lambda (x) (cons x (symbol-function x))) 
                                    '(format read find-package
                                    package-name reset-stack-limits eq
                                    bye eval fresh-line prin1
                                    terpri))) 

(defun top-level1 ()
  (let ((+ nil) (++ nil) (+++ nil)
        (- nil) 
        (* nil) (** nil) (*** nil)
        (/ nil) (// nil) (/// nil))
    (setq *lisp-initialized* t)
    (catch *quit-tag*
      (cond
       (*multiply-stacks* (setq *multiply-stacks* nil))
       ((probe-file "init.lsp") (load "init.lsp")))
      (let (*load-verbose*) (process-some-args *command-args*))
      (and (functionp *top-level-hook*)(funcall   *top-level-hook*)))

    (loop
     (when 
         (catch +top-abort-tag+
           (loop
            (when 
                (catch *quit-tag*
                  (setq +++ ++ ++ + + -)
                  (if *no-prompt* (setq *no-prompt* nil)
                    (format t "~%~a>"
                            (if (eq *package* (find-package 'user)) ""
                              (package-name *package*))))
                  (reset-stack-limits)
                  ;; have to exit and re-enter to multiply stacks
                  (cond (*multiply-stacks* (Return-from top-level1)))
                  (setq - (locally (declare (notinline read))
                                   (read *standard-input* nil *top-eof*)))
                  (when (eq - *top-eof*) (bye))
                                        ;              (si::clear-c-stack 4096)
                  (let ((values (multiple-value-list
                                 (locally (declare (notinline eval)) (eval 
-)))))
                    (setq /// // // / / values *** ** ** * * (car /))
                    (fresh-line)
                    (dolist (val /)
                      (locally (declare (notinline prin1)) (prin1 val))
                      (terpri))
                    nil))
              (setq *evalhook* nil *applyhook* nil *no-prompt* t)
              (terpri *error-output*)
              (break-current)))
           nil)
       (let ((*no-warnings* t))
         (dolist (x +critical-fns+)
           (emergency-fset (car x) (cdr x))))))))


Of course to make this really work, we would have to provide some
immutable key sequence to throw the abort tag, which is also done via
unrecoverable errors from C.  Said key would have to hook into the
terminal driver and bypass read somehow.

Thoughts most appreciated.

> Bob
> 
> 
> 
> 
> 

-- 
Camm Maguire                                            address@hidden
==========================================================================
"The earth is but one country, and mankind its citizens."  --  Baha'u'llah