X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fcompiler%2Fx86%2Falloc.lisp;h=4286c2e11440f108a3dcd9733cd5ffed40022138;hb=bc46c8bcdd6ac8918df8ea9e9db49808e4924fcf;hp=8e01287b80b8c632836fb862300c916d66335e5b;hpb=a530bbe337109d898d5b4a001fc8f1afa3b5dc39;p=sbcl.git diff --git a/src/compiler/x86/alloc.lisp b/src/compiler/x86/alloc.lisp index 8e01287..4286c2e 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* @@ -27,40 +24,40 @@ (: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 (macrolet - ((store-car (tn list &optional (slot sb!vm:cons-car-slot)) + ((store-car (tn list &optional (slot cons-car-slot)) `(let ((reg (sc-case ,tn ((any-reg descriptor-reg) ,tn) ((control-stack) (move temp ,tn) temp)))) - (storew reg ,list ,slot sb!vm:list-pointer-type)))) + (storew reg ,list ,slot 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*) @@ -101,18 +98,18 @@ ;; -- 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 *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*) - (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))) + (store-symbol-value temp *static-space-free-pointer*) + (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-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))) @@ -213,12 +213,11 @@ (:node-var node) (:generator 50 (inst lea bytes - (make-ea :dword :base extra :disp (* (1+ words) word-bytes))) + (make-ea :dword :base extra :disp (* (1+ words) n-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))))