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

[ehuelsmann at common-lisp.net]

Author: ehuelsmann
Date: Sat Aug 20 03:03:52 2011
New Revision: 13516

Log:
Fix #161: READTABLE-CASE setting of *readtable* affects FASL content.

Modified:
   trunk/abcl/src/org/armedbear/lisp/Primitives.java
   trunk/abcl/src/org/armedbear/lisp/dump-form.lisp

Modified: trunk/abcl/src/org/armedbear/lisp/Primitives.java
==============================================================================
--- trunk/abcl/src/org/armedbear/lisp/Primitives.java	Fri Aug 19 14:47:21 2011	(r13515)
+++ trunk/abcl/src/org/armedbear/lisp/Primitives.java	Sat Aug 20 03:03:52 2011	(r13516)
@@ -5847,4 +5847,17 @@
         }
     };
 
+    private static final Primitive GET_FASL_READTABLE
+            = new pf_get_fasl_readtable();
+    private static class pf_get_fasl_readtable extends Primitive {
+        pf_get_fasl_readtable() {
+            super("get-fasl-readtable", PACKAGE_SYS, false);
+        }
+        
+        @Override
+        public LispObject execute() {
+            return FaslReadtable.getInstance();
+        }
+    }
+    
 }

Modified: trunk/abcl/src/org/armedbear/lisp/dump-form.lisp
==============================================================================
--- trunk/abcl/src/org/armedbear/lisp/dump-form.lisp	Fri Aug 19 14:47:21 2011	(r13515)
+++ trunk/abcl/src/org/armedbear/lisp/dump-form.lisp	Sat Aug 20 03:03:52 2011	(r13516)
@@ -120,6 +120,12 @@
         (t
          (%stream-output-object object stream))))
 
+(defvar *the-fasl-printer-readtable*
+  (copy-readtable (get-fasl-readtable))
+  "This variable holds a copy of the FASL readtable which we need to bind
+below, in order to prevent the current readtable from influencing the content
+being written to the FASL: the READTABLE-CASE setting influences symbol printing.")
+
 (declaim (ftype (function (t stream) t) dump-form))
 (defun dump-form (form stream)
   (let ((*print-fasl* t)
@@ -142,6 +148,7 @@
         (*print-readably* t)
         (*print-right-margin* nil)
         (*print-structure* t)
+        (*readtable* *the-fasl-printer-readtable*)
 
         ;; make sure to write all floats with their exponent marker:
         ;; the dump-time default may not be the same at load-time