0.pre7.129:

[sbcl.git] / src / compiler / generic / vm-macs.lisp

diff --git a/src/compiler/generic/vm-macs.lisp b/src/compiler/generic/vm-macs.lisp
index 0d50cf4..b40ddff 100644 (file)
--- a/src/compiler/generic/vm-macs.lisp
+++ b/src/compiler/generic/vm-macs.lisp
@@ -45,12 +45,12 @@
 
 (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)
 
@@ -63,13 +63,13 @@
     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
@@ -103,30 +103,24 @@
          (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
-        (let ((sb!int::*rogue-export* "DEFINE-PRIMITIVE-OBJECT"))
-          (export ',(exports)))
         (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
@@ -135,42 +129,42 @@
 (in-package "SB!C")
 
 (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))))
+  (let ((info (fun-info-or-lose name)))
+    (setf (fun-info-ir2-convert info)
+         (lambda (node block)
+           (ir2-convert-reffer node block name offset lowtag))))
   name)
 
 (defmacro def-reffer (name offset lowtag)
   `(%def-reffer ',name ,offset ,lowtag))
 
 (defun %def-setter (name offset lowtag)
-  (let ((info (function-info-or-lose name)))
-    (setf (function-info-ir2-convert info)
+  (let ((info (fun-info-or-lose name)))
+    (setf (fun-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)
-  (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)))))
+(defun %def-alloc (name words var-length header lowtag inits)
+  (let ((info (fun-info-or-lose name)))
+    (setf (fun-info-ir2-convert info)
+         (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