(def!struct (primitive-object (:make-load-form-fun just-dump-it-normally))
(name nil :type symbol)
- (header nil :type symbol)
+ (widetag nil :type symbol)
(lowtag nil :type symbol)
(options nil :type list)
(slots nil :type list)
(size 0 :type fixnum)
- (variable-length nil :type (member t nil)))
+ (var-length nil :type (member t nil)))
(defvar *primitive-objects* nil)
name))
(defmacro define-primitive-object
- ((name &key header lowtag alloc-trans (type t))
+ ((name &key lowtag widetag alloc-trans (type t))
&rest slot-specs)
(collect ((slots) (exports) (constants) (forms) (inits))
- (let ((offset (if header 1 0))
- (variable-length nil))
+ (let ((offset (if widetag 1 0))
+ (var-length nil))
(dolist (spec slot-specs)
- (when variable-length
+ (when var-length
(error "No more slots can follow a :rest-p slot."))
(destructuring-bind
(slot-name &rest options
(when init
(inits (cons init offset)))
(when rest-p
- (setf variable-length t))
+ (setf var-length t))
(incf offset length)))
- (unless variable-length
+ (unless var-length
(let ((size (symbolicate name "-SIZE")))
- (constants `(defconstant ,size ,offset
- ,(format nil
- "Number of slots used by each ~S~
- ~@[~* including the header~]."
- name header)))
+ (constants `(defconstant ,size ,offset))
(exports size)))
(when alloc-trans
- (forms `(def-alloc ,alloc-trans ,offset ,variable-length ,header
+ (forms `(def-alloc ,alloc-trans ,offset ,var-length ,widetag
,lowtag ',(inits))))
`(progn
(eval-when (:compile-toplevel :load-toplevel :execute)
(%define-primitive-object
',(make-primitive-object :name name
- :header header
+ :widetag widetag
:lowtag lowtag
:slots (slots)
:size offset
- :variable-length variable-length))
+ :var-length var-length))
,@(constants))
,@(forms)))))
\f
(defun %def-reffer (name offset lowtag)
(let ((info (function-info-or-lose name)))
(setf (function-info-ir2-convert info)
- #'(lambda (node block)
- (ir2-convert-reffer node block name offset lowtag))))
+ (lambda (node block)
+ (ir2-convert-reffer node block name offset lowtag))))
name)
(defmacro def-reffer (name offset lowtag)
(let ((info (function-info-or-lose name)))
(setf (function-info-ir2-convert info)
(if (listp name)
- #'(lambda (node block)
- (ir2-convert-setfer node block name offset lowtag))
- #'(lambda (node block)
- (ir2-convert-setter node block name offset lowtag)))))
+ (lambda (node block)
+ (ir2-convert-setfer node block name offset lowtag))
+ (lambda (node block)
+ (ir2-convert-setter node block name offset lowtag)))))
name)
(defmacro def-setter (name offset lowtag)
`(%def-setter ',name ,offset ,lowtag))
-(defun %def-alloc (name words variable-length header lowtag inits)
+(defun %def-alloc (name words var-length header lowtag inits)
(let ((info (function-info-or-lose name)))
(setf (function-info-ir2-convert info)
- (if variable-length
- #'(lambda (node block)
- (ir2-convert-variable-allocation node block name words header
- lowtag inits))
- #'(lambda (node block)
- (ir2-convert-fixed-allocation node block name words header
- lowtag inits)))))
+ (if var-length
+ (lambda (node block)
+ (ir2-convert-variable-allocation node block name words header
+ lowtag inits))
+ (lambda (node block)
+ (ir2-convert-fixed-allocation node block name words header
+ lowtag inits)))))
name)
-(defmacro def-alloc (name words variable-length header lowtag inits)
- `(%def-alloc ',name ,words ,variable-length ,header ,lowtag ,inits))
+(defmacro def-alloc (name words var-length header lowtag inits)
+ `(%def-alloc ',name ,words ,var-length ,header ,lowtag ,inits))
\f
;;;; some general constant definitions