0.9.1.36:

[sbcl.git] / src / compiler / x86 / macros.lisp

diff --git a/src/compiler/x86/macros.lisp b/src/compiler/x86/macros.lisp
index a054404..bd782a4 100644 (file)
--- 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)))
 \f
 ;;;; 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)