diff options
Diffstat (limited to 'libguile')
-rw-r--r-- | libguile/intrinsics.c | 24 | ||||
-rw-r--r-- | libguile/intrinsics.h | 19 | ||||
-rw-r--r-- | libguile/jit.c | 27 | ||||
-rw-r--r-- | libguile/vm-engine.c | 20 |
4 files changed, 88 insertions, 2 deletions
diff --git a/libguile/intrinsics.c b/libguile/intrinsics.c index a00ab39f6..3a91d0753 100644 --- a/libguile/intrinsics.c +++ b/libguile/intrinsics.c @@ -449,6 +449,12 @@ push_prompt (scm_thread *thread, uint8_t escape_only_p, vra, mra, thread->vm.registers); } +static SCM +scm_atan1 (SCM x) +{ + return scm_atan (x, SCM_UNDEFINED); +} + void scm_bootstrap_intrinsics (void) { @@ -522,6 +528,24 @@ scm_bootstrap_intrinsics (void) scm_vm_intrinsics.sqrt = scm_sqrt; scm_vm_intrinsics.fabs = fabs; scm_vm_intrinsics.fsqrt = sqrt; + scm_vm_intrinsics.floor = scm_floor; + scm_vm_intrinsics.ceiling = scm_ceiling; + scm_vm_intrinsics.sin = scm_sin; + scm_vm_intrinsics.cos = scm_cos; + scm_vm_intrinsics.tan = scm_tan; + scm_vm_intrinsics.asin = scm_asin; + scm_vm_intrinsics.acos = scm_acos; + scm_vm_intrinsics.atan = scm_atan1; + scm_vm_intrinsics.atan2 = scm_atan; + scm_vm_intrinsics.ffloor = floor; + scm_vm_intrinsics.fceiling = ceil; + scm_vm_intrinsics.fsin = sin; + scm_vm_intrinsics.fcos = cos; + scm_vm_intrinsics.ftan = tan; + scm_vm_intrinsics.fasin = asin; + scm_vm_intrinsics.facos = acos; + scm_vm_intrinsics.fatan = atan; + scm_vm_intrinsics.fatan = atan2; scm_c_register_extension ("libguile-" SCM_EFFECTIVE_VERSION, "scm_init_intrinsics", diff --git a/libguile/intrinsics.h b/libguile/intrinsics.h index 15add953f..eed871234 100644 --- a/libguile/intrinsics.h +++ b/libguile/intrinsics.h @@ -93,6 +93,7 @@ typedef void (*scm_t_ptr_scm_intrinsic) (SCM*, SCM); typedef SCM (*scm_t_scm_from_ptr_scm_intrinsic) (SCM*, SCM); 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; #define SCM_FOR_ALL_VM_INTRINSICS(M) \ @@ -167,6 +168,24 @@ typedef uint32_t* scm_t_vcode_intrinsic; M(scm_from_scm, sqrt, "sqrt", SQRT) \ M(f64_from_f64, fabs, "fabs", FABS) \ M(f64_from_f64, fsqrt, "fsqrt", FSQRT) \ + M(scm_from_scm, floor, "floor", FLOOR) \ + M(scm_from_scm, ceiling, "ceiling", CEILING) \ + M(scm_from_scm, sin, "sin", SIN) \ + M(scm_from_scm, cos, "cos", COS) \ + M(scm_from_scm, tan, "tan", TAN) \ + M(scm_from_scm, asin, "asin", ASIN) \ + M(scm_from_scm, acos, "acos", ACOS) \ + M(scm_from_scm, atan, "atan", ATAN) \ + M(scm_from_scm_scm, atan2, "atan2", ATAN2) \ + M(f64_from_f64, ffloor, "ffloor", FFLOOR) \ + M(f64_from_f64, fceiling, "fceiling", FCEILING) \ + M(f64_from_f64, fsin, "fsin", FSIN) \ + M(f64_from_f64, fcos, "fcos", FCOS) \ + M(f64_from_f64, ftan, "ftan", FTAN) \ + M(f64_from_f64, fasin, "fasin", FASIN) \ + M(f64_from_f64, facos, "facos", FACOS) \ + M(f64_from_f64, fatan, "fatan", FATAN) \ + M(f64_from_f64_f64, fatan2, "fatan2", FATAN2) \ /* Add new intrinsics here; also update scm_bootstrap_intrinsics. */ enum scm_vm_intrinsic diff --git a/libguile/jit.c b/libguile/jit.c index a8b2270a2..136b8bcaf 100644 --- a/libguile/jit.c +++ b/libguile/jit.c @@ -1098,6 +1098,14 @@ emit_sp_ref_ptr (scm_jit_state *j, jit_gpr_t dst, uint32_t src) } #endif /* SCM_SIZEOF_UINTPTR_T >= 8 */ +static jit_operand_t +sp_f64_operand (scm_jit_state *j, uint32_t slot) +{ + ASSERT_HAS_REGISTER_STATE (SP_IN_REGISTER); + + return jit_operand_mem (JIT_OPERAND_ABI_DOUBLE, SP, 8 * slot); +} + static void emit_sp_ref_f64 (scm_jit_state *j, jit_fpr_t dst, uint32_t src) { @@ -2384,11 +2392,28 @@ compile_call_f64_from_f64 (scm_jit_state *j, uint16_t dst, uint16_t src, uint32_ break; } default: - DIE("unhandled f64<-f64"); + { + void *intrinsic = ((void **) &scm_vm_intrinsics)[idx]; + emit_call_1 (j, intrinsic, sp_f64_operand (j, src)); + emit_retval_d (j, JIT_F0); + emit_reload_sp (j); + emit_sp_set_f64 (j, dst, JIT_F0); + break; + } } } static void +compile_call_f64_from_f64_f64 (scm_jit_state *j, uint8_t dst, uint8_t a, uint8_t b, uint32_t idx) +{ + void *intrinsic = ((void **) &scm_vm_intrinsics)[idx]; + emit_call_2 (j, intrinsic, sp_f64_operand (j, a), sp_f64_operand (j, b)); + emit_retval_d (j, JIT_F0); + emit_reload_sp (j); + emit_sp_set_f64 (j, dst, JIT_F0); +} + +static void compile_call_u64_from_scm (scm_jit_state *j, uint16_t dst, uint16_t a, uint32_t idx) { void *intrinsic = ((void **) &scm_vm_intrinsics)[idx]; diff --git a/libguile/vm-engine.c b/libguile/vm-engine.c index ab34d42b9..0c2c8e7bf 100644 --- a/libguile/vm-engine.c +++ b/libguile/vm-engine.c @@ -3261,7 +3261,25 @@ VM_NAME (scm_thread *thread) NEXT (2); } - VM_DEFINE_OP (156, unused_156, NULL, NOP) + /* call-f64<-f64-f64 dst:8 a:8 b:8 IDX:32 + * + * Call the double-returning instrinsic with index IDX, passing SCM + * locals A and B as arguments. Place the double result in DST. + */ + VM_DEFINE_OP (156, call_f64_from_f64_f64, "call-f64<-f64-f64", DOP2 (X8_S8_S8_S8, C32)) + { + uint8_t dst, a, b; + scm_t_f64_from_f64_f64_intrinsic intrinsic; + + UNPACK_8_8_8 (op, dst, a, b); + intrinsic = intrinsics[ip[1]]; + + /* We assume these instructions can't throw an exception. */ + SP_SET_F64 (dst, intrinsic (SP_REF_F64 (a), SP_REF_F64 (b))); + + NEXT (2); + } + VM_DEFINE_OP (157, unused_157, NULL, NOP) VM_DEFINE_OP (158, unused_158, NULL, NOP) VM_DEFINE_OP (159, unused_159, NULL, NOP) |