Artifact 8e49a46d52edf1fd3672c6032a98d4c45cef1c24a8dbda7764711683edb50b67:
- Executable file
r37/lisp/csl/jlisp/Bytecode.java
— part of check-in
[f2fda60abd]
at
2011-09-02 18:13:33
on branch master
— Some historical releases purely for archival purposes
git-svn-id: https://svn.code.sf.net/p/reduce-algebra/code/trunk/historical@1375 2bfe0521-f11c-4a00-b80e-6202646ff360 (user: arthurcnorman@users.sourceforge.net, size: 90853) [annotate] [blame] [check-ins using] [more...]
// // This file is part of the Jlisp implementation of Standard Lisp // Copyright \u00a9 (C) Codemist Ltd, 1998-2000. // class Bytecode extends FnWithEnv { Bytecode() { env = new LispObject [0]; bytecodes = null; nargs = 0; } Bytecode(LispObject [] env) { this.env = env; bytecodes = null; nargs = 0; } Bytecode(int n) { env = new LispObject [0]; bytecodes = new byte [n]; nargs = 0; } static StringBuffer sb; String printAs() { sb.setLength(0); sb.append("#BPS"); if (nargs > 0xff) { sb.append(Integer.toHexString(nargs >> 8)); sb.append(":"); } sb.append(Integer.toString(nargs & 0xff)); sb.append("<"); if (bytecodes == null) sb.append("null"); else for (int i=0; i<bytecodes.length; i++) { String s = Integer.toHexString(bytecodes[i] & 0xff); if (s.length() == 1) s = "0" + s; sb.append(s); } sb.append(">"); return sb.toString(); } void iprint() { String s = printAs(); if ((currentFlags & noLineBreak) == 0 && currentOutput.column + s.length() > currentOutput.lineLength) currentOutput.println(); currentOutput.print(s); } void blankprint() { String s = printAs(); if ((currentFlags & noLineBreak) == 0 && currentOutput.column + s.length() >= currentOutput.lineLength) currentOutput.println(); else currentOutput.print(" "); currentOutput.print(s); } public LispObject op0() throws Exception { if (nargs != 0) Jlisp.error("Wrong number of arguments for " + name); return interpret(0); } public LispObject op1(LispObject a1) throws Exception { if (nargs != 1) Jlisp.error("Wrong number of arguments for " + name); int spsave = sp; LispObject r = Jlisp.nil; stack[++sp] = a1; try { r = interpret(0); sp--; } catch (Exception e) { sp = spsave; throw e; } return r; } public LispObject op2(LispObject a1, LispObject a2) throws Exception { if (nargs != 2) Jlisp.error("Wrong number of arguments for " + name); int spsave = sp; LispObject r = Jlisp.nil; stack[++sp] = a1; stack[++sp] = a2; try { r = interpret(0); sp -= 2; } catch (Exception e) { sp = spsave; throw e; } return r; } public LispObject opn(LispObject [] args) throws Exception { int n = args.length; if (nargs != n) Jlisp.error("Wrong number of arguments for " + name); int spsave = sp; for (int i=0; i<args.length; i++) stack[++sp] = args[i]; if (n > 3) { if (n != (bytecodes[0] & 0xff)) { sp = spsave; error("Wrong number of args"); } n = 1; } else n = 0; LispObject r = Jlisp.nil; try { r = interpret(n); sp = spsave; } catch (Exception e) { sp = spsave; throw e; } return r; } static LispFunction builtin0[], builtin1[], builtin2[], builtin3[]; static LispFunction lookupBuiltin(String s) { LispFunction r = (LispFunction)Jlisp.builtinFunctions.get(s); if (r == null) Jlisp.println("Function " + s + " not found"); return r; } static int BIbatchp, BIdate, BIeject, BIerror1, BIgctime, BIgensym, BIlposn, BInext_random, BIposn, BIread, BIreadch, BIterpri, BItime, BItyi, BIload_spid, BIabs, BIadd1, BIatan, BIapply0, BIatom, BIboundp, BIchar_code, BIclose, BIcodep, BIcompress, BIconstantp, BIdigit, BIendp, BIeval, BIevenp, BIevlis, BIexplode, BIexplode2lc, BIexplode2, BIexplodec, BIfixp, BIfloat, BIfloatp, BIsymbol_specialp, BIgc, BIgensym1, BIgetenv, BIsymbol_globalp, BIiadd1, BIsymbolp, BIiminus, BIiminusp, BIindirect, BIintegerp, BIintern, BIisub1, BIlength, BIlengthc, BIlinelength, BIliter, BIload_module, BIlognot, BImacroexpand, BImacroexpand_1, BImacro_function, BImake_bps, BImake_global, BImake_simple_string, BImake_special, BIminus, BIminusp, BImkvect, BImodular_minus, BImodular_number, BImodular_reciprocal, BInull, BIoddp, BIonep, BIpagelength, BIpairp, BIplist, BIplusp, BIprin, BIprinc, BIprint, BIprintc, BIrandom, BIrational, BIload, BIrds, BIremd, BIreverse, BIreversip, BIseprp, BIset_small_modulus, BIspaces, BIxtab, BIspecial_char, BIspecial_form_p, BIspool, BIstop, BIstringp, BIsub1, BIsymbol_env, BIsymbol_function, BIsymbol_name, BIsymbol_value, BIsystem, BIfix, BIttab, BItyo, BIremob, BIunmake_global, BIunmake_special, BIupbv, BIvectorp, BIsimple_vectorp, BIverbos, BIwrs, BIzerop, BIcar, BIcdr, BIcaar, BIcadr, BIcdar, BIcddr, BIqcar, BIqcdr, BIqcaar, BIqcadr, BIqcdar, BIqcddr, BIncons, BInumberp, BIis_spid, BIspid_to_nil, BImv_listSTAR, BIappend, BIash, BIassoc, BIatsoc, BIdeleq, BIdelete, BIdivide, BIeqcar, BIeql, BIeqn, BIexpt, BIflag, BIflagpcar, BIgcdn, BIgeq, BIgetv, BIgreaterp, BIidifference, BIigreaterp, BIilessp, BIimax, BIimin, BIiplus2, BIiquotient, BIiremainder, BIirightshift, BIitimes2, BIlcm, BIleq, BIlessp, BImake_random_state, BImax2, BImember, BImemq, BImin2, BImod, BImodular_difference, BImodular_expt, BImodular_plus, BImodular_quotient, BImodular_times, BInconc, BIneq, BIorderp, BIordp, BIquotient, BIremainder, BIremflag, BIremprop, BIrplaca, BIrplacd, BIschar, BIset, BIsmemq, BIsubla, BIsublis, BIsymbol_set_definition, BIsymbol_set_env, BIxcons, BIequal, BIeq, BIcons, BIlist2, BIget, BIqgetv, BIflagp, BIapply1, BIdifference, BIplus2, BItimes2, BIequalcar, BIiequal, BIbps_putv, BIerrorset, BIlist2STAR, BIlist3, BIputprop, BIputv, BIputv_char, BIsubst, BIapply2, BIacons; static void setupBuiltins() { builtin0 = new LispFunction[15]; builtin1 = new LispFunction[114]; builtin2 = new LispFunction[72]; builtin3 = new LispFunction[10]; builtin0[0] = lookupBuiltin("batchp"); BIbatchp = 0; builtin0[1] = lookupBuiltin("date"); BIdate = 1; builtin0[2] = lookupBuiltin("eject"); BIeject = 2; builtin0[3] = lookupBuiltin("error1"); BIerror1 = 3; builtin0[4] = lookupBuiltin("gctime"); BIgctime = 4; builtin0[5] = lookupBuiltin("gensym"); BIgensym = 5; builtin0[6] = lookupBuiltin("lposn"); BIlposn = 6; // builtin0[7] = lookupBuiltin("next-random"); BInext_random = 7; builtin0[8] = lookupBuiltin("posn"); BIposn = 8; builtin0[9] = lookupBuiltin("read"); BIread = 9; builtin0[10] = lookupBuiltin("readch"); BIreadch = 10; builtin0[11] = lookupBuiltin("terpri"); BIterpri = 11; builtin0[12] = lookupBuiltin("time"); BItime = 12; // builtin0[13] = lookupBuiltin("tyi"); BItyi = 13; // builtin0[14] = lookupBuiltin("load-spid"); BIload_spid = 14; builtin1[0] = lookupBuiltin("abs"); BIabs = 0; builtin1[1] = lookupBuiltin("add1"); BIadd1 = 1; builtin1[2] = lookupBuiltin("atan"); BIatan = 2; builtin1[3] = lookupBuiltin("apply0"); BIapply0 = 3; builtin1[4] = lookupBuiltin("atom"); BIatom = 4; builtin1[5] = lookupBuiltin("boundp"); BIboundp = 5; builtin1[6] = lookupBuiltin("char-code"); BIchar_code = 6; builtin1[7] = lookupBuiltin("close"); BIclose = 7; builtin1[8] = lookupBuiltin("codep"); BIcodep = 8; builtin1[9] = lookupBuiltin("compress"); BIcompress = 9; builtin1[10] = lookupBuiltin("constantp"); BIconstantp = 10; builtin1[11] = lookupBuiltin("digit"); BIdigit = 11; builtin1[12] = lookupBuiltin("endp"); BIendp = 12; builtin1[13] = lookupBuiltin("eval"); BIeval = 13; builtin1[14] = lookupBuiltin("evenp"); BIevenp = 14; builtin1[15] = lookupBuiltin("evlis"); BIevlis = 15; builtin1[16] = lookupBuiltin("explode"); BIexplode = 16; builtin1[17] = lookupBuiltin("explode2lc"); BIexplode2lc = 17; builtin1[18] = lookupBuiltin("explode2"); BIexplode2 = 18; builtin1[18] = lookupBuiltin("explodec"); BIexplodec = 18; builtin1[19] = lookupBuiltin("fixp"); BIfixp = 19; builtin1[20] = lookupBuiltin("float"); BIfloat = 20; builtin1[21] = lookupBuiltin("floatp"); BIfloatp = 21; // builtin1[22] = lookupBuiltin("symbol-specialp"); BIsymbol_specialp = 22; // builtin1[23] = lookupBuiltin("gc"); BIgc = 23; builtin1[24] = lookupBuiltin("gensym1"); BIgensym1 = 24; builtin1[25] = lookupBuiltin("getenv"); BIgetenv = 25; // builtin1[26] = lookupBuiltin("symbol-globalp"); BIsymbol_globalp = 26; builtin1[27] = lookupBuiltin("iadd1"); BIiadd1 = 27; builtin1[28] = lookupBuiltin("symbolp"); BIsymbolp = 28; builtin1[29] = lookupBuiltin("iminus"); BIiminus = 29; builtin1[30] = lookupBuiltin("iminusp"); BIiminusp = 30; builtin1[31] = lookupBuiltin("indirect"); BIindirect = 31; builtin1[32] = lookupBuiltin("integerp"); BIintegerp = 32; builtin1[33] = lookupBuiltin("intern"); BIintern = 33; builtin1[34] = lookupBuiltin("isub1"); BIisub1 = 34; builtin1[35] = lookupBuiltin("length"); BIlength = 35; builtin1[36] = lookupBuiltin("lengthc"); BIlengthc = 36; builtin1[37] = lookupBuiltin("linelength"); BIlinelength = 37; builtin1[38] = lookupBuiltin("liter"); BIliter = 38; builtin1[39] = lookupBuiltin("load-module"); BIload_module = 39; builtin1[40] = lookupBuiltin("lognot"); BIlognot = 40; builtin1[41] = lookupBuiltin("macroexpand"); BImacroexpand = 41; builtin1[42] = lookupBuiltin("macroexpand-1"); BImacroexpand_1 = 42; builtin1[43] = lookupBuiltin("macro-function"); BImacro_function = 43; builtin1[44] = lookupBuiltin("make-bps"); BImake_bps = 44; builtin1[45] = lookupBuiltin("make-global"); BImake_global = 45; builtin1[46] = lookupBuiltin("make-simple-string"); BImake_simple_string = 46; builtin1[47] = lookupBuiltin("make-special"); BImake_special = 47; builtin1[48] = lookupBuiltin("minus"); BIminus = 48; builtin1[49] = lookupBuiltin("minusp"); BIminusp = 49; builtin1[50] = lookupBuiltin("mkvect"); BImkvect = 50; builtin1[51] = lookupBuiltin("modular-minus"); BImodular_minus = 51; builtin1[52] = lookupBuiltin("modular-number"); BImodular_number = 52; builtin1[53] = lookupBuiltin("modular-reciprocal"); BImodular_reciprocal = 53; builtin1[54] = lookupBuiltin("null"); BInull = 54; builtin1[55] = lookupBuiltin("oddp"); BIoddp = 55; builtin1[56] = lookupBuiltin("onep"); BIonep = 56; builtin1[57] = lookupBuiltin("pagelength"); BIpagelength = 57; builtin1[58] = lookupBuiltin("pairp"); BIpairp = 58; builtin1[59] = lookupBuiltin("plist"); BIplist = 59; builtin1[60] = lookupBuiltin("plusp"); BIplusp = 60; builtin1[61] = lookupBuiltin("prin"); BIprin = 61; builtin1[62] = lookupBuiltin("princ"); BIprinc = 62; builtin1[63] = lookupBuiltin("print"); BIprint = 63; builtin1[64] = lookupBuiltin("printc"); BIprintc = 64; // builtin1[65] = lookupBuiltin("random"); BIrandom = 65; builtin1[66] = lookupBuiltin("rational"); BIrational = 66; // builtin1[67] = lookupBuiltin("load"); BIload = 67; builtin1[68] = lookupBuiltin("rds"); BIrds = 68; builtin1[69] = lookupBuiltin("remd"); BIremd = 69; builtin1[70] = lookupBuiltin("reverse"); BIreverse = 70; builtin1[71] = lookupBuiltin("reversip"); BIreversip = 71; builtin1[72] = lookupBuiltin("seprp"); BIseprp = 72; builtin1[73] = lookupBuiltin("set-small-modulus"); BIset_small_modulus = 73; builtin1[74] = lookupBuiltin("spaces"); BIspaces = 74; builtin1[74] = lookupBuiltin("xtab"); BIxtab = 74; builtin1[75] = lookupBuiltin("special-char"); BIspecial_char = 75; builtin1[76] = lookupBuiltin("special-form-p"); BIspecial_form_p = 76; builtin1[77] = lookupBuiltin("spool"); BIspool = 77; builtin1[78] = lookupBuiltin("stop"); BIstop = 78; builtin1[79] = lookupBuiltin("stringp"); BIstringp = 79; builtin1[80] = lookupBuiltin("sub1"); BIsub1 = 80; builtin1[81] = lookupBuiltin("symbol-env"); BIsymbol_env = 81; builtin1[82] = lookupBuiltin("symbol-function"); BIsymbol_function = 82; builtin1[83] = lookupBuiltin("symbol-name"); BIsymbol_name = 83; builtin1[84] = lookupBuiltin("symbol-value"); BIsymbol_value = 84; builtin1[85] = lookupBuiltin("system"); BIsystem = 85; builtin1[86] = lookupBuiltin("fix"); BIfix = 86; builtin1[87] = lookupBuiltin("ttab"); BIttab = 87; builtin1[88] = lookupBuiltin("tyo"); BItyo = 88; builtin1[89] = lookupBuiltin("remob"); BIremob = 89; builtin1[90] = lookupBuiltin("unmake-global"); BIunmake_global = 90; builtin1[91] = lookupBuiltin("unmake-special"); BIunmake_special = 91; builtin1[92] = lookupBuiltin("upbv"); BIupbv = 92; builtin1[93] = lookupBuiltin("vectorp"); BIvectorp = 93; // builtin1[93] = lookupBuiltin("simple-vectorp"); BIsimple_vectorp = 93; builtin1[94] = lookupBuiltin("verbos"); BIverbos = 94; builtin1[95] = lookupBuiltin("wrs"); BIwrs = 95; builtin1[96] = lookupBuiltin("zerop"); BIzerop = 96; builtin1[97] = lookupBuiltin("car"); BIcar = 97; builtin1[98] = lookupBuiltin("cdr"); BIcdr = 98; builtin1[99] = lookupBuiltin("caar"); BIcaar = 99; builtin1[100] = lookupBuiltin("cadr"); BIcadr = 100; builtin1[101] = lookupBuiltin("cdar"); BIcdar = 101; builtin1[102] = lookupBuiltin("cddr"); BIcddr = 102; builtin1[103] = lookupBuiltin("qcar"); BIqcar = 103; builtin1[104] = lookupBuiltin("qcdr"); BIqcdr = 104; builtin1[105] = lookupBuiltin("qcaar"); BIqcaar = 105; builtin1[106] = lookupBuiltin("qcadr"); BIqcadr = 106; builtin1[107] = lookupBuiltin("qcdar"); BIqcdar = 107; builtin1[108] = lookupBuiltin("qcddr"); BIqcddr = 108; builtin1[109] = lookupBuiltin("ncons"); BIncons = 109; builtin1[110] = lookupBuiltin("numberp"); BInumberp = 110; // builtin1[111] = lookupBuiltin("is-spid"); BIis_spid = 111; // builtin1[112] = lookupBuiltin("spid-to-nil"); BIspid_to_nil = 112; // builtin1[113] = lookupBuiltin("mv-list*"); BImv_listSTAR = 113; builtin2[0] = lookupBuiltin("append"); BIappend = 0; builtin2[1] = lookupBuiltin("ash"); BIash = 1; builtin2[2] = lookupBuiltin("assoc"); BIassoc = 2; builtin2[3] = lookupBuiltin("atsoc"); BIatsoc = 3; builtin2[4] = lookupBuiltin("deleq"); BIdeleq = 4; builtin2[5] = lookupBuiltin("delete"); BIdelete = 5; builtin2[6] = lookupBuiltin("divide"); BIdivide = 6; builtin2[7] = lookupBuiltin("eqcar"); BIeqcar = 7; builtin2[8] = lookupBuiltin("eql"); BIeql = 8; builtin2[9] = lookupBuiltin("eqn"); BIeqn = 9; builtin2[10] = lookupBuiltin("expt"); BIexpt = 10; builtin2[11] = lookupBuiltin("flag"); BIflag = 11; builtin2[12] = lookupBuiltin("flagpcar"); BIflagpcar = 12; builtin2[13] = lookupBuiltin("gcdn"); BIgcdn = 13; builtin2[14] = lookupBuiltin("geq"); BIgeq = 14; builtin2[15] = lookupBuiltin("getv"); BIgetv = 15; builtin2[16] = lookupBuiltin("greaterp"); BIgreaterp = 16; builtin2[17] = lookupBuiltin("idifference"); BIidifference = 17; builtin2[18] = lookupBuiltin("igreaterp"); BIigreaterp = 18; builtin2[19] = lookupBuiltin("ilessp"); BIilessp = 19; builtin2[20] = lookupBuiltin("imax"); BIimax = 20; builtin2[21] = lookupBuiltin("imin"); BIimin = 21; builtin2[22] = lookupBuiltin("iplus2"); BIiplus2 = 22; builtin2[23] = lookupBuiltin("iquotient"); BIiquotient = 23; builtin2[24] = lookupBuiltin("iremainder"); BIiremainder = 24; builtin2[25] = lookupBuiltin("irightshift"); BIirightshift = 25; builtin2[26] = lookupBuiltin("itimes2"); BIitimes2 = 26; // builtin2[27] = lookupBuiltin("lcm"); BIlcm = 27; builtin2[28] = lookupBuiltin("leq"); BIleq = 28; builtin2[29] = lookupBuiltin("lessp"); BIlessp = 29; builtin2[30] = lookupBuiltin("make-random-state"); BImake_random_state = 30; builtin2[31] = lookupBuiltin("max2"); BImax2 = 31; builtin2[32] = lookupBuiltin("member"); BImember = 32; builtin2[33] = lookupBuiltin("memq"); BImemq = 33; builtin2[34] = lookupBuiltin("min2"); BImin2 = 34; builtin2[35] = lookupBuiltin("mod"); BImod = 35; builtin2[36] = lookupBuiltin("modular-difference"); BImodular_difference = 36; builtin2[37] = lookupBuiltin("modular-expt"); BImodular_expt = 37; builtin2[38] = lookupBuiltin("modular-plus"); BImodular_plus = 38; builtin2[39] = lookupBuiltin("modular-quotient"); BImodular_quotient = 39; builtin2[40] = lookupBuiltin("modular-times"); BImodular_times = 40; builtin2[41] = lookupBuiltin("nconc"); BInconc = 41; builtin2[42] = lookupBuiltin("neq"); BIneq = 42; builtin2[43] = lookupBuiltin("orderp"); BIorderp = 43; builtin2[43] = lookupBuiltin("ordp"); BIordp = 43; builtin2[44] = lookupBuiltin("quotient"); BIquotient = 44; builtin2[45] = lookupBuiltin("remainder"); BIremainder = 45; builtin2[46] = lookupBuiltin("remflag"); BIremflag = 46; builtin2[47] = lookupBuiltin("remprop"); BIremprop = 47; builtin2[48] = lookupBuiltin("rplaca"); BIrplaca = 48; builtin2[49] = lookupBuiltin("rplacd"); BIrplacd = 49; builtin2[50] = lookupBuiltin("schar"); BIschar = 50; builtin2[51] = lookupBuiltin("set"); BIset = 51; builtin2[52] = lookupBuiltin("smemq"); BIsmemq = 52; builtin2[53] = lookupBuiltin("subla"); BIsubla = 53; builtin2[54] = lookupBuiltin("sublis"); BIsublis = 54; builtin2[55] = lookupBuiltin("symbol-set-definition");BIsymbol_set_definition = 55; builtin2[56] = lookupBuiltin("symbol-set-env"); BIsymbol_set_env = 56; ////builtin2[57] = lookupBuiltin("times2"); BItimes2 = 57; builtin2[58] = lookupBuiltin("xcons"); BIxcons = 58; builtin2[59] = lookupBuiltin("equal"); BIequal = 59; builtin2[60] = lookupBuiltin("eq"); BIeq = 60; builtin2[61] = lookupBuiltin("cons"); BIcons = 61; builtin2[62] = lookupBuiltin("list2"); BIlist2 = 62; builtin2[63] = lookupBuiltin("get"); BIget = 63; builtin2[64] = lookupBuiltin("qgetv"); BIqgetv = 64; builtin2[65] = lookupBuiltin("flagp"); BIflagp = 65; builtin2[66] = lookupBuiltin("apply1"); BIapply1 = 66; builtin2[67] = lookupBuiltin("difference"); BIdifference = 67; builtin2[68] = lookupBuiltin("plus2"); BIplus2 = 68; builtin2[69] = lookupBuiltin("times2"); BItimes2 = 69; builtin2[70] = lookupBuiltin("equalcar"); BIequalcar = 70; builtin2[71] = lookupBuiltin("iequal"); BIiequal = 71; builtin3[0] = lookupBuiltin("bps-putv"); BIbps_putv = 0; builtin3[1] = lookupBuiltin("errorset"); BIerrorset = 1; builtin3[2] = lookupBuiltin("list2*"); BIlist2STAR = 2; builtin3[3] = lookupBuiltin("list3"); BIlist3 = 3; // builtin3[4] = lookupBuiltin("putprop"); BIputprop = 4; builtin3[5] = lookupBuiltin("putv"); BIputv = 5; builtin3[6] = lookupBuiltin("putv-char"); BIputv_char = 6; builtin3[7] = lookupBuiltin("subst"); BIsubst = 7; builtin3[8] = lookupBuiltin("apply2"); BIapply2 = 8; builtin3[9] = lookupBuiltin("acons"); BIacons = 9; } static final int LOADLOC = 0x00; static final int LOADLOC0 = 0x01; static final int LOADLOC1 = 0x02; static final int LOADLOC2 = 0x03; static final int LOADLOC3 = 0x04; static final int LOADLOC4 = 0x05; static final int LOADLOC5 = 0x06; static final int LOADLOC6 = 0x07; static final int LOADLOC7 = 0x08; static final int LOADLOC8 = 0x09; static final int LOADLOC9 = 0x0a; static final int LOADLOC10 = 0x0b; static final int LOADLOC11 = 0x0c; static final int LOC0LOC1 = 0x0d; static final int LOC1LOC2 = 0x0e; static final int LOC2LOC3 = 0x0f; static final int LOC1LOC0 = 0x10; static final int LOC2LOC1 = 0x11; static final int LOC3LOC2 = 0x12; static final int VNIL = 0x13; static final int LOADLIT = 0x14; static final int LOADLIT1 = 0x15; static final int LOADLIT2 = 0x16; static final int LOADLIT3 = 0x17; static final int LOADLIT4 = 0x18; static final int LOADLIT5 = 0x19; static final int LOADLIT6 = 0x1a; static final int LOADLIT7 = 0x1b; static final int LOADFREE = 0x1c; static final int LOADFREE1 = 0x1d; static final int LOADFREE2 = 0x1e; static final int LOADFREE3 = 0x1f; static final int LOADFREE4 = 0x20; static final int STORELOC = 0x21; static final int STORELOC0 = 0x22; static final int STORELOC1 = 0x23; static final int STORELOC2 = 0x24; static final int STORELOC3 = 0x25; static final int STORELOC4 = 0x26; static final int STORELOC5 = 0x27; static final int STORELOC6 = 0x28; static final int STORELOC7 = 0x29; static final int STOREFREE = 0x2a; static final int STOREFREE1 = 0x2b; static final int STOREFREE2 = 0x2c; static final int STOREFREE3 = 0x2d; static final int LOADLEX = 0x2e; static final int STORELEX = 0x2f; static final int CLOSURE = 0x30; static final int CARLOC0 = 0x31; static final int CARLOC1 = 0x32; static final int CARLOC2 = 0x33; static final int CARLOC3 = 0x34; static final int CARLOC4 = 0x35; static final int CARLOC5 = 0x36; static final int CARLOC6 = 0x37; static final int CARLOC7 = 0x38; static final int CARLOC8 = 0x39; static final int CARLOC9 = 0x3a; static final int CARLOC10 = 0x3b; static final int CARLOC11 = 0x3c; static final int CDRLOC0 = 0x3d; static final int CDRLOC1 = 0x3e; static final int CDRLOC2 = 0x3f; static final int CDRLOC3 = 0x40; static final int CDRLOC4 = 0x41; static final int CDRLOC5 = 0x42; static final int CAARLOC0 = 0x43; static final int CAARLOC1 = 0x44; static final int CAARLOC2 = 0x45; static final int CAARLOC3 = 0x46; static final int CALL0 = 0x47; static final int CALL1 = 0x48; static final int CALL2 = 0x49; static final int CALL2R = 0x4a; static final int CALL3 = 0x4b; static final int CALLN = 0x4c; static final int CALL0_0 = 0x4d; static final int CALL0_1 = 0x4e; static final int CALL0_2 = 0x4f; static final int CALL0_3 = 0x50; static final int CALL1_0 = 0x51; static final int CALL1_1 = 0x52; static final int CALL1_2 = 0x53; static final int CALL1_3 = 0x54; static final int CALL1_4 = 0x55; static final int CALL1_5 = 0x56; static final int CALL2_0 = 0x57; static final int CALL2_1 = 0x58; static final int CALL2_2 = 0x59; static final int CALL2_3 = 0x5a; static final int CALL2_4 = 0x5b; static final int BUILTIN0 = 0x5c; static final int BUILTIN1 = 0x5d; static final int BUILTIN2 = 0x5e; static final int BUILTIN2R = 0x5f; static final int BUILTIN3 = 0x60; static final int APPLY1 = 0x61; static final int APPLY2 = 0x62; static final int APPLY3 = 0x63; static final int APPLY4 = 0x64; static final int JCALL = 0x65; static final int JCALLN = 0x66; static final int JUMP = 0x67; static final int JUMP_B = 0x68; static final int JUMP_L = 0x69; static final int JUMP_BL = 0x6a; static final int JUMPNIL = 0x6b; static final int JUMPNIL_B = 0x6c; static final int JUMPNIL_L = 0x6d; static final int JUMPNIL_BL = 0x6e; static final int JUMPT = 0x6f; static final int JUMPT_B = 0x70; static final int JUMPT_L = 0x71; static final int JUMPT_BL = 0x72; static final int JUMPATOM = 0x73; static final int JUMPATOM_B = 0x74; static final int JUMPATOM_L = 0x75; static final int JUMPATOM_BL = 0x76; static final int JUMPNATOM = 0x77; static final int JUMPNATOM_B = 0x78; static final int JUMPNATOM_L = 0x79; static final int JUMPNATOM_BL = 0x7a; static final int JUMPEQ = 0x7b; static final int JUMPEQ_B = 0x7c; static final int JUMPEQ_L = 0x7d; static final int JUMPEQ_BL = 0x7e; static final int JUMPNE = 0x7f; // I will put these things into byte arrays so I want to have values // in the range -128 to +127. static final int JUMPNE_B = 0x80 - 0x100; static final int JUMPNE_L = 0x81 - 0x100; static final int JUMPNE_BL = 0x82 - 0x100; static final int JUMPEQUAL = 0x83 - 0x100; static final int JUMPEQUAL_B = 0x84 - 0x100; static final int JUMPEQUAL_L = 0x85 - 0x100; static final int JUMPEQUAL_BL = 0x86 - 0x100; static final int JUMPNEQUAL = 0x87 - 0x100; static final int JUMPNEQUAL_B = 0x88 - 0x100; static final int JUMPNEQUAL_L = 0x89 - 0x100; static final int JUMPNEQUAL_BL = 0x8a - 0x100; static final int JUMPL0NIL = 0x8b - 0x100; static final int JUMPL0T = 0x8c - 0x100; static final int JUMPL1NIL = 0x8d - 0x100; static final int JUMPL1T = 0x8e - 0x100; static final int JUMPL2NIL = 0x8f - 0x100; static final int JUMPL2T = 0x90 - 0x100; static final int JUMPL3NIL = 0x91 - 0x100; static final int JUMPL3T = 0x92 - 0x100; static final int JUMPL4NIL = 0x93 - 0x100; static final int JUMPL4T = 0x94 - 0x100; static final int JUMPST0NIL = 0x95 - 0x100; static final int JUMPST0T = 0x96 - 0x100; static final int JUMPST1NIL = 0x97 - 0x100; static final int JUMPST1T = 0x98 - 0x100; static final int JUMPST2NIL = 0x99 - 0x100; static final int JUMPST2T = 0x9a - 0x100; static final int JUMPL0ATOM = 0x9b - 0x100; static final int JUMPL0NATOM = 0x9c - 0x100; static final int JUMPL1ATOM = 0x9d - 0x100; static final int JUMPL1NATOM = 0x9e - 0x100; static final int JUMPL2ATOM = 0x9f - 0x100; static final int JUMPL2NATOM = 0xa0 - 0x100; static final int JUMPL3ATOM = 0xa1 - 0x100; static final int JUMPL3NATOM = 0xa2 - 0x100; static final int JUMPFREE1NIL = 0xa3 - 0x100; static final int JUMPFREE1T = 0xa4 - 0x100; static final int JUMPFREE2NIL = 0xa5 - 0x100; static final int JUMPFREE2T = 0xa6 - 0x100; static final int JUMPFREE3NIL = 0xa7 - 0x100; static final int JUMPFREE3T = 0xa8 - 0x100; static final int JUMPFREE4NIL = 0xa9 - 0x100; static final int JUMPFREE4T = 0xaa - 0x100; static final int JUMPFREENIL = 0xab - 0x100; static final int JUMPFREET = 0xac - 0x100; static final int JUMPLIT1EQ = 0xad - 0x100; static final int JUMPLIT1NE = 0xae - 0x100; static final int JUMPLIT2EQ = 0xaf - 0x100; static final int JUMPLIT2NE = 0xb0 - 0x100; static final int JUMPLIT3EQ = 0xb1 - 0x100; static final int JUMPLIT3NE = 0xb2 - 0x100; static final int JUMPLIT4EQ = 0xb3 - 0x100; static final int JUMPLIT4NE = 0xb4 - 0x100; static final int JUMPLITEQ = 0xb5 - 0x100; static final int JUMPLITNE = 0xb6 - 0x100; static final int JUMPB1NIL = 0xb7 - 0x100; static final int JUMPB1T = 0xb8 - 0x100; static final int JUMPB2NIL = 0xb9 - 0x100; static final int JUMPB2T = 0xba - 0x100; static final int JUMPFLAGP = 0xbb - 0x100; static final int JUMPNFLAGP = 0xbc - 0x100; static final int JUMPEQCAR = 0xbd - 0x100; static final int JUMPNEQCAR = 0xbe - 0x100; static final int CATCH = 0xbf - 0x100; static final int CATCH_B = 0xc0 - 0x100; static final int CATCH_L = 0xc1 - 0x100; static final int CATCH_BL = 0xc2 - 0x100; static final int UNCATCH = 0xc3 - 0x100; static final int THROW = 0xc4 - 0x100; static final int PROTECT = 0xc5 - 0x100; static final int UNPROTECT = 0xc6 - 0x100; static final int PVBIND = 0xc7 - 0x100; static final int PVRESTORE = 0xc8 - 0x100; static final int FREEBIND = 0xc9 - 0x100; static final int FREERSTR = 0xca - 0x100; static final int EXIT = 0xcb - 0x100; static final int NILEXIT = 0xcc - 0x100; static final int LOC0EXIT = 0xcd - 0x100; static final int LOC1EXIT = 0xce - 0x100; static final int LOC2EXIT = 0xcf - 0x100; static final int PUSH = 0xd0 - 0x100; static final int PUSHNIL = 0xd1 - 0x100; static final int PUSHNIL2 = 0xd2 - 0x100; static final int PUSHNIL3 = 0xd3 - 0x100; static final int PUSHNILS = 0xd4 - 0x100; static final int POP = 0xd5 - 0x100; static final int LOSE = 0xd6 - 0x100; static final int LOSE2 = 0xd7 - 0x100; static final int LOSE3 = 0xd8 - 0x100; static final int LOSES = 0xd9 - 0x100; static final int SWOP = 0xda - 0x100; static final int EQ = 0xdb - 0x100; static final int EQCAR = 0xdc - 0x100; static final int EQUAL = 0xdd - 0x100; static final int NUMBERP = 0xde - 0x100; static final int CAR = 0xdf - 0x100; static final int CDR = 0xe0 - 0x100; static final int CAAR = 0xe1 - 0x100; static final int CADR = 0xe2 - 0x100; static final int CDAR = 0xe3 - 0x100; static final int CDDR = 0xe4 - 0x100; static final int CONS = 0xe5 - 0x100; static final int NCONS = 0xe6 - 0x100; static final int XCONS = 0xe7 - 0x100; static final int ACONS = 0xe8 - 0x100; static final int LENGTH = 0xe9 - 0x100; static final int LIST2 = 0xea - 0x100; static final int LIST2STAR = 0xeb - 0x100; static final int LIST3 = 0xec - 0x100; static final int PLUS2 = 0xed - 0x100; static final int ADD1 = 0xee - 0x100; static final int DIFFERENCE = 0xef - 0x100; static final int SUB1 = 0xf0 - 0x100; static final int TIMES2 = 0xf1 - 0x100; static final int GREATERP = 0xf2 - 0x100; static final int LESSP = 0xf3 - 0x100; static final int FLAGP = 0xf4 - 0x100; static final int GET = 0xf5 - 0x100; static final int LITGET = 0xf6 - 0x100; static final int GETV = 0xf7 - 0x100; static final int QGETV = 0xf8 - 0x100; static final int QGETVN = 0xf9 - 0x100; static final int BIGSTACK = 0xfa - 0x100; static final int BIGCALL = 0xfb - 0x100; static final int ICASE = 0xfc - 0x100; static final int FASTGET = 0xfd - 0x100; static final int SPARE1 = 0xfe - 0x100; static final int SPARE2 = 0xff - 0x100; // The table of names is just for debugging - but that is of course // very important! //- //- static final String [] opnames = //- { //- "LOADLOC ", "LOADLOC0 ", "LOADLOC1 ", "LOADLOC2 ", //- "LOADLOC3 ", "LOADLOC4 ", "LOADLOC5 ", "LOADLOC6 ", //- "LOADLOC7 ", "LOADLOC8 ", "LOADLOC9 ", "LOADLOC10 ", //- "LOADLOC11 ", "LOC0LOC1 ", "LOC1LOC2 ", "LOC2LOC3 ", //- "LOC1LOC0 ", "LOC2LOC1 ", "LOC3LOC2 ", "VNIL ", //- "LOADLIT ", "LOADLIT1 ", "LOADLIT2 ", "LOADLIT3 ", //- "LOADLIT4 ", "LOADLIT5 ", "LOADLIT6 ", "LOADLIT7 ", //- "LOADFREE ", "LOADFREE1 ", "LOADFREE2 ", "LOADFREE3 ", //- "LOADFREE4 ", "STORELOC ", "STORELOC0 ", "STORELOC1 ", //- "STORELOC2 ", "STORELOC3 ", "STORELOC4 ", "STORELOC5 ", //- "STORELOC6 ", "STORELOC7 ", "STOREFREE ", "STOREFREE1 ", //- "STOREFREE2 ", "STOREFREE3 ", "LOADLEX ", "STORELEX ", //- "CLOSURE ", "CARLOC0 ", "CARLOC1 ", "CARLOC2 ", //- "CARLOC3 ", "CARLOC4 ", "CARLOC5 ", "CARLOC6 ", //- "CARLOC7 ", "CARLOC8 ", "CARLOC9 ", "CARLOC10 ", //- "CARLOC11 ", "CDRLOC0 ", "CDRLOC1 ", "CDRLOC2 ", //- "CDRLOC3 ", "CDRLOC4 ", "CDRLOC5 ", "CAARLOC0 ", //- "CAARLOC1 ", "CAARLOC2 ", "CAARLOC3 ", "CALL0 ", //- "CALL1 ", "CALL2 ", "CALL2R ", "CALL3 ", //- "CALLN ", "CALL0_0 ", "CALL0_1 ", "CALL0_2 ", //- "CALL0_3 ", "CALL1_0 ", "CALL1_1 ", "CALL1_2 ", //- "CALL1_3 ", "CALL1_4 ", "CALL1_5 ", "CALL2_0 ", //- "CALL2_1 ", "CALL2_2 ", "CALL2_3 ", "CALL2_4 ", //- "BUILTIN0 ", "BUILTIN1 ", "BUILTIN2 ", "BUILTIN2R ", //- "BUILTIN3 ", "APPLY1 ", "APPLY2 ", "APPLY3 ", //- "APPLY4 ", "JCALL ", "JCALLN ", "JUMP ", //- "JUMP_B ", "JUMP_L ", "JUMP_BL ", "JUMPNIL ", //- "JUMPNIL_B ", "JUMPNIL_L ", "JUMPNIL_BL ", "JUMPT ", //- "JUMPT_B ", "JUMPT_L ", "JUMPT_BL ", "JUMPATOM ", //- "JUMPATOM_B ", "JUMPATOM_L ", "JUMPATOM_BL ", "JUMPNATOM ", //- "JUMPNATOM_B ", "JUMPNATOM_L ", "JUMPNATOM_BL ", "JUMPEQ ", //- "JUMPEQ_B ", "JUMPEQ_L ", "JUMPEQ_BL ", "JUMPNE ", //- "JUMPNE_B ", "JUMPNE_L ", "JUMPNE_BL ", "JUMPEQUAL ", //- "JUMPEQUAL_B ", "JUMPEQUAL_L ", "JUMPEQUAL_BL ", "JUMPNEQUAL ", //- "JUMPNEQUAL_B ", "JUMPNEQUAL_L ", "JUMPNEQUAL_BL", "JUMPL0NIL ", //- "JUMPL0T ", "JUMPL1NIL ", "JUMPL1T ", "JUMPL2NIL ", //- "JUMPL2T ", "JUMPL3NIL ", "JUMPL3T ", "JUMPL4NIL ", //- "JUMPL4T ", "JUMPST0NIL ", "JUMPST0T ", "JUMPST1NIL ", //- "JUMPST1T ", "JUMPST2NIL ", "JUMPST2T ", "JUMPL0ATOM ", //- "JUMPL0NATOM ", "JUMPL1ATOM ", "JUMPL1NATOM ", "JUMPL2ATOM ", //- "JUMPL2NATOM ", "JUMPL3ATOM ", "JUMPL3NATOM ", "JUMPFREE1NIL ", //- "JUMPFREE1T ", "JUMPFREE2NIL ", "JUMPFREE2T ", "JUMPFREE3NIL ", //- "JUMPFREE3T ", "JUMPFREE4NIL ", "JUMPFREE4T ", "JUMPFREENIL ", //- "JUMPFREET ", "JUMPLIT1EQ ", "JUMPLIT1NE ", "JUMPLIT2EQ ", //- "JUMPLIT2NE ", "JUMPLIT3EQ ", "JUMPLIT3NE ", "JUMPLIT4EQ ", //- "JUMPLIT4NE ", "JUMPLITEQ ", "JUMPLITNE ", "JUMPB1NIL ", //- "JUMPB1T ", "JUMPB2NIL ", "JUMPB2T ", "JUMPFLAGP ", //- "JUMPNFLAGP ", "JUMPEQCAR ", "JUMPNEQCAR ", "CATCH ", //- "CATCH_B ", "CATCH_L ", "CATCH_BL ", "UNCATCH ", //- "THROW ", "PROTECT ", "UNPROTECT ", "PVBIND ", //- "PVRESTORE ", "FREEBIND ", "FREERSTR ", "EXIT ", //- "NILEXIT ", "LOC0EXIT ", "LOC1EXIT ", "LOC2EXIT ", //- "PUSH ", "PUSHNIL ", "PUSHNIL2 ", "PUSHNIL3 ", //- "PUSHNILS ", "POP ", "LOSE ", "LOSE2 ", //- "LOSE3 ", "LOSES ", "SWOP ", "EQ ", //- "EQCAR ", "EQUAL ", "NUMBERP ", "CAR ", //- "CDR ", "CAAR ", "CADR ", "CDAR ", //- "CDDR ", "CONS ", "NCONS ", "XCONS ", //- "ACONS ", "LENGTH ", "LIST2 ", "LIST2STAR ", //- "LIST3 ", "PLUS2 ", "ADD1 ", "DIFFERENCE ", //- "SUB1 ", "TIMES2 ", "GREATERP ", "LESSP ", //- "FLAGP ", "GET ", "LITGET ", "GETV ", //- "QGETV ", "QGETVN ", "BIGSTACK ", "BIGCALL ", //- "ICASE ", "FASTGET ", "SPARE1 ", "SPARE2 " //- }; static int stack_size = 5000; static LispObject [] stack = new LispObject[stack_size]; static int sp = 0; LispObject interpret(int pc) throws Exception { int spsave = sp; int arg; LispObject a = Jlisp.nil, b = Jlisp.nil, w; if (sp > stack_size - 500) // the 500 is a pretty arbitrary margin! // bad enough code could breach it. { int new_size = (3*stack_size)/2; LispObject [] new_stack = new LispObject[new_size]; for (int i=0; i<=sp; i++) new_stack[i] = stack[i]; stack = new_stack; stack_size = new_size; if (Jlisp.verbosFlag != 0) Jlisp.errprint("+++ Stack enlarged to " + stack_size); } try { for (;;) { switch (bytecodes[pc++]) { case LOADLOC: b = a; a = stack[sp-(bytecodes[pc++] & 0xff)]; continue; case LOADLOC0: b = a; a = stack[sp-0]; continue; case LOADLOC1: b = a; a = stack[sp-1]; continue; case LOADLOC2: b = a; a = stack[sp-2]; continue; case LOADLOC3: b = a; a = stack[sp-3]; continue; case LOADLOC4: b = a; a = stack[sp-4]; continue; case LOADLOC5: b = a; a = stack[sp-5]; continue; case LOADLOC6: b = a; a = stack[sp-6]; continue; case LOADLOC7: b = a; a = stack[sp-7]; continue; case LOADLOC8: b = a; a = stack[sp-8]; continue; case LOADLOC9: b = a; a = stack[sp-9]; continue; case LOADLOC10: b = a; a = stack[sp-10]; continue; case LOADLOC11: b = a; a = stack[sp-11]; continue; case LOC0LOC1: b = stack[sp-0]; a = stack[sp-1]; continue; case LOC1LOC2: b = stack[sp-1]; a = stack[sp-2]; continue; case LOC2LOC3: b = stack[sp-2]; a = stack[sp-3]; continue; case LOC1LOC0: b = stack[sp-1]; a = stack[sp-0]; continue; case LOC2LOC1: b = stack[sp-2]; a = stack[sp-1]; continue; case LOC3LOC2: b = stack[sp-3]; a = stack[sp-2]; continue; case VNIL: b = a; a = Jlisp.nil; continue; case LOADLIT: b = a; a = env[bytecodes[pc++] & 0xff]; continue; case LOADLIT1: b = a; a = env[1]; continue; case LOADLIT2: b = a; a = env[2]; continue; case LOADLIT3: b = a; a = env[3]; continue; case LOADLIT4: b = a; a = env[4]; continue; case LOADLIT5: b = a; a = env[5]; continue; case LOADLIT6: b = a; a = env[6]; continue; case LOADLIT7: b = a; a = env[7]; continue; case LOADFREE: b = a; a = env[bytecodes[pc++] & 0xff].car/*value*/; continue; case LOADFREE1: b = a; a = env[1].car/*value*/; continue; case LOADFREE2: b = a; a = env[2].car/*value*/; continue; case LOADFREE3: b = a; a = env[3].car/*value*/; continue; case LOADFREE4: b = a; a = env[4].car/*value*/; continue; case STORELOC: stack[sp-(bytecodes[pc++] & 0xff)] = a; continue; case STORELOC0: stack[sp-0] = a; continue; case STORELOC1: stack[sp-1] = a; continue; case STORELOC2: stack[sp-2] = a; continue; case STORELOC3: stack[sp-3] = a; continue; case STORELOC4: stack[sp-4] = a; continue; case STORELOC5: stack[sp-5] = a; continue; case STORELOC6: stack[sp-6] = a; continue; case STORELOC7: stack[sp-7] = a; continue; case STOREFREE: env[bytecodes[pc++] & 0xff].car/*value*/ = a; continue; case STOREFREE1: env[1].car/*value*/ = a; continue; case STOREFREE2: env[2].car/*value*/ = a; continue; case STOREFREE3: env[3].car/*value*/ = a; continue; case LOADLEX: Jlisp.error("bytecode LOADLEX not implemented"); case STORELEX: Jlisp.error("bytecode STORELEX not implemented"); case CLOSURE: Jlisp.error("bytecode CLOSURE not implemented"); case CARLOC0: b = a; a = stack[sp-0]; if (a.atom) Jlisp.error("attempt to take car of an atom", a); a = a.car; continue; case CARLOC1: b = a; a = stack[sp-1]; if (a.atom) Jlisp.error("attempt to take car of an atom", a); a = a.car; continue; case CARLOC2: b = a; a = stack[sp-2]; if (a.atom) Jlisp.error("attempt to take car of an atom", a); a = a.car; continue; case CARLOC3: b = a; a = stack[sp-3]; if (a.atom) Jlisp.error("attempt to take car of an atom", a); a = a.car; continue; case CARLOC4: b = a; a = stack[sp-4]; if (a.atom) Jlisp.error("attempt to take car of an atom", a); a = a.car; continue; case CARLOC5: b = a; a = stack[sp-5]; if (a.atom) Jlisp.error("attempt to take car of an atom", a); a = a.car; continue; case CARLOC6: b = a; a = stack[sp-6]; if (a.atom) Jlisp.error("attempt to take car of an atom", a); a = a.car; continue; case CARLOC7: b = a; a = stack[sp-7]; if (a.atom) Jlisp.error("attempt to take car of an atom", a); a = a.car; continue; case CARLOC8: b = a; a = stack[sp-8]; if (a.atom) Jlisp.error("attempt to take car of an atom", a); a = a.car; continue; case CARLOC9: b = a; a = stack[sp-9]; if (a.atom) Jlisp.error("attempt to take car of an atom", a); a = a.car; continue; case CARLOC10: b = a; a = stack[sp-10]; if (a.atom) Jlisp.error("attempt to take car of an atom", a); a = a.car; continue; case CARLOC11: b = a; a = stack[sp-11]; if (a.atom) Jlisp.error("attempt to take car of an atom", a); a = a.car; continue; case CDRLOC0: b = a; a = stack[sp-0]; if (a.atom) Jlisp.error("attempt to take cdr of an atom", a); a = a.cdr; continue; case CDRLOC1: b = a; a = stack[sp-1]; if (a.atom) Jlisp.error("attempt to take cdr of an atom", a); a = a.cdr; continue; case CDRLOC2: b = a; a = stack[sp-2]; if (a.atom) Jlisp.error("attempt to take cdr of an atom", a); a = a.cdr; continue; case CDRLOC3: b = a; a = stack[sp-3]; if (a.atom) Jlisp.error("attempt to take cdr of an atom", a); a = a.cdr; continue; case CDRLOC4: b = a; a = stack[sp-4]; if (a.atom) Jlisp.error("attempt to take cdr of an atom", a); a = a.cdr; continue; case CDRLOC5: b = a; a = stack[sp-5]; if (a.atom) Jlisp.error("attempt to take cdr of an atom", a); a = a.cdr; continue; case CAARLOC0: b = a; a = stack[sp-0]; if (a.atom) Jlisp.error("attempt to take car of an atom", a); a = a.car; if (a.atom) Jlisp.error("attempt to take car of an atom", a); a = a.car; continue; case CAARLOC1: b = a; a = stack[sp-1]; if (a.atom) Jlisp.error("attempt to take car of an atom", a); a = a.car; if (a.atom) Jlisp.error("attempt to take car of an atom", a); a = a.car; continue; case CAARLOC2: b = a; a = stack[sp-2]; if (a.atom) Jlisp.error("attempt to take car of an atom", a); a = a.car; if (a.atom) Jlisp.error("attempt to take car of an atom", a); a = a.car; continue; case CAARLOC3: b = a; a = stack[sp-3]; if (a.atom) Jlisp.error("attempt to take car of an atom", a); a = a.car; if (a.atom) Jlisp.error("attempt to take car of an atom", a); a = a.car; continue; case CALL0: arg = bytecodes[pc++] & 0xff; a = ((Symbol)env[arg]).fn.op0(); continue; case CALL1: arg = bytecodes[pc++] & 0xff; a = ((Symbol)env[arg]).fn.op1(a); continue; case CALL2: arg = bytecodes[pc++] & 0xff; a = ((Symbol)env[arg]).fn.op2(b, a); continue; case CALL2R: arg = bytecodes[pc++] & 0xff; a = ((Symbol)env[arg]).fn.op2(a, b); continue; case CALL3: arg = bytecodes[pc++] & 0xff; a = ((Symbol)env[arg]).fn.opn(new LispObject [] {stack[sp--], b, a}); continue; case CALLN: arg = bytecodes[pc++] & 0xff; switch (bytecodes[pc++] & 0xff) { case 4: sp -= 2; a = ((Symbol)env[arg]).fn.opn(new LispObject [] {stack[sp+1], stack[sp+2], b, a}); continue; case 5: sp -= 3; a = ((Symbol)env[arg]).fn.opn(new LispObject [] {stack[sp+1], stack[sp+2], stack[sp+3], b, a}); continue; case 6: sp -= 4; a = ((Symbol)env[arg]).fn.opn(new LispObject [] {stack[sp+1], stack[sp+2], stack[sp+3], stack[sp+4], b, a}); continue; case 7: sp -= 5; a = ((Symbol)env[arg]).fn.opn(new LispObject [] {stack[sp+1], stack[sp+2], stack[sp+3], stack[sp+4], stack[sp+5], b, a}); continue; case 8: sp -= 6; a = ((Symbol)env[arg]).fn.opn(new LispObject [] {stack[sp+1], stack[sp+2], stack[sp+3], stack[sp+4], stack[sp+5], stack[sp+6], b, a}); continue; case 9: sp -= 7; a = ((Symbol)env[arg]).fn.opn(new LispObject [] {stack[sp+1], stack[sp+2], stack[sp+3], stack[sp+4], stack[sp+5], stack[sp+6], stack[sp+7], b, a}); continue; case 10:sp -= 8; a = ((Symbol)env[arg]).fn.opn(new LispObject [] {stack[sp+1], stack[sp+2], stack[sp+3], stack[sp+4], stack[sp+5], stack[sp+6], stack[sp+7], stack[sp+8], b, a}); continue; case 11:sp -= 9; a = ((Symbol)env[arg]).fn.opn(new LispObject [] {stack[sp+1], stack[sp+2], stack[sp+3], stack[sp+4], stack[sp+5], stack[sp+6], stack[sp+7], stack[sp+8], stack[sp+9], b, a}); continue; case 12:sp -= 10; a = ((Symbol)env[arg]).fn.opn(new LispObject [] {stack[sp+1], stack[sp+2], stack[sp+3], stack[sp+4], stack[sp+5], stack[sp+6], stack[sp+7], stack[sp+8], stack[sp+9], stack[sp+10], b, a}); continue; case 13:sp -= 11; a = ((Symbol)env[arg]).fn.opn(new LispObject [] {stack[sp+1], stack[sp+2], stack[sp+3], stack[sp+4], stack[sp+5], stack[sp+6], stack[sp+7], stack[sp+8], stack[sp+9], stack[sp+10], stack[sp+11], b, a}); continue; case 14:sp -= 12; a = ((Symbol)env[arg]).fn.opn(new LispObject [] {stack[sp+1], stack[sp+2], stack[sp+3], stack[sp+4], stack[sp+5], stack[sp+6], stack[sp+7], stack[sp+8], stack[sp+9], stack[sp+10], stack[sp+11], stack[sp+12], b, a}); continue; case 15:sp -= 13; a = ((Symbol)env[arg]).fn.opn(new LispObject [] {stack[sp+1], stack[sp+2], stack[sp+3], stack[sp+4], stack[sp+5], stack[sp+6], stack[sp+7], stack[sp+8], stack[sp+9], stack[sp+10], stack[sp+11], stack[sp+12], stack[sp+13], b, a}); continue; // The Standard Lisp Report mandates at least 15 arguments must be supported. // Common Lisp maybe does not have any real limit? Anyway I will go to 20 // here. case 16:sp -= 14; a = ((Symbol)env[arg]).fn.opn(new LispObject [] {stack[sp+1], stack[sp+2], stack[sp+3], stack[sp+4], stack[sp+5], stack[sp+6], stack[sp+7], stack[sp+8], stack[sp+9], stack[sp+10], stack[sp+11], stack[sp+12], stack[sp+13], stack[sp+14], b, a}); continue; case 17:sp -= 15; a = ((Symbol)env[arg]).fn.opn(new LispObject [] {stack[sp+1], stack[sp+2], stack[sp+3], stack[sp+4], stack[sp+5], stack[sp+6], stack[sp+7], stack[sp+8], stack[sp+9], stack[sp+10], stack[sp+11], stack[sp+12], stack[sp+13], stack[sp+14], stack[sp+15], b, a}); continue; case 18:sp -= 16; a = ((Symbol)env[arg]).fn.opn(new LispObject [] {stack[sp+1], stack[sp+2], stack[sp+3], stack[sp+4], stack[sp+5], stack[sp+6], stack[sp+7], stack[sp+8], stack[sp+9], stack[sp+10], stack[sp+11], stack[sp+12], stack[sp+13], stack[sp+14], stack[sp+15], stack[sp+16], b, a}); continue; case 19:sp -= 17; a = ((Symbol)env[arg]).fn.opn(new LispObject [] {stack[sp+1], stack[sp+2], stack[sp+3], stack[sp+4], stack[sp+5], stack[sp+6], stack[sp+7], stack[sp+8], stack[sp+9], stack[sp+10], stack[sp+11], stack[sp+12], stack[sp+13], stack[sp+14], stack[sp+15], stack[sp+16], stack[sp+17], b, a}); continue; case 20:sp -= 18; a = ((Symbol)env[arg]).fn.opn(new LispObject [] {stack[sp+1], stack[sp+2], stack[sp+3], stack[sp+4], stack[sp+5], stack[sp+6], stack[sp+7], stack[sp+8], stack[sp+9], stack[sp+10], stack[sp+11], stack[sp+12], stack[sp+13], stack[sp+14], stack[sp+15], stack[sp+16], stack[sp+17], stack[sp+18], b, a}); continue; default: Jlisp.error("calls with over 20 args not supported in this Lisp"); } case CALL0_0: a = op0(); // optimisation on call to self! continue; case CALL0_1: a = ((Symbol)env[1]).fn.op0(); continue; case CALL0_2: a = ((Symbol)env[2]).fn.op0(); continue; case CALL0_3: a = ((Symbol)env[3]).fn.op0(); continue; case CALL1_0: a = op1(a); // call to self continue; case CALL1_1: a = ((Symbol)env[1]).fn.op1(a); continue; case CALL1_2: a = ((Symbol)env[2]).fn.op1(a); continue; case CALL1_3: a = ((Symbol)env[3]).fn.op1(a); continue; case CALL1_4: a = ((Symbol)env[4]).fn.op1(a); continue; case CALL1_5: a = ((Symbol)env[5]).fn.op1(a); continue; case CALL2_0: a = op2(b, a); // call to self continue; case CALL2_1: a = ((Symbol)env[1]).fn.op2(b, a); continue; case CALL2_2: a = ((Symbol)env[2]).fn.op2(b, a); continue; case CALL2_3: a = ((Symbol)env[3]).fn.op2(b, a); continue; case CALL2_4: a = ((Symbol)env[4]).fn.op2(b, a); continue; case BUILTIN0: arg = bytecodes[pc++] & 0xff; a = builtin0[arg].op0(); continue; case BUILTIN1: arg = bytecodes[pc++] & 0xff; a = builtin1[arg].op1(a); continue; case BUILTIN2: arg = bytecodes[pc++] & 0xff; a = builtin2[arg].op2(b, a); continue; case BUILTIN2R: arg = bytecodes[pc++] & 0xff; a = builtin2[arg].op2(a, b); continue; case BUILTIN3: arg = bytecodes[pc++] & 0xff; a = builtin3[arg].opn(new LispObject [] {stack[sp--], b, a}); continue; case APPLY1: if (b instanceof Symbol) { a = ((Symbol)b).fn.op1(a); } else if (b instanceof LispFunction) { a = ((LispFunction)b).op1(a); } else a = Fns.apply1(b, a); continue; case APPLY2: if (stack[sp] instanceof Symbol) { a = ((Symbol)stack[sp--]).fn.op2(b, a); } else if (stack[sp] instanceof LispFunction) { a = ((LispFunction)stack[sp--]).op2(b, a); } else a = Fns.apply2(stack[sp--], b, a); continue; case APPLY3: sp -= 2; if (stack[sp+1] instanceof Symbol) { a = ((Symbol)stack[sp+1]).fn.opn(new LispObject [] {stack[sp+2], b, a}); } else if (stack[sp+1] instanceof LispFunction) { a = ((LispFunction)stack[sp+1]).opn(new LispObject [] {stack[sp+2], b, a}); } else a = Fns.apply3(stack[sp+1], stack[sp+2], b, a); continue; case APPLY4: sp -= 3; if (stack[sp+1] instanceof Symbol) { a = ((Symbol)stack[sp+1]).fn.opn(new LispObject [] {stack[sp+2], stack[sp+3], b, a}); } else if (stack[sp+1] instanceof LispFunction) { a = ((LispFunction)stack[sp+1]).opn(new LispObject [] {stack[sp+2], stack[sp+3], b, a}); } else a = Fns.applyn(stack[sp+1], new LispObject [] {stack[sp+2], stack[sp+3], b, a}); continue; case JCALL: arg = bytecodes[pc++]; switch (arg & 0xe0) // number of args { case 0x00: arg &= 0x1f; if (arg == 0) { sp = spsave; pc = 0; continue; } sp = spsave; return ((Symbol)env[arg & 0x1f]).fn.op0(); case 0x20: arg &= 0x1f; if (arg == 0) { stack[spsave] = a; sp = spsave; pc = 0; continue; } sp = spsave; return ((Symbol)env[arg & 0x1f]).fn.op1(a); case 0x40: arg &= 0x1f; if (arg == 0) { stack[spsave] = a; stack[spsave-1] = b; sp = spsave; pc = 0; continue; } sp = spsave; return ((Symbol)env[arg & 0x1f]).fn.op2(b, a); case 0x60: arg &= 0x1f; if (arg == 0) { stack[spsave] = a; stack[spsave-1] = b; stack[spsave-2] = stack[sp]; sp = spsave; pc = 0; continue; } pc = sp; sp = spsave; return ((Symbol)env[arg & 0x1f]).fn.opn( new LispObject [] {stack[pc--], b, a}); case 0x80: arg &= 0x1f; if (arg == 0) { stack[spsave] = a; stack[spsave-1] = b; stack[spsave-2] = stack[sp]; stack[spsave-3] = stack[sp-1]; sp = spsave; pc = 1; // NB to allow for arg-count byte continue; } pc = sp; sp = spsave; pc -= 2; return ((Symbol)env[arg & 0x1f]).fn.opn( new LispObject [] {stack[pc+1], stack[pc+2], b, a}); case 0xa0: arg &= 0x1f; if (arg == 0) { stack[spsave] = a; stack[spsave-1] = b; stack[spsave-2] = stack[sp]; stack[spsave-3] = stack[sp-1]; stack[spsave-4] = stack[sp-2]; sp = spsave; pc = 1; continue; } pc = sp; sp = spsave; pc -= 3; return ((Symbol)env[arg & 0x1f]).fn.opn( new LispObject [] {stack[pc+1], stack[pc+2], stack[pc+3], b, a}); case 0xc0: arg &= 0x1f; if (arg == 0) { stack[spsave] = a; stack[spsave-1] = b; stack[spsave-2] = stack[sp]; stack[spsave-3] = stack[sp-1]; stack[spsave-4] = stack[sp-2]; stack[spsave-5] = stack[sp-3]; sp = spsave; pc = 1; continue; } pc = sp; sp = spsave; pc -= 4; return ((Symbol)env[arg & 0x1f]).fn.opn( new LispObject [] {stack[pc+1], stack[pc+2], stack[pc+3], stack[pc+4], b, a}); case 0xe0: arg &= 0x1f; if (arg == 0) { stack[spsave] = a; stack[spsave-1] = b; stack[spsave-2] = stack[sp]; stack[spsave-3] = stack[sp-1]; stack[spsave-4] = stack[sp-2]; stack[spsave-5] = stack[sp-3]; stack[spsave-6] = stack[sp-4]; sp = spsave; pc = 1; continue; } pc = sp; sp = spsave; pc -= 5; return ((Symbol)env[arg & 0x1f]).fn.opn( new LispObject [] {stack[pc+1], stack[pc+2], stack[pc+3], stack[pc+4], stack[pc+5], b, a}); default: return Jlisp.error("oddity with JCALL " + Integer.toHexString(arg)); } case JCALLN: arg = bytecodes[pc++]; switch (bytecodes[pc++] & 0xff) // number of args { // Just at present I do not treat calls to self specially here (in the // way that I do for JCALL rather than JCALLN). This is something that I // should fix sometime... case 0: sp = spsave; return ((Symbol)env[arg]).fn.op0(); case 1: sp = spsave; return ((Symbol)env[arg]).fn.op1(a); case 2: sp = spsave; return ((Symbol)env[arg]).fn.op2(b, a); case 3: pc = sp; sp = spsave; return ((Symbol)env[arg]).fn.opn(new LispObject [] {stack[pc--], b, a}); case 4: pc = sp; sp = spsave; pc -= 2; return ((Symbol)env[arg]).fn.opn(new LispObject [] {stack[pc+1], stack[pc+2], b, a}); case 5: pc = sp; sp = spsave; pc -= 3; return ((Symbol)env[arg]).fn.opn(new LispObject [] {stack[pc+1], stack[pc+2], stack[pc+3], b, a}); case 6: pc = sp; sp = spsave; pc -= 4; return ((Symbol)env[arg]).fn.opn(new LispObject [] {stack[pc+1], stack[pc+2], stack[pc+3], stack[pc+4], b, a}); case 7: pc = sp; sp = spsave; pc -= 5; return ((Symbol)env[arg]).fn.opn(new LispObject [] {stack[pc+1], stack[pc+2], stack[pc+3], stack[pc+4], stack[pc+5], b, a}); case 8: pc = sp; sp = spsave; pc -= 6; return ((Symbol)env[arg]).fn.opn(new LispObject [] {stack[pc+1], stack[pc+2], stack[pc+3], stack[pc+4], stack[pc+5], stack[pc+6], b, a}); case 9: pc = sp; sp = spsave; pc -= 7; return ((Symbol)env[arg]).fn.opn(new LispObject [] {stack[pc+1], stack[pc+2], stack[pc+3], stack[pc+4], stack[pc+5], stack[pc+6], stack[pc+7], b, a}); case 10:pc = sp; sp = spsave; pc -= 8; return ((Symbol)env[arg]).fn.opn(new LispObject [] {stack[pc+1], stack[pc+2], stack[pc+3], stack[pc+4], stack[pc+5], stack[pc+6], stack[pc+7], stack[pc+8], b, a}); case 11:pc = sp; sp = spsave; pc -= 9; return ((Symbol)env[arg]).fn.opn(new LispObject [] {stack[pc+1], stack[pc+2], stack[pc+3], stack[pc+4], stack[pc+5], stack[pc+6], stack[pc+7], stack[pc+8], stack[pc+9], b, a}); case 12:pc = sp; sp = spsave; pc -= 10; return ((Symbol)env[arg]).fn.opn(new LispObject [] {stack[pc+1], stack[pc+2], stack[pc+3], stack[pc+4], stack[pc+5], stack[pc+6], stack[pc+7], stack[pc+8], stack[pc+9], stack[pc+10], b, a}); case 13:pc = sp; sp = spsave; pc -= 11; return ((Symbol)env[arg]).fn.opn(new LispObject [] {stack[pc+1], stack[pc+2], stack[pc+3], stack[pc+4], stack[pc+5], stack[pc+6], stack[pc+7], stack[pc+8], stack[pc+9], stack[pc+10], stack[pc+11], b, a}); case 14:pc = sp; sp = spsave; pc -= 12; return ((Symbol)env[arg]).fn.opn(new LispObject [] {stack[pc+1], stack[pc+2], stack[pc+3], stack[pc+4], stack[pc+5], stack[pc+6], stack[pc+7], stack[pc+8], stack[pc+9], stack[pc+10], stack[pc+11], stack[pc+12], b, a}); case 15:pc = sp; sp = spsave; pc -= 13; return ((Symbol)env[arg]).fn.opn(new LispObject [] {stack[pc+1], stack[pc+2], stack[pc+3], stack[pc+4], stack[pc+5], stack[pc+6], stack[pc+7], stack[pc+8], stack[pc+9], stack[pc+10], stack[pc+11], stack[pc+12], stack[pc+13], b, a}); // The Standard Lisp Report mandates at least 15 arguments must be supported. // Common Lisp maybe does not have any real limit? Anyway I will go to 20 // here. case 16:pc = sp; sp = spsave; pc -= 14; return ((Symbol)env[arg]).fn.opn(new LispObject [] {stack[pc+1], stack[pc+2], stack[pc+3], stack[pc+4], stack[pc+5], stack[pc+6], stack[pc+7], stack[pc+8], stack[pc+9], stack[pc+10], stack[pc+11], stack[pc+12], stack[pc+13], stack[pc+14], b, a}); case 17:pc = sp; sp = spsave; pc -= 15; return ((Symbol)env[arg]).fn.opn(new LispObject [] {stack[pc+1], stack[pc+2], stack[pc+3], stack[pc+4], stack[pc+5], stack[pc+6], stack[pc+7], stack[pc+8], stack[pc+9], stack[pc+10], stack[pc+11], stack[pc+12], stack[pc+13], stack[pc+14], stack[pc+15], b, a}); case 18:pc = sp; sp = spsave; pc -= 16; return ((Symbol)env[arg]).fn.opn(new LispObject [] {stack[pc+1], stack[pc+2], stack[pc+3], stack[pc+4], stack[pc+5], stack[pc+6], stack[pc+7], stack[pc+8], stack[pc+9], stack[pc+10], stack[pc+11], stack[pc+12], stack[pc+13], stack[pc+14], stack[pc+15], stack[pc+16], b, a}); case 19:pc = sp; sp = spsave; pc -= 17; return ((Symbol)env[arg]).fn.opn(new LispObject [] {stack[pc+1], stack[pc+2], stack[pc+3], stack[pc+4], stack[pc+5], stack[pc+6], stack[pc+7], stack[pc+8], stack[pc+9], stack[pc+10], stack[pc+11], stack[pc+12], stack[pc+13], stack[pc+14], stack[pc+15], stack[pc+16], stack[pc+17], b, a}); case 20:pc = sp; sp = spsave; pc -= 18; return ((Symbol)env[arg]).fn.opn(new LispObject [] {stack[pc+1], stack[pc+2], stack[pc+3], stack[pc+4], stack[pc+5], stack[pc+6], stack[pc+7], stack[pc+8], stack[pc+9], stack[pc+10], stack[pc+11], stack[pc+12], stack[pc+13], stack[pc+14], stack[pc+15], stack[pc+16], stack[pc+17], stack[pc+18], b, a}); default: Jlisp.error("calls with over 20 args not supported in this Lisp"); } case JUMP: pc = pc + (bytecodes[pc] & 0xff) + 1; continue; case JUMP_B: pc = pc - (bytecodes[pc] & 0xff) + 1; continue; case JUMP_L: arg = bytecodes[pc++] & 0xff; pc = pc + (arg << 8) + (bytecodes[pc] & 0xff) + 1; continue; case JUMP_BL: arg = bytecodes[pc++] & 0xff; pc = pc - ((arg << 8) + (bytecodes[pc] & 0xff)) + 1; continue; case JUMPNIL: if (a == Jlisp.nil) pc = pc + (bytecodes[pc] & 0xff) + 1; else pc++; continue; case JUMPNIL_B: if (a == Jlisp.nil) pc = pc - (bytecodes[pc] & 0xff) + 1; else pc++; continue; case JUMPNIL_L: arg = bytecodes[pc++] & 0xff; if (a == Jlisp.nil) pc = pc + (arg << 8) + (bytecodes[pc] & 0xff) + 1; else pc++; continue; case JUMPNIL_BL: arg = bytecodes[pc++] & 0xff; if (a == Jlisp.nil) pc = pc - ((arg << 8) + (bytecodes[pc] & 0xff)) + 1; else pc++; continue; case JUMPT: if (a != Jlisp.nil) pc = pc + (bytecodes[pc] & 0xff) + 1; else pc++; continue; case JUMPT_B: if (a != Jlisp.nil) pc = pc - (bytecodes[pc] & 0xff) + 1; else pc++; continue; case JUMPT_L: arg = bytecodes[pc++] & 0xff; if (a != Jlisp.nil) pc = pc + (arg << 8) + (bytecodes[pc] & 0xff) + 1; else pc++; continue; case JUMPT_BL: arg = bytecodes[pc++] & 0xff; if (a != Jlisp.nil) pc = pc - ((arg << 8) + (bytecodes[pc] & 0xff)) + 1; else pc++; continue; case JUMPATOM: if (a.atom) pc = pc + (bytecodes[pc] & 0xff) + 1; else pc++; continue; case JUMPATOM_B: if (a.atom) pc = pc - (bytecodes[pc] & 0xff) + 1; else pc++; continue; case JUMPATOM_L: arg = bytecodes[pc++] & 0xff; if (a.atom) pc = pc + (arg << 8) + (bytecodes[pc] & 0xff) + 1; else pc++; continue; case JUMPATOM_BL: arg = bytecodes[pc++] & 0xff; if (a.atom) pc = pc - ((arg << 8) + (bytecodes[pc] & 0xff)) + 1; else pc++; continue; case JUMPNATOM: if (!a.atom) pc = pc + (bytecodes[pc] & 0xff) + 1; else pc++; continue; case JUMPNATOM_B: if (!a.atom) pc = pc - (bytecodes[pc] & 0xff) + 1; else pc++; continue; case JUMPNATOM_L: arg = bytecodes[pc++] & 0xff; if (!a.atom) pc = pc + (arg << 8) + (bytecodes[pc] & 0xff) + 1; else pc++; continue; case JUMPNATOM_BL: arg = bytecodes[pc++] & 0xff; if (!a.atom) pc = pc - ((arg << 8) + (bytecodes[pc] & 0xff)) + 1; else pc++; continue; case JUMPEQ: // @@@ here and many related places would need treatment of numbers if // I had to support EQ being a reliable comparison on integers. if (a == b) pc = pc + (bytecodes[pc] & 0xff) + 1; else pc++; continue; case JUMPEQ_B: if (a == b) pc = pc - (bytecodes[pc] & 0xff) + 1; else pc++; continue; case JUMPEQ_L: arg = bytecodes[pc++] & 0xff; if (a == b) pc = pc + (arg << 8) + (bytecodes[pc] & 0xff) + 1; else pc++; continue; case JUMPEQ_BL: arg = bytecodes[pc++] & 0xff; if (a == b) pc = pc - ((arg << 8) + (bytecodes[pc] & 0xff)) + 1; else pc++; continue; case JUMPNE: if (a != b) pc = pc + (bytecodes[pc] & 0xff) + 1; else pc++; continue; case JUMPNE_B: if (a != b) pc = pc - (bytecodes[pc] & 0xff) + 1; else pc++; continue; case JUMPNE_L: arg = bytecodes[pc++] & 0xff; if (a != b) pc = pc + (arg << 8) + (bytecodes[pc] & 0xff) + 1; else pc++; continue; case JUMPNE_BL: arg = bytecodes[pc++] & 0xff; if (a != b) pc = pc - ((arg << 8) + (bytecodes[pc] & 0xff)) + 1; else pc++; continue; case JUMPEQUAL: if (a.lispequals(b)) pc = pc + (bytecodes[pc] & 0xff) + 1; else pc++; continue; case JUMPEQUAL_B: if (a.lispequals(b)) pc = pc - (bytecodes[pc] & 0xff) + 1; else pc++; continue; case JUMPEQUAL_L: arg = bytecodes[pc++] & 0xff; if (a.lispequals(b)) pc = pc + (arg << 8) + (bytecodes[pc] & 0xff) + 1; else pc++; continue; case JUMPEQUAL_BL: arg = bytecodes[pc++] & 0xff; if (a.lispequals(b)) pc = pc - ((arg << 8) + (bytecodes[pc] & 0xff)) + 1; else pc++; continue; case JUMPNEQUAL: if (!a.lispequals(b)) pc = pc + (bytecodes[pc] & 0xff) + 1; else pc++; continue; case JUMPNEQUAL_B: if (!a.lispequals(b)) pc = pc - (bytecodes[pc] & 0xff) + 1; else pc++; continue; case JUMPNEQUAL_L: arg = bytecodes[pc++] & 0xff; if (!a.lispequals(b)) pc = pc + (arg << 8) + (bytecodes[pc] & 0xff) + 1; else pc++; continue; case JUMPNEQUAL_BL: arg = bytecodes[pc++] & 0xff; if (!a.lispequals(b)) pc = pc - ((arg << 8) + (bytecodes[pc] & 0xff)) + 1; else pc++; continue; case JUMPL0NIL: if (stack[sp-0] == Jlisp.nil) pc = pc + (bytecodes[pc] & 0xff) + 1; else pc++; continue; case JUMPL0T: if (stack[sp-0] != Jlisp.nil) pc = pc + (bytecodes[pc] & 0xff) + 1; else pc++; continue; case JUMPL1NIL: if (stack[sp-1] == Jlisp.nil) pc = pc + (bytecodes[pc] & 0xff) + 1; else pc++; continue; case JUMPL1T: if (stack[sp-1] != Jlisp.nil) pc = pc + (bytecodes[pc] & 0xff) + 1; else pc++; continue; case JUMPL2NIL: if (stack[sp-2] == Jlisp.nil) pc = pc + (bytecodes[pc] & 0xff) + 1; else pc++; continue; case JUMPL2T: if (stack[sp-2] != Jlisp.nil) pc = pc + (bytecodes[pc] & 0xff) + 1; else pc++; continue; case JUMPL3NIL: if (stack[sp-3] == Jlisp.nil) pc = pc + (bytecodes[pc] & 0xff) + 1; else pc++; continue; case JUMPL3T: if (stack[sp-3] != Jlisp.nil) pc = pc + (bytecodes[pc] & 0xff) + 1; else pc++; continue; case JUMPL4NIL: if (stack[sp-4] == Jlisp.nil) pc = pc + (bytecodes[pc] & 0xff) + 1; else pc++; continue; case JUMPL4T: if (stack[sp-4] != Jlisp.nil) pc = pc + (bytecodes[pc] & 0xff) + 1; else pc++; continue; case JUMPST0NIL: if ((stack[sp-0] = a) == Jlisp.nil) pc = pc + (bytecodes[pc] & 0xff) + 1; else pc++; continue; case JUMPST0T: if ((stack[sp-0] = a) != Jlisp.nil) pc = pc + (bytecodes[pc] & 0xff) + 1; else pc++; continue; case JUMPST1NIL: if ((stack[sp-1] = a) == Jlisp.nil) pc = pc + (bytecodes[pc] & 0xff) + 1; else pc++; continue; case JUMPST1T: if ((stack[sp-1] = a) != Jlisp.nil) pc = pc + (bytecodes[pc] & 0xff) + 1; else pc++; continue; case JUMPST2NIL: if ((stack[sp-2] = a) == Jlisp.nil) pc = pc + (bytecodes[pc] & 0xff) + 1; else pc++; continue; case JUMPST2T: if ((stack[sp-2] = a) != Jlisp.nil) pc = pc + (bytecodes[pc] & 0xff) + 1; else pc++; continue; case JUMPL0ATOM: if (stack[sp-0].atom) pc = pc + (bytecodes[pc] & 0xff) + 1; else pc++; continue; case JUMPL0NATOM: if (!stack[sp-0].atom) pc = pc + (bytecodes[pc] & 0xff) + 1; else pc++; continue; case JUMPL1ATOM: if (stack[sp-1].atom) pc = pc + (bytecodes[pc] & 0xff) + 1; else pc++; continue; case JUMPL1NATOM: if (!stack[sp-1].atom) pc = pc + (bytecodes[pc] & 0xff) + 1; else pc++; continue; case JUMPL2ATOM: if (stack[sp-2].atom) pc = pc + (bytecodes[pc] & 0xff) + 1; else pc++; continue; case JUMPL2NATOM: if (!stack[sp-2].atom) pc = pc + (bytecodes[pc] & 0xff) + 1; else pc++; continue; case JUMPL3ATOM: if (stack[sp-3].atom) pc = pc + (bytecodes[pc] & 0xff) + 1; else pc++; continue; case JUMPL3NATOM: if (!stack[sp-3].atom) pc = pc + (bytecodes[pc] & 0xff) + 1; else pc++; continue; case JUMPFREE1NIL: if (env[1].car/*value*/ == Jlisp.nil) pc = pc + (bytecodes[pc] & 0xff) + 1; else pc++; continue; case JUMPFREE1T: if (env[1].car/*value*/ != Jlisp.nil) pc = pc + (bytecodes[pc] & 0xff) + 1; else pc++; continue; case JUMPFREE2NIL: if (env[2].car/*value*/ == Jlisp.nil) pc = pc + (bytecodes[pc] & 0xff) + 1; else pc++; continue; case JUMPFREE2T: if (env[2].car/*value*/ != Jlisp.nil) pc = pc + (bytecodes[pc] & 0xff) + 1; else pc++; continue; case JUMPFREE3NIL: if (env[3].car/*value*/ == Jlisp.nil) pc = pc + (bytecodes[pc] & 0xff) + 1; else pc++; continue; case JUMPFREE3T: if (env[3].car/*value*/ != Jlisp.nil) pc = pc + (bytecodes[pc] & 0xff) + 1; else pc++; continue; case JUMPFREE4NIL: if (env[4].car/*value*/ == Jlisp.nil) pc = pc + (bytecodes[pc] & 0xff) + 1; else pc++; continue; case JUMPFREE4T: if (env[4].car/*value*/ != Jlisp.nil) pc = pc + (bytecodes[pc] & 0xff) + 1; else pc++; continue; case JUMPFREENIL: arg = bytecodes[pc++] & 0xff; if (env[arg].car/*value*/ == Jlisp.nil) pc = pc + (bytecodes[pc] & 0xff) + 1; else pc++; continue; case JUMPFREET: arg = bytecodes[pc++] & 0xff; if (env[arg].car/*value*/ != Jlisp.nil) pc = pc + (bytecodes[pc] & 0xff) + 1; else pc++; continue; case JUMPLIT1EQ: if (env[1] == a) pc = pc + (bytecodes[pc] & 0xff) + 1; else pc++; continue; case JUMPLIT1NE: if (env[1] != a) pc = pc + (bytecodes[pc] & 0xff) + 1; else pc++; continue; case JUMPLIT2EQ: if (env[2] == a) pc = pc + (bytecodes[pc] & 0xff) + 1; else pc++; continue; case JUMPLIT2NE: if (env[2] != a) pc = pc + (bytecodes[pc] & 0xff) + 1; else pc++; continue; case JUMPLIT3EQ: if (env[3] == a) pc = pc + (bytecodes[pc] & 0xff) + 1; else pc++; continue; case JUMPLIT3NE: if (env[3] != a) pc = pc + (bytecodes[pc] & 0xff) + 1; else pc++; continue; case JUMPLIT4EQ: if (env[4] == a) pc = pc + (bytecodes[pc] & 0xff) + 1; else pc++; continue; case JUMPLIT4NE: if (env[4] != a) pc = pc + (bytecodes[pc] & 0xff) + 1; else pc++; continue; case JUMPLITEQ: arg = bytecodes[pc++] & 0xff; if (env[arg] == a) pc = pc + (bytecodes[pc] & 0xff) + 1; else pc++; continue; case JUMPLITNE: arg = bytecodes[pc++] & 0xff; if (env[arg] != a) pc = pc + (bytecodes[pc] & 0xff) + 1; else pc++; continue; case JUMPB1NIL: arg = bytecodes[pc++] & 0xff; if (builtin1[arg].op1(a) == Jlisp.nil) pc = pc + (bytecodes[pc] & 0xff) + 1; else pc++; continue; case JUMPB1T: arg = bytecodes[pc++] & 0xff; if (builtin1[arg].op1(a) != Jlisp.nil) pc = pc + (bytecodes[pc] & 0xff) + 1; else pc++; continue; case JUMPB2NIL: arg = bytecodes[pc++] & 0xff; if (builtin2[arg].op2(b, a) == Jlisp.nil) pc = pc + (bytecodes[pc] & 0xff) + 1; else pc++; continue; case JUMPB2T: arg = bytecodes[pc++] & 0xff; if (builtin2[arg].op2(b, a) != Jlisp.nil) pc = pc + (bytecodes[pc] & 0xff) + 1; else pc++; continue; case JUMPFLAGP: arg = bytecodes[pc++] & 0xff; if (builtin2[BIflagp].op2(a, env[arg]) != Jlisp.nil) pc = pc + (bytecodes[pc] & 0xff) + 1; else pc++; continue; case JUMPNFLAGP: arg = bytecodes[pc++] & 0xff; if (builtin2[BIflagp].op2(a, env[arg]) == Jlisp.nil) pc = pc + (bytecodes[pc] & 0xff) + 1; else pc++; continue; case JUMPEQCAR: arg = bytecodes[pc++] & 0xff; if (!a.atom && env[arg] == a.car) pc = pc + (bytecodes[pc] & 0xff) + 1; else pc++; continue; case JUMPNEQCAR: arg = bytecodes[pc++] & 0xff; if (a.atom || env[arg] != a.car) pc = pc + (bytecodes[pc] & 0xff) + 1; else pc++; continue; case CATCH: Jlisp.error("bytecode CATCH not implemented"); case CATCH_B: Jlisp.error("bytecode CATCH_B not implemented"); case CATCH_L: Jlisp.error("bytecode CATCH_L not implemented"); case CATCH_BL: Jlisp.error("bytecode CATCHH_BL not implemented"); case UNCATCH: Jlisp.error("bytecode UNCATCH not implemented"); case THROW: Jlisp.error("bytecode THROW not implemented"); case PROTECT: Jlisp.error("bytecode PROTECT not implemented"); case UNPROTECT: Jlisp.error("bytecode UNPROTECT not implemented"); case PVBIND: Jlisp.error("bytecode PVBIND not implemented"); case PVRESTORE: Jlisp.error("bytecode PVRESTORE not implemented"); case FREEBIND: arg = bytecodes[pc++] & 0xff; { LispObject [] v = ((LispVector)env[arg]).vec; for (int i=0; i<v.length; i++) { stack[++sp] = v[i].car/*value*/; v[i].car/*value*/ = Jlisp.nil; } stack[++sp] = env[arg]; stack[++sp] = Spid.fbind; } continue; case FREERSTR: { sp--; // ought to be the Spid LispObject [] v = ((LispVector)stack[sp--]).vec; for (int i=v.length-1; i>=0; i--) { v[i].car/*value*/ = stack[sp--]; } } continue; case EXIT: sp = spsave; return a; case NILEXIT: sp = spsave; return Jlisp.nil; case LOC0EXIT: pc = sp; sp = spsave; return stack[pc-0]; case LOC1EXIT: pc = sp; sp = spsave; return stack[pc-1]; case LOC2EXIT: pc = sp; sp = spsave; return stack[pc-2]; case PUSH: stack[++sp] = a; continue; case PUSHNIL: stack[++sp] = Jlisp.nil; continue; case PUSHNIL2: stack[++sp] = Jlisp.nil; stack[++sp] = Jlisp.nil; continue; case PUSHNIL3: stack[++sp] = Jlisp.nil; stack[++sp] = Jlisp.nil; stack[++sp] = Jlisp.nil; continue; case PUSHNILS: arg = bytecodes[pc++] & 0xff; for (int i=0; i<arg; i++) stack[++sp] = Jlisp.nil; continue; case POP: b = a; a = stack[sp--]; continue; case LOSE: sp--; continue; case LOSE2: sp -= 2; continue; case LOSE3: sp -= 3; continue; case LOSES: sp -= (bytecodes[pc++] & 0xff); continue; case SWOP: w = a; a = b; b = w; continue; case EQCAR: if (b.atom) { a = Jlisp.nil; continue; } else b = b.car; // drop through into EQ case EQ: if (a instanceof LispInteger) // @@@ EQ a = a.lispequals(b) ? Jlisp.lispTrue : Jlisp.nil; // @@@ EQ else // @@@ EQ a = (a == b) ? Jlisp.lispTrue : Jlisp.nil; continue; case EQUAL: a = (a.lispequals(b)) ? Jlisp.lispTrue : Jlisp.nil; continue; case NUMBERP: a = (a instanceof LispNumber) ? Jlisp.lispTrue : Jlisp.nil; continue; case CAR: if (a.atom) Jlisp.error("attempt to take car of an atom", a); a = a.car; continue; case CDR: if (a.atom) Jlisp.error("attempt to take cdr of an atom", a); a = a.cdr; continue; case CAAR: if (a.atom) Jlisp.error("attempt to take car of an atom", a); a = a.car; if (a.atom) Jlisp.error("attempt to take car of an atom", a); a = a.car; continue; case CADR: if (a.atom) Jlisp.error("attempt to take cdr of an atom", a); a = a.cdr; if (a.atom) Jlisp.error("attempt to take car of an atom", a); a = a.car; continue; case CDAR: if (a.atom) Jlisp.error("attempt to take car of an atom", a); a = a.car; if (a.atom) Jlisp.error("attempt to take cdr of an atom", a); a = a.cdr; continue; case CDDR: if (a.atom) Jlisp.error("attempt to take cdr of an atom", a); a = a.cdr; if (a.atom) Jlisp.error("attempt to take cdr of an atom", a); a = a.cdr; continue; case CONS: a = new Cons(b, a); continue; case NCONS: a = new Cons(a, Jlisp.nil); continue; case XCONS: a = new Cons(a, b); continue; case ACONS: a = new Cons(new Cons(stack[sp--], b), a); continue; case LENGTH: a = builtin1[BIlength].op1(a); continue; case LIST2: a = new Cons(b, new Cons(a, Jlisp.nil)); continue; case LIST2STAR: a = new Cons(stack[sp--], new Cons(b, a)); continue; case LIST3: a = new Cons(stack[sp--], new Cons(b, new Cons(a, Jlisp.nil))); continue; case PLUS2: a = builtin2[BIplus2].op2(b, a); continue; case ADD1: a = builtin1[BIadd1].op1(a); continue; case DIFFERENCE: a = builtin2[BIdifference].op2(b, a); continue; case SUB1: a = builtin1[BIsub1].op1(a); continue; case TIMES2: a = builtin2[BItimes2].op2(b, a); continue; case GREATERP: a = builtin2[BIgreaterp].op2(b, a); continue; case LESSP: a = builtin2[BIlessp].op2(b, a); continue; case FLAGP: a = builtin2[BIflagp].op2(b, a); continue; case GET: a = builtin2[BIget].op2(b, a); continue; case LITGET: arg = bytecodes[pc++] & 0xff; a = builtin2[BIget].op2(a, env[arg]); continue; case GETV: a = builtin2[BIgetv].op2(b, a); continue; case QGETV: a = builtin2[BIqgetv].op2(b, a); continue; case QGETVN: arg = bytecodes[pc++] & 0xff; a = builtin2[BIget].op2(a, LispInteger.valueOf(arg)); continue; case BIGSTACK: Jlisp.error("bytecode BIGSTACK not implemented"); case BIGCALL: Jlisp.error("bytecode BIGCALL not implemented"); case ICASE: Jlisp.error("bytecode ICASE not implemented"); case FASTGET: Jlisp.error("bytecode FASTGET not implemented"); case SPARE1: Jlisp.error("bytecode SPARE1 not implemented"); case SPARE2: Jlisp.error("bytecode SPARE2 not implemented"); } }} catch (Exception e) { // What I NEED to do here is to restore any free bindings that have been made. // I can find them because there is a Spid.fbind on the stack to mark them. // // What I also WANT to do is to print a fragment of backtrace in relevant // cases. while (sp != spsave) { a = stack[sp--]; if (a != Spid.fbind) continue; LispObject [] v = ((LispVector)stack[sp--]).vec; for (int i=v.length-1; i>=0; i--) { v[i].car/*value*/ = stack[sp--]; } } if (Jlisp.backtrace) { Jlisp.errprint("Within: "); env[0].errPrint(); Jlisp.errprintln(); } throw e; } } } // End of Bytecode.java