[Openmcl-cvs-notifications] r8989 - /trunk/source/lib/macros.lisp

[gb at clozure.com]

Author: gb
Date: Wed Apr  2 04:16:28 2008
New Revision: 8989

Log:
CHECK-TYPE: do the TYPEP call(s) inline, call (new) %CHECK-TYPE
to signal error and provide STORE-VALUE restart.

INGORING-EINTR: allow implicit PROGN, as suggested by use
of &BODY.

FF-CALL-IGNORING-EINTR: like IGNORING-EINTR, but assume that BODY
returns a C library result and we have to call %GET-ERRNO.



Modified:
    trunk/source/lib/macros.lisp

Modified: trunk/source/lib/macros.lisp
=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=
=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=
=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=
=3D=3D=3D
--- trunk/source/lib/macros.lisp (original)
+++ trunk/source/lib/macros.lisp Wed Apr  2 04:16:28 2008
@@ -2645,14 +2645,11 @@
   not of the specified type. If an error is signalled and the restart is
   used to return, this can only return if the STORE-VALUE restart is
   invoked. In that case it will store into PLACE and start over."
-  `(progn
-     (setf ,place =

-           (ensure-value-of-type =

-            ,place =

-            ',typespec =

-            ',place =

-            ,string))
-     nil))
+  (let* ((val (gensym)))
+    `(do* ((,val ,place ,place))
+          ((typep ,val ',typespec))
+      (setf ,place (%check-type ,val ',typespec ',place ,string)))))
+
 =

 =

 =

@@ -3553,7 +3550,17 @@
   (let* ((res (gensym))
          (eintr (symbol-value (read-from-string "#$EINTR"))))
     `(loop
-      (let* ((,res , at body))
+      (let* ((,res (progn , at body)))
+        (unless (eql ,res (- ,eintr))
+          (return ,res))))))
+
+(defmacro ff-call-ignoring-eintr (&body body)
+  (let* ((res (gensym))
+         (eintr (symbol-value (read-from-string "#$EINTR"))))
+    `(loop
+      (let* ((,res (progn , at body)))
+        (when (< ,res 0)
+          (setq ,res (%get-errno)))
         (unless (eql ,res (- ,eintr))
           (return ,res))))))
 =