From dc0f2bd2c7911564cec7cd822cc3497469f15f7c Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Daniel=20Kochma=C5=84ski?= Date: Wed, 14 May 2025 10:01:30 +0200 Subject: [PATCH] boot: add a file escape.d for program control transfer Currently it contains early errors and backtrace. --- src/c/Makefile.in | 2 +- src/c/error.d | 82 ++++--------------------- src/c/escape.d | 140 ++++++++++++++++++++++++++++++++++++++++++ src/c/ffi/backtrace.d | 47 -------------- 4 files changed, 152 insertions(+), 119 deletions(-) create mode 100644 src/c/escape.d diff --git a/src/c/Makefile.in b/src/c/Makefile.in index cdbc4f0e9..a9dd458c6 100644 --- a/src/c/Makefile.in +++ b/src/c/Makefile.in @@ -50,7 +50,7 @@ HFILES = $(HDIR)/config.h $(HDIR)/ecl.h $(HDIR)/ecl-cmp.h $(HDIR)/object.h $(HDIR)/impl/math_dispatch.h $(HDIR)/impl/math_fenv.h \ $(HDIR)/impl/math_fenv_msvc.h $(HDIR)/nucleus.h -BOOT_OBJS = +BOOT_OBJS = escape.o CLOS_OBJS = clos/cache.o clos/accessor.o clos/instance.o clos/gfun.o diff --git a/src/c/error.d b/src/c/error.d index 58bf24fdc..c8bc4a2ce 100644 --- a/src/c/error.d +++ b/src/c/error.d @@ -24,69 +24,12 @@ #include #include -static cl_object -cl_symbol_or_object(cl_object x) -{ - if (ECL_FIXNUMP(x)) - return (cl_object)(cl_symbols + ecl_fixnum(x)); - return x; -} - -void -_ecl_unexpected_return() -{ - ecl_internal_error( - "*** \n" - "*** A call to ERROR returned without handling the error.\n" - "*** This should have never happened and is usually a signal\n" - "*** that the debugger or the universal error handler were\n" - "*** improperly coded or altered. Please contact the maintainers\n" - "***\n"); -} - -void -ecl_internal_error(const char *s) -{ - int saved_errno = errno; - fprintf(stderr, "\nInternal or unrecoverable error in:\n%s\n", s); - if (saved_errno) { - fprintf(stderr, " [%d: %s]\n", saved_errno, strerror(saved_errno)); - } - fflush(stderr); - _ecl_dump_c_backtrace(); -#ifdef SIGIOT - signal(SIGIOT, SIG_DFL); /* avoid getting into a loop with abort */ -#endif - abort(); -} - -#ifdef ECL_THREADS -void -ecl_thread_internal_error(const char *s) -{ - int saved_errno = errno; - fprintf(stderr, "\nInternal thread error in:\n%s\n", s); - if (saved_errno) { - fprintf(stderr, " [%d: %s]\n", saved_errno, strerror(saved_errno)); - } - _ecl_dump_c_backtrace(); - fprintf(stderr, - "\nDid you forget to call `ecl_import_current_thread'?\n" - "Exitting thread.\n"); - fflush(stderr); - ecl_thread_exit(); -} -#endif - void ecl_unrecoverable_error(cl_env_ptr the_env, const char *message) { - /* - * Right now we have no means of specifying a jump point - * for really bad events. We just jump to the outermost - * frame, which is equivalent to quitting, and wait for - * someone to intercept this jump. - */ + /* Right now we have no means of specifying a jump point for really bad + * events. We just jump to the outermost frame, which is equivalent to + * quitting, and wait for someone to intercept this jump. */ ecl_frame_ptr destination; cl_object tag; @@ -112,21 +55,18 @@ ecl_unrecoverable_error(cl_env_ptr the_env, const char *message) } } -void -ecl_miscompilation_error() -{ - ecl_internal_error( - "***\n" - "*** Encountered a code path that should have never been taken.\n" - "*** This likely indicates a bug in the ECL compiler. Please contact\n" - "*** the maintainers.\n" - "***\n"); -} - /*****************************************************************************/ /* Support for Lisp Error Handler */ /*****************************************************************************/ +static cl_object +cl_symbol_or_object(cl_object x) +{ + if (ECL_FIXNUMP(x)) + return (cl_object)(cl_symbols + ecl_fixnum(x)); + return x; +} + void FEerror(const char *s, int narg, ...) { diff --git a/src/c/escape.d b/src/c/escape.d new file mode 100644 index 000000000..0d8fa836d --- /dev/null +++ b/src/c/escape.d @@ -0,0 +1,140 @@ +/* -*- Mode: C; c-basic-offset: 2; indent-tabs-mode: nil -*- */ +/* vim: set filetype=c tabstop=2 shiftwidth=2 expandtab: */ + +/* control.c - signaling conditions and transfering program control */ + +#include +#include +#include +#include +#include + +#include +#include +#include +#include +#include +#if defined(ECL_MS_WINDOWS_HOST) || defined(cygwin) +# include +#endif + +#if defined(HAVE_BACKTRACE) && defined(HAVE_BACKTRACE_SYMBOLS) +# include +# define ECL_UNIX_BACKTRACE +#endif + +#if defined(ECL_WINDOWS_BACKTRACE) +# include +# include +#endif + +/* -- Fatal errors ---------------------------------------------------------- ** + +Fatal errors that can't be recovered from and result in the program abortion. + +** ---------------------------------------------------------------------------*/ + +void +ecl_internal_error(const char *s) +{ + int saved_errno = errno; + fprintf(stderr, "\nInternal or unrecoverable error in:\n%s\n", s); + if (saved_errno) { + fprintf(stderr, " [%d: %s]\n", saved_errno, strerror(saved_errno)); + } + fflush(stderr); + _ecl_dump_c_backtrace(); +#ifdef SIGIOT + signal(SIGIOT, SIG_DFL); /* avoid getting into a loop with abort */ +#endif + abort(); +} + +#ifdef ECL_THREADS +void +ecl_thread_internal_error(const char *s) +{ + int saved_errno = errno; + fprintf(stderr, "\nInternal thread error in:\n%s\n", s); + if (saved_errno) { + fprintf(stderr, " [%d: %s]\n", saved_errno, strerror(saved_errno)); + } + _ecl_dump_c_backtrace(); + fprintf(stderr, "\nDid you forget to call `ecl_import_current_thread'?\n" + "Exitting thread.\n"); + fflush(stderr); + ecl_thread_exit(); +} +#endif + +void +_ecl_unexpected_return() +{ + ecl_internal_error("*** \n" + "*** A call to ERROR returned without handling the error.\n" + "*** This should have never happened and is usually a signal\n" + "*** that the debugger or the universal error handler were\n" + "*** improperly coded or altered. Please contact the maintainers\n" + "*** \n"); +} + +void +ecl_miscompilation_error() +{ + ecl_internal_error("*** \n" + "*** Encountered a code path that should have never been taken.\n" + "*** This likely indicates a bug in the ECL compiler. Please contact\n" + "*** the maintainers.\n" + "*** \n"); +} + + +/* Max number of frames dumped by _ecl_dump_c_backtrace */ +#define MAX_BACKTRACE_SIZE 128 +/* Max length of symbols printed */ +#define MAX_SYMBOL_LENGTH 256 + +void +_ecl_dump_c_backtrace() +{ +#if defined(ECL_UNIX_BACKTRACE) || defined(ECL_WINDOWS_BACKTRACE) + { + void **pointers = malloc(sizeof(void*) * MAX_BACKTRACE_SIZE); +# if defined(ECL_UNIX_BACKTRACE) + int nframes = backtrace(pointers, MAX_BACKTRACE_SIZE); + char **names = backtrace_symbols(pointers, nframes); +# elif defined(ECL_WINDOWS_BACKTRACE) + HANDLE process = GetCurrentProcess(); + if (!SymInitialize(process, NULL, TRUE)) { + return; + } + int nframes = CaptureStackBackTrace(0, MAX_BACKTRACE_SIZE, pointers, NULL); + char buffer[sizeof(SYMBOL_INFO) + MAX_SYMBOL_LENGTH * sizeof(TCHAR)]; + PSYMBOL_INFO pSymbol = (PSYMBOL_INFO)buffer; + pSymbol->SizeOfStruct = sizeof(SYMBOL_INFO); + pSymbol->MaxNameLen = MAX_SYMBOL_LENGTH; +# endif + int i; + fprintf(stderr, "\n;;; ECL C Backtrace\n"); + for (i = 0; i < nframes; i++) { +# if defined(ECL_UNIX_BACKTRACE) + fprintf(stderr, ";;; %s\n", names[i]); +# elif defined(ECL_WINDOWS_BACKTRACE) + DWORD64 displacement; + if (SymFromAddr(process, (DWORD64) pointers[i], &displacement, pSymbol)) { + fprintf(stderr, ";;; (%s+0x%llx) [0x%p]\n", pSymbol->Name, displacement, pointers[i]); + } else { + fprintf(stderr, ";;; (unknown) [0x%p]\n", pointers[i]); + } +# endif + } + fflush(stderr); + free(pointers); +# if defined(ECL_UNIX_BACKTRACE) + free(names); +# elif defined(ECL_WINDOWS_BACKTRACE) + SymCleanup(process); +# endif + } +#endif /* defined(ECL_UNIX_BACKTRACE) || defined(ECL_WINDOWS_BACKTRACE) */ +} diff --git a/src/c/ffi/backtrace.d b/src/c/ffi/backtrace.d index d1b72a310..0384babae 100644 --- a/src/c/ffi/backtrace.d +++ b/src/c/ffi/backtrace.d @@ -24,56 +24,9 @@ # include #endif -/* Max number of frames dumped by _ecl_dump_c_backtrace */ -#define MAX_BACKTRACE_SIZE 128 /* Max length of symbols printed */ #define MAX_SYMBOL_LENGTH 256 -void -_ecl_dump_c_backtrace() -{ -#if defined(ECL_UNIX_BACKTRACE) || defined(ECL_WINDOWS_BACKTRACE) - { - void **pointers = malloc(sizeof(void*) * MAX_BACKTRACE_SIZE); -# if defined(ECL_UNIX_BACKTRACE) - int nframes = backtrace(pointers, MAX_BACKTRACE_SIZE); - char **names = backtrace_symbols(pointers, nframes); -# elif defined(ECL_WINDOWS_BACKTRACE) - HANDLE process = GetCurrentProcess(); - if (!SymInitialize(process, NULL, TRUE)) { - return; - } - int nframes = CaptureStackBackTrace(0, MAX_BACKTRACE_SIZE, pointers, NULL); - char buffer[sizeof(SYMBOL_INFO) + MAX_SYMBOL_LENGTH * sizeof(TCHAR)]; - PSYMBOL_INFO pSymbol = (PSYMBOL_INFO)buffer; - pSymbol->SizeOfStruct = sizeof(SYMBOL_INFO); - pSymbol->MaxNameLen = MAX_SYMBOL_LENGTH; -# endif - int i; - fprintf(stderr, "\n;;; ECL C Backtrace\n"); - for (i = 0; i < nframes; i++) { -# if defined(ECL_UNIX_BACKTRACE) - fprintf(stderr, ";;; %s\n", names[i]); -# elif defined(ECL_WINDOWS_BACKTRACE) - DWORD64 displacement; - if (SymFromAddr(process, (DWORD64) pointers[i], &displacement, pSymbol)) { - fprintf(stderr, ";;; (%s+0x%llx) [0x%p]\n", pSymbol->Name, displacement, pointers[i]); - } else { - fprintf(stderr, ";;; (unknown) [0x%p]\n", pointers[i]); - } -# endif - } - fflush(stderr); - free(pointers); -# if defined(ECL_UNIX_BACKTRACE) - free(names); -# elif defined(ECL_WINDOWS_BACKTRACE) - SymCleanup(process); -# endif - } -#endif /* defined(ECL_UNIX_BACKTRACE) || defined(ECL_WINDOWS_BACKTRACE) */ -} - cl_object si_dump_c_backtrace(cl_object size) {