From aa920784b4e5e2291c186b8bf9932be6b8d72516 Mon Sep 17 00:00:00 2001 From: jjgarcia Date: Thu, 19 Jun 2008 15:07:24 +0000 Subject: [PATCH] Turn the macros in bytecodes.h into standalone forms that output no value. This restriction allows us to have more complex code in them. --- src/c/disassembler.d | 122 +++++++++++----------- src/c/interpreter.d | 234 ++++++++++++++++++++++++++----------------- src/h/bytecodes.h | 131 +++--------------------- 3 files changed, 221 insertions(+), 266 deletions(-) diff --git a/src/c/disassembler.d b/src/c/disassembler.d index 649b221c3..8499f47ac 100644 --- a/src/c/disassembler.d +++ b/src/c/disassembler.d @@ -122,9 +122,11 @@ NO_ARGS: */ static cl_opcode * disassemble_flet(cl_object bytecodes, cl_opcode *vector) { - cl_index nfun = GET_OPARG(vector); - cl_index first = GET_OPARG(vector); - cl_object *data = bytecodes->bytecodes.data + first; + cl_index nfun, first; + cl_object *data; + GET_OPARG(nfun, vector); + GET_OPARG(first, vector); + data = bytecodes->bytecodes.data + first; print_noarg("FLET"); while (nfun--) { cl_object fun = *(data++); @@ -141,9 +143,11 @@ disassemble_flet(cl_object bytecodes, cl_opcode *vector) { */ static cl_opcode * disassemble_labels(cl_object bytecodes, cl_opcode *vector) { - cl_index nfun = GET_OPARG(vector); - cl_index first = GET_OPARG(vector); - cl_object *data = bytecodes->bytecodes.data + first; + cl_index nfun, first; + cl_object *data; + GET_OPARG(nfun, vector); + GET_OPARG(first, vector); + data = bytecodes->bytecodes.data + first; print_noarg("LABELS"); while (nfun--) { cl_object fun = *(data++); @@ -180,9 +184,9 @@ labeln: */ static cl_opcode * disassemble_tagbody(cl_object bytecodes, cl_opcode *vector) { - cl_index i, ntags = GET_OPARG(vector); + cl_index i, ntags; cl_opcode *destination; - + GET_OPARG(ntags, vector); print_noarg("TAGBODY"); for (i=0; ibytecodes.data; BEGIN: cl_format(3, Ct, line_format, MAKE_FIXNUM(vector-base)); @@ -216,14 +221,14 @@ disassemble(cl_object bytecodes, cl_opcode *vector) { Sets VALUES(0) to an immediate value. */ case OP_QUOTE: string = "QUOTE\t"; - o = GET_DATA(vector, bytecodes); + GET_DATA(o, vector, data); goto ARG; /* OP_VAR n{arg} Sets NVALUES=1 and VALUES(0) to the value of the n-th local. */ case OP_VAR: string = "VAR\t"; - n = GET_OPARG(vector); + GET_OPARG(n, vector); goto OPARG; /* OP_VARS var{symbol} @@ -231,7 +236,7 @@ disassemble(cl_object bytecodes, cl_opcode *vector) { VAR should be either a special variable or a constant. */ case OP_VARS: string = "VARS\t"; - o = GET_DATA(vector, bytecodes); + GET_DATA(o, vector, data); goto ARG; /* OP_PUSH @@ -247,7 +252,7 @@ disassemble(cl_object bytecodes, cl_opcode *vector) { Pushes the value of the n-th local onto the stack. */ case OP_PUSHV: string = "PUSHV\t"; - n = GET_OPARG(vector); + GET_OPARG(n, vector); goto OPARG; /* OP_PUSHVS var{symbol} @@ -255,14 +260,14 @@ disassemble(cl_object bytecodes, cl_opcode *vector) { VAR should be either a special variable or a constant. */ case OP_PUSHVS: string = "PUSHVS\t"; - o = GET_DATA(vector, bytecodes); + GET_DATA(o, vector, data); goto ARG; /* OP_PUSHQ value{object} Pushes "value" onto the stack. */ case OP_PUSHQ: string = "PUSH\t'"; - o = GET_DATA(vector, bytecodes); + GET_DATA(o, vector, data); goto ARG; /* OP_PUSHVALUES @@ -304,7 +309,7 @@ disassemble(cl_object bytecodes, cl_opcode *vector) { are left in VALUES(...) */ case OP_CALL: string = "CALL\t"; - n = GET_OPARG(vector); + GET_OPARG(n, vector); goto OPARG; /* OP_CALLG n{arg}, name{arg} @@ -312,8 +317,8 @@ disassemble(cl_object bytecodes, cl_opcode *vector) { deposited in the stack. The output values are left in VALUES. */ case OP_CALLG: string = "CALLG\t"; - n = GET_OPARG(vector); - o = GET_DATA(vector, bytecodes); + GET_OPARG(n, vector); + GET_DATA(o, vector, data); goto OPARG_ARG; /* OP_FCALL n{arg} @@ -323,7 +328,7 @@ disassemble(cl_object bytecodes, cl_opcode *vector) { */ case OP_STEPCALL: case OP_FCALL: string = "FCALL\t"; - n = GET_OPARG(vector); + GET_OPARG(n, vector); goto OPARG; /* OP_PCALL n{arg} @@ -332,7 +337,7 @@ disassemble(cl_object bytecodes, cl_opcode *vector) { is pushed on the stack. */ case OP_PCALL: string = "PCALL\t"; - n = GET_OPARG(vector); + GET_OPARG(n, vector); goto OPARG; /* OP_PCALLG n{arg}, name{arg} @@ -341,8 +346,8 @@ disassemble(cl_object bytecodes, cl_opcode *vector) { the stack. */ case OP_PCALLG: string = "PCALLG\t"; - n = GET_OPARG(vector); - o = GET_DATA(vector, bytecodes); + GET_OPARG(n, vector); + GET_DATA(o, vector, data); goto OPARG_ARG; /* OP_PFCALL n{arg} @@ -351,7 +356,7 @@ disassemble(cl_object bytecodes, cl_opcode *vector) { is pushed on the stack. */ case OP_PFCALL: string = "PFCALL\t"; - n = GET_OPARG(vector); + GET_OPARG(n, vector); goto OPARG; /* OP_MCALL @@ -398,7 +403,7 @@ disassemble(cl_object bytecodes, cl_opcode *vector) { environment. This last value takes precedence. */ case OP_LFUNCTION: string = "LOCFUNC\t"; - n = GET_OPARG(vector); + GET_OPARG(n, vector); goto OPARG; /* OP_FUNCTION name{symbol} @@ -407,7 +412,7 @@ disassemble(cl_object bytecodes, cl_opcode *vector) { environment. This last value takes precedence. */ case OP_FUNCTION: string = "SYMFUNC\t"; - o = GET_DATA(vector, bytecodes); + GET_DATA(o, vector, data); goto ARG; /* OP_CLOSE name{arg} @@ -416,7 +421,7 @@ disassemble(cl_object bytecodes, cl_opcode *vector) { environment. This last value takes precedence. */ case OP_CLOSE: string = "CLOSE\t"; - o = GET_DATA(vector, bytecodes); + GET_DATA(o, vector, data); goto ARG; /* OP_GO n{arg} @@ -426,8 +431,8 @@ disassemble(cl_object bytecodes, cl_opcode *vector) { purposes. */ case OP_GO: string = "GO\t"; - n = GET_OPARG(vector); - o = GET_DATA(vector, bytecodes); + GET_OPARG(n, vector); + GET_DATA(o, vector, data); goto OPARG_ARG; /* OP_RETURN n{arg} @@ -435,7 +440,7 @@ disassemble(cl_object bytecodes, cl_opcode *vector) { occuppies the n-th position. */ case OP_RETURN: string = "RETFROM"; - n = GET_OPARG(vector); + GET_OPARG(n, vector); goto OPARG; /* OP_THROW @@ -459,17 +464,17 @@ disassemble(cl_object bytecodes, cl_opcode *vector) { case OP_JNIL: string = "JNIL\t"; goto JMP; case OP_JT: string = "JT\t"; - JMP: { cl_oparg jmp = GET_OPARG(vector); - n = vector + jmp - OPARG_SIZE - base; + JMP: { GET_OPARG(m, vector); + n = vector + m - OPARG_SIZE - base; goto OPARG; } case OP_JEQL: string = "JEQL\t"; goto JEQL; case OP_JNEQL: string = "JNEQL\t"; JEQL: { cl_oparg jmp; - o = GET_DATA(vector, bytecodes); - jmp = GET_OPARG(vector); - n = vector + jmp - OPARG_SIZE - base; + GET_DATA(o, vector, data); + GET_OPARG(m, vector); + n = vector + m - OPARG_SIZE - base; goto OPARG_ARG; } case OP_NOT: string = "NOT"; @@ -479,13 +484,13 @@ disassemble(cl_object bytecodes, cl_opcode *vector) { Undo "n" bindings of lexical variables. */ case OP_UNBIND: string = "UNBIND\t"; - n = GET_OPARG(vector); + GET_OPARG(n, vector); goto OPARG; /* OP_UNBINDS n{arg} Undo "n" bindings of special variables. */ case OP_UNBINDS: string = "UNBINDS\t"; - n = GET_OPARG(vector); + GET_OPARG(n, vector); goto OPARG; /* OP_BIND name{symbol} OP_PBIND name{symbol} @@ -496,24 +501,24 @@ disassemble(cl_object bytecodes, cl_opcode *vector) { to the n-th value of VALUES(...). */ case OP_BIND: string = "BIND\t"; - o = GET_DATA(vector, bytecodes); + GET_DATA(o, vector, data); goto ARG; case OP_PBIND: string = "PBIND\t"; - o = GET_DATA(vector, bytecodes); + GET_DATA(o, vector, data); goto ARG; case OP_VBIND: string = "VBIND\t"; - n = GET_OPARG(vector); - o = GET_DATA(vector, bytecodes); + GET_OPARG(n, vector); + GET_DATA(o, vector, data); goto OPARG_ARG; case OP_BINDS: string = "BINDS\t"; - o = GET_DATA(vector, bytecodes); + GET_DATA(o, vector, data); goto ARG; case OP_PBINDS: string = "PBINDS\t"; - o = GET_DATA(vector, bytecodes); + GET_DATA(o, vector, data); goto ARG; case OP_VBINDS: string = "VBINDS\t"; - n = GET_OPARG(vector); - o = GET_DATA(vector, bytecodes); + GET_OPARG(n, vector); + GET_DATA(o, vector, data); goto OPARG_ARG; /* OP_SETQ n{arg} OP_PSETQ n{arg} @@ -524,24 +529,25 @@ disassemble(cl_object bytecodes, cl_opcode *vector) { first value on the stack (OP_PSETQ[S]). */ case OP_SETQ: string = "SETQ\t"; - n = GET_OPARG(vector); + GET_OPARG(n, vector); goto OPARG; case OP_PSETQ: string = "PSETQ\t"; - n = GET_OPARG(vector); + GET_OPARG(n, vector); goto OPARG; case OP_VSETQ: string = "VSETQ\t"; - o = MAKE_FIXNUM(GET_OPARG(vector)); - n = GET_OPARG(vector); + GET_OPARG(m, vector); + o = MAKE_FIXNUM(m); + GET_OPARG(n, vector); goto OPARG_ARG; case OP_SETQS: string = "SETQS\t"; - o = GET_DATA(vector, bytecodes); + GET_DATA(o, vector, data); goto ARG; case OP_PSETQS: string = "PSETQS\t"; - o = GET_DATA(vector, bytecodes); + GET_DATA(o, vector, data); goto ARG; case OP_VSETQS: string = "VSETQS\t"; - o = GET_DATA(vector, bytecodes); - n = GET_OPARG(vector); + GET_DATA(o, vector, data); + GET_OPARG(n, vector); goto OPARG_ARG; case OP_PROGV: vector = disassemble_progv(bytecodes, vector); @@ -551,7 +557,7 @@ disassemble(cl_object bytecodes, cl_opcode *vector) { Pop N values from the stack and store them in VALUES(...) */ case OP_VALUES: string = "VALUES\t"; - n = GET_OPARG(vector); + GET_OPARG(n, vector); goto OPARG; /* OP_NTHVAL Set VALUES(0) to the N-th value of the VALUES(...) list. @@ -594,7 +600,7 @@ disassemble(cl_object bytecodes, cl_opcode *vector) { case OP_PUSHNIL: string = "PUSH\t'NIL"; goto NOARG; case OP_STEPIN: string = "STEP\tIN,"; - o = GET_DATA(vector, bytecodes); + GET_DATA(o, vector, data); goto ARG; case OP_STEPOUT: string = "STEP\tOUT"; goto NOARG; @@ -604,16 +610,16 @@ disassemble(cl_object bytecodes, cl_opcode *vector) { case OP_CAR: string = "CAR\tREG0"; goto NOARG; case OP_CDR: string = "CDR\tREG0"; goto NOARG; case OP_LIST: string = "LIST\t"; - n = GET_OPARG(bytecodes); + GET_OPARG(n, bytecodes); goto OPARG; case OP_LISTA: string = "LIST*\t"; - n = GET_OPARG(bytecodes); + GET_OPARG(n, bytecodes); goto OPARG; case OP_CALLG1: string = "CALLG1\t"; - o = GET_DATA(vector, bytecodes); + GET_DATA(o, vector, data); goto ARG; case OP_CALLG2: string = "CALLG2\t"; - o = GET_DATA(vector, bytecodes); + GET_DATA(o, vector, data); goto ARG; default: diff --git a/src/c/interpreter.d b/src/c/interpreter.d index dca86e32b..1694f5333 100644 --- a/src/c/interpreter.d +++ b/src/c/interpreter.d @@ -557,6 +557,7 @@ ecl_interpret(cl_object env, cl_object bytecodes, void *pc) typedef struct cl_env_struct *cl_env_ptr; const cl_env_ptr the_env = &cl_env; cl_opcode *vector = pc; + cl_object *data = bytecodes->bytecodes.data; cl_object reg0 = the_env->values[0], reg1, lex_env = env; struct ecl_stack_frame frame_aux; volatile struct ihs_frame ihs; @@ -574,7 +575,7 @@ ecl_interpret(cl_object env, cl_object bytecodes, void *pc) Sets REG0 to an immediate value. */ CASE(OP_QUOTE); { - reg0 = GET_DATA(vector, bytecodes); + GET_DATA(reg0, vector, data); THREAD_NEXT; } /* OP_VAR n{arg}, var{symbol} @@ -582,7 +583,8 @@ ecl_interpret(cl_object env, cl_object bytecodes, void *pc) VAR is the name of the variable for readability purposes. */ CASE(OP_VAR); { - int lex_env_index = GET_OPARG(vector); + int lex_env_index; + GET_OPARG(lex_env_index, vector); reg0 = ecl_lex_env_get_var(lex_env, lex_env_index); THREAD_NEXT; } @@ -592,7 +594,8 @@ ecl_interpret(cl_object env, cl_object bytecodes, void *pc) VAR should be either a special variable or a constant. */ CASE(OP_VARS); { - cl_object var_name = GET_DATA(vector, bytecodes); + cl_object var_name; + GET_DATA(var_name, vector, data); reg0 = search_global(var_name); THREAD_NEXT; } @@ -623,7 +626,8 @@ ecl_interpret(cl_object env, cl_object bytecodes, void *pc) reg0 = ecl_list1(reg0); CASE(OP_LISTA); { - cl_index n = GET_OPARG(vector); + cl_index n; + GET_OPARG(n, vector); while (--n) { reg0 = CONS(STACK_POP(the_env), reg0); } @@ -641,7 +645,8 @@ ecl_interpret(cl_object env, cl_object bytecodes, void *pc) Pushes the value of the n-th local onto the stack. */ CASE(OP_PUSHV); { - int lex_env_index = GET_OPARG(vector); + int lex_env_index; + GET_OPARG(lex_env_index, vector); STACK_PUSH(the_env, ecl_lex_env_get_var(lex_env, lex_env_index)); THREAD_NEXT; } @@ -651,7 +656,8 @@ ecl_interpret(cl_object env, cl_object bytecodes, void *pc) VAR should be either a special variable or a constant. */ CASE(OP_PUSHVS); { - cl_object var_name = GET_DATA(vector, bytecodes); + cl_object var_name; + GET_DATA(var_name, vector, data); STACK_PUSH(the_env, search_global(var_name)); THREAD_NEXT; } @@ -660,7 +666,9 @@ ecl_interpret(cl_object env, cl_object bytecodes, void *pc) Pushes "value" onto the stack. */ CASE(OP_PUSHQ); { - STACK_PUSH(the_env, GET_DATA(vector, bytecodes)); + cl_object aux; + GET_DATA(aux, vector, data); + STACK_PUSH(the_env, aux); THREAD_NEXT; } /* OP_CALL n{arg} @@ -669,7 +677,8 @@ ecl_interpret(cl_object env, cl_object bytecodes, void *pc) are left in VALUES(...) */ CASE(OP_CALL); { - cl_fixnum n = GET_OPARG(vector); + cl_fixnum n; + GET_OPARG(n, vector); INTERPRET_FUNCALL(reg0, the_env, frame_aux, n, reg0); THREAD_NEXT; } @@ -679,22 +688,28 @@ ecl_interpret(cl_object env, cl_object bytecodes, void *pc) deposited in the stack. The output values are left in VALUES. */ CASE(OP_CALLG); { - cl_fixnum n = GET_OPARG(vector); - cl_object f = GET_DATA(vector, bytecodes); + cl_fixnum n; + cl_object f; + GET_OPARG(n, vector); + GET_DATA(f, vector, data); INTERPRET_FUNCALL(reg0, the_env, frame_aux, n, f); THREAD_NEXT; } CASE(OP_CALLG1); { - cl_object s = GET_DATA(vector, bytecodes); - cl_objectfn_fixed f = (cl_objectfn_fixed)SYM_FUN(s)->cfun.entry; + cl_object s; + cl_objectfn_fixed f; + GET_DATA(s, vector, data); + f = (cl_objectfn_fixed)SYM_FUN(s)->cfun.entry; reg0 = f(reg0); THREAD_NEXT; } CASE(OP_CALLG2); { - cl_object s = GET_DATA(vector, bytecodes); - cl_objectfn_fixed f = (cl_objectfn_fixed)SYM_FUN(s)->cfun.entry; + cl_object s; + cl_objectfn_fixed f; + GET_DATA(s, vector, data); + f = (cl_objectfn_fixed)SYM_FUN(s)->cfun.entry; reg0 = f(STACK_POP(the_env), reg0); THREAD_NEXT; } @@ -705,8 +720,10 @@ ecl_interpret(cl_object env, cl_object bytecodes, void *pc) are left in VALUES(...) */ CASE(OP_FCALL); { - cl_fixnum n = GET_OPARG(vector); - cl_object fun = STACK_REF(the_env,-n-1); + cl_fixnum n; + cl_object fun; + GET_OPARG(n, vector); + fun = STACK_REF(the_env,-n-1); INTERPRET_FUNCALL(reg0, the_env, frame_aux, n, fun); STACK_POP(the_env); THREAD_NEXT; @@ -730,7 +747,8 @@ ecl_interpret(cl_object env, cl_object bytecodes, void *pc) is pushed on the stack. */ CASE(OP_PCALL); { - cl_fixnum n = GET_OPARG(vector); + cl_fixnum n; + GET_OPARG(n, vector); INTERPRET_FUNCALL(reg0, the_env, frame_aux, n, reg0); STACK_PUSH(the_env, reg0); THREAD_NEXT; @@ -742,8 +760,10 @@ ecl_interpret(cl_object env, cl_object bytecodes, void *pc) the stack. */ CASE(OP_PCALLG); { - cl_fixnum n = GET_OPARG(vector); - cl_object f = GET_DATA(vector, bytecodes); + cl_fixnum n; + cl_object f; + GET_OPARG(n, vector); + GET_DATA(f, vector, data); INTERPRET_FUNCALL(f, the_env, frame_aux, n, f); STACK_PUSH(the_env, f); THREAD_NEXT; @@ -755,8 +775,10 @@ ecl_interpret(cl_object env, cl_object bytecodes, void *pc) is pushed on the stack. */ CASE(OP_PFCALL); { - cl_fixnum n = GET_OPARG(vector); - cl_object fun = STACK_REF(the_env, -n-1); + cl_fixnum n; + cl_object fun; + GET_OPARG(n, vector); + fun = STACK_REF(the_env, -n-1); INTERPRET_FUNCALL(fun, the_env, frame_aux, n, fun); STACK_REF(the_env, -1) = fun; THREAD_NEXT; @@ -779,18 +801,18 @@ ecl_interpret(cl_object env, cl_object bytecodes, void *pc) index of the first function: the others are after this one. */ CASE(OP_FLET); { - cl_index nfun = GET_OPARG(vector); - cl_index first = GET_OPARG(vector); - cl_object *fun = bytecodes->bytecodes.data + first; + cl_index nfun, first; + cl_object old_lex, *fun; + GET_OPARG(nfun, vector); + GET_OPARG(first, vector); + fun = data + first; /* Copy the environment so that functions get it without references to themselves, and then add new closures to the environment. */ - cl_object old_lex = lex_env; - cl_object new_lex = old_lex; + old_lex = lex_env; while (nfun--) { cl_object f = close_around(*(fun++), old_lex); - new_lex = bind_function(new_lex, f->bytecodes.name, f); + lex_env = bind_function(lex_env, f->bytecodes.name, f); } - lex_env = new_lex; THREAD_NEXT; } /* OP_LABELS nfun{arg} @@ -804,10 +826,11 @@ ecl_interpret(cl_object env, cl_object bytecodes, void *pc) the functions "fun1" ... "funn". */ CASE(OP_LABELS); { - cl_index i, nfun = GET_OPARG(vector); - cl_index first = GET_OPARG(vector); - cl_object *fun = bytecodes->bytecodes.data + first; - cl_object l, new_lex; + cl_index i, nfun, first; + cl_object *fun, l, new_lex; + GET_OPARG(nfun, vector); + GET_OPARG(first, vector); + fun = data + first; /* Build up a new environment with all functions */ for (new_lex = lex_env, i = nfun; i; i--) { cl_object f = *(fun++); @@ -828,9 +851,10 @@ ecl_interpret(cl_object env, cl_object bytecodes, void *pc) which have been deposited in the stack. */ CASE(OP_LFUNCTION); { - int lex_env_index = GET_OPARG(vector); - cl_object fun_record = ecl_lex_env_get_record(lex_env, lex_env_index); - reg0 = CAR(fun_record); + int lex_env_index; + cl_object fun_record; + GET_OPARG(lex_env_index, vector); + reg0 = ECL_CONS_CAR(ecl_lex_env_get_record(lex_env, lex_env_index)); THREAD_NEXT; } @@ -839,9 +863,11 @@ ecl_interpret(cl_object env, cl_object bytecodes, void *pc) may be defined in the global environment or in the local environment. This last value takes precedence. */ - CASE(OP_FUNCTION); - reg0 = ecl_fdefinition(GET_DATA(vector, bytecodes)); + CASE(OP_FUNCTION); { + GET_DATA(reg0, vector, data); + reg0 = ecl_fdefinition(reg0); THREAD_NEXT; + } /* OP_CLOSE name{symbol} Extracts the function associated to a symbol. The function @@ -849,8 +875,8 @@ ecl_interpret(cl_object env, cl_object bytecodes, void *pc) environment. This last value takes precedence. */ CASE(OP_CLOSE); { - cl_object function_object = GET_DATA(vector, bytecodes); - reg0 = close_around(function_object, lex_env); + GET_DATA(reg0, vector, data); + reg0 = close_around(reg0, lex_env); THREAD_NEXT; } /* OP_GO n{arg} @@ -860,9 +886,11 @@ ecl_interpret(cl_object env, cl_object bytecodes, void *pc) purposes. */ CASE(OP_GO); { - cl_object id = ecl_lex_env_get_tag(lex_env, GET_OPARG(vector)); - cl_object tag_name = GET_DATA(vector, bytecodes); - cl_go(id, tag_name); + cl_index lex_env_index; + cl_object tag_name; + GET_OPARG(lex_env_index, vector); + GET_DATA(tag_name, vector, data); + cl_go(ecl_lex_env_get_tag(lex_env, lex_env_index), tag_name); THREAD_NEXT; } /* OP_RETURN n{arg} @@ -870,12 +898,14 @@ ecl_interpret(cl_object env, cl_object bytecodes, void *pc) occuppies the n-th position. */ CASE(OP_RETURN); { - int lex_env_index = GET_OPARG(vector); - cl_object block_record = ecl_lex_env_get_record(lex_env, lex_env_index); - cl_object id = CAR(block_record); - cl_object block_name = CDR(block_record); + int lex_env_index; + cl_object block_record, id, block_name; + GET_OPARG(lex_env_index, vector); + /* record = (id . name) */ + block_record = ecl_lex_env_get_record(lex_env, lex_env_index); the_env->values[0] = reg0; - cl_return_from(id, block_name); + cl_return_from(ECL_CONS_CAR(block_record), + ECL_CONS_CDR(block_record)); THREAD_NEXT; } /* OP_THROW @@ -898,33 +928,38 @@ ecl_interpret(cl_object env, cl_object bytecodes, void *pc) comparing with the value of REG0. */ CASE(OP_JMP); { - cl_oparg jump = GET_OPARG(vector); + cl_oparg jump; + GET_OPARG(jump, vector); vector += jump - OPARG_SIZE; THREAD_NEXT; } CASE(OP_JNIL); { - cl_oparg jump = GET_OPARG(vector); + cl_oparg jump; + GET_OPARG(jump, vector); if (Null(reg0)) vector += jump - OPARG_SIZE; THREAD_NEXT; } CASE(OP_JT); { - cl_oparg jump = GET_OPARG(vector); + cl_oparg jump; + GET_OPARG(jump, vector); if (!Null(reg0)) vector += jump - OPARG_SIZE; THREAD_NEXT; } CASE(OP_JEQL); { - cl_oparg value = GET_OPARG(vector); - cl_oparg jump = GET_OPARG(vector); - if (ecl_eql(reg0, bytecodes->bytecodes.data[value])) + cl_oparg value, jump; + GET_OPARG(value, vector); + GET_OPARG(jump, vector); + if (ecl_eql(reg0, data[value])) vector += jump - OPARG_SIZE; THREAD_NEXT; } CASE(OP_JNEQL); { - cl_oparg value = GET_OPARG(vector); - cl_oparg jump = GET_OPARG(vector); - if (!ecl_eql(reg0, bytecodes->bytecodes.data[value])) + cl_oparg value, jump; + GET_OPARG(value, vector); + GET_OPARG(jump, vector); + if (!ecl_eql(reg0, data[value])) vector += jump - OPARG_SIZE; THREAD_NEXT; } @@ -941,7 +976,8 @@ ecl_interpret(cl_object env, cl_object bytecodes, void *pc) Undo "n" local bindings. */ CASE(OP_UNBIND); { - cl_index n = GET_OPARG(vector); + cl_oparg n; + GET_OPARG(n, vector); while (n--) lex_env = ECL_CONS_CDR(lex_env); THREAD_NEXT; @@ -950,7 +986,8 @@ ecl_interpret(cl_object env, cl_object bytecodes, void *pc) Undo "n" bindings of special variables. */ CASE(OP_UNBINDS); { - cl_index n = GET_OPARG(vector); + cl_oparg n; + GET_OPARG(n, vector); bds_unwind_n(n); THREAD_NEXT; } @@ -965,39 +1002,44 @@ ecl_interpret(cl_object env, cl_object bytecodes, void *pc) to a given value in the values array. */ CASE(OP_BIND); { - cl_object var_name = GET_DATA(vector, bytecodes); + cl_object var_name; + GET_DATA(var_name, vector, data); lex_env = bind_var(lex_env, var_name, reg0); THREAD_NEXT; } CASE(OP_PBIND); { - cl_object var_name = GET_DATA(vector, bytecodes); - cl_object value = STACK_POP(the_env); - lex_env = bind_var(lex_env, var_name, value); + cl_object var_name, value; + GET_DATA(var_name, vector, data); + lex_env = bind_var(lex_env, var_name, STACK_POP(the_env)); THREAD_NEXT; } CASE(OP_VBIND); { - cl_index n = GET_OPARG(vector); - cl_object var_name = GET_DATA(vector, bytecodes); - cl_object value = (n < the_env->nvalues) ? the_env->values[n] : Cnil; - lex_env = bind_var(lex_env, var_name, value); + cl_index n; + cl_object var_name; + GET_OPARG(n, vector); + GET_DATA(var_name, vector, data); + lex_env = bind_var(lex_env, var_name, + (n < the_env->nvalues) ? the_env->values[n] : Cnil); THREAD_NEXT; } CASE(OP_BINDS); { - cl_object var_name = GET_DATA(vector, bytecodes); + cl_object var_name; + GET_DATA(var_name, vector, data); bds_bind(var_name, reg0); THREAD_NEXT; } CASE(OP_PBINDS); { - cl_object var_name = GET_DATA(vector, bytecodes); - cl_object value = STACK_POP(the_env); - bds_bind(var_name, value); + cl_object var_name; + GET_DATA(var_name, vector, data); + bds_bind(var_name, STACK_POP(the_env)); THREAD_NEXT; } CASE(OP_VBINDS); { - cl_index n = GET_OPARG(vector); - cl_object var_name = GET_DATA(vector, bytecodes); - cl_object value = (n < the_env->nvalues) ? the_env->values[n] : Cnil; - bds_bind(var_name, value); + cl_index n; + cl_object var_name; + GET_OPARG(n, vector); + GET_DATA(var_name, vector, data); + bds_bind(var_name, (n < the_env->nvalues) ? the_env->values[n] : Cnil); THREAD_NEXT; } /* OP_SETQ n{arg} @@ -1013,12 +1055,14 @@ ecl_interpret(cl_object env, cl_object bytecodes, void *pc) that NVALUE > 0 strictly. */ CASE(OP_SETQ); { - int lex_env_index = GET_OPARG(vector); + int lex_env_index; + GET_OPARG(lex_env_index, vector); ecl_lex_env_set_var(lex_env, lex_env_index, reg0); THREAD_NEXT; } CASE(OP_SETQS); { - cl_object var = GET_DATA(vector, bytecodes); + cl_object var; + GET_DATA(var, vector, data); /* INV: Not NIL, and of type t_symbol */ if (var->symbol.stype & stp_constant) FEassignment_to_constant(var); @@ -1026,27 +1070,33 @@ ecl_interpret(cl_object env, cl_object bytecodes, void *pc) THREAD_NEXT; } CASE(OP_PSETQ); { - int lex_env_index = GET_OPARG(vector); + int lex_env_index; + GET_OPARG(lex_env_index, vector); ecl_lex_env_set_var(lex_env, lex_env_index, STACK_POP(the_env)); THREAD_NEXT; } CASE(OP_PSETQS); { - cl_object var = GET_DATA(vector, bytecodes); + cl_object var; + GET_DATA(var, vector, data); /* INV: Not NIL, and of type t_symbol */ ECL_SETQ(var, STACK_POP(the_env)); THREAD_NEXT; } CASE(OP_VSETQ); { - int lex_env_index = GET_OPARG(vector); - int index = GET_OPARG(vector); - cl_object v = (index >= the_env->nvalues)? Cnil : the_env->values[index]; - ecl_lex_env_set_var(lex_env, lex_env_index, v); + cl_index lex_env_index; + cl_oparg index; + GET_OPARG(lex_env_index, vector); + GET_OPARG(index, vector); + ecl_lex_env_set_var(lex_env, lex_env_index, + (index >= the_env->nvalues)? Cnil : the_env->values[index]); THREAD_NEXT; } CASE(OP_VSETQS); { - cl_object var = GET_DATA(vector, bytecodes); - int index = GET_OPARG(vector); - cl_object v = (index >= the_env->nvalues)? Cnil : the_env->values[index]; + cl_object var, v; + cl_oparg index; + GET_DATA(var, vector, data); + GET_OPARG(index, vector); + v = (index >= the_env->nvalues)? Cnil : the_env->values[index]; ECL_SETQ(var, v); THREAD_NEXT; } @@ -1061,7 +1111,7 @@ ecl_interpret(cl_object env, cl_object bytecodes, void *pc) LABEL points to the first instruction after OP_EXIT. */ CASE(OP_BLOCK); { - reg0 = GET_DATA(vector, bytecodes); + GET_DATA(reg0, vector, data); reg1 = new_frame_id(); goto DO_BLOCK; } @@ -1124,7 +1174,8 @@ ecl_interpret(cl_object env, cl_object bytecodes, void *pc) */ CASE(OP_TAGBODY); { cl_object id = new_frame_id(); - int n = GET_OPARG(vector); + int n; + GET_OPARG(n, vector); /* Here we save the location of the jump table and the env. */ lex_env = bind_tagbody(lex_env, id); STACK_PUSH(the_env, lex_env); @@ -1220,7 +1271,8 @@ ecl_interpret(cl_object env, cl_object bytecodes, void *pc) Note that N is strictly > 0. */ CASE(OP_VALUES); { - cl_fixnum n = GET_OPARG(vector); + cl_fixnum n; + GET_OPARG(n, vector); the_env->nvalues = n; STACK_POP_N(the_env, n); memcpy(the_env->values, &STACK_REF(the_env, 0), n * sizeof(cl_object)); @@ -1318,9 +1370,10 @@ ecl_interpret(cl_object env, cl_object bytecodes, void *pc) } CASE(OP_STEPIN); { - cl_object form = GET_DATA(vector, bytecodes); + cl_object form; cl_object a = SYM_VAL(@'si::*step-action*'); cl_index n; + GET_DATA(form, vector, data); SETUP_ENV(the_env); the_env->values[0] = reg0; n = cl_stack_push_values(); @@ -1348,7 +1401,8 @@ ecl_interpret(cl_object env, cl_object bytecodes, void *pc) /* We are going to call a function. However, we would * like to step _in_ the function. STEPPER takes care of * that. */ - cl_fixnum n = GET_OPARG(vector); + cl_fixnum n; + GET_OPARG(n, vector); SETUP_ENV(the_env); if (SYM_VAL(@'si::*step-action*') == Ct) { STACK_PUSH(the_env, reg0); diff --git a/src/h/bytecodes.h b/src/h/bytecodes.h index 2b52596e5..fbf48c745 100644 --- a/src/h/bytecodes.h +++ b/src/h/bytecodes.h @@ -7,122 +7,8 @@ *** CODE. **********************************************************************/ /* - OP_BLOCK block-name{obj} - ... - OP_EXIT_FRAME - Exits the innermost frame (created by OP_BLOCK, OP_DO, etc). - - OP_EXIT - Executes the enclosed forms in a named block - - OP_PUSH - Pushes the object in VALUES(0) - - OP_PUSHV n{arg}, var{symbol} - Pushes the value of the n-th local onto the stack. VAR is given - for readability purposes only. - - OP_PUSHVS var{symbol} - Pushes the value of the symbol VAR onto the stack. - - OP_VAR n{arg} - Returns the value of the n-th local. - - OP_VARS var{symbol} - Returns the value of the symbol VAR. - - OP_PUSHQ value{obj} - Pushes "value" onto the stack. - - OP_PUSHV n{arg}, var{symbol} - Pushes the value of the n-th local. The name of the variable is - kept for readability purposes. - - OP_PUSHVALUES - Pushes the values output by the last form. - - OP_MCALL - ... - OP_EXIT - Saves the stack pointer, executes several forms and - funcalls VALUES(0) using the content of the stack. - - OP_CALLG narg{arg}, function{symbol} - Calls global "function" using the last "narg" values in the stack. - OP_PCALLG narg{arg}, function{symbol} - Calls global "function" using the last "narg" values in the stack. - The first result of the call is also pushed. - - OP_CALL narg{arg} - Calls VALUES(0) using the last "narg" values in the stack. - OP_PCALL narg{arg} - Calls VALUES(0) using the last "narg" values in the stack. - The first result of the call is also pushed. - - OP_FCALL narg{arg} - Pops NARG arguments from the stack, plus a function object and - builds up a function call. - - OP_CATCH dest{label} - ... - OP_EXIT - Sets a catch point with the tag in VALUES(0). The end of - the block is marked by "dest". - - OP_FLET nfun{arg} - ... - OP_EXIT - - OP_LABELS nfun{arg} - ... - OP_EXIT - - OP_FUNCTION symbol{obj} - - OP_CLOSE interpreted-function{obj} - - OP_GO tag-name{obj} - - OP_THROW tag-name{obj} - - OP_RETURN tag-name{obj} - - OP_JMP dest{label} - OP_JNIL dest{label} - OP_JT dest{label} - - OP_CASE n{arg} - object1{obj} dest1{label} - object2{obj} dest2{label} - ... - objectn{obj} destn{label} - destx{label} - dest1: - ... - OP_EXIT - dest2: - ... - OP_EXIT - ... - destn: - ... - OP_EXIT - destx: - - OP_DO exit{label} - ... - OP_EXIT - - OP_PUSHENV - ... - OP_EXIT - - OP_DOLIST - OP_BIND var{obj} - OP_EXIT - + * See ecl/src/c/interpreter.d for a detailed explanation of all opcodes */ - enum { OP_NOP, OP_QUOTE, @@ -217,9 +103,18 @@ typedef int16_t cl_oparg; #define READ_OPCODE(v) (*(cl_opcode *)(v)) #define READ_OPARG(v) (*(cl_oparg *)(v)) #define GET_OPCODE(v) (*((cl_opcode *)(v)++)) -#define GET_OPARG(v) (*((cl_oparg *)(v)++)) -#define GET_DATA(v,b) (b->bytecodes.data[GET_OPARG(v)]) -#define GET_LABEL(pc,v) {pc = (v) + READ_OPARG(v); v += OPARG_SIZE;} +#define GET_OPARG(r,v) { \ + r = *((cl_oparg *)(v)++); \ +} +#define GET_DATA(r,v,data) { \ + cl_oparg ndx; \ + GET_OPARG(ndx, v); \ + r = data[ndx]; \ +} +#define GET_LABEL(pc,v) { \ + pc = (v) + READ_OPARG(v); \ + v += OPARG_SIZE; \ +} /********************************************************************** * THREADED INTERPRETER CODE