From 72fb1c583a4af21252880e7e44bc0dca96c71d0d Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Daniel=20Kochma=C5=84ski?= Date: Tue, 16 Apr 2024 08:08:31 +0200 Subject: [PATCH] stacks: remove serror, stack-error-handler and reset-margin 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. --- src/c/error.d | 7 ----- src/c/stacks.d | 70 ++++++++++++++++++++--------------------- src/c/symbols_list.h | 3 -- src/clos/conditions.lsp | 5 --- src/clos/fixup.lsp | 5 --- src/h/external.h | 1 - src/h/internal.h | 3 -- 7 files changed, 34 insertions(+), 60 deletions(-) diff --git a/src/c/error.d b/src/c/error.d index 7e4c1b62b..612dd3a05 100644 --- a/src/c/error.d +++ b/src/c/error.d @@ -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) { diff --git a/src/c/stacks.d b/src/c/stacks.d index 859746715..13f3170f8 100644 --- a/src/c/stacks.d +++ b/src/c/stacks.d @@ -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) { diff --git a/src/c/symbols_list.h b/src/c/symbols_list.h index f5da4b072..7a0d12046 100644 --- a/src/c/symbols_list.h +++ b/src/c/symbols_list.h @@ -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)}, diff --git a/src/clos/conditions.lsp b/src/clos/conditions.lsp index fbc3686f7..87c82a4a7 100644 --- a/src/clos/conditions.lsp +++ b/src/clos/conditions.lsp @@ -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)) diff --git a/src/clos/fixup.lsp b/src/clos/fixup.lsp index 9ab0f07ce..4993a8ed4 100644 --- a/src/clos/fixup.lsp +++ b/src/clos/fixup.lsp @@ -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+) diff --git a/src/h/external.h b/src/h/external.h index 2d8978fca..e2c24b7dc 100755 --- a/src/h/external.h +++ b/src/h/external.h @@ -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); diff --git a/src/h/internal.h b/src/h/internal.h index 5ca1e1004..88ae995db 100755 --- a/src/h/internal.h +++ b/src/h/internal.h @@ -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 */