mirrors/ecl
1
Fork 0
mirror of https://gitlab.com/embeddable-common-lisp/ecl.git synced 2026-03-09 06:30:32 -07:00
Code Issues Projects Releases Packages Wiki Activity

stacks: remove serror, stack-error-handler and reset-margin

Browse source 
All these operations were propagated up to the condition system in order to
reset the stack margin in the case of a non-local exit. We can do that easily
with open-coded unwind protect within stacks.
This commit is contained in:
Daniel Kochmański 2024-04-16 08:08:31 +02:00
parent 6463cae89c
commit 72fb1c583a
7 changed files with 34 additions and 60 deletions
Download patch file Download diff file Expand all files Collapse all files

7
src/c/error.d
View file

@ -601,13 +601,6 @@ 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)
{

70
src/c/stacks.d
View file

@ -118,17 +118,21 @@ ecl_cs_overflow(void)
#endif
else
ecl_unrecoverable_error(env, stack_overflow_msg);
if (env->c_stack.max_size == (cl_index)0 || env->c_stack.size < env->c_stack.max_size)
si_serror(6, @"Extend stack size",
@'ext::stack-overflow',
@':size', ecl_make_fixnum(size),
@':type', @'ext::c-stack');
else
si_serror(6, ECL_NIL,
@'ext::stack-overflow',
@':size', ECL_NIL,
@':type', @'ext::c-stack');
ECL_UNWIND_PROTECT_BEGIN(env) {
if (env->c_stack.max_size == (cl_index)0 || env->c_stack.size < env->c_stack.max_size)
cl_cerror(6, @"Extend stack size",
@'ext::stack-overflow',
@':size', ecl_make_fixnum(size),
@':type', @'ext::c-stack');
else
cl_error(5,
@'ext::stack-overflow',
@':size', ECL_NIL,
@':type', @'ext::c-stack');
} ECL_UNWIND_PROTECT_EXIT {
/* reset margin */
cs_set_size(env, size);
} ECL_UNWIND_PROTECT_END;
size += size/2;
if (size > env->c_stack.max_size)
size = env->c_stack.max_size;
@ -315,7 +319,7 @@ bds_init(cl_env_ptr env)
}
static void
ecl_bds_set_size(cl_env_ptr env, cl_index nsize)
bds_set_size(cl_env_ptr env, cl_index nsize)
{
ecl_bds_ptr old_org = env->bds_stack.org;
cl_index limit = env->bds_stack.top - old_org;
@ -356,10 +360,15 @@ ecl_bds_overflow(void)
ecl_unrecoverable_error(env, stack_overflow_msg);
}
env->bds_stack.limit += margin;
si_serror(6, @"Extend stack size",
@'ext::stack-overflow', @':size', ecl_make_fixnum(size),
@':type', @'ext::binding-stack');
ecl_bds_set_size(env, size + (size / 2));
ECL_UNWIND_PROTECT_BEGIN(env) {
cl_cerror(6, @"Extend stack size",
@'ext::stack-overflow', @':size', ecl_make_fixnum(size),
@':type', @'ext::binding-stack');
} ECL_UNWIND_PROTECT_EXIT {
/* reset margin */
bds_set_size(env, size);
} ECL_UNWIND_PROTECT_END;
bds_set_size(env, size + (size / 2));
return env->bds_stack.top;
}
@ -722,9 +731,14 @@ frs_overflow(void) /* used as condition in list.d */
ecl_unrecoverable_error(env, stack_overflow_msg);
}
env->frs_stack.limit += margin;
si_serror(6, @"Extend stack size",
@'ext::stack-overflow', @':size', ecl_make_fixnum(size),
@':type', @'ext::frame-stack');
ECL_UNWIND_PROTECT_BEGIN(env) {
cl_cerror(6, @"Extend stack size",
@'ext::stack-overflow', @':size', ecl_make_fixnum(size),
@':type', @'ext::frame-stack');
} ECL_UNWIND_PROTECT_EXIT {
/* reset margin */
frs_set_size(env, size);
} ECL_UNWIND_PROTECT_END;
frs_set_size(env, size + size / 2);
}
@ -846,7 +860,7 @@ si_set_limit(cl_object type, cl_object limit)
} else if (type == @'ext::binding-stack') {
cl_index the_size = ecl_to_size(limit);
margin = ecl_option_values[ECL_OPT_BIND_STACK_SAFETY_AREA];
ecl_bds_set_size(env, the_size + 2*margin);
bds_set_size(env, the_size + 2*margin);
} else if (type == @'ext::c-stack') {
cl_index the_size = ecl_to_size(limit);
margin = ecl_option_values[ECL_OPT_C_STACK_SAFETY_AREA];
@ -887,22 +901,6 @@ si_get_limit(cl_object type)
ecl_return1(env, ecl_make_unsigned_integer(output));
}
cl_object
si_reset_margin(cl_object type)
{
cl_env_ptr env = ecl_process_env();
if (type == @'ext::frame-stack')
frs_set_size(env, env->frs_stack.size);
else if (type == @'ext::binding-stack')
ecl_bds_set_size(env, env->bds_stack.size);
else if (type == @'ext::c-stack')
cs_set_size(env, env->c_stack.size);
else
ecl_return1(env, ECL_NIL);
ecl_return1(env, ECL_T);
}
void
init_stacks(cl_env_ptr env)
{

3
src/c/symbols_list.h
View file

@ -1270,7 +1270,6 @@ cl_symbols[] = {
{EXT_ "SAFE-EVAL" ECL_FUN("si_safe_eval", ECL_NAME(si_safe_eval), -3) ECL_VAR(EXT_ORDINARY, OBJNULL)},
{SYS_ "SCH-FRS-BASE" ECL_FUN("si_sch_frs_base", si_sch_frs_base, 2) ECL_VAR(SI_ORDINARY, OBJNULL)},
{SYS_ "SCHAR-SET" ECL_FUN("si_char_set", si_char_set, 3) ECL_VAR(SI_ORDINARY, OBJNULL)},
{SYS_ "SERROR" ECL_FUN("si_serror", si_serror, -3) ECL_VAR(SI_ORDINARY, OBJNULL)},
{SYS_ "SHARP-A-READER" ECL_FUN(NULL, NULL, -1) ECL_VAR(SI_ORDINARY, OBJNULL)},
{SYS_ "SHARP-S-READER" ECL_FUN(NULL, NULL, -1) ECL_VAR(SI_ORDINARY, OBJNULL)},
{SYS_ "SELECT-PACKAGE" ECL_FUN("si_select_package", si_select_package, 1) ECL_VAR(SI_ORDINARY, OBJNULL)},
@ -1304,7 +1303,6 @@ cl_symbols[] = {
{SYS_ "TERMINAL-INTERRUPT" ECL_FUN(NULL, NULL, -1) ECL_VAR(SI_ORDINARY, OBJNULL)},
{SYS_ "TOP-LEVEL" ECL_FUN(NULL, NULL, -1) ECL_VAR(SI_ORDINARY, OBJNULL)},
{SYS_ "UNIVERSAL-ERROR-HANDLER" ECL_FUN(NULL, NULL, -1) ECL_VAR(SI_ORDINARY, OBJNULL)},
{SYS_ "STACK-ERROR-HANDLER" ECL_FUN(NULL, NULL, -1) ECL_VAR(SI_ORDINARY, OBJNULL)},
{SYS_ "VALID-FUNCTION-NAME-P" ECL_FUN("si_valid_function_name_p", si_valid_function_name_p, 1) ECL_VAR(SI_ORDINARY, OBJNULL)},
{SYS_ "SEARCH-PRINT-CIRCLE" ECL_FUN("si_search_print_circle", si_search_print_circle, 1) ECL_VAR(SI_SPECIAL, OBJNULL)},
{SYS_ "WRITE-OBJECT-WITH-CIRCLE" ECL_FUN("si_write_object_with_circle", si_write_object_with_circle, 3) ECL_VAR(SI_SPECIAL, OBJNULL)},
@ -1922,7 +1920,6 @@ cl_symbols[] = {
{EXT_ "ILLEGAL-INSTRUCTION" ECL_FUN(NULL, NULL, -1) ECL_VAR(EXT_ORDINARY, OBJNULL)},
{EXT_ "SET-LIMIT" ECL_FUN("si_set_limit", si_set_limit, 2) ECL_VAR(EXT_ORDINARY, OBJNULL)},
{EXT_ "GET-LIMIT" ECL_FUN("si_get_limit", si_get_limit, 1) ECL_VAR(EXT_ORDINARY, OBJNULL)},
{SYS_ "RESET-MARGIN" ECL_FUN("si_reset_margin", si_reset_margin, 1) ECL_VAR(EXT_ORDINARY, OBJNULL)},
{EXT_ "SEGMENTATION-VIOLATION" ECL_FUN(NULL, NULL, -1) ECL_VAR(EXT_ORDINARY, OBJNULL)},
{EXT_ "EXTENDED-STRING" ECL_FUN(NULL, NULL, -1) ECL_VAR(EXT_ORDINARY, OBJNULL)},

5
src/clos/conditions.lsp
View file

@ -879,10 +879,5 @@ 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))

5
src/clos/fixup.lsp
View file

@ -15,11 +15,6 @@
;;; ---------------------------------------------------------------------
;;; Fixup
;;; Early version of the stack handler.
(defun sys::stack-error-handler (continue-string datum args)
(declare (ignore continue-string))
(apply #'error datum args))
(defun register-method-with-specializers (method)
(declare (si::c-local))
(with-early-accessors (+standard-method-slots+ +specializer-slots+)

1
src/h/external.h
View file

@ -1643,7 +1643,6 @@ extern ECL_API cl_object si_bds_var(cl_object arg);
extern ECL_API cl_object si_bds_val(cl_object arg);
extern ECL_API cl_object si_sch_frs_base(cl_object fr, cl_object ihs);
extern ECL_API cl_object si_reset_stack_limits(void);
extern ECL_API cl_object si_reset_margin(cl_object type);
extern ECL_API cl_object si_set_limit(cl_object type, cl_object size);
extern ECL_API cl_object si_get_limit(cl_object type);

3
src/h/internal.h
View file

@ -298,9 +298,6 @@ struct cl_compiler_ref {
extern void _ecl_unexpected_return() ecl_attr_noreturn;
extern cl_object _ecl_strerror(int code);
extern ECL_API cl_object si_serror _ECL_ARGS
((cl_narg narg, cl_object cformat, cl_object eformat, ...));
/* eval.d */