mirror of
git://git.sv.gnu.org/emacs.git
synced 2026-01-03 10:31:37 -08:00
start compilation C side
This commit is contained in:
Andrea Corallo
Andrea Corallo
parent
ee04ef4f6f
commit
c51b7fe2c8
2 changed files with 166 additions and 117 deletions
|
|
@ -49,7 +49,14 @@
|
|||
)
|
||||
|
||||
(cl-defstruct comp-args
|
||||
mandatory nonrest rest)
|
||||
(min nil :type number
|
||||
:documentation "Minimum number of arguments allowed")
|
||||
(max nil
|
||||
:documentation "Maximum number of arguments allowed
|
||||
To be used when ncall-conv is nil.")
|
||||
(ncall-conv nil :type boolean
|
||||
:documentation "If t the signature is:
|
||||
(ptrdiff_t nargs, Lisp_Object *args)"))
|
||||
|
||||
(cl-defstruct (comp-func (:copier nil))
|
||||
"Internal rapresentation for a function."
|
||||
|
|
@ -64,6 +71,7 @@
|
|||
(ir nil
|
||||
:documentation "Current intermediate rappresentation")
|
||||
(args nil :type 'comp-args)
|
||||
(frame-size nil :type 'number)
|
||||
(limple-cnt -1 :type 'number
|
||||
:documentation "Counter to create ssa limple vars"))
|
||||
|
||||
|
|
@ -105,9 +113,15 @@
|
|||
|
||||
(defun comp-decrypt-lambda-list (x)
|
||||
"Decript lambda list X."
|
||||
(make-comp-args :rest (not (= (logand x 128) 0))
|
||||
:mandatory (logand x 127)
|
||||
:nonrest (ash x -8)))
|
||||
(let ((rest (not (= (logand x 128) 0)))
|
||||
(mandatory (logand x 127))
|
||||
(nonrest (ash x -8)))
|
||||
(if (and (null rest)
|
||||
(< nonrest 9)) ;; SUBR_MAX_ARGS
|
||||
(make-comp-args :min mandatory
|
||||
:max nonrest)
|
||||
(make-comp-args :min mandatory
|
||||
:ncall-conv t))))
|
||||
|
||||
(defun comp-recuparate-lap (func)
|
||||
"Byte compile and recuparate LAP rapresentation for FUNC."
|
||||
|
|
@ -119,6 +133,7 @@
|
|||
(setf (comp-func-args func)
|
||||
(comp-decrypt-lambda-list (aref (comp-func-byte-func func) 0)))
|
||||
(setf (comp-func-ir func) byte-compile-lap-output)
|
||||
(setf (comp-func-frame-size func) (aref (comp-func-byte-func func) 3))
|
||||
func)
|
||||
|
||||
(declare-function comp-init-ctxt "comp.c")
|
||||
|
|
@ -242,12 +257,13 @@ VAL is known at compile time."
|
|||
('byte-list4
|
||||
(comp-limplify-listn 4))
|
||||
('byte-return
|
||||
(push (list 'return (comp-slot)) comp-limple)
|
||||
`(return ,(comp-slot)))
|
||||
(_ (error "Unexpected LAP op %s" (symbol-name op))))))
|
||||
|
||||
(defun comp-limplify (func)
|
||||
"Given FUNC and return LIMPLE."
|
||||
(let* ((frame-size (aref (comp-func-byte-func func) 3))
|
||||
(let* ((frame-size (comp-func-frame-size func))
|
||||
(comp-func func)
|
||||
(comp-frame (make-comp-limple-frame
|
||||
:sp -1
|
||||
|
|
@ -284,11 +300,10 @@ VAL is known at compile time."
|
|||
(funcall pass func))
|
||||
comp-passes)
|
||||
;; Once we have the final LIMPLE we jump into C.
|
||||
(when t ;(boundp #'comp-init-ctxt)
|
||||
(comp-init-ctxt)
|
||||
(comp-add-func-to-ctxt func)
|
||||
(comp-compile-and-load-ctxt)
|
||||
(comp-release-ctxt))))
|
||||
(comp-init-ctxt)
|
||||
(comp-add-func-to-ctxt func)
|
||||
(comp-compile-and-load-ctxt)
|
||||
(comp-release-ctxt)))
|
||||
(error "Trying to native compile something not a function")))
|
||||
|
||||
(provide 'comp)
|
||||
|
|
|
|||
248
src/comp.c
248
src/comp.c
|
|
@ -35,34 +35,11 @@ along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. */
|
|||
|
||||
#define COMP_DEBUG 1
|
||||
|
||||
#define SAFE_ALLOCA_BLOCK(ptr, func, name) \
|
||||
do { \
|
||||
(ptr) = SAFE_ALLOCA (sizeof (basic_block_t)); \
|
||||
(ptr)->gcc_bb = gcc_jit_function_new_block ((func), (name)); \
|
||||
(ptr)->terminated = false; \
|
||||
(ptr)->top = NULL; \
|
||||
} while (0)
|
||||
|
||||
#define STR(s) #s
|
||||
|
||||
#define DECL_AND_SAFE_ALLOCA_BLOCK(name, func) \
|
||||
basic_block_t *(name); \
|
||||
SAFE_ALLOCA_BLOCK ((name), (func), STR(name))
|
||||
|
||||
/* Element of the meta stack. */
|
||||
typedef struct {
|
||||
gcc_jit_lvalue *gcc_lval;
|
||||
enum Lisp_Type type; /* -1 if not set. */
|
||||
Lisp_Object constant; /* This is used for constant propagation. */
|
||||
bool const_set;
|
||||
} stack_el_t;
|
||||
|
||||
typedef struct {
|
||||
gcc_jit_block *gcc_bb;
|
||||
/* When non zero indicates a stack pointer restart. */
|
||||
stack_el_t *top;
|
||||
bool terminated;
|
||||
} basic_block_t;
|
||||
#define DECL_BLOCK(name, func) \
|
||||
gcc_jit_block *(name) = \
|
||||
gcc_jit_function_new_block ((func), STR(name))
|
||||
|
||||
/* The compiler context */
|
||||
|
||||
|
|
@ -127,7 +104,8 @@ typedef struct {
|
|||
gcc_jit_field *cast_union_as_lisp_cons_ptr;
|
||||
gcc_jit_field *cast_union_as_lisp_obj;
|
||||
gcc_jit_field *cast_union_as_lisp_obj_ptr;
|
||||
gcc_jit_function *func; /* Current function being compiled */
|
||||
gcc_jit_function *func; /* Current function being compiled. */
|
||||
gcc_jit_block *block; /* Current basic block being compiled. */
|
||||
gcc_jit_rvalue *most_positive_fixnum;
|
||||
gcc_jit_rvalue *most_negative_fixnum;
|
||||
gcc_jit_rvalue *one;
|
||||
|
|
@ -141,7 +119,6 @@ typedef struct {
|
|||
gcc_jit_function *setcdr;
|
||||
gcc_jit_function *check_type;
|
||||
gcc_jit_function *check_impure;
|
||||
basic_block_t *block; /* Current basic block */
|
||||
Lisp_Object func_hash; /* f_name -> gcc_func */
|
||||
} comp_t;
|
||||
|
||||
|
|
@ -149,13 +126,6 @@ static comp_t comp;
|
|||
|
||||
FILE *logfile = NULL;
|
||||
|
||||
/* The result of one function compilation. */
|
||||
|
||||
typedef struct {
|
||||
gcc_jit_result *gcc_res;
|
||||
short min_args, max_args;
|
||||
} comp_f_res_t;
|
||||
|
||||
void emacs_native_compile (const char *lisp_f_name, const char *c_f_name,
|
||||
Lisp_Object func, int opt_level, bool dump_asm);
|
||||
|
||||
|
|
@ -221,7 +191,7 @@ INLINE static void
|
|||
emit_comment (const char *str)
|
||||
{
|
||||
if (COMP_DEBUG)
|
||||
gcc_jit_block_add_comment (comp.block->gcc_bb,
|
||||
gcc_jit_block_add_comment (comp.block,
|
||||
NULL,
|
||||
str);
|
||||
}
|
||||
|
|
@ -325,29 +295,28 @@ emit_call (const char *f_name, gcc_jit_type *ret_type, unsigned nargs,
|
|||
|
||||
INLINE static void
|
||||
emit_cond_jump (gcc_jit_rvalue *test,
|
||||
basic_block_t *then_target, basic_block_t *else_target)
|
||||
gcc_jit_block *then_target, gcc_jit_block *else_target)
|
||||
{
|
||||
if (gcc_jit_rvalue_get_type (test) == comp.bool_type)
|
||||
gcc_jit_block_end_with_conditional (comp.block->gcc_bb,
|
||||
gcc_jit_block_end_with_conditional (comp.block,
|
||||
NULL,
|
||||
test,
|
||||
then_target->gcc_bb,
|
||||
else_target->gcc_bb);
|
||||
then_target,
|
||||
else_target);
|
||||
else
|
||||
/* In case test is not bool we do a logical negation to obtain a bool as
|
||||
result. */
|
||||
gcc_jit_block_end_with_conditional (
|
||||
comp.block->gcc_bb,
|
||||
comp.block,
|
||||
NULL,
|
||||
gcc_jit_context_new_unary_op (comp.ctxt,
|
||||
NULL,
|
||||
GCC_JIT_UNARY_OP_LOGICAL_NEGATE,
|
||||
comp.bool_type,
|
||||
test),
|
||||
else_target->gcc_bb,
|
||||
then_target->gcc_bb);
|
||||
else_target,
|
||||
then_target);
|
||||
|
||||
comp.block->terminated = true;
|
||||
}
|
||||
|
||||
/* Close current basic block emitting a comparison between two rval. */
|
||||
|
|
@ -355,7 +324,7 @@ emit_cond_jump (gcc_jit_rvalue *test,
|
|||
/* static gcc_jit_rvalue * */
|
||||
/* emit_comparison_jump (enum gcc_jit_comparison op, */
|
||||
/* gcc_jit_rvalue *a, gcc_jit_rvalue *b, */
|
||||
/* basic_block_t *then_target, basic_block_t *else_target) */
|
||||
/* gcc_jit_block *then_target, gcc_jit_block *else_target) */
|
||||
/* { */
|
||||
/* gcc_jit_rvalue *test = gcc_jit_context_new_comparison (comp.ctxt, */
|
||||
/* NULL, */
|
||||
|
|
@ -381,7 +350,7 @@ emit_cast (gcc_jit_type *new_type, gcc_jit_rvalue *obj)
|
|||
NULL,
|
||||
comp.cast_union_type,
|
||||
format_string ("union_cast_%u", i++));
|
||||
gcc_jit_block_add_assignment (comp.block->gcc_bb,
|
||||
gcc_jit_block_add_assignment (comp.block,
|
||||
NULL,
|
||||
gcc_jit_lvalue_access_field (tmp_u,
|
||||
NULL,
|
||||
|
|
@ -717,7 +686,7 @@ emit_CONSP (gcc_jit_rvalue *obj)
|
|||
/* comp.lisp_obj_type, */
|
||||
/* "lisp_obj_fixnum"); */
|
||||
|
||||
/* gcc_jit_block_add_assignment (comp.block->gcc_bb, */
|
||||
/* gcc_jit_block_add_assignment (comp.block, */
|
||||
/* NULL, */
|
||||
/* emit_lval_XLI (res), */
|
||||
/* tmp); */
|
||||
|
|
@ -747,7 +716,7 @@ emit_lisp_obj_from_ptr (void *p)
|
|||
format_string ("Symbol %s",
|
||||
(char *) SDATA (SYMBOL_NAME (p))));
|
||||
|
||||
gcc_jit_block_add_assignment (comp.block->gcc_bb,
|
||||
gcc_jit_block_add_assignment (comp.block,
|
||||
NULL,
|
||||
emit_lval_XLP (lisp_obj),
|
||||
void_ptr);
|
||||
|
|
@ -867,7 +836,7 @@ emit_CHECK_CONS (gcc_jit_rvalue *x)
|
|||
x };
|
||||
|
||||
gcc_jit_block_add_eval (
|
||||
comp.block->gcc_bb,
|
||||
comp.block,
|
||||
NULL,
|
||||
gcc_jit_context_new_call (comp.ctxt,
|
||||
NULL,
|
||||
|
|
@ -898,7 +867,7 @@ emit_XSETCAR (gcc_jit_rvalue *c, gcc_jit_rvalue *n)
|
|||
emit_comment ("XSETCAR");
|
||||
|
||||
gcc_jit_block_add_assignment(
|
||||
comp.block->gcc_bb,
|
||||
comp.block,
|
||||
NULL,
|
||||
gcc_jit_rvalue_dereference (
|
||||
emit_car_addr (c),
|
||||
|
|
@ -912,7 +881,7 @@ emit_XSETCDR (gcc_jit_rvalue *c, gcc_jit_rvalue *n)
|
|||
emit_comment ("XSETCDR");
|
||||
|
||||
gcc_jit_block_add_assignment(
|
||||
comp.block->gcc_bb,
|
||||
comp.block,
|
||||
NULL,
|
||||
gcc_jit_rvalue_dereference (
|
||||
emit_cdr_addr (c),
|
||||
|
|
@ -955,7 +924,29 @@ emit_PURE_P (gcc_jit_rvalue *ptr)
|
|||
/* return emit_call (f_name, comp.lisp_obj_type, 2, args); */
|
||||
/* } */
|
||||
|
||||
/* /\* struct Lisp_Cons definition. *\/ */
|
||||
static void
|
||||
emit_limple_inst (Lisp_Object inst)
|
||||
{
|
||||
Lisp_Object op = XCAR (inst);
|
||||
Lisp_Object arg0 = XCAR (XCDR (inst));
|
||||
|
||||
if (EQ (op, Qblock))
|
||||
{
|
||||
char *block_name = SDATA (SYMBOL_NAME (arg0));
|
||||
comp.block = gcc_jit_function_new_block (comp.func, block_name);
|
||||
}
|
||||
else if (EQ (op, Qeqcall))
|
||||
{
|
||||
}
|
||||
else if (EQ (op, Qeqconst))
|
||||
{
|
||||
}
|
||||
else if (EQ (op, Qreturn))
|
||||
{
|
||||
}
|
||||
}
|
||||
|
||||
/* struct Lisp_Cons definition. */
|
||||
|
||||
static void
|
||||
define_lisp_cons (void)
|
||||
|
|
@ -1300,7 +1291,6 @@ define_cast_union (void)
|
|||
static void
|
||||
define_CHECK_TYPE (void)
|
||||
{
|
||||
USE_SAFE_ALLOCA;
|
||||
gcc_jit_param *param[] =
|
||||
{ gcc_jit_context_new_param (comp.ctxt,
|
||||
NULL,
|
||||
|
|
@ -1326,29 +1316,27 @@ define_CHECK_TYPE (void)
|
|||
gcc_jit_rvalue *predicate = gcc_jit_param_as_rvalue (param[1]);
|
||||
gcc_jit_rvalue *x = gcc_jit_param_as_rvalue (param[2]);
|
||||
|
||||
DECL_AND_SAFE_ALLOCA_BLOCK (init_block, comp.check_type);
|
||||
DECL_AND_SAFE_ALLOCA_BLOCK (ok_block, comp.check_type);
|
||||
DECL_AND_SAFE_ALLOCA_BLOCK (not_ok_block, comp.check_type);
|
||||
DECL_BLOCK (init_block, comp.check_type);
|
||||
DECL_BLOCK (ok_block, comp.check_type);
|
||||
DECL_BLOCK (not_ok_block, comp.check_type);
|
||||
|
||||
comp.block = init_block;
|
||||
comp.func = comp.check_type;
|
||||
|
||||
emit_cond_jump (ok, ok_block, not_ok_block);
|
||||
|
||||
gcc_jit_block_end_with_void_return (ok_block->gcc_bb, NULL);
|
||||
gcc_jit_block_end_with_void_return (ok_block, NULL);
|
||||
|
||||
comp.block = not_ok_block;
|
||||
|
||||
gcc_jit_rvalue *wrong_type_args[] = { predicate, x };
|
||||
|
||||
gcc_jit_block_add_eval (comp.block->gcc_bb,
|
||||
gcc_jit_block_add_eval (comp.block,
|
||||
NULL,
|
||||
emit_call ("wrong_type_argument",
|
||||
comp.lisp_obj_type, 2, wrong_type_args));
|
||||
|
||||
gcc_jit_block_end_with_void_return (not_ok_block->gcc_bb, NULL);
|
||||
|
||||
SAFE_FREE ();
|
||||
gcc_jit_block_end_with_void_return (not_ok_block, NULL);
|
||||
}
|
||||
|
||||
|
||||
|
|
@ -1357,8 +1345,6 @@ define_CHECK_TYPE (void)
|
|||
static void
|
||||
define_CAR_CDR (void)
|
||||
{
|
||||
USE_SAFE_ALLOCA;
|
||||
|
||||
gcc_jit_param *car_param =
|
||||
gcc_jit_context_new_param (comp.ctxt,
|
||||
NULL,
|
||||
|
|
@ -1392,9 +1378,9 @@ define_CAR_CDR (void)
|
|||
for (int i = 0; i < 2; i++)
|
||||
{
|
||||
gcc_jit_rvalue *c = gcc_jit_param_as_rvalue (param);
|
||||
DECL_AND_SAFE_ALLOCA_BLOCK (init_block, f);
|
||||
DECL_AND_SAFE_ALLOCA_BLOCK (is_cons_b, f);
|
||||
DECL_AND_SAFE_ALLOCA_BLOCK (not_a_cons_b, f);
|
||||
DECL_BLOCK (init_block, f);
|
||||
DECL_BLOCK (is_cons_b, f);
|
||||
DECL_BLOCK (not_a_cons_b, f);
|
||||
|
||||
comp.block = init_block;
|
||||
comp.func = f;
|
||||
|
|
@ -1404,23 +1390,23 @@ define_CAR_CDR (void)
|
|||
comp.block = is_cons_b;
|
||||
|
||||
if (f == comp.car)
|
||||
gcc_jit_block_end_with_return (comp.block->gcc_bb,
|
||||
gcc_jit_block_end_with_return (comp.block,
|
||||
NULL,
|
||||
emit_XCAR (c));
|
||||
else
|
||||
gcc_jit_block_end_with_return (comp.block->gcc_bb,
|
||||
gcc_jit_block_end_with_return (comp.block,
|
||||
NULL,
|
||||
emit_XCDR (c));
|
||||
|
||||
comp.block = not_a_cons_b;
|
||||
|
||||
DECL_AND_SAFE_ALLOCA_BLOCK (is_nil_b, f);
|
||||
DECL_AND_SAFE_ALLOCA_BLOCK (not_nil_b, f);
|
||||
DECL_BLOCK (is_nil_b, f);
|
||||
DECL_BLOCK (not_nil_b, f);
|
||||
|
||||
emit_cond_jump (emit_NILP (c), is_nil_b, not_nil_b);
|
||||
|
||||
comp.block = is_nil_b;
|
||||
gcc_jit_block_end_with_return (comp.block->gcc_bb,
|
||||
gcc_jit_block_end_with_return (comp.block,
|
||||
NULL,
|
||||
emit_lisp_obj_from_ptr (Qnil));
|
||||
|
||||
|
|
@ -1428,25 +1414,21 @@ define_CAR_CDR (void)
|
|||
gcc_jit_rvalue *wrong_type_args[] =
|
||||
{ emit_lisp_obj_from_ptr (Qlistp), c };
|
||||
|
||||
gcc_jit_block_add_eval (comp.block->gcc_bb,
|
||||
gcc_jit_block_add_eval (comp.block,
|
||||
NULL,
|
||||
emit_call ("wrong_type_argument",
|
||||
comp.lisp_obj_type, 2, wrong_type_args));
|
||||
gcc_jit_block_end_with_return (comp.block->gcc_bb,
|
||||
gcc_jit_block_end_with_return (comp.block,
|
||||
NULL,
|
||||
emit_lisp_obj_from_ptr (Qnil));
|
||||
f = comp.cdr;
|
||||
param = cdr_param;
|
||||
}
|
||||
|
||||
SAFE_FREE ();
|
||||
}
|
||||
|
||||
static void
|
||||
define_setcar_setcdr (void)
|
||||
{
|
||||
USE_SAFE_ALLOCA;
|
||||
|
||||
char const *f_name[] = {"setcar", "setcdr"};
|
||||
char const *par_name[] = {"new_car", "new_cdr"};
|
||||
|
||||
|
|
@ -1473,7 +1455,7 @@ define_setcar_setcdr (void)
|
|||
2,
|
||||
param,
|
||||
0);
|
||||
DECL_AND_SAFE_ALLOCA_BLOCK (init_block, *f_ref);
|
||||
DECL_BLOCK (init_block, *f_ref);
|
||||
comp.func = *f_ref;
|
||||
comp.block = init_block;
|
||||
|
||||
|
|
@ -1486,7 +1468,7 @@ define_setcar_setcdr (void)
|
|||
emit_XCONS (gcc_jit_param_as_rvalue (cell)) };
|
||||
|
||||
gcc_jit_block_add_eval (
|
||||
init_block->gcc_bb,
|
||||
init_block,
|
||||
NULL,
|
||||
gcc_jit_context_new_call (comp.ctxt,
|
||||
NULL,
|
||||
|
|
@ -1503,11 +1485,10 @@ define_setcar_setcdr (void)
|
|||
gcc_jit_param_as_rvalue (new_el));
|
||||
|
||||
/* return newel; */
|
||||
gcc_jit_block_end_with_return (init_block->gcc_bb,
|
||||
gcc_jit_block_end_with_return (init_block,
|
||||
NULL,
|
||||
gcc_jit_param_as_rvalue (new_el));
|
||||
}
|
||||
SAFE_FREE ();
|
||||
}
|
||||
|
||||
/* Declare a substitute for PSEUDOVECTORP as always inlined function. */
|
||||
|
|
@ -1515,8 +1496,6 @@ define_setcar_setcdr (void)
|
|||
static void
|
||||
define_PSEUDOVECTORP (void)
|
||||
{
|
||||
USE_SAFE_ALLOCA;
|
||||
|
||||
gcc_jit_param *param[] =
|
||||
{ gcc_jit_context_new_param (comp.ctxt,
|
||||
NULL,
|
||||
|
|
@ -1536,9 +1515,9 @@ define_PSEUDOVECTORP (void)
|
|||
param,
|
||||
0);
|
||||
|
||||
DECL_AND_SAFE_ALLOCA_BLOCK (init_block, comp.pseudovectorp);
|
||||
DECL_AND_SAFE_ALLOCA_BLOCK (ret_false_b, comp.pseudovectorp);
|
||||
DECL_AND_SAFE_ALLOCA_BLOCK (call_pseudovector_typep_b, comp.pseudovectorp);
|
||||
DECL_BLOCK (init_block, comp.pseudovectorp);
|
||||
DECL_BLOCK (ret_false_b, comp.pseudovectorp);
|
||||
DECL_BLOCK (call_pseudovector_typep_b, comp.pseudovectorp);
|
||||
|
||||
comp.block = init_block;
|
||||
comp.func = comp.pseudovectorp;
|
||||
|
|
@ -1548,7 +1527,7 @@ define_PSEUDOVECTORP (void)
|
|||
ret_false_b);
|
||||
|
||||
comp.block = ret_false_b;
|
||||
gcc_jit_block_end_with_return (ret_false_b->gcc_bb,
|
||||
gcc_jit_block_end_with_return (ret_false_b,
|
||||
NULL,
|
||||
gcc_jit_context_new_rvalue_from_int(
|
||||
comp.ctxt,
|
||||
|
|
@ -1560,21 +1539,18 @@ define_PSEUDOVECTORP (void)
|
|||
gcc_jit_param_as_rvalue (param[1]) };
|
||||
comp.block = call_pseudovector_typep_b;
|
||||
/* FIXME use XUNTAG now that's available. */
|
||||
gcc_jit_block_end_with_return (call_pseudovector_typep_b->gcc_bb
|
||||
gcc_jit_block_end_with_return (call_pseudovector_typep_b
|
||||
,
|
||||
NULL,
|
||||
emit_call ("helper_PSEUDOVECTOR_TYPEP_XUNTAG",
|
||||
comp.bool_type,
|
||||
2,
|
||||
args));
|
||||
SAFE_FREE ();
|
||||
}
|
||||
|
||||
static void
|
||||
define_CHECK_IMPURE (void)
|
||||
{
|
||||
USE_SAFE_ALLOCA;
|
||||
|
||||
gcc_jit_param *param[] =
|
||||
{ gcc_jit_context_new_param (comp.ctxt,
|
||||
NULL,
|
||||
|
|
@ -1593,9 +1569,9 @@ define_CHECK_IMPURE (void)
|
|||
param,
|
||||
0);
|
||||
|
||||
DECL_AND_SAFE_ALLOCA_BLOCK (init_block, comp.check_impure);
|
||||
DECL_AND_SAFE_ALLOCA_BLOCK (err_block, comp.check_impure);
|
||||
DECL_AND_SAFE_ALLOCA_BLOCK (ok_block, comp.check_impure);
|
||||
DECL_BLOCK (init_block, comp.check_impure);
|
||||
DECL_BLOCK (err_block, comp.check_impure);
|
||||
DECL_BLOCK (ok_block, comp.check_impure);
|
||||
|
||||
comp.block = init_block;
|
||||
comp.func = comp.check_impure;
|
||||
|
|
@ -1603,29 +1579,26 @@ define_CHECK_IMPURE (void)
|
|||
emit_cond_jump (emit_PURE_P (gcc_jit_param_as_rvalue (param[0])), /* FIXME */
|
||||
err_block,
|
||||
ok_block);
|
||||
gcc_jit_block_end_with_void_return (ok_block->gcc_bb, NULL);
|
||||
gcc_jit_block_end_with_void_return (ok_block, NULL);
|
||||
|
||||
gcc_jit_rvalue *pure_write_error_arg =
|
||||
gcc_jit_param_as_rvalue (param[0]);
|
||||
|
||||
comp.block = err_block;
|
||||
gcc_jit_block_add_eval (comp.block->gcc_bb,
|
||||
gcc_jit_block_add_eval (comp.block,
|
||||
NULL,
|
||||
emit_call ("pure_write_error",
|
||||
comp.void_type, 1,
|
||||
&pure_write_error_arg));
|
||||
|
||||
gcc_jit_block_end_with_void_return (err_block->gcc_bb, NULL);
|
||||
|
||||
SAFE_FREE ();}
|
||||
gcc_jit_block_end_with_void_return (err_block, NULL);
|
||||
}
|
||||
|
||||
/* Declare a function to convert boolean into t or nil */
|
||||
|
||||
static void
|
||||
define_bool_to_lisp_obj (void)
|
||||
{
|
||||
USE_SAFE_ALLOCA;
|
||||
|
||||
/* x ? Qt : Qnil */
|
||||
gcc_jit_param *param = gcc_jit_context_new_param (comp.ctxt,
|
||||
NULL,
|
||||
|
|
@ -1639,9 +1612,9 @@ define_bool_to_lisp_obj (void)
|
|||
1,
|
||||
¶m,
|
||||
0);
|
||||
DECL_AND_SAFE_ALLOCA_BLOCK (init_block, comp.bool_to_lisp_obj);
|
||||
DECL_AND_SAFE_ALLOCA_BLOCK (ret_t_block, comp.bool_to_lisp_obj);
|
||||
DECL_AND_SAFE_ALLOCA_BLOCK (ret_nil_block, comp.bool_to_lisp_obj);
|
||||
DECL_BLOCK (init_block, comp.bool_to_lisp_obj);
|
||||
DECL_BLOCK (ret_t_block, comp.bool_to_lisp_obj);
|
||||
DECL_BLOCK (ret_nil_block, comp.bool_to_lisp_obj);
|
||||
comp.block = init_block;
|
||||
comp.func = comp.bool_to_lisp_obj;
|
||||
|
||||
|
|
@ -1650,16 +1623,15 @@ define_bool_to_lisp_obj (void)
|
|||
ret_nil_block);
|
||||
|
||||
comp.block = ret_t_block;
|
||||
gcc_jit_block_end_with_return (ret_t_block->gcc_bb,
|
||||
gcc_jit_block_end_with_return (ret_t_block,
|
||||
NULL,
|
||||
emit_lisp_obj_from_ptr (Qt));
|
||||
|
||||
comp.block = ret_nil_block;
|
||||
gcc_jit_block_end_with_return (ret_nil_block->gcc_bb,
|
||||
gcc_jit_block_end_with_return (ret_nil_block,
|
||||
NULL,
|
||||
emit_lisp_obj_from_ptr (Qnil));
|
||||
|
||||
SAFE_FREE ();
|
||||
}
|
||||
|
||||
DEFUN ("comp-init-ctxt", Fcomp_init_ctxt, Scomp_init_ctxt,
|
||||
|
|
@ -1832,6 +1804,56 @@ DEFUN ("comp-add-func-to-ctxt", Fcomp_add_func_to_ctxt, Scomp_add_func_to_ctxt,
|
|||
{
|
||||
char *c_name =
|
||||
(char *) SDATA (CALLN (Ffuncall, intern ("comp-func-c-func-name"), func));
|
||||
Lisp_Object args = (CALLN (Ffuncall, intern ("comp-func-args"), func));
|
||||
EMACS_INT frame_size =
|
||||
XFIXNUM (CALLN (Ffuncall, intern ("comp-func-frame-size"), func));
|
||||
EMACS_INT min_args =
|
||||
XFIXNUM (CALLN (Ffuncall, intern ("comp-args-min"), args));
|
||||
EMACS_INT max_args =
|
||||
XFIXNUM (CALLN (Ffuncall, intern ("comp-args-max"), args));
|
||||
bool ncall =
|
||||
!NILP (CALLN (Ffuncall, intern ("comp-args-ncall-conv"), args));
|
||||
|
||||
if (!ncall)
|
||||
{
|
||||
comp.func =
|
||||
emit_func_declare (c_name, comp.lisp_obj_type, min_args,
|
||||
NULL, GCC_JIT_FUNCTION_EXPORTED, false);
|
||||
}
|
||||
else
|
||||
{
|
||||
error ("Not supported for now");
|
||||
}
|
||||
|
||||
gcc_jit_lvalue *meta_frame =
|
||||
gcc_jit_function_new_local (
|
||||
comp.func,
|
||||
NULL,
|
||||
gcc_jit_context_new_array_type (comp.ctxt,
|
||||
NULL,
|
||||
comp.lisp_obj_type,
|
||||
frame_size),
|
||||
"local");
|
||||
|
||||
gcc_jit_lvalue *frame[frame_size];
|
||||
for (int i = 0; i < frame_size; ++i)
|
||||
frame[i] =
|
||||
gcc_jit_context_new_array_access (
|
||||
comp.ctxt,
|
||||
NULL,
|
||||
gcc_jit_lvalue_as_rvalue (meta_frame),
|
||||
gcc_jit_context_new_rvalue_from_int (comp.ctxt,
|
||||
comp.int_type,
|
||||
i));
|
||||
|
||||
Lisp_Object limple = (CALLN (Ffuncall, intern ("comp-func-ir"), func));
|
||||
|
||||
while (CONSP (limple))
|
||||
{
|
||||
Lisp_Object inst = XCAR (limple);
|
||||
emit_limple_inst (inst);
|
||||
limple = XCDR (limple);
|
||||
};
|
||||
|
||||
return Qt;
|
||||
}
|
||||
|
|
@ -1846,12 +1868,24 @@ DEFUN ("comp-compile-and-load-ctxt", Fcomp_compile_and_load_ctxt,
|
|||
gcc_jit_context_set_int_option (comp.ctxt,
|
||||
GCC_JIT_INT_OPTION_OPTIMIZATION_LEVEL,
|
||||
comp_speed);
|
||||
/* Gcc doesn't like being interrupted. */
|
||||
sigset_t oldset;
|
||||
block_atimers (&oldset);
|
||||
|
||||
unblock_atimers (&oldset);
|
||||
|
||||
return Qt;
|
||||
}
|
||||
|
||||
void
|
||||
syms_of_comp (void)
|
||||
{
|
||||
/* Limple instruction set. */
|
||||
DEFSYM (Qblock, "BLOCK");
|
||||
DEFSYM (Qeqcall, "=call");
|
||||
DEFSYM (Qeqconst, "=const");
|
||||
DEFSYM (Qreturn, "return");
|
||||
|
||||
defsubr (&Scomp_init_ctxt);
|
||||
defsubr (&Scomp_release_ctxt);
|
||||
defsubr (&Scomp_add_func_to_ctxt);
|
||||
|
|
|
|||
Loading…
Add table
Add a link
Reference in a new issue