[movitz-cvs] CVS update: movitz/losp/muerte/basic-macros.lisp

[Frode Vatvedt Fjeld]

Update of /project/movitz/cvsroot/movitz/losp/muerte
In directory common-lisp.net:/tmp/cvs-serv13377

Modified Files:
	basic-macros.lisp 
Log Message:
Added macro unbound-protect.

Date: Mon May  2 23:33:30 2005
Author: ffjeld

Index: movitz/losp/muerte/basic-macros.lisp
diff -u movitz/losp/muerte/basic-macros.lisp:1.58 movitz/losp/muerte/basic-macros.lisp:1.59
--- movitz/losp/muerte/basic-macros.lisp:1.58	Wed Apr 27 01:45:00 2005
+++ movitz/losp/muerte/basic-macros.lisp	Mon May  2 23:33:29 2005
@@ -9,7 +9,7 @@
 ;;;; Created at:    Wed Nov  8 18:44:57 2000
 ;;;; Distribution:  See the accompanying file COPYING.
 ;;;;                
-;;;; $Id: basic-macros.lisp,v 1.58 2005/04/26 23:45:00 ffjeld Exp $
+;;;; $Id: basic-macros.lisp,v 1.59 2005/05/02 21:33:29 ffjeld Exp $
 ;;;;                
 ;;;;------------------------------------------------------------------
 
@@ -688,6 +688,26 @@
     (0 nil)
     (1 `(cons ,(car elements) nil))
     (t form)))
+
+
+(defmacro unbound-protect (x &optional error-continuation &environment env)
+  (cond
+   ((movitz:movitz-constantp x env)
+    `(values ,x))
+   (movitz::*compiler-use-into-unbound-protocol*
+    (let ((unbound-continue (gensym "unbound-continue-")))
+      `(with-inline-assembly (:returns :register)
+	 (:compile-form (:result-mode :register) ,x)
+	 (:cmpl -1 (:result-register))
+	 (:jo '(:sub-program (unbound)
+		(:compile-form (:result-mode :eax) ,error-continuation)
+		(:jmp ',unbound-continue)))
+	 ,unbound-continue)))
+   (t (let ((var (gensym)))
+	`(let ((,var ,x))
+	   (if (not (eq ,var (load-global-constant new-unbound-value)))
+	       ,var
+	     ,error-continuation))))))
 
 #+ignore
 (define-compiler-macro apply (&whole form function &rest args)