X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fcompiler%2Fgeneric%2Fobjdef.lisp;h=760f8cab75ecc2584e6ec9cbf0239b85bbd94ffb;hb=69ef68ba7393e3492c1b4a756d1140f71c2922bc;hp=0e9d11e19aa3d532d364b3eb0de9231fe6c43b7d;hpb=040e4e707e4f7bc9bda2ab78774fd9205c44ee1f;p=sbcl.git diff --git a/src/compiler/generic/objdef.lisp b/src/compiler/generic/objdef.lisp index 0e9d11e..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 #!-sb-thread :set-trans #!-sb-thread %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 @@ -337,7 +340,7 @@ (package :ref-trans symbol-package :set-trans %set-symbol-package :init :null) - #!+sb-thread (tls-index)) + #!+sb-thread (tls-index :ref-known (flushable) :ref-trans symbol-tls-index)) (define-primitive-object (complex-single-float :lowtag other-pointer-lowtag @@ -348,17 +351,9 @@ (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 @@ -370,18 +365,20 @@ ;; 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 - (binding-stack-start :c-type "lispobj *") - (binding-stack-pointer :c-type "lispobj *") - (control-stack-start :c-type "lispobj *") - (control-stack-end :c-type "lispobj *") - (alien-stack-start :c-type "lispobj *") - (alien-stack-pointer :c-type "lispobj *") - (alloc-region :c-type "struct alloc_region" :length 5) (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 *") - (next :c-type "struct thread *") - (pseudo-atomic-atomic) - (pseudo-atomic-interrupted) - (interrupt-data :c-type "struct interrupt_data *") + (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))