(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10) (FILECREATED " 2-Nov-93 17:19:14" ("compiled on " {DSK}export>lispcore>sources>CLTL2>CMLFLOATARRAY.;1) "19-Feb-93 17:03:08" bcompl'd in "Medley 19-Feb-93 ..." dated "19-Feb-93 18:20:42") (FILECREATED "19-Oct-93 10:48:08" "{Pele:mv:envos}Sources>CLTL2>CMLFLOATARRAY.;1" 29993 previous date%: "11-Jun-90 14:41:02" "{Pele:mv:envos}Sources>CMLFLOATARRAY.;1") MAP-ARRAY :D8 (L (0 ARGS)) a&elHo kalala@J oJ lh]dH)Id GIL qLI jeoWa^ LNL oN N\Mk԰_OLd gI YIoI LI>lH7H_dlIJK lIJKla gOo I _I _Hl2O0dO."O2_ _Oj__OO*Ia _6O4O6h_4_2O0k_0O6&_4JOO_"_ O"*O _IO_&O_$OO&O$Ok_ O O"OO O"IJj_,_*Hl2 O:dO8MO<_(JHl2%ODdOBOF O( a_JOHOJh_H_FODk_DOJ&_Ha_@O>O@h_>_dnO,k_,hl4 O,O*(598 \LISPERROR 508 ASET 501 CL:APPLY 423 CL:ARRAYP 384 CL:APPLY 330 FLATTEN-ARG 303 CL:COPY-LIST 275 CL:ARRAY-TOTAL-SIZE 266 FLATTEN-ARG 259 ECASE-FAIL 241 MAP-ARRAY-2 224 MAP-ARRAY-1 192 CL:ERROR 177 CL:MAKE-ARRAY 166 CL:ARRAY-DIMENSIONS 132 CL:ERROR 120 EQUAL-DIMENSIONS-P 108 CL:ARRAYP 90 CL:ARRAY-RANK 80 EQUAL-DIMENSIONS-P 70 CL:ARRAYP 51 CL:ERROR 39 CL:FUNCTIONP 18 CL:ERROR) (247 ARGS 171 :ELEMENT-TYPE 156 LISTP 148 LITATOM) ( 254 (3 4) 186 "RESULT must be an array, an element type, or NIL: ~S" 126 "Dimensions mismatch" 99 "Dimensions mismatch: ~S" 45 "Not a function: ~S" 13 "MAPARRAY takes at least three args") (PRETTYCOMPRINT CMLFLOATARRAYCOMS) (RPAQQ CMLFLOATARRAYCOMS ((DECLARE%: DONTCOPY DOEVAL@COMPILE (FILES (SYSLOAD FROM VALUEOF DIRECTORIES) UNBOXEDOPS FLOAT-ARRAY-SUPPORT)) (* ;; "MAPARRAY fns and macros") (FNS MAP-ARRAY) (FUNCTIONS MAP-ARRAY-1 MAP-ARRAY-2) (FUNCTIONS REDUCE-ARRAY EVALUATE-POLYNOMIAL FIND-ARRAY-ELEMENT-INDEX) ( FUNCTIONS FLATTEN-ARG MAX-ABS MIN-ABS) (FUNCTIONS %%MAP-FLOAT-ARRAY-ABS %%MAP-FLOAT-ARRAY-FLOAT %%MAP-FLOAT-ARRAY-MINUS %%MAP-FLOAT-ARRAY-NEGATE %%MAP-FLOAT-ARRAY-PLUS %%MAP-FLOAT-ARRAY-QUOTIENT %%MAP-FLOAT-ARRAY-TIMES %%MAP-FLOAT-ARRAY-TRUNCATE %%REDUCE-FLOAT-ARRAY-MAX %%REDUCE-FLOAT-ARRAY-MAX-ABS %%REDUCE-FLOAT-ARRAY-MIN %%REDUCE-FLOAT-ARRAY-MIN-ABS %%REDUCE-FLOAT-ARRAY-PLUS %%REDUCE-FLOAT-ARRAY-TIMES) (* ;; "For convenience") (PROP FILETYPE CMLFLOATARRAY) (DECLARE%: DONTEVAL@LOAD DOEVAL@COMPILE DONTCOPY (LOCALVARS . T)) (DECLARE%: DONTEVAL@LOAD DOEVAL@COMPILE DONTCOPY COMPILERVARS (ADDVARS (NLAMA) (NLAML) (LAMA MAP-ARRAY))))) (CL:DEFUN MAP-ARRAY-1 (RESULT MAPFN ARRAY) (* ;; "Does something fast for MAPFNS - abs truncate float and EXPONENT. ARRAY is always an array.") (LET (( RESULT-FLOAT-P (EQ (CL:ARRAY-ELEMENT-TYPE RESULT) (QUOTE CL:SINGLE-FLOAT))) (ARRAY-FLOAT-P (EQ ( CL:ARRAY-ELEMENT-TYPE ARRAY) (QUOTE CL:SINGLE-FLOAT)))) (* ; "Coerce MAPFN to standard form") (SETQ MAPFN (CL:TYPECASE MAPFN (CL:SYMBOL (CASE MAPFN (MINUS (QUOTE -)) (FIX (QUOTE CL:TRUNCATE)) (T MAPFN)) ) (COMPILED-CLOSURE (COND ((OR (CL::%%EQCODEP MAPFN (QUOTE -)) (CL::%%EQCODEP MAPFN (QUOTE MINUS))) ( QUOTE -)) ((CL::%%EQCODEP MAPFN (QUOTE ABS)) (QUOTE ABS)) ((OR (CL::%%EQCODEP MAPFN (QUOTE FIX)) ( CL::%%EQCODEP MAPFN (QUOTE CL:TRUNCATE))) (QUOTE CL:TRUNCATE)) ((CL::%%EQCODEP MAPFN (QUOTE FLOAT)) ( QUOTE FLOAT)) (T MAPFN))) (T MAPFN))) (COND ((AND (EQ MAPFN (QUOTE -)) RESULT-FLOAT-P ARRAY-FLOAT-P) ( %%MAP-FLOAT-ARRAY-NEGATE RESULT ARRAY)) ((AND (EQ MAPFN (QUOTE ABS)) RESULT-FLOAT-P ARRAY-FLOAT-P) ( %%MAP-FLOAT-ARRAY-ABS RESULT ARRAY)) ((AND (EQ MAPFN (QUOTE CL:TRUNCATE)) ARRAY-FLOAT-P) ( %%MAP-FLOAT-ARRAY-TRUNCATE RESULT ARRAY)) ((AND (EQ MAPFN (QUOTE FLOAT)) RESULT-FLOAT-P) ( %%MAP-FLOAT-ARRAY-FLOAT RESULT ARRAY)) (T (LET ((FLATTENED-RESULT (FLATTEN-ARG RESULT)) ( FLATTENED-ARRAY (FLATTEN-ARG ARRAY))) (CL:DOTIMES (INDEX (CL:ARRAY-TOTAL-SIZE RESULT) RESULT) (CL:SETF (CL:AREF FLATTENED-RESULT INDEX) (CL:FUNCALL MAPFN (CL:AREF FLATTENED-ARRAY INDEX))))))))) (CL:DEFUN MAP-ARRAY-2 (RESULT MAPFN ARRAY-1 ARRAY-2) (* ;; "Does something fast for MAPFNS + - * /. At least one of ARRAY-1 and ARRAY-2 is an array") (LET (( ARRAYS-FLOAT-P (AND (EQ (CL:ARRAY-ELEMENT-TYPE RESULT) (QUOTE CL:SINGLE-FLOAT)) (OR (TYPEP ARRAY-1 ( QUOTE (CL:ARRAY CL:SINGLE-FLOAT))) (TYPEP ARRAY-1 (QUOTE (OR FLOAT CL:RATIONAL)))) (OR (TYPEP ARRAY-2 (QUOTE (CL:ARRAY CL:SINGLE-FLOAT))) (TYPEP ARRAY-2 (QUOTE (OR FLOAT CL:RATIONAL))))))) (* ; "Coerce MAPFN to standard form") (SETQ MAPFN (CL:TYPECASE MAPFN (CL:SYMBOL (CASE MAPFN (PLUS (QUOTE +) ) (MINUS (QUOTE -)) (TIMES (QUOTE CL:*)) (QUOTIENT (QUOTE /)) (T MAPFN))) (COMPILED-CLOSURE (COND ((OR (CL::%%EQCODEP MAPFN (QUOTE +)) (CL::%%EQCODEP MAPFN (QUOTE PLUS))) (QUOTE +)) ((OR (CL::%%EQCODEP MAPFN (QUOTE -)) (CL::%%EQCODEP MAPFN (QUOTE MINUS))) (QUOTE -)) ((OR (CL::%%EQCODEP MAPFN (QUOTE CL:* )) (CL::%%EQCODEP MAPFN (QUOTE TIMES))) (QUOTE CL:*)) ((OR (CL::%%EQCODEP MAPFN (QUOTE /)) ( CL::%%EQCODEP MAPFN (QUOTE QUOTIENT))) (QUOTE /)) (T MAPFN))) (T MAPFN))) (COND ((AND (EQ MAPFN (QUOTE +)) ARRAYS-FLOAT-P) (%%MAP-FLOAT-ARRAY-PLUS RESULT ARRAY-1 ARRAY-2)) ((AND (EQ MAPFN (QUOTE -)) ARRAYS-FLOAT-P) (%%MAP-FLOAT-ARRAY-MINUS RESULT ARRAY-1 ARRAY-2)) ((AND (EQ MAPFN (QUOTE CL:*)) ARRAYS-FLOAT-P) (%%MAP-FLOAT-ARRAY-TIMES RESULT ARRAY-1 ARRAY-2)) ((AND (EQ MAPFN (QUOTE /)) ARRAYS-FLOAT-P) (%%MAP-FLOAT-ARRAY-QUOTIENT RESULT ARRAY-1 ARRAY-2)) (T (LET ((FLATTENED-RESULT ( FLATTEN-ARG RESULT)) (FLATTENED-ARRAY-1 (FLATTEN-ARG ARRAY-1)) (FLATTENED-ARRAY-2 (FLATTEN-ARG ARRAY-2 ))) (CL:IF (CL:ARRAYP ARRAY-1) (CL:IF (CL:ARRAYP ARRAY-2) (CL:DOTIMES (INDEX (CL:ARRAY-TOTAL-SIZE RESULT) RESULT) (CL:SETF (CL:AREF FLATTENED-RESULT INDEX) (CL:FUNCALL MAPFN (CL:AREF FLATTENED-ARRAY-1 INDEX) (CL:AREF FLATTENED-ARRAY-2 INDEX)))) (CL:DOTIMES (INDEX (CL:ARRAY-TOTAL-SIZE RESULT) RESULT) ( CL:SETF (CL:AREF FLATTENED-RESULT INDEX) (CL:FUNCALL MAPFN (CL:AREF FLATTENED-ARRAY-1 INDEX) FLATTENED-ARRAY-2)))) (CL:DOTIMES (INDEX (CL:ARRAY-TOTAL-SIZE RESULT) RESULT) (CL:SETF (CL:AREF FLATTENED-RESULT INDEX) (CL:FUNCALL MAPFN FLATTENED-ARRAY-1 (CL:AREF FLATTENED-ARRAY-2 INDEX)))))))))) (CL:DEFUN REDUCE-ARRAY (REDUCTION-FN ARRAY &OPTIONAL (INITIAL-VALUE NIL INITIAL-VALUE-P)) (SETQ REDUCTION-FN (CL:TYPECASE REDUCTION-FN (CL:SYMBOL (CASE REDUCTION-FN (PLUS (QUOTE +)) (TIMES (QUOTE CL:* )) (T REDUCTION-FN))) (COMPILED-CLOSURE (COND ((OR (CL::%%EQCODEP REDUCTION-FN (QUOTE +)) (CL::%%EQCODEP REDUCTION-FN (QUOTE PLUS))) (QUOTE +)) ((OR (CL::%%EQCODEP REDUCTION-FN (QUOTE CL:*)) (CL::%%EQCODEP REDUCTION-FN (QUOTE TIMES))) (QUOTE CL:*)) ((CL::%%EQCODEP REDUCTION-FN (QUOTE MIN)) (QUOTE MIN)) (( CL::%%EQCODEP REDUCTION-FN (QUOTE MAX)) (QUOTE MAX)) ((CL::%%EQCODEP REDUCTION-FN (QUOTE MIN-ABS)) ( QUOTE MIN-ABS)) ((CL::%%EQCODEP REDUCTION-FN (QUOTE MAX-ABS)) (QUOTE MAX-ABS)) (T REDUCTION-FN))) (T REDUCTION-FN))) (CL:IF (NOT (CL:ARRAYP ARRAY)) (CL:IF INITIAL-VALUE-P (CL:FUNCALL REDUCTION-FN INITIAL-VALUE ARRAY) ARRAY) (LET ((SIZE (CL:ARRAY-TOTAL-SIZE ARRAY)) (ARRAY-FLOAT-P (EQ ( CL:ARRAY-ELEMENT-TYPE ARRAY) (QUOTE CL:SINGLE-FLOAT)))) (CASE SIZE (0 (CL:IF INITIAL-VALUE-P INITIAL-VALUE (CL:FUNCALL REDUCTION-FN))) (1 (CL:IF INITIAL-VALUE-P (CL:FUNCALL REDUCTION-FN INITIAL-VALUE (CL:AREF (FLATTEN-ARG ARRAY) 0)) (CL:AREF (FLATTEN-ARG ARRAY) 0))) (T (COND ((AND (EQ REDUCTION-FN (QUOTE +)) ARRAY-FLOAT-P) (%%REDUCE-FLOAT-ARRAY-PLUS ARRAY INITIAL-VALUE)) ((AND (EQ REDUCTION-FN (QUOTE CL:*)) ARRAY-FLOAT-P) (%%REDUCE-FLOAT-ARRAY-TIMES ARRAY INITIAL-VALUE)) ((AND (EQ REDUCTION-FN (QUOTE MIN)) ARRAY-FLOAT-P) (%%REDUCE-FLOAT-ARRAY-MIN ARRAY INITIAL-VALUE)) ((AND (EQ REDUCTION-FN (QUOTE MAX)) ARRAY-FLOAT-P) (%%REDUCE-FLOAT-ARRAY-MAX ARRAY INITIAL-VALUE)) ((AND (EQ REDUCTION-FN (QUOTE MIN-ABS)) ARRAY-FLOAT-P) (%%REDUCE-FLOAT-ARRAY-MIN-ABS ARRAY INITIAL-VALUE)) ((AND (EQ REDUCTION-FN (QUOTE MAX-ABS)) ARRAY-FLOAT-P) (%%REDUCE-FLOAT-ARRAY-MAX-ABS ARRAY INITIAL-VALUE)) (T (CL:DO* ((FLATTENED-ARRAY (FLATTEN-ARG ARRAY)) (ACCUMULATOR (CL:IF INITIAL-VALUE-P INITIAL-VALUE ( CL:AREF FLATTENED-ARRAY 0))) (INDEX (CL:IF INITIAL-VALUE-P 0 1) (CL:1+ INDEX))) ((EQ INDEX SIZE) ACCUMULATOR) (SETQ ACCUMULATOR (CL:FUNCALL REDUCTION-FN ACCUMULATOR (CL:AREF FLATTENED-ARRAY INDEX)))) ))))))) (CL:DEFUN EVALUATE-POLYNOMIAL (X COEFFICIENTS) (CL:IF (NOT (CL:ARRAYP COEFFICIENTS)) (CL:ERROR "Not an array: ~S" COEFFICIENTS) (CL:IF (EQ (CL:ARRAY-ELEMENT-TYPE COEFFICIENTS) (QUOTE CL:SINGLE-FLOAT )) (%%POLY-EVAL (FLOAT X) (%%GET-FLOAT-ARRAY-BASE COEFFICIENTS) (CL:1- (CL:ARRAY-TOTAL-SIZE COEFFICIENTS))) (CL:DO ((FLATTENED-ARRAY (FLATTEN-ARG COEFFICIENTS)) (INDEX 1 (CL:1+ INDEX)) (SIZE ( CL:ARRAY-TOTAL-SIZE COEFFICIENTS)) (PRODUCT (CL:AREF COEFFICIENTS 0))) ((EQ INDEX SIZE) PRODUCT) (SETQ PRODUCT (+ (CL:* X PRODUCT) (CL:AREF COEFFICIENTS INDEX))))))) (CL:DEFUN FIND-ARRAY-ELEMENT-INDEX (ELEMENT ARRAY) (CL:IF (NOT (CL:ARRAYP ARRAY)) (CL:ERROR "Not an array: ~S" ARRAY) (CL:IF (EQ (CL:ARRAY-ELEMENT-TYPE ARRAY) (QUOTE CL:SINGLE-FLOAT)) (CL:DO (( BASE (%%GET-FLOAT-ARRAY-BASE ARRAY) (\ADDBASE BASE 2)) (INDEX 0 (CL:1+ INDEX)) (F-ELEMENT (FLOAT ELEMENT)) (SIZE (CL:ARRAY-TOTAL-SIZE ARRAY))) ((EQ INDEX SIZE) NIL) (DECLARE (TYPE FLOAT F-ELEMENT)) ( CL:IF (UFEQP F-ELEMENT (\GETBASEFLOATP BASE 0)) (RETURN INDEX))) (CL:DO ((FLATTENED-ARRAY (FLATTEN-ARG ARRAY)) (INDEX 0 (CL:1+ INDEX)) (SIZE (CL:ARRAY-TOTAL-SIZE ARRAY))) ((EQ INDEX SIZE) NIL) (CL:IF (EQL ELEMENT (CL:AREF FLATTENED-ARRAY INDEX)) (RETURN INDEX)))))) (CL:DEFUN FLATTEN-ARG (ARG) (CL:IF (OR (NOT (CL:ARRAYP ARG)) (EQ 1 (CL:ARRAY-RANK ARG))) ARG ( CL:MAKE-ARRAY (CL:ARRAY-TOTAL-SIZE ARG) :ELEMENT-TYPE (CL:ARRAY-ELEMENT-TYPE ARG) :DISPLACED-TO ARG))) (CL:DEFUN MAX-ABS (X Y) (CL:IF (> (ABS X) (ABS Y)) X Y)) (CL:DEFUN MIN-ABS (X Y) (CL:IF (< (ABS X) (ABS Y)) X Y)) (CL:DEFUN %%MAP-FLOAT-ARRAY-ABS (RESULT ARRAY) (CL:DO ((SIZE (CL:ARRAY-TOTAL-SIZE RESULT)) ( RESULT-BASE (%%GET-FLOAT-ARRAY-BASE RESULT) (\ADDBASE RESULT-BASE 2)) (ARRAY-BASE ( %%GET-FLOAT-ARRAY-BASE ARRAY) (\ADDBASE ARRAY-BASE 2)) (INDEX 0 (CL:1+ INDEX))) ((EQ INDEX SIZE) RESULT) (\PUTBASEFLOATP RESULT-BASE 0 (UFABS (\GETBASEFLOATP ARRAY-BASE 0))))) (CL:DEFUN %%MAP-FLOAT-ARRAY-FLOAT (RESULT ARRAY) (LET ((SIZE (CL:ARRAY-TOTAL-SIZE RESULT))) (CL:IF ( EQUAL (CL:ARRAY-ELEMENT-TYPE ARRAY) (QUOTE (CL:UNSIGNED-BYTE 16))) (%%BLKSMALLP2FLOAT ( %%GET-FLOAT-ARRAY-BASE ARRAY) (%%GET-FLOAT-ARRAY-BASE RESULT) SIZE) (CL:DO ((RESULT-BASE ( %%GET-FLOAT-ARRAY-BASE RESULT) (\ADDBASE RESULT-BASE 2)) (INDEX 0 (CL:1+ INDEX))) ((EQ INDEX SIZE)) ( \PUTBASEFLOATP RESULT-BASE 0 (FLOAT (CL:AREF ARRAY INDEX))))) RESULT)) (CL:DEFUN %%MAP-FLOAT-ARRAY-MINUS (RESULT ARRAY-1 ARRAY-2) (CL:IF (CL:ARRAYP ARRAY-1) (CL:IF (CL:ARRAYP ARRAY-2) (%%BLKFDIFF (%%GET-FLOAT-ARRAY-BASE ARRAY-1) (%%GET-FLOAT-ARRAY-BASE ARRAY-2) ( %%GET-FLOAT-ARRAY-BASE RESULT) (CL:ARRAY-TOTAL-SIZE RESULT)) (CL:DO ((SIZE (CL:ARRAY-TOTAL-SIZE RESULT )) (RESULT-BASE (%%GET-FLOAT-ARRAY-BASE RESULT) (\ADDBASE RESULT-BASE 2)) (ARRAY-1-BASE ( %%GET-FLOAT-ARRAY-BASE ARRAY-1) (\ADDBASE ARRAY-1-BASE 2)) (SCALAR (FLOAT ARRAY-2)) (INDEX 0 (CL:1+ INDEX))) ((EQ INDEX SIZE)) (DECLARE (TYPE FLOATP SCALAR)) (\PUTBASEFLOATP RESULT-BASE 0 (FDIFFERENCE ( \GETBASEFLOATP ARRAY-1-BASE 0) SCALAR)))) (CL:DO ((SIZE (CL:ARRAY-TOTAL-SIZE RESULT)) (RESULT-BASE ( %%GET-FLOAT-ARRAY-BASE RESULT) (\ADDBASE RESULT-BASE 2)) (SCALAR (FLOAT ARRAY-1)) (ARRAY-2-BASE ( %%GET-FLOAT-ARRAY-BASE ARRAY-2) (\ADDBASE ARRAY-2-BASE 2)) (INDEX 0 (CL:1+ INDEX))) ((EQ INDEX SIZE)) (DECLARE (TYPE FLOATP SCALAR)) (\PUTBASEFLOATP RESULT-BASE 0 (FDIFFERENCE SCALAR (\GETBASEFLOATP ARRAY-2-BASE 0))))) RESULT) (CL:DEFUN %%MAP-FLOAT-ARRAY-NEGATE (RESULT ARRAY) (CL:DO ((SIZE (CL:ARRAY-TOTAL-SIZE RESULT)) ( RESULT-BASE (%%GET-FLOAT-ARRAY-BASE RESULT) (\ADDBASE RESULT-BASE 2)) (ARRAY-BASE ( %%GET-FLOAT-ARRAY-BASE ARRAY) (\ADDBASE ARRAY-BASE 2)) (INDEX 0 (CL:1+ INDEX))) ((EQ INDEX SIZE) RESULT) (\PUTBASEFLOATP RESULT-BASE 0 (UFMINUS (\GETBASEFLOATP ARRAY-BASE 0))))) (CL:DEFUN %%MAP-FLOAT-ARRAY-PLUS (RESULT ARRAY-1 ARRAY-2) (CL:IF (NOT (CL:ARRAYP ARRAY-1)) (CL:ROTATEF ARRAY-1 ARRAY-2)) (* ; "addition is commutative") (CL:IF (CL:ARRAYP ARRAY-2) (%%BLKFPLUS ( %%GET-FLOAT-ARRAY-BASE ARRAY-1) (%%GET-FLOAT-ARRAY-BASE ARRAY-2) (%%GET-FLOAT-ARRAY-BASE RESULT) ( CL:ARRAY-TOTAL-SIZE RESULT)) (CL:DO ((SIZE (CL:ARRAY-TOTAL-SIZE RESULT)) (RESULT-BASE ( %%GET-FLOAT-ARRAY-BASE RESULT) (\ADDBASE RESULT-BASE 2)) (ARRAY-1-BASE (%%GET-FLOAT-ARRAY-BASE ARRAY-1 ) (\ADDBASE ARRAY-1-BASE 2)) (SCALAR (FLOAT ARRAY-2)) (INDEX 0 (CL:1+ INDEX))) ((EQ INDEX SIZE)) ( DECLARE (TYPE FLOATP SCALAR)) (\PUTBASEFLOATP RESULT-BASE 0 (FPLUS (\GETBASEFLOATP ARRAY-1-BASE 0) SCALAR)))) RESULT) (CL:DEFUN %%MAP-FLOAT-ARRAY-QUOTIENT (RESULT ARRAY-1 ARRAY-2) (CL:IF (CL:ARRAYP ARRAY-1) (CL:IF ( CL:ARRAYP ARRAY-2) (CL:DO ((SIZE (CL:ARRAY-TOTAL-SIZE RESULT)) (RESULT-BASE (%%GET-FLOAT-ARRAY-BASE RESULT) (\ADDBASE RESULT-BASE 2)) (ARRAY-1-BASE (%%GET-FLOAT-ARRAY-BASE ARRAY-1) (\ADDBASE ARRAY-1-BASE 2)) (ARRAY-2-BASE (%%GET-FLOAT-ARRAY-BASE ARRAY-2) (\ADDBASE ARRAY-1-BASE 2)) (INDEX 0 ( CL:1+ INDEX))) ((EQ INDEX SIZE)) (\PUTBASEFLOATP RESULT-BASE 0 (FQUOTIENT (\GETBASEFLOATP ARRAY-1-BASE 0) (\GETBASEFLOATP ARRAY-2-BASE 0)))) (CL:DO ((SIZE (CL:ARRAY-TOTAL-SIZE RESULT)) (RESULT-BASE ( %%GET-FLOAT-ARRAY-BASE RESULT) (\ADDBASE RESULT-BASE 2)) (ARRAY-1-BASE (%%GET-FLOAT-ARRAY-BASE ARRAY-1 ) (\ADDBASE ARRAY-1-BASE 2)) (SCALAR (FLOAT ARRAY-2)) (INDEX 0 (CL:1+ INDEX))) ((EQ INDEX SIZE)) ( DECLARE (TYPE FLOATP SCALAR)) (\PUTBASEFLOATP RESULT-BASE 0 (FQUOTIENT (\GETBASEFLOATP ARRAY-1-BASE 0) SCALAR)))) (CL:DO ((SIZE (CL:ARRAY-TOTAL-SIZE RESULT)) (RESULT-BASE (%%GET-FLOAT-ARRAY-BASE RESULT) ( \ADDBASE RESULT-BASE 2)) (SCALAR (FLOAT ARRAY-1)) (ARRAY-2-BASE (%%GET-FLOAT-ARRAY-BASE ARRAY-2) ( \ADDBASE ARRAY-2-BASE 2)) (INDEX 0 (CL:1+ INDEX))) ((EQ INDEX SIZE)) (DECLARE (TYPE FLOATP SCALAR)) ( \PUTBASEFLOATP RESULT-BASE 0 (FQUOTIENT SCALAR (\GETBASEFLOATP ARRAY-2-BASE 0))))) RESULT) (CL:DEFUN %%MAP-FLOAT-ARRAY-TIMES (RESULT ARRAY-1 ARRAY-2) (CL:IF (NOT (CL:ARRAYP ARRAY-1)) (CL:ROTATEF ARRAY-1 ARRAY-2)) (* ; "Multiplication is commutative") (CL:IF (CL:ARRAYP ARRAY-2) (%%BLKFTIMES ( %%GET-FLOAT-ARRAY-BASE ARRAY-1) (%%GET-FLOAT-ARRAY-BASE ARRAY-2) (%%GET-FLOAT-ARRAY-BASE RESULT) ( CL:ARRAY-TOTAL-SIZE RESULT)) (CL:DO ((SIZE (CL:ARRAY-TOTAL-SIZE RESULT)) (RESULT-BASE ( %%GET-FLOAT-ARRAY-BASE RESULT) (\ADDBASE RESULT-BASE 2)) (ARRAY-1-BASE (%%GET-FLOAT-ARRAY-BASE ARRAY-1 ) (\ADDBASE ARRAY-1-BASE 2)) (SCALAR (FLOAT ARRAY-2)) (INDEX 0 (CL:1+ INDEX))) ((EQ INDEX SIZE)) ( DECLARE (TYPE FLOATP SCALAR)) (\PUTBASEFLOATP RESULT-BASE 0 (FTIMES (\GETBASEFLOATP ARRAY-1-BASE 0) SCALAR)))) RESULT) (CL:DEFUN %%MAP-FLOAT-ARRAY-TRUNCATE (RESULT ARRAY) (CL:DO ((SIZE (CL:ARRAY-TOTAL-SIZE RESULT)) ( ARRAY-BASE (%%GET-FLOAT-ARRAY-BASE ARRAY) (\ADDBASE ARRAY-BASE 2)) (INDEX 0 (CL:1+ INDEX))) ((EQ INDEX SIZE) RESULT) (CL:SETF (CL:AREF RESULT INDEX) (UFIX (\GETBASEFLOATP ARRAY-BASE 0))))) (CL:DEFUN %%REDUCE-FLOAT-ARRAY-MAX (ARRAY INITIAL-VALUE) (LET ((RESULT (CL:AREF ARRAY (%%BLKFMAX ( %%GET-FLOAT-ARRAY-BASE ARRAY) 0 (CL:ARRAY-TOTAL-SIZE ARRAY))))) (CL:IF INITIAL-VALUE (MAX INITIAL-VALUE RESULT) RESULT))) (CL:DEFUN %%REDUCE-FLOAT-ARRAY-MAX-ABS (ARRAY INITIAL-VALUE) (LET ((RESULT (CL:AREF ARRAY ( %%BLKFABSMAX (%%GET-FLOAT-ARRAY-BASE ARRAY) 0 (CL:ARRAY-TOTAL-SIZE ARRAY))))) (CL:IF INITIAL-VALUE ( MAX-ABS INITIAL-VALUE RESULT) RESULT))) (CL:DEFUN %%REDUCE-FLOAT-ARRAY-MIN (ARRAY INITIAL-VALUE) (LET ((RESULT (CL:AREF ARRAY (%%BLKFMIN ( %%GET-FLOAT-ARRAY-BASE ARRAY) 0 (CL:ARRAY-TOTAL-SIZE ARRAY))))) (CL:IF INITIAL-VALUE (MIN INITIAL-VALUE RESULT) RESULT))) (CL:DEFUN %%REDUCE-FLOAT-ARRAY-MIN-ABS (ARRAY INITIAL-VALUE) (LET ((RESULT (CL:AREF ARRAY ( %%BLKFABSMIN (%%GET-FLOAT-ARRAY-BASE ARRAY) 0 (CL:ARRAY-TOTAL-SIZE ARRAY))))) (CL:IF INITIAL-VALUE ( MIN-ABS INITIAL-VALUE RESULT) RESULT))) (CL:DEFUN %%REDUCE-FLOAT-ARRAY-PLUS (ARRAY INITIAL-VALUE) (LET ((RESULT (%%POLY-EVAL 1.0 ( %%GET-FLOAT-ARRAY-BASE ARRAY) (CL:1- (CL:ARRAY-TOTAL-SIZE ARRAY))))) (CL:IF INITIAL-VALUE (+ INITIAL-VALUE RESULT) RESULT))) (CL:DEFUN %%REDUCE-FLOAT-ARRAY-TIMES (ARRAY INITIAL-VALUE) (LET ((TOTAL 1.0)) (DECLARE (TYPE FLOAT TOTAL)) (CL:DO ((I 0 (CL:1+ I)) (BASE (%%GET-FLOAT-ARRAY-BASE ARRAY) (\ADDBASE BASE 2)) (SIZE ( CL:ARRAY-TOTAL-SIZE ARRAY))) ((EQ I SIZE) TOTAL) (SETQ TOTAL (CL:* TOTAL (\GETBASEFLOATP BASE 0)))) ( CL:IF INITIAL-VALUE (CL:* INITIAL-VALUE TOTAL) TOTAL))) (PUTPROPS CMLFLOATARRAY FILETYPE CL:COMPILE-FILE) (PUTPROPS CMLFLOATARRAY COPYRIGHT ("Venue & Xerox Corporation" 1985 1986 1987 1990 1993)) NIL