;;;; files for more information.
(in-package "SB!VM")
-
-(file-comment
- "$Header$")
\f
;;;; the primitive objects themselves
-(define-primitive-object (cons :lowtag list-pointer-type
+(define-primitive-object (cons :lowtag list-pointer-lowtag
:alloc-trans cons)
(car :ref-trans car :set-trans sb!c::%rplaca :init :arg)
(cdr :ref-trans cdr :set-trans sb!c::%rplacd :init :arg))
-(define-primitive-object (instance :lowtag instance-pointer-type
+(define-primitive-object (instance :lowtag instance-pointer-lowtag
:header instance-header-type
:alloc-trans %make-instance)
(slots :rest-p t))
-(define-primitive-object (bignum :lowtag other-pointer-type
+(define-primitive-object (bignum :lowtag other-pointer-lowtag
:header bignum-type
:alloc-trans sb!bignum::%allocate-bignum)
(digits :rest-p t :c-type #!-alpha "long" #!+alpha "u32"))
(define-primitive-object (ratio :type ratio
- :lowtag other-pointer-type
+ :lowtag other-pointer-lowtag
:header ratio-type
:alloc-trans %make-ratio)
(numerator :type integer
:ref-trans %denominator
:init :arg))
-(define-primitive-object (single-float :lowtag other-pointer-type
+(define-primitive-object (single-float :lowtag other-pointer-lowtag
:header single-float-type)
(value :c-type "float"))
-(define-primitive-object (double-float :lowtag other-pointer-type
+(define-primitive-object (double-float :lowtag other-pointer-lowtag
:header double-float-type)
(filler)
(value :c-type "double" :length 2))
#!+long-float
-(define-primitive-object (long-float :lowtag other-pointer-type
+(define-primitive-object (long-float :lowtag other-pointer-lowtag
:header long-float-type)
#!+sparc (filler)
(value :c-type "long double" :length #!+x86 3 #!+sparc 4))
(define-primitive-object (complex :type complex
- :lowtag other-pointer-type
+ :lowtag other-pointer-lowtag
:header complex-type
:alloc-trans %make-complex)
(real :type real
:ref-trans %imagpart
:init :arg))
-(define-primitive-object (array :lowtag other-pointer-type
+(define-primitive-object (array :lowtag other-pointer-lowtag
:header t)
(fill-pointer :type index
:ref-trans %array-fill-pointer
(dimensions :rest-p t))
(define-primitive-object (vector :type vector
- :lowtag other-pointer-type
+ :lowtag other-pointer-lowtag
:header t)
(length :ref-trans sb!c::vector-length
:type index)
(data :rest-p t :c-type #!-alpha "unsigned long" #!+alpha "u32"))
(define-primitive-object (code :type code-component
- :lowtag other-pointer-type
+ :lowtag other-pointer-lowtag
:header t)
(code-size :type index
:ref-known (flushable movable)
(constants :rest-p t))
(define-primitive-object (fdefn :type fdefn
- :lowtag other-pointer-type
+ :lowtag other-pointer-lowtag
:header fdefn-type)
(name :ref-trans fdefn-name)
- (function :type (or function null) :ref-trans fdefn-function)
+ (fun :type (or function null) :ref-trans fdefn-fun)
(raw-addr :c-type #!-alpha "char *" #!+alpha "u32"))
-(define-primitive-object (function :type function
- :lowtag function-pointer-type
- :header function-header-type)
- #!-gengc (self :ref-trans %function-self :set-trans (setf %function-self))
- #!+gengc (entry-point :c-type "char *")
+;;; a simple function (as opposed to hairier things like closures
+;;; which are also subtypes of Common Lisp's FUNCTION type)
+(define-primitive-object (simple-fun :type function
+ :lowtag fun-pointer-lowtag
+ :header simple-fun-header-type)
+ #!-x86 (self :ref-trans %simple-fun-self
+ :set-trans (setf %simple-fun-self))
+ #!+x86 (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
+ ;; compiler/x86/system.lisp to define and declare them by
+ ;; hand. I don't know why this is, but that's (basically)
+ ;; the way it was done in CMU CL, and it works. (It's not
+ ;; exactly the same way it was done in CMU CL in that CMU
+ ;; CL's allows duplicate DEFKNOWNs, blithely overwriting any
+ ;; previous data associated with the previous DEFKNOWN, and
+ ;; that property was used to mask the definitions here. In
+ ;; SBCL as of 0.6.12.64 that's not allowed -- too confusing!
+ ;; -- so we have to explicitly suppress the DEFKNOWNish
+ ;; stuff here in order to allow this old hack to work in the
+ ;; new world. -- WHN 2001-08-82
+ )
(next :type (or function null)
:ref-known (flushable)
- :ref-trans %function-next
+ :ref-trans %simple-fun-next
:set-known (unsafe)
- :set-trans (setf %function-next))
+ :set-trans (setf %simple-fun-next))
(name :ref-known (flushable)
- :ref-trans %function-name
+ :ref-trans %simple-fun-name
:set-known (unsafe)
- :set-trans (setf %function-name))
+ :set-trans (setf %simple-fun-name))
(arglist :ref-known (flushable)
- :ref-trans %function-arglist
+ :ref-trans %simple-fun-arglist
:set-known (unsafe)
- :set-trans (setf %function-arglist))
+ :set-trans (setf %simple-fun-arglist))
(type :ref-known (flushable)
- :ref-trans %function-type
+ :ref-trans %simple-fun-type
:set-known (unsafe)
- :set-trans (setf %function-type))
+ :set-trans (setf %simple-fun-type))
(code :rest-p t :c-type "unsigned char"))
-#!-gengc
-(define-primitive-object (return-pc :lowtag other-pointer-type :header t)
+(define-primitive-object (return-pc :lowtag other-pointer-lowtag :header t)
(return-point :c-type "unsigned char" :rest-p t))
-(define-primitive-object (closure :lowtag function-pointer-type
+(define-primitive-object (closure :lowtag fun-pointer-lowtag
:header closure-header-type)
- #!-gengc (function :init :arg :ref-trans %closure-function)
- #!+gengc (entry-point :c-type "char *")
+ (fun :init :arg :ref-trans %closure-fun)
(info :rest-p t))
(define-primitive-object (funcallable-instance
- :lowtag function-pointer-type
+ :lowtag fun-pointer-lowtag
:header funcallable-instance-header-type
:alloc-trans %make-funcallable-instance)
- #!-gengc
- (function
- :ref-known (flushable) :ref-trans %funcallable-instance-function
- :set-known (unsafe) :set-trans (setf %funcallable-instance-function))
- #!+gengc (entry-point :c-type "char *")
+ #!-x86
+ (fun
+ :ref-known (flushable) :ref-trans %funcallable-instance-fun
+ :set-known (unsafe) :set-trans (setf %funcallable-instance-fun))
+ #!+x86
+ (fun
+ :ref-known (flushable) :ref-trans %funcallable-instance-fun
+ ;; KLUDGE: There's no :SET-KNOWN or :SET-TRANS in this case.
+ ;; Instead, later in compiler/x86/system.lisp there's a separate
+ ;; DEFKNOWN for (SETF %FUNCALLABLE-INSTANCE-FUN), and a weird
+ ;; unexplained DEFTRANSFORM from (SETF %SIMPLE-FUN-INSTANCE-FUN)
+ ;; into (SETF %SIMPLE-FUN-SELF). The #!+X86 wrapped around this case
+ ;; is a literal translation of the old CMU CL implementation into
+ ;; the new world of sbcl-0.6.12.63, where multiple DEFKNOWNs for
+ ;; the same operator cause an error (instead of silently deleting
+ ;; all information associated with the old DEFKNOWN, as before).
+ ;; It's definitely not very clean, with too many #!+ conditionals and
+ ;; too little documentation, but I have more urgent things to
+ ;; clean up right now, so I've just left it as a literal
+ ;; translation without trying to fix it. -- WHN 2001-08-02
+ )
(lexenv :ref-known (flushable) :ref-trans %funcallable-instance-lexenv
:set-known (unsafe) :set-trans (setf %funcallable-instance-lexenv))
(layout :init :arg
:set-known (unsafe) :set-trans (setf %funcallable-instance-layout))
(info :rest-p t))
-(define-primitive-object (value-cell :lowtag other-pointer-type
+(define-primitive-object (value-cell :lowtag other-pointer-lowtag
:header value-cell-header-type
:alloc-trans make-value-cell)
(value :set-trans value-cell-set
:init :arg))
#!+alpha
-(define-primitive-object (sap :lowtag other-pointer-type
+(define-primitive-object (sap :lowtag other-pointer-lowtag
:header sap-type)
(padding)
(pointer :c-type "char *" :length 2))
#!-alpha
-(define-primitive-object (sap :lowtag other-pointer-type
+(define-primitive-object (sap :lowtag other-pointer-lowtag
:header sap-type)
(pointer :c-type "char *"))
(define-primitive-object (weak-pointer :type weak-pointer
- :lowtag other-pointer-type
+ :lowtag other-pointer-lowtag
:header weak-pointer-type
:alloc-trans make-weak-pointer)
(value :ref-trans sb!c::%weak-pointer-value :ref-known (flushable)
;;; (For an explanation of this, see the comments at the definition of
;;; KLUDGE-NONDETERMINISTIC-CATCH-BLOCK-SIZE.)
-(assert (= sb!vm::kludge-nondeterministic-catch-block-size catch-block-size))
+(aver (= sb!vm::kludge-nondeterministic-catch-block-size catch-block-size))
\f
;;;; symbols
-#!+gengc
-(defknown %make-symbol (index simple-string) symbol
- (flushable movable))
-
-#!+gengc
-(defknown symbol-hash (symbol) index
- (flushable movable))
-
#!+x86
(defknown symbol-hash (symbol) (integer 0 #.*target-most-positive-fixnum*)
(flushable movable))
-(define-primitive-object (symbol :lowtag other-pointer-type
+(define-primitive-object (symbol :lowtag other-pointer-lowtag
:header symbol-header-type
- #!-x86 :alloc-trans
- #!-(or gengc x86) make-symbol
- #!+gengc %make-symbol)
+ #!-x86 :alloc-trans #!-x86 make-symbol)
(value :set-trans %set-symbol-value
:init :unbound)
- #!-(or gengc x86) unused
- #!+gengc (hash :init :arg)
#!+x86 (hash)
(plist :ref-trans symbol-plist
:set-trans %set-symbol-plist
:init :null))
(define-primitive-object (complex-single-float
- :lowtag other-pointer-type
+ :lowtag other-pointer-lowtag
:header complex-single-float-type)
(real :c-type "float")
(imag :c-type "float"))
(define-primitive-object (complex-double-float
- :lowtag other-pointer-type
+ :lowtag other-pointer-lowtag
:header complex-double-float-type)
(filler)
(real :c-type "double" :length 2)
#!+long-float
(define-primitive-object (complex-long-float
- :lowtag other-pointer-type
+ :lowtag other-pointer-lowtag
:header complex-long-float-type)
#!+sparc (filler)
(real :c-type "long double" :length #!+x86 3 #!+sparc 4)
projects / sbcl.git / blobdiff