[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-serv11165

Modified Files:
	basic-macros.lisp 
Log Message:
Added -non-header variation of the malloc primitive-functions.

Date: Thu Nov 25 17:45:37 2004
Author: ffjeld

Index: movitz/losp/muerte/basic-macros.lisp
diff -u movitz/losp/muerte/basic-macros.lisp:1.50 movitz/losp/muerte/basic-macros.lisp:1.51
--- movitz/losp/muerte/basic-macros.lisp:1.50	Tue Nov 23 17:02:34 2004
+++ movitz/losp/muerte/basic-macros.lisp	Thu Nov 25 17:45:33 2004
@@ -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.50 2004/11/23 16:02:34 ffjeld Exp $
+;;;; $Id: basic-macros.lisp,v 1.51 2004/11/25 16:45:33 ffjeld Exp $
 ;;;;                
 ;;;;------------------------------------------------------------------
 
@@ -1109,7 +1109,34 @@
 	 , at code
 	 ,@(when fixed-size-p
 	     `((:load-lexical (:lexical-binding ,size-var) :ecx)))
-	 (:call-local-pf cons-commit)
+	 (:call-local-pf cons-commit-non-pointer)
+	 (:locally (:movl 0 (:edi (:edi-offset atomically-continuation))))
+	 (:leal (:esp 16) :esp)))))
+
+(defmacro with-non-header-allocation-assembly
+    ((size-form &key object-register size-register fixed-size-p labels) &body code)
+  (assert (eq object-register :eax))
+  (assert (or fixed-size-p (eq size-register :ecx)))
+  (let ((size-var (gensym "malloc-size-")))
+    `(let ((,size-var ,size-form))
+       (with-inline-assembly (:returns :eax :labels (retry-alloc retry-jumper , at labels))
+	 (:declare-label-set retry-jumper (retry-alloc))
+	 ;; Set up atomically continuation.
+	 (:locally (:pushl (:edi (:edi-offset :dynamic-env))))
+	 (:pushl 'retry-jumper)
+	 ;; ..this allows us to detect recursive atomicallies.
+	 (:locally (:pushl (:edi (:edi-offset :atomically-continuation))))
+	 (:pushl :ebp)
+	retry-alloc
+	 (:movl (:esp) :ebp)
+	 (:load-lexical (:lexical-binding ,size-var) :eax)
+	 (:locally (:movl :esp (:edi (:edi-offset :atomically-continuation))))
+	 ;; Now inside atomically section.
+	 (:call-local-pf get-cons-pointer-non-header)
+	 , at code
+	 ,@(when fixed-size-p
+	     `((:load-lexical (:lexical-binding ,size-var) :ecx)))
+	 (:call-local-pf cons-commit-non-header)
 	 (:locally (:movl 0 (:edi (:edi-offset atomically-continuation))))
 	 (:leal (:esp 16) :esp)))))