X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fcompiler%2Fx86%2Fmacros.lisp;h=bd782a4fdac4cd91470acea1ba93b38789e1acbf;hb=e67cc0f952040723f7d0f37ddb88fe895f4b1464;hp=a054404313494d0b64995d12069b31bd38dd8e38;hpb=8902b8b6bd2e9285749dd39d313b33b6c69c5213;p=sbcl.git

diff --git a/src/compiler/x86/macros.lisp b/src/compiler/x86/macros.lisp
index a054404..bd782a4 100644
--- a/src/compiler/x86/macros.lisp
+++ b/src/compiler/x86/macros.lisp
@@ -174,10 +174,9 @@
     (unless (or (eql size 8) (eql size 16))
       (unless (and (tn-p size) (location= alloc-tn size))
 	(inst mov alloc-tn size)))
-    (inst call (make-fixup (extern-alien-name 
-			    (concatenate 'string
+    (inst call (make-fixup (concatenate 'string
 					 "alloc_" size-text
-					 "to_" tn-text))
+					 "to_" tn-text)
 			   :foreign))))
 
 (defun allocation-inline (alloc-tn size)
@@ -185,14 +184,12 @@
 	(free-pointer
 	 (make-ea :dword :disp 
 		  #!+sb-thread (* n-word-bytes thread-alloc-region-slot)
-		  #!-sb-thread (make-fixup (extern-alien-name "boxed_region")
-					    :foreign)
+		  #!-sb-thread (make-fixup "boxed_region" :foreign)
 		  :scale 1)) ; thread->alloc_region.free_pointer
 	(end-addr 
 	 (make-ea :dword :disp
 		  #!+sb-thread (* n-word-bytes (1+ thread-alloc-region-slot))
-		  #!-sb-thread (make-fixup (extern-alien-name "boxed_region")
-					   :foreign 4)
+		  #!-sb-thread (make-fixup "boxed_region" :foreign 4)
 		  :scale 1)))	; thread->alloc_region.end_addr
     (unless (and (tn-p size) (location= alloc-tn size))
       (inst mov alloc-tn size))
@@ -208,7 +205,7 @@
 		 (#.ebx-offset "alloc_overflow_ebx")
 		 (#.esi-offset "alloc_overflow_esi")
 		 (#.edi-offset "alloc_overflow_edi"))))
-      (inst call (make-fixup (extern-alien-name dst) :foreign)))
+      (inst call (make-fixup dst :foreign)))
     (emit-label ok)
     #!+sb-thread (inst fs-segment-prefix)
     (inst xchg free-pointer alloc-tn))
@@ -243,14 +240,17 @@
 ;;; header having the specified WIDETAG value. The result is placed in
 ;;; RESULT-TN.
 (defmacro with-fixed-allocation ((result-tn widetag size &optional inline)
-				 &rest forms)
-  `(pseudo-atomic
-    (allocation ,result-tn (pad-data-block ,size) ,inline)
-    (storew (logior (ash (1- ,size) n-widetag-bits) ,widetag)
-	    ,result-tn)
-    (inst lea ,result-tn
-     (make-ea :byte :base ,result-tn :disp other-pointer-lowtag))
-    ,@forms))
+				 &body forms)
+  (unless forms
+    (bug "empty &body in WITH-FIXED-ALLOCATION"))
+  (once-only ((result-tn result-tn) (size size))
+    `(pseudo-atomic
+      (allocation ,result-tn (pad-data-block ,size) ,inline)
+      (storew (logior (ash (1- ,size) n-widetag-bits) ,widetag)
+	      ,result-tn)
+      (inst lea ,result-tn
+	    (make-ea :byte :base ,result-tn :disp other-pointer-lowtag))
+      ,@forms)))
 
 ;;;; error code
 (eval-when (#-sb-xc :compile-toplevel :load-toplevel :execute)
@@ -326,7 +326,8 @@
        (inst mov (make-ea :byte
                           :disp (* 4 thread-pseudo-atomic-interrupted-slot)) 0)
        (inst fs-segment-prefix)
-       (inst mov (make-ea :byte :disp (* 4 thread-pseudo-atomic-atomic-slot)) 1)
+       (inst mov (make-ea :byte :disp (* 4 thread-pseudo-atomic-atomic-slot))
+            (fixnumize 1))
        ,@forms
        (inst fs-segment-prefix)
        (inst mov (make-ea :byte :disp (* 4 thread-pseudo-atomic-atomic-slot)) 0)