Re: openmcl patch

bryan o'connor <[email protected]> Tue, 9 Aug 2005 16:21:16 -0700
Newsgroups gmane.lisp.clx.devel
Message-ID <[email protected]>
--Apple-Mail-5--706411016
Content-Transfer-Encoding: 7bit
Content-Type: text/plain;
	charset=US-ASCII;
	format=flowed

and one more filling in some pieces in gl.lisp



--Apple-Mail-5--706411016
Content-Transfer-Encoding: 7bit
Content-Type: text/plain;
	x-unix-mode=0644;
	name="gl-openmcl.patch.txt"
Content-Disposition: attachment;
	filename=gl-openmcl.patch.txt

--- old-clx/gl.lisp	2005-08-09 16:19:29.000000000 -0700
+++ new-clx/gl.lisp	2005-08-09 16:19:29.000000000 -0700
@@ -2121,6 +2121,18 @@
   value)
 
 
+#+openmcl
+(defun aset-float32 (value array index)
+  (declare (type single-float value)
+           (type buffer-bytes array)
+           (type array-index index))
+  #.(declare-buffun)
+  (let ((bits (ccl::single-float-bits value)))
+    (declare (type (unsigned-byte 32) bits))
+    (aset-card32 bits array index))
+  value)
+
+
 #+sbcl
 (defun aset-float64 (value array index)
   (declare (type double-float value)
@@ -2149,6 +2161,20 @@
   value)
 
 
+#+openmcl
+(defun aset-float64 (value array index)
+  (declare (type double-float value)
+           (type buffer-bytes array)
+           (type array-index index))
+  #.(declare-buffun)
+  (multiple-value-bind (low high)
+      (ccl::double-float-bits value)
+    (declare (type (unsigned-byte 32) low high))
+    (aset-card32 low array index)
+    (aset-card32 high array (the array-index (+ index 4))))
+  value)
+
+
 (eval-when (:compile-toplevel :load-toplevel :execute)
 (defun byte-width (type)
   (ecase type


--Apple-Mail-5--706411016
Content-Transfer-Encoding: 7bit
Content-Type: text/plain;
	charset=US-ASCII;
	format=flowed




--Apple-Mail-5--706411016--

_______________________________________________
Portable-clx mailing list
[email protected]
http://lists.metacircles.com/cgi-bin/mailman/listinfo/portable-clx
cvs -d :ext:cvs.telent.net:/usr/local/src/cvs co clx  # over ssh
cvs -d :pserver:[email protected]:/cvs co clx  # anonymous