From df93780efe61cea82463a96dbac3792fd3eed737 Mon Sep 17 00:00:00 2001 From: Andrea Corallo Date: Mon, 24 Jun 2019 13:47:08 +0200 Subject: [PATCH] full inline car --- src/comp.c | 109 ++++++++++++++++++++++++++++++++++++++++------------- 1 file changed, 82 insertions(+), 27 deletions(-) diff --git a/src/comp.c b/src/comp.c index 599f8f158b7..e3ec34d5545 100644 --- a/src/comp.c +++ b/src/comp.c @@ -194,7 +194,10 @@ typedef struct { /* struct Lisp_Cons */ gcc_jit_struct *lisp_cons_s; gcc_jit_field *lisp_cons_u; - gcc_jit_type *lisp_cons_ptr; + gcc_jit_field *lisp_cons_u_s; + gcc_jit_field *lisp_cons_u_s_car; + gcc_jit_type *lisp_cons_type; + gcc_jit_type *lisp_cons_ptr_type; /* struct jmp_buf. */ gcc_jit_struct *jmp_buf_s; /* struct handler. */ @@ -217,6 +220,7 @@ typedef struct { gcc_jit_field *cast_union_as_i; gcc_jit_field *cast_union_as_b; gcc_jit_field *cast_union_as_c_p; + gcc_jit_field *cast_union_as_lisp_cons_ptr; gcc_jit_function *func; /* Current function being compiled */ gcc_jit_rvalue *most_positive_fixnum; gcc_jit_rvalue *most_negative_fixnum; @@ -225,6 +229,7 @@ typedef struct { gcc_jit_rvalue *lisp_int0; gcc_jit_function *pseudovectorp; gcc_jit_function *bool_to_lisp_obj; + gcc_jit_function *car; basic_block_t *block; /* Current basic block */ Lisp_Object func_hash; /* f_name -> gcc_func */ } comp_t; @@ -297,6 +302,8 @@ type_to_cast_field (gcc_jit_type *type) field = comp.cast_union_as_b; else if (type == comp.char_ptr_type) field = comp.cast_union_as_c_p; + else if (type == comp.lisp_cons_ptr_type) + field = comp.cast_union_as_lisp_cons_ptr; else error ("unsopported cast\n"); @@ -768,6 +775,8 @@ emit_NILP (gcc_jit_rvalue *x) { return emit_EQ (x, emit_lisp_obj_from_ptr (comp.block, Qnil)); } + +static gcc_jit_rvalue * emit_call_n_ref (const char *f_name, unsigned nargs, gcc_jit_lvalue *base_arg) { @@ -813,8 +822,10 @@ define_lisp_cons (void) gcc_jit_context_new_opaque_struct (comp.ctxt, NULL, "comp_Lisp_Cons"); - comp.lisp_cons_ptr = - gcc_jit_type_get_pointer (gcc_jit_struct_as_type (comp.lisp_cons_s)); + comp.lisp_cons_type = + gcc_jit_struct_as_type (comp.lisp_cons_s); + comp.lisp_cons_ptr_type = + gcc_jit_type_get_pointer (comp.lisp_cons_type); gcc_jit_field *cdr_u_fields[] = { gcc_jit_context_new_field (comp.ctxt, @@ -823,7 +834,7 @@ define_lisp_cons (void) "cdr"), gcc_jit_context_new_field (comp.ctxt, NULL, - comp.lisp_cons_ptr, + comp.lisp_cons_ptr_type, "chain") }; gcc_jit_type *cdr_u = @@ -834,11 +845,12 @@ define_lisp_cons (void) / sizeof (*cdr_u_fields), cdr_u_fields); + comp.lisp_cons_u_s_car = gcc_jit_context_new_field (comp.ctxt, + NULL, + comp.lisp_obj_type, + "car"); gcc_jit_field *cons_s_fields[] = - { gcc_jit_context_new_field (comp.ctxt, - NULL, - comp.lisp_obj_type, - "car"), + { comp.lisp_cons_u_s_car, gcc_jit_context_new_field (comp.ctxt, NULL, cdr_u, @@ -852,11 +864,13 @@ define_lisp_cons (void) / sizeof (*cons_s_fields), cons_s_fields); - gcc_jit_field *cons_u_fields[] = - { gcc_jit_context_new_field (comp.ctxt, + comp.lisp_cons_u_s = gcc_jit_context_new_field (comp.ctxt, NULL, gcc_jit_struct_as_type (cons_s), - "s"), + "s"); + + gcc_jit_field *cons_u_fields[] = + { comp.lisp_cons_u_s, gcc_jit_context_new_field ( comp.ctxt, NULL, @@ -866,7 +880,7 @@ define_lisp_cons (void) sizeof (struct Lisp_Cons)), "align_pad") }; - gcc_jit_type *cons_u = + gcc_jit_type *lisp_cons_u_type = gcc_jit_context_new_union_type (comp.ctxt, NULL, "comp_cons_u", @@ -877,7 +891,7 @@ define_lisp_cons (void) comp.lisp_cons_u = gcc_jit_context_new_field (comp.ctxt, NULL, - cons_u, + lisp_cons_u_type, "u"); gcc_jit_struct_set_fields (comp.lisp_cons_s, NULL, 1, &comp.lisp_cons_u); @@ -1087,29 +1101,30 @@ define_CAR (void) 1, ¶m, 0); + gcc_jit_rvalue *c = gcc_jit_param_as_rvalue (param); gcc_jit_block *initial_block = gcc_jit_function_new_block (comp.car, "CAR_initial_block"); - /* gcc_jit_block *is_cons_b = */ - /* gcc_jit_function_new_block (comp.pseudovectorp, "is_cons"); */ + gcc_jit_block *is_cons_b = + gcc_jit_function_new_block (comp.car, "is_cons"); - /* gcc_jit_block *not_a_cons_b = */ - /* gcc_jit_function_new_block (comp.pseudovectorp, "not_a_cons"); */ + gcc_jit_block *not_a_cons_b = + gcc_jit_function_new_block (comp.car, "not_a_cons"); /* Set current context as needed */ basic_block_t block = { .gcc_bb = initial_block, - .terminated = false }; + .terminated = false }; comp.block = █ comp.func = comp.car; - /* emit_cond_jump ( */ - /* emit_cast (comp.bool_type, */ - /* emit_CONSP (gcc_jit_param_as_rvalue (param))), */ - /* is_cons_b, */ - /* not_a_cons_b); */ + emit_cond_jump ( + emit_cast (comp.bool_type, + emit_CONSP (c)), + is_cons_b, + not_a_cons_b); - /* comp.block->gcc_bb = is_cons_b; */ + comp.block->gcc_bb = is_cons_b; gcc_jit_rvalue *res_car = /* c->u.s.car */ @@ -1119,7 +1134,7 @@ define_CAR (void) /* c->u */ gcc_jit_lvalue_as_rvalue ( gcc_jit_rvalue_dereference_field ( - emit_rval_XCONS (gcc_jit_param_as_rvalue (param)), + emit_rval_XCONS (c), NULL, comp.lisp_cons_u)), NULL, @@ -1127,10 +1142,37 @@ define_CAR (void) NULL, comp.lisp_cons_u_s_car); - gcc_jit_block_end_with_return (initial_block, + gcc_jit_block_end_with_return (comp.block->gcc_bb, NULL, res_car); + comp.block->gcc_bb = not_a_cons_b; + + gcc_jit_block *is_nil_b = + gcc_jit_function_new_block (comp.car, "is_nil"); + gcc_jit_block *not_nil_b = + gcc_jit_function_new_block (comp.car, "not_nil"); + + emit_cond_jump (emit_NILP (c), + is_nil_b, + not_nil_b); + + comp.block->gcc_bb = is_nil_b; + gcc_jit_block_end_with_return (comp.block->gcc_bb, + NULL, + emit_lisp_obj_from_ptr (comp.block, Qnil)); + + comp.block->gcc_bb = not_nil_b; + gcc_jit_rvalue *wrong_type_args[] = + { emit_lisp_obj_from_ptr (comp.block, Qlistp), c }; + + gcc_jit_block_add_eval (comp.block->gcc_bb, + NULL, + emit_call ("wrong_type_argument", + comp.lisp_obj_type, 2, wrong_type_args)); + gcc_jit_block_end_with_return (comp.block->gcc_bb, + NULL, + emit_lisp_obj_from_ptr (comp.block, Qnil)); } /* Declare a substitute for PSEUDOVECTORP as always inlined function. */ @@ -1496,6 +1538,10 @@ init_comp (int opt_level) gcc_jit_context_new_rvalue_from_ptr (comp.ctxt, comp.thread_state_ptr_type, current_thread); + + /* Define inline functions. */ + + define_CAR(); define_PSEUDOVECTORP (); define_bool_to_lisp_obj (); } @@ -1911,7 +1957,16 @@ compile_f (const char *f_name, ptrdiff_t bytestr_length, CASE_CALL_N (eq, 2); CASE_CALL_N (memq, 1); CASE_CALL_N (not, 1); - CASE_CALL_N (car, 1); + + case Bcar: + POP1; + res = gcc_jit_context_new_call (comp.ctxt, + NULL, + comp.car, + 1, args); + PUSH_RVAL (res); + break; + CASE_CALL_N (cdr, 1); CASE_CALL_N (cons, 2); -- 2.39.5