mirror/emacs
1
0
Fork 0
mirror of https://git.savannah.gnu.org/git/emacs.git synced 2025-01-30 19:53:09 +00:00
Code Issues Releases Activity

Remove generation of old bytecodes for catch/unwind

Browse Source 
* 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
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

22
lisp/emacs-lisp/byte-opt.el
View File

@ -498,15 +498,12 @@
form) form)
((eq fn 'condition-case) ((eq fn 'condition-case)
(if byte-compile--use-old-handlers `(condition-case ,(nth 1 form) ;Not evaluated.
;; Will be optimized later. ,(byte-optimize-form (nth 2 form) for-effect)
form ,@(mapcar (lambda (clause)
`(condition-case ,(nth 1 form) ;Not evaluated. `(,(car clause)
,(byte-optimize-form (nth 2 form) for-effect) ,@(byte-optimize-body (cdr clause) for-effect)))
,@(mapcar (lambda (clause) (nthcdr 3 form))))
`(,(car clause)
,@(byte-optimize-body (cdr clause) for-effect)))
(nthcdr 3 form)))))
((eq fn 'unwind-protect) ((eq fn 'unwind-protect)
;; the "protected" part of an unwind-protect is compiled (and thus ;; the "protected" part of an unwind-protect is compiled (and thus
@ -521,12 +518,7 @@
((eq fn 'catch) ((eq fn 'catch)
(cons fn (cons fn
(cons (byte-optimize-form (nth 1 form) nil) (cons (byte-optimize-form (nth 1 form) nil)
(if byte-compile--use-old-handlers (byte-optimize-body (cdr form) for-effect))))
;; 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)))))
((eq fn 'ignore) ((eq fn 'ignore)
;; Don't treat the args to `ignore' as being ;; Don't treat the args to `ignore' as being

85
lisp/emacs-lisp/bytecomp.el
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 save-window-excursion) ;Obsolete: now a macro.
;; (byte-defop-compiler-1 with-output-to-temp-buffer) ;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) (defun byte-compile-catch (form)
(byte-compile-form (car (cdr form))) (byte-compile-form (car (cdr form)))
(if (not byte-compile--use-old-handlers) (let ((endtag (byte-compile-make-tag)))
(let ((endtag (byte-compile-make-tag))) (byte-compile-goto 'byte-pushcatch endtag)
(byte-compile-goto 'byte-pushcatch endtag) (byte-compile-body (cddr form) nil)
(byte-compile-body (cddr form) nil) (byte-compile-out 'byte-pophandler)
(byte-compile-out 'byte-pophandler) (byte-compile-out-tag endtag)))
(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)))
(defun byte-compile-unwind-protect (form) (defun byte-compile-unwind-protect (form)
(pcase (cddr form) (pcase (cddr form)
(`(:fun-body ,f) (`(:fun-body ,f)
(byte-compile-form (byte-compile-form f))
(if byte-compile--use-old-handlers `(list (list 'funcall ,f)) f)))
(handlers (handlers
(if byte-compile--use-old-handlers (byte-compile-form `#'(lambda () ,@handlers))))
(byte-compile-push-constant
(byte-compile-top-level-body handlers t))
(byte-compile-form `#'(lambda () ,@handlers)))))
(byte-compile-out 'byte-unwind-protect 0) (byte-compile-out 'byte-unwind-protect 0)
(byte-compile-form-do-effect (car (cdr form))) (byte-compile-form-do-effect (car (cdr form)))
(byte-compile-out 'byte-unbind 1)) (byte-compile-out 'byte-unbind 1))
(defun byte-compile-condition-case (form) (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)) (let* ((var (nth 1 form))
(body (nth 2 form)) (body (nth 2 form))
(depth byte-compile-depth) (depth byte-compile-depth)

34
lisp/emacs-lisp/cconv.el
View File

@ -462,20 +462,7 @@ places where they originally did not directly appear."
;; and may be an invalid expression (e.g. ($# . 678)). ;; and may be an invalid expression (e.g. ($# . 678)).
(cdr forms))))) (cdr forms)))))
;condition-case ; 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 ,var ,protected-form . ,handlers) (`(condition-case ,var ,protected-form . ,handlers)
`(condition-case ,var `(condition-case ,var
,(cconv-convert protected-form env extend) ,(cconv-convert protected-form env extend)
@ -496,10 +483,8 @@ places where they originally did not directly appear."
`((let ((,var (list ,var))) ,@body)))))) `((let ((,var (list ,var))) ,@body))))))
handlers)))) handlers))))
(`(,(and head (or (and 'catch (guard byte-compile--use-old-handlers)) (`(unwind-protect ,form . ,body)
'unwind-protect)) `(unwind-protect ,(cconv-convert form env extend)
,form . ,body)
`(,head ,(cconv-convert form env extend)
:fun-body ,(cconv--convert-function () body env form))) :fun-body ,(cconv--convert-function () body env form)))
(`(setq . ,forms) ; setq special form (`(setq . ,forms) ; setq special form
@ -718,15 +703,6 @@ and updates the data stored in ENV."
(`(quote . ,_) nil) ; quote form (`(quote . ,_) nil) ; quote form
(`(function . ,_) nil) ; same as quote (`(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) (`(condition-case ,var ,protected-form . ,handlers)
(cconv-analyze-form protected-form env) (cconv-analyze-form protected-form env)
(when (and var (symbolp var) (byte-compile-not-lexical-var-p var)) (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")))) form "variable"))))
;; FIXME: The bytecode for unwind-protect forces us to wrap the unwind. ;; 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-form form env)
(cconv--analyze-function () body env form)) (cconv--analyze-function () body env form))