mirrors/ecl
1
Fork 0
mirror of https://gitlab.com/embeddable-common-lisp/ecl.git synced 2026-01-17 23:02:31 -08:00
Code Issues Projects Releases Packages Wiki Activity

ihs_push now requires the lisp environment.

Browse source
This commit is contained in:
Juan Jose Garcia Ripoll 2008-10-13 22:48:37 +02:00
parent 46aa17b1d9
commit 7452875f32
4 changed files with 17 additions and 12 deletions
Download patch file Download diff file Expand all files Collapse all files

4
src/c/compiler.d
View file

@ -2761,7 +2761,7 @@ si_make_lambda(cl_object name, cl_object rest)
/*
* Interpret using the given lexical environment.
*/
ihs_push(&ihs, bytecodes, Cnil);
ecl_ihs_push(the_env, &ihs, bytecodes, Cnil);
VALUES(0) = Cnil;
NVALUES = 0;
{
@ -2771,7 +2771,7 @@ si_make_lambda(cl_object name, cl_object rest)
GC_free(bytecodes->bytecodes.data);
GC_free(bytecodes);
#endif
ihs_pop();
ecl_ihs_pop(the_env);
return output;
}
@)

4
src/c/interpreter.d
View file

@ -506,7 +506,7 @@ ecl_interpret(cl_object frame, cl_object env, cl_object bytecodes, cl_index offs
if (type_of(bytecodes) != t_bytecodes)
FEinvalid_function(bytecodes);
ihs_push(&ihs, bytecodes, lex_env);
ecl_ihs_push(the_env, &ihs, bytecodes, lex_env);
frame_aux.t = t_frame;
frame_aux.stack = frame_aux.top = frame_aux.bottom = 0;
reg0 = Cnil;
@ -782,7 +782,7 @@ ecl_interpret(cl_object frame, cl_object env, cl_object bytecodes, cl_index offs
or a function.
*/
CASE(OP_EXIT); {
ihs_pop();
ecl_ihs_pop(the_env);
ecl_bds_unwind(the_env, old_bds_top_index);
return reg0;
}

2
src/cmp/cmptop.lsp
View file

@ -626,7 +626,7 @@
;; name into the invocation stack
(when (>= (fun-debug fun) 2)
(push 'IHS *unwind-exit*)
(wt-nl "ihs_push(&ihs," (add-symbol (fun-name fun)) ",Cnil);"))
(wt-nl "ihs_push(cl_env_copy,&ihs," (add-symbol (fun-name fun)) ",Cnil);"))
(c2lambda-expr (c1form-arg 0 lambda-expr)
(c1form-arg 2 lambda-expr)

19
src/h/stacks.h
View file

@ -89,15 +89,20 @@ typedef struct ihs_frame {
cl_index index;
} *ihs_ptr;
#define ihs_push(r,f,e) do { \
(r)->next=cl_env.ihs_top; (r)->function=(f); (r)->lex_env=(e); \
(r)->index=cl_env.ihs_top->index+1;\
cl_env.ihs_top = (r); \
#define ecl_ihs_push(env,rec,fun,lisp_env) do { \
const cl_env_ptr __the_env = (env); \
struct ihs_frame * const r = (rec); \
r->next=__the_env->ihs_top; \
r->function=(fun); \
r->lex_env=(lisp_env); \
r->index=__the_env->ihs_top->index+1; \
__the_env->ihs_top = r; \
} while(0)
#define ihs_pop() do {\
if (cl_env.ihs_top->next == NULL) ecl_internal_error("Underflow in IHS stack"); \
cl_env.ihs_top = cl_env.ihs_top->next; \
#define ecl_ihs_pop(env) do { \
const cl_env_ptr __the_env = (env); \
struct ihs_frame *r = __the_env->ihs_top; \
if (r) __the_env->ihs_top = r->next; \
} while(0)
extern ECL_API cl_object ihs_top_function_name(void);