Unbox floor/ceiling and trigonometric functions where possible

* libguile/intrinsics.c (scm_atan1): New intrinsic, wrapping scm_atan.
  (scm_bootstrap_intrinsics): Add new intrinsics.
* libguile/intrinsics.h (scm_t_f64_from_f64_f64_intrinsic): New
  intrinsic type.
  (SCM_FOR_ALL_VM_INTRINSICS): Add intrinsics for floor, ceiling, sin,
  cos, tan, asin, acos, atan, and their unboxed counterparts.
* libguile/jit.c (sp_f64_operand): New helper.
  (compile_call_f64_from_f64, compile_call_f64_from_f64_f64): Call out
  to intrinsics.
* libguile/vm-engine.c (call-f64<-f64-f64): New opcode.
* module/language/cps/effects-analysis.scm: Add new intrinsics.
* module/language/cps/reify-primitives.scm (compute-known-primitives):
  Add new intrinsics.
* module/language/cps/slot-allocation.scm (compute-var-representations):
  Add 'f64 slot types for the new unboxed intrinsics.
* module/language/cps/specialize-numbers.scm (specialize-operations):
  Support unboxing the new intrinsics.
* module/language/cps/types.scm: Define type inferrers for the new
  intrinsics.
* module/language/tree-il/cps-primitives.scm: Define CPS translations
  for the new intrinsics.
* module/language/tree-il/primitives.scm (*interesting-primitive-names*):
  (*effect-free-primitives*, atan): Define primitive resolvers.
* module/system/vm/assembler.scm: Export assemblers for the new
  intrinsics.
  (define-f64<-f64-f64-intrinsic): New helper.

1 files changed, 26 insertions, 1 deletions

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];