Changeset 11783

Timestamp:

04/25/09 14:19:51 (14 years ago)

Author:

ehuelsmann

Message:

Fix fasl reader special bindings leak.

• Bind the *FASL-ANONYMOUS-PACKAGE* to the outer most scope which needs one, instead of binding it upon first use. Specials shouldn't be bound with indefinite extent: some other code might limit the extent by unbinding its specials.

Location:

trunk/abcl/src/org/armedbear/lisp

Files:

• FaslReader.java (modified) (1 diff)
• Load.java (modified) (2 diffs)
• Primitives.java (modified) (1 diff)
• Stream.java (modified) (1 diff)
• compile-file.lisp (modified) (1 diff)
• compiler-pass2.lisp (modified) (1 diff)
• jvm.lisp (modified) (1 diff)

trunk/abcl/src/org/armedbear/lisp/FaslReader.java

@@ -285 +285 @@
             Symbol symbol = (Symbol) stream.readSymbol(FaslReadtable.getInstance());
             LispObject pkg = Load._FASL_ANONYMOUS_PACKAGE_.symbolValue(thread);
-            if (pkg == NIL) {
-                thread.bindSpecial(Load._FASL_ANONYMOUS_PACKAGE_,
-                                   pkg = new Package());
-            }
+            Debug.assertTrue(pkg != NIL);
             symbol = ((Package)pkg).intern(symbol.getName());
             symbol.setPackage(NIL);

trunk/abcl/src/org/armedbear/lisp/Load.java

@@ -345 +345 @@
     // ### *fasl-anonymous-package*
     // internal symbol
+    /**
+     * This variable gets bound to a package with no name in which the
+     * reader can intern its uninterned symbols.
+     * 
+     */
     public static final Symbol _FASL_ANONYMOUS_PACKAGE_ =
         internSpecial("*FASL-ANONYMOUS-PACKAGE*", PACKAGE_SYS, NIL);
@@ -474 +479 @@
         Stream in = (Stream) _LOAD_STREAM_.symbolValue(thread);
         final Environment env = new Environment();
-        while (true) {
-            LispObject obj = in.faslRead(false, EOF, true, thread);
-            if (obj == EOF)
-                break;
-            eval(obj, env, thread);
+        final SpecialBinding lastSpecialBinding = thread.lastSpecialBinding;
+        try {
+            thread.bindSpecial(_FASL_ANONYMOUS_PACKAGE_, new Package());
+            while (true) {
+                LispObject obj = in.faslRead(false, EOF, true, thread);
+                if (obj == EOF)
+                    break;
+                eval(obj, env, thread);
+            }
+        }
+        finally {
+            thread.lastSpecialBinding = lastSpecialBinding;
         }
         return T;

trunk/abcl/src/org/armedbear/lisp/Primitives.java

@@ -3018 +3018 @@
     new Primitive("%make-package", PACKAGE_SYS, false)
     {
+      /**
+       * This invocation is solely used to be able to create
+       * a package to bind to *FASL-ANONYMOUS-PACKAGE*
+       */
+      @Override
+      public LispObject execute()
+        throws ConditionThrowable
+      {
+        return new Package();
+      }
+
+      /**
+       * This invocation is used by MAKE-PACKAGE to create a package
+       */
       @Override
       public LispObject execute(LispObject first, LispObject second,

trunk/abcl/src/org/armedbear/lisp/Stream.java

@@ -519 +519 @@
     else
       {
+        SpecialBinding lastSpecialBinding = thread.lastSpecialBinding;
         thread.bindSpecial(_SHARP_EQUAL_ALIST_, NIL);
-        return faslReadPreservingWhitespace(eofError, eofValue, true, thread);
+        try
+          {
+            return faslReadPreservingWhitespace(eofError, eofValue, true, thread);
+          }
+        finally
+          {
+            thread.lastSpecialBinding = lastSpecialBinding;
+          }
       }
   }

trunk/abcl/src/org/armedbear/lisp/compile-file.lisp

@@ -428 +428 @@
                   (*explain* *explain*)
                   (jvm::*functions-defined-in-current-file* '())
-                  (*fbound-names* '()))
+                  (*fbound-names* '())
+                  (*fasl-anonymous-package* (%make-package)))
               (jvm::with-file-compilation
                 (write "; -*- Mode: Lisp -*-" :escape nil :stream out)

trunk/abcl/src/org/armedbear/lisp/compiler-pass2.lisp

@@ -5020 +5020 @@
          (set-compiland-and-write-class-file class-file compiland)
          (setf (local-function-class-file local-function) class-file)
-         (setf (local-function-function local-function) (load-compiled-function pathname))
+         (setf (local-function-function local-function)
+                     (load-compiled-function pathname))
          (when (local-function-variable local-function)
      (let ((g (declare-object (load-compiled-function pathname))))

trunk/abcl/src/org/armedbear/lisp/jvm.lisp

@@ -414 +414 @@
 (defun compile (name &optional definition)
   (let ((*file-compilation* nil)
-        (*pathnames-generator* #'make-temp-file))
+        (*pathnames-generator* #'make-temp-file)
+        (sys::*fasl-anonymous-package* (sys::%make-package)))
     (jvm-compile name definition)))