From jivestgarden at common-lisp.net Wed Mar 10 19:52:37 2010 From: jivestgarden at common-lisp.net (=?UTF-8?Q?J=C3=B8rn_Inge_Vestg=C3=A5rden?=) Date: Wed, 10 Mar 2010 14:52:37 -0500 Subject: [lisplab-cvs] r134 - trunk/src/matlisp Message-ID: Author: jivestgarden Date: Wed Mar 10 14:52:37 2010 New Revision: 134 Log: lapack lu not yet ok Added: trunk/src/matlisp/lu.lisp Modified: trunk/src/matlisp/inv.lisp Modified: trunk/src/matlisp/inv.lisp ============================================================================== --- trunk/src/matlisp/inv.lisp (original) +++ trunk/src/matlisp/inv.lisp Wed Mar 10 14:52:37 2010 @@ -1,4 +1,4 @@ -;;; Lisplab, matliap/div.lisp +;;; Lisplab, matlisp/div.lisp ;;; Lapack-based matrix inversion ;;; Copyright (C) 2009 Joern Inge Vestgaarden @@ -23,7 +23,7 @@ (if cl-user::*lisplab-liblapack-path* (let* ((N (rows a)) (ipiv (make-array N :element-type '(unsigned-byte 32))) - (msg "argument A given to minv is singular to working machine precision")) + (msg "Argument A given to minv is singular to working machine precision")) (multiple-value-bind (_ ipiv info) (f77::dgetrf N N (matrix-store a) N ipiv 0) (declare (ignore _)) @@ -46,7 +46,7 @@ (if cl-user::*lisplab-liblapack-path* (let* ((N (rows a)) (ipiv (make-array N :element-type '(unsigned-byte 32))) - (msg "argument A given to mdiv is singular to working machine precision")) + (msg "Argument A given to mdiv is singular to working machine precision")) (multiple-value-bind (_ ipiv info) (f77::zgetrf N N (matrix-store a) N ipiv 0) (declare (ignore _)) Added: trunk/src/matlisp/lu.lisp ============================================================================== --- (empty file) +++ trunk/src/matlisp/lu.lisp Wed Mar 10 14:52:37 2010 @@ -0,0 +1,51 @@ +;;; Lisplab, matlisp/lu.lisp +;;; LU-factorization + +;;; Copyright (C) 2009 Joern Inge Vestgaarden +;;; +;;; This program is free software; you can redistribute it and/or modify +;;; it under the terms of the GNU General Public License as published by +;;; the Free Software Foundation; either version 2 of the License, or +;;; (at your option) any later version. +;;; +;;; This program is distributed in the hope that it will be useful, +;;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;;; GNU General Public License for more details. +;;; +;;; You should have received a copy of the GNU General Public License along +;;; with this program; if not, write to the Free Software Foundation, Inc., +;;; 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA. + +;;; TODO: maybe speed up. + +(in-package :lisplab) + +(defmethod LU-factor! ((A matrix-blas-dge) p) + (if cl-user::*lisplab-liblapack-path* + (let* ((N (rows a)) + (ipiv (make-array N :element-type '(unsigned-byte 32))) + (msg "Argument A given to minv is singular to working machine precision")) + (format t "Hei~%") + (multiple-value-bind (_ ipiv info) + (f77::dgetrf N N (matrix-store a) N ipiv 0) + (declare (ignore _)) + (unless (zerop info) + (error msg)) + + ;; TOOD must change ipiv to a an actual permutation vector !!!!! + + + ;; Change from 1 based to zero based index + (dotimes (i (length ipiv)) + (setf (aref ipiv i) (1- (aref ipiv i)))) + (list A ipiv (getrf-get-ipiv-det ipiv)))) + (call-next-method))) + +(defun getrf-get-ipiv-det (ipiv) + (let ((det 1)) + ;; TODO maybe speed up + (dotimes (i (length ipiv)) + (unless (= i (aref ipiv i)) + (setf det (* det -1)))) + det)) \ No newline at end of file From jivestgarden at common-lisp.net Wed Mar 10 19:53:17 2010 From: jivestgarden at common-lisp.net (=?UTF-8?Q?J=C3=B8rn_Inge_Vestg=C3=A5rden?=) Date: Wed, 10 Mar 2010 14:53:17 -0500 Subject: [lisplab-cvs] r135 - trunk/src/linalg Message-ID: Author: jivestgarden Date: Wed Mar 10 14:53:17 2010 New Revision: 135 Log: fixed lu factor and determinant Modified: trunk/src/linalg/level3-linalg-generic.lisp trunk/src/linalg/level3-linalg-interface.lisp Modified: trunk/src/linalg/level3-linalg-generic.lisp ============================================================================== --- trunk/src/linalg/level3-linalg-generic.lisp (original) +++ trunk/src/linalg/level3-linalg-generic.lisp Wed Mar 10 14:53:17 2010 @@ -136,7 +136,7 @@ (w/mat L (x i j) (cond ((> i j) x) ((= i j) 1) (t 0))) (w/mat U (x i j) (cond ((<= i j) x) (t 0))) (dotimes (i (rows P)) - (setf (mref Pmat i (vref p i) ) 1)) + (setf (mref Pmat (vref p i) i) 1)) (list L U Pmat)))) (defun L-solve! (L x) @@ -175,7 +175,8 @@ (LU-solve! LU b2)))) (defmethod mdet ((A matrix-base)) - (destructuring-bind (LU pvec det) (LU-factor A) + (destructuring-bind (LU pvec det) + (LU-factor! (copy A) (make-permutation-vector (rows A))) (dotimes (i (rows A)) (setf det (.* det (mref LU i i)))) det)) Modified: trunk/src/linalg/level3-linalg-interface.lisp ============================================================================== --- trunk/src/linalg/level3-linalg-interface.lisp (original) +++ trunk/src/linalg/level3-linalg-interface.lisp Wed Mar 10 14:53:17 2010 @@ -62,11 +62,14 @@ (:documentation "Short for (m*! a (minv b)). Destructive.")) (defgeneric LU-factor! (matrix pivotes) - (:documentation "LU-factorization with pivoting. Destructive.")) + (:documentation "LU-factorization with pivoting. Destructive. +Ouputs a combined LU matrix where the diagonals belong to U and a +permutation vector.")) (defgeneric LU-factor (matrix) - (:documentation "LU-factorization with pivoting. Outputs (m p) where -m is the LU-matrix and p is the pivot permutations.")) + (:documentation "LU-factorization with pivoting. Outputs (L U P) where +L is low diagonal with unity at diagnoals, U is upper diagnoal and +P is an permutation matrix, so that A = P L U.")) (defgeneric lin-solve (A b) (:documentation "Solves the linear system of equations Ax=b.")) From jivestgarden at common-lisp.net Thu Mar 11 14:26:36 2010 From: jivestgarden at common-lisp.net (=?UTF-8?Q?J=C3=B8rn_Inge_Vestg=C3=A5rden?=) Date: Thu, 11 Mar 2010 09:26:36 -0500 Subject: [lisplab-cvs] r136 - trunk/src/io Message-ID: Author: jivestgarden Date: Thu Mar 11 09:26:35 2010 New Revision: 136 Log: removed anisotropy in postscript generation Modified: trunk/src/io/level3-io.lisp Modified: trunk/src/io/level3-io.lisp ============================================================================== --- trunk/src/io/level3-io.lisp (original) +++ trunk/src/io/level3-io.lisp Thu Mar 11 09:26:35 2010 @@ -147,7 +147,7 @@ ;; TOOD: change name to epswrite. (when (<= (- max min) 0.0) (setf max 1.0 min 0.0 )) - (let* ((DTXSCALE 1.0787) + (let* ((DTXSCALE 1.0) (DTYSCALE 1.0) #+nil (DTHRES 513) #+nil (DTVRES 481) From jivestgarden at common-lisp.net Sat Mar 20 14:10:07 2010 From: jivestgarden at common-lisp.net (=?UTF-8?Q?J=C3=B8rn_Inge_Vestg=C3=A5rden?=) Date: Sat, 20 Mar 2010 10:10:07 -0400 Subject: [lisplab-cvs] r137 - in trunk/src: core linalg matrix Message-ID: Author: jivestgarden Date: Sat Mar 20 10:10:06 2010 New Revision: 137 Log: cleaned up matrix predicate methods Modified: trunk/src/core/level0-functions.lisp trunk/src/core/level0-interface.lisp trunk/src/linalg/level3-linalg-interface.lisp trunk/src/matrix/level1-array.lisp trunk/src/matrix/level1-matrix.lisp trunk/src/matrix/level2-generic.lisp trunk/src/matrix/level2-interface.lisp trunk/src/matrix/level2-matrix-zge.lisp Modified: trunk/src/core/level0-functions.lisp ============================================================================== --- trunk/src/core/level0-functions.lisp (original) +++ trunk/src/core/level0-functions.lisp Sat Mar 20 10:10:06 2010 @@ -19,11 +19,9 @@ (in-package :lisplab) -(defmethod matrix? ((a number)) nil) +(defmethod matrix-p (x) nil) -(defmethod vector? ((a number)) nil) - -(defmethod scalar? ((a number)) t) +(defmethod vector-p (x) nil) (defun ^ (x n) "Synonym for expt" (expt x n)) Modified: trunk/src/core/level0-interface.lisp ============================================================================== --- trunk/src/core/level0-interface.lisp (original) +++ trunk/src/core/level0-interface.lisp Sat Mar 20 10:10:06 2010 @@ -35,16 +35,10 @@ (defgeneric cleanup-threads () (:documentation "Kills unused threads and frees resources.")) -;;; Remove scalar? -(defgeneric scalar? (x) - (:documentation "A scalar is a object with ignored internal structure.")) - -;;; Change name to vector-p -(defgeneric vector? (x) +(defgeneric vector-p (x) (:documentation "A vector is a object whose elements are accessible with vref.")) -;;; Change name to matrix-p -(defgeneric matrix? (x) +(defgeneric matrix-p (x) (:documentation "A matrix is a object whose elements are accesible with mref.")) (defgeneric copy (a) Modified: trunk/src/linalg/level3-linalg-interface.lisp ============================================================================== --- trunk/src/linalg/level3-linalg-interface.lisp (original) +++ trunk/src/linalg/level3-linalg-interface.lisp Sat Mar 20 10:10:06 2010 @@ -37,7 +37,7 @@ (defgeneric mdet (matrix) (:documentation "Matrix determinant.") (:method :before (m) - (assert (square-matrix? m)))) + (assert (= (rows m) (cols m))))) (defgeneric minv! (a) (:documentation "Matrix inverse. Destructive.")) @@ -45,7 +45,7 @@ (defgeneric minv (a) (:documentation "Matrix inverse.") (:method :before (m) - (assert (square-matrix? m)))) + (assert (= (rows m) (cols m))))) (defgeneric m* (a b) (:documentation "Matrix multiplication.") Modified: trunk/src/matrix/level1-array.lisp ============================================================================== --- trunk/src/matrix/level1-array.lisp (original) +++ trunk/src/matrix/level1-array.lisp Sat Mar 20 10:10:06 2010 @@ -19,7 +19,7 @@ (in-package :lisplab) -(defmethod matrix? ((a array)) +(defmethod matrix-p ((a array)) "True for an array of rank 2" (= (rank a) 2)) Modified: trunk/src/matrix/level1-matrix.lisp ============================================================================== --- trunk/src/matrix/level1-matrix.lisp (original) +++ trunk/src/matrix/level1-matrix.lisp Sat Mar 20 10:10:06 2010 @@ -24,11 +24,9 @@ (in-package :lisplab) -(defmethod scalar? ((x matrix-base)) nil) +(defmethod vector-p ((x matrix-base)) t) -(defmethod vector? ((x matrix-base)) t) - -(defmethod matrix? ((x matrix-base)) t) +(defmethod matrix-p ((x matrix-base)) t) (defmethod rank ((matrix matrix-base)) 2) Modified: trunk/src/matrix/level2-generic.lisp ============================================================================== --- trunk/src/matrix/level2-generic.lisp (original) +++ trunk/src/matrix/level2-generic.lisp Sat Mar 20 10:10:06 2010 @@ -20,7 +20,7 @@ ;;; Implementation principles: ;;; - all operators in this film should spezialie for matrix-base and only -;;; asume level0 and level1 generic function (mref, vref, size, dim, etc.) +;;; assume level0 and level1 generic function (mref, vref, size, dim, etc.) ;;; - The methods in this file should not assume anything about implementation of ;;; the matrices. ;;; - The methds in this file should be as short and clean as possible. @@ -36,9 +36,6 @@ ;; TODO what the dim, should I use it or ignore it val) -(defmethod square-matrix? ((x matrix-base)) - (= (rows x) (cols x))) - ;;; This is OK, but could be optimzied! (defmacro w/mat (a args &body body) (let ((a2 (gensym)) @@ -251,130 +248,19 @@ (reshape a (list rows (/ (size a) rows) 1))) +(defmethod row-swap! (A i j) + (dotimes (c (cols A)) + (psetf (mref A i c) (mref A j c) + (mref A j c) (mref A i c))) + A) + +(defmethod row-mul! (A i num) + (dotimes (c (cols A)) + (setf (mref A i c) (.* num (mref A i c)))) + A) + +(defmethod row-add! (A i j num) + (dotimes (c (cols A)) + (setf (mref A i c) (.+ (mref A i c) (.* num (mref A j c))))) + A) - - - - - -#| OLD - -;; Specialize operators for matrix-ge. It is dangerous to spezialize for matrix-base -;; since the output type depends on the kind of operator. It is possible to -;; make it better by separating between complex and real number and matrices, but -;; I'm too lazy to do it. -(defmacro def-binary-op-matrix-ge (op) - (let ((a (gensym "a")) - (b (gensym "b")) - (len (gensym "len")) - (i (gensym "i"))) - `(progn - (defmethod ,op ((,a matrix-ge) ,b) - (let* ((,a (copy ,a)) - (,len (size ,a))) - (dotimes (,i ,len) - (setf (vref ,a ,i) (,op (vref ,a ,i) ,b))) - ,a)) - (defmethod ,op (,a (,b matrix-ge)) - (let* ((,b (copy ,b)) - (,len (size ,b))) - (dotimes (,i ,len) - (setf (vref ,b ,i) (,op ,a (vref ,b ,i)))) - ,b)) - (defmethod ,op ((,a matrix-ge) (,b matrix-ge)) - (let* ((,a (copy ,a)) - (,len (size ,a))) - (dotimes (,i ,len) - (setf (vref ,a ,i) (,op (vref ,a ,i) (vref ,b ,i)))) - ,a))))) - -(def-binary-op-matrix-ge .add) - -(def-binary-op-matrix-ge .mul) - -(def-binary-op-matrix-ge .sub) - -(def-binary-op-matrix-ge .div) - -(def-binary-op-matrix-ge .expt) - -(def-binary-op-matrix-ge .min) - -(def-binary-op-matrix-ge .max) - -|# - -#| -;;; Anything and matrix - -(define-constant +generic-function-anything-matrix-list+ - '(.add .sub .mul .div .expt .max .min)) - -(defmacro defmethod-anything-matrix (name) - (let ((a (gensym "a")) - (b (gensym "b")) - (c (gensym "c")) - (i (gensym "i"))) - `(defmethod ,name (,a (,b matrix-base)) - (let ((,c (mcreate ,b))) - (dotimes (,i (size ,c)) - (setf (vref ,c ,i) (,name ,a (vref ,b ,i)))) - ,c)))) - -(defmacro expand-generic-function-anything-matrix-list () - (cons 'progn - (mapcar (lambda (name) - `(defmethod-anything-matrix ,name)) - +generic-function-anything-matrix-list+))) - -(expand-generic-function-anything-matrix-list) - -;;; Matrix and anything - -(define-constant +generic-function-matrix-anything-list+ - '(.add .sub .mul .div .expt .max .min)) - -(defmacro defmethod-matrix-anything (name) - (let ((a (gensym "a")) - (b (gensym "b")) - (c (gensym "c")) - (i (gensym "i"))) - `(defmethod ,name ((,a matrix-base) ,b) - (let ((,c (mcreate ,a))) - (dotimes (,i (size ,c)) - (setf (vref ,c ,i) (,name (vref ,a ,i) ,b))) - ,c)))) - -(defmacro expand-generic-function-matrix-anything-list () - (cons 'progn - (mapcar (lambda (name) - `(defmethod-matrix-anything ,name)) - +generic-function-matrix-anything-list+))) - -(expand-generic-function-matrix-anything-list) - -;;; Matrix and matrix - -(define-constant +generic-function-matrix-matrix-list+ - '(.add .sub .mul .div .expt .max .min)) - -(defmacro defmethod-matrix-matrix (name) - (let ((a (gensym "a")) - (b (gensym "b")) - (c (gensym "c")) - (i (gensym "i"))) - `(defmethod ,name ((,a matrix-base) (,b matrix-base)) - (let ((,c (mcreate ,a))) - (dotimes (,i (size ,c)) - (setf (vref ,c ,i) (,name (vref ,a ,i) (vref ,b ,i)))) - ,c)))) - -(defmacro expand-generic-function-matrix-matrix-list () - (cons 'progn - (mapcar (lambda (name) - `(defmethod-matrix-matrix ,name)) - +generic-function-matrix-matrix-list+))) - -(expand-generic-function-matrix-matrix-list) - -|# \ No newline at end of file Modified: trunk/src/matrix/level2-interface.lisp ============================================================================== --- trunk/src/matrix/level2-interface.lisp (original) +++ trunk/src/matrix/level2-interface.lisp Sat Mar 20 10:10:06 2010 @@ -47,9 +47,6 @@ (:documentation "Creates a new matrix of the same type and with the same value as the other, but with all elements set to value.")) -(defgeneric square-matrix? (x) - (:documentation "True when the matrix is square, obviously.")) - (defgeneric diag (v) (:documentation "Creates a diagnoal matrix from the vector.")) @@ -83,6 +80,18 @@ (defgeneric get-col (matrix col) (:documentation "Gets rows. Destructive")) +;;; Row operations + +(defgeneric row-swap! (matrix i j) + (:documentation "Swaps row i and j of matrix. Destructive.")) + +(defgeneric row-mul! (matrix i number) + (:documentation "Multiplies row i with number. Destructive.")) + +(defgeneric row-add! (matrix i j number) + (:documentation "Adds a multiplicum of row j to row i. A_ic=A_ic+number*A_jc. Destructive.")) + + ;;;; Views (defgeneric view-row (matrix row) Modified: trunk/src/matrix/level2-matrix-zge.lisp ============================================================================== --- trunk/src/matrix/level2-matrix-zge.lisp (original) +++ trunk/src/matrix/level2-matrix-zge.lisp Sat Mar 20 10:10:06 2010 @@ -161,8 +161,8 @@ (type-spec ,a) (type-spec ,b)))) ;; Assumes that input is something with a well-defined spec - (,name (if (matrix? ,a) (convert ,a ,spec) ,a) - (if (matrix? ,b) (convert ,b ,spec) ,b)))))) + (,name (if (matrix-p ,a) (convert ,a ,spec) ,a) + (if (matrix-p ,b) (convert ,b ,spec) ,b)))))) (defmacro def-all-cross-complex-real-methods (name) `(progn From jivestgarden at common-lisp.net Sat Mar 20 15:25:58 2010 From: jivestgarden at common-lisp.net (=?UTF-8?Q?J=C3=B8rn_Inge_Vestg=C3=A5rden?=) Date: Sat, 20 Mar 2010 11:25:58 -0400 Subject: [lisplab-cvs] r138 - in trunk: . src/linalg src/matlisp Message-ID: Author: jivestgarden Date: Sat Mar 20 11:25:57 2010 New Revision: 138 Log: added lu-factorization from lapack Modified: trunk/lisplab.asd trunk/package.lisp trunk/src/linalg/level3-linalg-generic.lisp trunk/src/matlisp/lu.lisp Modified: trunk/lisplab.asd ============================================================================== --- trunk/lisplab.asd (original) +++ trunk/lisplab.asd Sat Mar 20 11:25:57 2010 @@ -179,6 +179,7 @@ (:file "mul") (:file "inv") (:file "geev") + (:file "lu") (:file "tridiag"))))) (defsystem :lisplab-fftw Modified: trunk/package.lisp ============================================================================== --- trunk/package.lisp (original) +++ trunk/package.lisp Sat Mar 20 11:25:57 2010 @@ -60,9 +60,8 @@ ;; Some general methods "COPY" "CONVERT" - "SCALAR?" - "VECTOR?" - "MATRIX?" + "VECTOR-P" + "MATRIX-P" ;; Basic methods (The dotted algebra) ".+" @@ -193,6 +192,9 @@ "MMAX" "MABSMIN" "MABSMAX" + "ROW-SWAP!" + "ROW-MUL!" + "ROW-ADD!" "SUB-MATRIX" ; To level3 ? "CIRC-SHIFT" "PAD-SHIFT" Modified: trunk/src/linalg/level3-linalg-generic.lisp ============================================================================== --- trunk/src/linalg/level3-linalg-generic.lisp (original) +++ trunk/src/linalg/level3-linalg-generic.lisp Sat Mar 20 11:25:57 2010 @@ -109,13 +109,11 @@ i-pivot i)))) (unless (= i-pivot j) (dotimes (i N) - (let ((tmp (mref A j i))) - (setf (mref A j i) (mref A i-pivot i) - (mref A i-pivot i) tmp))) - (let ((tmp (vref p j))) - (setf (vref p j) (vref p i-pivot) - (vref p i-pivot) tmp) - (setf sign (- sign))))) + (psetf (mref A j i) (mref A i-pivot i) + (mref A i-pivot i) (mref A j i))) + (psetf (vref p j) (vref p i-pivot) + (vref p i-pivot) (vref p j)) + (setf sign (- sign)))) (unless (zerop (mref A j j)) (loop for i from (1+ j) below N do (let ((Aij (./ (mref A i j) (mref A j j)))) Modified: trunk/src/matlisp/lu.lisp ============================================================================== --- trunk/src/matlisp/lu.lisp (original) +++ trunk/src/matlisp/lu.lisp Sat Mar 20 11:25:57 2010 @@ -26,26 +26,20 @@ (let* ((N (rows a)) (ipiv (make-array N :element-type '(unsigned-byte 32))) (msg "Argument A given to minv is singular to working machine precision")) - (format t "Hei~%") (multiple-value-bind (_ ipiv info) (f77::dgetrf N N (matrix-store a) N ipiv 0) (declare (ignore _)) (unless (zerop info) (error msg)) - - ;; TOOD must change ipiv to a an actual permutation vector !!!!! - - - ;; Change from 1 based to zero based index - (dotimes (i (length ipiv)) - (setf (aref ipiv i) (1- (aref ipiv i)))) - (list A ipiv (getrf-get-ipiv-det ipiv)))) + ;; Now convert the interchange vector ipiv to the permutation vector p + ;; Also convert from one to zero-indexed. + (let ((det 1) + (p (make-permutation-vector (size ipiv)))) + (dotimes (i (length ipiv)) + (unless (= (1+ i) (aref ipiv i)) + (setf det (* det -1)) + (psetf (vref p i) (vref p (1- (vref ipiv i))) + (vref p (1- (vref ipiv i))) (vref p i)))) + (list A p det)))) (call-next-method))) -(defun getrf-get-ipiv-det (ipiv) - (let ((det 1)) - ;; TODO maybe speed up - (dotimes (i (length ipiv)) - (unless (= i (aref ipiv i)) - (setf det (* det -1)))) - det)) \ No newline at end of file From jivestgarden at common-lisp.net Sat Mar 20 15:30:34 2010 From: jivestgarden at common-lisp.net (=?UTF-8?Q?J=C3=B8rn_Inge_Vestg=C3=A5rden?=) Date: Sat, 20 Mar 2010 11:30:34 -0400 Subject: [lisplab-cvs] r139 - in trunk: . src/core src/matrix Message-ID: Author: jivestgarden Date: Sat Mar 20 11:30:34 2010 New Revision: 139 Log: moved permutation Added: trunk/src/matrix/permutation.lisp - copied unchanged from r136, /trunk/src/core/level0-permutation.lisp Removed: trunk/src/core/level0-permutation.lisp Modified: trunk/lisplab.asd Modified: trunk/lisplab.asd ============================================================================== --- trunk/lisplab.asd (original) +++ trunk/lisplab.asd Sat Mar 20 11:30:34 2010 @@ -50,7 +50,6 @@ (:file "level0-interface") (:file "level0-default") (:file "level0-functions") - (:file "level0-permutation") (:file "level0-thread") (:file "level0-infpre"))) @@ -69,6 +68,7 @@ (:file "level1-util") (:file "store-operators") (:file "store-ordinary-functions") + (:file "permutation") (:file "level1-classes") (:file "level1-constructors") From jivestgarden at common-lisp.net Sat Mar 20 15:33:49 2010 From: jivestgarden at common-lisp.net (=?UTF-8?Q?J=C3=B8rn_Inge_Vestg=C3=A5rden?=) Date: Sat, 20 Mar 2010 11:33:49 -0400 Subject: [lisplab-cvs] r140 - trunk/src/matrix Message-ID: Author: jivestgarden Date: Sat Mar 20 11:33:48 2010 New Revision: 140 Log: fix Modified: trunk/src/matrix/permutation.lisp Modified: trunk/src/matrix/permutation.lisp ============================================================================== --- trunk/src/matrix/permutation.lisp (original) +++ trunk/src/matrix/permutation.lisp Sat Mar 20 11:33:48 2010 @@ -1,4 +1,4 @@ -;;; Level2-permutations.lisp +;;; Permutation.lisp ;;; Permutation of matrix indices. ;;; Copyright (C) 2009 Joern Inge Vestgaarden @@ -21,7 +21,7 @@ (deftype type-permutation () ;; This should be the same as the max size of arrays - '(MOD 536870911)) + 'type-blas-idx) (deftype type-permutation-vector () '(simple-array type-permutation (*))) From jivestgarden at common-lisp.net Sat Mar 20 19:19:43 2010 From: jivestgarden at common-lisp.net (=?UTF-8?Q?J=C3=B8rn_Inge_Vestg=C3=A5rden?=) Date: Sat, 20 Mar 2010 15:19:43 -0400 Subject: [lisplab-cvs] r141 - in trunk/src: core fft io linalg matlisp matrix test Message-ID: Author: jivestgarden Date: Sat Mar 20 15:19:43 2010 New Revision: 141 Log: Changed 0.0 to 0d0 etc. Modified: trunk/src/core/level0-basic.lisp trunk/src/core/level0-const.lisp trunk/src/core/template.lisp trunk/src/fft/level3-fft-zge.lisp trunk/src/io/level3-io.lisp trunk/src/linalg/level3-linalg-dge.lisp trunk/src/matlisp/mul.lisp trunk/src/matrix/level1-ddiag.lisp trunk/src/matrix/level1-dgt.lisp trunk/src/matrix/level1-util.lisp trunk/src/matrix/level2-constructors.lisp trunk/src/matrix/level2-generic.lisp trunk/src/matrix/level2-matrix-dge.lisp trunk/src/matrix/level2-matrix-zge.lisp trunk/src/test/test-methods.lisp Modified: trunk/src/core/level0-basic.lisp ============================================================================== --- trunk/src/core/level0-basic.lisp (original) +++ trunk/src/core/level0-basic.lisp Sat Mar 20 15:19:43 2010 @@ -54,6 +54,6 @@ (defun dvec (n) "Creates a double vector with n elements." - (make-array n :element-type 'double-float :initial-element 0.0)) + (make-array n :element-type 'double-float :initial-element 0d0)) Modified: trunk/src/core/level0-const.lisp ============================================================================== --- trunk/src/core/level0-const.lisp (original) +++ trunk/src/core/level0-const.lisp Sat Mar 20 15:19:43 2010 @@ -20,9 +20,9 @@ (in-package :lisplab) ;;; Float and complex constants -(define-constant %e (exp 1.0) "The number e = exp(1).") -(define-constant %i #C(0.0 1.0) "The imaginary unit i=sqrt(-1).") -(define-constant -%i #C(0.0 -1.0) "The negative imaginary unit -i=-sqrt(-1).") +(define-constant %e (exp 1d0) "The number e = exp(1).") +(define-constant %i #C(0d0 1d0) "The imaginary unit i=sqrt(-1).") +(define-constant -%i #C(0d0 -1d0) "The negative imaginary unit -i=-sqrt(-1).") ;;; Type constants ;;; TODO: throw them out or use deftype in stead @@ -35,28 +35,28 @@ ;;; TODO: throw them out -(define-constant +lisplab-dbl-epsilon+ 2.2204460492503131e-16) -(define-constant +lisplab-sqrt-dbl-epsilon+ 1.4901161193847656e-08) -(define-constant +lisplab-root3-dbl-epsilon+ 6.0554544523933429e-06) -(define-constant +lisplab-root4-dbl-epsilon+ 1.2207031250000000e-04) -(define-constant +lisplab-root5-dbl-epsilon+ 7.4009597974140505e-04) -(define-constant +lisplab-root6-dbl-epsilon+ 2.4607833005759251e-03) -(define-constant +lisplab-log-dbl-epsilon+ -3.6043653389117154e+01) - -(define-constant +lisplab-dbl-min+ 2.2250738585072014e-308) -(define-constant +lisplab-sqrt-dbl-min+ 1.4916681462400413e-154) -(define-constant +lisplab-root3-dbl-min+ 2.8126442852362996e-103) -(define-constant +lisplab-root4-dbl-min+ 1.2213386697554620e-77) -(define-constant +lisplab-root5-dbl-min+ 2.9476022969691763e-62) -(define-constant +lisplab-root6-dbl-min+ 5.3034368905798218e-52) -(define-constant +lisplab-log-dbl-min+ -7.0839641853226408e+02) - -(define-constant +lisplab-dbl-max+ 1.7976931348623157e+308) -(define-constant +lisplab-sqrt-dbl-max+ 1.3407807929942596e+154) -(define-constant +lisplab-root3-dbl-max+ 5.6438030941222897e+102) -(define-constant +lisplab-root4-dbl-max+ 1.1579208923731620e+77) -(define-constant +lisplab-root5-dbl-max+ 4.4765466227572707e+61) -(define-constant +lisplab-root6-dbl-max+ 2.3756689782295612e+51) -(define-constant +lisplab-log-dbl-max+ 7.0978271289338397e+02) +(define-constant +lisplab-dbl-epsilon+ 2.2204460492503131d-16) +(define-constant +lisplab-sqrt-dbl-epsilon+ 1.4901161193847656d-08) +(define-constant +lisplab-root3-dbl-epsilon+ 6.0554544523933429d-06) +(define-constant +lisplab-root4-dbl-epsilon+ 1.2207031250000000d-04) +(define-constant +lisplab-root5-dbl-epsilon+ 7.4009597974140505d-04) +(define-constant +lisplab-root6-dbl-epsilon+ 2.4607833005759251d-03) +(define-constant +lisplab-log-dbl-epsilon+ -3.6043653389117154d+01) + +(define-constant +lisplab-dbl-min+ 2.2250738585072014d-308) +(define-constant +lisplab-sqrt-dbl-min+ 1.4916681462400413d-154) +(define-constant +lisplab-root3-dbl-min+ 2.8126442852362996d-103) +(define-constant +lisplab-root4-dbl-min+ 1.2213386697554620d-77) +(define-constant +lisplab-root5-dbl-min+ 2.9476022969691763d-62) +(define-constant +lisplab-root6-dbl-min+ 5.3034368905798218d-52) +(define-constant +lisplab-log-dbl-min+ -7.0839641853226408d+02) + +(define-constant +lisplab-dbl-max+ 1.7976931348623157d+308) +(define-constant +lisplab-sqrt-dbl-max+ 1.3407807929942596d+154) +(define-constant +lisplab-root3-dbl-max+ 5.6438030941222897d+102) +(define-constant +lisplab-root4-dbl-max+ 1.1579208923731620d+77) +(define-constant +lisplab-root5-dbl-max+ 4.4765466227572707d+61) +(define-constant +lisplab-root6-dbl-max+ 2.3756689782295612d+51) +(define-constant +lisplab-log-dbl-max+ 7.0978271289338397d+02) Modified: trunk/src/core/template.lisp ============================================================================== --- trunk/src/core/template.lisp (original) +++ trunk/src/core/template.lisp Sat Mar 20 15:19:43 2010 @@ -145,11 +145,11 @@ (N (cols b)) (S (cols a)) (c (create a 0 (list M N))) - (tmp 0.0)) + (tmp 0d0)) (w/dynamic (a b c tmp) (dotimes (i (rows A)) (dotimes (j (cols B)) - (setf tmp 0.0) + (setf tmp 0d0) (dotimes (k (cols A)) (incf tmp (* (mref a i k) (mref b k j)))) (setf (mref c i j) tmp))) Modified: trunk/src/fft/level3-fft-zge.lisp ============================================================================== --- trunk/src/fft/level3-fft-zge.lisp (original) +++ trunk/src/fft/level3-fft-zge.lisp Sat Mar 20 15:19:43 2010 @@ -150,7 +150,7 @@ forward or :r for reverse transform. Input must be a vector of complex double float" (let* ((ftx x) - (sign (ecase direction (:f -1.0) (:r 1.0)))) + (sign (ecase direction (:f -1d0) (:r 1d0)))) (declare (type-blas-idx n start step) (double-float sign) (type-blas-store ftx)) @@ -158,8 +158,8 @@ ;; apply fft recursion (dotimes (bit (floor (log n 2))) (let* ((dual (expt 2 bit)) - (W #C(1.0 0.0)) - (tmp (- (exp (/ (* sign %i pi) dual)) 1.0 ))) + (W #C(1d0 0d0)) + (tmp (- (exp (/ (* sign %i pi) dual)) 1d0 ))) (declare (type type-blas-idx dual) (type (integer 0 30) bit) (type (complex double-float) W tmp)) Modified: trunk/src/io/level3-io.lisp ============================================================================== --- trunk/src/io/level3-io.lisp (original) +++ trunk/src/io/level3-io.lisp Sat Mar 20 15:19:43 2010 @@ -118,8 +118,8 @@ (let* ((rows (rows m)) (cols (cols m)) (scale (- max min))) - (when (<= (- max min) 0.0) - (setf max 1.0 min 0.0 scale 1.0)) + (when (<= (- max min) 0d0) + (setf max 1d0 min 0d0 scale 1d0)) (with-open-file (out filename :direction :output :if-exists :supersede) (format out "P5~%") (format out "~A ~A~%" cols rows) @@ -145,10 +145,10 @@ ;; TODO: clean up and some more lispifying. ;; TODO: more testing. ;; TOOD: change name to epswrite. - (when (<= (- max min) 0.0) - (setf max 1.0 min 0.0 )) - (let* ((DTXSCALE 1.0) - (DTYSCALE 1.0) + (when (<= (- max min) 0d0) + (setf max 1d0 min 0d0 )) + (let* ((DTXSCALE 1d0) + (DTYSCALE 1d0) #+nil (DTHRES 513) #+nil (DTVRES 481) (XOFFSET 54) ; 3/4 inch. 72 units = 1 inch. @@ -159,9 +159,9 @@ #+nil (invert 0) #+nil (count 0) #+nil (title nil) - (xsc 1.0) - ; (ysc 1.0 ) - (ysc (/ (cols m) (rows m) 1.0)) + (xsc 1d0) + ; (ysc 1d0 ) + (ysc (/ (cols m) (rows m) 1d0)) (xscale (floor (* DTXSCALE scale 432 xsc))) (yscale (floor (* DTYSCALE scale 432 ysc))) Modified: trunk/src/linalg/level3-linalg-dge.lisp ============================================================================== --- trunk/src/linalg/level3-linalg-dge.lisp (original) +++ trunk/src/linalg/level3-linalg-dge.lisp Sat Mar 20 15:19:43 2010 @@ -50,7 +50,7 @@ (refc (i j) `(ref-blas-real-store C2 ,i ,j N))) (dotimes (i N) (dotimes (j M) - (let ((cij 0.0)) + (let ((cij 0d0)) (declare (double-float cij)) (dotimes (k S) (incf cij (* (refa i k ) (refb k j)))) Modified: trunk/src/matlisp/mul.lisp ============================================================================== --- trunk/src/matlisp/mul.lisp (original) +++ trunk/src/matlisp/mul.lisp Sat Mar 20 15:19:43 2010 @@ -25,8 +25,8 @@ (n (cols b)) (k (cols a)) (c (mcreate a 0 (list m n)))) - (f77::dgemm "N" "N" m n k 1.0 - (matrix-store a) m (matrix-store b) k 0.0 (matrix-store c) m) + (f77::dgemm "N" "N" m n k 1d0 + (matrix-store a) m (matrix-store b) k 0d0 (matrix-store c) m) c) (call-next-method))) @@ -36,7 +36,7 @@ (n (cols b)) (k (cols a)) (c (mcreate a 0 (list m n)))) - (f77::zgemm "N" "N" m n k #C(1.0 0.0) - (matrix-store a) m (matrix-store b) k #C(0.0 0.0) (matrix-store c) m) + (f77::zgemm "N" "N" m n k #C(1d0 0d0) + (matrix-store a) m (matrix-store b) k #C(0d0 0d0) (matrix-store c) m) c) (call-next-method))) Modified: trunk/src/matrix/level1-ddiag.lisp ============================================================================== --- trunk/src/matrix/level1-ddiag.lisp (original) +++ trunk/src/matrix/level1-ddiag.lisp Sat Mar 20 15:19:43 2010 @@ -59,7 +59,7 @@ (defmethod mref ((matrix matrix-base-ddi) row col) (if (= row col) (aref (slot-value matrix 'diagonal-store) row) - 0.0)) + 0d0)) (defmethod (setf mref) (value (matrix matrix-base-ddi) row col) (if (= row col) Modified: trunk/src/matrix/level1-dgt.lisp ============================================================================== --- trunk/src/matrix/level1-dgt.lisp (original) +++ trunk/src/matrix/level1-dgt.lisp Sat Mar 20 15:19:43 2010 @@ -82,7 +82,7 @@ (aref (slot-value matrix 'subdiagonal-store) col)) ((= (1+ row) col) 8 (aref (slot-value matrix 'superdiagonal-store) row)) - (t 0.0))) + (t 0d0))) (defmethod (setf mref) (value (matrix matrix-base-dgt) row col) (let ((val2 (coerce value 'double-float))) Modified: trunk/src/matrix/level1-util.lisp ============================================================================== --- trunk/src/matrix/level1-util.lisp (original) +++ trunk/src/matrix/level1-util.lisp Sat Mar 20 15:19:43 2010 @@ -101,7 +101,7 @@ value) value) -(defun allocate-real-store (size &optional (initial-element 0.0)) +(defun allocate-real-store (size &optional (initial-element 0d0)) ;; All matrix double and complex double constructors ;; should call this one (let ((x (coerce initial-element 'double-float))) @@ -109,10 +109,10 @@ (type type-blas-idx size)) ;; Stupid efficiency hack for SBCL. Allocations of arrays with zeros ;; is significantly faster than others! - (if (= x 0.0) + (if (= x 0d0) (make-array size :element-type 'double-float - :initial-element 0.0) + :initial-element 0d0) (make-array size :element-type 'double-float :initial-element x)))) @@ -141,7 +141,7 @@ ;;;; The complex store -(defun allocate-complex-store (size &optional (value 0.0)) +(defun allocate-complex-store (size &optional (value 0d0)) (let* ((2size (* 2 size)) (rv (coerce (realpart value) 'double-float)) (iv (coerce (imagpart value) 'double-float)) Modified: trunk/src/matrix/level2-constructors.lisp ============================================================================== --- trunk/src/matrix/level2-constructors.lisp (original) +++ trunk/src/matrix/level2-constructors.lisp Sat Mar 20 15:19:43 2010 @@ -88,7 +88,7 @@ (defun drandom (rows cols) "Creates a double matrix with random element between 0 and 1." - (mmap t #'random (dnew 1.0 rows cols))) + (mmap t #'random (dnew 1d0 rows cols))) (defmacro dmat (&body args) "Creates a matrix-dge matrix." Modified: trunk/src/matrix/level2-generic.lisp ============================================================================== --- trunk/src/matrix/level2-generic.lisp (original) +++ trunk/src/matrix/level2-generic.lisp Sat Mar 20 15:19:43 2010 @@ -30,7 +30,7 @@ (in-package :lisplab) -(defmethod mcreate ((m number) &optional (val 0.0) dim) +(defmethod mcreate ((m number) &optional (val 0) dim) ;; This is not about matrices at all, but is usefull ;; when you use the dotted algebra and is not sure is input is numbers or matrices. ;; TODO what the dim, should I use it or ignore it Modified: trunk/src/matrix/level2-matrix-dge.lisp ============================================================================== --- trunk/src/matrix/level2-matrix-dge.lisp (original) +++ trunk/src/matrix/level2-matrix-dge.lisp Sat Mar 20 15:19:43 2010 @@ -69,7 +69,7 @@ nil) (defmethod msum ((m matrix-base-dge)) - (let ((sum 0.0)) + (let ((sum 0d0)) (with-elements-df-1 (matrix-store m) x (incf sum x)) sum)) @@ -278,66 +278,66 @@ (copy a)) (defmethod .sqrt ((a matrix-base-dge)) - (if (>= (mmin a) 0.0) + (if (>= (mmin a) 0d0) (let ((out (mcreate a))) (sqrt_dfa-to-dfa (matrix-store a) (matrix-store out)) out) (let ((out (make-matrix-instance (cons :z (cdr (type-spec a))) (dim a) - 0.0))) + 0d0))) (sqrt_dfa-to-cdfa (matrix-store a) (matrix-store out)) out))) (defmethod .ln ((a matrix-base-dge)) - (if (> (mmin a) 0.0) + (if (> (mmin a) 0d0) (let ((out (mcreate a))) (log_dfa-to-dfa (matrix-store a) (matrix-store out)) out) (let ((out (make-matrix-instance (cons :z (cdr (type-spec a))) (dim a) - 0.0))) + 0d0))) (log_dfa-to-cdfa (matrix-store a) (matrix-store out)) out))) (defmethod .asin ((a matrix-base-dge)) (destructuring-bind (min max) (mminmax a) - (if (and (>= min -1.0) - (<= max 1.0)) + (if (and (>= min -1d0) + (<= max 1d0)) (let ((out (mcreate a))) (asin_dfa-to-dfa (matrix-store a) (matrix-store out)) out) (let ((out (make-matrix-instance (cons :z (cdr (type-spec a))) (dim a) - 0.0))) + 0d0))) (asin_dfa-to-cdfa (matrix-store a) (matrix-store out)) out)))) (defmethod .acos ((a matrix-base-dge)) (destructuring-bind (min max) (mminmax a) - (if (and (>= min -1.0) - (<= max 1.0)) + (if (and (>= min -1d0) + (<= max 1d0)) (let ((out (mcreate a))) (acos_dfa-to-dfa (matrix-store a) (matrix-store out)) out) (let ((out (make-matrix-instance (cons :z (cdr (type-spec a))) (dim a) - 0.0))) + 0d0))) (acos_dfa-to-cdfa (matrix-store a) (matrix-store out)) out)))) (defmethod .atanh ((a matrix-base-dge)) (destructuring-bind (min max) (mminmax a) - (if (and (> min -1.0) - (< max 1.0)) + (if (and (> min -1d0) + (< max 1d0)) (let ((out (mcreate a))) (atanh_dfa-to-dfa (matrix-store a) (matrix-store out)) out) (let ((out (make-matrix-instance (cons :z (cdr (type-spec a))) (dim a) - 0.0))) + 0d0))) (atanh_dfa-to-cdfa (matrix-store a) (matrix-store out)) out)))) Modified: trunk/src/matrix/level2-matrix-zge.lisp ============================================================================== --- trunk/src/matrix/level2-matrix-zge.lisp (original) +++ trunk/src/matrix/level2-matrix-zge.lisp Sat Mar 20 15:19:43 2010 @@ -54,8 +54,8 @@ to))) (defmethod msum ((m matrix-base-zge)) - (let ((sum-r 0.0) - (sum-i 0.0) + (let ((sum-r 0d0) + (sum-i 0d0) (m0 (matrix-store m))) (declare (type double-float sum-r sum-i) (type type-blas-store m0)) Modified: trunk/src/test/test-methods.lisp ============================================================================== --- trunk/src/test/test-methods.lisp (original) +++ trunk/src/test/test-methods.lisp Sat Mar 20 15:19:43 2010 @@ -20,7 +20,7 @@ (defun test-level0-methods () (let* ((a 1) - (b 1.0) + (b 1d0) (c %i) (x (dmat (1 2) (3 4))) (y (zmat (1 2) (3 4))) From jivestgarden at common-lisp.net Sun Mar 21 10:05:33 2010 From: jivestgarden at common-lisp.net (=?UTF-8?Q?J=C3=B8rn_Inge_Vestg=C3=A5rden?=) Date: Sun, 21 Mar 2010 06:05:33 -0400 Subject: [lisplab-cvs] r142 - trunk/shared/slatec Message-ID: 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). From jivestgarden at common-lisp.net Sun Mar 21 10:16:26 2010 From: jivestgarden at common-lisp.net (=?UTF-8?Q?J=C3=B8rn_Inge_Vestg=C3=A5rden?=) Date: Sun, 21 Mar 2010 06:16:26 -0400 Subject: [lisplab-cvs] r143 - trunk/shared/slatec/src Message-ID: Author: jivestgarden Date: Sun Mar 21 06:16:26 2010 New Revision: 143 Log: empty src directory Added: trunk/shared/slatec/src/ From jivestgarden at common-lisp.net Sun Mar 21 10:36:18 2010 From: jivestgarden at common-lisp.net (=?UTF-8?Q?J=C3=B8rn_Inge_Vestg=C3=A5rden?=) Date: Sun, 21 Mar 2010 06:36:18 -0400 Subject: [lisplab-cvs] r144 - in trunk: . shared/slatec shared/slatec/src src/core Message-ID: Author: jivestgarden Date: Sun Mar 21 06:36:17 2010 New Revision: 144 Log: hopefully fixed slatec compilation problem Added: trunk/shared/slatec/src/d9aimp.lisp - copied unchanged from r141, /trunk/shared/slatec/d9aimp.lisp trunk/shared/slatec/src/d9b0mp.lisp - copied unchanged from r141, /trunk/shared/slatec/d9b0mp.lisp trunk/shared/slatec/src/d9b1mp.lisp - copied unchanged from r141, /trunk/shared/slatec/d9b1mp.lisp trunk/shared/slatec/src/d9lgmc.lisp - copied unchanged from r141, /trunk/shared/slatec/d9lgmc.lisp trunk/shared/slatec/src/d9upak.lisp - copied unchanged from r141, /trunk/shared/slatec/d9upak.lisp trunk/shared/slatec/src/dai.lisp - copied unchanged from r141, /trunk/shared/slatec/dai.lisp trunk/shared/slatec/src/daie.lisp - copied unchanged from r141, /trunk/shared/slatec/daie.lisp trunk/shared/slatec/src/dasyik.lisp - copied unchanged from r141, /trunk/shared/slatec/dasyik.lisp trunk/shared/slatec/src/dasyjy.lisp - copied unchanged from r141, /trunk/shared/slatec/dasyjy.lisp trunk/shared/slatec/src/dbesi.lisp - copied unchanged from r141, /trunk/shared/slatec/dbesi.lisp trunk/shared/slatec/src/dbesi0.lisp - copied unchanged from r141, /trunk/shared/slatec/dbesi0.lisp trunk/shared/slatec/src/dbesi1.lisp - copied unchanged from r141, /trunk/shared/slatec/dbesi1.lisp trunk/shared/slatec/src/dbesj.lisp - copied unchanged from r141, /trunk/shared/slatec/dbesj.lisp trunk/shared/slatec/src/dbesj0.lisp - copied unchanged from r141, /trunk/shared/slatec/dbesj0.lisp trunk/shared/slatec/src/dbesj1.lisp - copied unchanged from r141, /trunk/shared/slatec/dbesj1.lisp trunk/shared/slatec/src/dbesk.lisp - copied unchanged from r141, /trunk/shared/slatec/dbesk.lisp trunk/shared/slatec/src/dbesk0.lisp - copied unchanged from r141, /trunk/shared/slatec/dbesk0.lisp trunk/shared/slatec/src/dbesk1.lisp - copied unchanged from r141, /trunk/shared/slatec/dbesk1.lisp trunk/shared/slatec/src/dbesy.lisp - copied unchanged from r141, /trunk/shared/slatec/dbesy.lisp trunk/shared/slatec/src/dbesy0.lisp - copied unchanged from r141, /trunk/shared/slatec/dbesy0.lisp trunk/shared/slatec/src/dbesy1.lisp - copied unchanged from r141, /trunk/shared/slatec/dbesy1.lisp trunk/shared/slatec/src/dbi.lisp - copied unchanged from r141, /trunk/shared/slatec/dbi.lisp trunk/shared/slatec/src/dbie.lisp - copied unchanged from r141, /trunk/shared/slatec/dbie.lisp trunk/shared/slatec/src/dbsi0e.lisp - copied unchanged from r141, /trunk/shared/slatec/dbsi0e.lisp trunk/shared/slatec/src/dbsi1e.lisp - copied unchanged from r141, /trunk/shared/slatec/dbsi1e.lisp trunk/shared/slatec/src/dbsk0e.lisp - copied unchanged from r141, /trunk/shared/slatec/dbsk0e.lisp trunk/shared/slatec/src/dbsk1e.lisp - copied unchanged from r141, /trunk/shared/slatec/dbsk1e.lisp trunk/shared/slatec/src/dbsknu.lisp - copied unchanged from r141, /trunk/shared/slatec/dbsknu.lisp trunk/shared/slatec/src/dbsynu.lisp - copied unchanged from r141, /trunk/shared/slatec/dbsynu.lisp trunk/shared/slatec/src/dcsevl.lisp - copied unchanged from r141, /trunk/shared/slatec/dcsevl.lisp trunk/shared/slatec/src/de1.lisp - copied unchanged from r141, /trunk/shared/slatec/de1.lisp trunk/shared/slatec/src/dei.lisp - copied unchanged from r141, /trunk/shared/slatec/dei.lisp trunk/shared/slatec/src/derf.lisp - copied unchanged from r141, /trunk/shared/slatec/derf.lisp trunk/shared/slatec/src/derfc.lisp - copied unchanged from r141, /trunk/shared/slatec/derfc.lisp trunk/shared/slatec/src/dgamlm.lisp - copied unchanged from r141, /trunk/shared/slatec/dgamlm.lisp trunk/shared/slatec/src/dgamln.lisp - copied unchanged from r141, /trunk/shared/slatec/dgamln.lisp trunk/shared/slatec/src/dgamma.lisp - copied unchanged from r141, /trunk/shared/slatec/dgamma.lisp trunk/shared/slatec/src/dgtsl.lisp - copied unchanged from r141, /trunk/shared/slatec/dgtsl.lisp trunk/shared/slatec/src/djairy.lisp - copied unchanged from r141, /trunk/shared/slatec/djairy.lisp trunk/shared/slatec/src/dlngam.lisp - copied unchanged from r141, /trunk/shared/slatec/dlngam.lisp trunk/shared/slatec/src/dqag.lisp - copied unchanged from r141, /trunk/shared/slatec/dqag.lisp trunk/shared/slatec/src/dqage.lisp - copied unchanged from r141, /trunk/shared/slatec/dqage.lisp trunk/shared/slatec/src/dqagi.lisp - copied unchanged from r141, /trunk/shared/slatec/dqagi.lisp trunk/shared/slatec/src/dqagie.lisp - copied unchanged from r141, /trunk/shared/slatec/dqagie.lisp trunk/shared/slatec/src/dqagpe.lisp - copied unchanged from r141, /trunk/shared/slatec/dqagpe.lisp trunk/shared/slatec/src/dqags.lisp - copied unchanged from r141, /trunk/shared/slatec/dqags.lisp trunk/shared/slatec/src/dqagse.lisp - copied unchanged from r141, /trunk/shared/slatec/dqagse.lisp trunk/shared/slatec/src/dqawc.lisp - copied unchanged from r141, /trunk/shared/slatec/dqawc.lisp trunk/shared/slatec/src/dqawce.lisp - copied unchanged from r141, /trunk/shared/slatec/dqawce.lisp trunk/shared/slatec/src/dqawf.lisp - copied unchanged from r141, /trunk/shared/slatec/dqawf.lisp trunk/shared/slatec/src/dqawfe.lisp - copied unchanged from r141, /trunk/shared/slatec/dqawfe.lisp trunk/shared/slatec/src/dqawo.lisp - copied unchanged from r141, /trunk/shared/slatec/dqawo.lisp trunk/shared/slatec/src/dqawoe.lisp - copied unchanged from r141, /trunk/shared/slatec/dqawoe.lisp trunk/shared/slatec/src/dqaws.lisp - copied unchanged from r141, /trunk/shared/slatec/dqaws.lisp trunk/shared/slatec/src/dqawse.lisp - copied unchanged from r141, /trunk/shared/slatec/dqawse.lisp trunk/shared/slatec/src/dqc25c.lisp - copied unchanged from r141, /trunk/shared/slatec/dqc25c.lisp trunk/shared/slatec/src/dqc25f.lisp - copied unchanged from r141, /trunk/shared/slatec/dqc25f.lisp trunk/shared/slatec/src/dqc25s.lisp - copied unchanged from r141, /trunk/shared/slatec/dqc25s.lisp trunk/shared/slatec/src/dqcheb.lisp - copied unchanged from r141, /trunk/shared/slatec/dqcheb.lisp trunk/shared/slatec/src/dqelg.lisp - copied unchanged from r141, /trunk/shared/slatec/dqelg.lisp trunk/shared/slatec/src/dqk15.lisp - copied unchanged from r141, /trunk/shared/slatec/dqk15.lisp trunk/shared/slatec/src/dqk15i.lisp - copied unchanged from r141, /trunk/shared/slatec/dqk15i.lisp trunk/shared/slatec/src/dqk15w.lisp - copied unchanged from r141, /trunk/shared/slatec/dqk15w.lisp trunk/shared/slatec/src/dqk21.lisp - copied unchanged from r141, /trunk/shared/slatec/dqk21.lisp trunk/shared/slatec/src/dqk31.lisp - copied unchanged from r141, /trunk/shared/slatec/dqk31.lisp trunk/shared/slatec/src/dqk41.lisp - copied unchanged from r141, /trunk/shared/slatec/dqk41.lisp trunk/shared/slatec/src/dqk51.lisp - copied unchanged from r141, /trunk/shared/slatec/dqk51.lisp trunk/shared/slatec/src/dqk61.lisp - copied unchanged from r141, /trunk/shared/slatec/dqk61.lisp trunk/shared/slatec/src/dqmomo.lisp - copied unchanged from r141, /trunk/shared/slatec/dqmomo.lisp trunk/shared/slatec/src/dqng.lisp - copied unchanged from r141, /trunk/shared/slatec/dqng.lisp trunk/shared/slatec/src/dqpsrt.lisp - copied unchanged from r141, /trunk/shared/slatec/dqpsrt.lisp trunk/shared/slatec/src/dqwgtc.lisp - copied unchanged from r141, /trunk/shared/slatec/dqwgtc.lisp trunk/shared/slatec/src/dqwgtf.lisp - copied unchanged from r141, /trunk/shared/slatec/dqwgtf.lisp trunk/shared/slatec/src/dqwgts.lisp - copied unchanged from r141, /trunk/shared/slatec/dqwgts.lisp trunk/shared/slatec/src/dspenc.lisp - copied unchanged from r141, /trunk/shared/slatec/dspenc.lisp trunk/shared/slatec/src/dyairy.lisp - copied unchanged from r141, /trunk/shared/slatec/dyairy.lisp trunk/shared/slatec/src/fdump.lisp - copied unchanged from r141, /trunk/shared/slatec/fdump.lisp trunk/shared/slatec/src/initds.lisp - copied unchanged from r141, /trunk/shared/slatec/initds.lisp trunk/shared/slatec/src/j4save.lisp - copied unchanged from r141, /trunk/shared/slatec/j4save.lisp trunk/shared/slatec/src/script.sh - copied unchanged from r141, /trunk/shared/slatec/script.sh trunk/shared/slatec/src/xercnt.lisp - copied unchanged from r141, /trunk/shared/slatec/xercnt.lisp trunk/shared/slatec/src/xerhlt.lisp - copied unchanged from r141, /trunk/shared/slatec/xerhlt.lisp trunk/shared/slatec/src/xermsg.lisp - copied unchanged from r141, /trunk/shared/slatec/xermsg.lisp trunk/shared/slatec/src/xerprn.lisp - copied unchanged from r141, /trunk/shared/slatec/xerprn.lisp trunk/shared/slatec/src/xersve.lisp - copied unchanged from r141, /trunk/shared/slatec/xersve.lisp trunk/shared/slatec/src/xgetua.lisp - copied unchanged from r141, /trunk/shared/slatec/xgetua.lisp trunk/shared/slatec/src/zabs.lisp - copied unchanged from r141, /trunk/shared/slatec/zabs.lisp trunk/shared/slatec/src/zacai.lisp - copied unchanged from r141, /trunk/shared/slatec/zacai.lisp trunk/shared/slatec/src/zacon.lisp - copied unchanged from r141, /trunk/shared/slatec/zacon.lisp trunk/shared/slatec/src/zairy.lisp - copied unchanged from r141, /trunk/shared/slatec/zairy.lisp trunk/shared/slatec/src/zasyi.lisp - copied unchanged from r141, /trunk/shared/slatec/zasyi.lisp trunk/shared/slatec/src/zbesh.lisp - copied unchanged from r141, /trunk/shared/slatec/zbesh.lisp trunk/shared/slatec/src/zbesi.lisp - copied unchanged from r141, /trunk/shared/slatec/zbesi.lisp trunk/shared/slatec/src/zbesj.lisp - copied unchanged from r141, /trunk/shared/slatec/zbesj.lisp trunk/shared/slatec/src/zbesk.lisp - copied unchanged from r141, /trunk/shared/slatec/zbesk.lisp trunk/shared/slatec/src/zbesy.lisp - copied unchanged from r141, /trunk/shared/slatec/zbesy.lisp trunk/shared/slatec/src/zbinu.lisp - copied unchanged from r141, /trunk/shared/slatec/zbinu.lisp trunk/shared/slatec/src/zbiry.lisp - copied unchanged from r141, /trunk/shared/slatec/zbiry.lisp trunk/shared/slatec/src/zbknu.lisp - copied unchanged from r141, /trunk/shared/slatec/zbknu.lisp trunk/shared/slatec/src/zbuni.lisp - copied unchanged from r141, /trunk/shared/slatec/zbuni.lisp trunk/shared/slatec/src/zbunk.lisp - copied unchanged from r141, /trunk/shared/slatec/zbunk.lisp trunk/shared/slatec/src/zdiv.lisp - copied unchanged from r141, /trunk/shared/slatec/zdiv.lisp trunk/shared/slatec/src/zexp.lisp - copied unchanged from r141, /trunk/shared/slatec/zexp.lisp trunk/shared/slatec/src/zkscl.lisp - copied unchanged from r141, /trunk/shared/slatec/zkscl.lisp trunk/shared/slatec/src/zlog.lisp - copied unchanged from r141, /trunk/shared/slatec/zlog.lisp trunk/shared/slatec/src/zmlri.lisp - copied unchanged from r141, /trunk/shared/slatec/zmlri.lisp trunk/shared/slatec/src/zmlt.lisp - copied unchanged from r141, /trunk/shared/slatec/zmlt.lisp trunk/shared/slatec/src/zrati.lisp - copied unchanged from r141, /trunk/shared/slatec/zrati.lisp trunk/shared/slatec/src/zs1s2.lisp - copied unchanged from r141, /trunk/shared/slatec/zs1s2.lisp trunk/shared/slatec/src/zseri.lisp - copied unchanged from r141, /trunk/shared/slatec/zseri.lisp trunk/shared/slatec/src/zshch.lisp - copied unchanged from r141, /trunk/shared/slatec/zshch.lisp trunk/shared/slatec/src/zsqrt.lisp - copied unchanged from r141, /trunk/shared/slatec/zsqrt.lisp trunk/shared/slatec/src/zuchk.lisp - copied unchanged from r141, /trunk/shared/slatec/zuchk.lisp trunk/shared/slatec/src/zunhj.lisp - copied unchanged from r141, /trunk/shared/slatec/zunhj.lisp trunk/shared/slatec/src/zuni1.lisp - copied unchanged from r141, /trunk/shared/slatec/zuni1.lisp trunk/shared/slatec/src/zuni2.lisp - copied unchanged from r141, /trunk/shared/slatec/zuni2.lisp trunk/shared/slatec/src/zunik.lisp - copied unchanged from r141, /trunk/shared/slatec/zunik.lisp trunk/shared/slatec/src/zunk1.lisp - copied unchanged from r141, /trunk/shared/slatec/zunk1.lisp trunk/shared/slatec/src/zunk2.lisp - copied unchanged from r141, /trunk/shared/slatec/zunk2.lisp trunk/shared/slatec/src/zuoik.lisp - copied unchanged from r141, /trunk/shared/slatec/zuoik.lisp trunk/shared/slatec/src/zwrsk.lisp - copied unchanged from r141, /trunk/shared/slatec/zwrsk.lisp Removed: trunk/shared/slatec/d9aimp.lisp trunk/shared/slatec/d9b0mp.lisp trunk/shared/slatec/d9b1mp.lisp trunk/shared/slatec/d9lgmc.lisp trunk/shared/slatec/d9upak.lisp trunk/shared/slatec/dai.lisp trunk/shared/slatec/daie.lisp trunk/shared/slatec/dasyik.lisp trunk/shared/slatec/dasyjy.lisp trunk/shared/slatec/dbesi.lisp trunk/shared/slatec/dbesi0.lisp trunk/shared/slatec/dbesi1.lisp trunk/shared/slatec/dbesj.lisp trunk/shared/slatec/dbesj0.lisp trunk/shared/slatec/dbesj1.lisp trunk/shared/slatec/dbesk.lisp trunk/shared/slatec/dbesk0.lisp trunk/shared/slatec/dbesk1.lisp trunk/shared/slatec/dbesy.lisp trunk/shared/slatec/dbesy0.lisp trunk/shared/slatec/dbesy1.lisp trunk/shared/slatec/dbi.lisp trunk/shared/slatec/dbie.lisp trunk/shared/slatec/dbsi0e.lisp trunk/shared/slatec/dbsi1e.lisp trunk/shared/slatec/dbsk0e.lisp trunk/shared/slatec/dbsk1e.lisp trunk/shared/slatec/dbsknu.lisp trunk/shared/slatec/dbsynu.lisp trunk/shared/slatec/dcsevl.lisp trunk/shared/slatec/de1.lisp trunk/shared/slatec/dei.lisp trunk/shared/slatec/derf.lisp trunk/shared/slatec/derfc.lisp trunk/shared/slatec/dgamlm.lisp trunk/shared/slatec/dgamln.lisp trunk/shared/slatec/dgamma.lisp trunk/shared/slatec/dgtsl.lisp trunk/shared/slatec/djairy.lisp trunk/shared/slatec/dlngam.lisp trunk/shared/slatec/dqag.lisp trunk/shared/slatec/dqage.lisp trunk/shared/slatec/dqagi.lisp trunk/shared/slatec/dqagie.lisp trunk/shared/slatec/dqagpe.lisp trunk/shared/slatec/dqags.lisp trunk/shared/slatec/dqagse.lisp trunk/shared/slatec/dqawc.lisp trunk/shared/slatec/dqawce.lisp trunk/shared/slatec/dqawf.lisp trunk/shared/slatec/dqawfe.lisp trunk/shared/slatec/dqawo.lisp trunk/shared/slatec/dqawoe.lisp trunk/shared/slatec/dqaws.lisp trunk/shared/slatec/dqawse.lisp trunk/shared/slatec/dqc25c.lisp trunk/shared/slatec/dqc25f.lisp trunk/shared/slatec/dqc25s.lisp trunk/shared/slatec/dqcheb.lisp trunk/shared/slatec/dqelg.lisp trunk/shared/slatec/dqk15.lisp trunk/shared/slatec/dqk15i.lisp trunk/shared/slatec/dqk15w.lisp trunk/shared/slatec/dqk21.lisp trunk/shared/slatec/dqk31.lisp trunk/shared/slatec/dqk41.lisp trunk/shared/slatec/dqk51.lisp trunk/shared/slatec/dqk61.lisp trunk/shared/slatec/dqmomo.lisp trunk/shared/slatec/dqng.lisp trunk/shared/slatec/dqpsrt.lisp trunk/shared/slatec/dqwgtc.lisp trunk/shared/slatec/dqwgtf.lisp trunk/shared/slatec/dqwgts.lisp trunk/shared/slatec/dspenc.lisp trunk/shared/slatec/dyairy.lisp trunk/shared/slatec/fdump.lisp trunk/shared/slatec/initds.lisp trunk/shared/slatec/j4save.lisp trunk/shared/slatec/script.sh trunk/shared/slatec/xercnt.lisp trunk/shared/slatec/xerhlt.lisp trunk/shared/slatec/xermsg.lisp trunk/shared/slatec/xerprn.lisp trunk/shared/slatec/xersve.lisp trunk/shared/slatec/xgetua.lisp trunk/shared/slatec/zabs.lisp trunk/shared/slatec/zacai.lisp trunk/shared/slatec/zacon.lisp trunk/shared/slatec/zairy.lisp trunk/shared/slatec/zasyi.lisp trunk/shared/slatec/zbesh.lisp trunk/shared/slatec/zbesi.lisp trunk/shared/slatec/zbesj.lisp trunk/shared/slatec/zbesk.lisp trunk/shared/slatec/zbesy.lisp trunk/shared/slatec/zbinu.lisp trunk/shared/slatec/zbiry.lisp trunk/shared/slatec/zbknu.lisp trunk/shared/slatec/zbuni.lisp trunk/shared/slatec/zbunk.lisp trunk/shared/slatec/zdiv.lisp trunk/shared/slatec/zexp.lisp trunk/shared/slatec/zkscl.lisp trunk/shared/slatec/zlog.lisp trunk/shared/slatec/zmlri.lisp trunk/shared/slatec/zmlt.lisp trunk/shared/slatec/zrati.lisp trunk/shared/slatec/zs1s2.lisp trunk/shared/slatec/zseri.lisp trunk/shared/slatec/zshch.lisp trunk/shared/slatec/zsqrt.lisp trunk/shared/slatec/zuchk.lisp trunk/shared/slatec/zunhj.lisp trunk/shared/slatec/zuni1.lisp trunk/shared/slatec/zuni2.lisp trunk/shared/slatec/zunik.lisp trunk/shared/slatec/zunk1.lisp trunk/shared/slatec/zunk2.lisp trunk/shared/slatec/zuoik.lisp trunk/shared/slatec/zwrsk.lisp Modified: trunk/lisplab.asd trunk/shared/slatec/f2cl-lib.lisp trunk/src/core/level0-basic.lisp Modified: trunk/lisplab.asd ============================================================================== --- trunk/lisplab.asd (original) +++ trunk/lisplab.asd Sun Mar 21 06:36:17 2010 @@ -28,8 +28,15 @@ (:lisplab-base :lisplab-matlisp :lisplab-fftw - ; :slatec Slatec not in system becuase of compilation problems - :quadpack)) + :slatec + :quadpack) + :components + ((:module :src/specfunc +; :depends-on (:lisplab-base :slatec) + :components ((:file "level0-specfunc"))) + (:module :src/integrate +; :depends-on (:lisplab-base :quadpack) + :components ((:file "quadpack"))))) (defsystem :lisplab-base :depends-on () @@ -214,17 +221,10 @@ (:file "level3-fft-fftw"))))) (defsystem :quadpack - :depends-on (:lisplab-base) + :depends-on () :components ( ;; - ;; Quadpack in lisplab - ;; - (:module :src/integrate - :depends-on (:/shared/quadpack/) - :components ((:file "quadpack"))) - - ;; ;; Quadpack. Generated with f2cl. ;; (:module :/shared/quadpack/ @@ -275,23 +275,26 @@ )))) (defsystem :slatec - :depends-on (:lisplab-base) + :depends-on () :components ( - (:module :src/specfunc - :depends-on (:shared/slatec) - :components ((:file "level0-specfunc"))) - ;; - ;; Slatec in lisplab ;; + ;; Quadpack. Generated with f2cl. + ;; Taken from Maxima + (:module :shared/slatec + :depends-on () :components ( (:file "f2cl-package") (:file "f2cl-lib") ;; The package - (:file "slatec") + (:file "slatec"))) + (:module :shared/slatec/src + :depends-on (:shared/slatec) + :components + ( (:file "fdump") (:file "j4save") (:file "initds" Modified: trunk/shared/slatec/f2cl-lib.lisp ============================================================================== --- trunk/shared/slatec/f2cl-lib.lisp (original) +++ trunk/shared/slatec/f2cl-lib.lisp Sun Mar 21 06:36:17 2010 @@ -671,6 +671,7 @@ (float-sign y x)))) #+sbcl (defun sign (x y) + (declare (type (or integer4 single-float double-float) x y)) (etypecase x (integer4 (isign x y)) Modified: trunk/src/core/level0-basic.lisp ============================================================================== --- trunk/src/core/level0-basic.lisp (original) +++ trunk/src/core/level0-basic.lisp Sun Mar 21 06:36:17 2010 @@ -28,7 +28,7 @@ ;; Help, not tested #-sbcl(defmacro truely-the (type val) `(the ,type ,val)) -(setf *READ-DEFAULT-FLOAT-FORMAT* 'double-float) ; TODO make part of pacakge import? +;; (setf *READ-DEFAULT-FLOAT-FORMAT* 'double-float) ; TODO make part of pacakge import? (defmacro with-gensyms ((&rest names) . body) ;; TODO remove? Is it used at all? From jivestgarden at common-lisp.net Sun Mar 21 11:05:08 2010 From: jivestgarden at common-lisp.net (=?UTF-8?Q?J=C3=B8rn_Inge_Vestg=C3=A5rden?=) Date: Sun, 21 Mar 2010 07:05:08 -0400 Subject: [lisplab-cvs] r145 - trunk/shared/slatec/src Message-ID: Author: jivestgarden Date: Sun Mar 21 07:05:08 2010 New Revision: 145 Log: fix sign to dsign Modified: trunk/shared/slatec/src/derf.lisp Modified: trunk/shared/slatec/src/derf.lisp ============================================================================== --- trunk/shared/slatec/src/derf.lisp (original) +++ trunk/shared/slatec/src/derf.lisp Sun Mar 21 07:05:08 2010 @@ -64,8 +64,8 @@ (setf derf (* x (+ 1.0 (dcsevl (- (* 2.0 x x) 1.0) erfcs nterf))))) (go end_label) label20 - (if (<= y xbig) (setf derf (f2cl-lib:sign (- 1.0 (derfc y)) x))) - (if (> y xbig) (setf derf (f2cl-lib:sign 1.0 x))) + (if (<= y xbig) (setf derf (f2cl-lib:dsign (- 1.0 (derfc y)) x))) + (if (> y xbig) (setf derf (f2cl-lib:dsign 1.0 x))) (go end_label) end_label (return (values derf nil))))) From jivestgarden at common-lisp.net Sun Mar 21 11:24:02 2010 From: jivestgarden at common-lisp.net (=?UTF-8?Q?J=C3=B8rn_Inge_Vestg=C3=A5rden?=) Date: Sun, 21 Mar 2010 07:24:02 -0400 Subject: [lisplab-cvs] r146 - trunk Message-ID: Author: jivestgarden Date: Sun Mar 21 07:24:02 2010 New Revision: 146 Log: fixed double float issue Modified: trunk/lisplab.asd Modified: trunk/lisplab.asd ============================================================================== --- trunk/lisplab.asd (original) +++ trunk/lisplab.asd Sun Mar 21 07:24:02 2010 @@ -10,6 +10,8 @@ (defpackage :asdf-lisplab (:use :asdf :cl)) (in-package :asdf-lisplab) +(defvar *orig-read-default-float-format* nil) + (defun load-lisplab-lib (name) (when name #+sbcl (sb-alien:load-shared-object name))) @@ -222,6 +224,12 @@ (defsystem :quadpack :depends-on () + :perform (asdf:load-op :before (op c) + (setf *orig-read-default-float-format* *read-default-float-format* + *read-default-float-format* 'double-float)) + :perform (asdf:load-op :after (op c) + (setf *read-default-float-format* *orig-read-default-float-format*)) + :components ( ;; @@ -276,6 +284,11 @@ (defsystem :slatec :depends-on () + :perform (asdf:load-op :before (op c) + (setf *orig-read-default-float-format* *read-default-float-format* + *read-default-float-format* 'double-float)) + :perform (asdf:load-op :after (op c) + (setf *read-default-float-format* *orig-read-default-float-format*)) :components ( ;; From jivestgarden at common-lisp.net Sun Mar 21 13:53:36 2010 From: jivestgarden at common-lisp.net (=?UTF-8?Q?J=C3=B8rn_Inge_Vestg=C3=A5rden?=) Date: Sun, 21 Mar 2010 09:53:36 -0400 Subject: [lisplab-cvs] r147 - in trunk: . doc/www Message-ID: Author: jivestgarden Date: Sun Mar 21 09:53:36 2010 New Revision: 147 Log: cleanup Modified: trunk/doc/www/index.html trunk/lisplab.asd trunk/start.lisp Modified: trunk/doc/www/index.html ============================================================================== --- trunk/doc/www/index.html (original) +++ trunk/doc/www/index.html Sun Mar 21 09:53:36 2010 @@ -51,7 +51,8 @@

Lisplab is a mathematics library in Common Lisp - released under the GNU General Public License (GPL). + released under the GNU General Public License (GPL) + and hosted at common-lisp.net. Lisplab is based on code from Matlisp, but has now moved quite far from the original code mass.

@@ -83,9 +84,10 @@ The external libraries, BLAS, LAPACK, and FFTW must be installed separately. They make Lisplab more powerful, but it also makes sense to run it without external libraries. - Lisplab does not depend on any other Common Lisp projects, but will only - compile out-of-the-box for SBCL and - for other Lisps you must expect some hacking. + Lisplab is mainly ANSI compliant and does not depend on any other Common Lisp projects, + but it has so far only been tested on + SBCL, so + for other Lisps you must expect some hacking to make it build.

See @@ -98,6 +100,8 @@ contains lisplab.asd. Then you install it by 

   > (require :lisplab)
and use it by 
   > (use-package :ll-user)
+ When compiling for the first time you must have *read-default-float-format* + set to 'double-float because the generated slatec code requires it. When started, you can do 
  LL-USER> (.^ (dmat (1 2) (3 4)) 2)
   #<MATRIX-DGE  2x2
@@ -120,6 +124,7 @@
   mmax mmin circ-shift pad-shift
   m* m/ minv mtp mct 
   eivenvalues eigenvectors 
+  LU-factor
   dlmread dlmwrite pswrite pgmwrite
   export-list import-list
   fftw1 ifftw1 
@@ -173,6 +178,9 @@
     tree from anonymous svn,
     
   % svn checkout svn://common-lisp.net/project/lisplab/svn lisplab

+    or if you want just the latest version,
+    
+  % svn checkout svn://common-lisp.net/project/lisplab/svn/trunk lisplab

   

 
   
Mailing Lists


Modified: trunk/lisplab.asd
==============================================================================
--- trunk/lisplab.asd	(original)
+++ trunk/lisplab.asd	Sun Mar 21 09:53:36 2010
@@ -10,8 +10,6 @@
 (defpackage :asdf-lisplab (:use :asdf :cl))
 (in-package :asdf-lisplab)
 
-(defvar *orig-read-default-float-format* nil)
-
 (defun load-lisplab-lib (name)
   (when name  
     #+sbcl (sb-alien:load-shared-object name)))
@@ -224,12 +222,6 @@
 
 (defsystem :quadpack
   :depends-on ()
-  :perform (asdf:load-op :before (op c)
-			 (setf  *orig-read-default-float-format* *read-default-float-format*
-				*read-default-float-format* 'double-float))
-  :perform (asdf:load-op :after (op c)
-			 (setf  *read-default-float-format* *orig-read-default-float-format*))
-
   :components 
   (
    ;;
@@ -284,15 +276,10 @@
 
 (defsystem :slatec
   :depends-on ()
-  :perform (asdf:load-op :before (op c)
-			 (setf  *orig-read-default-float-format* *read-default-float-format*
-				*read-default-float-format* 'double-float))
-  :perform (asdf:load-op :after (op c)
-			 (setf  *read-default-float-format* *orig-read-default-float-format*))
   :components 
   (
    ;;
-   ;; Quadpack. Generated with f2cl. 
+   ;; Slatec. Generated with f2cl. 
    ;; Taken from Maxima
 
    (:module :shared/slatec

Modified: trunk/start.lisp
==============================================================================
--- trunk/start.lisp	(original)
+++ trunk/start.lisp	Sun Mar 21 09:53:36 2010
@@ -7,11 +7,9 @@
 ;; (defvar *lisplab-liblapack-path* #P"/usr/lib/atlas/liblapack.so.3.0")
 ;; (defvar  *lisplab-libfftw-path* #P"/usr/lib/libfftw3.so.3")
 
+;; Slatec needs this for compiling. 
+(setf *read-default-float-format* 'double-float) 
 
 (require :lisplab)
-(let ((asdf:*compile-file-failure-behaviour* :ignore))
-    ;; There seems to bee some compilation trouble in SBCL 
-    ;; due to type interference. Should be fixed, not just skipped.
-  (require :slatec))
 
-(format t "Lisplab is loaded.~%")
+(format t "~&Lisplab is loaded.~%")



From jivestgarden at common-lisp.net  Sun Mar 21 15:17:48 2010
From: jivestgarden at common-lisp.net (=?UTF-8?Q?J=C3=B8rn_Inge_Vestg=C3=A5rden?=)
Date: Sun, 21 Mar 2010 11:17:48 -0400
Subject: [lisplab-cvs] r148 - trunk
Message-ID: 

Author: jivestgarden
Date: Sun Mar 21 11:17:48 2010
New Revision: 148

Log:
svnversion target in makefile

Modified:
   trunk/Makefile

Modified: trunk/Makefile
==============================================================================
--- trunk/Makefile	(original)
+++ trunk/Makefile	Sun Mar 21 11:17:48 2010
@@ -22,8 +22,8 @@
 	--eval "(tinaa:document-system 'asdf-system 'lisplab #P\"tinaa/\")" \
 	--eval "(sb-ext::quit)"
 
-touch:
-	touch system/lisplab.asd
+svnversion:
+	svnversion -n > SVNVERSION
 
 lispclean:
 	-find . -name "*.fasl" -exec rm \{} \; 



From jivestgarden at common-lisp.net  Sun Mar 21 15:30:48 2010
From: jivestgarden at common-lisp.net (=?UTF-8?Q?J=C3=B8rn_Inge_Vestg=C3=A5rden?=)
Date: Sun, 21 Mar 2010 11:30:48 -0400
Subject: [lisplab-cvs] r149 - trunk
Message-ID: 

Author: jivestgarden
Date: Sun Mar 21 11:30:48 2010
New Revision: 149

Log:
added version number

Added:
   trunk/version.lisp
Modified:
   trunk/lisplab.asd
   trunk/package.lisp

Modified: trunk/lisplab.asd
==============================================================================
--- trunk/lisplab.asd	(original)
+++ trunk/lisplab.asd	Sun Mar 21 11:30:48 2010
@@ -43,6 +43,7 @@
   :components 
   (
    (:file "package")
+   (:file "version")
 
    ;;
    ;; All core none-matrix stuff (level 0)

Modified: trunk/package.lisp
==============================================================================
--- trunk/package.lisp	(original)
+++ trunk/package.lisp	Sun Mar 21 11:30:48 2010
@@ -46,6 +46,9 @@
 
 Lisplab provides high level interfaces to BLAS, LAPACK and FFTW.")
   (:export 
+   "LISPLAB-VERSION"
+   "LISPLAB-SVN-VERSION"
+
    ;; Utilities
    "IN-DIR"
    "STRCAT"

Added: trunk/version.lisp
==============================================================================
--- (empty file)
+++ trunk/version.lisp	Sun Mar 21 11:30:48 2010
@@ -0,0 +1,11 @@
+(in-package :lisplab)
+
+(defparameter lisplab-version "0.1.0" "A rather non-systematic overall version number.")
+
+(defparameter lisplab-svn-version
+  (if (probe-file #P"SVNVERSION")
+      (with-open-file (in #P"SVNVERSION" :direction :input)
+	(read-line in))
+      "No such ting. Make with '% make svnversion'")
+  "Revision number from subversion. Generated with svnversion.")
+		  
\ No newline at end of file



From jivestgarden at common-lisp.net  Sun Mar 21 15:51:12 2010
From: jivestgarden at common-lisp.net (=?UTF-8?Q?J=C3=B8rn_Inge_Vestg=C3=A5rden?=)
Date: Sun, 21 Mar 2010 11:51:12 -0400
Subject: [lisplab-cvs] r150 - tags/version-0.1.0
Message-ID: 

Author: jivestgarden
Date: Sun Mar 21 11:51:12 2010
New Revision: 150

Log:
Saved version 0.1.0

Added:
   tags/version-0.1.0/
      - copied from r149, /trunk/



From jivestgarden at common-lisp.net  Sun Mar 21 19:52:46 2010
From: jivestgarden at common-lisp.net (=?UTF-8?Q?J=C3=B8rn_Inge_Vestg=C3=A5rden?=)
Date: Sun, 21 Mar 2010 15:52:46 -0400
Subject: [lisplab-cvs] r151 - trunk
Message-ID: 

Author: jivestgarden
Date: Sun Mar 21 15:52:46 2010
New Revision: 151

Log:
added the quadpack integration routines

Modified:
   trunk/package.lisp

Modified: trunk/package.lisp
==============================================================================
--- trunk/package.lisp	(original)
+++ trunk/package.lisp	Sun Mar 21 15:52:46 2010
@@ -234,6 +234,14 @@
    "IFFT2" 	  
    "FFT-SHIFT" 
    "IFFT-SHIFT"
+
+   ;; Quadpack
+   "INTEGRATE-QNG"
+   "INTEGRATE-QAG"
+   "INTEGRATE-QAGS"
+   "INTEGRATE-QAGI"
+   "INTEGRATE-QAWS"
+   "INTEGRATE-QAWC"
    ))
 
 (defpackage "LISPLAB-USER"