Less constraint propagation when COMPILATION-SPEED > SPEED
[sbcl.git] / src / code / irrat.lisp
index 55dbb83..1b28a3a 100644 (file)
 (eval-when (:compile-toplevel :execute)
 
 (sb!xc:defmacro def-math-rtn (name num-args)
-  (let ((function (symbolicate "%" (string-upcase name))))
+  (let ((function (symbolicate "%" (string-upcase name)))
+        (args (let ((sb!impl::*gentemp-counter* 0))
+                (loop repeat num-args collect (gentemp "ARG")))))
     `(progn
        (declaim (inline ,function))
-       (sb!alien:define-alien-routine (,name ,function) double-float
-         ,@(let ((results nil))
-             (dotimes (i num-args (nreverse results))
-               (push (list (intern (format nil "ARG-~D" i))
-                           'double-float)
-                     results)))))))
+       (defun ,function ,args
+         (alien-funcall
+          (extern-alien ,name
+                        (function double-float
+                                  ,@(loop repeat num-args
+                                          collect 'double-float)))
+          ,@args)))))
 
 (defun handle-reals (function var)
   `((((foreach fixnum single-float bignum ratio))
   #!+sb-doc
   "Return BASE raised to the POWER."
   (if (zerop power)
-      (let ((result (1+ (* base power))))
-        (if (and (floatp result) (float-nan-p result))
-            (float 1 result)
-            result))
+    (if (and (zerop base) (floatp power))
+        (error 'arguments-out-of-domain-error
+               :operands (list base power)
+               :operation 'expt
+               :references (list '(:ansi-cl :function expt)))
+        (let ((result (1+ (* base power))))
+          (if (and (floatp result) (float-nan-p result))
+              (float 1 result)
+              result)))
     (labels (;; determine if the double float is an integer.
              ;;  0 - not an integer
              ;;  1 - an odd int