X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fcompiler%2Fgeneric%2Fvm-macs.lisp;h=639f7e422f695d7c71451969bc8c436467172682;hb=e511ed14d4a20cb9de2523f052b0f23a1dde1115;hp=86d3bcb00eeb51f360da1e9b96cd7158992a05bd;hpb=a530bbe337109d898d5b4a001fc8f1afa3b5dc39;p=sbcl.git

diff --git a/src/compiler/generic/vm-macs.lisp b/src/compiler/generic/vm-macs.lisp
index 86d3bcb..639f7e4 100644
--- a/src/compiler/generic/vm-macs.lisp
+++ b/src/compiler/generic/vm-macs.lisp
@@ -11,9 +11,6 @@
 ;;;; files for more information.
 
 (in-package "SB!VM")
-
-(file-comment
-  "$Header$")
 
 ;;;; other miscellaneous stuff
 
@@ -48,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)))
+  (variable-length-p nil :type (member t nil)))
 
 (defvar *primitive-objects* nil)
 
@@ -66,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))
+	  (variable-length-p nil))
       (dolist (spec slot-specs)
-	(when variable-length
+	(when variable-length-p
 	  (error "No more slots can follow a :rest-p slot."))
 	(destructuring-bind
 	    (slot-name &rest options
@@ -87,7 +84,7 @@
 					     '(:docs :rest-p :length))))
 	  (let ((offset-sym (symbolicate name "-" slot-name
 					 (if rest-p "-OFFSET" "-SLOT"))))
-	    (constants `(defconstant ,offset-sym ,offset
+	    (constants `(def!constant ,offset-sym ,offset
 			  ,@(when docs (list docs))))
 	    (exports offset-sym))
 	  (when ref-trans
@@ -106,30 +103,24 @@
 	  (when init
 	    (inits (cons init offset)))
 	  (when rest-p
-	    (setf variable-length t))
+	    (setf variable-length-p t))
 	  (incf offset length)))
-      (unless variable-length
+      (unless variable-length-p
 	(let ((size (symbolicate name "-SIZE")))
-	  (constants `(defconstant ,size ,offset
-			,(format nil
-				 "Number of slots used by each ~S~
-				  ~@[~* including the header~]."
-				 name header)))
+	  (constants `(def!constant ,size ,offset))
 	  (exports size)))
       (when alloc-trans
-	(forms `(def-alloc ,alloc-trans ,offset ,variable-length ,header
+	(forms `(def-alloc ,alloc-trans ,offset ,variable-length-p ,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))
+				     :variable-length-p variable-length-p))
 	   ,@(constants))
 	 ,@(forms)))))
 
@@ -137,43 +128,18 @@
 
 (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))))
-  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)
-	  (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)))))
-  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)))))
-  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 variable-length-p header lowtag inits)
+  `(%def-alloc ',name ,words ,variable-length-p ,header ,lowtag ,inits))
+;;; KLUDGE: The %DEF-FOO functions used to implement the macros here
+;;; are defined later in another file, since they use structure slot
+;;; setters defined later, and we can't have physical forward
+;;; references to structure slot setters because ANSI in its wisdom
+;;; allows the xc host CL to implement structure slot setters as SETF
+;;; expanders instead of SETF functions. -- WHN 2002-02-09
 
 ;;;; some general constant definitions
 
@@ -182,4 +148,4 @@
 (in-package "SB!C")
 
 ;;; the maximum number of SCs in any implementation
-(defconstant sc-number-limit 32)
+(def!constant sc-number-limit 32)