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

[Frode Vatvedt Fjeld]

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

Modified Files:
	more-macros.lisp 
Log Message:
Started support for stack-allocating functions (of dynamic
extent). Primary purpose is to evaluate e.g. handler-case without
having to cons up a function for each handler.

Date: Mon Jan  3 12:56:16 2005
Author: ffjeld

Index: movitz/losp/muerte/more-macros.lisp
diff -u movitz/losp/muerte/more-macros.lisp:1.22 movitz/losp/muerte/more-macros.lisp:1.23
--- movitz/losp/muerte/more-macros.lisp:1.22	Thu Dec  9 15:20:43 2004
+++ movitz/losp/muerte/more-macros.lisp	Mon Jan  3 12:56:14 2005
@@ -10,7 +10,7 @@
 ;;;; Author:        Frode Vatvedt Fjeld <frodef at acm.org>
 ;;;; Created at:    Fri Jun  7 15:05:57 2002
 ;;;;                
-;;;; $Id: more-macros.lisp,v 1.22 2004/12/09 14:20:43 ffjeld Exp $
+;;;; $Id: more-macros.lisp,v 1.23 2005/01/03 11:56:14 ffjeld Exp $
 ;;;;                
 ;;;;------------------------------------------------------------------
 
@@ -104,10 +104,10 @@
 		   (return t))))))))))
 
 (define-compiler-macro dotimes (&whole form-decline (var count-form &optional result-form)
-				&body declarations-and-body)
-  (if (not (movitz:movitz-constantp count-form))
+				&body declarations-and-body &environment env)
+  (if (not (movitz:movitz-constantp count-form env))
       form-decline
-    (let ((count (movitz::eval-form count-form)))
+    (let ((count (movitz:movitz-eval count-form env)))
       (check-type count (integer 0 *))
       (cond
        ((= 0 count)
@@ -236,8 +236,6 @@
 	   , at body)
        (setf (muerte::%run-time-context-slot 'bochs-flags) old-flags))))
 
-  
-  
 
 (defmacro handler-bind (bindings &body forms)
   (if (null bindings)
@@ -245,31 +243,14 @@
     (labels ((make-handler (binding)
 	       (destructuring-bind (type handler)
 		   binding
-		 (cond
-		  #+ignore
-		  ((and (listp handler)
-			(eq 'lambda (first handler))
-			(= 1 (length (second handler))))
-		   `(cons t (lambda (x)
-			      (when (typep x ',type)
-				(let ((,(first (second handler)) x))
-				  ,@(cddr handler)))
-			      nil)))
-		  #+ignore
-		  ((and (listp handler)
-			(eq 'function (first handler))
-			(listp (second handler))
-			(eq 'lambda (first (second handler)))
-			(= 1 (length (second (second handler)))))
-		   (make-handler (list type (second handler))))
-		  (t `(cons ',type ,handler))))))
-      `(let ((*active-condition-handlers*
-	      (cons (list ,@(mapcar #'make-handler #+ignore (lambda (binding)
-							      `(cons ',(first binding)
-								     ,(second binding)))
-				    bindings))
-		    *active-condition-handlers*)))
-	 , at forms))))
+		 `(cons ',type ,handler))))
+      (let ((scope-tag (gensym "handler-bind-extent-scope-")))
+	`(with-dynamic-extent-scope (,scope-tag)
+	   (let ((*active-condition-handlers*
+		  (with-dynamic-extent-allocation (,scope-tag)
+		    (cons (list ,@(mapcar #'make-handler bindings))
+			  *active-condition-handlers*))))
+	     , at forms))))))
 
 (defmacro handler-case (expression &rest clauses)
   (multiple-value-bind (normal-clauses no-error-clauses)