mirror of
https://git.savannah.gnu.org/git/emacs.git
synced 2025-01-18 18:05:07 +00:00
Remove generation of old bytecodes for catch/unwind
* lisp/emacs-lisp/bytecomp.el (byte-compile--use-old-handlers) (byte-compile-condition-case, byte-compile-condition-case--old): Remove. (byte-compile-condition-case--new): Rename to byte-compile-condition-case. (byte-compile-catch, byte-compile-unwind-protect): * lisp/emacs-lisp/cconv.el (cconv-convert, cconv-analyze-form): * lisp/emacs-lisp/byte-opt.el (byte-optimize-form-code-walker): Simplify.
This commit is contained in:
parent
e086a9fddc
commit
2d5d0fa1b4
@ -498,15 +498,12 @@
|
||||
form)
|
||||
|
||||
((eq fn 'condition-case)
|
||||
(if byte-compile--use-old-handlers
|
||||
;; Will be optimized later.
|
||||
form
|
||||
`(condition-case ,(nth 1 form) ;Not evaluated.
|
||||
,(byte-optimize-form (nth 2 form) for-effect)
|
||||
,@(mapcar (lambda (clause)
|
||||
`(,(car clause)
|
||||
,@(byte-optimize-body (cdr clause) for-effect)))
|
||||
(nthcdr 3 form)))))
|
||||
`(condition-case ,(nth 1 form) ;Not evaluated.
|
||||
,(byte-optimize-form (nth 2 form) for-effect)
|
||||
,@(mapcar (lambda (clause)
|
||||
`(,(car clause)
|
||||
,@(byte-optimize-body (cdr clause) for-effect)))
|
||||
(nthcdr 3 form))))
|
||||
|
||||
((eq fn 'unwind-protect)
|
||||
;; the "protected" part of an unwind-protect is compiled (and thus
|
||||
@ -521,12 +518,7 @@
|
||||
((eq fn 'catch)
|
||||
(cons fn
|
||||
(cons (byte-optimize-form (nth 1 form) nil)
|
||||
(if byte-compile--use-old-handlers
|
||||
;; The body of a catch is compiled (and thus
|
||||
;; optimized) as a top-level form, so don't do it
|
||||
;; here.
|
||||
(cdr (cdr form))
|
||||
(byte-optimize-body (cdr form) for-effect)))))
|
||||
(byte-optimize-body (cdr form) for-effect))))
|
||||
|
||||
((eq fn 'ignore)
|
||||
;; Don't treat the args to `ignore' as being
|
||||
|
@ -4529,96 +4529,25 @@ binding slots have been popped."
|
||||
;; (byte-defop-compiler-1 save-window-excursion) ;Obsolete: now a macro.
|
||||
;; (byte-defop-compiler-1 with-output-to-temp-buffer) ;Obsolete: now a macro.
|
||||
|
||||
(defvar byte-compile--use-old-handlers nil
|
||||
"If nil, use new byte codes introduced in Emacs-24.4.")
|
||||
|
||||
(defun byte-compile-catch (form)
|
||||
(byte-compile-form (car (cdr form)))
|
||||
(if (not byte-compile--use-old-handlers)
|
||||
(let ((endtag (byte-compile-make-tag)))
|
||||
(byte-compile-goto 'byte-pushcatch endtag)
|
||||
(byte-compile-body (cddr form) nil)
|
||||
(byte-compile-out 'byte-pophandler)
|
||||
(byte-compile-out-tag endtag))
|
||||
(pcase (cddr form)
|
||||
(`(:fun-body ,f)
|
||||
(byte-compile-form `(list 'funcall ,f)))
|
||||
(body
|
||||
(byte-compile-push-constant
|
||||
(byte-compile-top-level (cons 'progn body) byte-compile--for-effect))))
|
||||
(byte-compile-out 'byte-catch 0)))
|
||||
(let ((endtag (byte-compile-make-tag)))
|
||||
(byte-compile-goto 'byte-pushcatch endtag)
|
||||
(byte-compile-body (cddr form) nil)
|
||||
(byte-compile-out 'byte-pophandler)
|
||||
(byte-compile-out-tag endtag)))
|
||||
|
||||
(defun byte-compile-unwind-protect (form)
|
||||
(pcase (cddr form)
|
||||
(`(:fun-body ,f)
|
||||
(byte-compile-form
|
||||
(if byte-compile--use-old-handlers `(list (list 'funcall ,f)) f)))
|
||||
(byte-compile-form f))
|
||||
(handlers
|
||||
(if byte-compile--use-old-handlers
|
||||
(byte-compile-push-constant
|
||||
(byte-compile-top-level-body handlers t))
|
||||
(byte-compile-form `#'(lambda () ,@handlers)))))
|
||||
(byte-compile-form `#'(lambda () ,@handlers))))
|
||||
(byte-compile-out 'byte-unwind-protect 0)
|
||||
(byte-compile-form-do-effect (car (cdr form)))
|
||||
(byte-compile-out 'byte-unbind 1))
|
||||
|
||||
(defun byte-compile-condition-case (form)
|
||||
(if byte-compile--use-old-handlers
|
||||
(byte-compile-condition-case--old form)
|
||||
(byte-compile-condition-case--new form)))
|
||||
|
||||
(defun byte-compile-condition-case--old (form)
|
||||
(let* ((var (nth 1 form))
|
||||
(fun-bodies (eq var :fun-body))
|
||||
(byte-compile-bound-variables
|
||||
(if (and var (not fun-bodies))
|
||||
(cons var byte-compile-bound-variables)
|
||||
byte-compile-bound-variables)))
|
||||
(byte-compile-set-symbol-position 'condition-case)
|
||||
(unless (symbolp var)
|
||||
(byte-compile-warn
|
||||
"`%s' is not a variable-name or nil (in condition-case)" var))
|
||||
(if fun-bodies (setq var (make-symbol "err")))
|
||||
(byte-compile-push-constant var)
|
||||
(if fun-bodies
|
||||
(byte-compile-form `(list 'funcall ,(nth 2 form)))
|
||||
(byte-compile-push-constant
|
||||
(byte-compile-top-level (nth 2 form) byte-compile--for-effect)))
|
||||
(let ((compiled-clauses
|
||||
(mapcar
|
||||
(lambda (clause)
|
||||
(let ((condition (car clause)))
|
||||
(cond ((not (or (symbolp condition)
|
||||
(and (listp condition)
|
||||
(let ((ok t))
|
||||
(dolist (sym condition)
|
||||
(if (not (symbolp sym))
|
||||
(setq ok nil)))
|
||||
ok))))
|
||||
(byte-compile-warn
|
||||
"`%S' is not a condition name or list of such (in condition-case)"
|
||||
condition))
|
||||
;; (not (or (eq condition 't)
|
||||
;; (and (stringp (get condition 'error-message))
|
||||
;; (consp (get condition
|
||||
;; 'error-conditions)))))
|
||||
;; (byte-compile-warn
|
||||
;; "`%s' is not a known condition name
|
||||
;; (in condition-case)"
|
||||
;; condition))
|
||||
)
|
||||
(if fun-bodies
|
||||
`(list ',condition (list 'funcall ,(cadr clause) ',var))
|
||||
(cons condition
|
||||
(byte-compile-top-level-body
|
||||
(cdr clause) byte-compile--for-effect)))))
|
||||
(cdr (cdr (cdr form))))))
|
||||
(if fun-bodies
|
||||
(byte-compile-form `(list ,@compiled-clauses))
|
||||
(byte-compile-push-constant compiled-clauses)))
|
||||
(byte-compile-out 'byte-condition-case 0)))
|
||||
|
||||
(defun byte-compile-condition-case--new (form)
|
||||
(let* ((var (nth 1 form))
|
||||
(body (nth 2 form))
|
||||
(depth byte-compile-depth)
|
||||
|
@ -462,20 +462,7 @@ places where they originally did not directly appear."
|
||||
;; and may be an invalid expression (e.g. ($# . 678)).
|
||||
(cdr forms)))))
|
||||
|
||||
;condition-case
|
||||
((and `(condition-case ,var ,protected-form . ,handlers)
|
||||
(guard byte-compile--use-old-handlers))
|
||||
(let ((newform (cconv--convert-function
|
||||
() (list protected-form) env form)))
|
||||
`(condition-case :fun-body ,newform
|
||||
,@(mapcar (lambda (handler)
|
||||
(list (car handler)
|
||||
(cconv--convert-function
|
||||
(list (or var cconv--dummy-var))
|
||||
(cdr handler) env form)))
|
||||
handlers))))
|
||||
|
||||
; condition-case with new byte-codes.
|
||||
; condition-case
|
||||
(`(condition-case ,var ,protected-form . ,handlers)
|
||||
`(condition-case ,var
|
||||
,(cconv-convert protected-form env extend)
|
||||
@ -496,10 +483,8 @@ places where they originally did not directly appear."
|
||||
`((let ((,var (list ,var))) ,@body))))))
|
||||
handlers))))
|
||||
|
||||
(`(,(and head (or (and 'catch (guard byte-compile--use-old-handlers))
|
||||
'unwind-protect))
|
||||
,form . ,body)
|
||||
`(,head ,(cconv-convert form env extend)
|
||||
(`(unwind-protect ,form . ,body)
|
||||
`(unwind-protect ,(cconv-convert form env extend)
|
||||
:fun-body ,(cconv--convert-function () body env form)))
|
||||
|
||||
(`(setq . ,forms) ; setq special form
|
||||
@ -718,15 +703,6 @@ and updates the data stored in ENV."
|
||||
(`(quote . ,_) nil) ; quote form
|
||||
(`(function . ,_) nil) ; same as quote
|
||||
|
||||
((and `(condition-case ,var ,protected-form . ,handlers)
|
||||
(guard byte-compile--use-old-handlers))
|
||||
;; FIXME: The bytecode for condition-case forces us to wrap the
|
||||
;; form and handlers in closures.
|
||||
(cconv--analyze-function () (list protected-form) env form)
|
||||
(dolist (handler handlers)
|
||||
(cconv--analyze-function (if var (list var)) (cdr handler)
|
||||
env form)))
|
||||
|
||||
(`(condition-case ,var ,protected-form . ,handlers)
|
||||
(cconv-analyze-form protected-form env)
|
||||
(when (and var (symbolp var) (byte-compile-not-lexical-var-p var))
|
||||
@ -741,9 +717,7 @@ and updates the data stored in ENV."
|
||||
form "variable"))))
|
||||
|
||||
;; FIXME: The bytecode for unwind-protect forces us to wrap the unwind.
|
||||
(`(,(or (and 'catch (guard byte-compile--use-old-handlers))
|
||||
'unwind-protect)
|
||||
,form . ,body)
|
||||
(`(unwind-protect ,form . ,body)
|
||||
(cconv-analyze-form form env)
|
||||
(cconv--analyze-function () body env form))
|
||||
|
||||
|
Loading…
Reference in New Issue
Block a user