0.pre7.56:
[sbcl.git] / src / compiler / x86 / alloc.lisp
index 8e01287..10e5150 100644 (file)
@@ -10,9 +10,6 @@
 ;;;; files for more information.
 
 (in-package "SB!VM")
-
-(file-comment
- "$Header$")
 \f
 ;;;; LIST and LIST*
 
@@ -27,8 +24,8 @@
   (:node-var node)
   (:generator 0
     (cond ((zerop num)
-          ;; (move result *nil-value*)
-          (inst mov result *nil-value*))
+          ;; (move result nil-value)
+          (inst mov result nil-value))
          ((and star (= num 1))
           (move result (tn-ref-tn things)))
          (t
                            ((control-stack)
                             (move temp ,tn)
                             temp))))
-                    (storew reg ,list ,slot sb!vm:list-pointer-type))))
+                    (storew reg ,list ,slot sb!vm:list-pointer-lowtag))))
             (let ((cons-cells (if star (1- num) num)))
               (pseudo-atomic
                (allocation res (* (pad-data-block cons-size) cons-cells) node)
                (inst lea res
-                     (make-ea :byte :base res :disp list-pointer-type))
+                     (make-ea :byte :base res :disp list-pointer-lowtag))
                (move ptr res)
                (dotimes (i (1- cons-cells))
                  (store-car (tn-ref-tn things) ptr)
                  (setf things (tn-ref-across things))
                  (inst add ptr (pad-data-block cons-size))
                  (storew ptr ptr (- cons-cdr-slot cons-size)
-                         list-pointer-type))
+                         list-pointer-lowtag))
                (store-car (tn-ref-tn things) ptr)
                (cond (star
                       (setf things (tn-ref-across things))
                       (store-car (tn-ref-tn things) ptr cons-cdr-slot))
                      (t
-                      (storew *nil-value* ptr cons-cdr-slot
-                              list-pointer-type)))
-               (assert (null (tn-ref-across things)))))
+                      (storew nil-value ptr cons-cdr-slot
+                              list-pointer-lowtag)))
+               (aver (null (tn-ref-across things)))))
             (move result res))))))
 
 (define-vop (list list-or-list*)
      ;;   -- WHN 19990916
      ;;
      ;; FIXME: should have a check for overflow of static space
-     (load-symbol-value temp sb!impl::*static-space-free-pointer*)
-     (inst lea result (make-ea :byte :base temp :disp other-pointer-type))
+     (load-symbol-value temp sb!vm:*static-space-free-pointer*)
+     (inst lea result (make-ea :byte :base temp :disp other-pointer-lowtag))
      (inst add temp boxed)
      (inst add temp unboxed)
-     (store-symbol-value temp sb!impl::*static-space-free-pointer*)
+     (store-symbol-value temp sb!vm:*static-space-free-pointer*)
      (inst shl boxed (- type-bits word-shift))
      (inst or boxed code-header-type)
-     (storew boxed result 0 other-pointer-type)
-     (storew unboxed result code-code-size-slot other-pointer-type)
-     (inst mov temp *nil-value*)
-     (storew temp result code-entry-points-slot other-pointer-type))
-    (storew temp result code-debug-info-slot other-pointer-type)))
+     (storew boxed result 0 other-pointer-lowtag)
+     (storew unboxed result code-code-size-slot other-pointer-lowtag)
+     (inst mov temp nil-value)
+     (storew temp result code-entry-points-slot other-pointer-lowtag))
+    (storew temp result code-debug-info-slot other-pointer-lowtag)))
 
 (define-vop (allocate-dynamic-code-object)
   (:args (boxed-arg :scs (any-reg) :target boxed)
     (inst add result unboxed)
     (pseudo-atomic
      (allocation result result node)
-     (inst lea result (make-ea :byte :base result :disp other-pointer-type))
+     (inst lea result (make-ea :byte :base result :disp other-pointer-lowtag))
      (inst shl boxed (- type-bits word-shift))
      (inst or boxed code-header-type)
-     (storew boxed result 0 other-pointer-type)
-     (storew unboxed result code-code-size-slot other-pointer-type)
-     (storew *nil-value* result code-entry-points-slot other-pointer-type))
-    (storew *nil-value* result code-debug-info-slot other-pointer-type)))
+     (storew boxed result 0 other-pointer-lowtag)
+     (storew unboxed result code-code-size-slot other-pointer-lowtag)
+     (storew nil-value result code-entry-points-slot other-pointer-lowtag))
+    (storew nil-value result code-debug-info-slot other-pointer-lowtag)))
 \f
 (define-vop (make-fdefn)
   (:policy :fast-safe)
   (:node-var node)
   (:generator 37
     (with-fixed-allocation (result fdefn-type fdefn-size node)
-      (storew name result fdefn-name-slot other-pointer-type)
-      (storew *nil-value* result fdefn-function-slot other-pointer-type)
+      (storew name result fdefn-name-slot other-pointer-lowtag)
+      (storew nil-value result fdefn-fun-slot other-pointer-lowtag)
       (storew (make-fixup (extern-alien-name "undefined_tramp") :foreign)
-             result fdefn-raw-addr-slot other-pointer-type))))
+             result fdefn-raw-addr-slot other-pointer-lowtag))))
 
 (define-vop (make-closure)
   (:args (function :to :save :scs (descriptor-reg)))
     (let ((size (+ length closure-info-offset)))
       (allocation result (pad-data-block size) node)
       (inst lea result
-           (make-ea :byte :base result :disp function-pointer-type))
+           (make-ea :byte :base result :disp fun-pointer-lowtag))
       (storew (logior (ash (1- size) type-bits) closure-header-type)
-             result 0 function-pointer-type))
-    (loadw temp function closure-function-slot function-pointer-type)
-    (storew temp result closure-function-slot function-pointer-type))))
+             result 0 fun-pointer-lowtag))
+    (loadw temp function closure-fun-slot fun-pointer-lowtag)
+    (storew temp result closure-fun-slot fun-pointer-lowtag))))
 
 ;;; The compiler likes to be able to directly make value cells.
 (define-vop (make-value-cell)
   (:generator 10
     (with-fixed-allocation
        (result value-cell-header-type value-cell-size node))
-    (storew value result value-cell-value-slot other-pointer-type)))
+    (storew value result value-cell-value-slot other-pointer-lowtag)))
 \f
 ;;;; automatic allocators for primitive objects
 
   (:node-var node)
   (:generator 37
     (with-fixed-allocation (result symbol-header-type symbol-size node)
-      (storew name result symbol-name-slot other-pointer-type)
-      (storew unbound-marker-type result symbol-value-slot other-pointer-type)
+      (storew name result symbol-name-slot other-pointer-lowtag)
+      (storew unbound-marker-type result symbol-value-slot other-pointer-lowtag)
       ;; Set up a random hash value for the symbol. Perhaps the object
       ;; address could be used for even faster and smaller code!
       ;; FIXME: We don't mind the symbol hash not being repeatable, so
       ;; We want a positive fixnum for the hash value, so discard the LS bits.
       (inst shr temp 1)
       (inst and temp #xfffffffc)
-      (storew temp result symbol-hash-slot other-pointer-type)
-      (storew *nil-value* result symbol-plist-slot other-pointer-type)
-      (storew *nil-value* result symbol-package-slot other-pointer-type))))
+      (storew temp result symbol-hash-slot other-pointer-lowtag)
+      (storew nil-value result symbol-plist-slot other-pointer-lowtag)
+      (storew nil-value result symbol-package-slot other-pointer-lowtag))))