objdef.lisp

开源跨平台Lisp编译器

  (arglist :type list
           :ref-known (flushable)
           :ref-trans %simple-fun-arglist
           :set-known (unsafe)
           :set-trans (setf %simple-fun-arglist))
  (type :ref-known (flushable)
        :ref-trans %simple-fun-type
        :set-known (unsafe)
        :set-trans (setf %simple-fun-type))
  (xrefs :init :null
         :ref-trans %simple-fun-xrefs
         :ref-known (flushable)
         :set-trans (setf %simple-fun-xrefs)
         :set-known ())
  ;; the SB!C::DEBUG-FUN object corresponding to this object, or NIL for none
  #+nil ; FIXME: doesn't work (gotcha, lowly maintenoid!) See notes on bug 137.
  (debug-fun :ref-known (flushable)
             :ref-trans %simple-fun-debug-fun
             :set-known (unsafe)
             :set-trans (setf %simple-fun-debug-fun))
  (code :rest-p t :c-type "unsigned char"))

(define-primitive-object (return-pc :lowtag other-pointer-lowtag :widetag t)
  (return-point :c-type "unsigned char" :rest-p t))

(define-primitive-object (closure :lowtag fun-pointer-lowtag
                                  :widetag closure-header-widetag)
  (fun :init :arg :ref-trans %closure-fun)
  (info :rest-p t))

(define-primitive-object (funcallable-instance
                          :lowtag fun-pointer-lowtag
                          :widetag funcallable-instance-header-widetag
                          :alloc-trans %make-funcallable-instance)
  (trampoline :init :funcallable-instance-tramp)
  (function :ref-known (flushable) :ref-trans %funcallable-instance-function
            :set-known (unsafe) :set-trans (setf %funcallable-instance-function))
  (info :rest-p t))

(define-primitive-object (value-cell :lowtag other-pointer-lowtag
                                     :widetag value-cell-header-widetag
                                     ;; FIXME: We also have an explicit VOP
                                     ;; for this. Is this needed as well?
                                     :alloc-trans make-value-cell)
  (value :set-trans value-cell-set
         :set-known (unsafe)
         :ref-trans value-cell-ref
         :ref-known (flushable)
         :init :arg))

#!+alpha
(define-primitive-object (sap :lowtag other-pointer-lowtag
                              :widetag sap-widetag)
  (padding)
  (pointer :c-type "char *" :length 2))

#!-alpha
(define-primitive-object (sap :lowtag other-pointer-lowtag
                              :widetag sap-widetag)
  (pointer :c-type "char *"))


(define-primitive-object (weak-pointer :type weak-pointer
                                       :lowtag other-pointer-lowtag
                                       :widetag weak-pointer-widetag
                                       :alloc-trans make-weak-pointer)
  (value :ref-trans sb!c::%weak-pointer-value :ref-known (flushable)
         :init :arg)
  (broken :type (member t nil)
          :ref-trans sb!c::%weak-pointer-broken :ref-known (flushable)
          :init :null)
  (next :c-type #!-alpha "struct weak_pointer *" #!+alpha "u32"))

;;;; other non-heap data blocks

(define-primitive-object (binding)
  value
  symbol)

(define-primitive-object (unwind-block)
  (current-uwp :c-type #!-alpha "struct unwind_block *" #!+alpha "u32")
  (current-cont :c-type #!-alpha "lispobj *" #!+alpha "u32")
  #!-(or x86 x86-64) current-code
  entry-pc
  #!+win32 next-seh-frame
  #!+win32 seh-frame-handler)

(define-primitive-object (catch-block)
  (current-uwp :c-type #!-alpha "struct unwind_block *" #!+alpha "u32")
  (current-cont :c-type #!-alpha "lispobj *" #!+alpha "u32")
  #!-(or x86 x86-64) current-code
  entry-pc
  #!+win32 next-seh-frame
  #!+win32 seh-frame-handler
  tag
  (previous-catch :c-type #!-alpha "struct catch_block *" #!+alpha "u32")
  size)

;;; (For an explanation of this, see the comments at the definition of
;;; KLUDGE-NONDETERMINISTIC-CATCH-BLOCK-SIZE.)
(aver (= kludge-nondeterministic-catch-block-size catch-block-size))

;;;; symbols

(define-primitive-object (symbol :lowtag other-pointer-lowtag
                                 :widetag symbol-header-widetag
                                 :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
  ;; ( NIL . NIL ), living in the first two slots of NIL-the-symbol
  ;; (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
  ;; first data slot, and if you subtract 7 you get a symbol header.

  ;; 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
         :cas-trans %compare-and-swap-symbol-plist
         :type list
         :init :null)
  (name :ref-trans symbol-name :init :arg)
  (package :ref-trans symbol-package
           :set-trans %set-symbol-package
           :init :null)
  #!+sb-thread (tls-index :ref-known (flushable) :ref-trans symbol-tls-index))

(define-primitive-object (complex-single-float
                          :lowtag other-pointer-lowtag
                          :widetag complex-single-float-widetag)
  (real :c-type "float")
  (imag :c-type "float"))

(define-primitive-object (complex-double-float
                          :lowtag other-pointer-lowtag
                          :widetag complex-double-float-widetag)
  #!-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))

#!+(and sb-lutex sb-thread)
(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)
  (mutexattr :c-type "pthread_mutexattr_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
;;; 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)
  ;; 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")
  ;; This is the original address at which the memory was allocated,
  ;; which may have different alignment then what we prefer to use.
  ;; Kept here so that when the thread dies we can releast the whole
  ;; memory we reserved.
  (os-address :c-type "void *" :length #!+alpha 2 #!-alpha 1)
  #!+sb-thread
  (os-attr :c-type "pthread_attr_t *" :length #!+alpha 2 #!-alpha 1)
  (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)
  (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 :c-type "volatile lispobj")
  (tls-cookie)                          ;  on x86, the LDT index
  #!+(or x86 x86-64) (pseudo-atomic-bits)
  (interrupt-data :c-type "struct interrupt_data *"
                  :length #!+alpha 2 #!-alpha 1)
  (stepping)
  (interrupt-contexts :c-type "os_context_t *" :rest-p t))