From d6b6daca372e3a7d2abc601e2b60d6c2cc6c0abc Mon Sep 17 00:00:00 2001 From: Andy Wingo Date: Wed, 29 Apr 2020 21:23:53 +0200 Subject: [PATCH] Add intrinsics for a baseline compiler Since there's no optimization in the baseline compiler, there's no sense in instruction explosion. * libguile/intrinsics.h: * libguile/intrinsics.c ($car, $cdr, $set-car!, $set-cdr!, $variable-ref, $variable-set!, $vector-length, $vector-ref, $vector-set!, $vector-ref/immediate, $vector-set!, $allocate-struct, $struct-vtable, $struct-ref, $struct-set! $struct-ref/immediate, $struct-set!): New intrinsics. * libguile/jit.c (compile_call_scm_scm, compile_call_scm_scm_slow) (compile_call_scm_scm_scm, compile_call_scm_scm_scm_slow) (compile_call_scm_uimm_scm, compile_call_scm_uimm_scm_slow): New code generators. * libguile/vm-engine.c (call-scm-scm, call-scm-scm-scm, call-scm-uimm-scm): New instructions. * module/system/vm/assembler.scm (emit-null?, emit-false?, emit-nil?): Export these. Also export emitters for the new intrinsics. (define-scm-scm-intrinsic, define-scm-uimm-scm-intrinsic) (define-scm-scm-scm-intrinsic): New helpers. * doc/ref/vm.texi (Intrinsic Call Instructions): Add new instructions. --- doc/ref/vm.texi | 39 +++++++++++++++++++ libguile/intrinsics.c | 69 +++++++++++++++++++++++++++++++++- libguile/intrinsics.h | 25 +++++++++++- libguile/jit.c | 52 +++++++++++++++++++++++++ libguile/vm-engine.c | 60 +++++++++++++++++++++++++++-- module/system/vm/assembler.scm | 50 ++++++++++++++++++++++++ 6 files changed, 290 insertions(+), 5 deletions(-) diff --git a/doc/ref/vm.texi b/doc/ref/vm.texi index d5a2c9683..8ee3dccfc 100644 --- a/doc/ref/vm.texi +++ b/doc/ref/vm.texi @@ -1144,6 +1144,22 @@ Call the @code{SCM}-returning instrinsic with index @var{idx}, passing Place the @code{scm} result in @var{dst}. @end deftypefn +@deftypefn Instruction {} call-scm-scm s12:@var{a} s12:@var{b} c32:@var{idx} +Call the @code{void}-returning instrinsic with index @var{idx}, passing +@code{scm} locals @var{a} and @var{b} as arguments. +@end deftypefn + +@deftypefn Instruction {} call-scm-scm-scm s8:@var{a} s8:@var{b} s8:@var{c} c32:@var{idx} +Call the @code{void}-returning instrinsic with index @var{idx}, passing +@code{scm} locals @var{a}, @var{b}, and @var{c} as arguments. +@end deftypefn + +@deftypefn Instruction {} call-scm-uimm-scm s8:@var{a} c8:@var{b} s8:@var{c} c32:@var{idx} +Call the @code{void}-returning instrinsic with index @var{idx}, passing +@code{scm} local @var{a}, @code{uint8_t} immediate @var{b}, and +@code{scm} local @var{c} as arguments. +@end deftypefn + There are corresponding macro-instructions for specific intrinsics. These are equivalent to @code{call-@var{instrinsic-kind}} instructions with the appropriate intrinsic @var{idx} arguments. @@ -1302,6 +1318,29 @@ Look up @var{sym} in module @var{mod}, placing the resulting variable in @deffn {Macro Instruction} current-module dst Set @var{dst} to the current module. @end deffn +@deffn {Macro Instruction} $car dst src +@deffnx {Macro Instruction} $cdr dst src +@deffnx {Macro Instruction} $set-car! x val +@deffnx {Macro Instruction} $set-cdr! x val +@deffnx {Macro Instruction} $variable-ref dst src +@deffnx {Macro Instruction} $variable-set! x val +@deffnx {Macro Instruction} $vector-length dst x +@deffnx {Macro Instruction} $vector-ref dst x idx +@deffnx {Macro Instruction} $vector-ref/immediate dst x idx/imm +@deffnx {Macro Instruction} $vector-set! x idx v +@deffnx {Macro Instruction} $vector-set!/immediate x idx/imm v +@deffnx {Macro Instruction} $allocate-struct dst vtable nwords +@deffnx {Macro Instruction} $struct-vtable dst src +@deffnx {Macro Instruction} $struct-ref dst src idx +@deffnx {Macro Instruction} $struct-ref/immediate dst src idx/imm +@deffnx {Macro Instruction} $struct-set! x idx v +@deffnx {Macro Instruction} $struct-set!/immediate x idx/imm v +Intrinsics for use by the baseline compiler. The usual strategy for CPS +compilation is to expose the component parts of e.g. @code{vector-ref} +so that the compiler can learn from them and eliminate needless bits. +However in the non-optimizing baseline compiler, that's just overhead, +so we have some intrinsics that encapsulate all the usual type checks. +@end deffn @node Constant Instructions diff --git a/libguile/intrinsics.c b/libguile/intrinsics.c index de0375950..ba25dcb0f 100644 --- a/libguile/intrinsics.c +++ b/libguile/intrinsics.c @@ -1,4 +1,4 @@ -/* Copyright 2018-2019 +/* Copyright 2018-2020 Free Software Foundation, Inc. This file is part of Guile. @@ -36,8 +36,10 @@ #include "keywords.h" #include "modules.h" #include "numbers.h" +#include "struct.h" #include "symbols.h" #include "threads.h" +#include "variable.h" #include "version.h" #include "intrinsics.h" @@ -470,6 +472,52 @@ scm_atan1 (SCM x) return scm_atan (x, SCM_UNDEFINED); } +static void +set_car_x (SCM x, SCM y) +{ + scm_set_car_x (x, y); +} +static void +set_cdr_x (SCM x, SCM y) +{ + scm_set_cdr_x (x, y); +} +static void +variable_set_x (SCM x, SCM y) +{ + scm_variable_set_x (x, y); +} +static void +vector_set_x (SCM x, SCM y, SCM z) +{ + scm_vector_set_x (x, y, z); +} +static SCM +vector_ref_immediate (SCM x, uint8_t idx) +{ + return scm_c_vector_ref (x, idx); +} +static void +vector_set_x_immediate (SCM x, uint8_t idx, SCM z) +{ + scm_c_vector_set_x (x, idx, z); +} +static void +struct_set_x (SCM x, SCM y, SCM z) +{ + scm_struct_set_x (x, y, z); +} +static SCM +struct_ref_immediate (SCM x, uint8_t idx) +{ + return scm_struct_ref (x, scm_from_uint8 (idx)); +} +static void +struct_set_x_immediate (SCM x, uint8_t idx, SCM z) +{ + scm_struct_set_x (x, scm_from_uint8 (idx), z); +} + void scm_bootstrap_intrinsics (void) { @@ -566,6 +614,25 @@ scm_bootstrap_intrinsics (void) allocate_pointerless_words_with_freelist; scm_vm_intrinsics.inexact = scm_exact_to_inexact; + /* Intrinsics for the baseline compiler. */ + scm_vm_intrinsics.car = scm_car; + scm_vm_intrinsics.cdr = scm_cdr; + scm_vm_intrinsics.set_car_x = set_car_x; + scm_vm_intrinsics.set_cdr_x = set_cdr_x; + scm_vm_intrinsics.variable_ref = scm_variable_ref; + scm_vm_intrinsics.variable_set_x = variable_set_x; + scm_vm_intrinsics.vector_length = scm_vector_length; + scm_vm_intrinsics.vector_ref = scm_vector_ref; + scm_vm_intrinsics.vector_set_x = vector_set_x; + scm_vm_intrinsics.vector_ref_immediate = vector_ref_immediate; + scm_vm_intrinsics.vector_set_x_immediate = vector_set_x_immediate; + scm_vm_intrinsics.allocate_struct = scm_allocate_struct; + scm_vm_intrinsics.struct_vtable = scm_struct_vtable; + scm_vm_intrinsics.struct_ref = scm_struct_ref; + scm_vm_intrinsics.struct_set_x = struct_set_x; + scm_vm_intrinsics.struct_ref_immediate = struct_ref_immediate; + scm_vm_intrinsics.struct_set_x_immediate = struct_set_x_immediate; + scm_c_register_extension ("libguile-" SCM_EFFECTIVE_VERSION, "scm_init_intrinsics", (scm_t_extension_init_func)scm_init_intrinsics, diff --git a/libguile/intrinsics.h b/libguile/intrinsics.h index f2682fb6c..5af526550 100644 --- a/libguile/intrinsics.h +++ b/libguile/intrinsics.h @@ -1,4 +1,4 @@ -/* Copyright 2018-2019 +/* Copyright 2018-2020 Free Software Foundation, Inc. This file is part of Guile. @@ -97,6 +97,9 @@ typedef SCM (*scm_t_scm_from_ptr_scm_scm_intrinsic) (SCM*, SCM, SCM); typedef double (*scm_t_f64_from_f64_intrinsic) (double); typedef double (*scm_t_f64_from_f64_f64_intrinsic) (double, double); typedef uint32_t* scm_t_vcode_intrinsic; +typedef void (*scm_t_scm_scm_intrinsic) (SCM, SCM); +typedef void (*scm_t_scm_scm_scm_intrinsic) (SCM, SCM, SCM); +typedef void (*scm_t_scm_uimm_scm_intrinsic) (SCM, uint8_t, SCM); #define SCM_FOR_ALL_VM_INTRINSICS(M) \ M(scm_from_scm_scm, add, "add", ADD) \ @@ -192,8 +195,28 @@ typedef uint32_t* scm_t_vcode_intrinsic; M(scm_from_thread_sz, allocate_pointerless_words_with_freelist, "allocate-pointerless-words/freelist", ALLOCATE_POINTERLESS_WORDS_WITH_FREELIST) \ M(scm_from_scm, inexact, "inexact", INEXACT) \ M(f64_from_s64, s64_to_f64, "s64->f64", S64_TO_F64) \ + M(scm_from_scm, car, "$car", CAR) \ + M(scm_from_scm, cdr, "$cdr", CDR) \ + M(scm_scm, set_car_x, "$set-car!", SET_CAR_X) \ + M(scm_scm, set_cdr_x, "$set-cdr!", SET_CDR_X) \ + M(scm_from_scm, variable_ref, "$variable-ref", VARIABLE_REF) \ + M(scm_scm, variable_set_x, "$variable-set!", VARIABLE_SET_X) \ + M(scm_from_scm, vector_length, "$vector-length", VECTOR_LENGTH) \ + M(scm_from_scm_scm, vector_ref, "$vector-ref", VECTOR_REF) \ + M(scm_scm_scm, vector_set_x, "$vector-set!", VECTOR_SET_X) \ + M(scm_from_scm_uimm, vector_ref_immediate, "$vector-ref/immediate", VECTOR_REF_IMMEDIATE) \ + M(scm_uimm_scm, vector_set_x_immediate, "$vector-set!/immediate", VECTOR_SET_X_IMMEDIATE) \ + M(scm_from_scm_scm, allocate_struct, "$allocate-struct", ALLOCATE_STRUCT) \ + M(scm_from_scm, struct_vtable, "$struct-vtable", STRUCT_VTABLE) \ + M(scm_from_scm_scm, struct_ref, "$struct-ref", STRUCT_REF) \ + M(scm_scm_scm, struct_set_x, "$struct-set!", STRUCT_SET_X) \ + M(scm_from_scm_uimm, struct_ref_immediate, "$struct-ref/immediate", STRUCT_REF_IMMEDIATE) \ + M(scm_uimm_scm, struct_set_x_immediate, "$struct-set!/immediate", STRUCT_SET_X_IMMEDIATE) \ /* Add new intrinsics here; also update scm_bootstrap_intrinsics. */ +/* Intrinsics prefixed with $ are meant to reduce bytecode size, + notably for the baseline compiler. */ + enum scm_vm_intrinsic { #define DEFINE_ENUM(type, id, name, ID) SCM_VM_INTRINSIC_##ID, diff --git a/libguile/jit.c b/libguile/jit.c index 7e5852c3e..ede16ea5e 100644 --- a/libguile/jit.c +++ b/libguile/jit.c @@ -3146,6 +3146,56 @@ compile_call_scm_from_thread_slow (scm_jit_state *j, uint32_t dst, uint32_t idx) { } +static void +compile_call_scm_scm (scm_jit_state *j, uint16_t a, uint16_t b, uint32_t idx) +{ + void *intrinsic = ((void **) &scm_vm_intrinsics)[idx]; + + emit_store_current_ip (j, T0); + emit_call_2 (j, intrinsic, sp_scm_operand (j, a), sp_scm_operand (j, b)); + emit_reload_sp (j); +} +static void +compile_call_scm_scm_slow (scm_jit_state *j, uint16_t a, uint16_t b, + uint32_t idx) +{ +} + +static void +compile_call_scm_scm_scm (scm_jit_state *j, uint8_t a, uint8_t b, uint8_t c, + uint32_t idx) +{ + void *intrinsic = ((void **) &scm_vm_intrinsics)[idx]; + + emit_store_current_ip (j, T0); + emit_call_3 (j, intrinsic, sp_scm_operand (j, a), sp_scm_operand (j, b), + sp_scm_operand (j, c)); + emit_reload_sp (j); +} +static void +compile_call_scm_scm_scm_slow (scm_jit_state *j, uint8_t a, uint8_t b, + uint8_t c, uint32_t idx) +{ +} + +static void +compile_call_scm_uimm_scm (scm_jit_state *j, uint8_t a, uint8_t b, uint8_t c, + uint32_t idx) +{ + void *intrinsic = ((void **) &scm_vm_intrinsics)[idx]; + + emit_store_current_ip (j, T0); + emit_call_3 (j, intrinsic, sp_scm_operand (j, a), + jit_operand_imm (JIT_OPERAND_ABI_UINT8, b), + sp_scm_operand (j, c)); + emit_reload_sp (j); +} +static void +compile_call_scm_uimm_scm_slow (scm_jit_state *j, uint8_t a, uint8_t b, + uint8_t c, uint32_t idx) +{ +} + static void compile_fadd (scm_jit_state *j, uint8_t dst, uint8_t a, uint8_t b) { @@ -5262,6 +5312,8 @@ compile_s64_to_f64_slow (scm_jit_state *j, uint16_t dst, uint16_t src) } #define COMPILE_X8_S8_S8_S8__C32(j, comp) \ COMPILE_X8_S8_S8_C8__C32(j, comp) +#define COMPILE_X8_S8_C8_S8__C32(j, comp) \ + COMPILE_X8_S8_S8_C8__C32(j, comp) #define COMPILE_X32__LO32__L32(j, comp) \ { \ diff --git a/libguile/vm-engine.c b/libguile/vm-engine.c index a57a8ccc6..19d35f113 100644 --- a/libguile/vm-engine.c +++ b/libguile/vm-engine.c @@ -3319,9 +3319,63 @@ VM_NAME (scm_thread *thread) NEXT (1); } - VM_DEFINE_OP (160, unused_160, NULL, NOP) - VM_DEFINE_OP (161, unused_161, NULL, NOP) - VM_DEFINE_OP (162, unused_162, NULL, NOP) + /* call-scm-scm a:12 b:12 IDX:32 + * + * Call the void-returning instrinsic with index IDX, passing SCM + * locals A and B as arguments. + */ + VM_DEFINE_OP (160, call_scm_scm, "call-scm-scm", OP2 (X8_S12_S12, C32)) + { + uint16_t a, b; + scm_t_scm_scm_intrinsic intrinsic; + + UNPACK_12_12 (op, a, b); + intrinsic = intrinsics[ip[1]]; + + SYNC_IP (); + intrinsic (SP_REF (a), SP_REF (b)); + + NEXT (2); + } + + /* call-scm-scm-scm a:8 b:8 c:8 IDX:32 + * + * Call the void-returning instrinsic with index IDX, passing SCM + * locals A, B, and C as arguments. + */ + VM_DEFINE_OP (161, call_scm_scm_scm, "call-scm-scm-scm", OP2 (X8_S8_S8_S8, C32)) + { + uint8_t a, b, c; + scm_t_scm_scm_scm_intrinsic intrinsic; + + UNPACK_8_8_8 (op, a, b, c); + intrinsic = intrinsics[ip[1]]; + + SYNC_IP (); + intrinsic (SP_REF (a), SP_REF (b), SP_REF (c)); + + NEXT (2); + } + + /* call-scm-uimm-scm a:8 b:8 c:8 IDX:32 + * + * Call the void-returning instrinsic with index IDX, passing SCM + * local A, uint8 B, and SCM local C as arguments. + */ + VM_DEFINE_OP (162, call_scm_uimm_scm, "call-scm-uimm-scm", OP2 (X8_S8_C8_S8, C32)) + { + uint8_t a, b, c; + scm_t_scm_uimm_scm_intrinsic intrinsic; + + UNPACK_8_8_8 (op, a, b, c); + intrinsic = intrinsics[ip[1]]; + + SYNC_IP (); + intrinsic (SP_REF (a), b, SP_REF (c)); + + NEXT (2); + } + VM_DEFINE_OP (163, unused_163, NULL, NOP) VM_DEFINE_OP (164, unused_164, NULL, NOP) VM_DEFINE_OP (165, unused_165, NULL, NOP) diff --git a/module/system/vm/assembler.scm b/module/system/vm/assembler.scm index 022a40256..64b65f79e 100644 --- a/module/system/vm/assembler.scm +++ b/module/system/vm/assembler.scm @@ -101,6 +101,10 @@ emit-undefined? emit-eof-object? + emit-null? + emit-false? + emit-nil? + emit-untag-fixnum emit-tag-fixnum emit-untag-char @@ -256,6 +260,25 @@ emit-define! emit-current-module + ;; Intrinsics for use by the baseline compiler. + emit-$car + emit-$cdr + emit-$set-car! + emit-$set-cdr! + emit-$variable-ref + emit-$variable-set! + emit-$vector-length + emit-$vector-ref + emit-$vector-set! + emit-$vector-ref/immediate + emit-$vector-set!/immediate + emit-$allocate-struct + emit-$struct-vtable + emit-$struct-ref + emit-$struct-set! + emit-$struct-ref/immediate + emit-$struct-set!/immediate + emit-cache-ref emit-cache-set! @@ -1399,6 +1422,15 @@ returned instead." (define-syntax-rule (define-scm<-thread-intrinsic name) (define-macro-assembler (name asm dst) (emit-call-scm<-thread asm dst (intrinsic-name->index 'name)))) +(define-syntax-rule (define-scm-scm-intrinsic name) + (define-macro-assembler (name asm a b) + (emit-call-scm-scm asm a b (intrinsic-name->index 'name)))) +(define-syntax-rule (define-scm-uimm-scm-intrinsic name) + (define-macro-assembler (name asm a b c) + (emit-call-scm-uimm-scm asm a b c (intrinsic-name->index 'name)))) +(define-syntax-rule (define-scm-scm-scm-intrinsic name) + (define-macro-assembler (name asm a b c) + (emit-call-scm-scm-scm asm a b c (intrinsic-name->index 'name)))) (define-scm<-scm-scm-intrinsic add) (define-scm<-scm-uimm-intrinsic add/immediate) @@ -1464,6 +1496,24 @@ returned instead." (define-scm<-scm-scm-intrinsic define!) (define-scm<-thread-intrinsic current-module) +(define-scm<-scm-intrinsic $car) +(define-scm<-scm-intrinsic $cdr) +(define-scm-scm-intrinsic $set-car!) +(define-scm-scm-intrinsic $set-cdr!) +(define-scm<-scm-intrinsic $variable-ref) +(define-scm-scm-intrinsic $variable-set!) +(define-scm<-scm-intrinsic $vector-length) +(define-scm<-scm-scm-intrinsic $vector-ref) +(define-scm-scm-scm-intrinsic $vector-set!) +(define-scm<-scm-uimm-intrinsic $vector-ref/immediate) +(define-scm-uimm-scm-intrinsic $vector-set!/immediate) +(define-scm<-scm-scm-intrinsic $allocate-struct) +(define-scm<-scm-intrinsic $struct-vtable) +(define-scm<-scm-scm-intrinsic $struct-ref) +(define-scm-scm-scm-intrinsic $struct-set!) +(define-scm<-scm-uimm-intrinsic $struct-ref/immediate) +(define-scm-uimm-scm-intrinsic $struct-set!/immediate) + (define-macro-assembler (begin-program asm label properties) (emit-label asm label) (let ((meta (make-meta label properties (asm-start asm))))