[cmucl-commit] CMUCL commit: src (2 files)

[Raymond Toy]

    Date: Monday, December 13, 2010 @ 19:26:43
  Author: rtoy
    Path: /project/cmucl/cvsroot/src

   Added: bootfiles/20b/boot-2010-12.lisp
Modified: compiler/generic/new-genesis.lisp

compiler/generic/new-genesis.lisp:
o More cleanups.  Basically back to rev 1.93 with a couple more
  cleanups, but this works on sparc.

bootfiles/20b/boot-2010-12.lisp:
o Use this to bootstrap the necessary values in the compiler backend
  for the foreign-linkage-space.


-----------------------------------+
 bootfiles/20b/boot-2010-12.lisp   |   23 +++++++++++
 compiler/generic/new-genesis.lisp |   71 ++++++------------------------------
 2 files changed, 36 insertions(+), 58 deletions(-)


Index: src/bootfiles/20b/boot-2010-12.lisp
diff -u /dev/null src/bootfiles/20b/boot-2010-12.lisp:1.1
--- /dev/null	Mon Dec 13 19:26:43 2010
+++ src/bootfiles/20b/boot-2010-12.lisp	Mon Dec 13 19:26:42 2010
@@ -0,0 +1,23 @@
+;; Setup backend-foreign-linkage-space-start/entry-size for each
+;; architecture.
+
+#+x86
+(setf (c::backend-foreign-linkage-space-start c:*target-backend*)
+      #+linux #x58000000
+      #-linux #xB0000000
+      (c::backend-foreign-linkage-entry-size c:*target-backend*)
+      8)
+
+#+sparc
+(setf (c::backend-foreign-linkage-space-start c:*target-backend*)
+      ;; This better match the value in sparc-validate.h!
+      #x0f800000
+      (c::backend-foreign-linkage-entry-size c:*target-backend*)
+      ;; This better agree with what sparc-arch.c thinks it is!  Right now,
+      ;; it's 4 instructions, so 16 bytes.
+      16)
+#+ppc
+(setf (c::backend-foreign-linkage-space-start c:*target-backend*)
+      #x17000000
+      (c::backend-foreign-linkage-entry-size c:*target-backend*)
+      32)
\ No newline at end of file
Index: src/compiler/generic/new-genesis.lisp
diff -u src/compiler/generic/new-genesis.lisp:1.94 src/compiler/generic/new-genesis.lisp:1.95
--- src/compiler/generic/new-genesis.lisp:1.94	Sat Dec 11 10:07:08 2010
+++ src/compiler/generic/new-genesis.lisp	Mon Dec 13 19:26:43 2010
@@ -4,7 +4,7 @@
 ;;; Carnegie Mellon University, and has been placed in the public domain.
 ;;;
 (ext:file-comment
-  "$Header: /project/cmucl/cvsroot/src/compiler/generic/new-genesis.lisp,v 1.94 2010-12-11 15:07:08 rtoy Exp $")
+  "$Header: /project/cmucl/cvsroot/src/compiler/generic/new-genesis.lisp,v 1.95 2010-12-14 00:26:43 rtoy Exp $")
 ;;;
 ;;; **********************************************************************
 ;;;
@@ -1321,42 +1321,24 @@
 ;; Destructively byte swap a string, if the backend and the native
 ;; backend have different endianness.
 (declaim (inline maybe-byte-swap-string))
-#+unicode
 (defun maybe-byte-swap-string (s &optional (len (length s)))
+  #-unicode
+  (declare (ignore len))
+  #+unicode
   (unless (eq (c:backend-byte-order c:*backend*)
 	      (c:backend-byte-order c:*native-backend*))
     (dotimes (k len)
       (let ((code (char-code (aref s k))))
 	(setf (aref s k) (code-char (swap-16 code))))))
   s)
-#-unicode
-(defun maybe-byte-swap-string (s &optional len)
-  (declare (ignore s len))
-  s)
 
 ;;; Cold-Load-Symbol loads a symbol N characters long from the File and interns
 ;;; that symbol in the given Package.
 ;;;
-#-unicode
-(defun cold-load-symbol (size package)
-  (let ((string (make-string size)))
-    (read-n-bytes *fasl-file* string 0 size)
-    (cold-intern (intern string package) package)))
-
-#+unicode
-(defmacro load-char-code ()
-  (ecase (c::backend-byte-order c::*native-backend*)
-    (:little-endian
-     `(code-char (+ (read-arg 1)
-		    (ash (read-arg 1) 8))))
-    (:big-endian
-     `(code-char (+ (ash (read-arg 1) 8)
-		    (read-arg 1))))))
 
-#+unicode
 (defun cold-load-symbol (size package)
   (let ((string (make-string size)))
-    (read-n-bytes *fasl-file* string 0 (* 2 size))
+    (read-n-bytes *fasl-file* string 0 (* vm:char-bytes size))
     (maybe-byte-swap-string string)
     (cold-intern (intern string package) package)))
 
@@ -1383,21 +1365,11 @@
 		(fop-keyword-small-symbol-save)
   (push-table (cold-load-symbol (clone-arg) *keyword-package*)))
 
-#-unicode
 (clone-cold-fop (fop-uninterned-symbol-save)
 		(fop-uninterned-small-symbol-save)
   (let* ((size (clone-arg))
 	 (name (make-string size)))
-    (read-n-bytes *fasl-file* name 0 size)
-    (let ((symbol (allocate-symbol name)))
-      (push-table symbol))))
-
-#+unicode
-(clone-cold-fop (fop-uninterned-symbol-save)
-		(fop-uninterned-small-symbol-save)
-  (let* ((size (clone-arg))
-	 (name (make-string size)))
-    (read-n-bytes *fasl-file* name 0 (* 2 size))
+    (read-n-bytes *fasl-file* name 0 (* vm:char-bytes size))
     (maybe-byte-swap-string name)
     (let ((symbol (allocate-symbol name)))
       (push-table symbol))))
@@ -1452,20 +1424,11 @@
 
 ;;; Loading vectors...
 
-#-unicode
 (clone-cold-fop (fop-string)
 		(fop-small-string)
   (let* ((len (clone-arg))
 	 (string (make-string len)))
-    (read-n-bytes *fasl-file* string 0 len)
-    (string-to-core string)))
-
-#+unicode
-(clone-cold-fop (fop-string)
-		(fop-small-string)
-  (let* ((len (clone-arg))
-	 (string (make-string len)))
-    (read-n-bytes *fasl-file* string 0 (* 2 len))
+    (read-n-bytes *fasl-file* string 0 (* vm:char-bytes len))
     (maybe-byte-swap-string string)
     (string-to-core string)))
 
@@ -1989,12 +1952,8 @@
 	 (code-object (pop-stack))
 	 (len (read-arg 1))
 	 (sym (make-string len)))
-    #-unicode
-    (read-n-bytes *fasl-file* sym 0 len)
-    #+unicode
-    (progn
-      (read-n-bytes *fasl-file* sym 0 (* 2 len))
-      (maybe-byte-swap-string sym))
+    (read-n-bytes *fasl-file* sym 0 (* vm:char-bytes len))
+    (maybe-byte-swap-string sym)
     
     (let ((offset (read-arg 4))
 	  (value #+linkage-table (cold-register-foreign-linkage sym :code)
@@ -2010,12 +1969,8 @@
 	 (code-object (pop-stack))
 	 (len (read-arg 1))
 	 (sym (make-string len)))
-    #-unicode
-    (read-n-bytes *fasl-file* sym 0 len)
-    #+unicode
-    (progn
-      (read-n-bytes *fasl-file* sym 0 (* 2 len))
-      (maybe-byte-swap-string sym))
+    (read-n-bytes *fasl-file* sym 0 (* vm:char-bytes len))
+    (maybe-byte-swap-string sym)
     (let ((offset (read-arg 4))
 	  (value (cold-register-foreign-linkage sym :data)))
       (do-cold-fixup code-object offset value kind))
@@ -2218,8 +2173,8 @@
 					     type
 					     *cold-linkage-table*
 					     *cold-foreign-hash*)))
-    (+ vm:target-foreign-linkage-space-start
-       (* entry-num vm:target-foreign-linkage-entry-size))))
+    (+ (c:backend-foreign-linkage-space-start c:*backend*)
+       (* entry-num (c:backend-foreign-linkage-entry-size c:*backend*)))))
 
 #+linkage-table
 (defun init-foreign-linkage ()