0.8.5.3:

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

diff --git a/src/compiler/alpha/macros.lisp b/src/compiler/alpha/macros.lisp
index d472eef..790d69e 100644 (file)
--- a/src/compiler/alpha/macros.lisp
+++ b/src/compiler/alpha/macros.lisp
@@ -224,8 +224,7 @@
   Emit code for a continuable error with the specified Error-Code and
   context Values.  If the error is continued, execution resumes after
   the GENERATE-CERROR-CODE form."
   Emit code for a continuable error with the specified Error-Code and
   context Values.  If the error is continued, execution resumes after
   the GENERATE-CERROR-CODE form."

-  (let ((continue (gensym "CONTINUE-LABEL-"))
-       (error (gensym "ERROR-LABEL-")))
+  (with-unique-names (continue error)

     `(let ((,continue (gen-label)))
        (emit-label ,continue)
        (assemble (*elsewhere*)
     `(let ((,continue (gen-label)))
        (emit-label ,continue)
        (assemble (*elsewhere*)

@@ -380,7 +379,7 @@
         (:result-types ,el-type)
         (:temporary (:sc non-descriptor-reg) temp)
         (:temporary (:sc non-descriptor-reg) temp1)
         (:result-types ,el-type)
         (:temporary (:sc non-descriptor-reg) temp)
         (:temporary (:sc non-descriptor-reg) temp1)

-        (:generator 5
+        (:generator 4

           ,@(ecase size
               (:byte
                (if signed
           ,@(ecase size
               (:byte
                (if signed

@@ -473,30 +472,45 @@
         (:temporary (:sc non-descriptor-reg) temp2)
         (:results (result :scs ,scs))
         (:result-types ,el-type)
         (:temporary (:sc non-descriptor-reg) temp2)
         (:results (result :scs ,scs))
         (:result-types ,el-type)

-        (:generator 5
+        (:generator 4

           ,@(ecase size
               (:byte
           ,@(ecase size
               (:byte

-               `((inst lda temp (- (* ,offset n-word-bytes)
-                                   (* index ,scale) ,lowtag)
+               `((inst lda temp (- (+ (* ,offset n-word-bytes)
+                                      (* index ,scale))
+                                   ,lowtag)

                        object)
                        object)

-                 (inst ldq_u temp1 (- (* ,offset n-word-bytes) 
-                                      (* index ,scale) ,lowtag)
+                 (inst ldq_u temp1 (- (+ (* ,offset n-word-bytes) 
+                                         (* index ,scale))
+                                      ,lowtag)

                        object)
                  (inst insbl value temp temp2)
                  (inst mskbl temp1 temp temp1)
                  (inst bis temp1 temp2 temp1)
                        object)
                  (inst insbl value temp temp2)
                  (inst mskbl temp1 temp temp1)
                  (inst bis temp1 temp2 temp1)

-                 (inst stq_u temp1 (- (* ,offset n-word-bytes)
-                                      (* index ,scale) ,lowtag) object)))
+                 (inst stq_u temp1 (- (+ (* ,offset n-word-bytes)
+                                         (* index ,scale))
+                                      ,lowtag) object)))

               (:short
               (:short

-               `((inst lda temp (- (* ,offset n-word-bytes)
-                                   (* index ,scale) ,lowtag)
+               `((inst lda temp (- (+ (* ,offset n-word-bytes)
+                                      (* index ,scale))
+                                   ,lowtag)

                        object)
                        object)

-                 (inst ldq_u temp1 (- (* ,offset n-word-bytes)
-                                      (* index ,scale) ,lowtag)
+                 (inst ldq_u temp1 (- (+ (* ,offset n-word-bytes)
+                                         (* index ,scale))
+                                      ,lowtag)

                        object)
                  (inst mskwl temp1 temp temp1)
                  (inst inswl value temp temp2)
                  (inst bis temp1 temp2 temp)
                        object)
                  (inst mskwl temp1 temp temp1)
                  (inst inswl value temp temp2)
                  (inst bis temp1 temp2 temp)

-                 (inst stq_u temp (- (* ,offset n-word-bytes)
-                                     (* index ,scale) ,lowtag) object))))
+                 (inst stq_u temp (- (+ (* ,offset n-word-bytes)
+                                        (* index ,scale))
+                                     ,lowtag) object))))

           (move value result))))))
           (move value result))))))

+
+(defmacro sb!sys::with-pinned-objects ((&rest objects) &body body)
+  "Arrange with the garbage collector that the pages occupied by
+OBJECTS will not be moved in memory for the duration of BODY.
+Useful for e.g. foreign calls where another thread may trigger
+garbage collection.  This is currently implemented by disabling GC"
+  (declare (ignore objects))           ;should we eval these for side-effect?
+  `(without-gcing
+    ,@body))