Commit c3010094 authored by Daniel Kochmański's avatar Daniel Kochmański
Browse files

Merge branch 'revert-cleanup-up' into 'develop'

Revert "cmp: execute cleanup forms of unwind-protect with interrupts disabled"

See merge request embeddable-common-lisp/ecl!119
parents 3adc8b22 3824e1b6
......@@ -56,8 +56,6 @@
=--with-libgc-incdir= and =--with-libgc-libdir= (these flags work the
same as flags for =libffi= and =libgmp=)
** Issues fixed
- initarg caches are now invalidated when new methods are defined. Problem
found and fixed by Alexander Wood.
- ECL allocated too much space in lisp stack. Instead of the specified size
x in bytes, ECL allocated roughly x^2/p where p is defined in
LISP_PAGESIZE (2048 by default). If you're setting the value of
......@@ -88,8 +86,6 @@ in C code
- No more explicit option in ~main.d~ to trap SIGCHLD asynchronously
- Zombie processes are cleaned in ~external-process~ finalizer. If process
is still referenced in the memory, it's programmer duty to call wait.
- The cleanup forms of an unwind-protect are now executed with interrupts
disabled.
- The ECL_OPT_SIGALTSTACK_SIZE option has been removed, because it had no
effect.
* 16.1.3 changes since 16.1.2
......
......@@ -103,8 +103,11 @@ out_of_memory(size_t requested_bytes)
int interrupts = the_env->disable_interrupts;
int method = 0;
void *output;
if (!interrupts)
ecl_disable_interrupts_env(the_env);
/* Disable interrupts only with the ext::*interrupts-enabled*
* mechanism to allow for writes in the thread local environment */
if (interrupts)
ecl_enable_interrupts_env(the_env);
ecl_bds_bind(the_env, @'ext::*interrupts-enabled*', ECL_NIL);
/* Free the input / output buffers */
the_env->string_pool = ECL_NIL;
......@@ -151,11 +154,10 @@ out_of_memory(size_t requested_bytes)
#ifdef ECL_THREADS
ECL_UNWIND_PROTECT_EXIT {
mp_giveup_lock(cl_core.error_lock);
ecl_enable_interrupts_env(the_env);
} ECL_UNWIND_PROTECT_END;
#else
ecl_enable_interrupts_env(the_env);
#endif
ecl_bds_unwind1(the_env);
ecl_check_pending_interrupts(the_env);
switch (method) {
case 0: cl_error(1, @'ext::storage-exhausted');
break;
......
......@@ -696,9 +696,9 @@ si_load_foreign_module(cl_object filename)
}
# ifdef ECL_THREADS
(void)0; /* MSVC complains about missing ';' before '}' */
} ECL_UNWIND_PROTECT_EXIT {
} ECL_UNWIND_PROTECT_THREAD_SAFE_EXIT {
mp_giveup_lock(ecl_symbol_value(@'mp::+load-compile-lock+'));
} ECL_UNWIND_PROTECT_END;
} ECL_UNWIND_PROTECT_THREAD_SAFE_END;
# endif
if (ecl_unlikely(ecl_t_of(output) != t_codeblock)) {
FEerror("LOAD-FOREIGN-MODULE: Could not load "
......@@ -728,9 +728,9 @@ si_unload_foreign_module(cl_object module)
if (ecl_likely(ecl_library_close(module))) output = ECL_T;
# ifdef ECL_THREADS
(void)0; /* MSVC complains about missing ';' before '}' */
} ECL_UNWIND_PROTECT_EXIT {
} ECL_UNWIND_PROTECT_THREAD_SAFE_EXIT {
mp_giveup_lock(ecl_symbol_value(@'mp::+load-compile-lock+'));
} ECL_UNWIND_PROTECT_END;
} ECL_UNWIND_PROTECT_THREAD_SAFE_END;
# endif
@(return output);
#endif
......
......@@ -111,14 +111,14 @@ si_load_source(cl_object source, cl_object verbose, cl_object print, cl_object e
}
}
ecl_bds_unwind1(the_env);
} ECL_UNWIND_PROTECT_EXIT {
} ECL_UNWIND_PROTECT_THREAD_SAFE_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');
} ECL_UNWIND_PROTECT_END;
} ECL_UNWIND_PROTECT_THREAD_SAFE_END;
@(return ECL_NIL);
}
......@@ -176,14 +176,14 @@ si_load_bytecodes(cl_object source, cl_object verbose, cl_object print, cl_objec
2, x, source);
}
}
} ECL_UNWIND_PROTECT_EXIT {
} ECL_UNWIND_PROTECT_THREAD_SAFE_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');
} ECL_UNWIND_PROTECT_END;
} ECL_UNWIND_PROTECT_THREAD_SAFE_END;
@(return ECL_NIL);
}
......
......@@ -2455,12 +2455,12 @@ ecl_init_module(cl_object block, void (*entry_point)(cl_object))
ecl_dealloc(VVtemp);
}
ecl_bds_unwind1(env);
} ECL_UNWIND_PROTECT_EXIT {
} ECL_UNWIND_PROTECT_THREAD_SAFE_EXIT {
if (in != OBJNULL)
cl_close(1,in);
env->packages_to_be_created = old_eptbc;
env->packages_to_be_created_p = ECL_NIL;
} ECL_UNWIND_PROTECT_END;
} ECL_UNWIND_PROTECT_THREAD_SAFE_END;
return block;
}
......@@ -1949,6 +1949,7 @@ cl_symbols[] = {
{EXT_ "WITH-INTERRUPTS", MP_CONSTANT, NULL, -1, OBJNULL},
{EXT_ "WITHOUT-INTERRUPTS", MP_CONSTANT, NULL, -1, OBJNULL},
{EXT_ "WITH-RESTORED-INTERRUPTS", MP_CONSTANT, NULL, -1, OBJNULL},
{EXT_ "WITH-LOCAL-INTERRUPTS", MP_CONSTANT, NULL, -1, OBJNULL},
{EXT_ "ALLOW-WITH-INTERRUPTS", MP_CONSTANT, NULL, -1, OBJNULL},
......
......@@ -1949,6 +1949,7 @@ cl_symbols[] = {
{EXT_ "WITH-INTERRUPTS",NULL},
{EXT_ "WITHOUT-INTERRUPTS",NULL},
{EXT_ "WITH-RESTORED-INTERRUPTS",NULL},
{EXT_ "WITH-LOCAL-INTERRUPTS",NULL},
{EXT_ "ALLOW-WITH-INTERRUPTS",NULL},
......
......@@ -601,9 +601,10 @@ mp_process_enable(cl_object process)
}
#endif
ecl_enable_interrupts_env(the_env);
} ECL_UNWIND_PROTECT_EXIT {
} ECL_UNWIND_PROTECT_THREAD_SAFE_EXIT {
if (!ok) {
/* INV: interrupts are already disabled through unwind-protect */
/* INV: interrupts are already disabled through thread safe
* unwind-protect */
ecl_unlist_process(process);
/* Disable the barrier and alert possible waiting processes. */
mp_barrier_unblock(3, process->process.exit_barrier,
......@@ -615,7 +616,7 @@ mp_process_enable(cl_object process)
}
/* Unleash the thread */
ecl_giveup_spinlock(&process->process.start_stop_spinlock);
} ECL_UNWIND_PROTECT_END;
} ECL_UNWIND_PROTECT_THREAD_SAFE_END;
@(return (ok? process : ECL_NIL));
}
......
......@@ -51,6 +51,7 @@ ecl_giveup_spinlock(cl_object *lock)
static ECL_INLINE void
wait_queue_nconc(cl_env_ptr the_env, cl_object q, cl_object new_tail)
{
/* INV: interrupts are disabled */
ecl_get_spinlock(the_env, &q->queue.spinlock);
q->queue.list = ecl_nconc(q->queue.list, new_tail);
ecl_giveup_spinlock(&q->queue.spinlock);
......@@ -74,6 +75,7 @@ wait_queue_pop_all(cl_env_ptr the_env, cl_object q)
static ECL_INLINE void
wait_queue_delete(cl_env_ptr the_env, cl_object q, cl_object item)
{
/* INV: interrupts are disabled */
ecl_get_spinlock(the_env, &q->queue.spinlock);
q->queue.list = ecl_delete_eq(item, q->queue.list);
ecl_giveup_spinlock(&q->queue.spinlock);
......
......@@ -87,20 +87,14 @@
(*destination* 'VALUES))
(c2expr* form))
(wt-nl "}")
;; Here we disable interrupts for the execution of the cleanup forms...
(wt-nl "ecl_bds_bind(cl_env_copy,ECL_INTERRUPTS_ENABLED,ECL_NIL);")
(wt-nl "ecl_frs_pop(cl_env_copy);")
;; Here we save the values of the form which might have been
;; aborted, and execute some cleanup code. This code may also be
;; aborted by some control structure, it is only protected against
;; interrupts from other threads.
;; aborted, and execute some cleanup code. This code may also
;; be aborted by some control structure, but is not protected.
(wt-nl nargs "=ecl_stack_push_values(cl_env_copy);")
(let ((*destination* 'TRASH))
(c2expr* body))
(wt-nl "ecl_stack_pop_values(cl_env_copy," nargs ");")
;; ...and here we reenable the interrupts.
(wt-nl "ecl_bds_unwind1(cl_env_copy);")
(wt-nl "ecl_check_pending_interrupts(cl_env_copy);")
;; Finally, if the protected form was aborted, jump to the
;; next catch point...
(wt-nl "if (unwinding) ecl_unwind(cl_env_copy,next_fr);")
......
......@@ -33,8 +33,8 @@ processes, which are made of programs running in separate contexts and
without access to each other's memory.
The implementation of threads in ECL is purely native and based on Posix
Threads wherever avaiable. The use of native threads has
advantanges. For instance, they allow for non-blocking file operations,
Threads wherever available. The use of native threads has
advantages. For instance, they allow for non-blocking file operations,
so that while one task is reading a file, a different one is performing
a computation.
......
......@@ -108,36 +108,36 @@ The other option is to let ECL handle signals itself. This would be safer when t
@node Signals and Interrupts - Signals Reference
@subsection Signals Reference
@lspindex ext:with-interrupts
@lspindex ext:without-interrupts
@lspindex mp:with-interrupts
@lspindex mp:without-interrupts
@defmac ext:with-interrupts &body body
@defmac mp:with-interrupts &body body
Execute code with interrupts optionally enabled.
@subsubheading Description
Executes the given body with all interrupts enabled. Since interrupts are normally enabled, this macro only makes sense if there is an outer @code{ext:without-interrupts} with a corresponding @code{ext:allow-with-interrupts}: interrupts are not enabled if any outer @code{mp:without-interrupts} is not accompanied by @code{mp:allow-with-interrupts}.
Executes the given body with all interrupts enabled. Since interrupts are normally enabled, this macro only makes sense if there is an outer @code{mp:without-interrupts} with a corresponding @code{mp:allow-with-interrupts}: interrupts are not enabled if any outer @code{mp:without-interrupts} is not accompanied by @code{mp:allow-with-interrupts}.
@end defmac
@defmac ext:without-interrupts &body body
@defmac mp:without-interrupts &body body
Execute code without being interrupted.
@subsubheading Description
Executes the given body with all interrupts disabled. This macro is compatible with the one in SBCL and as such it also defines three other local macros @code{ext:allow-with-interrupts}, @code{ext:with-local-interrupts} and @code{ext:with-restored-interrupts}.
Executes the given body with all deferrable interrupts disabled. Deferrable interrupts arriving during execution of the body take effect after the body has been executed.
Deferrable interrupts include most blockable POSIX signals, and @code{mp:interrupt-process}. Does not interfere with garbage collection, and does not inhibit scheduling of other threads.
This macro binds @code{allow-with-interrupts}, @code{with-local-interrupts} and @code{with-restored-interrupts} as a local macros.
This macro is compatible with the one in SBCL and as such it also defines three other local macros @code{mp:allow-with-interrupts}, @code{mp:with-local-interrupts} and @code{mp:with-restored-interrupts}.
@code{ext:with-restored-interrupts} executes the body with interrupts enabled if and only if the @code{ext:without-interrupts} was in an environment in which interrupts were allowed.
@code{mp:with-restored-interrupts} executes the body with interrupts enabled if and only if the @code{mp:without-interrupts} was in an environment in which interrupts were allowed.
@code{ext:allow-with-interrupts} allows the ext:with-interrupts to take effect during the dynamic scope of its body, unless there is an outer ext:without-interrupts without a corresponding @code{ext:allow-with-interrupts}.
@code{mp:allow-with-interrupts} allows the @code{mp:with-interrupts} to take effect during the dynamic scope of its body, unless there is an outer @code{mp:without-interrupts} without a corresponding @code{mp:allow-with-interrupts}.
@code{ext:with-local-interrupts} executes its body with interrupts enabled provided that for there is an @code{ext:allow-with-interrupts} for every @code{ext:without-interrupts} surrounding the current one. @code{ext:with-local-interrupts} is equivalent to:
@code{mp:with-local-interrupts} executes its body with interrupts enabled provided that there is an @code{mp:allow-with-interrupts} for every @code{mp:without-interrupts} surrounding the current one. @code{mp:with-local-interrupts} is equivalent to:
@verbatim
(allow-with-interrupts (with-interrupts ...))
@end verbatim
Care must be taken not to let either ext:allow-with-interrupts or ext:with-local-interrupts appear in a function that escapes from inside the ext:without-interrupts in:
Care must be taken not to let either @code{mp:allow-with-interrupts} or @code{mp:with-local-interrupts} appear in a function that escapes from inside the @code{mp:without-interrupts} in:
@verbatim
(without-interrupts
......
......@@ -383,18 +383,18 @@ extern void cl_write_object(cl_object x, cl_object stream);
ECL_UNWIND_PROTECT_BEGIN(__ecl_the_env); \
ecl_enable_interrupts_env(__ecl_the_env);
# define ECL_WITH_LOCK_END \
ECL_UNWIND_PROTECT_EXIT { \
ECL_UNWIND_PROTECT_THREAD_SAFE_EXIT { \
mp_giveup_lock(__ecl_the_lock); \
} ECL_UNWIND_PROTECT_END; }
} ECL_UNWIND_PROTECT_THREAD_SAFE_END; }
# define ECL_WITH_SPINLOCK_BEGIN(the_env,lock) { \
const cl_env_ptr __ecl_the_env = (the_env); \
cl_object *__ecl_the_lock = (lock); \
ECL_UNWIND_PROTECT_BEGIN(__ecl_the_env); \
ecl_get_spinlock(__ecl_the_env, __ecl_the_lock);
# define ECL_WITH_SPINLOCK_END \
ECL_UNWIND_PROTECT_EXIT { \
ECL_UNWIND_PROTECT_THREAD_SAFE_EXIT { \
ecl_giveup_spinlock(__ecl_the_lock); \
} ECL_UNWIND_PROTECT_END; }
} ECL_UNWIND_PROTECT_THREAD_SAFE_END; }
#else
# define ECL_WITH_GLOBAL_LOCK_BEGIN(the_env)
# define ECL_WITH_GLOBAL_LOCK_END
......
......@@ -446,12 +446,22 @@ extern ECL_API ecl_frame_ptr _ecl_frs_push(register cl_env_ptr);
} else {
#define ECL_UNWIND_PROTECT_EXIT \
__unwinding=0; } \
ecl_frs_pop(__the_env); \
__nr = ecl_stack_push_values(__the_env);
#define ECL_UNWIND_PROTECT_END \
ecl_stack_pop_values(__the_env,__nr); \
if (__unwinding) ecl_unwind(__the_env,__next_fr); } while(0)
/* unwind-protect variant which disables interrupts during cleanup */
#define ECL_UNWIND_PROTECT_THREAD_SAFE_EXIT \
__unwinding=0; } \
ecl_bds_bind(__the_env,ECL_INTERRUPTS_ENABLED,ECL_NIL); \
ecl_frs_pop(__the_env); \
__nr = ecl_stack_push_values(__the_env);
#define ECL_UNWIND_PROTECT_END \
#define ECL_UNWIND_PROTECT_THREAD_SAFE_END \
ecl_stack_pop_values(__the_env,__nr); \
ecl_bds_unwind1(__the_env); \
ecl_check_pending_interrupts(__the_env); \
......
......@@ -42,7 +42,7 @@ dynamic scope of its body, unless there is an outer WITHOUT-INTERRUPTS without
a corresponding ALLOW-WITH-INTERRUPTS.
WITH-LOCAL-INTERRUPTS executes its body with interrupts enabled provided that
for there is an ALLOW-WITH-INTERRUPTS for every WITHOUT-INTERRUPTS surrounding
there is an ALLOW-WITH-INTERRUPTS for every WITHOUT-INTERRUPTS surrounding
the current one. WITH-LOCAL-INTERRUPTS is equivalent to:
(allow-with-interrupts (with-interrupts ...))
......
......@@ -466,13 +466,14 @@ under certain conditions; see file 'Copyright' for details.")
#-threads
`(progn ,@body)
#+threads
`(unwind-protect
(progn
(register-in-waiting-list mp:*current-process*)
(grab-console mp:*current-process*)
,@body)
(delete-from-waiting-list mp:*current-process*)
(release-console mp:*current-process*)))
`(mp:without-interrupts
(unwind-protect
(mp:with-restored-interrupts
(register-in-waiting-list mp:*current-process*)
(grab-console mp:*current-process*)
,@body)
(delete-from-waiting-list mp:*current-process*)
(release-console mp:*current-process*))))
(defparameter *allow-recursive-debug* nil)
(defparameter *debug-status* nil)
......
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment