[armedbear-cvs] r13850 - trunk/abcl/src/org/armedbear/lisp
ehuelsmann at common-lisp.net
ehuelsmann at common-lisp.net
Sat Feb 4 13:09:36 UTC 2012
Author: ehuelsmann
Date: Sat Feb 4 05:09:35 2012
New Revision: 13850
Log:
Remove Closure.fastProcessArgs(): it's concept has been abstracted away
in ArgumentListProcessor.
Modified:
trunk/abcl/src/org/armedbear/lisp/ArgumentListProcessor.java
trunk/abcl/src/org/armedbear/lisp/Closure.java
trunk/abcl/src/org/armedbear/lisp/compiler-pass2.lisp
trunk/abcl/src/org/armedbear/lisp/jvm-class-file.lisp
Modified: trunk/abcl/src/org/armedbear/lisp/ArgumentListProcessor.java
==============================================================================
--- trunk/abcl/src/org/armedbear/lisp/ArgumentListProcessor.java Sat Feb 4 03:35:39 2012 (r13849)
+++ trunk/abcl/src/org/armedbear/lisp/ArgumentListProcessor.java Sat Feb 4 05:09:35 2012 (r13850)
@@ -545,6 +545,62 @@
/** ArgumentMatcher class which implements full-blown argument matching,
* including validation of the keywords passed. */
private class SlowMatcher extends ArgumentMatcher {
+ private LispObject[] _match(LispObject[] args, Environment _environment,
+ Environment env, LispThread thread) {
+ final ArgList argslist = new ArgList(_environment, args);
+ final LispObject[] array = new LispObject[variables.length];
+ int index = 0;
+
+
+ for (Param p : positionalParameters)
+ index = p.assign(index, array, argslist, env, thread);
+
+ if (andKey) {
+ argslist.assertRemainderKeywords();
+
+ for (Param p : keywordParameters)
+ index = p.assign(index, array, argslist, env, thread);
+ }
+ for (Param p : auxVars)
+ index = p.assign(index, array, argslist, env, thread);
+
+ if (andKey) {
+ if (allowOtherKeys)
+ return array;
+
+ if (!argslist.consumed()) // verify keywords
+ {
+ LispObject allowOtherKeysValue =
+ argslist.findKeywordArg(Keyword.ALLOW_OTHER_KEYS, NIL);
+
+ if (allowOtherKeysValue != NIL)
+ return array;
+
+ // verify keywords
+ next_key:
+ while (! argslist.consumed()) {
+ LispObject key = argslist.consume();
+ argslist.consume(); // consume value
+
+ if (key == Keyword.ALLOW_OTHER_KEYS)
+ continue next_key;
+
+ for (KeywordParam k : keywordParameters)
+ if (k.keyword == key)
+ continue next_key;
+
+ error(new ProgramError("Unrecognized keyword argument " +
+ key.printObject()));
+ }
+ }
+ }
+
+ if (restVar == null && !argslist.consumed())
+ error(new WrongNumberOfArgumentsException(function));
+
+ return array;
+ }
+
@Override
LispObject[] match(LispObject[] args, Environment _environment,
Environment env, LispThread thread) {
@@ -560,60 +616,12 @@
if (args.length < minArgs)
error(new WrongNumberOfArgumentsException(function, minArgs, -1));
+ if (thread == null)
+ return _match(args, _environment, env, thread);
final SpecialBindingsMark mark = thread.markSpecialBindings();
- final LispObject[] array = new LispObject[variables.length];
- int index = 0;
- ArgList argslist = new ArgList(_environment, args);
-
try {
- for (Param p : positionalParameters)
- index = p.assign(index, array, argslist, env, thread);
-
- if (andKey) {
- argslist.assertRemainderKeywords();
-
- for (Param p : keywordParameters)
- index = p.assign(index, array, argslist, env, thread);
- }
- for (Param p : auxVars)
- index = p.assign(index, array, argslist, env, thread);
-
- if (andKey) {
- if (allowOtherKeys)
- return array;
-
- if (!argslist.consumed()) // verify keywords
- {
- LispObject allowOtherKeysValue =
- argslist.findKeywordArg(Keyword.ALLOW_OTHER_KEYS, NIL);
-
- if (allowOtherKeysValue != NIL)
- return array;
-
- // verify keywords
- next_key:
- while (! argslist.consumed()) {
- LispObject key = argslist.consume();
- argslist.consume(); // consume value
-
- if (key == Keyword.ALLOW_OTHER_KEYS)
- continue next_key;
-
- for (KeywordParam k : keywordParameters)
- if (k.keyword == key)
- continue next_key;
-
- error(new ProgramError("Unrecognized keyword argument " +
- key.printObject()));
- }
- }
- }
-
- if (restVar == null && !argslist.consumed())
- error(new WrongNumberOfArgumentsException(function));
-
- return array;
+ return _match(args, _environment, env, thread);
}
finally {
thread.resetSpecialBindings(mark);
Modified: trunk/abcl/src/org/armedbear/lisp/Closure.java
==============================================================================
--- trunk/abcl/src/org/armedbear/lisp/Closure.java Sat Feb 4 03:35:39 2012 (r13849)
+++ trunk/abcl/src/org/armedbear/lisp/Closure.java Sat Feb 4 05:09:35 2012 (r13850)
@@ -221,12 +221,6 @@
return arglist.match(args, environment, environment, thread);
}
- // No optional or keyword parameters.
- protected final LispObject[] fastProcessArgs(LispObject[] args)
- {
- return arglist.match(args, environment, null, null);
- }
-
// ### lambda-list-names
private static final Primitive LAMBDA_LIST_NAMES =
new Primitive("lambda-list-names", PACKAGE_SYS, true)
Modified: trunk/abcl/src/org/armedbear/lisp/compiler-pass2.lisp
==============================================================================
--- trunk/abcl/src/org/armedbear/lisp/compiler-pass2.lisp Sat Feb 4 03:35:39 2012 (r13849)
+++ trunk/abcl/src/org/armedbear/lisp/compiler-pass2.lisp Sat Feb 4 05:09:35 2012 (r13850)
@@ -7046,7 +7046,6 @@
(let* ((p1-result (compiland-p1-result compiland))
(class-file (compiland-class-file compiland))
(*this-class* (abcl-class-file-class class-file))
- (args (cadr p1-result))
(closure-args (intersection *closure-variables*
(compiland-arg-vars compiland)))
(local-closure-vars
@@ -7233,24 +7232,16 @@
(aload 0) ; this
(aver (not (null (compiland-argument-register compiland))))
(aload (compiland-argument-register compiland)) ; arg vector
- (cond ((or (memq '&OPTIONAL args) (memq '&KEY args))
- (ensure-thread-var-initialized)
- (maybe-initialize-thread-var)
- (emit-push-current-thread)
- (emit-invokevirtual *this-class* "processArgs"
- (list +lisp-object-array+ +lisp-thread+)
- +lisp-object-array+))
- (t
- (emit-invokevirtual *this-class* "fastProcessArgs"
- (list +lisp-object-array+)
- +lisp-object-array+)))
+ (emit 'aconst_null) ;; no thread arg required:
+ ;; there's no non-constant initform or special
+ ;; which might require the thread
+ (emit-invokevirtual *this-class* "processArgs"
+ (list +lisp-object-array+ +lisp-thread+)
+ +lisp-object-array+)
(astore (compiland-argument-register compiland)))
- (unless (and *hairy-arglist-p*
- (or (memq '&OPTIONAL args) (memq '&KEY args)))
- (maybe-initialize-thread-var))
- (setf *code* (nconc code *code*)))
- ))
+ (maybe-initialize-thread-var)
+ (setf *code* (nconc code *code*)))))
t)
(defun compile-to-jvm-class (compiland)
Modified: trunk/abcl/src/org/armedbear/lisp/jvm-class-file.lisp
==============================================================================
--- trunk/abcl/src/org/armedbear/lisp/jvm-class-file.lisp Sat Feb 4 03:35:39 2012 (r13849)
+++ trunk/abcl/src/org/armedbear/lisp/jvm-class-file.lisp Sat Feb 4 05:09:35 2012 (r13850)
@@ -189,8 +189,6 @@
"org.armedbear.lisp.ArgumentListProcessor$OptionalParam")
(define-class-name +alp-keyword-parameter+
"org.armedbear.lisp.ArgumentListProcessor$KeywordParam")
-(defconstant +lisp-closure-parameter-array+
- (class-array +lisp-closure-parameter+))
#|
More information about the armedbear-cvs
mailing list