0.8.19.30: less COMPILE-FILE verbosity

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

diff --git a/src/compiler/alpha/macros.lisp b/src/compiler/alpha/macros.lisp
index 130b230..a251501 100644 (file)
--- a/src/compiler/alpha/macros.lisp
+++ b/src/compiler/alpha/macros.lisp
@@ -87,8 +87,8 @@
 (defmacro lisp-jump (function lip)
   "Jump to the lisp function FUNCTION.  LIP is an interior-reg temporary."
   `(progn
 (defmacro lisp-jump (function lip)
   "Jump to the lisp function FUNCTION.  LIP is an interior-reg temporary."
   `(progn

-     (inst lda ,lip (- (ash sb!vm:simple-fun-code-offset sb!vm:word-shift)
-                      sb!vm:fun-pointer-lowtag)
+     (inst lda ,lip (- (ash simple-fun-code-offset word-shift)
+                      fun-pointer-lowtag)

            ,function)
      (move ,function code-tn)
      (inst jsr zero-tn ,lip 1)))
            ,function)
      (move ,function code-tn)
      (inst jsr zero-tn ,lip 1)))

@@ -379,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

@@ -472,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))