X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;ds=sidebyside;f=src%2Fcompiler%2Fgeneric%2Fobjdef.lisp;h=b3839eb205f325a229fd30bb556564698089bd5e;hb=992e6a70a0cae3f6d43bdbba18f77306fdf10662;hp=7bfbb4c03e693c85b245c08c5a42aede01421df7;hpb=f1ffbf976aaa50b7b22f126b97e34afe06a91210;p=sbcl.git diff --git a/src/compiler/generic/objdef.lisp b/src/compiler/generic/objdef.lisp index 7bfbb4c..b3839eb 100644 --- a/src/compiler/generic/objdef.lisp +++ b/src/compiler/generic/objdef.lisp @@ -221,6 +221,49 @@ (define-primitive-object (closure :lowtag fun-pointer-lowtag :widetag closure-header-widetag) (fun :init :arg :ref-trans %closure-fun) + ;; This SELF slot needs explanation. + ;; + ;; Ordinary closures did not need this slot before version 0.9.3.xx, + ;; as the closure object was already in some dedicated register -- + ;; EAX/RAX on x86(-64), reg_LEXENV on register-rich platforms -- and + ;; consequently setting up the environment (from the INFO slot, + ;; below) was easy. + ;; + ;; However, it is not easy to support calling FUNCALLABLE-INSTANCEs + ;; in the same way; in a FUNCALLABLE-INSTANCE, there are + ;; conceptually two variable-length data areas: the closure + ;; environment, if any, and the slots of the instance. + ;; + ;; Until sbcl-0.9.3.xx, it was required that closures to be set as a + ;; FUNCALLABLE-INSTANCE-FUNCTION be defined using the magical + ;; keyword SB-KERNEL:INSTANCE-LAMBDA, rather than ordinary LAMBDA; + ;; this caused an extra indirection to be compiled into the closure + ;; code to load the closure from the FUNCALLABLE-INSTANCE-LEXENV + ;; slot before setting up the environment for the function body. + ;; Failure to obey this protocol yielded confusing error messages as + ;; either INSTANCE-LAMBDAs tried to dereference environments that + ;; weren't there, or ordinary LAMBDAs got hold of the LAYOUT and + ;; LEXENV slots of a FUNCALLABLE-INSTANCE. + ;; + ;; By adding this SELF slot, which is at the same offset in a + ;; regular CLOSURE as the LEXENV slot is in a FUNCALLABLE-INSTANCE, + ;; we enable the extra indirection (VOP FUNCALLABLE-INSTANCE-LEXENV, + ;; in src/compiler/ir2tran.lisp) to be compiled unconditionally + ;; (provided that we set this slot to the closure object itself). + ;; Relative to the code before, this adds a word to the space + ;; requirements of a closure, and one instruction (a memory fetch) + ;; to the body of a closure function. + ;; + ;; There are potentially other implementation strategies which would + ;; remove the need for this extra indirection in regular closures, + ;; such as setting up a trampoline for funcallable instances (though + ;; it was not clear to me that there are enough registers free in + ;; the x86 backend to permit this). This indirection should not be + ;; too disastrous, given that for regular closures the fetch is from + ;; memory which is known to be active. + ;; + ;; CSR, 2005-08-05 + (self) ; KLUDGE (see above comment) (info :rest-p t)) (define-primitive-object (funcallable-instance @@ -250,9 +293,6 @@ ) (lexenv :ref-known (flushable) :ref-trans %funcallable-instance-lexenv :set-known (unsafe) :set-trans (setf %funcallable-instance-lexenv)) - (layout :init :arg - :ref-known (flushable) :ref-trans %funcallable-instance-layout - :set-known (unsafe) :set-trans (setf %funcallable-instance-layout)) (info :rest-p t)) (define-primitive-object (value-cell :lowtag other-pointer-lowtag @@ -316,7 +356,7 @@ (define-primitive-object (symbol :lowtag other-pointer-lowtag :widetag symbol-header-widetag - :alloc-trans 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 @@ -355,6 +395,20 @@ (real :c-type "double" :length #!-x86-64 2 #!+x86-64 1) (imag :c-type "double" :length #!-x86-64 2 #!+x86-64 1)) +#!+sb-lutex +(define-primitive-object (lutex + :lowtag other-pointer-lowtag + :widetag lutex-widetag + :alloc-trans %make-lutex) + (gen :c-type "long" :length 1) + (live :c-type "long" :length 1) + (next :c-type "struct lutex *" :length 1) + (prev :c-type "struct lutex *" :length 1) + (mutex :c-type "pthread_mutex_t *" + :length 1) + (condition-variable :c-type "pthread_cond_t *" + :length 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 @@ -362,10 +416,12 @@ ;;; 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 - (os-thread :c-type "os_thread_t") + ;; no_tls_value_marker is borrowed very briefly at thread startup to + ;; pass the address of initial-function into new_thread_trampoline. + ;; tls[0] = NO_TLS_VALUE_MARKER_WIDETAG because a the tls index slot + ;; of a symbol is initialized to zero + (no-tls-value-marker) + (os-thread :c-type "volatile os_thread_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) @@ -373,16 +429,14 @@ (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) (prev :c-type "struct thread *" :length #!+alpha 2 #!-alpha 1) (next :c-type "struct thread *" :length #!+alpha 2 #!-alpha 1) ;; starting, running, suspended, dead - (state) + (state :c-type "volatile lispobj") + (tls-cookie) ; on x86, the LDT index #!+(or x86 x86-64) (pseudo-atomic-atomic) #!+(or x86 x86-64) (pseudo-atomic-interrupted) - (interrupt-fun) - (interrupt-fun-lock) (interrupt-data :c-type "struct interrupt_data *" :length #!+alpha 2 #!-alpha 1) (interrupt-contexts :c-type "os_context_t *" :rest-p t))