Re: [armedbear-devel] [armedbear-cvs] r11465 - trunk/abcl/src/org/armedbear/lisp - armedbear-devel - mailman3.common-lisp.net

21 Dec 2008

If you're using trunk, you'll need to delete your .abcl files after
updating and building this commit:

it changes the structure of the .cls files stored in the .abcl files.

Bye,

Erik.

On Sun, Dec 21, 2008 at 11:16 PM, Erik Huelsmann
<ehuelsmann@common-lisp.net> wrote:
...
Author: ehuelsmann
Date: Sun Dec 21 22:16:29 2008
New Revision: 11465
Log:
Make clear difference between calling the template evaluator or evaluating the object. (Relates to ClosureTemplateFunction.)
Modified:
  trunk/abcl/src/org/armedbear/lisp/ClosureTemplateFunction.java
  trunk/abcl/src/org/armedbear/lisp/CompiledClosure.java
  trunk/abcl/src/org/armedbear/lisp/compiler-pass2.lisp
Modified: trunk/abcl/src/org/armedbear/lisp/ClosureTemplateFunction.java
==============================================================================

--- trunk/abcl/src/org/armedbear/lisp/ClosureTemplateFunction.java      (original)
+++ trunk/abcl/src/org/armedbear/lisp/ClosureTemplateFunction.java      Sun Dec 21 22:16:29 2008
@@ -33,42 +33,62 @@
package org.armedbear.lisp;
-public abstract class ClosureTemplateFunction extends Closure
+public class ClosureTemplateFunction extends Closure
+        implements Cloneable
 {
+
+  public LispObject[] ctx;
+
  public ClosureTemplateFunction(LispObject lambdaList)
    throws ConditionThrowable
  {
    super(list2(Symbol.LAMBDA, lambdaList), null);
  }
+  public ClosureTemplateFunction setContext(LispObject[] context)
+  {
+    ctx = context;
+    return this;
+  }
+
+  public ClosureTemplateFunction dup()
+      throws CloneNotSupportedException
+  {
+      return (ClosureTemplateFunction)super.clone();
+  }
+
+
+
+    // execute methods have the semantic meaning
+    // "evaluate this object"
  public final LispObject execute() throws ConditionThrowable
  {
-    return notImplemented();
+      return _execute(ctx);
  }
public final LispObject execute(LispObject arg) throws ConditionThrowable
  {
-    return notImplemented();
+      return _execute(ctx);
  }
public final LispObject execute(LispObject first, LispObject second)
    throws ConditionThrowable
  {
-    return notImplemented();
+      return _execute(ctx, first, second);
  }
public final LispObject execute(LispObject first, LispObject second,
                                  LispObject third)
    throws ConditionThrowable
  {
-    return notImplemented();
+      return _execute(ctx, first, second, third);
  }
public final LispObject execute(LispObject first, LispObject second,
                                  LispObject third, LispObject fourth)
    throws ConditionThrowable
  {
-    return notImplemented();
+      return _execute(ctx, first, second, third, fourth);
  }
public final LispObject execute(LispObject first, LispObject second,
@@ -76,7 +96,7 @@
                                  LispObject fifth)
    throws ConditionThrowable
  {
-    return notImplemented();
+      return _execute(ctx, first, second, third, fourth, fifth);
  }
public final LispObject execute(LispObject first, LispObject second,
@@ -84,7 +104,7 @@
                                  LispObject fifth, LispObject sixth)
    throws ConditionThrowable
  {
-    return notImplemented();
+      return _execute(ctx, first, second, third, fourth, fifth, sixth);
  }
public final LispObject execute(LispObject first, LispObject second,
@@ -93,7 +113,7 @@
                                  LispObject seventh)
    throws ConditionThrowable
  {
-    return notImplemented();
+      return _execute(ctx, first, second, third, fourth, fifth, sixth, seventh);
  }
public final LispObject execute(LispObject first, LispObject second,
@@ -102,7 +122,14 @@
                                  LispObject seventh, LispObject eighth)
    throws ConditionThrowable
  {
-    return notImplemented();
+      return _execute(ctx, first, second, third, fourth, fifth,
+              sixth, seventh, eighth);
+  }
+
+  public final LispObject execute(LispObject[] args)
+    throws ConditionThrowable
+  {
+    return _execute(ctx, args);
  }
private final LispObject notImplemented() throws ConditionThrowable
@@ -110,35 +137,39 @@
    return error(new WrongNumberOfArgumentsException(this));
  }
+
+    // _execute methods have the semantic meaning
+    // "evaluate this template with these values"
+
  // Zero args.
-  public LispObject execute(LispObject[] context) throws ConditionThrowable
+  public LispObject _execute(LispObject[] context) throws ConditionThrowable
  {
    LispObject[] args = new LispObject[0];
-    return execute(context, args);
+    return _execute(context, args);
  }
// One arg.
-  public LispObject execute(LispObject[] context, LispObject first)
+  public LispObject _execute(LispObject[] context, LispObject first)
    throws ConditionThrowable
  {
    LispObject[] args = new LispObject[1];
    args[0] = first;
-    return execute(context, args);
+    return _execute(context, args);
  }
// Two args.
-  public LispObject execute(LispObject[] context, LispObject first,
+  public LispObject _execute(LispObject[] context, LispObject first,
                            LispObject second)
    throws ConditionThrowable
  {
    LispObject[] args = new LispObject[2];
    args[0] = first;
    args[1] = second;
-    return execute(context, args);
+    return _execute(context, args);
  }
// Three args.
-  public LispObject execute(LispObject[] context, LispObject first,
+  public LispObject _execute(LispObject[] context, LispObject first,
                            LispObject second, LispObject third)
    throws ConditionThrowable
  {
@@ -146,11 +177,11 @@
    args[0] = first;
    args[1] = second;
    args[2] = third;
-    return execute(context, args);
+    return _execute(context, args);
  }
// Four args.
-  public LispObject execute(LispObject[] context, LispObject first,
+  public LispObject _execute(LispObject[] context, LispObject first,
                            LispObject second, LispObject third,
                            LispObject fourth)
    throws ConditionThrowable
@@ -160,11 +191,11 @@
    args[1] = second;
    args[2] = third;
    args[3] = fourth;
-    return execute(context, args);
+    return _execute(context, args);
  }
// Five args.
-  public LispObject execute(LispObject[] context, LispObject first,
+  public LispObject _execute(LispObject[] context, LispObject first,
                            LispObject second, LispObject third,
                            LispObject fourth, LispObject fifth)
    throws ConditionThrowable
@@ -175,11 +206,11 @@
    args[2] = third;
    args[3] = fourth;
    args[4] = fifth;
-    return execute(context, args);
+    return _execute(context, args);
  }
// Six args.
-  public LispObject execute(LispObject[] context, LispObject first,
+  public LispObject _execute(LispObject[] context, LispObject first,
                            LispObject second, LispObject third,
                            LispObject fourth, LispObject fifth,
                            LispObject sixth)
@@ -192,11 +223,11 @@
    args[3] = fourth;
    args[4] = fifth;
    args[5] = sixth;
-    return execute(context, args);
+    return _execute(context, args);
  }
// Seven args.
-  public LispObject execute(LispObject[] context, LispObject first,
+  public LispObject _execute(LispObject[] context, LispObject first,
                            LispObject second, LispObject third,
                            LispObject fourth, LispObject fifth,
                            LispObject sixth, LispObject seventh)
@@ -210,11 +241,11 @@
    args[4] = fifth;
    args[5] = sixth;
    args[6] = seventh;
-    return execute(context, args);
+    return _execute(context, args);
  }
// Eight args.
-  public LispObject execute(LispObject[] context, LispObject first,
+  public LispObject _execute(LispObject[] context, LispObject first,
                            LispObject second, LispObject third,
                            LispObject fourth, LispObject fifth,
                            LispObject sixth, LispObject seventh,
@@ -230,11 +261,11 @@
    args[5] = sixth;
    args[6] = seventh;
    args[7] = eighth;
-    return execute(context, args);
+    return _execute(context, args);
  }
// Arg array.
-  public LispObject execute(LispObject[] context, LispObject[] args)
+  public LispObject _execute(LispObject[] context, LispObject[] args)
    throws ConditionThrowable
  {
    return notImplemented();
Modified: trunk/abcl/src/org/armedbear/lisp/CompiledClosure.java
==============================================================================
--- trunk/abcl/src/org/armedbear/lisp/CompiledClosure.java      (original)
+++ trunk/abcl/src/org/armedbear/lisp/CompiledClosure.java      Sun Dec 21 22:16:29 2008
@@ -53,32 +53,32 @@
public LispObject execute() throws ConditionThrowable
    {
-        return ctf.execute(context);
+        return ctf._execute(context);
    }
public LispObject execute(LispObject arg) throws ConditionThrowable
    {
-        return ctf.execute(context, arg);
+        return ctf._execute(context, arg);
    }
public LispObject execute(LispObject first, LispObject second)
        throws ConditionThrowable
    {
-        return ctf.execute(context, first, second);
+        return ctf._execute(context, first, second);
    }
public LispObject execute(LispObject first, LispObject second,
                              LispObject third)
        throws ConditionThrowable
    {
-        return ctf.execute(context, first, second, third);
+        return ctf._execute(context, first, second, third);
    }
public LispObject execute(LispObject first, LispObject second,
                              LispObject third, LispObject fourth)
        throws ConditionThrowable
    {
-        return ctf.execute(context, first, second, third, fourth);
+        return ctf._execute(context, first, second, third, fourth);
    }
public LispObject execute(LispObject first, LispObject second,
@@ -86,7 +86,7 @@
                              LispObject fifth)
        throws ConditionThrowable
    {
-        return ctf.execute(context, first, second, third, fourth, fifth);
+        return ctf._execute(context, first, second, third, fourth, fifth);
    }
public LispObject execute(LispObject first, LispObject second,
@@ -94,7 +94,7 @@
                              LispObject fifth, LispObject sixth)
        throws ConditionThrowable
    {
-        return ctf.execute(context, first, second, third, fourth, fifth, sixth);
+        return ctf._execute(context, first, second, third, fourth, fifth, sixth);
    }
public LispObject execute(LispObject first, LispObject second,
@@ -103,7 +103,7 @@
                              LispObject seventh)
        throws ConditionThrowable
    {
-        return ctf.execute(context, first, second, third, fourth, fifth, sixth,
+        return ctf._execute(context, first, second, third, fourth, fifth, sixth,
                           seventh);
    }
@@ -113,12 +113,12 @@
                              LispObject seventh, LispObject eighth)
        throws ConditionThrowable
    {
-        return ctf.execute(context, first, second, third, fourth, fifth, sixth,
+        return ctf._execute(context, first, second, third, fourth, fifth, sixth,
                           seventh, eighth);
    }
public LispObject execute(LispObject[] args) throws ConditionThrowable
    {
-        return ctf.execute(context, args);
+        return ctf._execute(context, args);
    }
 }
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       Sun Dec 21 22:16:29 2008
@@ -8939,7 +8939,14 @@
                 super)
                (*child-p*
                 (if *closure-variables*
-                     +lisp-ctf-class+
+                     (progn
+                       (setf execute-method-name
+                             (setf (method-name execute-method) "_execute"))
+                       (setf (method-name-index execute-method)
+                             (pool-name (method-name execute-method)))
+                       (setf (method-descriptor-index execute-method)
+                             (pool-name (method-descriptor execute-method)))
+                       +lisp-ctf-class+)
                     (if *hairy-arglist-p*
                         +lisp-compiled-function-class+
                         +lisp-primitive-class+)))
@@ -9251,4 +9258,4 @@
 (initialize-p2-handlers)
-(provide "COMPILER-PASS2")
\ No newline at end of file
+(provide "COMPILER-PASS2")
_______________________________________________
armedbear-cvs mailing list
armedbear-cvs@common-lisp.net
http://common-lisp.net/cgi-bin/mailman/listinfo/armedbear-cvs


    

Re: [armedbear-devel] [armedbear-cvs] r11465 - trunk/abcl/src/org/armedbear/lisp

Erik Huelsmann

tags

participants (1)