mirror of
https://gitlab.com/embeddable-common-lisp/ecl.git
synced 2026-03-10 15:10:25 -07:00
boot: add a file escape.d for program control transfer
Currently it contains early errors and backtrace.
This commit is contained in:
Daniel Kochmański
parent
67f22249de
commit
dc0f2bd2c7
4 changed files with 152 additions and 119 deletions
|
|
@ -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
|
||||
|
||||
|
|
|
|||
|
|
@ -24,69 +24,12 @@
|
|||
#include <ecl/internal.h>
|
||||
#include <ecl/ecl-inl.h>
|
||||
|
||||
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, ...)
|
||||
{
|
||||
|
|
|
|||
140
src/c/escape.d
Normal file
140
src/c/escape.d
Normal file
|
|
@ -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 <ecl/ecl.h>
|
||||
#include <ecl/ecl-inl.h>
|
||||
#include <ecl/internal.h>
|
||||
#include <ecl/external.h>
|
||||
#include <ecl/nucleus.h>
|
||||
|
||||
#include <stdio.h>
|
||||
#include <string.h>
|
||||
#include <errno.h>
|
||||
#include <signal.h>
|
||||
#include <stdlib.h>
|
||||
#if defined(ECL_MS_WINDOWS_HOST) || defined(cygwin)
|
||||
# include <windows.h>
|
||||
#endif
|
||||
|
||||
#if defined(HAVE_BACKTRACE) && defined(HAVE_BACKTRACE_SYMBOLS)
|
||||
# include <execinfo.h>
|
||||
# define ECL_UNIX_BACKTRACE
|
||||
#endif
|
||||
|
||||
#if defined(ECL_WINDOWS_BACKTRACE)
|
||||
# include <windows.h>
|
||||
# include <DbgHelp.h>
|
||||
#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) */
|
||||
}
|
||||
|
|
@ -24,56 +24,9 @@
|
|||
# include <DbgHelp.h>
|
||||
#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)
|
||||
{
|
||||
|
|
|
|||
Loading…
Add table
Add a link
Reference in a new issue