[armedbear-cvs] r13275 - trunk/abcl/src/org/armedbear/lisp

[Erik Huelsmann]

Author: ehuelsmann
Date: Sat May  7 19:31:35 2011
New Revision: 13275

Log:
Fix the remainder of ticket #147: make sure we write proper-case
symbol and package names to allow case sensitive reading of symbols
as required by (e.g.) Qi.

Modified:
   trunk/abcl/src/org/armedbear/lisp/compile-file.lisp
   trunk/abcl/src/org/armedbear/lisp/compiler-pass2.lisp

Modified: trunk/abcl/src/org/armedbear/lisp/compile-file.lisp
==============================================================================
--- trunk/abcl/src/org/armedbear/lisp/compile-file.lisp	(original)
+++ trunk/abcl/src/org/armedbear/lisp/compile-file.lisp	Sat May  7 19:31:35 2011
@@ -592,7 +592,39 @@
             ;; write header
             (write "; -*- Mode: Lisp -*-" :escape nil :stream out)
             (%stream-terpri out)
-            (let ((*package* (find-package '#:cl)))
+            (let ((*package* (find-package '#:cl))
+                  (*print-fasl* t)
+                  (*print-array* t)
+                  (*print-base* 10)
+                  (*print-case* :upcase)
+                  (*print-circle* nil)
+                  (*print-escape* t)
+                  (*print-gensym* t)
+                  (*print-length* nil)
+                  (*print-level* nil)
+                  (*print-lines* nil)
+                  (*print-pretty* nil)
+                  (*print-radix* nil)
+                  (*print-readably* t)
+                  (*print-right-margin* nil)
+                  (*print-structure* t)
+
+                  ;; make sure to write all floats with their exponent marker:
+                  ;; the dump-time default may not be the same at load-time
+
+                  (*read-default-float-format* nil))
+
+              ;; these values are also bound by WITH-STANDARD-IO-SYNTAX,
+              ;; but not used by our reader/printer, so don't bind them,
+              ;; for efficiency reasons.
+              ;;        (*read-eval* t)
+              ;;        (*read-suppress* nil)
+              ;;        (*print-miser-width* nil)
+              ;;        (*print-pprint-dispatch* (copy-pprint-dispatch nil))
+              ;;        (*read-base* 10)
+              ;;        (*read-default-float-format* 'single-float)
+              ;;        (*readtable* (copy-readtable nil))
+
               (write (list 'init-fasl :version *fasl-version*)
                      :stream out)
               (%stream-terpri out)

Modified: trunk/abcl/src/org/armedbear/lisp/compiler-pass2.lisp
==============================================================================
--- trunk/abcl/src/org/armedbear/lisp/compiler-pass2.lisp	(original)
+++ trunk/abcl/src/org/armedbear/lisp/compiler-pass2.lisp	Sat May  7 19:31:35 2011
@@ -929,12 +929,7 @@
 
 (defun emit-constructor-lambda-list (lambda-list)
   (if lambda-list
-      (let* ((*print-level* nil)
-             (*print-length* nil)
-             (s (sys::%format nil "~S" lambda-list)))
-        (emit 'ldc (pool-string s))
-        (emit-invokestatic +lisp+ "readObjectFromString"
-                           (list +java-string+) +lisp-object+))
+      (serialize-object lambda-list)
       (emit-push-nil)))
 
 (defun emit-read-from-string (object)