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

[Erik Huelsmann]

Author: ehuelsmann
Date: Sat Mar 12 18:08:21 2011
New Revision: 13248

Log:
Close #138 by implementing finalizers on LispObject derived objects.

Modified:
   trunk/abcl/src/org/armedbear/lisp/Autoload.java
   trunk/abcl/src/org/armedbear/lisp/LispObject.java
   trunk/abcl/src/org/armedbear/lisp/Primitives.java

Modified: trunk/abcl/src/org/armedbear/lisp/Autoload.java
==============================================================================
--- trunk/abcl/src/org/armedbear/lisp/Autoload.java	(original)
+++ trunk/abcl/src/org/armedbear/lisp/Autoload.java	Sat Mar 12 18:08:21 2011
@@ -519,6 +519,8 @@
         autoload(PACKAGE_EXT, "string-position", "StringFunctions");
         autoload(PACKAGE_EXT, "make-weak-reference", "WeakReference", true);
         autoload(PACKAGE_EXT, "weak-reference-value", "WeakReference", true);
+        autoload(PACKAGE_EXT, "finalize", "Primitives", true);
+        autoload(PACKAGE_EXT, "cancel-finalization", "Primitives", true);
         autoload(PACKAGE_JAVA, "%jnew-proxy", "JProxy");
         autoload(PACKAGE_JAVA, "%find-java-class", "JavaObject");
         autoload(PACKAGE_JAVA, "%register-java-class", "JavaObject");

Modified: trunk/abcl/src/org/armedbear/lisp/LispObject.java
==============================================================================
--- trunk/abcl/src/org/armedbear/lisp/LispObject.java	(original)
+++ trunk/abcl/src/org/armedbear/lisp/LispObject.java	Sat Mar 12 18:08:21 2011
@@ -1284,4 +1284,25 @@
   public void incrementHotCount()
   {
   }
+
+  private Cons finalizers = null;
+
+  synchronized public void addFinalizer(LispObject fun) {
+      finalizers = new Cons(fun, finalizers);
+  }
+
+  synchronized public void cancelFinalizers() {
+      finalizers = null;
+  }
+
+  @Override
+  @SuppressWarnings("FinalizeDeclaration")
+  protected void finalize()
+    throws Throwable {
+      while (finalizers != null) {
+          finalizers.car.execute();
+          finalizers = (Cons)finalizers.cdr;
+      }
+      super.finalize();
+  }
 }

Modified: trunk/abcl/src/org/armedbear/lisp/Primitives.java
==============================================================================
--- trunk/abcl/src/org/armedbear/lisp/Primitives.java	(original)
+++ trunk/abcl/src/org/armedbear/lisp/Primitives.java	Sat Mar 12 18:08:21 2011
@@ -2,6 +2,7 @@
  * Primitives.java
  *
  * Copyright (C) 2002-2007 Peter Graves
+ * Copyright (C) 2011 Erik Huelsmann
  * $Id$
  *
  * This program is free software; you can redistribute it and/or
@@ -5818,4 +5819,34 @@
         }
     };
 
+    // ### finalize
+    private static final Primitive FINALIZE
+        = new pf_finalize();
+    private static final class pf_finalize extends Primitive {
+        pf_finalize() {
+            super("finalize", PACKAGE_EXT, true, "object function");
+        }
+
+        @Override
+        public LispObject execute(LispObject obj, LispObject fun) {
+            obj.addFinalizer(fun);
+            return obj;
+        }
+    };
+
+    // ### cancel-finalization
+    private static final Primitive CANCEL_FINALIZATION
+        = new pf_cancel_finalization();
+    private static final class pf_cancel_finalization extends Primitive {
+        pf_cancel_finalization() {
+            super("cancel-finalization", PACKAGE_EXT, true, "object");
+        }
+
+        @Override
+        public LispObject execute(LispObject obj) {
+            obj.cancelFinalizers();
+            return obj;
+        }
+    };
+
 }