Index: /trunk/source/lib/macros.lisp
===================================================================
--- /trunk/source/lib/macros.lisp	(revision 14768)
+++ /trunk/source/lib/macros.lisp	(revision 14769)
@@ -3115,5 +3115,5 @@
                            `(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,5 +3209,25 @@
       ,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)