masscollaborationlabs/emacs
2
0
Fork 0
mirror of https://github.com/masscollaborationlabs/emacs.git synced 2025-07-18 01:46:44 +00:00
Code Issues Projects Releases Packages Wiki Activity Actions

fix non local mechanism

Browse source
This commit is contained in:
Andrea Corallo 2019-11-10 17:02:55 +01:00
parent d5ffb49490
commit c33c2ef511
2 changed files with 17 additions and 12 deletions
Download patch file Download diff file Expand all files Collapse all files

27
lisp/emacs-lisp/comp.el
View file

@ -527,6 +527,10 @@ Restore the original value afterwards."
(or (gethash label (comp-limplify-label-to-addr comp-pass)) (or (gethash label (comp-limplify-label-to-addr comp-pass))
(error "Can't find label %d" label))) (error "Can't find label %d" label)))
(defsubst comp-mark-curr-bb-closed ()
"Mark the current basic block as closed."
(setf (comp-block-closed (comp-limplify-curr-block comp-pass)) t))
(defun comp-bb-maybe-add (lap-addr &optional sp) (defun comp-bb-maybe-add (lap-addr &optional sp)
"If necessary create a pending basic block for LAP-ADDR with stack depth SP. "If necessary create a pending basic block for LAP-ADDR with stack depth SP.
The basic block is returned regardless it was already declared or not." The basic block is returned regardless it was already declared or not."
@ -580,11 +584,6 @@ The basic block is returned regardless it was already declared or not."
(cl-assert (not (comp-block-closed bb))) (cl-assert (not (comp-block-closed bb)))
(push insn (comp-block-insns bb)))) (push insn (comp-block-insns bb))))
(defsubst comp-emit-as-head (insn bb)
"Emit INSN at the head of basic block BB.
NOTE: this is used for late fixup therefore ignore if the basic block is closed."
(setf (comp-block-insns bb) (nconc (comp-block-insns bb) (list insn))))
(defsubst comp-emit-set-call (call) (defsubst comp-emit-set-call (call)
"Emit CALL assigning the result the the current slot frame. "Emit CALL assigning the result the the current slot frame.
If the callee function is known to have a return type propagate it." If the callee function is known to have a return type propagate it."
@ -629,7 +628,7 @@ The block is returned."
(let ((target (comp-bb-maybe-add (comp-label-to-addr label-num) (let ((target (comp-bb-maybe-add (comp-label-to-addr label-num)
(comp-sp)))) (comp-sp))))
(comp-emit `(jump ,(comp-block-name target))) (comp-emit `(jump ,(comp-block-name target)))
(setf (comp-block-closed (comp-limplify-curr-block comp-pass)) t)))) (comp-mark-curr-bb-closed))))
(defun comp-emit-cond-jump (a b target-offset lap-label negated) (defun comp-emit-cond-jump (a b target-offset lap-label negated)
"Emit a conditional jump to LAP-LABEL when A and B satisfy EQ. "Emit a conditional jump to LAP-LABEL when A and B satisfy EQ.
@ -648,7 +647,7 @@ Return value is the fall through block name."
(comp-emit (if negated (comp-emit (if negated
(list 'cond-jump a b target bb) (list 'cond-jump a b target bb)
(list 'cond-jump a b bb target))) (list 'cond-jump a b bb target)))
(setf (comp-block-closed (comp-limplify-curr-block comp-pass)) t) (comp-mark-curr-bb-closed)
bb))) bb)))
(defun comp-emit-handler (lap-label handler-type) (defun comp-emit-handler (lap-label handler-type)
@ -658,14 +657,20 @@ Return value is the fall through block name."
(let* ((guarded-bb (comp-bb-maybe-add (1+ (comp-limplify-pc comp-pass)) (let* ((guarded-bb (comp-bb-maybe-add (1+ (comp-limplify-pc comp-pass))
(comp-sp))) (comp-sp)))
(handler-bb (comp-bb-maybe-add (comp-label-to-addr label-num) (handler-bb (comp-bb-maybe-add (comp-label-to-addr label-num)
(1+ (comp-sp))))) (1+ (comp-sp))))
(pop-bb (make--comp-block nil (comp-sp) (comp-new-block-sym))))
(comp-emit (list 'push-handler (comp-emit (list 'push-handler
handler-type handler-type
(comp-slot+1) (comp-slot+1)
(comp-block-name handler-bb) (comp-block-name pop-bb)
(comp-block-name guarded-bb))) (comp-block-name guarded-bb)))
(setf (comp-block-closed (comp-limplify-curr-block comp-pass)) t) (comp-mark-curr-bb-closed)
(comp-emit-as-head `(fetch-handler ,(comp-slot+1)) handler-bb)))) ;; Emit the basic block to pop the handler if we got the non local.
(puthash (comp-block-name pop-bb) pop-bb (comp-func-blocks comp-func))
(setf (comp-limplify-curr-block comp-pass) pop-bb)
(comp-emit `(fetch-handler ,(comp-slot+1)))
(comp-emit `(jump ,(comp-block-name handler-bb)))
(comp-mark-curr-bb-closed))))
(defun comp-limplify-listn (n) (defun comp-limplify-listn (n)
"Limplify list N." "Limplify list N."

2
src/comp.c
View file

@ -2807,7 +2807,7 @@ compile_function (Lisp_Object func)
comp.loc_handler = gcc_jit_function_new_local (comp.func, comp.loc_handler = gcc_jit_function_new_local (comp.func,
NULL, NULL,
comp.handler_ptr_type, comp.handler_ptr_type,
"handler"); "c");
comp.func_blocks_h = CALLN (Fmake_hash_table); comp.func_blocks_h = CALLN (Fmake_hash_table);