mirrors/ecl
1
Fork 0
mirror of https://gitlab.com/embeddable-common-lisp/ecl.git synced 2026-01-15 05:43:19 -08:00
Code Issues Projects Releases Packages Wiki Activity

Prefix the block creation macros, ECL_BLOCK_*, etc

Browse source
This commit is contained in:
Juan Jose Garcia-Ripoll 2012-06-30 12:01:44 +02:00
parent 8441a08c97
commit efadef99dc
13 changed files with 74 additions and 64 deletions
Download patch file Download diff file Expand all files Collapse all files

6
src/c/alloc_2.d
View file

@ -101,7 +101,7 @@ out_of_memory(size_t requested_bytes)
/* But then we have to ensure the error has not been solved */
#ifdef ECL_THREADS
mp_get_lock_wait(cl_core.error_lock);
CL_UNWIND_PROTECT_BEGIN(the_env)
ECL_UNWIND_PROTECT_BEGIN(the_env)
#endif
{
failure = 0;
@ -138,10 +138,10 @@ out_of_memory(size_t requested_bytes)
(void)0;
}
#ifdef ECL_THREADS
CL_UNWIND_PROTECT_EXIT {
ECL_UNWIND_PROTECT_EXIT {
mp_giveup_lock(cl_core.error_lock);
ecl_enable_interrupts_env(the_env);
} CL_UNWIND_PROTECT_END;
} ECL_UNWIND_PROTECT_END;
#else
ecl_enable_interrupts_env(the_env);
#endif

4
src/c/cinit.d
View file

@ -110,7 +110,7 @@ static cl_object si_simple_toplevel ()
int i;
/* Simple minded top level loop */
CL_CATCH_ALL_BEGIN(env) {
ECL_CATCH_ALL_BEGIN(env) {
writestr_stream(";*** Lisp core booted ****\n"
"ECL (Embeddable Common Lisp)\n",
output);
@ -127,7 +127,7 @@ static cl_object si_simple_toplevel ()
sentence = si_eval_with_env(1, sentence);
ecl_prin1(sentence, output);
}
} CL_CATCH_ALL_END;
} ECL_CATCH_ALL_END;
}
int

12
src/c/compiler.d
View file

@ -3079,11 +3079,11 @@ si_make_lambda(cl_object name, cl_object rest)
struct cl_compiler_env new_c_env;
c_new_env(the_env, &new_c_env, Cnil, 0);
CL_UNWIND_PROTECT_BEGIN(the_env) {
ECL_UNWIND_PROTECT_BEGIN(the_env) {
lambda = ecl_make_lambda(the_env, name, rest);
} CL_UNWIND_PROTECT_EXIT {
} ECL_UNWIND_PROTECT_EXIT {
the_env->c_env = old_c_env;
} CL_UNWIND_PROTECT_END;
} ECL_UNWIND_PROTECT_END;
@(return lambda)
}
@ -3108,7 +3108,7 @@ si_make_lambda(cl_object name, cl_object rest)
guess_environment(the_env, interpreter_env);
new_c_env.lex_env = env;
new_c_env.stepping = stepping != Cnil;
CL_UNWIND_PROTECT_BEGIN(the_env) {
ECL_UNWIND_PROTECT_BEGIN(the_env) {
if (Null(execute)) {
cl_index handle = asm_begin(the_env);
new_c_env.mode = FLAG_LOAD;
@ -3120,11 +3120,11 @@ si_make_lambda(cl_object name, cl_object rest)
} else {
eval_form(the_env, form);
}
} CL_UNWIND_PROTECT_EXIT {
} ECL_UNWIND_PROTECT_EXIT {
/* Clear up */
the_env->c_env = old_c_env;
memset(&new_c_env, 0, sizeof(new_c_env));
} CL_UNWIND_PROTECT_END;
} ECL_UNWIND_PROTECT_END;
return the_env->values[0];
@)

6
src/c/ffi.d
View file

@ -705,7 +705,7 @@ si_load_foreign_module(cl_object filename)
# ifdef ECL_THREADS
mp_get_lock(1, ecl_symbol_value(@'mp::+load-compile-lock+'));
CL_UNWIND_PROTECT_BEGIN(ecl_process_env()) {
ECL_UNWIND_PROTECT_BEGIN(ecl_process_env()) {
# endif
output = ecl_library_open(filename, 0);
if (output->cblock.handle == NULL) {
@ -714,9 +714,9 @@ si_load_foreign_module(cl_object filename)
}
# ifdef ECL_THREADS
(void)0; /* MSVC complains about missing ';' before '}' */
} CL_UNWIND_PROTECT_EXIT {
} ECL_UNWIND_PROTECT_EXIT {
mp_giveup_lock(ecl_symbol_value(@'mp::+load-compile-lock+'));
} CL_UNWIND_PROTECT_END;
} ECL_UNWIND_PROTECT_END;
# endif
if (ecl_unlikely(type_of(output) != t_codeblock)) {
FEerror("LOAD-FOREIGN-MODULE: Could not load "

12
src/c/load.d
View file

@ -101,7 +101,7 @@ si_load_source(cl_object source, cl_object verbose, cl_object print, cl_object e
if (Null(strm))
@(return Cnil)
}
CL_UNWIND_PROTECT_BEGIN(the_env) {
ECL_UNWIND_PROTECT_BEGIN(the_env) {
cl_object form_index = ecl_make_fixnum(0);
cl_object pathname = ECL_SYM_VAL(the_env, @'*load-pathname*');
cl_object location = CONS(pathname, form_index);
@ -121,14 +121,14 @@ si_load_source(cl_object source, cl_object verbose, cl_object print, cl_object e
}
}
ecl_bds_unwind1(the_env);
} CL_UNWIND_PROTECT_EXIT {
} ECL_UNWIND_PROTECT_EXIT {
/* We do not want to come back here if close_stream fails,
therefore, first we frs_pop() current jump point, then
try to close the stream, and then jump to next catch
point */
if (strm != source)
cl_close(3, strm, @':abort', @'t');
} CL_UNWIND_PROTECT_END;
} ECL_UNWIND_PROTECT_END;
@(return Cnil)
}
@ -150,7 +150,7 @@ si_load_bytecodes(cl_object source, cl_object verbose, cl_object print, cl_objec
if (Null(strm))
@(return Cnil)
}
CL_UNWIND_PROTECT_BEGIN(env) {
ECL_UNWIND_PROTECT_BEGIN(env) {
{
cl_object progv_list = ECL_SYM_VAL(env, @'si::+ecl-syntax-progv-list+');
cl_index bds_ndx = ecl_progv(env, ECL_CONS_CAR(progv_list),
@ -185,14 +185,14 @@ si_load_bytecodes(cl_object source, cl_object verbose, cl_object print, cl_objec
2, x, source);
}
}
} CL_UNWIND_PROTECT_EXIT {
} ECL_UNWIND_PROTECT_EXIT {
/* We do not want to come back here if close_stream fails,
therefore, first we frs_pop() current jump point, then
try to close the stream, and then jump to next catch
point */
if (strm != source)
cl_close(3, strm, @':abort', @'t');
} CL_UNWIND_PROTECT_END;
} ECL_UNWIND_PROTECT_END;
@(return Cnil)
}

6
src/c/read.d
View file

@ -2268,7 +2268,7 @@ ecl_init_module(cl_object block, void (*entry_point)(cl_object))
block->cblock.entry = entry_point;
in = OBJNULL;
CL_UNWIND_PROTECT_BEGIN(env) {
ECL_UNWIND_PROTECT_BEGIN(env) {
cl_index bds_ndx;
cl_object progv_list;
@ -2398,12 +2398,12 @@ ecl_init_module(cl_object block, void (*entry_point)(cl_object))
ecl_dealloc(VVtemp);
}
ecl_bds_unwind1(env);
} CL_UNWIND_PROTECT_EXIT {
} ECL_UNWIND_PROTECT_EXIT {
if (in != OBJNULL)
cl_close(1,in);
env->packages_to_be_created = old_eptbc;
env->packages_to_be_created_p = Cnil;
} CL_UNWIND_PROTECT_END;
} ECL_UNWIND_PROTECT_END;
return block;
}

8
src/c/threads/process.d
View file

@ -254,7 +254,7 @@ thread_entry_point(void *arg)
* provides us with an elegant way to exit the thread: we just
* do an unwind up to frs_top.
*/
CL_CATCH_ALL_BEGIN(env) {
ECL_CATCH_ALL_BEGIN(env) {
#ifdef HAVE_SIGPROCMASK
{
sigset_t *new = (sigset_t*)env->default_sigmask;
@ -279,7 +279,7 @@ thread_entry_point(void *arg)
* so that the unwinding is not interrupted. */
process->process.phase = ECL_PROCESS_EXITING;
ecl_bds_unwind1(env);
} CL_CATCH_ALL_END;
} ECL_CATCH_ALL_END;
/* 4) If everything went right, we should be exiting the thread
* through this point. thread_cleanup is automatically invoked
@ -420,11 +420,11 @@ cl_object
mp_suspend_loop()
{
cl_env_ptr env = ecl_process_env();
CL_CATCH_BEGIN(env,@'mp::suspend-loop') {
ECL_CATCH_BEGIN(env,@'mp::suspend-loop') {
for ( ; ; ) {
cl_sleep(ecl_make_fixnum(100));
}
} CL_CATCH_END;
} ECL_CATCH_END;
ecl_return0(env);
}

12
src/c/threads/queue.d
View file

@ -153,7 +153,7 @@ ecl_wait_on_timed(cl_env_ptr env, cl_object (*condition)(cl_env_ptr, cl_object),
}
ecl_bds_bind(the_env, @'ext::*interrupts-enabled*', Cnil);
CL_UNWIND_PROTECT_BEGIN(the_env) {
ECL_UNWIND_PROTECT_BEGIN(the_env) {
/* 2) Now we add ourselves to the queue. In order to
* avoid a call to the GC, we try to reuse records. */
print_lock("adding to queue", o);
@ -171,7 +171,7 @@ ecl_wait_on_timed(cl_env_ptr env, cl_object (*condition)(cl_env_ptr, cl_object),
ecl_musleep(waiting_time(iteration++, &start), 1);
} while (Null(output = condition(the_env, o)));
ecl_bds_unwind1(the_env);
} CL_UNWIND_PROTECT_EXIT {
} ECL_UNWIND_PROTECT_EXIT {
/* 4) At this point we wrap up. We remove ourselves
* from the queue and unblock the lisp interrupt
* signal. Note that we recover the cons for later use.*/
@ -191,7 +191,7 @@ ecl_wait_on_timed(cl_env_ptr env, cl_object (*condition)(cl_env_ptr, cl_object),
if (/*Null(output) &&*/ (firstone == record)) {
ecl_wakeup_waiters(the_env, o, ECL_WAKEUP_ONE);
}
} CL_UNWIND_PROTECT_END;
} ECL_UNWIND_PROTECT_END;
ecl_bds_unwind1(the_env);
return output;
}
@ -257,7 +257,7 @@ ecl_wait_on(cl_env_ptr env, cl_object (*condition)(cl_env_ptr, cl_object), cl_ob
/* 2) Now we add ourselves to the queue. */
wait_queue_nconc(the_env, o, record);
CL_UNWIND_PROTECT_BEGIN(the_env) {
ECL_UNWIND_PROTECT_BEGIN(the_env) {
/* 3) At this point we may receive signals, but we
* might have missed a wakeup event if that happened
* between 0) and 2), which is why we start with the
@ -277,7 +277,7 @@ ecl_wait_on(cl_env_ptr env, cl_object (*condition)(cl_env_ptr, cl_object), cl_ob
sigsuspend(&original);
} while (Null(output = condition(the_env, o)));
}
} CL_UNWIND_PROTECT_EXIT {
} ECL_UNWIND_PROTECT_EXIT {
/* 4) At this point we wrap up. We remove ourselves
* from the queue and unblock the lisp interrupt
* signal. Note that we recover the cons for later use.*/
@ -301,7 +301,7 @@ ecl_wait_on(cl_env_ptr env, cl_object (*condition)(cl_env_ptr, cl_object), cl_ob
/* 6) Restoring signals is done last, to ensure that
* all cleanup steps are performed. */
pthread_sigmask(SIG_SETMASK, &original, NULL);
} CL_UNWIND_PROTECT_END;
} ECL_UNWIND_PROTECT_END;
return output;
#else
return ecl_wait_on_timed(env, condition, o);

4
src/c/unixint.d
View file

@ -1153,7 +1153,7 @@ asynchronous_signal_servicing_thread()
sigaddset(&handled_set, interrupt_signal);
pthread_sigmask(SIG_SETMASK, &handled_set, NULL);
}
CL_CATCH_ALL_BEGIN(the_env) {
ECL_CATCH_ALL_BEGIN(the_env) {
for (;;) {
/* Waiting may fail! */
int status = sigwait(&handled_set, &signo);
@ -1193,7 +1193,7 @@ asynchronous_signal_servicing_thread()
}
}
}
} CL_CATCH_ALL_END;
} ECL_CATCH_ALL_END;
ecl_return0(the_env);
}
#endif

12
src/cmp/cmpmain.lsp
View file

@ -279,11 +279,11 @@ extern int
main(int argc, char **argv)
{
cl_boot(argc, argv);
CL_CATCH_ALL_BEGIN(ecl_process_env()) {
ECL_CATCH_ALL_BEGIN(ecl_process_env()) {
~A
ecl_init_module(OBJNULL, ~A);
~A
} CL_CATCH_ALL_END;
} ECL_CATCH_ALL_END;
si_exit(0);
}")
@ -292,11 +292,11 @@ extern int
~A(int argc, char **argv)
{
cl_boot(argc, argv);
CL_CATCH_ALL_BEGIN(ecl_process_env()) {
ECL_CATCH_ALL_BEGIN(ecl_process_env()) {
~A
ecl_init_module(OBJNULL, ~A);
~A
} CL_CATCH_ALL_END;
} ECL_CATCH_ALL_END;
}")
#+:win32
@ -309,11 +309,11 @@ WinMain(HINSTANCE hInstance, HINSTANCE hPrevInstance, LPSTR lpCmdLine, int nCmdS
int argc;
ecl_get_commandline_args(&argc, &argv);
cl_boot(argc, argv);
CL_CATCH_ALL_BEGIN(ecl_process_env()) {
ECL_CATCH_ALL_BEGIN(ecl_process_env()) {
~A
ecl_init_module(OBJNULL, ~A);
~A
} CL_CATCH_ALL_END;
} ECL_CATCH_ALL_END;
si_exit(0);
}")

13
src/h/internal.h
View file

@ -395,12 +395,12 @@ extern void cl_write_object(cl_object x, cl_object stream);
const cl_object __ecl_the_lock = lock; \
ecl_disable_interrupts_env(the_env); \
mp_get_lock_wait(__ecl_the_lock); \
CL_UNWIND_PROTECT_BEGIN(__ecl_the_env); \
ECL_UNWIND_PROTECT_BEGIN(__ecl_the_env); \
ecl_enable_interrupts_env(__ecl_the_env);
# define ECL_WITH_LOCK_END \
CL_UNWIND_PROTECT_EXIT { \
ECL_UNWIND_PROTECT_EXIT { \
mp_giveup_lock(__ecl_the_lock); \
} CL_UNWIND_PROTECT_END; }
} ECL_UNWIND_PROTECT_END; }
# define ECL_WITH_SPINLOCK_BEGIN(the_env,lock) { \
const cl_env_ptr __ecl_the_env = (the_env); \
cl_object *__ecl_the_lock = (lock); \
@ -456,6 +456,13 @@ extern cl_object ecl_deserialize(uint8_t *data);
#define ecl_vector_start_end ecl_sequence_start_end
/* stacks.d */
#define CL_NEWENV_BEGIN {\
const cl_env_ptr the_env = ecl_process_env(); \
cl_index __i = ecl_stack_push_values(the_env); \
#define CL_NEWENV_END \
ecl_stack_pop_values(the_env,__i); }
extern void ecl_cs_set_org(cl_env_ptr env);
/* threads.d */

10
src/h/legacy.h
View file

@ -143,3 +143,13 @@
#define return0() return ((NVALUES = 0),Cnil)
#define return1(x) return ((VALUES(0)=(x)),(NVALUES=1),VALUES(0))
#define returnn(x) return x
#define CL_UNWIND_PROTECT_BEGIN ECL_UNWIND_PROTECT_BEGIN
#define CL_UNWIND_PROTECT_END ECL_UNWIND_PROTECT_END
#define CL_UNWIND_PROTECT_EXIT ECL_UNWIND_PROTECT_EXIT
#define CL_BLOCK_END ECL_BLOCK_END
#define CL_BLOCK_BEGIN ECL_BLOCK_BEGIN
#define CL_CATCH_BEGIN ECL_CATCH_BEGIN
#define CL_CATCH_END ECL_CATCH_END
#define CL_CATCH_ALL_BEGIN ECL_CATCH_ALL_BEGIN
#define CL_CATCH_ALL_END ECL_CATCH_ALL_END

33
src/h/stacks.h
View file

@ -382,14 +382,7 @@ extern ECL_API ecl_frame_ptr _ecl_frs_push(register cl_env_ptr, register cl_obje
* HIGH LEVEL CONTROL STRUCTURES *
*********************************/
#define CL_NEWENV_BEGIN {\
const cl_env_ptr the_env = ecl_process_env(); \
cl_index __i = ecl_stack_push_values(the_env); \
#define CL_NEWENV_END \
ecl_stack_pop_values(the_env,__i); }
#define CL_UNWIND_PROTECT_BEGIN(the_env) do { \
#define ECL_UNWIND_PROTECT_BEGIN(the_env) do { \
bool __unwinding; ecl_frame_ptr __next_fr; \
const cl_env_ptr __the_env = (the_env); \
cl_index __nr; \
@ -397,49 +390,49 @@ extern ECL_API ecl_frame_ptr _ecl_frs_push(register cl_env_ptr, register cl_obje
__unwinding=1; __next_fr=__the_env->nlj_fr; \
} else {
#define CL_UNWIND_PROTECT_EXIT \
#define ECL_UNWIND_PROTECT_EXIT \
__unwinding=0; } \
ecl_frs_pop(__the_env); \
__nr = ecl_stack_push_values(__the_env);
#define CL_UNWIND_PROTECT_END \
#define ECL_UNWIND_PROTECT_END \
ecl_stack_pop_values(__the_env,__nr); \
if (__unwinding) ecl_unwind(__the_env,__next_fr); } while(0)
#define ECL_NEW_FRAME_ID(env) ecl_make_fixnum(env->frame_id++)
#define CL_BLOCK_BEGIN(the_env,id) do { \
#define ECL_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 \
#define ECL_BLOCK_END \
ecl_frs_pop(__the_env); } while(0)
#define CL_CATCH_BEGIN(the_env,tag) do { \
#define ECL_CATCH_BEGIN(the_env,tag) do { \
const cl_env_ptr __the_env = (the_env); \
if (ecl_frs_push(__the_env,tag) == 0) {
#define CL_CATCH_END } \
#define ECL_CATCH_END } \
ecl_frs_pop(__the_env); } while (0)
#if defined(_MSC_VER)
# define CL_CATCH_ALL_BEGIN(the_env) do { \
# define ECL_CATCH_ALL_BEGIN(the_env) do { \
const cl_env_ptr __the_env = (the_env); \
_try { \
const cl_env_ptr __the_env = (the_env); \
if (ecl_frs_push(__the_env,ECL_PROTECT_TAG) == 0) {
# define CL_CATCH_ALL_IF_CAUGHT } else {
# define CL_CATCH_ALL_END }} \
# define ECL_CATCH_ALL_IF_CAUGHT } else {
# define ECL_CATCH_ALL_END }} \
_except(_ecl_w32_exception_filter(GetExceptionInformation())) \
{ (void)0; } \
ecl_frs_pop(__the_env); } while(0)
#else
# define CL_CATCH_ALL_BEGIN(the_env) do { \
# define ECL_CATCH_ALL_BEGIN(the_env) do { \
const cl_env_ptr __the_env = (the_env); \
if (ecl_frs_push(__the_env,ECL_PROTECT_TAG) == 0) {
# define CL_CATCH_ALL_IF_CAUGHT } else {
# define CL_CATCH_ALL_END } \
# define ECL_CATCH_ALL_IF_CAUGHT } else {
# define ECL_CATCH_ALL_END } \
ecl_frs_pop(__the_env); } while(0)
#endif