[Openmcl-devel] non-consing short float trap parameters
james anderson
janderson at ravenpack.com
Mon Mar 6 15:07:27 UTC 2006
hello;
i am working to make some graphics code cons less.
in general, i can get through a transformation pipeline w/o consing,
but when i get to the bottom, calls through the respective graphic
system's interface tend to generate gratuitous garbage.
the pipeline works with resourced double-float vectors and matrices.
in the case of open-gl, which accept doubles, i can get the location
coordiantes through the interface for free by simply indirecting
through stacked double floats with dynamic extent.
short floats, which core graphics likes, are a different story
mr altosaar's recent enquiries about mach-o traps caused me to look
again at the interface to core-graphics. the enclosed macro,
auxiliary function, and example graphics operator show what i found
to be necessary to get short floats out of simple double-float
vectors and through a trap call without consing.
i have two questions
?1 for mcl, are all these contortions really necessary?
for doubles, i observer that (setf <stacked-double> (aref <simple
double vector> i)) is space-free, but the same does not apply to a
double-to-short transfer.
it would be really nice to be able to expect (setf <y> (float <x>
<type>)) to be coded inline and without consing for dynamic extent
targets, but i found no other combination, than that which follows,
which would move the bits for free.
?2, for open-mcl, i note that this is code from mcl-5.1, but ask
whether the same situation applies to open-mcl.
------------------------
(defvar *location-vector-type*
(type-of (make-array 4 :initial-element 0.0d0 :element-type
'double-float)))
(deftype short-location-vector ()
"a (4) short float simple array intended to hold location
coordinates."
*short-location-vector-type*)
;;; analogous definitions for short location vectors
(ccl:defrecord :single-float-coordinate
(:float :single-float :default 0.0s0))
(defun %copy-location-to-short-coordinates (location x y &optional z h)
(declare (type short-float x y))
(let ((tmp-double 0.0d0)
(tmp-short 0.0s0))
(declare (dynamic-extent tmp-double tmp-short)
(type double-float tmp-double)
(type short-float tmp-short))
(rlet ((%tmp-single-coordinate :single-float-coordinate))
(ecase (array-element-type location)
(double-float
(locally (declare (type location-vector location))
(setf tmp-double (aref location 0))
(ccl::%set-ieee-single-float-from-double tmp-double %tmp-
single-coordinate)
(ccl::%ref-ieee-single-float %tmp-single-coordinate x)
(setf tmp-double (aref location 1))
(ccl::%set-ieee-single-float-from-double tmp-double %tmp-
single-coordinate)
(ccl::%ref-ieee-single-float %tmp-single-coordinate y)
(when z
(locally (declare (type short-float z))
(setf tmp-double (aref location 2))
(ccl::%set-ieee-single-float-from-double tmp-double %
tmp-single-coordinate)
(ccl::%ref-ieee-single-float %tmp-single-coordinate z))
(when h
(locally (declare (type short-float h))
(setf tmp-double (aref location 3))
(ccl::%set-ieee-single-float-from-double tmp-double
%tmp-single-coordinate)
(ccl::%ref-ieee-single-float %tmp-single-coordinate
h))))))
(short-float
(locally (declare (type short-location-vector location))
(setf tmp-short (aref location 0))
(ccl::%set-ieee-single-float tmp-short %tmp-single-
coordinate)
(ccl::%ref-ieee-single-float %tmp-single-coordinate x)
(setf tmp-short (aref location 1))
(ccl::%set-ieee-single-float tmp-short %tmp-single-
coordinate)
(ccl::%ref-ieee-single-float %tmp-single-coordinate y)
(when z
(locally (declare (type short-float z))
(setf tmp-short (aref location 2))
(ccl::%set-ieee-single-float tmp-short %tmp-single-
coordinate)
(ccl::%ref-ieee-single-float %tmp-single-coordinate z))
(when h
(locally (declare (type short-float h))
(setf tmp-short (aref location 3))
(ccl::%set-ieee-single-float tmp-short %tmp-single-
coordinate)
(ccl::%ref-ieee-single-float %tmp-single-coordinate
h))))))))))
(defmacro with-short-location-coordinates (bindings &rest body)
"establish dynamic bindings for the components of a location-
vector as short
floats."
(let ((short-variables nil))
`(let ,(reduce #'append
(mapcar #'(lambda (binding)
(destructuring-bind (location &rest
coordinates) binding
(declare (ignore location))
(mapcar #'(lambda (name)
(push name short-
variables)
`(,name 0.0s0))
coordinates)))
bindings))
(declare (type short-float ,@(reverse short-variables))
(dynamic-extent ,@(reverse short-variables)))
,@(remove nil (mapcar #'(lambda (binding)
(cons '%copy-location-to-short-
coordinates binding))
bindings))
, at body)))
(defun core-graphics-line-ndc (cgcontextref l1 l2 properties)
"draw a line given the ndc endpoints"
(declare (type location-vector l1 l2))
#+og.assert-types (progn (assert-type cgcontextref cgcontextref)
(assert-types (l1 l2) location-vector)
(assert-type properties sequence))
(with-short-location-coordinates ((l1 x1 y1) (l2 x2 y2))
(#_CGContextBeginPath cgcontextref)
(#_CGContextMoveToPoint cgcontextref x1 y1)
(#_CGContextAddLineToPoint cgcontextref x2 y2)
;; don't close a line (#_CGContextClosePath cgcontextref)
(flet ((line-geometry ()
(#_CGContextDrawPath cgcontextref *core-graphics-path-
drawing-mode-value*)))
(declare (dynamic-extent #'line-geometry))
(call-with-projection-variables #'line-geometry properties))))
whereby the
(with-short-location-coordinates ((l1 x1 y1) (l2 x2 y2))
... )
expands to
(LET ((X1 0.0S0) (Y1 0.0S0) (X2 0.0S0) (Y2 0.0S0))
(DECLARE (TYPE SHORT-FLOAT X1 Y1 X2 Y2) (DYNAMIC-EXTENT X1 Y1 X2
Y2))
(%COPY-LOCATION-TO-SHORT-COORDINATES L1 X1 Y1)
(%COPY-LOCATION-TO-SHORT-COORDINATES L2 X2 Y2)
... )
...
More information about the Openmcl-devel
mailing list