Mercurial > hg > xemacs-beta

comparison lisp/prim/debug.el @ 171:929b76928fce r20-3b12

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Import from CVS: tag r20-3b12
author cvs
date Mon, 13 Aug 2007 09:47:52 +0200
parents 3bb7ccffb0c0
children
comparison
equal deleted inserted replaced
170:98a42ee61975 171:929b76928fce
481 (mapcar 'cancel-debug-on-entry debug-function-list))) 481 (mapcar 'cancel-debug-on-entry debug-function-list)))
482 482
483 (defun debug-convert-byte-code (function) 483 (defun debug-convert-byte-code (function)
484 (let ((defn (symbol-function function))) 484 (let ((defn (symbol-function function)))
485 (if (not (consp defn)) 485 (if (not (consp defn))
486 ;; Assume a compiled code object. 486 ;; Assume a compiled-function object.
487 (let* ((contents (append defn nil)) 487 (let* ((body
488 (body 488 (list (list 'byte-code
489 (list (list 'byte-code (nth 1 contents) 489 (compiled-function-instructions defn)
490 (nth 2 contents) (nth 3 contents))))) 490 (compiled-function-constants defn)
491 (if (nthcdr 5 contents) 491 (compiled-function-stack-depth defn)))))
492 (setq body (cons (list 'interactive (nth 5 contents)) body))) 492 (if (compiled-function-interactive defn)
493 (if (nth 4 contents) 493 (setq body (cons (compiled-function-interactive defn) body)))
494 (if (compiled-function-doc-string defn)
494 ;; Use `documentation' here, to get the actual string, 495 ;; Use `documentation' here, to get the actual string,
495 ;; in case the compiled function has a reference 496 ;; in case the compiled function has a reference
496 ;; to the .elc file. 497 ;; to the .elc file.
497 (setq body (cons (documentation function) body))) 498 (setq body (cons (documentation function) body)))
498 (fset function (cons 'lambda (cons (car contents) body))))))) 499 (fset function (cons 'lambda (cons
500 (compiled-function-arglist defn)
501 body)))))))
499 502
500 (defun debug-on-entry-1 (function defn flag) 503 (defun debug-on-entry-1 (function defn flag)
501 (if (subrp defn) 504 (if (subrp defn)
502 (error "%s is a built-in function" function) 505 (error "%s is a built-in function" function)
503 (if (eq (car defn) 'macro) 506 (if (eq (car defn) 'macro)