mirrors/ecl
1
Fork 0
mirror of https://gitlab.com/embeddable-common-lisp/ecl.git synced 2026-01-14 21:32:49 -08:00
Code Issues Projects Releases Packages Wiki Activity

The generation of new block ids is now thread safe.

Browse source
This commit is contained in:
Juan Jose Garcia Ripoll 2009-02-21 23:26:42 +01:00
parent 8004e7e027
commit c6fe981f87
6 changed files with 15 additions and 21 deletions
Download patch file Download diff file Expand all files Collapse all files

6
src/c/interpreter.d
View file

@ -625,7 +625,7 @@ ecl_interpret(cl_object frame, cl_object env, cl_object bytecodes, cl_index offs
default:
FEinvalid_function(reg0);
}
the_env->stack_top -= narg;
STACK_POP_N(the_env, narg);
THREAD_NEXT;
}
@ -1073,13 +1073,13 @@ ecl_interpret(cl_object frame, cl_object env, cl_object bytecodes, cl_index offs
CASE(OP_BLOCK); {
GET_DATA(reg0, vector, data);
reg1 = new_frame_id();
reg1 = MAKE_FIXNUM(the_env->frame_id++);
lex_env = bind_frame(lex_env, reg1, reg0);
THREAD_NEXT;
}
CASE(OP_DO); {
reg0 = Cnil;
reg1 = new_frame_id();
reg1 = MAKE_FIXNUM(the_env->frame_id++);
lex_env = bind_frame(lex_env, reg1, reg0);
THREAD_NEXT;
}

8
src/c/stacks.d
View file

@ -339,14 +339,6 @@ si_ihs_env(cl_object arg)
/********************** FRAME STACK *************************/
static int frame_id = 0;
cl_object
new_frame_id(void)
{
return MAKE_FIXNUM(frame_id++);
}
static void
frs_set_size(cl_env_ptr env, cl_index size)
{

2
src/cmp/cmpblock.lsp
View file

@ -59,7 +59,7 @@
(let ((env-lvl *env-lvl*))
(wt-nl *volatile* "cl_object env" (incf *env-lvl*)
" = env" env-lvl ";")))
(bind "new_frame_id()" blk-var)
(bind "ECL_NEW_FRAME_ID(cl_env_copy)" blk-var)
(wt-nl "if (ecl_frs_push(cl_env_copy," blk-var ")!=0) {")
(let ((*unwind-exit* (cons 'FRAME *unwind-exit*)))
(unwind-exit 'VALUES)

2
src/cmp/cmptag.lsp
View file

@ -149,7 +149,7 @@
(setf (var-loc tag-loc) (next-lcl))
(wt-nl "{ cl_object " tag-loc ";")
(setq env-grows t)) ; just to ensure closing the block
(bind "new_frame_id()" tag-loc)
(bind "ECL_NEW_FRAME_ID(cl_env_copy)" tag-loc)
(wt-nl "if (ecl_frs_push(cl_env_copy," tag-loc ")) {")
;; Allocate labels.
(dolist (tag body)

10
src/h/external.h
View file

@ -13,6 +13,10 @@ struct cl_env_struct {
/* Flag for disabling interrupts while we call C library functions. */
volatile int disable_interrupts;
/* Array where values are returned by functions. */
cl_index nvalues;
cl_object values[ECL_MULTIPLE_VALUES_LIMIT];
/* Environment for calling closures, CLOS generic functions, etc */
cl_object function;
@ -54,6 +58,7 @@ struct cl_env_struct {
struct ecl_frame *frs_top;
struct ecl_frame *frs_limit;
struct ecl_frame *nlj_fr;
cl_index frame_id;
/*
* The following pointers to the C Stack are used to ensure that a
@ -66,10 +71,6 @@ struct cl_env_struct {
cl_fixnum *cs_barrier;
cl_index cs_size;
/* Array where values are returned by functions. */
cl_index nvalues;
cl_object values[ECL_MULTIPLE_VALUES_LIMIT];
/* Private variables used by different parts of ECL: */
/* ... the reader ... */
cl_object string_pool;
@ -1362,7 +1363,6 @@ extern ECL_API void ecl_bds_unwind(cl_env_ptr env, cl_index new_bds_top_index);
extern ECL_API void ecl_unwind(cl_env_ptr env, ecl_frame_ptr fr) /*__attribute__((noreturn))*/;
extern ECL_API ecl_frame_ptr frs_sch(cl_object frame_id);
extern ECL_API ecl_frame_ptr frs_sch_catch(cl_object frame_id);
extern ECL_API cl_object new_frame_id(void);
/* string.c */

8
src/h/stacks.h
View file

@ -238,9 +238,11 @@ extern ECL_API ecl_frame_ptr _ecl_frs_push(register cl_env_ptr, register cl_obje
ecl_stack_pop_values(__the_env,__nr); \
if (__unwinding) ecl_unwind(__the_env,__next_fr); } while(0)
#define CL_BLOCK_BEGIN(the_env,id) do { \
const cl_object __id = new_frame_id(); \
const cl_env_ptr __the_env = (the_env); \
#define ECL_NEW_FRAME_ID(env) MAKE_FIXNUM(env->frame_id++)
#define CL_BLOCK_BEGIN(the_env,id) do { \
const cl_object __id = ECL_NEW_FRAME_ID(the_env); \
const cl_env_ptr __the_env = (the_env); \
if (ecl_frs_push(__the_env,__id) == 0)
#define CL_BLOCK_END \