[cmucl-commit] CMUCL commit: cross-sparc-branch src/compiler/generic (new-genesis.lisp)

Raymond Toy rtoy at common-lisp.net
Thu Nov 18 01:25:10 CET 2010


    Date: Wednesday, November 17, 2010 @ 19:25:10
  Author: rtoy
    Path: /project/cmucl/cvsroot/src/compiler/generic
     Tag: cross-sparc-branch

Modified: new-genesis.lisp

o Comment out debugging prints.
o Add some comments.


------------------+
 new-genesis.lisp |   41 ++++++++++++++++++++++++++++++-----------
 1 file changed, 30 insertions(+), 11 deletions(-)


Index: src/compiler/generic/new-genesis.lisp
diff -u src/compiler/generic/new-genesis.lisp:1.91.2.2 src/compiler/generic/new-genesis.lisp:1.91.2.3
--- src/compiler/generic/new-genesis.lisp:1.91.2.2	Tue Nov 16 17:01:49 2010
+++ src/compiler/generic/new-genesis.lisp	Wed Nov 17 19:25:10 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.91.2.2 2010-11-16 22:01:49 rtoy Exp $")
+  "$Header: /project/cmucl/cvsroot/src/compiler/generic/new-genesis.lisp,v 1.91.2.3 2010-11-18 00:25:10 rtoy Exp $")
 ;;;
 ;;; **********************************************************************
 ;;;
@@ -436,14 +436,17 @@
       (setf (aref bytes k) (logand #xffff (char-code (aref string k)))))
     (unless (eq (c:backend-byte-order c:*backend*)
 		(c:backend-byte-order c:*native-backend*))
-      ;; Swap byte order of unicode strings.
-      (format t "s-t-c: len = ~d, ~S~%" len string)
-      (format t "     codes = ~{~X~^ ~}~%" (map 'list #'char-code string))
+      ;; Swap byte order of unicode strings if the backend and
+      ;; native-backend have different endianness.
+      #+(or)
+      (progn
+	(format t "s-t-c: len = ~d, ~S~%" len string)
+	(format t "     codes = ~{~X~^ ~}~%" (map 'list #'char-code string)))
       (dotimes (k len)
 	(let ((x (aref bytes k)))
 	  (setf (aref bytes k) (maybe-byte-swap-short x))))
-      (format t " new codes = ~{~X~^ ~}~%" (coerce bytes 'list))
-      )
+      #+(or)
+      (format t " new codes = ~{~X~^ ~}~%" (coerce bytes 'list)))
     (copy-to-system-area bytes (* vm:vector-data-offset
 				   ;; the word size of the native backend which
 				   ;; may be different from the target backend
@@ -1341,6 +1344,8 @@
   (logior (ash (ldb (byte 8 0) n) 8)
 	  (ldb (byte 8 8) n)))
 
+;; Destructively byte swap a string, if the backend and the native
+;; backend have different endianness.
 (defun maybe-byte-swap-string (s &optional (len (length s)))
   (unless (eq (c:backend-byte-order c:*backend*)
 	      (c:backend-byte-order c:*native-backend*))
@@ -1353,8 +1358,12 @@
 (defun cold-load-symbol (size package)
   (let ((string (make-string size)))
     (read-n-bytes *fasl-file* string 0 (* 2 size))
+    #+(or)
     (format t "pre swap cold-load-symbol: ~S to package ~S~%" string package)
+    ;; Make the string have the correct byte order for the native
+    ;; backend.
     (maybe-byte-swap-string string)
+    #+(or)
     (format t "post swap cold-load-symbol: ~S to package ~S~%" string package)
     (cold-intern (intern string package) package)))
 
@@ -1464,8 +1473,13 @@
   (let* ((len (clone-arg))
 	 (string (make-string len)))
     (read-n-bytes *fasl-file* string 0 (* 2 len))
+    #+(or)
     (format t "pre fop-string result  = ~{~X~^ ~}~%" (map 'list #'char-code string))
+    ;; Make the string have the correct byte order for the native
+    ;; backend.  (This wouldn't be needed if string-to-core had an
+    ;; option to
     (maybe-byte-swap-string string)
+    #+(or)
     (format t "post fop-string result = ~{~X~^ ~}~%" (map 'list #'char-code string))
     (string-to-core string)))
 
@@ -1994,9 +2008,12 @@
     #+unicode
     (progn
       (read-n-bytes *fasl-file* sym 0 (* 2 len))
-      (format t "foreign-fixup: ~S~%" sym)
-      (format t " codes: ~{~X~^ ~}~%" (map 'list #'char-code sym))
+      #+(or)
+      (progn
+	(format t "foreign-fixup: ~S~%" sym)
+	(format t " codes: ~{~X~^ ~}~%" (map 'list #'char-code sym)))
       (maybe-byte-swap-string sym)
+      #+(or)
       (format t " swaps: ~S~%" sym))
     (let ((offset (read-arg 4))
 	  (value #+linkage-table (cold-register-foreign-linkage sym :code)
@@ -2017,9 +2034,12 @@
     #+unicode
     (progn
       (read-n-bytes *fasl-file* sym 0 (* 2 len))
-      (format t "foreign-data-fixup: ~S~%" sym)
-      (format t " codes: ~{~X~^ ~}~%" (map 'list #'char-code sym))
+      #+(or)
+      (progn
+	(format t "foreign-data-fixup: ~S~%" sym)
+	(format t " codes: ~{~X~^ ~}~%" (map 'list #'char-code sym)))
       (maybe-byte-swap-string sym)
+      #+(or)
       (format t " swaps: ~{~X~^ ~}~%" (map 'list #'char-code sym)))
     (let ((offset (read-arg 4))
 	  (value (cold-register-foreign-linkage sym :data)))
@@ -2484,7 +2504,6 @@
 (defun linkage-info-to-core ()
   (let ((result *nil-descriptor*))
     (maphash #'(lambda (symbol value)
-		 (format t "linkage-info symbol = ~S~%" symbol)
 		 (cold-push (allocate-cons *dynamic*
 					   (string-to-core symbol)
 					   (number-to-core value))


More information about the cmucl-commit mailing list