Changeset 14769

Timestamp:

May 2, 2011, 11:31:56 AM (14 years ago)

Author:

Gary Byers

Message:

In RLET, just use (setf uvref) to set the type ordinal.

New macros (that should probably have better names): WITH-CONSTRAINED-{SINGLE,DOUBLE}-FLOATS:
stack-allocate a vector of the indicated type, define symbol-macros to refer to its elements.
(Have spoken about getting the compiler to do something similar, without symbol-macro issues.)

File:

• trunk/source/lib/macros.lisp (modified) (2 diffs)

trunk/source/lib/macros.lisp

@@ -3115 +3115 @@
                            `(foreign-type-ordinal (load-time-value (%foreign-type-or-record ',record-name))))))
       (when (eq *host-backend* *target-backend*)
-        (setq result (nconc result `((%set-macptr-type ,name ,ordinal-form)))))
+        (setq result (nconc result `((setf (uvref ,name target::macptr.type-cell) ,ordinal-form)))))
       (if (typep ftype 'foreign-record-type)
         (setq result
@@ -3209 +3209 @@
       ,ptr)))
 
-    
+(defun with-constrained-values (type specs body env)
+  (multiple-value-bind (body decls) (parse-body body env)
+    (collect ((inits))
+      (dolist (spec specs)
+        (when (cdr spec)
+          (inits `(setq ,(car spec) ,(cadr spec)))))        
+  (let* ((vector (gensym))
+         (idx -1))
+    `(let* ((,vector (make-array ,(length specs) :element-type ',type)))
+      (declare (dynamic-extent ,vector))
+      (symbol-macrolet ,(mapcar (lambda (spec) `(,(car spec) (aref ,vector ,(incf idx)))) specs)
+        ,@decls
+        ,@(inits)
+        ,@body))))))  
+
+(defmacro with-constrained-double-floats (specs &body body &environment env)
+  (with-constrained-values 'double-float specs body env))
+
+
+(defmacro with-constrained-single-floats (specs &body body &environment env)
+  (with-constrained-values 'single-float specs body env))
 
 (defmacro with-terminal-input (&body body)