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

stack: add special conditional handler for stack-overflow

Browse source 
Add `serror' and `stack-error-handler', which behave like normal
`cerror' -> `universal-error-handler' call order, except fact, that
after handling stack-overflow condition they reset appropriate stack
limit. Fixes #56.

Signed-off-by: Daniel Kochmański <dkochmanski@turtle-solutions.eu>
This commit is contained in:
Daniel Kochmański 2015-06-24 13:31:47 +02:00
parent 44c58e95f7
commit 09ae630cde
6 changed files with 20 additions and 3 deletions
Download patch file Download diff file Expand all files Collapse all files

7
src/c/error.d
View file

@ -541,6 +541,13 @@ FEwin32_error(const char *msg, int narg, ...)
cl_grab_rest_args(args));
@)
@(defun si::serror (cformat eformat &rest args)
@
ecl_enable_interrupts();
return funcall(4, @'si::stack-error-handler', cformat, eformat,
cl_grab_rest_args(args));
@)
void
init_error(void)
{

6
src/c/stacks.d
View file

@ -71,7 +71,7 @@ ecl_cs_overflow(void)
#endif
else
ecl_unrecoverable_error(env, stack_overflow_msg);
cl_cerror(6, make_constant_base_string("Extend stack size"),
cl_serror(6, make_constant_base_string("Extend stack size"),
@'ext::stack-overflow', @':size', ecl_make_fixnum(size),
@':type', @'ext::c-stack');
size += size / 2;
@ -158,7 +158,7 @@ ecl_bds_overflow(void)
ecl_unrecoverable_error(env, stack_overflow_msg);
}
env->bds_limit += margin;
cl_cerror(6, make_constant_base_string("Extend stack size"),
cl_serror(6, make_constant_base_string("Extend stack size"),
@'ext::stack-overflow', @':size', ecl_make_fixnum(size),
@':type', @'ext::binding-stack');
ecl_bds_set_size(env, size + (size / 2));
@ -511,7 +511,7 @@ frs_overflow(void) /* used as condition in list.d */
ecl_unrecoverable_error(env, stack_overflow_msg);
}
env->frs_limit += margin;
cl_cerror(6, make_constant_base_string("Extend stack size"),
cl_serror(6, make_constant_base_string("Extend stack size"),
@'ext::stack-overflow', @':size', ecl_make_fixnum(size),
@':type', @'ext::frame-stack');
frs_set_size(env, size + size / 2);

2
src/c/symbols_list.h
View file

@ -295,6 +295,7 @@ cl_symbols[] = {
{"CELL-ERROR", CL_ORDINARY, NULL, -1, OBJNULL},
{"CELL-ERROR-NAME", CL_ORDINARY, NULL, -1, OBJNULL},
{"CERROR", CL_ORDINARY, cl_cerror, -1, OBJNULL},
{SYS_ "SERROR", CL_ORDINARY, cl_serror, -1, OBJNULL},
{"CHAR", CL_ORDINARY, cl_char, 2, OBJNULL},
{"CHAR-CODE", CL_ORDINARY, cl_char_code, 1, OBJNULL},
{"CHAR-CODE-LIMIT", CL_CONSTANT, NULL, -1, ecl_make_fixnum(ECL_CHAR_CODE_LIMIT)},
@ -1269,6 +1270,7 @@ cl_symbols[] = {
{SYS_ "TERMINAL-INTERRUPT", SI_ORDINARY, NULL, -1, OBJNULL},
{SYS_ "TOP-LEVEL", SI_ORDINARY, NULL, -1, OBJNULL},
{SYS_ "UNIVERSAL-ERROR-HANDLER", SI_ORDINARY, NULL, -1, OBJNULL},
{SYS_ "STACK-ERROR-HANDLER", SI_ORDINARY, NULL, -1, OBJNULL},
{SYS_ "VALID-FUNCTION-NAME-P", SI_ORDINARY, si_valid_function_name_p, 1, OBJNULL},
{SYS_ "WRITE-OBJECT", SI_SPECIAL, si_write_object, 2, OBJNULL},
{SYS_ "WRITE-UGLY-OBJECT", SI_SPECIAL, si_write_ugly_object, 2, OBJNULL},

2
src/c/symbols_list2.h
View file

@ -295,6 +295,7 @@ cl_symbols[] = {
{"CELL-ERROR",NULL},
{"CELL-ERROR-NAME",NULL},
{"CERROR","cl_cerror"},
{SYS_ "SERROR","cl_serror"},
{"CHAR","cl_char"},
{"CHAR-CODE","cl_char_code"},
{"CHAR-CODE-LIMIT",NULL},
@ -1269,6 +1270,7 @@ cl_symbols[] = {
{SYS_ "TERMINAL-INTERRUPT",NULL},
{SYS_ "TOP-LEVEL",NULL},
{SYS_ "UNIVERSAL-ERROR-HANDLER",NULL},
{SYS_ "STACK-ERROR-HANDLER",NULL},
{SYS_ "VALID-FUNCTION-NAME-P","si_valid_function_name_p"},
{SYS_ "WRITE-OBJECT","si_write_object"},
{SYS_ "WRITE-UGLY-OBJECT","si_write_ugly_object"},

5
src/clos/conditions.lsp
View file

@ -831,5 +831,10 @@ strings."
(signal condition)
(invoke-debugger condition))))))
(defun sys::stack-error-handler (continue-string datum args)
(unwind-protect (universal-error-handler continue-string datum args)
(si:reset-margin
(getf args :type))))
(defun sys::tpl-continue-command (&rest any)
(apply #'invoke-restart 'continue any))

1
src/h/external.h
View file

@ -560,6 +560,7 @@ extern ECL_API cl_object si_bc_join(cl_object lex, cl_object code, cl_object dat
extern ECL_API cl_object cl_error _ECL_ARGS((cl_narg narg, cl_object eformat, ...)) ecl_attr_noreturn;
extern ECL_API cl_object cl_cerror _ECL_ARGS((cl_narg narg, cl_object cformat, cl_object eformat, ...));
extern ECL_API cl_object cl_serror _ECL_ARGS((cl_narg narg, cl_object cformat, cl_object eformat, ...));
extern ECL_API void ecl_internal_error(const char *s) ecl_attr_noreturn;
extern ECL_API void ecl_unrecoverable_error(cl_env_ptr the_env, const char *message) ecl_attr_noreturn;