X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fcompiler%2Fx86%2Falloc.lisp;h=47408a6a5ad0fb0d11832329d3671749001301c4;hb=3c65762b927af861c9c8bc416e4cbac9a14ec0c3;hp=c233755d0b48ff1b6204b384b5cf47c67bb5f469;hpb=adf0d51d2bde8b723276bacf94641df9aa5ae561;p=sbcl.git diff --git a/src/compiler/x86/alloc.lisp b/src/compiler/x86/alloc.lisp index c233755..47408a6 100644 --- a/src/compiler/x86/alloc.lisp +++ b/src/compiler/x86/alloc.lisp @@ -10,9 +10,6 @@ ;;;; files for more information. (in-package "SB!VM") - -(file-comment - "$Header$") ;;;; LIST and LIST* @@ -40,27 +37,27 @@ ((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))))) + list-pointer-lowtag))) + (aver (null (tn-ref-across things))))) (move result res)))))) (define-vop (list list-or-list*) @@ -102,17 +99,17 @@ ;; ;; FIXME: should have a check for overflow of static space (load-symbol-value temp sb!vm:*static-space-free-pointer*) - (inst lea result (make-ea :byte :base temp :disp other-pointer-type)) + (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!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 shl boxed (- n-widetag-bits word-shift)) + (inst or boxed code-header-widetag) + (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-type)) - (storew temp result code-debug-info-slot other-pointer-type))) + (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) @@ -133,13 +130,13 @@ (inst add result unboxed) (pseudo-atomic (allocation result result node) - (inst lea result (make-ea :byte :base result :disp other-pointer-type)) - (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))) + (inst lea result (make-ea :byte :base result :disp other-pointer-lowtag)) + (inst shl boxed (- n-widetag-bits word-shift)) + (inst or boxed code-header-widetag) + (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))) (define-vop (make-fdefn) (:policy :fast-safe) @@ -148,11 +145,11 @@ (:results (result :scs (descriptor-reg) :from :argument)) (: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) + (with-fixed-allocation (result fdefn-widetag fdefn-size node) + (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))) @@ -165,11 +162,11 @@ (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)) - (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)))) + (make-ea :byte :base result :disp fun-pointer-lowtag)) + (storew (logior (ash (1- size) n-widetag-bits) closure-header-widetag) + 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) @@ -178,8 +175,8 @@ (:node-var node) (:generator 10 (with-fixed-allocation - (result value-cell-header-type value-cell-size node)) - (storew value result value-cell-value-slot other-pointer-type))) + (result value-cell-header-widetag value-cell-size node)) + (storew value result value-cell-value-slot other-pointer-lowtag))) ;;;; automatic allocators for primitive objects @@ -187,7 +184,7 @@ (:args) (:results (result :scs (any-reg))) (:generator 1 - (inst mov result unbound-marker-type))) + (inst mov result unbound-marker-widetag))) (define-vop (fixed-alloc) (:args) @@ -200,7 +197,10 @@ (allocation result (pad-data-block words) node) (inst lea result (make-ea :byte :base result :disp lowtag)) (when type - (storew (logior (ash (1- words) type-bits) type) result 0 lowtag))))) + (storew (logior (ash (1- words) n-widetag-bits) type) + result + 0 + lowtag))))) (define-vop (var-alloc) (:args (extra :scs (any-reg))) @@ -215,10 +215,9 @@ (inst lea bytes (make-ea :dword :base extra :disp (* (1+ words) word-bytes))) (inst mov header bytes) - (inst shl header (- type-bits 2)) ; w+1 to length field - + (inst shl header (- n-widetag-bits 2)) ; w+1 to length field (inst lea header ; (w-1 << 8) | type - (make-ea :dword :base header :disp (+ (ash -2 type-bits) type))) + (make-ea :dword :base header :disp (+ (ash -2 n-widetag-bits) type))) (inst and bytes (lognot lowtag-mask)) (pseudo-atomic (allocation result bytes node) @@ -233,9 +232,12 @@ (:results (result :scs (descriptor-reg) :from :argument)) (: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) + (with-fixed-allocation (result symbol-header-widetag symbol-size node) + (storew name result symbol-name-slot other-pointer-lowtag) + (storew unbound-marker-widetag + 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 @@ -250,6 +252,6 @@ ;; 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))))