[lisplab-cvs] r142 - trunk/shared/slatec

[Jørn Inge Vestgården]

Author: jivestgarden
Date: Sun Mar 21 06:05:33 2010
New Revision: 142

Log:
fixed type things for sbcl

Modified:
   trunk/shared/slatec/f2cl-lib.lisp

Modified: trunk/shared/slatec/f2cl-lib.lisp
==============================================================================
--- trunk/shared/slatec/f2cl-lib.lisp	(original)
+++ trunk/shared/slatec/f2cl-lib.lisp	Sun Mar 21 06:05:33 2010
@@ -446,7 +446,7 @@
 
 (declaim (inline int ifix idfix))
 
-#-(or cmu scl)
+#-(or cmu scl sbcl)
 (defun int (x)
   ;; We use fixnum here because f2cl thinks Fortran integers are
   ;; fixnums.  If this should change, we need to change the ranges
@@ -463,7 +463,7 @@
 				  #.(float most-positive-fixnum 1d0))
 		 x)))))
 
-#+(or cmu scl)
+#+(or cmu scl sbcl)
 (defun int (x)
   ;; For CMUCL, we support the full 32-bit integer range, so INT can
   ;; return a full 32-bit integer.  Tell CMUCL that this is true so we
@@ -530,7 +530,7 @@
 ;; cost of MPNORM (from MPFUN) from 48.89 sec to 24.88 sec (a factor
 ;; of 2!) when computing pi to 29593 digits or os.
 
-#+(and cmu (not x86))
+#+(and (or cmu sbcl)(not x86))
 (defun aint (x)
   (etypecase x
     (single-float
@@ -544,7 +544,7 @@
 	 (+ (- (- x 0.5d0) const) const)
 	 (- (+ (+ x 0.5d0) const) const))))))
 
-#+(and cmu x86)
+#+(and (or cmu sbcl) x86)
 (let ((junks (make-array 1 :element-type 'single-float))
       (junkd (make-array 1 :element-type 'double-float)))
   (defun aint (x)
@@ -569,7 +569,7 @@
 	       (setf (aref junkd 0) (+ x 0.5d0))
 	       (- (+ (aref junkd 0) const) const))))))))
 
-#-cmu
+#-(or cmu sbcl)
 (defun aint (x)
   ;; ftruncate is exactly what we want.
   (etypecase x
@@ -660,7 +660,7 @@
       (the integer4 (- (the integer4 (abs x))))))
 
 ;; Fortran 77 says SIGN is a generic!
-(defun sign (x y)
+#-sbcl (defun sign (x y)
   (declare (type (or integer4 single-float double-float) x y))
   (etypecase x
     (integer4
@@ -670,6 +670,13 @@
     (double-float
      (float-sign y x))))
 
+#+sbcl (defun sign (x y)
+	 (etypecase x
+	   (integer4
+	    (isign x y))
+	   (t 
+	    (float-sign y x))))
+
 (defun dsign (x y)
   (declare (type double-float x y))
   (float-sign y x))
@@ -745,7 +752,7 @@
   (nint (apply #'min x y z)))
 
 ;; Define some compile macros for these max/min functions.
-#+(or cmu scl)
+#+(or cmu scl sbcl)
 (progn
 (define-compiler-macro max0 (&rest args)
   `(max , at args))
@@ -818,7 +825,7 @@
   (conjugate c))
 
 (declaim (inline fsqrt flog))
-(defun fsqrt (x)
+#-sbcl (defun fsqrt (x)
   (typecase x
     (single-float
      (sqrt (the (single-float 0f0) x)))
@@ -827,7 +834,10 @@
     (t
      (sqrt x))))
 
-(defun flog (x)
+#+sbcl (defun fsqrt (x)
+	 (sqrt x))
+
+#-sbcl (defun flog (x)
   (typecase x
     (single-float
      (log (the (or (single-float (0f0)) (member 0f0)) x)))
@@ -836,6 +846,9 @@
     (t
      (log x))))
   
+#+sbcl (defun flog (x)
+	 (log x))
+
 ;; Tell Lisp that the arguments always have the correct range.  If
 ;; this is not true, the original Fortran code was broken anyway, so
 ;; GIGO (garbage in, garbage out).