X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fcompiler%2Fgeneric%2Fobjdef.lisp;h=760f8cab75ecc2584e6ec9cbf0239b85bbd94ffb;hb=a3649ba68e298d9203e8bb1de5629ff788586fe1;hp=f945ad3674440fb429e7f365db388058ffba8519;hpb=ec2616d216958a608581802c47496c0194478dc8;p=sbcl.git diff --git a/src/compiler/generic/objdef.lisp b/src/compiler/generic/objdef.lisp index f945ad3..760f8ca 100644 --- a/src/compiler/generic/objdef.lisp +++ b/src/compiler/generic/objdef.lisp @@ -66,14 +66,15 @@ :ref-trans %denominator :init :arg)) +#!+#.(cl:if (cl:= sb!vm:n-word-bits 32) '(and) '(or)) (define-primitive-object (single-float :lowtag other-pointer-lowtag :widetag single-float-widetag) (value :c-type "float")) (define-primitive-object (double-float :lowtag other-pointer-lowtag :widetag double-float-widetag) - (filler) - (value :c-type "double" :length 2)) + #!-x86-64 (filler) + (value :c-type "double" :length #!-x86-64 2 #!+x86-64 1)) #!+long-float (define-primitive-object (long-float :lowtag other-pointer-lowtag @@ -96,6 +97,8 @@ (define-primitive-object (array :lowtag other-pointer-lowtag :widetag t) + ;; FILL-POINTER of an ARRAY is in the same place as LENGTH of a + ;; VECTOR -- see SHRINK-VECTOR. (fill-pointer :type index :ref-trans %array-fill-pointer :ref-known (flushable foldable) @@ -131,6 +134,8 @@ (define-primitive-object (vector :type vector :lowtag other-pointer-lowtag :widetag t) + ;; FILL-POINTER of an ARRAY is in the same place as LENGTH of a + ;; VECTOR -- see SHRINK-VECTOR. (length :ref-trans sb!c::vector-length :type index) (data :rest-p t :c-type #!-alpha "unsigned long" #!+alpha "u32")) @@ -166,9 +171,9 @@ (define-primitive-object (simple-fun :type function :lowtag fun-pointer-lowtag :widetag simple-fun-header-widetag) - #!-x86 (self :ref-trans %simple-fun-self + #!-(or x86 x86-64) (self :ref-trans %simple-fun-self :set-trans (setf %simple-fun-self)) - #!+x86 (self + #!+(or x86 x86-64) (self ;; KLUDGE: There's no :SET-KNOWN, :SET-TRANS, :REF-KNOWN, or ;; :REF-TRANS here in this case. Instead, there's separate ;; DEFKNOWN/DEFINE-VOP/DEFTRANSFORM stuff in @@ -222,11 +227,11 @@ :lowtag fun-pointer-lowtag :widetag funcallable-instance-header-widetag :alloc-trans %make-funcallable-instance) - #!-x86 + #!-(or x86 x86-64) (fun :ref-known (flushable) :ref-trans %funcallable-instance-fun :set-known (unsafe) :set-trans (setf %funcallable-instance-fun)) - #!+x86 + #!+(or x86 x86-64) (fun :ref-known (flushable) :ref-trans %funcallable-instance-fun ;; KLUDGE: There's no :SET-KNOWN or :SET-TRANS in this case. @@ -291,13 +296,13 @@ (define-primitive-object (unwind-block) (current-uwp :c-type #!-alpha "struct unwind_block *" #!+alpha "u32") (current-cont :c-type #!-alpha "lispobj *" #!+alpha "u32") - #!-x86 current-code + #!-(or x86 x86-64) current-code entry-pc) (define-primitive-object (catch-block) (current-uwp :c-type #!-alpha "struct unwind_block *" #!+alpha "u32") (current-cont :c-type #!-alpha "lispobj *" #!+alpha "u32") - #!-x86 current-code + #!-(or x86 x86-64) current-code entry-pc tag (previous-catch :c-type #!-alpha "struct catch_block *" #!+alpha "u32") @@ -309,13 +314,9 @@ ;;;; symbols -#!+x86 -(defknown symbol-hash (symbol) (integer 0 #.sb!xc:most-positive-fixnum) - (flushable movable)) - (define-primitive-object (symbol :lowtag other-pointer-lowtag :widetag symbol-header-widetag - #!-x86 :alloc-trans #!-x86 make-symbol) + :alloc-trans make-symbol) ;; Beware when changing this definition. NIL-the-symbol is defined ;; using this layout, and NIL-the-end-of-list-marker is the cons @@ -323,12 +324,14 @@ ;; (conses have no header). Careful selection of lowtags ensures ;; that the same pointer can be used for both purposes: ;; OTHER-POINTER-LOWTAG is 7, LIST-POINTER-LOWTAG is 3, so if you - ;; subtract 3 from (sb-kernel:get-lisp-obj-address 'NIL) you get the + ;; subtract 3 from (SB-KERNEL:GET-LISP-OBJ-ADDRESS 'NIL) you get the ;; first data slot, and if you subtract 7 you get a symbol header. - (value :set-trans %set-symbol-value - :init :unbound) ;also the CAR of NIL-as-end-of-list - (hash) ;the CDR of NIL-as-end-of-list + ;; also the CAR of NIL-as-end-of-list + (value :init :unbound :ref-known (flushable) :ref-trans symbol-global-value) + ;; also the CDR of NIL-as-end-of-list. Its reffer needs special + ;; care for this reason, as hash values must be fixnums. + (hash :set-trans %set-symbol-hash) (plist :ref-trans symbol-plist :set-trans %set-symbol-plist @@ -336,7 +339,8 @@ (name :ref-trans symbol-name :init :arg) (package :ref-trans symbol-package :set-trans %set-symbol-package - :init :null)) + :init :null) + #!+sb-thread (tls-index :ref-known (flushable) :ref-trans symbol-tls-index)) (define-primitive-object (complex-single-float :lowtag other-pointer-lowtag @@ -347,15 +351,34 @@ (define-primitive-object (complex-double-float :lowtag other-pointer-lowtag :widetag complex-double-float-widetag) - (filler) - (real :c-type "double" :length 2) - (imag :c-type "double" :length 2)) - -#!+long-float -(define-primitive-object (complex-long-float - :lowtag other-pointer-lowtag - :widetag complex-long-float-widetag) - #!+sparc (filler) - (real :c-type "long double" :length #!+x86 3 #!+sparc 4) - (imag :c-type "long double" :length #!+x86 3 #!+sparc 4)) - + #!-x86-64 (filler) + (real :c-type "double" :length #!-x86-64 2 #!+x86-64 1) + (imag :c-type "double" :length #!-x86-64 2 #!+x86-64 1)) + +;;; this isn't actually a lisp object at all, it's a c structure that lives +;;; in c-land. However, we need sight of so many parts of it from Lisp that +;;; it makes sense to define it here anyway, so that the GENESIS machinery +;;; can take care of maintaining Lisp and C versions. +;;; Hence the even-fixnum lowtag just so we don't get odd(sic) numbers +;;; added to the slot offsets +(define-primitive-object (thread :lowtag even-fixnum-lowtag) + ;; unbound_marker is borrowed very briefly at thread startup to + ;; pass the address of initial-function into new_thread_trampoline + (unbound-marker :init :unbound) ; tls[0] = UNBOUND_MARKER_WIDETAG + (pid :c-type "pid_t") + (binding-stack-start :c-type "lispobj *" :length #!+alpha 2 #!-alpha 1) + (binding-stack-pointer :c-type "lispobj *" :length #!+alpha 2 #!-alpha 1) + (control-stack-start :c-type "lispobj *" :length #!+alpha 2 #!-alpha 1) + (control-stack-end :c-type "lispobj *" :length #!+alpha 2 #!-alpha 1) + (alien-stack-start :c-type "lispobj *" :length #!+alpha 2 #!-alpha 1) + (alien-stack-pointer :c-type "lispobj *" :length #!+alpha 2 #!-alpha 1) + #!+gencgc (alloc-region :c-type "struct alloc_region" :length 5) + (tls-cookie) ; on x86, the LDT index + (this :c-type "struct thread *" :length #!+alpha 2 #!-alpha 1) + (next :c-type "struct thread *" :length #!+alpha 2 #!-alpha 1) + (state) ; running, stopping, stopped, dead + #!+(or x86 x86-64) (pseudo-atomic-atomic) + #!+(or x86 x86-64) (pseudo-atomic-interrupted) + (interrupt-data :c-type "struct interrupt_data *" + :length #!+alpha 2 #!-alpha 1) + (interrupt-contexts :c-type "os_context_t *" :rest-p t))