mirrors/ecl
1
Fork 0
mirror of https://gitlab.com/embeddable-common-lisp/ecl.git synced 2026-01-18 07:12:26 -08:00
Code Issues Projects Releases Packages Wiki Activity

The ECL_STACK* macros were not hygienic and caused problems due to the duplication of the 'env' name.

Browse source
This commit is contained in:
Juan Jose Garcia Ripoll 2009-02-25 20:15:33 +01:00
parent 8fe85d2e7c
commit 4ffa8552ae
5 changed files with 49 additions and 51 deletions
Download patch file Download diff file Expand all files Collapse all files

9
src/c/compiler.d
View file

@ -63,8 +63,8 @@
#define asm_clear(h) ecl_stack_set_index(ecl_process_env(), h)
#define current_pc() ECL_STACK_INDEX(ecl_process_env())
#define set_pc(n) ecl_stack_set_index(ecl_process_env(), n)
#define asm_op(o) ecl_stack_push(ecl_process_env(), (cl_object)((cl_fixnum)(o)))
#define asm_ref(n) (cl_fixnum)(ecl_process_env()->stack[n])
static void asm_op(cl_fixnum op);
static void asm_op2(int op, int arg);
static cl_object asm_end(cl_index handle);
static cl_index asm_jmp(register int op);
@ -196,6 +196,13 @@ asm_arg(int n) {
#define asm_arg(n) asm_op(n)
#endif
static void
asm_op(cl_fixnum code) {
const cl_env_ptr env = ecl_process_env();
cl_object v = (cl_object)code;
ECL_STACK_PUSH(env,v);
}
static void
asm_op2(register int code, register int n) {
if (n < -MAX_OPARG || MAX_OPARG < n)

42
src/c/interpreter.d
View file

@ -23,7 +23,7 @@
/* -------------------- INTERPRETER STACK -------------------- */
void
cl_object *
ecl_stack_set_size(cl_env_ptr env, cl_index tentative_new_size)
{
cl_index top = env->stack_top - env->stack;
@ -52,6 +52,7 @@ ecl_stack_set_size(cl_env_ptr env, cl_index tentative_new_size)
*/
if (top == 0)
ecl_stack_push(env, MAKE_FIXNUM(0));
return env->stack_top;
}
void
@ -66,10 +67,10 @@ FEstack_advance(void)
FEerror("Internal error: stack advance beyond current point.",0);
}
void
cl_object *
ecl_stack_grow(cl_env_ptr env)
{
ecl_stack_set_size(env, env->stack_size + env->stack_size / 2);
return ecl_stack_set_size(env, env->stack_size + env->stack_size / 2);
}
void
@ -305,15 +306,6 @@ close_around(cl_object fun, cl_object lex) {
return v;
}
/*
* Manipulation of the interpreter stack. As shown here, we omit may
* security checks, assuming that the interpreted code is consistent.
* This is done for performance reasons, but could probably be undone
* using a configuration flag.
*/
#define STACK_REF(the_env,n) (the_env->stack_top[n])
#define SETUP_ENV(the_env) { ihs.lex_env = lex_env; }
/*
@ -534,7 +526,7 @@ ecl_interpret(cl_object frame, cl_object env, cl_object bytecodes, cl_index offs
*/
CASE(OP_FCALL); {
GET_OPARG(narg, vector);
reg0 = STACK_REF(the_env,-narg-1);
reg0 = ECL_STACK_REF(the_env,-narg-1);
goto DO_CALL;
}
@ -544,7 +536,7 @@ ecl_interpret(cl_object frame, cl_object env, cl_object bytecodes, cl_index offs
*/
CASE(OP_MCALL); {
narg = fix(ECL_STACK_POP_UNSAFE(the_env));
reg0 = STACK_REF(the_env,-narg-1);
reg0 = ECL_STACK_REF(the_env,-narg-1);
goto DO_CALL;
}
@ -1071,8 +1063,8 @@ ecl_interpret(cl_object frame, cl_object env, cl_object bytecodes, cl_index offs
THREAD_NEXT;
} else {
reg0 = the_env->values[0];
vector = (cl_opcode *)STACK_REF(the_env,-1); /* FIXME! */
lex_env = STACK_REF(the_env,-2);
vector = (cl_opcode *)ECL_STACK_REF(the_env,-1); /* FIXME! */
lex_env = ECL_STACK_REF(the_env,-2);
goto DO_EXIT_FRAME;
}
}
@ -1101,8 +1093,8 @@ ecl_interpret(cl_object frame, cl_object env, cl_object bytecodes, cl_index offs
to ntags-1, depending on the tag. These
numbers are indices into the jump table and
are computed at compile time. */
cl_opcode *table = (cl_opcode *)STACK_REF(the_env,-1);
lex_env = STACK_REF(the_env,-2);
cl_opcode *table = (cl_opcode *)ECL_STACK_REF(the_env,-1);
lex_env = ECL_STACK_REF(the_env,-2);
table = table + fix(the_env->values[0]) * OPARG_SIZE;
vector = table + *(cl_oparg *)table;
}
@ -1140,20 +1132,20 @@ ecl_interpret(cl_object frame, cl_object env, cl_object bytecodes, cl_index offs
cl_index i = the_env->nvalues;
ECL_STACK_PUSH_N(the_env, i+1);
the_env->values[0] = reg0;
memcpy(&STACK_REF(the_env, -(i+1)), the_env->values, i * sizeof(cl_object));
STACK_REF(the_env, -1) = MAKE_FIXNUM(the_env->nvalues);
memcpy(&ECL_STACK_REF(the_env, -(i+1)), the_env->values, i * sizeof(cl_object));
ECL_STACK_REF(the_env, -1) = MAKE_FIXNUM(the_env->nvalues);
THREAD_NEXT;
}
/* OP_PUSHMOREVALUES
Adds more values to the ones pushed by OP_PUSHVALUES.
*/
CASE(OP_PUSHMOREVALUES); {
cl_index n = fix(STACK_REF(the_env,-1));
cl_index n = fix(ECL_STACK_REF(the_env,-1));
cl_index i = the_env->nvalues;
ECL_STACK_PUSH_N(the_env, i);
the_env->values[0] = reg0;
memcpy(&STACK_REF(the_env, -(i+1)), the_env->values, i * sizeof(cl_object));
STACK_REF(the_env, -1) = MAKE_FIXNUM(n + i);
memcpy(&ECL_STACK_REF(the_env, -(i+1)), the_env->values, i * sizeof(cl_object));
ECL_STACK_REF(the_env, -1) = MAKE_FIXNUM(n + i);
THREAD_NEXT;
}
/* OP_POPVALUES
@ -1170,7 +1162,7 @@ ecl_interpret(cl_object frame, cl_object env, cl_object bytecodes, cl_index offs
THREAD_NEXT;
} else {
ECL_STACK_POP_N_UNSAFE(the_env,n);
memcpy(dest, &STACK_REF(the_env,0), n * sizeof(cl_object));
memcpy(dest, &ECL_STACK_REF(the_env,0), n * sizeof(cl_object));
reg0 = *dest;
THREAD_NEXT;
}
@ -1184,7 +1176,7 @@ ecl_interpret(cl_object frame, cl_object env, cl_object bytecodes, cl_index offs
GET_OPARG(n, vector);
the_env->nvalues = n;
ECL_STACK_POP_N_UNSAFE(the_env, n);
memcpy(the_env->values, &STACK_REF(the_env, 0), n * sizeof(cl_object));
memcpy(the_env->values, &ECL_STACK_REF(the_env, 0), n * sizeof(cl_object));
reg0 = the_env->values[0];
THREAD_NEXT;
}

4
src/h/external.h
View file

@ -475,10 +475,10 @@ extern ECL_API void ecl_stack_frame_close(cl_object f);
extern ECL_API void FEstack_underflow(void);
extern ECL_API void FEstack_advance(void);
extern ECL_API void ecl_stack_grow(cl_env_ptr env);
extern ECL_API cl_object *ecl_stack_grow(cl_env_ptr env);
extern ECL_API void ecl_stack_push(cl_env_ptr env, cl_object o);
extern ECL_API cl_object ecl_stack_pop(cl_env_ptr env);
extern ECL_API void ecl_stack_set_size(cl_env_ptr env, cl_index new_size);
extern ECL_API cl_object *ecl_stack_set_size(cl_env_ptr env, cl_index new_size);
extern ECL_API void ecl_stack_set_index(cl_env_ptr env, cl_index sp);
extern ECL_API void ecl_stack_pop_n(cl_env_ptr env, cl_index n);
extern ECL_API void ecl_stack_insert(cl_env_ptr env, cl_index where, cl_index n);

2
src/h/internal.h
View file

@ -91,8 +91,6 @@ typedef struct cl_compiler_env *cl_compiler_env_ptr;
/* interpreter.d */
#define ecl_stack_ref(env,n) (env)->stack[n]
#define ECL_BUILD_STACK_FRAME(env,name,frame) \
struct ecl_stack_frame frame;\
cl_object name = ecl_stack_frame_open(env, (cl_object)&frame, 0);

43
src/h/stacks.h
View file

@ -216,41 +216,42 @@ extern ECL_API ecl_frame_ptr _ecl_frs_push(register cl_env_ptr, register cl_obje
#define ECL_STACK_INDEX(env) ((env)->stack_top - (env)->stack)
#define ECL_STACK_PUSH(the_env,o) do { \
const cl_env_ptr env = (the_env); \
cl_object *new_top = env->stack_top; \
if (new_top >= env->stack_limit) { \
ecl_stack_grow(env); \
} \
*new_top = (o); \
env->stack_top = new_top+1; } while (0)
#define ECL_STACK_PUSH(the_env,o) do { \
const cl_env_ptr __env = (the_env); \
cl_object *__new_top = __env->stack_top; \
if (__new_top >= __env->stack_limit) { \
__new_top = ecl_stack_grow(__env); \
} \
*__new_top = (o); \
__env->stack_top = __new_top+1; } while (0)
#define ECL_STACK_POP_UNSAFE(env) *(--((env)->stack_top))
#define ECL_STACK_REF(env,n) ((env)->stack_top[n])
#define ECL_STACK_SET_INDEX(the_env,ndx) do { \
const cl_env_ptr env = the_env; \
cl_object *new_top = env->stack + (ndx); \
if (new_top >= env->stack_top) \
const cl_env_ptr __env = the_env; \
cl_object *__new_top = __env->stack + (ndx); \
if (__new_top >= __env->stack_top) \
FEstack_advance(); \
env->stack_top = new_top; } while (0)
__env->stack_top = __new_top; } while (0)
#define ECL_STACK_POP_N(the_env,n) do { \
const cl_env_ptr env = (the_env); \
cl_object *new_top = env->stack_top - (n); \
if (new_top < env->stack) FEstack_underflow(); \
env->stack_top = new_top; } while (0)
const cl_env_ptr __env = (the_env); \
cl_object *__new_top = __env->stack_top - (n); \
if (__new_top < __env->stack) FEstack_underflow(); \
__env->stack_top = __new_top; } while (0)
#define ECL_STACK_POP_N_UNSAFE(the_env,n) ((the_env)->stack_top -= (n))
#define ECL_STACK_PUSH_N(the_env,n) do { \
const cl_env_ptr env = (the_env) ; \
cl_index aux = (n); \
while ((env->stack_limit - env->stack_top) <= aux) { \
ecl_stack_grow(env); \
const cl_env_ptr __env = (the_env) ; \
cl_index __aux = (n); \
cl_object *__new_top = __env->stack_top; \
while ((__env->stack_limit - __new_top) <= __aux) { \
__new_top = ecl_stack_grow(__env); \
} \
env->stack_top += aux; } while (0)
__env->stack_top = __new_top + __aux; } while (0)
/*********************************
* HIGH LEVEL CONTROL STRUCTURES *