diff --git a/CHANGELOG b/CHANGELOG index 654852bd6..ae8dbb76a 100644 --- a/CHANGELOG +++ b/CHANGELOG @@ -51,8 +51,14 @@ =--with-libgc-incdir= and =--with-libgc-libdir= (these flags work the same as flags for =libffi= and =libgmp=) ** Issues fixed +- 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 + ECL_OPT_LISP_STACK_SIZE, please check whether you really have + set a high enough value. - ~block/return-from~ fixed (didn't work across some closure boundaries) - ~mp:semaphore-signal~ fixed (race when count was > 1) +- Multiple native threads issues fixed by Marius Gerbershagen - ASDF systems like foo/base and bar/base doesn't have conflicts in bundles - interactive input stream in ext:run-program on Windows - removed race condition between waitpid and sigchld handler on UNIX @@ -71,6 +77,8 @@ 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. * 16.1.3 changes since 16.1.2 ** Announcement Dear Community, diff --git a/src/c/alloc_2.d b/src/c/alloc_2.d index f749abcf4..9816d1643 100644 --- a/src/c/alloc_2.d +++ b/src/c/alloc_2.d @@ -268,7 +268,7 @@ allocate_object_own(register struct ecl_type_information *type_info) if( (op = *opp) == 0 ) { UNLOCK(); op = (ptr_t)GENERAL_MALLOC((word)lb, cl_object_kind); - if (0 == op){ + if (0 == op) { ecl_enable_interrupts_env(the_env); return 0; } diff --git a/src/c/big.d b/src/c/big.d index cdbe41366..57b2f7807 100644 --- a/src/c/big.d +++ b/src/c/big.d @@ -273,13 +273,13 @@ _ecl_fix_divided_by_big(cl_fixnum x, cl_object y) static void * mp_alloc(size_t size) { - return ecl_alloc_uncollectable(size); + return ecl_alloc_atomic(size); } static void mp_free(void *ptr, size_t size) { - ecl_free_uncollectable(ptr); + ecl_dealloc(ptr); } static void * diff --git a/src/c/interpreter.d b/src/c/interpreter.d index d937fdbab..74f510584 100644 --- a/src/c/interpreter.d +++ b/src/c/interpreter.d @@ -30,7 +30,7 @@ ecl_stack_set_size(cl_env_ptr env, cl_index tentative_new_size) cl_index new_size = tentative_new_size + 2*safety_area; /* Round to page size */ - new_size = (new_size + (LISP_PAGESIZE-1))/LISP_PAGESIZE * new_size; + new_size = ((new_size + LISP_PAGESIZE - 1) / LISP_PAGESIZE) * LISP_PAGESIZE; if (ecl_unlikely(top > new_size)) { FEerror("Internal error: cannot shrink stack below stack top.",0); diff --git a/src/c/main.d b/src/c/main.d index 973cd7bad..d9ee8a8eb 100755 --- a/src/c/main.d +++ b/src/c/main.d @@ -569,7 +569,7 @@ cl_boot(int argc, char **argv) /* * Initialize the per-thread data. * This cannot come later, because we need to be able to bind - * ext::*interrupts-enabled while creating packages. + * ext::*interrupts-enabled* while creating packages. */ init_big(); ecl_init_env(env); diff --git a/src/c/threads/process.d b/src/c/threads/process.d index 05ba5fe93..08d218008 100755 --- a/src/c/threads/process.d +++ b/src/c/threads/process.d @@ -534,9 +534,11 @@ mp_process_yield(void) cl_object mp_process_enable(cl_object process) { - cl_env_ptr process_env = NULL; + /* process_env and ok are changed after the setjmp call in + * ECL_UNWIND_PROTECT_BEGIN, so they need to be declared volatile */ + volatile cl_env_ptr process_env = NULL; cl_env_ptr the_env = ecl_process_env(); - int ok = 0; + volatile int ok = 0; ECL_UNWIND_PROTECT_BEGIN(the_env) { /* Try to gain exclusive access to the process at the same * time we ensure that it is inactive. This prevents two @@ -618,7 +620,7 @@ mp_process_enable(cl_object process) @':disable', ECL_T); process->process.phase = ECL_PROCESS_INACTIVE; process->process.env = NULL; - if(process_env != NULL) + if (process_env != NULL) _ecl_dealloc_env(process_env); } /* Unleash the thread */ diff --git a/src/c/unixint.d b/src/c/unixint.d index 4ec5a3580..127d2c87b 100644 --- a/src/c/unixint.d +++ b/src/c/unixint.d @@ -823,7 +823,7 @@ si_check_pending_interrupts(void) void ecl_check_pending_interrupts(cl_env_ptr env) { - if(env->interrupt_struct->pending_interrupt != ECL_NIL) + if (env->interrupt_struct->pending_interrupt != ECL_NIL) handle_all_queued_interrupt_safe(env); } diff --git a/src/cmp/cmpblock.lsp b/src/cmp/cmpblock.lsp index bdd5dbe8f..bd9ba3941 100644 --- a/src/cmp/cmpblock.lsp +++ b/src/cmp/cmpblock.lsp @@ -60,6 +60,7 @@ (let ((env-lvl *env-lvl*)) (wt-nl "cl_object " *volatile* "env" (incf *env-lvl*) " = env" env-lvl ";"))) (bind "ECL_NEW_FRAME_ID(cl_env_copy)" blk-var) + (wt-nl-open-brace) (wt-nl "ecl_frs_push(cl_env_copy," blk-var ");") (wt-nl "if (__ecl_frs_push_result!=0) {") (let ((*unwind-exit* (cons 'FRAME *unwind-exit*))) @@ -67,6 +68,7 @@ (wt-nl "} else {") (c2expr body) (wt "}")) + (wt-nl-close-brace) (when (var-ref-ccb blk-var) (decf *env*)) (wt-nl-close-brace)) (c2expr body))) diff --git a/src/cmp/cmpcatch.lsp b/src/cmp/cmpcatch.lsp index a27f8a8e6..a9fc17a04 100644 --- a/src/cmp/cmpcatch.lsp +++ b/src/cmp/cmpcatch.lsp @@ -30,6 +30,7 @@ (c2expr* tag)) (let* ((*destination* new-destination) (*unwind-exit* (cons 'FRAME *unwind-exit*))) + (wt-nl-open-brace) (if (member new-destination '(TRASH VALUES)) (progn (wt-nl "ecl_frs_push(cl_env_copy," 'VALUE0 ");") @@ -51,6 +52,7 @@ (wt-nl "}") (wt-nl "ecl_frs_pop(cl_env_copy);") (wt-comment "END CATCH ~A" code) + (wt-nl-close-brace) (unwind-exit new-destination))) (defun c1unwind-protect (args) @@ -85,14 +87,20 @@ (*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, but is not protected. + ;; 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. (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);") diff --git a/src/cmp/cmptag.lsp b/src/cmp/cmptag.lsp index 491faeaec..382237c94 100644 --- a/src/cmp/cmptag.lsp +++ b/src/cmp/cmptag.lsp @@ -151,6 +151,7 @@ (maybe-open-inline-block) (wt-nl "cl_object " tag-loc ";")) (bind "ECL_NEW_FRAME_ID(cl_env_copy)" tag-loc) + (wt-nl-open-brace) (wt-nl "ecl_frs_push(cl_env_copy," tag-loc ");") (wt-nl "if (__ecl_frs_push_result) {") ;; Allocate labels. @@ -163,6 +164,7 @@ (when (var-ref-ccb tag-loc) (wt-nl "ecl_internal_error(\"GO found an inexistent tag\");")) (wt-nl "}") + (wt-nl-close-brace) (c2tagbody-body body) (close-inline-blocks)))) diff --git a/src/tests/ecl-tests.lisp b/src/tests/ecl-tests.lisp index a31c9eabd..e3ca7f473 100644 --- a/src/tests/ecl-tests.lisp +++ b/src/tests/ecl-tests.lisp @@ -21,12 +21,15 @@ ;;;; Declare the suites (suite 'ecl-tests - '(executable eformat ieee-fp eprocess package-ext hash-tables ansi+ mixed - cmp emb ffi mop mp run-program)) + '(executable ieee-fp eprocess package-ext hash-tables ansi+ mixed + cmp emb ffi mop mp run-program eformat)) (suite 'make-check - '(executable ieee-fp eprocess package-ext hash-tables ansi+ mixed cmp emb - ffi mop run-program mp ieee-fp)) + '(executable ieee-fp eprocess package-ext hash-tables ansi+ mixed + cmp emb ffi mop run-program mp)) + +(suite 'stress) +(test stress.all (finishes (1am-ecl:run))) (defmacro is-true (form)