From ehuelsmann at common-lisp.net Wed Sep 10 20:01:00 2008 From: ehuelsmann at common-lisp.net (ehuelsmann at common-lisp.net) Date: Wed, 10 Sep 2008 16:01:00 -0400 (EDT) Subject: [armedbear-cvs] r11307 - trunk/j/src/org/armedbear/lisp Message-ID: <20080910200100.21CE44204C@common-lisp.net> Author: ehuelsmann Date: Wed Sep 10 16:00:57 2008 New Revision: 11307 Modified: trunk/j/src/org/armedbear/lisp/Pathname.java Log: Make ABCL behave (correctly) with UNC paths - on Windows. Modified: trunk/j/src/org/armedbear/lisp/Pathname.java ============================================================================== --- trunk/j/src/org/armedbear/lisp/Pathname.java (original) +++ trunk/j/src/org/armedbear/lisp/Pathname.java Wed Sep 10 16:00:57 2008 @@ -93,8 +93,30 @@ directory = list2(Keyword.RELATIVE, Keyword.UP); return; } - if (Utilities.isPlatformWindows) + if (Utilities.isPlatformWindows) { + if (s.startsWith("\\\\")) { + //UNC path support + // match \\\\[directories-and-files] + + int shareIndex = s.indexOf('\\', 2); + int dirIndex = s.indexOf('\\', shareIndex + 1); + + if (shareIndex == -1 || dirIndex == -1) + error(new LispError("Unsupported UNC path format: \"" + s + '"')); + + host = new SimpleString(s.substring(2, shareIndex)); + device = new SimpleString(s.substring(shareIndex + 1, dirIndex)); + + Pathname p = new Pathname(s.substring(dirIndex)); + directory = p.directory; + name = p.name; + type = p.type; + version = p.version; + return; + } + s = s.replace('/', '\\'); + } // Jar file support. int bang = s.indexOf("!/"); if (bang >= 0) { @@ -262,8 +284,13 @@ // the namestring." 19.2.2.2.3.1 if (host != NIL) { Debug.assertTrue(host instanceof AbstractString); + if (! (this instanceof LogicalPathname)) + sb.append("\\\\"); //UNC file support; if there's a host, it's a UNC path. sb.append(host.getStringValue()); - sb.append(':'); + if (this instanceof LogicalPathname) + sb.append(':'); + else + sb.append(File.separatorChar); } if (device == NIL) ; @@ -271,7 +298,9 @@ ; else if (device instanceof AbstractString) { sb.append(device.getStringValue()); - sb.append(':'); + if (this instanceof LogicalPathname + || host == NIL) + sb.append(':'); // non-UNC paths } else if (device instanceof Pathname) { sb.append(((Pathname)device).getNamestring()); sb.append("!"); From ehuelsmann at common-lisp.net Thu Sep 11 21:35:01 2008 From: ehuelsmann at common-lisp.net (ehuelsmann at common-lisp.net) Date: Thu, 11 Sep 2008 17:35:01 -0400 (EDT) Subject: [armedbear-cvs] r11308 - trunk/j/src/org/armedbear/lisp Message-ID: <20080911213501.3D07B3C209@common-lisp.net> Author: ehuelsmann Date: Thu Sep 11 17:35:00 2008 New Revision: 11308 Modified: trunk/j/src/org/armedbear/lisp/Closure.java Log: Fix some special variable bindings test. Modified: trunk/j/src/org/armedbear/lisp/Closure.java ============================================================================== --- trunk/j/src/org/armedbear/lisp/Closure.java (original) +++ trunk/j/src/org/armedbear/lisp/Closure.java Thu Sep 11 17:35:00 2008 @@ -889,11 +889,6 @@ final LispThread thread = LispThread.currentThread(); SpecialBinding lastSpecialBinding = thread.lastSpecialBinding; Environment ext = new Environment(environment); - if (specials != null) - { - for (int i = 0; i < specials.length; i++) - ext.declareSpecial(specials[i]); - } if (optionalParameters == null && keywordParameters == null) args = fastProcessArgs(args); else @@ -901,21 +896,30 @@ Debug.assertTrue(args.length == variables.length); if (envVar != null) { - if (isSpecial(envVar)) - thread.bindSpecial(envVar, environment); - else - ext.bind(envVar, environment); + bindArg(envVar, environment, ext, thread); } for (int i = 0; i < variables.length; i++) { Symbol sym = variables[i]; - if (isSpecial(sym)) - thread.bindSpecial(sym, args[i]); - else - ext.bind(sym, args[i]); + bindArg(sym, args[i], ext, thread); } if (auxVars != null) bindAuxVars(ext, thread); + if (specials != null) { + special: + for (int i = 0; i < specials.length; i++) { + for (int j = 0; j < variables.length; j++) + if (specials[i] == variables[j]) + continue special; + + if (auxVars != null) + for (int j = 0; j < auxVars.length; j++) + if (specials[i] == auxVars[j].var) + continue special; + + ext.declareSpecial(specials[i]); + } + } LispObject result = NIL; LispObject prog = body; try @@ -977,14 +981,14 @@ // &whole before any other variables in the lambda list..." if (bindInitForms) if (envVar != null) - bind(envVar, environment, ext); + bindArg(envVar, environment, ext, thread); // Required parameters. if (requiredParameters != null) { for (int i = 0; i < minArgs; i++) { if (bindInitForms) - bind(requiredParameters[i].var, args[i], ext); + bindArg(requiredParameters[i].var, args[i], ext, thread); array[index++] = args[i]; } } @@ -999,13 +1003,13 @@ if (i < argsLength) { if (bindInitForms) - bind(parameter.var, args[i], ext); + bindArg(parameter.var, args[i], ext, thread); array[index++] = args[i]; ++argsUsed; if (parameter.svar != NIL) { if (bindInitForms) - bind((Symbol)parameter.svar, T, ext); + bindArg((Symbol)parameter.svar, T, ext, thread); array[index++] = T; } } @@ -1018,12 +1022,12 @@ else value = eval(parameter.initForm, ext, thread); if (bindInitForms) - bind(parameter.var, value, ext); + bindArg(parameter.var, value, ext, thread); array[index++] = value; if (parameter.svar != NIL) { if (bindInitForms) - bind((Symbol)parameter.svar, NIL, ext); + bindArg((Symbol)parameter.svar, NIL, ext, thread); array[index++] = NIL; } } @@ -1037,7 +1041,7 @@ for (int j = argsLength; j-- > argsUsed;) rest = new Cons(args[j], rest); if (bindInitForms) - bind(restVar, rest, ext); + bindArg(restVar, rest, ext, thread); array[index++] = rest; } // Keyword parameters. @@ -1057,12 +1061,12 @@ else value = eval(parameter.initForm, ext, thread); if (bindInitForms) - bind(parameter.var, value, ext); + bindArg(parameter.var, value, ext, thread); array[index++] = value; if (parameter.svar != NIL) { if (bindInitForms) - bind((Symbol)parameter.svar, NIL, ext); + bindArg((Symbol)parameter.svar, NIL, ext, thread); array[index++] = NIL; } } @@ -1083,12 +1087,12 @@ if (args[j] == keyword) { if (bindInitForms) - bind(parameter.var, args[j+1], ext); + bindArg(parameter.var, args[j+1], ext, thread); value = array[index++] = args[j+1]; if (parameter.svar != NIL) { if (bindInitForms) - bind((Symbol)parameter.svar, T, ext); + bindArg((Symbol)parameter.svar, T, ext, thread); array[index++] = T; } args[j] = null; @@ -1104,12 +1108,12 @@ else value = eval(parameter.initForm, ext, thread); if (bindInitForms) - bind(parameter.var, value, ext); + bindArg(parameter.var, value, ext, thread); array[index++] = value; if (parameter.svar != NIL) { if (bindInitForms) - bind((Symbol)parameter.svar, NIL, ext); + bindArg((Symbol)parameter.svar, NIL, ext, thread); array[index++] = NIL; } } @@ -1306,9 +1310,9 @@ value = parameter.initVal; else value = eval(parameter.initForm, env, thread); - bind(parameter.var, value, env); + bindArg(parameter.var, value, env, thread); if (parameter.svar != NIL) - bind((Symbol)parameter.svar, NIL, env); + bindArg((Symbol)parameter.svar, NIL, env, thread); } } @@ -1324,12 +1328,22 @@ value = parameter.initVal; else value = eval(parameter.initForm, env, thread); - bind(parameter.var, value, env); + bindArg(parameter.var, value, env, thread); if (parameter.svar != NIL) - bind((Symbol)parameter.svar, NIL, env); + bindArg((Symbol)parameter.svar, NIL, env, thread); } } + private final void bindArg(Symbol sym, LispObject value, + Environment env, LispThread thread) + throws ConditionThrowable + { + if (isSpecial(sym) && ! sym.isSpecialVariable()) + env.declareSpecial(sym); + + bind(sym, value, env); + } + private final void bindAuxVars(Environment env, LispThread thread) throws ConditionThrowable { @@ -1339,11 +1353,13 @@ Parameter parameter = auxVars[i]; Symbol sym = parameter.var; LispObject value; + if (parameter.initVal != null) value = parameter.initVal; else value = eval(parameter.initForm, env, thread); - bind(sym, value, env); + + bindArg(sym, value, env, thread); } } From ehuelsmann at common-lisp.net Thu Sep 11 22:08:02 2008 From: ehuelsmann at common-lisp.net (ehuelsmann at common-lisp.net) Date: Thu, 11 Sep 2008 18:08:02 -0400 (EDT) Subject: [armedbear-cvs] r11309 - trunk/j/src/org/armedbear/lisp Message-ID: <20080911220802.A246E71123@common-lisp.net> Author: ehuelsmann Date: Thu Sep 11 18:07:58 2008 New Revision: 11309 Modified: trunk/j/src/org/armedbear/lisp/Closure.java Log: Use bindArg everywhere where it's applicable; fixes handler-case.29 (free declaration scope). Modified: trunk/j/src/org/armedbear/lisp/Closure.java ============================================================================== --- trunk/j/src/org/armedbear/lisp/Closure.java (original) +++ trunk/j/src/org/armedbear/lisp/Closure.java Thu Sep 11 18:07:58 2008 @@ -432,18 +432,13 @@ final LispThread thread = LispThread.currentThread(); SpecialBinding lastSpecialBinding = thread.lastSpecialBinding; Environment ext = new Environment(environment); - if (specials != null) - { - for (int i = 0; i < specials.length; i++) - ext.declareSpecial(specials[i]); - } - bind(requiredParameters[0].var, arg, ext); + bindArg(requiredParameters[0].var, arg, ext, thread); if (arity != 1) { if (optionalParameters != null) bindOptionalParameterDefaults(ext, thread); if (restVar != null) - bind(restVar, NIL, ext); + bindArg(restVar, NIL, ext, thread); if (keywordParameters != null) bindKeywordParameterDefaults(ext, thread); } @@ -481,19 +476,14 @@ final LispThread thread = LispThread.currentThread(); SpecialBinding lastSpecialBinding = thread.lastSpecialBinding; Environment ext = new Environment(environment); - if (specials != null) - { - for (int i = 0; i < specials.length; i++) - ext.declareSpecial(specials[i]); - } - bind(requiredParameters[0].var, first, ext); - bind(requiredParameters[1].var, second, ext); + bindArg(requiredParameters[0].var, first, ext, thread); + bindArg(requiredParameters[1].var, second, ext, thread); if (arity != 2) { if (optionalParameters != null) bindOptionalParameterDefaults(ext, thread); if (restVar != null) - bind(restVar, NIL, ext); + bindArg(restVar, NIL, ext, thread); if (keywordParameters != null) bindKeywordParameterDefaults(ext, thread); } @@ -533,20 +523,15 @@ final LispThread thread = LispThread.currentThread(); SpecialBinding lastSpecialBinding = thread.lastSpecialBinding; Environment ext = new Environment(environment); - if (specials != null) - { - for (int i = 0; i < specials.length; i++) - ext.declareSpecial(specials[i]); - } - bind(requiredParameters[0].var, first, ext); - bind(requiredParameters[1].var, second, ext); - bind(requiredParameters[2].var, third, ext); + bindArg(requiredParameters[0].var, first, ext, thread); + bindArg(requiredParameters[1].var, second, ext, thread); + bindArg(requiredParameters[2].var, third, ext, thread); if (arity != 3) { if (optionalParameters != null) bindOptionalParameterDefaults(ext, thread); if (restVar != null) - bind(restVar, NIL, ext); + bindArg(restVar, NIL, ext, thread); if (keywordParameters != null) bindKeywordParameterDefaults(ext, thread); } @@ -587,21 +572,16 @@ final LispThread thread = LispThread.currentThread(); SpecialBinding lastSpecialBinding = thread.lastSpecialBinding; Environment ext = new Environment(environment); - if (specials != null) - { - for (int i = 0; i < specials.length; i++) - ext.declareSpecial(specials[i]); - } - bind(requiredParameters[0].var, first, ext); - bind(requiredParameters[1].var, second, ext); - bind(requiredParameters[2].var, third, ext); - bind(requiredParameters[3].var, fourth, ext); + bindArg(requiredParameters[0].var, first, ext, thread); + bindArg(requiredParameters[1].var, second, ext, thread); + bindArg(requiredParameters[2].var, third, ext, thread); + bindArg(requiredParameters[3].var, fourth, ext, thread); if (arity != 4) { if (optionalParameters != null) bindOptionalParameterDefaults(ext, thread); if (restVar != null) - bind(restVar, NIL, ext); + bindArg(restVar, NIL, ext, thread); if (keywordParameters != null) bindKeywordParameterDefaults(ext, thread); } @@ -644,22 +624,17 @@ final LispThread thread = LispThread.currentThread(); SpecialBinding lastSpecialBinding = thread.lastSpecialBinding; Environment ext = new Environment(environment); - if (specials != null) - { - for (int i = 0; i < specials.length; i++) - ext.declareSpecial(specials[i]); - } - bind(requiredParameters[0].var, first, ext); - bind(requiredParameters[1].var, second, ext); - bind(requiredParameters[2].var, third, ext); - bind(requiredParameters[3].var, fourth, ext); - bind(requiredParameters[4].var, fifth, ext); + bindArg(requiredParameters[0].var, first, ext, thread); + bindArg(requiredParameters[1].var, second, ext, thread); + bindArg(requiredParameters[2].var, third, ext, thread); + bindArg(requiredParameters[3].var, fourth, ext, thread); + bindArg(requiredParameters[4].var, fifth, ext, thread); if (arity != 5) { if (optionalParameters != null) bindOptionalParameterDefaults(ext, thread); if (restVar != null) - bind(restVar, NIL, ext); + bindArg(restVar, NIL, ext, thread); if (keywordParameters != null) bindKeywordParameterDefaults(ext, thread); } @@ -703,23 +678,18 @@ final LispThread thread = LispThread.currentThread(); SpecialBinding lastSpecialBinding = thread.lastSpecialBinding; Environment ext = new Environment(environment); - if (specials != null) - { - for (int i = 0; i < specials.length; i++) - ext.declareSpecial(specials[i]); - } - bind(requiredParameters[0].var, first, ext); - bind(requiredParameters[1].var, second, ext); - bind(requiredParameters[2].var, third, ext); - bind(requiredParameters[3].var, fourth, ext); - bind(requiredParameters[4].var, fifth, ext); - bind(requiredParameters[5].var, sixth, ext); + bindArg(requiredParameters[0].var, first, ext, thread); + bindArg(requiredParameters[1].var, second, ext, thread); + bindArg(requiredParameters[2].var, third, ext, thread); + bindArg(requiredParameters[3].var, fourth, ext, thread); + bindArg(requiredParameters[4].var, fifth, ext, thread); + bindArg(requiredParameters[5].var, sixth, ext, thread); if (arity != 6) { if (optionalParameters != null) bindOptionalParameterDefaults(ext, thread); if (restVar != null) - bind(restVar, NIL, ext); + bindArg(restVar, NIL, ext, thread); if (keywordParameters != null) bindKeywordParameterDefaults(ext, thread); } @@ -765,24 +735,19 @@ final LispThread thread = LispThread.currentThread(); SpecialBinding lastSpecialBinding = thread.lastSpecialBinding; Environment ext = new Environment(environment); - if (specials != null) - { - for (int i = 0; i < specials.length; i++) - ext.declareSpecial(specials[i]); - } - bind(requiredParameters[0].var, first, ext); - bind(requiredParameters[1].var, second, ext); - bind(requiredParameters[2].var, third, ext); - bind(requiredParameters[3].var, fourth, ext); - bind(requiredParameters[4].var, fifth, ext); - bind(requiredParameters[5].var, sixth, ext); - bind(requiredParameters[6].var, seventh, ext); + bindArg(requiredParameters[0].var, first, ext, thread); + bindArg(requiredParameters[1].var, second, ext, thread); + bindArg(requiredParameters[2].var, third, ext, thread); + bindArg(requiredParameters[3].var, fourth, ext, thread); + bindArg(requiredParameters[4].var, fifth, ext, thread); + bindArg(requiredParameters[5].var, sixth, ext, thread); + bindArg(requiredParameters[6].var, seventh, ext, thread); if (arity != 7) { if (optionalParameters != null) bindOptionalParameterDefaults(ext, thread); if (restVar != null) - bind(restVar, NIL, ext); + bindArg(restVar, NIL, ext, thread); if (keywordParameters != null) bindKeywordParameterDefaults(ext, thread); } @@ -834,20 +799,20 @@ for (int i = 0; i < specials.length; i++) ext.declareSpecial(specials[i]); } - bind(requiredParameters[0].var, first, ext); - bind(requiredParameters[1].var, second, ext); - bind(requiredParameters[2].var, third, ext); - bind(requiredParameters[3].var, fourth, ext); - bind(requiredParameters[4].var, fifth, ext); - bind(requiredParameters[5].var, sixth, ext); - bind(requiredParameters[6].var, seventh, ext); - bind(requiredParameters[7].var, eighth, ext); + bindArg(requiredParameters[0].var, first, ext, thread); + bindArg(requiredParameters[1].var, second, ext, thread); + bindArg(requiredParameters[2].var, third, ext, thread); + bindArg(requiredParameters[3].var, fourth, ext, thread); + bindArg(requiredParameters[4].var, fifth, ext, thread); + bindArg(requiredParameters[5].var, sixth, ext, thread); + bindArg(requiredParameters[6].var, seventh, ext, thread); + bindArg(requiredParameters[7].var, eighth, ext, thread); if (arity != 8) { if (optionalParameters != null) bindOptionalParameterDefaults(ext, thread); if (restVar != null) - bind(restVar, NIL, ext); + bindArg(restVar, NIL, ext, thread); if (keywordParameters != null) bindKeywordParameterDefaults(ext, thread); } From ehuelsmann at common-lisp.net Fri Sep 12 21:40:40 2008 From: ehuelsmann at common-lisp.net (ehuelsmann at common-lisp.net) Date: Fri, 12 Sep 2008 17:40:40 -0400 (EDT) Subject: [armedbear-cvs] r11310 - trunk/j/src/org/armedbear/lisp Message-ID: <20080912214040.BB3B35C19D@common-lisp.net> Author: ehuelsmann Date: Fri Sep 12 17:40:40 2008 New Revision: 11310 Modified: trunk/j/src/org/armedbear/lisp/SpecialOperators.java Log: Fold 2 code paths which essentially differ only by 1 conditional in _let(). Modified: trunk/j/src/org/armedbear/lisp/SpecialOperators.java ============================================================================== --- trunk/j/src/org/armedbear/lisp/SpecialOperators.java (original) +++ trunk/j/src/org/armedbear/lisp/SpecialOperators.java Fri Sep 12 17:40:40 2008 @@ -132,119 +132,51 @@ break; } Environment ext = new Environment(env); - if (sequential) + while (varList != NIL) { - // LET* - while (varList != NIL) + final Symbol symbol; + LispObject value; + LispObject obj = varList.car(); + if (obj instanceof Cons) { - final Symbol symbol; - LispObject value; - LispObject obj = varList.car(); - if (obj instanceof Cons) - { - if (obj.length() > 2) - return error(new LispError("The LET* binding specification " + - obj.writeToString() + - " is invalid.")); - try - { - symbol = (Symbol) ((Cons)obj).car; - } - catch (ClassCastException e) - { - return type_error(((Cons)obj).car, Symbol.SYMBOL); - } - value = eval(obj.cadr(), ext, thread); - } - else + if (obj.length() > 2) + return error(new LispError("The LET* binding specification " + + obj.writeToString() + + " is invalid.")); + try { - try - { - symbol = (Symbol) obj; - } - catch (ClassCastException e) - { - return type_error(obj, Symbol.SYMBOL); - } - value = NIL; + symbol = (Symbol) ((Cons)obj).car; } - if (specials != NIL && memq(symbol, specials)) + catch (ClassCastException e) { - thread.bindSpecial(symbol, value); - ext.declareSpecial(symbol); + return type_error(((Cons)obj).car, Symbol.SYMBOL); } - else if (symbol.isSpecialVariable()) - { - thread.bindSpecial(symbol, value); - } - else - ext.bind(symbol, value); - varList = ((Cons)varList).cdr; - } - } - else - { - // LET - final int length = varList.length(); - LispObject[] vals = new LispObject[length]; - for (int i = 0; i < length; i++) - { - LispObject obj = ((Cons)varList).car; - if (obj instanceof Cons) - { - if (obj.length() > 2) - return error(new LispError("The LET binding specification " + - obj.writeToString() + - " is invalid.")); - vals[i] = eval(obj.cadr(), env, thread); - } - else - vals[i] = NIL; - varList = ((Cons)varList).cdr; + value = eval(obj.cadr(), sequential ? ext : env, thread); } - varList = args.car(); - int i = 0; - while (varList != NIL) - { - final Symbol symbol; - LispObject obj = varList.car(); - if (obj instanceof Cons) - { - try - { - symbol = (Symbol) ((Cons)obj).car; - } - catch (ClassCastException e) - { - return type_error(((Cons)obj).car, Symbol.SYMBOL); - } - } - else - { - try - { - symbol = (Symbol) obj; - } - catch (ClassCastException e) - { - return type_error(obj, Symbol.SYMBOL); - } - } - LispObject value = vals[i]; - if (specials != NIL && memq(symbol, specials)) + else + { + try { - thread.bindSpecial(symbol, value); - ext.declareSpecial(symbol); + symbol = (Symbol) obj; } - else if (symbol.isSpecialVariable()) + catch (ClassCastException e) { - thread.bindSpecial(symbol, value); + return type_error(obj, Symbol.SYMBOL); } - else - ext.bind(symbol, value); - varList = ((Cons)varList).cdr; - ++i; + value = NIL; } + if (specials != NIL && memq(symbol, specials)) + { + thread.bindSpecial(symbol, value); + ext.declareSpecial(symbol); + } + else if (symbol.isSpecialVariable()) + { + thread.bindSpecial(symbol, value); + } + else + ext.bind(symbol, value); + varList = ((Cons)varList).cdr; } // Make sure free special declarations are visible in the body. // "The scope of free declarations specifically does not include From ehuelsmann at common-lisp.net Sat Sep 13 06:35:09 2008 From: ehuelsmann at common-lisp.net (ehuelsmann at common-lisp.net) Date: Sat, 13 Sep 2008 02:35:09 -0400 (EDT) Subject: [armedbear-cvs] r11311 - trunk/j/src/org/armedbear/lisp Message-ID: <20080913063509.BBEC35E0FF@common-lisp.net> Author: ehuelsmann Date: Sat Sep 13 02:35:05 2008 New Revision: 11311 Modified: trunk/j/src/org/armedbear/lisp/SpecialOperators.java Log: Reinstate error message in LET case. Modified: trunk/j/src/org/armedbear/lisp/SpecialOperators.java ============================================================================== --- trunk/j/src/org/armedbear/lisp/SpecialOperators.java (original) +++ trunk/j/src/org/armedbear/lisp/SpecialOperators.java Sat Sep 13 02:35:05 2008 @@ -140,9 +140,9 @@ if (obj instanceof Cons) { if (obj.length() > 2) - return error(new LispError("The LET* binding specification " + - obj.writeToString() + - " is invalid.")); + return error(new LispError("The " + (sequential ? "LET*" : "LET") + + " binding specification " + + obj.writeToString() + " is invalid.")); try { symbol = (Symbol) ((Cons)obj).car; @@ -188,17 +188,12 @@ ext.declareSpecial(symbol); specials = ((Cons)specials).cdr; } - while (body != NIL) - { - result = eval(body.car(), ext, thread); - body = ((Cons)body).cdr; - } + return progn(body, ext, thread); } finally { thread.lastSpecialBinding = lastSpecialBinding; } - return result; } // ### symbol-macrolet From ehuelsmann at common-lisp.net Sat Sep 13 08:52:37 2008 From: ehuelsmann at common-lisp.net (ehuelsmann at common-lisp.net) Date: Sat, 13 Sep 2008 04:52:37 -0400 (EDT) Subject: [armedbear-cvs] r11312 - trunk/j/src/org/armedbear/lisp Message-ID: <20080913085237.50E605803D@common-lisp.net> Author: ehuelsmann Date: Sat Sep 13 04:51:48 2008 New Revision: 11312 Modified: trunk/j/src/org/armedbear/lisp/Closure.java Log: Replace looping over BODY by PROGN call. That's its purpose. Modified: trunk/j/src/org/armedbear/lisp/Closure.java ============================================================================== --- trunk/j/src/org/armedbear/lisp/Closure.java (original) +++ trunk/j/src/org/armedbear/lisp/Closure.java Sat Sep 13 04:51:48 2008 @@ -885,21 +885,14 @@ ext.declareSpecial(specials[i]); } } - LispObject result = NIL; - LispObject prog = body; try { - while (prog != NIL) - { - result = eval(prog.car(), ext, thread); - prog = prog.cdr(); - } + return progn(body, ext, thread); } finally { thread.lastSpecialBinding = lastSpecialBinding; } - return result; } private final boolean isSpecial(Symbol sym) From ehuelsmann at common-lisp.net Sat Sep 13 10:03:26 2008 From: ehuelsmann at common-lisp.net (ehuelsmann at common-lisp.net) Date: Sat, 13 Sep 2008 06:03:26 -0400 (EDT) Subject: [armedbear-cvs] r11313 - trunk/j/src/org/armedbear/lisp Message-ID: <20080913100326.23C2B1621A@common-lisp.net> Author: ehuelsmann Date: Sat Sep 13 06:03:24 2008 New Revision: 11313 Modified: trunk/j/src/org/armedbear/lisp/SpecialOperators.java Log: Fix FLET.64 and LABELS.43: flet forms without function bindings can still have bodies which start with DECLARE forms. Down to 56 failures. Modified: trunk/j/src/org/armedbear/lisp/SpecialOperators.java ============================================================================== --- trunk/j/src/org/armedbear/lisp/SpecialOperators.java (original) +++ trunk/j/src/org/armedbear/lisp/SpecialOperators.java Sat Sep 13 06:03:24 2008 @@ -347,69 +347,62 @@ // First argument is a list of local function definitions. LispObject defs = checkList(args.car()); final LispThread thread = LispThread.currentThread(); - LispObject result; - if (defs != NIL) + SpecialBinding lastSpecialBinding = thread.lastSpecialBinding; + Environment ext = new Environment(env); + while (defs != NIL) { - SpecialBinding lastSpecialBinding = thread.lastSpecialBinding; - Environment ext = new Environment(env); - while (defs != NIL) + final LispObject def = checkList(defs.car()); + final LispObject name = def.car(); + final Symbol symbol; + if (name instanceof Symbol) { - final LispObject def = checkList(defs.car()); - final LispObject name = def.car(); - final Symbol symbol; - if (name instanceof Symbol) - { - symbol = checkSymbol(name); - if (symbol.getSymbolFunction() instanceof SpecialOperator) - { - String message = - symbol.getName() + " is a special operator and may not be redefined"; - return error(new ProgramError(message)); - } - } - else if (isValidSetfFunctionName(name)) - symbol = checkSymbol(name.cadr()); - else - return type_error(name, FUNCTION_NAME); - LispObject rest = def.cdr(); - LispObject parameters = rest.car(); - LispObject body = rest.cdr(); - LispObject decls = NIL; - while (body.car() instanceof Cons && body.car().car() == Symbol.DECLARE) - { - decls = new Cons(body.car(), decls); - body = body.cdr(); - } - body = new Cons(symbol, body); - body = new Cons(Symbol.BLOCK, body); - body = new Cons(body, NIL); - while (decls != NIL) + symbol = checkSymbol(name); + if (symbol.getSymbolFunction() instanceof SpecialOperator) { - body = new Cons(decls.car(), body); - decls = decls.cdr(); + String message = + symbol.getName() + " is a special operator and may not be redefined"; + return error(new ProgramError(message)); } - LispObject lambda_expression = - new Cons(Symbol.LAMBDA, new Cons(parameters, body)); - LispObject lambda_name = - list2(recursive ? Symbol.LABELS : Symbol.FLET, name); - Closure closure = - new Closure(lambda_name, lambda_expression, - recursive ? ext : env); - ext.addFunctionBinding(name, closure); - defs = defs.cdr(); } - try + else if (isValidSetfFunctionName(name)) + symbol = checkSymbol(name.cadr()); + else + return type_error(name, FUNCTION_NAME); + LispObject rest = def.cdr(); + LispObject parameters = rest.car(); + LispObject body = rest.cdr(); + LispObject decls = NIL; + while (body.car() instanceof Cons && body.car().car() == Symbol.DECLARE) { - result = progn(args.cdr(), ext, thread); + decls = new Cons(body.car(), decls); + body = body.cdr(); } - finally + body = new Cons(symbol, body); + body = new Cons(Symbol.BLOCK, body); + body = new Cons(body, NIL); + while (decls != NIL) { - thread.lastSpecialBinding = lastSpecialBinding; + body = new Cons(decls.car(), body); + decls = decls.cdr(); } + LispObject lambda_expression = + new Cons(Symbol.LAMBDA, new Cons(parameters, body)); + LispObject lambda_name = + list2(recursive ? Symbol.LABELS : Symbol.FLET, name); + Closure closure = + new Closure(lambda_name, lambda_expression, + recursive ? ext : env); + ext.addFunctionBinding(name, closure); + defs = defs.cdr(); + } + try + { + return progn(args.cdr(), ext, thread); + } + finally + { + thread.lastSpecialBinding = lastSpecialBinding; } - else - result = progn(args.cdr(), env, thread); - return result; } // ### the value-type form => result* From ehuelsmann at common-lisp.net Sat Sep 13 14:24:29 2008 From: ehuelsmann at common-lisp.net (ehuelsmann at common-lisp.net) Date: Sat, 13 Sep 2008 10:24:29 -0400 (EDT) Subject: [armedbear-cvs] r11314 - trunk/j/src/org/armedbear/lisp Message-ID: <20080913142429.EBAFE64018@common-lisp.net> Author: ehuelsmann Date: Sat Sep 13 10:24:25 2008 New Revision: 11314 Modified: trunk/j/src/org/armedbear/lisp/Version.java Log: Increase version number: we've had some fixes again... Modified: trunk/j/src/org/armedbear/lisp/Version.java ============================================================================== --- trunk/j/src/org/armedbear/lisp/Version.java (original) +++ trunk/j/src/org/armedbear/lisp/Version.java Sat Sep 13 10:24:25 2008 @@ -29,6 +29,6 @@ public static String getVersion() { - return "0.0.10.20"; + return "0.0.10.21"; } } From ehuelsmann at common-lisp.net Sat Sep 13 15:18:15 2008 From: ehuelsmann at common-lisp.net (ehuelsmann at common-lisp.net) Date: Sat, 13 Sep 2008 11:18:15 -0400 (EDT) Subject: [armedbear-cvs] r11315 - trunk/j/src/org/armedbear/lisp Message-ID: <20080913151815.0EB8B461CA@common-lisp.net> Author: ehuelsmann Date: Sat Sep 13 11:18:14 2008 New Revision: 11315 Modified: trunk/j/src/org/armedbear/lisp/SpecialOperators.java Log: Fix LABELS.47 (special variables related). Modified: trunk/j/src/org/armedbear/lisp/SpecialOperators.java ============================================================================== --- trunk/j/src/org/armedbear/lisp/SpecialOperators.java (original) +++ trunk/j/src/org/armedbear/lisp/SpecialOperators.java Sat Sep 13 11:18:14 2008 @@ -97,7 +97,6 @@ boolean sequential) throws ConditionThrowable { - LispObject result = NIL; final LispThread thread = LispThread.currentThread(); final SpecialBinding lastSpecialBinding = thread.lastSpecialBinding; try @@ -347,8 +346,8 @@ // First argument is a list of local function definitions. LispObject defs = checkList(args.car()); final LispThread thread = LispThread.currentThread(); - SpecialBinding lastSpecialBinding = thread.lastSpecialBinding; - Environment ext = new Environment(env); + final SpecialBinding lastSpecialBinding = thread.lastSpecialBinding; + final Environment ext = new Environment(env); while (defs != NIL) { final LispObject def = checkList(defs.car()); @@ -397,7 +396,34 @@ } try { - return progn(args.cdr(), ext, thread); + final Environment innerEnv = new Environment(ext); + LispObject body = args.cdr(); + while (body != NIL) + { + LispObject obj = body.car(); + if (obj instanceof Cons && ((Cons)obj).car == Symbol.DECLARE) + { + LispObject decls = ((Cons)obj).cdr; + while (decls != NIL) + { + LispObject decl = decls.car(); + if (decl instanceof Cons && ((Cons)decl).car == Symbol.SPECIAL) + { + LispObject vars = ((Cons)decl).cdr; + while (vars != NIL) + { + innerEnv.declareSpecial((Symbol)((Cons)vars).car); + vars = ((Cons)vars).cdr; + } + } + decls = ((Cons)decls).cdr; + } + body = ((Cons)body).cdr; + } + else + break; + } + return progn(body, ext, thread); } finally { From ehuelsmann at common-lisp.net Sat Sep 13 16:53:17 2008 From: ehuelsmann at common-lisp.net (ehuelsmann at common-lisp.net) Date: Sat, 13 Sep 2008 12:53:17 -0400 (EDT) Subject: [armedbear-cvs] r11316 - trunk/j/src/org/armedbear/lisp Message-ID: <20080913165317.2C6F8662D6@common-lisp.net> Author: ehuelsmann Date: Sat Sep 13 12:53:16 2008 New Revision: 11316 Modified: trunk/j/src/org/armedbear/lisp/Closure.java Log: Fix FLET.40, special variables related. Modified: trunk/j/src/org/armedbear/lisp/Closure.java ============================================================================== --- trunk/j/src/org/armedbear/lisp/Closure.java (original) +++ trunk/j/src/org/armedbear/lisp/Closure.java Sat Sep 13 12:53:16 2008 @@ -1296,10 +1296,12 @@ Environment env, LispThread thread) throws ConditionThrowable { - if (isSpecial(sym) && ! sym.isSpecialVariable()) + if (isSpecial(sym)) { env.declareSpecial(sym); - - bind(sym, value, env); + thread.bindSpecial(sym, value); + } + else + env.bind(sym, value); } private final void bindAuxVars(Environment env, LispThread thread) From ehuelsmann at common-lisp.net Sun Sep 14 07:51:34 2008 From: ehuelsmann at common-lisp.net (ehuelsmann at common-lisp.net) Date: Sun, 14 Sep 2008 03:51:34 -0400 (EDT) Subject: [armedbear-cvs] r11317 - public_html Message-ID: <20080914075134.3C8386B0F6@common-lisp.net> Author: ehuelsmann Date: Sun Sep 14 03:51:33 2008 New Revision: 11317 Added: public_html/ public_html/index.shtml public_html/project-name public_html/style.css Log: Commit initial revision of the website. Added: public_html/index.shtml ============================================================================== --- (empty file) +++ public_html/index.shtml Sun Sep 14 03:51:33 2008 @@ -0,0 +1,127 @@ + + + + + <!--#include virtual="project-name" --> + + + + + +
+

+
+
+

Armed Bear

+ The right of the people to keep and arm bears shall not be infringed! +
+ +
+

+ + + About ABCL + + +

+

+
+ Armed Bear Common Lisp (ABCL) is an implementation of ANSI Common Lisp + that runs in a Java virtual machine. It provides a runtime system, a + compiler that compiles Lisp source to JVM bytecode, and an interactive + REPL for program development. +

+ ABCL is distributed under the terms of the GNU General Public + License, with a special linking exception. If you link ABCL with your + own program, then you do not need to release the source code for that + program. However, any changes that you make to ABCL itself must be + released in accordance with the terms of the GPL. +

+ ABCL runs on platforms that support Java 1.4 (or later), including Linux, + Windows, and Mac OS X. +

+ ABCL is free software and comes with ABSOLUTELY NO WARRANTY. +

+ The latest version is 0.0.10, released March 6, 2007. +

+
+ +

+ + Download + +

+
+ abcl-0.0.10.tar.gz + (source, 632987 bytes) +

+ abcl-0.0.10.zip + (source, 1012345 bytes) +

+
+ +

+ + CVS + +

+
+ The project's SourceForge.net CVS repository can be checked out through + anonymous (pserver) CVS with the following command: + 
+      cvs -d:cvs -z3 -d:pserver:anonymous at armedbear-j.cvs.sourceforge.net:/cvsroot/armedbear-j co j
+
+
+
+ +

+ + Bugs + +

+
+ ABCL is a young implementation (particularly by Lisp standards). You + are certain to encounter bugs. +

+ ABCL 0.0.10 fails 67 out of 21696 tests in the GCL ANSI test suite. +

+ ABCL's CLOS is intolerably slow and does not handle on-the-fly + redefinition of classes correctly. There is no support for the long + form of DEFINE-METHOD-COMBINATION, and certain other required CLOS + features are also missing. Enough CLOS is there to run ASDF and + CL-PPCRE, if you're in no hurry. There's no MOP worth mentioning. +

+ Since this is an early public release, there might be build problems as + well as runtime bugs. +

+ Please report problems to the j development mailing list + (you must be subscribed to post). +

+
+ +

+ + Installation + +

+
+ The README file in the root directory of the source distribution contains + instructions for building ABCL. +

+ Java 1.4 or later is required. + Java 1.5 + is recommended. There are + + unresolved performance issues with Java 1.6. To build ABCL, you'll need + the full JDK; the JRE is not enough.

+
+ +
+

Back to Common-lisp.net.

+ +
+ Valid XHTML 1.0 Strict +
+ + Added: public_html/project-name ============================================================================== --- (empty file) +++ public_html/project-name Sun Sep 14 03:51:33 2008 @@ -0,0 +1 @@ +armedbear Added: public_html/style.css ============================================================================== --- (empty file) +++ public_html/style.css Sun Sep 14 03:51:33 2008 @@ -0,0 +1,54 @@ + +.header { + font-size: medium; + background-color:#336699; + color:#ffffff; + border-style:solid; + border-width: 5px; + border-color:#002244; + padding: 1mm 1mm 1mm 5mm; +} + +.footer { + font-size: small; + font-style: italic; + text-align: right; + background-color:#336699; + color:#ffffff; + border-style:solid; + border-width: 2px; + border-color:#002244; + padding: 1mm 1mm 1mm 1mm; +} + +.footer a:link { + font-weight:bold; + color:#ffffff; + text-decoration:underline; +} + +.footer a:visited { + font-weight:bold; + color:#ffffff; + text-decoration:underline; +} + +.footer a:hover { + font-weight:bold; + color:#002244; + text-decoration:underline; } + +.check {font-size: x-small; + text-align:right;} + +.check a:link { font-weight:bold; + color:#a0a0ff; + text-decoration:underline; } + +.check a:visited { font-weight:bold; + color:#a0a0ff; + text-decoration:underline; } + +.check a:hover { font-weight:bold; + color:#000000; + text-decoration:underline; } From ehuelsmann at common-lisp.net Sun Sep 14 08:33:22 2008 From: ehuelsmann at common-lisp.net (ehuelsmann at common-lisp.net) Date: Sun, 14 Sep 2008 04:33:22 -0400 (EDT) Subject: [armedbear-cvs] r11318 - public_html Message-ID: <20080914083322.E70DD6B0F6@common-lisp.net> Author: ehuelsmann Date: Sun Sep 14 04:33:20 2008 New Revision: 11318 Modified: public_html/index.shtml (contents, props changed) public_html/project-name (props changed) public_html/style.css (props changed) Log: Update files and keywords and eol styles. Modified: public_html/index.shtml ============================================================================== --- public_html/index.shtml (original) +++ public_html/index.shtml Sun Sep 14 04:33:20 2008 @@ -63,15 +63,18 @@

- CVS + Repository

- The project's SourceForge.net CVS repository can be checked out through - anonymous (pserver) CVS with the following command: - 
-      cvs -d:cvs -z3 -d:pserver:anonymous at armedbear-j.cvs.sourceforge.net:/cvsroot/armedbear-j co j
+      The project's Common-Lisp.net Subversion repository can be checked
+      out through anonymous access with the following command:
+      
+
+      $ svn co svn://common-lisp.net/project/armedbear/svn/trunk/j j
       

+      
Please note that the minimum required JDK version for development
+     versions of ABCL has been raised to 1.5.
@@ -85,6 +88,8 @@ are certain to encounter bugs.

ABCL 0.0.10 fails 67 out of 21696 tests in the GCL ANSI test suite. + Recent development snapshots perform considerably better, failing only + 55 tests.

ABCL's CLOS is intolerably slow and does not handle on-the-fly redefinition of classes correctly. There is no support for the long @@ -123,5 +128,6 @@

Valid XHTML 1.0 Strict
+
$Id$
From ehuelsmann at common-lisp.net Mon Sep 15 18:32:13 2008 From: ehuelsmann at common-lisp.net (ehuelsmann at common-lisp.net) Date: Mon, 15 Sep 2008 14:32:13 -0400 (EDT) Subject: [armedbear-cvs] r11319 - public_html Message-ID: <20080915183213.CDA8E7B4DF@common-lisp.net> Author: ehuelsmann Date: Mon Sep 15 14:32:12 2008 New Revision: 11319 Modified: public_html/index.shtml Log: Point website to SourceForge downloads. Modified: public_html/index.shtml ============================================================================== --- public_html/index.shtml (original) +++ public_html/index.shtml Mon Sep 15 14:32:12 2008 @@ -53,10 +53,10 @@
- abcl-0.0.10.tar.gz + abcl-0.0.10.tar.gz (source, 632987 bytes)

- abcl-0.0.10.zip + abcl-0.0.10.zip (source, 1012345 bytes)

@@ -128,6 +128,6 @@
Valid XHTML 1.0 Strict
-
$Id$
+
$Id$
From ehuelsmann at common-lisp.net Wed Sep 17 20:19:30 2008 From: ehuelsmann at common-lisp.net (ehuelsmann at common-lisp.net) Date: Wed, 17 Sep 2008 16:19:30 -0400 (EDT) Subject: [armedbear-cvs] r11320 - trunk/j/src/org/armedbear/lisp Message-ID: <20080917201930.8608F1D115@common-lisp.net> Author: ehuelsmann Date: Wed Sep 17 16:19:25 2008 New Revision: 11320 Modified: trunk/j/src/org/armedbear/lisp/SpecialOperators.java Log: Change some inline simulated progn()s to progn() calls (which is final anyway, ready to be inlined). Modified: trunk/j/src/org/armedbear/lisp/SpecialOperators.java ============================================================================== --- trunk/j/src/org/armedbear/lisp/SpecialOperators.java (original) +++ trunk/j/src/org/armedbear/lisp/SpecialOperators.java Wed Sep 17 16:19:25 2008 @@ -204,7 +204,6 @@ { LispObject varList = checkList(args.car()); final LispThread thread = LispThread.currentThread(); - LispObject result = NIL; if (varList != NIL) { SpecialBinding lastSpecialBinding = thread.lastSpecialBinding; @@ -234,12 +233,7 @@ obj.writeToString())); } } - LispObject body = args.cdr(); - while (body != NIL) - { - result = eval(body.car(), ext, thread); - body = body.cdr(); - } + return progn(args.cdr(), ext, thread); } finally { @@ -248,14 +242,8 @@ } else { - LispObject body = args.cdr(); - while (body != NIL) - { - result = eval(body.car(), env, thread); - body = body.cdr(); - } + return progn(args.cdr(), ext, thread); } - return result; } }; @@ -462,14 +450,7 @@ // Set up the new bindings. progvBindVars(symbols, values, thread); // Implicit PROGN. - LispObject result = NIL; - LispObject body = args.cdr().cdr(); - while (body != NIL) - { - result = eval(body.car(), env, thread); - body = body.cdr(); - } - return result; + return progn(args.cdr().cdr(), env, thread); } finally { From ehuelsmann at common-lisp.net Wed Sep 17 20:46:01 2008 From: ehuelsmann at common-lisp.net (ehuelsmann at common-lisp.net) Date: Wed, 17 Sep 2008 16:46:01 -0400 (EDT) Subject: [armedbear-cvs] r11321 - trunk/j/src/org/armedbear/lisp Message-ID: <20080917204601.D7D6912064@common-lisp.net> Author: ehuelsmann Date: Wed Sep 17 16:45:50 2008 New Revision: 11321 Modified: trunk/j/src/org/armedbear/lisp/SpecialOperators.java Log: Fix special declarations in SYMBOL-MACROLET, fixing symbol-macrolet.error.1. Found by: Ville Vouitilainen Modified: trunk/j/src/org/armedbear/lisp/SpecialOperators.java ============================================================================== --- trunk/j/src/org/armedbear/lisp/SpecialOperators.java (original) +++ trunk/j/src/org/armedbear/lisp/SpecialOperators.java Wed Sep 17 16:45:50 2008 @@ -210,6 +210,9 @@ try { Environment ext = new Environment(env); + // Declare our free specials, this will correctly raise + LispObject body = ext.processDeclarations(args.cdr()); + for (int i = varList.length(); i-- > 0;) { LispObject obj = varList.car(); @@ -217,7 +220,8 @@ if (obj instanceof Cons && obj.length() == 2) { Symbol symbol = checkSymbol(obj.car()); - if (symbol.isSpecialVariable()) + if (symbol.isSpecialVariable() + || ext.isDeclaredSpecial(symbol)) { return error(new ProgramError( "Attempt to bind the special variable " + @@ -233,7 +237,7 @@ obj.writeToString())); } } - return progn(args.cdr(), ext, thread); + return progn(body, ext, thread); } finally { @@ -242,7 +246,7 @@ } else { - return progn(args.cdr(), ext, thread); + return progn(args.cdr(), env, thread); } } }; From ehuelsmann at common-lisp.net Wed Sep 17 21:27:57 2008 From: ehuelsmann at common-lisp.net (ehuelsmann at common-lisp.net) Date: Wed, 17 Sep 2008 17:27:57 -0400 (EDT) Subject: [armedbear-cvs] r11322 - trunk/j/src/org/armedbear/lisp Message-ID: <20080917212757.3D7403C079@common-lisp.net> Author: ehuelsmann Date: Wed Sep 17 17:27:52 2008 New Revision: 11322 Modified: trunk/j/src/org/armedbear/lisp/Primitives.java Log: Add declaration processing in MACROLET bodies. Modified: trunk/j/src/org/armedbear/lisp/Primitives.java ============================================================================== --- trunk/j/src/org/armedbear/lisp/Primitives.java (original) +++ trunk/j/src/org/armedbear/lisp/Primitives.java Wed Sep 17 17:27:52 2008 @@ -3499,8 +3499,9 @@ { LispObject defs = checkList(args.car()); final LispThread thread = LispThread.currentThread(); - LispObject result; - if (defs != NIL) + final SpecialBinding lastSpecialBinding = thread.lastSpecialBinding; + + try { Environment ext = new Environment(env); while (defs != NIL) @@ -3517,11 +3518,12 @@ ext.addFunctionBinding(symbol, macroObject); defs = defs.cdr(); } - result = progn(args.cdr(), ext, thread); + return progn(ext.processDeclarations(args.cdr()), ext, thread); + } + finally + { + thread.lastSpecialBinding = lastSpecialBinding; } - else - result = progn(args.cdr(), env, thread); - return result; } }; From ehuelsmann at common-lisp.net Thu Sep 18 20:48:23 2008 From: ehuelsmann at common-lisp.net (ehuelsmann at common-lisp.net) Date: Thu, 18 Sep 2008 16:48:23 -0400 (EDT) Subject: [armedbear-cvs] r11323 - trunk/j/src/org/armedbear/lisp Message-ID: <20080918204823.CC96A1A0E0@common-lisp.net> Author: ehuelsmann Date: Thu Sep 18 16:48:17 2008 New Revision: 11323 Modified: trunk/j/src/org/armedbear/lisp/Closure.java Log: Cleanup patch provided by Ville. Patch by: Ville Voutilianen Modified: trunk/j/src/org/armedbear/lisp/Closure.java ============================================================================== --- trunk/j/src/org/armedbear/lisp/Closure.java (original) +++ trunk/j/src/org/armedbear/lisp/Closure.java Thu Sep 18 16:48:17 2008 @@ -411,15 +411,8 @@ { if (arity == 0) { - final LispThread thread = LispThread.currentThread(); - LispObject result = NIL; - LispObject prog = body; - while (prog != NIL) - { - result = eval(prog.car(), environment, thread); - prog = prog.cdr(); - } - return result; + return progn(body, environment, + LispThread.currentThread()); } else return execute(new LispObject[0]); @@ -444,21 +437,14 @@ } if (auxVars != null) bindAuxVars(ext, thread); - LispObject result = NIL; - LispObject prog = body; try { - while (prog != NIL) - { - result = eval(prog.car(), ext, thread); - prog = prog.cdr(); - } + return progn(body, ext, thread); } finally { thread.lastSpecialBinding = lastSpecialBinding; } - return result; } else { @@ -489,21 +475,14 @@ } if (auxVars != null) bindAuxVars(ext, thread); - LispObject result = NIL; - LispObject prog = body; try { - while (prog != NIL) - { - result = eval(prog.car(), ext, thread); - prog = prog.cdr(); - } + return progn(body, ext, thread); } finally { thread.lastSpecialBinding = lastSpecialBinding; } - return result; } else { @@ -537,21 +516,14 @@ } if (auxVars != null) bindAuxVars(ext, thread); - LispObject result = NIL; - LispObject prog = body; try { - while (prog != NIL) - { - result = eval(prog.car(), ext, thread); - prog = prog.cdr(); - } + return progn(body, ext, thread); } finally { thread.lastSpecialBinding = lastSpecialBinding; } - return result; } else { @@ -587,21 +559,14 @@ } if (auxVars != null) bindAuxVars(ext, thread); - LispObject result = NIL; - LispObject prog = body; try { - while (prog != NIL) - { - result = eval(prog.car(), ext, thread); - prog = prog.cdr(); - } + return progn(body, ext, thread); } finally { thread.lastSpecialBinding = lastSpecialBinding; } - return result; } else { @@ -640,21 +605,14 @@ } if (auxVars != null) bindAuxVars(ext, thread); - LispObject result = NIL; - LispObject prog = body; try { - while (prog != NIL) - { - result = eval(prog.car(), ext, thread); - prog = prog.cdr(); - } + return progn(body, ext, thread); } finally { thread.lastSpecialBinding = lastSpecialBinding; } - return result; } else { @@ -695,21 +653,14 @@ } if (auxVars != null) bindAuxVars(ext, thread); - LispObject result = NIL; - LispObject prog = body; try { - while (prog != NIL) - { - result = eval(prog.car(), ext, thread); - prog = prog.cdr(); - } + return progn(body, ext, thread); } finally { thread.lastSpecialBinding = lastSpecialBinding; } - return result; } else { @@ -753,21 +704,14 @@ } if (auxVars != null) bindAuxVars(ext, thread); - LispObject result = NIL; - LispObject prog = body; try { - while (prog != NIL) - { - result = eval(prog.car(), ext, thread); - prog = prog.cdr(); - } + return progn(body, ext, thread); } finally { thread.lastSpecialBinding = lastSpecialBinding; } - return result; } else { @@ -818,21 +762,14 @@ } if (auxVars != null) bindAuxVars(ext, thread); - LispObject result = NIL; - LispObject prog = body; try { - while (prog != NIL) - { - result = eval(prog.car(), ext, thread); - prog = prog.cdr(); - } + return progn(body, ext, thread); } finally { thread.lastSpecialBinding = lastSpecialBinding; } - return result; } else { From ehuelsmann at common-lisp.net Fri Sep 19 19:21:56 2008 From: ehuelsmann at common-lisp.net (ehuelsmann at common-lisp.net) Date: Fri, 19 Sep 2008 15:21:56 -0400 (EDT) Subject: [armedbear-cvs] r11324 - trunk/j/src/org/armedbear/lisp Message-ID: <20080919192156.AC1487C04F@common-lisp.net> Author: ehuelsmann Date: Fri Sep 19 15:21:55 2008 New Revision: 11324 Modified: trunk/j/src/org/armedbear/lisp/SpecialOperators.java Log: Code cleanup. Patch by: Philip Hudson Modified: trunk/j/src/org/armedbear/lisp/SpecialOperators.java ============================================================================== --- trunk/j/src/org/armedbear/lisp/SpecialOperators.java (original) +++ trunk/j/src/org/armedbear/lisp/SpecialOperators.java Fri Sep 19 15:21:55 2008 @@ -390,31 +390,7 @@ { final Environment innerEnv = new Environment(ext); LispObject body = args.cdr(); - while (body != NIL) - { - LispObject obj = body.car(); - if (obj instanceof Cons && ((Cons)obj).car == Symbol.DECLARE) - { - LispObject decls = ((Cons)obj).cdr; - while (decls != NIL) - { - LispObject decl = decls.car(); - if (decl instanceof Cons && ((Cons)decl).car == Symbol.SPECIAL) - { - LispObject vars = ((Cons)decl).cdr; - while (vars != NIL) - { - innerEnv.declareSpecial((Symbol)((Cons)vars).car); - vars = ((Cons)vars).cdr; - } - } - decls = ((Cons)decls).cdr; - } - body = ((Cons)body).cdr; - } - else - break; - } + body = innerEnv.processDeclarations(body); return progn(body, ext, thread); } finally From ehuelsmann at common-lisp.net Sat Sep 20 06:15:30 2008 From: ehuelsmann at common-lisp.net (ehuelsmann at common-lisp.net) Date: Sat, 20 Sep 2008 02:15:30 -0400 (EDT) Subject: [armedbear-cvs] r11325 - trunk/j/src/org/armedbear/lisp Message-ID: <20080920061530.9E75075187@common-lisp.net> Author: ehuelsmann Date: Sat Sep 20 02:15:27 2008 New Revision: 11325 Modified: trunk/j/src/org/armedbear/lisp/Closure.java Log: Cleanup. Patch by: Ville Voutilainen Modified: trunk/j/src/org/armedbear/lisp/Closure.java ============================================================================== --- trunk/j/src/org/armedbear/lisp/Closure.java (original) +++ trunk/j/src/org/armedbear/lisp/Closure.java Sat Sep 20 02:15:27 2008 @@ -417,6 +417,24 @@ else return execute(new LispObject[0]); } + + private final void bindParameters(int arityValue, + Environment ext, + LispThread thread) + throws ConditionThrowable + { + if (arity != arityValue) + { + if (optionalParameters != null) + bindOptionalParameterDefaults(ext, thread); + if (restVar != null) + bindArg(restVar, NIL, ext, thread); + if (keywordParameters != null) + bindKeywordParameterDefaults(ext, thread); + } + if (auxVars != null) + bindAuxVars(ext, thread); + } public LispObject execute(LispObject arg) throws ConditionThrowable { @@ -426,17 +444,7 @@ SpecialBinding lastSpecialBinding = thread.lastSpecialBinding; Environment ext = new Environment(environment); bindArg(requiredParameters[0].var, arg, ext, thread); - if (arity != 1) - { - if (optionalParameters != null) - bindOptionalParameterDefaults(ext, thread); - if (restVar != null) - bindArg(restVar, NIL, ext, thread); - if (keywordParameters != null) - bindKeywordParameterDefaults(ext, thread); - } - if (auxVars != null) - bindAuxVars(ext, thread); + bindParameters(1, ext, thread); try { return progn(body, ext, thread); @@ -464,17 +472,7 @@ Environment ext = new Environment(environment); bindArg(requiredParameters[0].var, first, ext, thread); bindArg(requiredParameters[1].var, second, ext, thread); - if (arity != 2) - { - if (optionalParameters != null) - bindOptionalParameterDefaults(ext, thread); - if (restVar != null) - bindArg(restVar, NIL, ext, thread); - if (keywordParameters != null) - bindKeywordParameterDefaults(ext, thread); - } - if (auxVars != null) - bindAuxVars(ext, thread); + bindParameters(2, ext, thread); try { return progn(body, ext, thread); @@ -505,17 +503,7 @@ bindArg(requiredParameters[0].var, first, ext, thread); bindArg(requiredParameters[1].var, second, ext, thread); bindArg(requiredParameters[2].var, third, ext, thread); - if (arity != 3) - { - if (optionalParameters != null) - bindOptionalParameterDefaults(ext, thread); - if (restVar != null) - bindArg(restVar, NIL, ext, thread); - if (keywordParameters != null) - bindKeywordParameterDefaults(ext, thread); - } - if (auxVars != null) - bindAuxVars(ext, thread); + bindParameters(3, ext, thread); try { return progn(body, ext, thread); @@ -548,17 +536,7 @@ bindArg(requiredParameters[1].var, second, ext, thread); bindArg(requiredParameters[2].var, third, ext, thread); bindArg(requiredParameters[3].var, fourth, ext, thread); - if (arity != 4) - { - if (optionalParameters != null) - bindOptionalParameterDefaults(ext, thread); - if (restVar != null) - bindArg(restVar, NIL, ext, thread); - if (keywordParameters != null) - bindKeywordParameterDefaults(ext, thread); - } - if (auxVars != null) - bindAuxVars(ext, thread); + bindParameters(4, ext, thread); try { return progn(body, ext, thread); @@ -594,17 +572,7 @@ bindArg(requiredParameters[2].var, third, ext, thread); bindArg(requiredParameters[3].var, fourth, ext, thread); bindArg(requiredParameters[4].var, fifth, ext, thread); - if (arity != 5) - { - if (optionalParameters != null) - bindOptionalParameterDefaults(ext, thread); - if (restVar != null) - bindArg(restVar, NIL, ext, thread); - if (keywordParameters != null) - bindKeywordParameterDefaults(ext, thread); - } - if (auxVars != null) - bindAuxVars(ext, thread); + bindParameters(5, ext, thread); try { return progn(body, ext, thread); @@ -642,17 +610,7 @@ bindArg(requiredParameters[3].var, fourth, ext, thread); bindArg(requiredParameters[4].var, fifth, ext, thread); bindArg(requiredParameters[5].var, sixth, ext, thread); - if (arity != 6) - { - if (optionalParameters != null) - bindOptionalParameterDefaults(ext, thread); - if (restVar != null) - bindArg(restVar, NIL, ext, thread); - if (keywordParameters != null) - bindKeywordParameterDefaults(ext, thread); - } - if (auxVars != null) - bindAuxVars(ext, thread); + bindParameters(6, ext, thread); try { return progn(body, ext, thread); @@ -693,17 +651,7 @@ bindArg(requiredParameters[4].var, fifth, ext, thread); bindArg(requiredParameters[5].var, sixth, ext, thread); bindArg(requiredParameters[6].var, seventh, ext, thread); - if (arity != 7) - { - if (optionalParameters != null) - bindOptionalParameterDefaults(ext, thread); - if (restVar != null) - bindArg(restVar, NIL, ext, thread); - if (keywordParameters != null) - bindKeywordParameterDefaults(ext, thread); - } - if (auxVars != null) - bindAuxVars(ext, thread); + bindParameters(7, ext, thread); try { return progn(body, ext, thread); @@ -751,17 +699,7 @@ bindArg(requiredParameters[5].var, sixth, ext, thread); bindArg(requiredParameters[6].var, seventh, ext, thread); bindArg(requiredParameters[7].var, eighth, ext, thread); - if (arity != 8) - { - if (optionalParameters != null) - bindOptionalParameterDefaults(ext, thread); - if (restVar != null) - bindArg(restVar, NIL, ext, thread); - if (keywordParameters != null) - bindKeywordParameterDefaults(ext, thread); - } - if (auxVars != null) - bindAuxVars(ext, thread); + bindParameters(8, ext, thread); try { return progn(body, ext, thread); From ehuelsmann at common-lisp.net Mon Sep 22 20:06:01 2008 From: ehuelsmann at common-lisp.net (ehuelsmann at common-lisp.net) Date: Mon, 22 Sep 2008 16:06:01 -0400 (EDT) Subject: [armedbear-cvs] r11326 - trunk/j/src/org/armedbear/lisp Message-ID: <20080922200601.5A24F690DA@common-lisp.net> Author: ehuelsmann Date: Mon Sep 22 16:06:00 2008 New Revision: 11326 Modified: trunk/j/src/org/armedbear/lisp/Closure.java Log: Cleanup. Patch by: Ville Voutilainen Modified: trunk/j/src/org/armedbear/lisp/Closure.java ============================================================================== --- trunk/j/src/org/armedbear/lisp/Closure.java (original) +++ trunk/j/src/org/armedbear/lisp/Closure.java Mon Sep 22 16:06:00 2008 @@ -2,6 +2,7 @@ * Closure.java * * Copyright (C) 2002-2008 Peter Graves + * Copyright (C) 2008 Ville Voutilainen * $Id$ * * This program is free software; you can redistribute it and/or @@ -436,6 +437,17 @@ bindAuxVars(ext, thread); } + private final void bindRequiredParameters(Environment ext, + LispThread thread, + LispObject... objects) + throws ConditionThrowable + { + for (int i = 0; i < objects.length; ++i) + { + bindArg(requiredParameters[i].var, objects[i], ext, thread); + } + } + public LispObject execute(LispObject arg) throws ConditionThrowable { if (minArgs == 1) @@ -443,8 +455,8 @@ final LispThread thread = LispThread.currentThread(); SpecialBinding lastSpecialBinding = thread.lastSpecialBinding; Environment ext = new Environment(environment); - bindArg(requiredParameters[0].var, arg, ext, thread); - bindParameters(1, ext, thread); + bindRequiredParameters(ext, thread, arg); + bindParameters(1, ext, thread); try { return progn(body, ext, thread); @@ -470,9 +482,8 @@ final LispThread thread = LispThread.currentThread(); SpecialBinding lastSpecialBinding = thread.lastSpecialBinding; Environment ext = new Environment(environment); - bindArg(requiredParameters[0].var, first, ext, thread); - bindArg(requiredParameters[1].var, second, ext, thread); - bindParameters(2, ext, thread); + bindRequiredParameters(ext, thread, first, second); + bindParameters(2, ext, thread); try { return progn(body, ext, thread); @@ -500,10 +511,8 @@ final LispThread thread = LispThread.currentThread(); SpecialBinding lastSpecialBinding = thread.lastSpecialBinding; Environment ext = new Environment(environment); - bindArg(requiredParameters[0].var, first, ext, thread); - bindArg(requiredParameters[1].var, second, ext, thread); - bindArg(requiredParameters[2].var, third, ext, thread); - bindParameters(3, ext, thread); + bindRequiredParameters(ext, thread, first, second, third); + bindParameters(3, ext, thread); try { return progn(body, ext, thread); @@ -532,11 +541,8 @@ final LispThread thread = LispThread.currentThread(); SpecialBinding lastSpecialBinding = thread.lastSpecialBinding; Environment ext = new Environment(environment); - bindArg(requiredParameters[0].var, first, ext, thread); - bindArg(requiredParameters[1].var, second, ext, thread); - bindArg(requiredParameters[2].var, third, ext, thread); - bindArg(requiredParameters[3].var, fourth, ext, thread); - bindParameters(4, ext, thread); + bindRequiredParameters(ext, thread, first, second, third, fourth); + bindParameters(4, ext, thread); try { return progn(body, ext, thread); @@ -567,12 +573,9 @@ final LispThread thread = LispThread.currentThread(); SpecialBinding lastSpecialBinding = thread.lastSpecialBinding; Environment ext = new Environment(environment); - bindArg(requiredParameters[0].var, first, ext, thread); - bindArg(requiredParameters[1].var, second, ext, thread); - bindArg(requiredParameters[2].var, third, ext, thread); - bindArg(requiredParameters[3].var, fourth, ext, thread); - bindArg(requiredParameters[4].var, fifth, ext, thread); - bindParameters(5, ext, thread); + bindRequiredParameters(ext, thread, first, second, third, fourth, + fifth); + bindParameters(5, ext, thread); try { return progn(body, ext, thread); @@ -604,13 +607,9 @@ final LispThread thread = LispThread.currentThread(); SpecialBinding lastSpecialBinding = thread.lastSpecialBinding; Environment ext = new Environment(environment); - bindArg(requiredParameters[0].var, first, ext, thread); - bindArg(requiredParameters[1].var, second, ext, thread); - bindArg(requiredParameters[2].var, third, ext, thread); - bindArg(requiredParameters[3].var, fourth, ext, thread); - bindArg(requiredParameters[4].var, fifth, ext, thread); - bindArg(requiredParameters[5].var, sixth, ext, thread); - bindParameters(6, ext, thread); + bindRequiredParameters(ext, thread, first, second, third, fourth, + fifth, sixth); + bindParameters(6, ext, thread); try { return progn(body, ext, thread); @@ -644,14 +643,9 @@ final LispThread thread = LispThread.currentThread(); SpecialBinding lastSpecialBinding = thread.lastSpecialBinding; Environment ext = new Environment(environment); - bindArg(requiredParameters[0].var, first, ext, thread); - bindArg(requiredParameters[1].var, second, ext, thread); - bindArg(requiredParameters[2].var, third, ext, thread); - bindArg(requiredParameters[3].var, fourth, ext, thread); - bindArg(requiredParameters[4].var, fifth, ext, thread); - bindArg(requiredParameters[5].var, sixth, ext, thread); - bindArg(requiredParameters[6].var, seventh, ext, thread); - bindParameters(7, ext, thread); + bindRequiredParameters(ext, thread, first, second, third, fourth, + fifth, sixth, seventh); + bindParameters(7, ext, thread); try { return progn(body, ext, thread); @@ -691,15 +685,9 @@ for (int i = 0; i < specials.length; i++) ext.declareSpecial(specials[i]); } - bindArg(requiredParameters[0].var, first, ext, thread); - bindArg(requiredParameters[1].var, second, ext, thread); - bindArg(requiredParameters[2].var, third, ext, thread); - bindArg(requiredParameters[3].var, fourth, ext, thread); - bindArg(requiredParameters[4].var, fifth, ext, thread); - bindArg(requiredParameters[5].var, sixth, ext, thread); - bindArg(requiredParameters[6].var, seventh, ext, thread); - bindArg(requiredParameters[7].var, eighth, ext, thread); - bindParameters(8, ext, thread); + bindRequiredParameters(ext, thread, first, second, third, fourth, + fifth, sixth, seventh, eighth); + bindParameters(8, ext, thread); try { return progn(body, ext, thread); From ehuelsmann at common-lisp.net Sun Sep 28 19:30:51 2008 From: ehuelsmann at common-lisp.net (ehuelsmann at common-lisp.net) Date: Sun, 28 Sep 2008 15:30:51 -0400 (EDT) Subject: [armedbear-cvs] r11327 - public_html Message-ID: <20080928193051.5EB62340A6@common-lisp.net> Author: ehuelsmann Date: Sun Sep 28 15:30:49 2008 New Revision: 11327 Modified: public_html/index.shtml Log: Update website with testing results from Mark Evenson. Modified: public_html/index.shtml ============================================================================== --- public_html/index.shtml (original) +++ public_html/index.shtml Sun Sep 28 15:30:49 2008 @@ -71,10 +71,10 @@ out through anonymous access with the following command: 
 
-      $ svn co svn://common-lisp.net/project/armedbear/svn/trunk/j j
+      $ svn co svn://common-lisp.net/project/armedbear/svn/trunk/j j
-

Please note that the minimum required JDK version for development - versions of ABCL has been raised to 1.5.

+

Please note that the minimum required JDK version for development + versions of ABCL has been raised to 1.5.

@@ -114,12 +114,15 @@ The README file in the root directory of the source distribution contains instructions for building ABCL.

- Java 1.4 or later is required. + Java 1.4 or later is required - see the note above on recent development + versions - Java 1.5 is recommended. There are unresolved performance issues with Java 1.6. To build ABCL, you'll need - the full JDK; the JRE is not enough. + the full JDK; the JRE is not enough.
+ Recent performance tests have shown Java 1.6 Update 10 - a Release + Candidate as of this writing - to be as fast as Java 1.5.

From ehuelsmann at common-lisp.net Sun Sep 28 19:34:43 2008 From: ehuelsmann at common-lisp.net (ehuelsmann at common-lisp.net) Date: Sun, 28 Sep 2008 15:34:43 -0400 (EDT) Subject: [armedbear-cvs] r11328 - trunk/j/src/org/armedbear/lisp Message-ID: <20080928193443.D3A5A340A6@common-lisp.net> Author: ehuelsmann Date: Sun Sep 28 15:34:43 2008 New Revision: 11328 Modified: trunk/j/src/org/armedbear/lisp/Closure.java Log: Closure.java cleanup by Ville Voutilainen. Modified: trunk/j/src/org/armedbear/lisp/Closure.java ============================================================================== --- trunk/j/src/org/armedbear/lisp/Closure.java (original) +++ trunk/j/src/org/armedbear/lisp/Closure.java Sun Sep 28 15:34:43 2008 @@ -447,7 +447,13 @@ bindArg(requiredParameters[i].var, objects[i], ext, thread); } } - + + public final LispObject invokeArrayExecute(LispObject... objects) + throws ConditionThrowable + { + return execute(objects); + } + public LispObject execute(LispObject arg) throws ConditionThrowable { if (minArgs == 1) @@ -456,7 +462,7 @@ SpecialBinding lastSpecialBinding = thread.lastSpecialBinding; Environment ext = new Environment(environment); bindRequiredParameters(ext, thread, arg); - bindParameters(1, ext, thread); + bindParameters(minArgs, ext, thread); try { return progn(body, ext, thread); @@ -468,9 +474,7 @@ } else { - LispObject[] args = new LispObject[1]; - args[0] = arg; - return execute(args); + return invokeArrayExecute(arg); } } @@ -483,7 +487,7 @@ SpecialBinding lastSpecialBinding = thread.lastSpecialBinding; Environment ext = new Environment(environment); bindRequiredParameters(ext, thread, first, second); - bindParameters(2, ext, thread); + bindParameters(minArgs, ext, thread); try { return progn(body, ext, thread); @@ -495,10 +499,7 @@ } else { - LispObject[] args = new LispObject[2]; - args[0] = first; - args[1] = second; - return execute(args); + return invokeArrayExecute(first, second); } } @@ -512,7 +513,7 @@ SpecialBinding lastSpecialBinding = thread.lastSpecialBinding; Environment ext = new Environment(environment); bindRequiredParameters(ext, thread, first, second, third); - bindParameters(3, ext, thread); + bindParameters(minArgs, ext, thread); try { return progn(body, ext, thread); @@ -524,11 +525,7 @@ } else { - LispObject[] args = new LispObject[3]; - args[0] = first; - args[1] = second; - args[2] = third; - return execute(args); + return invokeArrayExecute(first, second, third); } } @@ -542,7 +539,7 @@ SpecialBinding lastSpecialBinding = thread.lastSpecialBinding; Environment ext = new Environment(environment); bindRequiredParameters(ext, thread, first, second, third, fourth); - bindParameters(4, ext, thread); + bindParameters(minArgs, ext, thread); try { return progn(body, ext, thread); @@ -554,12 +551,7 @@ } else { - LispObject[] args = new LispObject[4]; - args[0] = first; - args[1] = second; - args[2] = third; - args[3] = fourth; - return execute(args); + return invokeArrayExecute(first, second, third, fourth); } } @@ -575,7 +567,7 @@ Environment ext = new Environment(environment); bindRequiredParameters(ext, thread, first, second, third, fourth, fifth); - bindParameters(5, ext, thread); + bindParameters(minArgs, ext, thread); try { return progn(body, ext, thread); @@ -587,13 +579,7 @@ } else { - LispObject[] args = new LispObject[5]; - args[0] = first; - args[1] = second; - args[2] = third; - args[3] = fourth; - args[4] = fifth; - return execute(args); + return invokeArrayExecute(first, second, third, fourth, fifth); } } @@ -609,7 +595,7 @@ Environment ext = new Environment(environment); bindRequiredParameters(ext, thread, first, second, third, fourth, fifth, sixth); - bindParameters(6, ext, thread); + bindParameters(minArgs, ext, thread); try { return progn(body, ext, thread); @@ -621,14 +607,8 @@ } else { - LispObject[] args = new LispObject[6]; - args[0] = first; - args[1] = second; - args[2] = third; - args[3] = fourth; - args[4] = fifth; - args[5] = sixth; - return execute(args); + return invokeArrayExecute(first, second, third, fourth, fifth, + sixth); } } @@ -645,7 +625,7 @@ Environment ext = new Environment(environment); bindRequiredParameters(ext, thread, first, second, third, fourth, fifth, sixth, seventh); - bindParameters(7, ext, thread); + bindParameters(minArgs, ext, thread); try { return progn(body, ext, thread); @@ -657,15 +637,8 @@ } else { - LispObject[] args = new LispObject[7]; - args[0] = first; - args[1] = second; - args[2] = third; - args[3] = fourth; - args[4] = fifth; - args[5] = sixth; - args[6] = seventh; - return execute(args); + return invokeArrayExecute(first, second, third, fourth, fifth, + sixth, seventh); } } @@ -687,7 +660,7 @@ } bindRequiredParameters(ext, thread, first, second, third, fourth, fifth, sixth, seventh, eighth); - bindParameters(8, ext, thread); + bindParameters(minArgs, ext, thread); try { return progn(body, ext, thread); @@ -699,16 +672,8 @@ } else { - LispObject[] args = new LispObject[8]; - args[0] = first; - args[1] = second; - args[2] = third; - args[3] = fourth; - args[4] = fifth; - args[5] = sixth; - args[6] = seventh; - args[7] = eighth; - return execute(args); + return invokeArrayExecute(first, second, third, fourth, fifth, + sixth, seventh, eighth); } } From ehuelsmann at common-lisp.net Tue Sep 30 20:57:21 2008 From: ehuelsmann at common-lisp.net (ehuelsmann at common-lisp.net) Date: Tue, 30 Sep 2008 16:57:21 -0400 (EDT) Subject: [armedbear-cvs] r11329 - trunk/j/src/org/armedbear/lisp Message-ID: <20080930205721.5845D5007@common-lisp.net> Author: ehuelsmann Date: Tue Sep 30 16:57:17 2008 New Revision: 11329 Modified: trunk/j/src/org/armedbear/lisp/Closure.java Log: Cleanup by Ville Voutilainen. Modified: trunk/j/src/org/armedbear/lisp/Closure.java ============================================================================== --- trunk/j/src/org/armedbear/lisp/Closure.java (original) +++ trunk/j/src/org/armedbear/lisp/Closure.java Tue Sep 30 16:57:17 2008 @@ -419,9 +419,10 @@ return execute(new LispObject[0]); } - private final void bindParameters(int arityValue, - Environment ext, - LispThread thread) + private final LispObject bindParametersAndExecute(int arityValue, + Environment ext, + LispThread thread, + SpecialBinding lastSpecialBinding) throws ConditionThrowable { if (arity != arityValue) @@ -435,6 +436,14 @@ } if (auxVars != null) bindAuxVars(ext, thread); + try + { + return progn(body, ext, thread); + } + finally + { + thread.lastSpecialBinding = lastSpecialBinding; + } } private final void bindRequiredParameters(Environment ext, @@ -462,15 +471,8 @@ SpecialBinding lastSpecialBinding = thread.lastSpecialBinding; Environment ext = new Environment(environment); bindRequiredParameters(ext, thread, arg); - bindParameters(minArgs, ext, thread); - try - { - return progn(body, ext, thread); - } - finally - { - thread.lastSpecialBinding = lastSpecialBinding; - } + return bindParametersAndExecute(minArgs, ext, thread, + lastSpecialBinding); } else { @@ -487,15 +489,8 @@ SpecialBinding lastSpecialBinding = thread.lastSpecialBinding; Environment ext = new Environment(environment); bindRequiredParameters(ext, thread, first, second); - bindParameters(minArgs, ext, thread); - try - { - return progn(body, ext, thread); - } - finally - { - thread.lastSpecialBinding = lastSpecialBinding; - } + return bindParametersAndExecute(minArgs, ext, thread, + lastSpecialBinding); } else { @@ -513,15 +508,8 @@ SpecialBinding lastSpecialBinding = thread.lastSpecialBinding; Environment ext = new Environment(environment); bindRequiredParameters(ext, thread, first, second, third); - bindParameters(minArgs, ext, thread); - try - { - return progn(body, ext, thread); - } - finally - { - thread.lastSpecialBinding = lastSpecialBinding; - } + return bindParametersAndExecute(minArgs, ext, thread, + lastSpecialBinding); } else { @@ -539,15 +527,8 @@ SpecialBinding lastSpecialBinding = thread.lastSpecialBinding; Environment ext = new Environment(environment); bindRequiredParameters(ext, thread, first, second, third, fourth); - bindParameters(minArgs, ext, thread); - try - { - return progn(body, ext, thread); - } - finally - { - thread.lastSpecialBinding = lastSpecialBinding; - } + return bindParametersAndExecute(minArgs, ext, thread, + lastSpecialBinding); } else { @@ -567,15 +548,8 @@ Environment ext = new Environment(environment); bindRequiredParameters(ext, thread, first, second, third, fourth, fifth); - bindParameters(minArgs, ext, thread); - try - { - return progn(body, ext, thread); - } - finally - { - thread.lastSpecialBinding = lastSpecialBinding; - } + return bindParametersAndExecute(minArgs, ext, thread, + lastSpecialBinding); } else { @@ -595,15 +569,8 @@ Environment ext = new Environment(environment); bindRequiredParameters(ext, thread, first, second, third, fourth, fifth, sixth); - bindParameters(minArgs, ext, thread); - try - { - return progn(body, ext, thread); - } - finally - { - thread.lastSpecialBinding = lastSpecialBinding; - } + return bindParametersAndExecute(minArgs, ext, thread, + lastSpecialBinding); } else { @@ -625,15 +592,8 @@ Environment ext = new Environment(environment); bindRequiredParameters(ext, thread, first, second, third, fourth, fifth, sixth, seventh); - bindParameters(minArgs, ext, thread); - try - { - return progn(body, ext, thread); - } - finally - { - thread.lastSpecialBinding = lastSpecialBinding; - } + return bindParametersAndExecute(minArgs, ext, thread, + lastSpecialBinding); } else { @@ -660,15 +620,8 @@ } bindRequiredParameters(ext, thread, first, second, third, fourth, fifth, sixth, seventh, eighth); - bindParameters(minArgs, ext, thread); - try - { - return progn(body, ext, thread); - } - finally - { - thread.lastSpecialBinding = lastSpecialBinding; - } + return bindParametersAndExecute(minArgs, ext, thread, + lastSpecialBinding); } else {