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, 39 insertions, 0 deletions

diff --git a/module/system/vm/assembler.scm b/module/system/vm/assembler.scm
index ab234525e..cb4311093 100644
--- a/module/system/vm/assembler.scm
+++ b/module/system/vm/assembler.scm
@@ -199,8 +199,26 @@
             emit-mod
             emit-abs
             emit-sqrt
+            emit-floor
+            emit-ceiling
+            emit-sin
+            emit-cos
+            emit-tan
+            emit-asin
+            emit-acos
+            emit-atan
+            emit-atan2
             emit-fabs
             emit-fsqrt
+            emit-ffloor
+            emit-fceiling
+            emit-fsin
+            emit-fcos
+            emit-ftan
+            emit-fasin
+            emit-facos
+            emit-fatan
+            emit-fatan2
             emit-logand
             emit-logior
             emit-logxor
@@ -1339,6 +1357,9 @@ returned instead."
 (define-syntax-rule (define-f64<-f64-intrinsic name)
   (define-macro-assembler (name asm dst src)
     (emit-call-f64<-f64 asm dst src (intrinsic-name->index 'name))))
+(define-syntax-rule (define-f64<-f64-f64-intrinsic name)
+  (define-macro-assembler (name asm dst a b)
+    (emit-call-f64<-f64-f64 asm dst a b (intrinsic-name->index 'name))))
 (define-syntax-rule (define-u64<-scm-intrinsic name)
   (define-macro-assembler (name asm dst src)
     (emit-call-u64<-scm asm dst src (intrinsic-name->index 'name))))
@@ -1384,8 +1405,26 @@ returned instead."
 (define-scm<-scm-scm-intrinsic mod)
 (define-scm<-scm-intrinsic abs)
 (define-scm<-scm-intrinsic sqrt)
+(define-scm<-scm-intrinsic floor)
+(define-scm<-scm-intrinsic ceiling)
+(define-scm<-scm-intrinsic sin)
+(define-scm<-scm-intrinsic cos)
+(define-scm<-scm-intrinsic tan)
+(define-scm<-scm-intrinsic asin)
+(define-scm<-scm-intrinsic acos)
+(define-scm<-scm-intrinsic atan)
+(define-scm<-scm-scm-intrinsic atan2)
 (define-f64<-f64-intrinsic fabs)
 (define-f64<-f64-intrinsic fsqrt)
+(define-f64<-f64-intrinsic ffloor)
+(define-f64<-f64-intrinsic fceiling)
+(define-f64<-f64-intrinsic fsin)
+(define-f64<-f64-intrinsic fcos)
+(define-f64<-f64-intrinsic ftan)
+(define-f64<-f64-intrinsic fasin)
+(define-f64<-f64-intrinsic facos)
+(define-f64<-f64-intrinsic fatan)
+(define-f64<-f64-f64-intrinsic fatan2)
 (define-scm<-scm-scm-intrinsic logand)
 (define-scm<-scm-scm-intrinsic logior)
 (define-scm<-scm-scm-intrinsic logxor)