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

[Erik Huelsmann]

Author: ehuelsmann
Date: Sat May 16 13:59:40 2009
New Revision: 11883

Log:
Remove CompiledClosure;
Rename ClosureTemplateFunction to CompiledClosure,
as it is no longer a template: it holds the closure context.

Added:
   trunk/abcl/src/org/armedbear/lisp/CompiledClosure.java
      - copied, changed from r11882, /trunk/abcl/src/org/armedbear/lisp/ClosureTemplateFunction.java
Removed:
   trunk/abcl/src/org/armedbear/lisp/ClosureTemplateFunction.java
Modified:
   trunk/abcl/src/org/armedbear/lisp/Lisp.java
   trunk/abcl/src/org/armedbear/lisp/Primitives.java
   trunk/abcl/src/org/armedbear/lisp/compiler-pass2.lisp

Copied: trunk/abcl/src/org/armedbear/lisp/CompiledClosure.java (from r11882, /trunk/abcl/src/org/armedbear/lisp/ClosureTemplateFunction.java)
==============================================================================
--- /trunk/abcl/src/org/armedbear/lisp/ClosureTemplateFunction.java	(original)
+++ trunk/abcl/src/org/armedbear/lisp/CompiledClosure.java	Sat May 16 13:59:40 2009
@@ -1,5 +1,5 @@
 /*
- * ClosureTemplateFunction.java
+ * CompiledClosure.java
  *
  * Copyright (C) 2004-2005 Peter Graves
  * $Id$
@@ -33,29 +33,29 @@
 
 package org.armedbear.lisp;
 
-public class ClosureTemplateFunction extends Closure
+public class CompiledClosure extends Closure
         implements Cloneable
 {
 
   public ClosureBinding[] ctx;
 
-  public ClosureTemplateFunction(LispObject lambdaList)
+  public CompiledClosure(LispObject lambdaList)
     throws ConditionThrowable
   {
     super(list(Symbol.LAMBDA, lambdaList), null);
   }
 
-  final public ClosureTemplateFunction setContext(ClosureBinding[] context)
+  final public CompiledClosure setContext(ClosureBinding[] context)
   {
     ctx = context;
     return this;
   }
 
-  final public ClosureTemplateFunction dup()
+  final public CompiledClosure dup()
   {
-      ClosureTemplateFunction result = null;
+      CompiledClosure result = null;
       try {
-	  result = (ClosureTemplateFunction)super.clone();
+	  result = (CompiledClosure)super.clone();
       } catch (CloneNotSupportedException e) {
       }
       return result;

Modified: trunk/abcl/src/org/armedbear/lisp/Lisp.java
==============================================================================
--- trunk/abcl/src/org/armedbear/lisp/Lisp.java	(original)
+++ trunk/abcl/src/org/armedbear/lisp/Lisp.java	Sat May 16 13:59:40 2009
@@ -1189,7 +1189,7 @@
                                                      ClosureBinding[] context)
     throws ConditionThrowable
   {
-    return ((ClosureTemplateFunction)template).dup().setContext(context);
+    return ((CompiledClosure)template).dup().setContext(context);
   }
 
   public static final String safeWriteToString(LispObject obj)

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 May 16 13:59:40 2009
@@ -2439,13 +2439,6 @@
             LispObject name = ((CompiledClosure)arg).getLambdaName();
             value3 = name != null ? name : NIL;
           }
-        else if (arg instanceof ClosureTemplateFunction)
-          {
-            value1 = NIL;
-            value2 = T;
-            LispObject name = ((ClosureTemplateFunction)arg).getLambdaName();
-            value3 = name != null ? name : NIL;
-          }
         else if (arg instanceof Closure && !(arg instanceof CompiledFunction))
           {
             Closure closure = (Closure) arg;

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 16 13:59:40 2009
@@ -240,7 +240,7 @@
 (defconstant +lisp-throw-class+ "org/armedbear/lisp/Throw")
 (defconstant +lisp-return-class+ "org/armedbear/lisp/Return")
 (defconstant +lisp-go-class+ "org/armedbear/lisp/Go")
-(defconstant +lisp-ctf-class+ "org/armedbear/lisp/ClosureTemplateFunction")
+(defconstant +lisp-compiled-closure-class+ "org/armedbear/lisp/CompiledClosure")
 (defconstant +lisp-compiled-function-class+ "org/armedbear/lisp/CompiledFunction")
 (defconstant +lisp-primitive-class+ "org/armedbear/lisp/Primitive")
 (defconstant +lisp-hash-table-class+ "org/armedbear/lisp/HashTable")
@@ -1816,7 +1816,7 @@
            (emit-constructor-lambda-name lambda-name)
            (emit-constructor-lambda-list args)
            (emit-invokespecial-init super (lisp-object-arg-types 2)))
-          ((equal super +lisp-ctf-class+)
+          ((equal super +lisp-compiled-closure-class+)
            (emit-constructor-lambda-list args)
            (emit-invokespecial-init super (lisp-object-arg-types 1)))
           (t
@@ -3036,7 +3036,7 @@
              (emit 'getstatic *this-class* g +lisp-object+)
                                         ; Stack: template-function
              (when *closure-variables*
-               (emit 'checkcast +lisp-ctf-class+)
+               (emit 'checkcast +lisp-compiled-closure-class+)
                (duplicate-closure-array compiland)
                (emit-invokestatic +lisp-class+ "makeCompiledClosure"
                                   (list +lisp-object+ +closure-binding-array+)
@@ -4856,7 +4856,7 @@
     (when (compiland-closure-register parent)
       (dformat t "(compiland-closure-register parent) = ~S~%"
 	       (compiland-closure-register parent))
-      (emit 'checkcast +lisp-ctf-class+)
+      (emit 'checkcast +lisp-compiled-closure-class+)
       (duplicate-closure-array parent)
       (emit-invokestatic +lisp-class+ "makeCompiledClosure"
 			 (list +lisp-object+ +closure-binding-array+)
@@ -5016,7 +5016,7 @@
                                         ; Stack: template-function
 
                (when (compiland-closure-register *current-compiland*)
-                 (emit 'checkcast +lisp-ctf-class+)
+                 (emit 'checkcast +lisp-compiled-closure-class+)
                  (duplicate-closure-array *current-compiland*)
                  (emit-invokestatic +lisp-class+ "makeCompiledClosure"
                                     (list +lisp-object+ +closure-binding-array+)
@@ -8051,7 +8051,7 @@
             (emit 'anewarray +closure-binding-class+))
         (progn
           (aload 0)
-          (emit 'getfield +lisp-ctf-class+ "ctx"
+          (emit 'getfield +lisp-compiled-closure-class+ "ctx"
                 +closure-binding-array+)
           (when local-closure-vars
             ;; in all other cases, it gets stored in the register below
@@ -8215,7 +8215,7 @@
                              (pool-name (method-name execute-method)))
                        (setf (method-descriptor-index execute-method)
                              (pool-name (method-descriptor execute-method)))
-                       +lisp-ctf-class+)
+                       +lisp-compiled-closure-class+)
                      (if *hairy-arglist-p*
                          +lisp-compiled-function-class+
                          +lisp-primitive-class+)))