From ce724349c5f8bc20ff1adca103c799bc2ac3cb92 Mon Sep 17 00:00:00 2001 From: jjgarcia Date: Thu, 19 Jun 2008 15:02:58 +0000 Subject: [PATCH] Split operator MSETQ into VSETQ and VSETQS. --- src/c/compiler.d | 27 +++++++++++++-------- src/c/disassembler.d | 48 ++++++------------------------------ src/c/interpreter.d | 58 +++++++++++++++----------------------------- src/h/bytecodes.h | 6 +++-- 4 files changed, 49 insertions(+), 90 deletions(-) diff --git a/src/c/compiler.d b/src/c/compiler.d index cee4b4476..b680db959 100644 --- a/src/c/compiler.d +++ b/src/c/compiler.d @@ -1464,7 +1464,7 @@ c_multiple_value_setq(cl_object orig_args, int flags) { cl_object orig_vars; cl_object vars = Cnil, values; cl_object old_variables = ENV->variables; - cl_index nvars = 0; + cl_index i, nvars = 0; /* Look for symbol macros, building the list of variables and the list of late assignments. */ @@ -1498,22 +1498,29 @@ c_multiple_value_setq(cl_object orig_args, int flags) { compile_form(values, FLAG_VALUES); /* Compile variables */ - asm_op2(OP_MSETQ, nvars); vars = cl_nreverse(vars); - while (nvars--) { + for (i = 0; i < nvars; i++) { cl_object var = pop(&vars); - cl_fixnum ndx = c_var_ref(var,0,TRUE); - if (ndx < 0) { /* Global variable */ - if (ecl_symbol_type(var) & stp_constant) - FEassignment_to_constant(var); - ndx = -1-c_register_constant(var); + /* Note that we only use VSETQ[S] for values other than 0 */ + if (i == 0) { + compile_setq(OP_SETQ, var); + } else { + cl_fixnum ndx = c_var_ref(var,0,TRUE); + if (ndx < 0) { /* Global variable */ + if (ecl_symbol_type(var) & stp_constant) + FEassignment_to_constant(var); + asm_op2(OP_VSETQS, i); + asm_c(var); + } else { + asm_op2(OP_VSETQ, i); + asm_arg(ndx); + } } - asm_arg(ndx); } c_undo_bindings(old_variables); - return FLAG_VALUES; + return FLAG_REG0; } /* diff --git a/src/c/disassembler.d b/src/c/disassembler.d index fe71c9ad1..604148b86 100644 --- a/src/c/disassembler.d +++ b/src/c/disassembler.d @@ -154,44 +154,6 @@ disassemble_labels(cl_object bytecodes, cl_opcode *vector) { return vector; } -/* OP_MSETQ n{arg} - {fixnumn} - ... - {fixnum1} - - Sets N variables to the N values in VALUES(), filling with - NIL when there are values missing. Local variables are denoted - with an integer which points a position in the lexical environment, - while special variables are denoted with a negative index X, which - denotes the value -1-X in the table of constants. -*/ -static cl_opcode * -disassemble_msetq(cl_object bytecodes, cl_opcode *vector) -{ - int i, n = GET_OPARG(vector); - bool newline = FALSE; - - for (i=0; i= 0) { - cl_format(4, Ct, - make_constant_base_string("MSETQ\t~D,VALUES(~D)"), - MAKE_FIXNUM(var), MAKE_FIXNUM(i)); - } else { - cl_object name = bytecodes->bytecodes.data[-1-var]; - cl_format(4, Ct, - make_constant_base_string("MSETQS\t~A,VALUES(~D)"), - name, MAKE_FIXNUM(i)); - } - } - return vector; -} - - /* OP_PROGV bindings{list} ... OP_EXIT @@ -569,15 +531,21 @@ disassemble(cl_object bytecodes, cl_opcode *vector) { case OP_PSETQ: string = "PSETQ\t"; n = GET_OPARG(vector); goto OPARG; + case OP_VSETQ: string = "VSETQ\t"; + n = GET_OPARG(vector); + o = MAKE_FIXNUM(GET_OPARG(vector)); + goto OPARG_ARG; case OP_SETQS: string = "SETQS\t"; o = GET_DATA(vector, bytecodes); goto ARG; case OP_PSETQS: string = "PSETQS\t"; o = GET_DATA(vector, bytecodes); goto ARG; + case OP_VSETQS: string = "VSETQS\t"; + n = GET_OPARG(vector); + o = GET_DATA(vector, bytecodes); + goto OPARG_ARG; - case OP_MSETQ: vector = disassemble_msetq(bytecodes, vector); - break; case OP_PROGV: vector = disassemble_progv(bytecodes, vector); break; diff --git a/src/c/interpreter.d b/src/c/interpreter.d index a21761030..1e373a93e 100644 --- a/src/c/interpreter.d +++ b/src/c/interpreter.d @@ -903,11 +903,14 @@ ecl_interpret(cl_object env, cl_object bytecodes, void *pc) } /* OP_SETQ n{arg} OP_PSETQ n{arg} + OP_VSETQ nval{arg}, n{arg} OP_SETQS var-name{symbol} OP_PSETQS var-name{symbol} + OP_VSETQS nval{arg}, var-name{symbol} Sets either the n-th local or a special variable VAR-NAME, - to either the value in REG0 (OP_SETQ[S]) or to the - first value on the stack (OP_PSETQ[S]). + to either the value in REG0 (OP_SETQ[S]), or to the + first value on the stack (OP_PSETQ[S]), or to the appropriate + value of the values list. */ CASE(OP_SETQ); { int lex_env_index = GET_OPARG(vector); @@ -935,6 +938,21 @@ ecl_interpret(cl_object env, cl_object bytecodes, void *pc) ECL_SETQ(var, cl_stack_pop()); THREAD_NEXT; } + CASE(OP_VSETQ); { + int nval = GET_OPARG(vector); + int lex_env_index = GET_OPARG(vector); + ecl_lex_env_set_var(lex_env, lex_env_index, the_env->values[nval]); + THREAD_NEXT; + } + CASE(OP_VSETQS); { + int nval = GET_OPARG(vector); + cl_object var = GET_DATA(vector, bytecodes); + /* INV: Not NIL, and of type t_symbol */ + if (var->symbol.stype & stp_constant) + FEassignment_to_constant(var); + ECL_SETQ(var, the_env->values[nval]); + THREAD_NEXT; + } /* OP_BLOCK label{arg} ... @@ -1048,42 +1066,6 @@ ecl_interpret(cl_object env, cl_object bytecodes, void *pc) the_env->nvalues = 1; THREAD_NEXT; } - /* OP_MSETQ n{arg} - {fixnumn} - ... - {fixnum1} - - Sets N variables to the N values in VALUES(), filling with - NIL when there are values missing. Local variables are denoted - with an integer which points a position in the lexical environment, - while special variables are denoted with a negative index X, which - denotes the value -1-X in the table of constants. - */ - CASE(OP_MSETQ); { - cl_object value; - cl_index i, n = GET_OPARG(vector), nv = the_env->nvalues; - for (i=0; ivalues[i] : Cnil; - if (var >= 0) { - ecl_lex_env_set_var(lex_env, var, value); - } else { - cl_object name = bytecodes->bytecodes.data[-1-var]; - if (Null(name) || (name->symbol.stype & stp_constant)) { - FEassignment_to_constant(name); - } - ECL_SETQ(name, value); - } - } - if (nv == 0) { - the_env->values[0] = reg0 = Cnil; - } else { - reg0 = the_env->values[0]; - } - the_env->nvalues = 1; - THREAD_NEXT; - } - /* OP_PUSHVALUES Pushes the values output by the last form, plus the number of values. diff --git a/src/h/bytecodes.h b/src/h/bytecodes.h index 02d498cb5..006571e1f 100644 --- a/src/h/bytecodes.h +++ b/src/h/bytecodes.h @@ -165,6 +165,8 @@ enum { OP_SETQS, OP_PSETQ, OP_PSETQS, + OP_VSETQ, + OP_VSETQS, OP_BLOCK, OP_DO, OP_CATCH, @@ -174,7 +176,6 @@ enum { OP_PROTECT, OP_PROTECT_NORMAL, OP_PROTECT_EXIT, - OP_MSETQ, OP_PROGV, OP_EXIT_PROGV, OP_PUSHVALUES, @@ -287,6 +288,8 @@ typedef int16_t cl_oparg; &&LBL_OP_SETQS - &&LBL_OP_NOP,\ &&LBL_OP_PSETQ - &&LBL_OP_NOP,\ &&LBL_OP_PSETQS - &&LBL_OP_NOP,\ + &&LBL_OP_VSETQ - &&LBL_OP_NOP,\ + &&LBL_OP_VSETQS - &&LBL_OP_NOP,\ &&LBL_OP_BLOCK - &&LBL_OP_NOP,\ &&LBL_OP_DO - &&LBL_OP_NOP,\ &&LBL_OP_CATCH - &&LBL_OP_NOP,\ @@ -296,7 +299,6 @@ typedef int16_t cl_oparg; &&LBL_OP_PROTECT - &&LBL_OP_NOP,\ &&LBL_OP_PROTECT_NORMAL - &&LBL_OP_NOP,\ &&LBL_OP_PROTECT_EXIT - &&LBL_OP_NOP,\ - &&LBL_OP_MSETQ - &&LBL_OP_NOP,\ &&LBL_OP_PROGV - &&LBL_OP_NOP,\ &&LBL_OP_EXIT_PROGV - &&LBL_OP_NOP,\ &&LBL_OP_PUSHVALUES - &&LBL_OP_NOP,\