(DEFINE-FILE-INFO READTABLE "XCL" PACKAGE "E-ARRAY")
(il:filecreated "15-Nov-88 18:49:18" il:{qv}<idl>next>e-array-float.\;2 3029
il:|changes| il:|to:| (xcl:file-environments "E-ARRAY-FLOAT") (il:vars il:e-array-floatcoms)
il:|previous| il:|date:| "17-Jan-88 14:58:20" il:{qv}<idl>next>e-array-float.\;1)
; Copyright (c) 1988 by Xerox Corporation. All rights reserved.
(il:prettycomprint il:e-array-floatcoms)
(il:rpaqq il:e-array-floatcoms ((il:declare\: il:dontcopy il:doeval@compile il:doeval@load (il:files il:cmlarray-support)) (il:functions mul2) (il:functions float-blt float-fill) (xcl:file-environments "E-ARRAY-FLOAT")))
(il:declare\: il:dontcopy il:doeval@compile il:doeval@load
(il:filesload il:cmlarray-support)
)
(defmacro mul2 (index) (il:bquote (il:llsh (il:\\\, index) 1)))
(defun float-blt (source source-iterator destination destination-iterator) (let ((source-base (il:%array-base source)) (destination-base (il:%array-base destination)) (dest-limit (mul2 (array-total-size destination))) (source-limit (mul2 (array-total-size source)))) (if (null source-iterator) (if (null destination-iterator) (il:* il:|;;| "(il:blas.arrayblt source 0 1 destination offset 1 cnt)") (let ((i 0) (j 0)) (loop (cond ((eq i dest-limit) (return nil)) ((eq j source-limit) (setq j 0))) (il:\\putbasefloatp destination-base i (il:\\getbasefloatp source-base j)) (incf i 2) (incf j 2))) (let (i (j 0)) (loop (cond ((null (setq i (next-index destination-iterator))) (return nil)) ((eq j source-limit) (setq j 0))) (il:\\putbasefloatp destination-base (mul2 i) (il:\\getbasefloatp source-base j)) (incf j 2)))) (if (null destination-iterator) (let ((i 0) j) (loop (cond ((eq i dest-limit) (return nil)) ((null (setq j (next-index source-iterator))) (setq j (next-index (reset-iterator source-iterator))))) (il:\\putbasefloatp destination-base i (il:\\getbasefloatp source-base (mul2 j))) (incf i 2))) (let (i j) (loop (cond ((null (setq i (next-index destination-iterator))) (return nil)) ((null (setq j (next-index source-iterator))) (setq j (next-index (reset-iterator source-iterator))))) (il:\\putbasefloatp destination-base (mul2 i) (il:\\getbasefloatp source-base (mul2 j))))))) destination))
(defun float-fill (scalar destination destination-iterator) (il:* il:|;;| "Must be Byte compiled ") (let ((fscalar (float scalar)) (destination-base (il:%array-base destination))) (declare (type float fscalar)) (if (null destination-iterator) (il:* il:|;;| "(il:blas.arrayfill scalar destination)") (do ((limit (mul2 (total-size destination))) (i 0 (+ i 2))) ((eq i limit)) (il:\\putbasefloatp destination-base i fscalar)) (let (index) (loop (if (null (setq index (next-index destination-iterator))) (return nil)) (il:\\putbasefloatp destination-base (mul2 index 1) fscalar))))) destination)
(xcl:define-file-environment "E-ARRAY-FLOAT" :package "E-ARRAY" :readtable "XCL" :compiler compile-file)
(il:putprops il:e-array-float il:copyright ("Xerox Corporation" 1988))
(il:declare\: il:dontcopy
(il:filemap (nil)))
il:stop