let limple support calls with no assignment
This commit is contained in:
Andrea Corallo
Andrea Corallo
parent
73cb29c3fb
commit
ba8ca065a7
2 changed files with 70 additions and 75 deletions
|
|
@ -193,19 +193,23 @@ To be used when ncall-conv is nil.")
|
|||
"Slot into the meta-stack pointed by sp + 1."
|
||||
'(comp-slot-n (1+ (comp-sp))))
|
||||
|
||||
(defun comp-emit-call (call)
|
||||
"Emit CALL."
|
||||
(defun comp-emit (x)
|
||||
"Emit X into current LIMPLE ir.."
|
||||
(push x comp-limple))
|
||||
|
||||
(defun comp-emit-set-call (call)
|
||||
"Emit CALL assigning the result the the current slot frame.."
|
||||
(cl-assert call)
|
||||
(setf (comp-slot)
|
||||
(make-comp-mvar :slot (comp-sp)
|
||||
:type (alist-get (cadr call)
|
||||
comp-known-ret-types)))
|
||||
(push (list 'set (comp-slot) call) comp-limple))
|
||||
(comp-emit (list 'set (comp-slot) call)))
|
||||
|
||||
(defun comp-push-call (call)
|
||||
"Push call CALL into frame."
|
||||
"Increase sp and call `comp-emit-set-call' to emit CALL."
|
||||
(cl-incf (comp-sp))
|
||||
(comp-emit-call call))
|
||||
(comp-emit-set-call call))
|
||||
|
||||
(defun comp-push-slot-n (n)
|
||||
"Push slot number N into frame."
|
||||
|
|
@ -215,11 +219,11 @@ To be used when ncall-conv is nil.")
|
|||
(setf (comp-slot)
|
||||
(copy-sequence src-slot))
|
||||
(setf (comp-mvar-slot (comp-slot)) (comp-sp))
|
||||
(push (list 'set (comp-slot) src-slot) comp-limple)))
|
||||
(comp-emit (list 'set (comp-slot) src-slot))))
|
||||
|
||||
(defun comp-emit-annotation (str)
|
||||
"Emit annotation STR."
|
||||
(push `(comment ,str) comp-limple))
|
||||
(comp-emit `(comment ,str)))
|
||||
|
||||
(defun comp-push-const (val)
|
||||
"Push VAL into frame.
|
||||
|
|
@ -228,7 +232,7 @@ VAL is known at compile time."
|
|||
(setf (comp-slot) (make-comp-mvar :slot (comp-sp)
|
||||
:const-vld t
|
||||
:constant val))
|
||||
(push (list 'setimm (comp-slot) val) comp-limple))
|
||||
(comp-emit (list 'setimm (comp-slot) val)))
|
||||
|
||||
(defun comp-emit-block (bblock)
|
||||
"Push basic block BBLOCK."
|
||||
|
|
@ -237,7 +241,7 @@ VAL is known at compile time."
|
|||
;; This will be superseded by proper flow analysis.
|
||||
(setf (comp-limple-frame-frame comp-frame)
|
||||
(comp-limple-frame-new-frame (comp-func-frame-size comp-func)))
|
||||
(push `(block ,bblock) comp-limple))
|
||||
(comp-emit `(block ,bblock)))
|
||||
|
||||
(defun comp-pop (n)
|
||||
"Pop N elements from the meta-stack."
|
||||
|
|
@ -245,12 +249,12 @@ VAL is known at compile time."
|
|||
|
||||
(defun comp-limplify-listn (n)
|
||||
"Limplify list N."
|
||||
(comp-emit-call `(call Fcons ,(comp-slot)
|
||||
(comp-emit-set-call `(call Fcons ,(comp-slot)
|
||||
,(make-comp-mvar :const-vld t
|
||||
:constant nil)))
|
||||
(dotimes (_ (1- n))
|
||||
(comp-pop 1)
|
||||
(comp-emit-call `(call Fcons
|
||||
(comp-emit-set-call `(call Fcons
|
||||
,(comp-slot)
|
||||
,(comp-slot-n (1+ (comp-sp)))))))
|
||||
|
||||
|
|
@ -265,7 +269,7 @@ VAL is known at compile time."
|
|||
:const-vld t
|
||||
:constant (cadr inst)))))
|
||||
('byte-varset
|
||||
(comp-emit-call `(call set_internal
|
||||
(comp-emit `(call set_internal
|
||||
,(make-comp-mvar
|
||||
:const-vld t
|
||||
:constant (cadr inst))
|
||||
|
|
@ -276,20 +280,20 @@ VAL is known at compile time."
|
|||
(comp-push-slot-n (- (comp-sp) (cdr inst))))
|
||||
('byte-plus
|
||||
(comp-pop 1)
|
||||
(comp-emit-call `(callref Fplus 2 ,(comp-sp))))
|
||||
(comp-emit-set-call `(callref Fplus 2 ,(comp-sp))))
|
||||
('byte-cons
|
||||
(comp-pop 1)
|
||||
(comp-emit-call `(call Fcons ,(comp-slot) ,(comp-slot-next))))
|
||||
(comp-emit-set-call `(call Fcons ,(comp-slot) ,(comp-slot-next))))
|
||||
('byte-car
|
||||
(comp-emit-call `(call Fcar ,(comp-slot))))
|
||||
(comp-emit-set-call `(call Fcar ,(comp-slot))))
|
||||
('byte-cdr
|
||||
(comp-emit-call `(call Fcdr ,(comp-slot))))
|
||||
(comp-emit-set-call `(call Fcdr ,(comp-slot))))
|
||||
('byte-car-safe
|
||||
(comp-emit-call `(call Fcar_safe ,(comp-slot))))
|
||||
(comp-emit-set-call `(call Fcar_safe ,(comp-slot))))
|
||||
('byte-cdr-safe
|
||||
(comp-emit-call `(call Fcdr_safe ,(comp-slot))))
|
||||
(comp-emit-set-call `(call Fcdr_safe ,(comp-slot))))
|
||||
('byte-length
|
||||
(comp-emit-call `(call Flength ,(comp-slot))))
|
||||
(comp-emit-set-call `(call Flength ,(comp-slot))))
|
||||
('byte-list1
|
||||
(comp-limplify-listn 1))
|
||||
('byte-list2
|
||||
|
|
@ -299,7 +303,7 @@ VAL is known at compile time."
|
|||
('byte-list4
|
||||
(comp-limplify-listn 4))
|
||||
('byte-return
|
||||
(push (list 'return (comp-slot)) comp-limple)
|
||||
(comp-emit (list 'return (comp-slot)))
|
||||
`(return ,(comp-slot)))
|
||||
(_ (error "Unexpected LAP op %s" (symbol-name op))))))
|
||||
|
||||
|
|
|
|||
73
src/comp.c
73
src/comp.c
|
|
@ -976,12 +976,10 @@ emit_limple_call (Lisp_Object arg1)
|
|||
if (calle[0] == 'F')
|
||||
{
|
||||
/*
|
||||
Ex: (= #s(comp-mvar 6 1 nil nil nil)
|
||||
(call Fcar #s(comp-mvar 4 0 nil nil nil)))
|
||||
Ex: (call Fcar #s(comp-mvar 4 0 nil nil nil))
|
||||
|
||||
Ex: (= #s(comp-mvar 5 0 nil nil cons)
|
||||
(call Fcons #s(comp-mvar 3 0 t 1 nil)
|
||||
#s(comp-mvar 4 nil t nil nil)))
|
||||
Ex: (call Fcons #s(comp-mvar 3 0 t 1 nil)
|
||||
#s(comp-mvar 4 nil t nil nil))
|
||||
*/
|
||||
|
||||
ptrdiff_t nargs = list_length (call_args);
|
||||
|
|
@ -994,10 +992,9 @@ emit_limple_call (Lisp_Object arg1)
|
|||
else if (!strcmp (calle, "set_internal"))
|
||||
{
|
||||
/*
|
||||
Ex: (set #s(comp-mvar 8 1 nil nil nil)
|
||||
(call set_internal
|
||||
Ex: (call set_internal
|
||||
#s(comp-mvar 7 nil t xxx nil)
|
||||
#s(comp-mvar 6 1 t 3 nil)))
|
||||
#s(comp-mvar 6 1 t 3 nil))
|
||||
*/
|
||||
/* TODO: Inline the most common case. */
|
||||
eassert (list_length (call_args) == 2);
|
||||
|
|
@ -1008,14 +1005,26 @@ emit_limple_call (Lisp_Object arg1)
|
|||
gcc_args[3] = gcc_jit_context_new_rvalue_from_int (comp.ctxt,
|
||||
comp.int_type,
|
||||
SET_INTERNAL_SET);
|
||||
gcc_jit_block_add_eval (
|
||||
comp.block,
|
||||
NULL,
|
||||
emit_call ("set_internal", comp.void_type , 4, gcc_args));
|
||||
|
||||
return NULL;
|
||||
return emit_call ("set_internal", comp.void_type , 4, gcc_args);
|
||||
}
|
||||
error ("LIMPLE inconsiste call");
|
||||
error ("LIMPLE call is inconsistet");
|
||||
}
|
||||
|
||||
static gcc_jit_rvalue *
|
||||
emit_limple_call_ref (Lisp_Object arg1)
|
||||
{
|
||||
/* Ex: (callref Fplus 2 0). */
|
||||
|
||||
char *calle = (char *) SDATA (SYMBOL_NAME (SECOND (arg1)));
|
||||
EMACS_UINT nargs = XFIXNUM (THIRD (arg1));
|
||||
EMACS_UINT base_ptr = XFIXNUM (FORTH (arg1));
|
||||
gcc_jit_rvalue *gcc_args[2] =
|
||||
{ gcc_jit_context_new_rvalue_from_int (comp.ctxt,
|
||||
comp.ptrdiff_type,
|
||||
nargs),
|
||||
gcc_jit_lvalue_get_address (comp.frame[base_ptr], NULL) };
|
||||
|
||||
return emit_call (calle, comp.lisp_obj_type, 2, gcc_args);
|
||||
}
|
||||
|
||||
static void
|
||||
|
|
@ -1037,44 +1046,26 @@ emit_limple_inst (Lisp_Object inst)
|
|||
gcc_jit_block_end_with_jump (comp.block, NULL, target);
|
||||
comp.block = target;
|
||||
}
|
||||
else if (EQ (op, Qcall))
|
||||
{
|
||||
gcc_jit_block_add_eval (comp.block,
|
||||
NULL,
|
||||
emit_limple_call (inst));
|
||||
}
|
||||
else if (EQ (op, Qset))
|
||||
{
|
||||
EMACS_UINT slot_n = XFIXNUM (FUNCALL1 (comp-mvar-slot, arg0));
|
||||
Lisp_Object arg1 = THIRD (inst);
|
||||
|
||||
if (EQ (Ftype_of (arg1), Qcomp_mvar))
|
||||
{
|
||||
/*
|
||||
Ex: (= #s(comp-mvar 6 2 nil nil nil)
|
||||
#s(comp-mvar 6 0 nil nil nil)).
|
||||
*/
|
||||
res = emit_mvar_val (arg1);
|
||||
}
|
||||
else if (EQ (FIRST (arg1), Qcall))
|
||||
{
|
||||
res = emit_limple_call (arg1);
|
||||
}
|
||||
else if (EQ (FIRST (arg1), Qcallref))
|
||||
{
|
||||
/* Ex: (= #s(comp-mvar 10 1 nil nil nil) (callref Fplus 2 0)). */
|
||||
|
||||
char *calle = (char *) SDATA (SYMBOL_NAME (SECOND (arg1)));
|
||||
EMACS_UINT nargs = XFIXNUM (THIRD (arg1));
|
||||
EMACS_UINT base_ptr = XFIXNUM (FORTH (arg1));
|
||||
gcc_jit_rvalue *gcc_args[2] =
|
||||
{ gcc_jit_context_new_rvalue_from_int (comp.ctxt,
|
||||
comp.ptrdiff_type,
|
||||
nargs),
|
||||
gcc_jit_lvalue_get_address (
|
||||
comp.frame[base_ptr],
|
||||
NULL) };
|
||||
res = emit_call (calle, comp.lisp_obj_type, 2, gcc_args);
|
||||
}
|
||||
res = emit_limple_call_ref (arg1);
|
||||
else
|
||||
{
|
||||
error ("LIMPLE inconsistent arg1 for op =");
|
||||
}
|
||||
if (res)
|
||||
eassert (res);
|
||||
gcc_jit_block_add_assignment (comp.block,
|
||||
NULL,
|
||||
comp.frame[slot_n],
|
||||
|
|
|
|||
Loading…
Add table
Add a link
Reference in a new issue