1
0
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:
Mattias Engdegård 2020-01-03 13:58:15 +01:00
parent e086a9fddc
commit 2d5d0fa1b4
3 changed files with 18 additions and 123 deletions

View File

@ -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

View File

@ -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)

View File

@ -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))