Introduce new bytecodes for efficient catch/condition-case in lexbind.
* lisp/emacs-lisp/byte-opt.el (byte-optimize-form-code-walker): Optimize under `condition-case' and `catch' if byte-compile--use-old-handlers is nil. (disassemble-offset): Handle new bytecodes. * lisp/emacs-lisp/bytecomp.el (byte-pushcatch, byte-pushconditioncase) (byte-pophandler): New byte codes. (byte-goto-ops): Adjust accordingly. (byte-compile--use-old-handlers): New var. (byte-compile-catch): Use new byte codes depending on byte-compile--use-old-handlers. (byte-compile-condition-case--old): Rename from byte-compile-condition-case. (byte-compile-condition-case--new): New function. (byte-compile-condition-case): New function that dispatches depending on byte-compile--use-old-handlers. (byte-compile-unwind-protect): Pass a function to byte-unwind-protect when we can. * lisp/emacs-lisp/cconv.el (cconv-convert, cconv-analyse-form): Adjust for the new compilation scheme using the new byte-codes. * src/alloc.c (Fgarbage_collect): Merge scans of handlerlist and catchlist, and make them unconditional now that they're heap-allocated. * src/bytecode.c (BYTE_CODES): Add Bpushcatch, Bpushconditioncase and Bpophandler. (bcall0): New function. (exec_byte_code): Add corresponding cases. Improve error message when encountering an invalid byte-code. Let Bunwind_protect accept a function (rather than a list of expressions) as argument. * src/eval.c (catchlist): Remove (merge with handlerlist). (handlerlist, lisp_eval_depth): Not static any more. (internal_catch, internal_condition_case, internal_condition_case_1) (internal_condition_case_2, internal_condition_case_n): Use PUSH_HANDLER. (unwind_to_catch, Fthrow, Fsignal): Adjust to merged handlerlist/catchlist. (internal_lisp_condition_case): Use PUSH_HANDLER. Adjust to new handlerlist which can only handle a single condition-case handler at a time. (find_handler_clause): Simplify since we only a single branch here any more. * src/lisp.h (struct handler): Merge struct handler and struct catchtag. (PUSH_HANDLER): New macro. (catchlist): Remove. (handlerlist): Always declare.
This commit is contained in:
parent
328a8179fe
commit
adf2aa6140
9 changed files with 475 additions and 306 deletions
|
@ -488,11 +488,22 @@
|
|||
(prin1-to-string form))
|
||||
nil)
|
||||
|
||||
((memq fn '(function condition-case))
|
||||
;; These forms are compiled as constants or by breaking out
|
||||
((eq fn 'function)
|
||||
;; This forms is compiled as constant or by breaking out
|
||||
;; all the subexpressions and compiling them separately.
|
||||
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)))))
|
||||
|
||||
((eq fn 'unwind-protect)
|
||||
;; the "protected" part of an unwind-protect is compiled (and thus
|
||||
;; optimized) as a top-level form, so don't do it here. But the
|
||||
|
@ -504,13 +515,14 @@
|
|||
(cdr (cdr form)))))
|
||||
|
||||
((eq fn 'catch)
|
||||
;; the body of a catch is compiled (and thus optimized) as a
|
||||
;; top-level form, so don't do it here. The tag is never
|
||||
;; for-effect. The body should have the same for-effect status
|
||||
;; as the catch form itself, but that isn't handled properly yet.
|
||||
(cons fn
|
||||
(cons (byte-optimize-form (nth 1 form) nil)
|
||||
(cdr (cdr form)))))
|
||||
(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)))))
|
||||
|
||||
((eq fn 'ignore)
|
||||
;; Don't treat the args to `ignore' as being
|
||||
|
@ -1292,7 +1304,7 @@
|
|||
"Don't call this!"
|
||||
;; Fetch and return the offset for the current opcode.
|
||||
;; Return nil if this opcode has no offset.
|
||||
(cond ((< bytedecomp-op byte-nth)
|
||||
(cond ((< bytedecomp-op byte-pophandler)
|
||||
(let ((tem (logand bytedecomp-op 7)))
|
||||
(setq bytedecomp-op (logand bytedecomp-op 248))
|
||||
(cond ((eq tem 6)
|
||||
|
@ -1311,7 +1323,9 @@
|
|||
(setq bytedecomp-op byte-constant)))
|
||||
((or (and (>= bytedecomp-op byte-constant2)
|
||||
(<= bytedecomp-op byte-goto-if-not-nil-else-pop))
|
||||
(= bytedecomp-op byte-stack-set2))
|
||||
(memq bytedecomp-op (eval-when-compile
|
||||
(list byte-stack-set2 byte-pushcatch
|
||||
byte-pushconditioncase))))
|
||||
;; Offset in next 2 bytes.
|
||||
(setq bytedecomp-ptr (1+ bytedecomp-ptr))
|
||||
(+ (aref bytes bytedecomp-ptr)
|
||||
|
|
Loading…
Add table
Add a link
Reference in a new issue