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

Erik Huelsmann ehuels at gmail.com
Sun Dec 21 23:02:47 UTC 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 at 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 at common-lisp.net
> http://common-lisp.net/cgi-bin/mailman/listinfo/armedbear-cvs
>




More information about the armedbear-devel mailing list