1.0.4.82: more x86 backend cleanups
[sbcl.git] / src / compiler / generic / genesis.lisp
index 90c22bd..2440b6c 100644 (file)
@@ -1278,6 +1278,8 @@ core and return a descriptor to it."
              (symbols (cdr cold-package-symbols-entry))
              (shadows (package-shadowing-symbols cold-package))
              (documentation (base-string-to-core (documentation cold-package t)))
+             (internal-count 0)
+             (external-count 0)
              (internal *nil-descriptor*)
              (external *nil-descriptor*)
              (imported-internal *nil-descriptor*)
@@ -1319,10 +1321,14 @@ core and return a descriptor to it."
               (case where
                 (:internal (if imported-p
                                (cold-push handle imported-internal)
-                               (cold-push handle internal)))
+                               (progn
+                                 (cold-push handle internal)
+                                 (incf internal-count))))
                 (:external (if imported-p
                                (cold-push handle imported-external)
-                               (cold-push handle external)))))))
+                               (progn
+                                 (cold-push handle external)
+                                 (incf external-count))))))))
         (let ((r *nil-descriptor*))
           (cold-push documentation r)
           (cold-push shadowing r)
@@ -1330,7 +1336,10 @@ core and return a descriptor to it."
           (cold-push imported-internal r)
           (cold-push external r)
           (cold-push internal r)
-          (cold-push (make-make-package-args cold-package) r)
+          (cold-push (make-make-package-args cold-package
+                                             internal-count
+                                             external-count)
+                     r)
           ;; FIXME: It would be more space-efficient to use vectors
           ;; instead of lists here, and space-efficiency here would be
           ;; nice, since it would reduce the peak memory usage in
@@ -1349,9 +1358,9 @@ core and return a descriptor to it."
     (cold-set 'sb!vm::*fp-constant-0f0* (number-to-core 0f0))
     (cold-set 'sb!vm::*fp-constant-1f0* (number-to-core 1f0))))
 
-;;; Make a cold list that can be used as the arg list to MAKE-PACKAGE in order
-;;; to make a package that is similar to PKG.
-(defun make-make-package-args (pkg)
+;;; Make a cold list that can be used as the arg list to MAKE-PACKAGE in
+;;; order to make a package that is similar to PKG.
+(defun make-make-package-args (pkg internal-count external-count)
   (let* ((use *nil-descriptor*)
          (cold-nicknames *nil-descriptor*)
          (res *nil-descriptor*))
@@ -1380,13 +1389,14 @@ core and return a descriptor to it."
       (dolist (warm-nickname warm-nicknames)
         (cold-push (base-string-to-core warm-nickname) cold-nicknames)))
 
-    (cold-push (number-to-core (truncate (package-internal-symbol-count pkg)
-                                         0.8))
-               res)
+    ;; INTERNAL-COUNT and EXTERNAL-COUNT are the number of symbols that
+    ;; the package contains in the core. We arrange for the package
+    ;; symbol tables to be created somewhat larger so that they don't
+    ;; need to be rehashed so easily when additional symbols are
+    ;; interned during the warm build.
+    (cold-push (number-to-core (truncate internal-count 0.8)) res)
     (cold-push (cold-intern :internal-symbols) res)
-    (cold-push (number-to-core (truncate (package-external-symbol-count pkg)
-                                         0.8))
-               res)
+    (cold-push (number-to-core (truncate external-count 0.8)) res)
     (cold-push (cold-intern :external-symbols) res)
 
     (cold-push cold-nicknames res)
@@ -2728,22 +2738,17 @@ core and return a descriptor to it."
             (setf prev-priority priority))
           (format t "#define ~A " name)
           (format t
-                  ;; KLUDGE: As of sbcl-0.6.7.14, we're dumping two
-                  ;; different kinds of values here, (1) small codes
-                  ;; and (2) machine addresses. The small codes can be
-                  ;; dumped as bare integer values. The large machine
-                  ;; addresses might cause problems if they're large
-                  ;; and represented as (signed) C integers, so we
-                  ;; want to force them to be unsigned. We do that by
-                  ;; wrapping them in the LISPOBJ macro. (We could do
-                  ;; it with a bare "(unsigned)" cast, except that
-                  ;; this header file is used not only in C files, but
-                  ;; also in assembly files, which don't understand
-                  ;; the cast syntax. The LISPOBJ macro goes away in
-                  ;; assembly files, but that shouldn't matter because
-                  ;; we don't do arithmetic on address constants in
-                  ;; assembly files. See? It really is a kludge..) --
-                  ;; WHN 2000-10-18
+                  ;; KLUDGE: We're dumping two different kinds of
+                  ;; values here, (1) small codes and (2) machine
+                  ;; addresses. The small codes can be dumped as bare
+                  ;; integer values. The large machine addresses might
+                  ;; cause problems if they're large and represented
+                  ;; as (signed) C integers, so we want to force them
+                  ;; to be unsigned by appending an U to the
+                  ;; literal. We can't dump all the values using the
+                  ;; literal-U syntax, since the assembler doesn't
+                  ;; support that syntax and some of the small
+                  ;; constants can be used in assembler files.
                   (let (;; cutoff for treatment as a small code
                         (cutoff (expt 2 16)))
                     (cond ((minusp value)
@@ -2751,7 +2756,7 @@ core and return a descriptor to it."
                           ((< value cutoff)
                            "~D")
                           (t
-                           "LISPOBJ(~DU)")))
+                           "~DU")))
                   value)
           (format t " /* 0x~X */~@[  /* ~A */~]~%" value doc))))
     (terpri))
@@ -2768,6 +2773,13 @@ core and return a descriptor to it."
                   i)))))
   (terpri)
 
+  ;; I'm not really sure why this is in SB!C, since it seems
+  ;; conceptually like something that belongs to SB!VM. In any case,
+  ;; it's needed C-side.
+  (format t "#define BACKEND_PAGE_SIZE ~DU~%" sb!c:*backend-page-size*)
+
+  (terpri)
+
   ;; FIXME: The SPARC has a PSEUDO-ATOMIC-TRAP that differs between
   ;; platforms. If we export this from the SB!VM package, it gets
   ;; written out as #define trap_PseudoAtomic, which is confusing as