mirror of
https://gitlab.com/embeddable-common-lisp/ecl.git
synced 2026-01-01 23:30:40 -08:00
Split operator MSETQ into VSETQ and VSETQS.
This commit is contained in:
jjgarcia
parent
5aa07e402d
commit
ce724349c5
4 changed files with 49 additions and 90 deletions
|
|
@ -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;
|
||||
}
|
||||
|
||||
/*
|
||||
|
|
|
|||
|
|
@ -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<n; i++) {
|
||||
cl_fixnum var = GET_OPARG(vector);
|
||||
if (newline) {
|
||||
print_noarg("\n\t");
|
||||
} else
|
||||
newline = TRUE;
|
||||
if (var >= 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;
|
||||
|
||||
|
|
|
|||
|
|
@ -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; i<n; i++) {
|
||||
cl_fixnum var = GET_OPARG(vector);
|
||||
value = (i < nv) ? the_env->values[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.
|
||||
|
|
|
|||
|
|
@ -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,\
|
||||
|
|
|
|||
Loading…
Add table
Add a link
Reference in a new issue