diff --git a/CHANGELOG b/CHANGELOG index d2c5c2ae2..e930341e8 100644 --- a/CHANGELOG +++ b/CHANGELOG @@ -29,6 +29,7 @@ * Pending changes since 16.1.3 ** Enhancements +- improvements to C backend interface by Marius Gerbershagen - better handling of fifo files (see man 7 fifo) - unicode names are always linked for unicode builds (~--with-unicode-names~ removed) - numerous bytecodes compiler enhancements diff --git a/msvc/Makefile b/msvc/Makefile index 8d159786f..5ab61530f 100755 --- a/msvc/Makefile +++ b/msvc/Makefile @@ -60,6 +60,8 @@ ECL_RT = ECL_DEFSYS = # Profiling ECL_PROFILE = +# Use the DbgHelp.lib shared library to provide C Backtrace support +ECL_USE_DBGHELP = $(ECL_DEBUG) !if "$(YASM)" == "" !if "$(ECL_WIN64)" != "" @@ -78,7 +80,9 @@ TAR_DIR = %CD%\ecl-$(ECL_VERSION) # CC = cl -LIBS = eclgc.lib eclgmp.lib user32.lib ws2_32.lib shell32.lib +CLIBS = user32.lib ws2_32.lib shell32.lib +STATICLIBS = eclgc.lib eclgmp.lib +LIBS = $(STATICLIBS) $(CLIBS) RM = del RMDIR = rmdir /Q /S MKDIR = mkdir @@ -123,6 +127,10 @@ SHARED_LDFLAGS = /LD GCFLAGS = nodebug=1 !endif +!if "$(ECL_USE_DBGHELP)" != "" +CLIBS = $(CLIBS) DbgHelp.lib +!endif + CFLAGS = /EHsc /DGC_DLL /DGC_BUILD /nologo /D_CRT_SECURE_NO_DEPRECATE $(CFLAGS_CONFIG) LDFLAGS = /link /incremental:no /nologo /nodefaultlib:libcmt /nodefaultlib:libcmtd /nodefaultlib:libc /nodefaultlib:libcd $(LDFLAGS_CONFIG) @@ -263,9 +271,9 @@ compile.lsp: bare.lsp $(srcdir)/compile.lsp.in Makefile "@LDFLAGS@" "$(LDFLAGS)" \ "@SHARED_LDFLAGS@" "$(SHARED_LDFLAGS)" \ "@BUNDLE_LDFLAGS@" "$(SHARED_LDFLAGS)" \ - "@CLIBS@" "user32.lib ws2_32.lib shell32.lib" \ - "@STATICLIBS@" "eclgmp.lib eclgc.lib" \ - "@LIBS@" "user32.lib ws2_32.lib shell32.lib" \ + "@CLIBS@" "$(CLIBS)" \ + "@STATICLIBS@" "$(STATICLIBS)" \ + "@LIBS@" "$(LIBS)" \ "@CORE_LIBS@" "" \ "@FASL_LIBS@" "" \ "@OBJEXT@" "obj" \ @@ -305,8 +313,8 @@ cmp/cmpdefs.lsp: $(srcdir)/cmp/cmpdefs.lsp Makefile "@LDFLAGS@" "$(LDFLAGS)" \ "@SHARED_LDFLAGS@" "$(SHARED_LDFLAGS)" \ "@BUNDLE_LDFLAGS@" "$(SHARED_LDFLAGS)" \ - "@CLIBS@" "user32.lib ws2_32.lib shell32.lib" \ - "@STATICLIBS@" "eclgmp.lib eclgc.lib" \ + "@CLIBS@" "$(CLIBS)" \ + "@STATICLIBS@" "$(STATICLIBS)" \ "@OBJEXT@" "obj" \ "@SHAREDPREFIX@" "" \ "@SHAREDEXT@" "dll" \ @@ -340,6 +348,7 @@ eclmin.lib: eclgmp.lib eclgc.lib lsp/config.lsp $(MAKE) ECL_VERSION_NUMBER=$(ECL_VERSION_NUMBER) \ ECL_THREADS=$(ECL_THREADS) ECL_UNICODE=$(ECL_UNICODE) \ ECL_SSE=$(ECL_SSE) ECL_WIN64=$(ECL_WIN64) \ + ECL_USE_DBGHELP=$(ECL_USE_DBGHELP) \ "ECL_CFLAGS=$(CFLAGS) -DGC_BUILD" cd .. eclgc.lib: @@ -448,6 +457,7 @@ clean_ecl: -$(MAKE) ECL_VERSION_NUMBER=$(ECL_VERSION_NUMBER) \ ECL_THREADS=$(ECL_THREADS) ECL_UNICODE=$(ECL_UNICODE) \ ECL_SSE=$(ECL_SSE) ECL_WIN64=$(ECL_WIN64) \ + ECL_USE_DBGHELP=$(ECL_USE_DBGHELP) \ "ECL_CFLAGS=$(CFLAGS) -DGC_BUILD" clean cd .. clean_lisp: diff --git a/msvc/c/Makefile b/msvc/c/Makefile index ec87976a1..15a594f1c 100755 --- a/msvc/c/Makefile +++ b/msvc/c/Makefile @@ -35,6 +35,12 @@ ECL_SSE_FLAG=0 ECL_SSE_OBJ= !endif +!if "$(ECL_USE_DBGHELP)" != "" +ECL_USE_DBGHELP_FLAG=1 +!else +ECL_USE_DBGHELP_FLAG=0 +!endif + # Programs used by "make": # TRUE_CC = cl @@ -60,12 +66,14 @@ libdir=$(prefix)\lib\ecl # Files HDIR = $(top_srcdir)\h -HFILES = ..\ecl\config.h ..\ecl\atomic_ops.h $(HDIR)\ecl.h $(HDIR)\ecl-cmp.h\ - $(HDIR)\object.h $(HDIR)\cs.h $(HDIR)\stacks.h\ - $(HDIR)\external.h $(HDIR)\cons.h $(HDIR)\legacy.h\ +HFILES = ..\ecl\config.h ..\ecl\config-internal.h ..\ecl\atomic_ops.h \ + $(HDIR)\ecl.h $(HDIR)\ecl-cmp.h \ + $(HDIR)\object.h $(HDIR)\cs.h $(HDIR)\stacks.h \ + $(HDIR)\external.h $(HDIR)\cons.h $(HDIR)\legacy.h \ $(HDIR)\number.h $(HDIR)\page.h \ $(HDIR)\internal.h $(HDIR)\ecl-inl.h $(HDIR)\bytecodes.h \ - $(HDIR)\impl\math_dispatch.h + $(HDIR)\impl\math_dispatch.h $(HDIR)\cache.h $(HDIR)\stack-resize.h \ + $(HDIR)\ecl-atomic-ops.h OBJS = main.obj symbol.obj package.obj cons.obj list.obj\ apply.obj eval.obj \ @@ -153,21 +161,23 @@ clean: # Build rules -$(DPP): $(srcdir)/dpp.c $(srcdir)/symbols_list2.h ../ecl/config.h +$(DPP): $(srcdir)/dpp.c $(srcdir)/symbols_list2.h ../ecl/config.h ../ecl/config-internal.h $(TRUE_CC) -I.. -I./ $(srcdir)/dpp.c -o $@ -$(HFILES): ../ecl/config.h.msvc6 Makefile +$(HFILES): ../ecl/config.h.msvc6 ../ecl/config-internal.h.msvc6 Makefile -mkdir ..\ecl\impl cut.exe "@ECL_FPE_CODE@" "$(srcdir:\=/)/arch/$(ECL_FPE_CODE)" \ "@ECL_VERSION_NUMBER@" "$(ECL_VERSION_NUMBER)" \ "@ECL_THREADS@" "$(ECL_THREADS_FLAG)" \ "@ECL_UNICODE@" "$(ECL_UNICODE_FLAG)" \ "@ECL_SSE2@" "$(ECL_SSE_FLAG)" \ + "@ECL_USE_DBGHELP@" "$(ECL_USE_DBGHELP_FLAG)" \ < ..\ecl\config.h.msvc6 > ..\ecl\config.h cut.exe "@ECL_FPE_CODE@" "$(srcdir:\=/)/arch/$(ECL_FPE_CODE)" \ "@ECL_VERSION_NUMBER@" "$(ECL_VERSION_NUMBER)" \ "@ECL_THREADS@" "$(ECL_THREADS_FLAG)" \ "@ECL_UNICODE@" "$(ECL_UNICODE_FLAG)" \ "@ECL_SSE2@" "$(ECL_SSE_FLAG)" \ + "@ECL_USE_DBGHELP@" "$(ECL_USE_DBGHELP_FLAG)" \ < ..\ecl\config-internal.h.msvc6 > ..\ecl\config-internal.h xcopy /SYI $(top_srcdir)\h\*.h ..\ecl -mkdir ..\ecl\atomic_ops diff --git a/msvc/ecl/config-internal.h.msvc6 b/msvc/ecl/config-internal.h.msvc6 index 18694fcef..758d3977a 100644 --- a/msvc/ecl/config-internal.h.msvc6 +++ b/msvc/ecl/config-internal.h.msvc6 @@ -210,3 +210,8 @@ # define ECL_MATHERR_CLEAR # define ECL_MATHERR_TEST #endif + +#define ECL_WINDOWS_BACKTRACE @ECL_USE_DBGHELP@ +#if !ECL_WINDOWS_BACKTRACE +#undef ECL_WINDOWS_BACKTRACE +#endif diff --git a/src/aclocal.m4 b/src/aclocal.m4 index f4e4527ef..82bce9eca 100644 --- a/src/aclocal.m4 +++ b/src/aclocal.m4 @@ -831,22 +831,6 @@ AC_MSG_CHECKING([Linker flags]) AC_MSG_RESULT([${LDFLAGS}]) ]) -dnl -------------------------------------------------------------- -dnl Determine whether GCC supports backtraces -dnl -AC_DEFUN([ECL_GCC_BACKTRACE],[ -if test "x${cross_compiling}" != "xyes"; then -AC_RUN_IFELSE( - [AC_LANG_SOURCE([[ - void *foo() { return __builtin_return_address(1); } - int main() { - return (foo() == 0); - }]])], - [AC_DEFINE([HAVE___BUILTIN_RETURN_ADDRESS], [], [HAVE___BUILTIN_RETURN_ADDRESS])], - []) -fi -]) - dnl ---------------------------------------------------------------------- dnl Choose the type of code to detect floating point exceptions and dnl raise them. diff --git a/src/c/error.d b/src/c/error.d index d0dc16881..8e9ea3fa0 100644 --- a/src/c/error.d +++ b/src/c/error.d @@ -54,7 +54,7 @@ ecl_internal_error(const char *s) strerror(saved_errno)); } fflush(stderr); - si_dump_c_backtrace(ecl_make_fixnum(32)); + _ecl_dump_c_backtrace(); #ifdef SIGIOT signal(SIGIOT, SIG_DFL); /* avoid getting into a loop with abort */ #endif diff --git a/src/c/ffi/backtrace.d b/src/c/ffi/backtrace.d index ce4b8d655..1bdcb8f49 100644 --- a/src/c/ffi/backtrace.d +++ b/src/c/ffi/backtrace.d @@ -14,112 +14,116 @@ #include #include -#ifdef HAVE_DLADDR -# ifdef HAVE_DLFCN_H -# include -# endif -#endif - -#if defined(HAVE_BACKTRACE) || defined(HAVE_BACKTRACE_SYMBOLS) +#if defined(HAVE_BACKTRACE) && defined(HAVE_BACKTRACE_SYMBOLS) # include +# define ECL_UNIX_BACKTRACE #endif -#if !defined(HAVE_BACKTRACE) && defined(HAVE___BUILTIN_RETURN_ADDRESS) -#define HAVE_BACKTRACE -static int -backtrace(void **buffer, int n) -{ - int nframes = (n > 32)? 32 : n; - int i; - switch (nframes) { - case 32: buffer[31] = __builtin_return_address(31); - case 31: buffer[30] = __builtin_return_address(30); - case 30: buffer[29] = __builtin_return_address(29); - case 29: buffer[28] = __builtin_return_address(28); - case 28: buffer[27] = __builtin_return_address(27); - case 27: buffer[26] = __builtin_return_address(26); - case 26: buffer[25] = __builtin_return_address(25); - case 25: buffer[24] = __builtin_return_address(24); - case 24: buffer[23] = __builtin_return_address(23); - case 23: buffer[22] = __builtin_return_address(22); - case 22: buffer[21] = __builtin_return_address(21); - case 21: buffer[20] = __builtin_return_address(20); - case 20: buffer[19] = __builtin_return_address(19); - case 19: buffer[18] = __builtin_return_address(18); - case 18: buffer[17] = __builtin_return_address(17); - case 17: buffer[16] = __builtin_return_address(16); - case 16: buffer[15] = __builtin_return_address(15); - case 15: buffer[14] = __builtin_return_address(14); - case 14: buffer[13] = __builtin_return_address(13); - case 13: buffer[12] = __builtin_return_address(12); - case 12: buffer[11] = __builtin_return_address(11); - case 11: buffer[10] = __builtin_return_address(10); - case 10: buffer[9] = __builtin_return_address(9); - case 9: buffer[8] = __builtin_return_address(8); - case 8: buffer[7] = __builtin_return_address(7); - case 7: buffer[6] = __builtin_return_address(6); - case 6: buffer[5] = __builtin_return_address(5); - case 5: buffer[4] = __builtin_return_address(4); - case 4: buffer[3] = __builtin_return_address(3); - case 3: buffer[2] = __builtin_return_address(2); - case 2: buffer[1] = __builtin_return_address(1); - case 1: buffer[0] = __builtin_return_address(0); - } - return nframes; -} +#if defined(ECL_WINDOWS_BACKTRACE) +# include +# include #endif -#if !defined(HAVE_BACKTRACE_SYMBOLS) -# if defined(HAVE_BACKTRACE) && defined(HAVE_DLADDR) -# define HAVE_BACKTRACE_SYMBOLS -# define BACKTRACE_SYMBOLS_SIMPLE -static char ** -backtrace_symbols(void **buffer, int nframes) +/* 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() { - Dl_info data[1]; - int i; - char **strings = malloc(nframes * sizeof(char*)); - for (i = 0; i < nframes; i++) { - if (dladdr(buffer[i], data)) { - strings[i] = data->dli_sname; - } else { - strings[i] = "unknown"; +#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 } - return strings; +#endif /* defined(ECL_UNIX_BACKTRACE) || defined(ECL_WINDOWS_BACKTRACE) */ } -# endif /* HAVE_BACKTRACE && HAVE_DLADDR */ -#endif /* !HAVE_BACKTRACE_SYMBOLS */ cl_object si_dump_c_backtrace(cl_object size) { cl_env_ptr the_env = ecl_process_env(); -#ifdef HAVE_BACKTRACE_SYMBOLS +#if defined(ECL_UNIX_BACKTRACE) || defined(ECL_WINDOWS_BACKTRACE) { - void *pointers[32]; - int nframes = backtrace(pointers, 32); + cl_index nsize = ecl_to_unsigned_integer(size); + void **pointers = malloc(sizeof(void*) * nsize); +# if defined(ECL_UNIX_BACKTRACE) + int nframes = backtrace(pointers, nsize); char **names = backtrace_symbols(pointers, nframes); - int i; - fprintf(stderr, "\n;;; ECL C Backtrace\n"); - for (i = 0; i < nframes; i++) { -#ifdef BACKTRACE_SYMBOLS_SIMPLE - fprintf(stderr, ";;; %4d %s (%p) \n", i, names[i], pointers[i]); -#else - fprintf(stderr, ";;; %s\n", names[i]); -#endif +# elif defined(ECL_WINDOWS_BACKTRACE) + HANDLE process = GetCurrentProcess(); + if (!SymInitialize(process, NULL, TRUE)) { + return; } - fflush(stderr); + int nframes = CaptureStackBackTrace(0, nsize, 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; + cl_format(2, ECL_T, make_constant_base_string("~&C Backtrace:~%")); + for (i = 0; i < nframes; i++) { +# if defined(ECL_UNIX_BACKTRACE) + cl_format(3, ECL_T, make_constant_base_string(" > ~a~%"), + make_constant_base_string(names[i])); +# elif defined(ECL_WINDOWS_BACKTRACE) + DWORD64 displacement; + if (SymFromAddr(process, (DWORD64) pointers[i], &displacement, pSymbol)) { + cl_format(5, ECL_T, make_constant_base_string(" > (~a+0x~x) [0x~x]~%"), + make_constant_base_string(pSymbol->Name), + ecl_make_unsigned_integer(displacement), + ecl_make_unsigned_integer((cl_index)pointers[i])); + } else { + cl_format(3, ECL_T, make_constant_base_string(" > (unknown) [0x~x]~%"), + ecl_make_unsigned_integer((cl_index)pointers[i])); + } +# endif + } + free(pointers); +# if defined(ECL_UNIX_BACKTRACE) free(names); +# elif defined(ECL_WINDOWS_BACKTRACE) + SymCleanup(process); +# endif } ecl_return1(the_env, ECL_T); #else ecl_return1(the_env, ECL_NIL); -#endif -} - -cl_object -si_backtrace(cl_object start, cl_object end) -{ - @(return ECL_NIL); +#endif /* defined(ECL_UNIX_BACKTRACE) || defined(ECL_WINDOWS_BACKTRACE) */ } diff --git a/src/configure b/src/configure index 7c773b7ba..be1d07b61 100755 --- a/src/configure +++ b/src/configure @@ -1521,8 +1521,7 @@ Optional Packages: --with-rt Deprecated! include MIT-RT testing environment (yes|builtin|no, default=NO) --with-profile Deprecated! include CMUCL's simple profiler - (yes|builtin|no, default=YES if Boehm-Weiser garbage - collector used) + (yes|builtin|no, default=NO) --with-dffi dynamic foreign function interface (system|included|auto|no, default=AUTO if libffi available) @@ -2859,7 +2858,7 @@ fi if test "${with_profile+set}" = set; then : withval=$with_profile; else - with_profile=NO + with_profile=no fi @@ -9422,33 +9421,6 @@ $as_echo "#define ECL_CXX_CORE 1" >>confdefs.h fi -if test "x${cross_compiling}" != "xyes"; then -if test "$cross_compiling" = yes; then : - { { $as_echo "$as_me:${as_lineno-$LINENO}: error: in \`$ac_pwd':" >&5 -$as_echo "$as_me: error: in \`$ac_pwd':" >&2;} -as_fn_error $? "cannot run test program while cross compiling -See \`config.log' for more details" "$LINENO" 5; } -else - cat confdefs.h - <<_ACEOF >conftest.$ac_ext -/* end confdefs.h. */ - - void *foo() { return __builtin_return_address(1); } - int main() { - return (foo() == 0); - } -_ACEOF -if ac_fn_c_try_run "$LINENO"; then : - -$as_echo "#define HAVE___BUILTIN_RETURN_ADDRESS /**/" >>confdefs.h - -fi -rm -f core *.core core.conftest.* gmon.out bb.out conftest$ac_exeext \ - conftest.$ac_objext conftest.beam conftest.$ac_ext -fi - -fi - - case "${enable_libatomic}" in auto|system|included) ;; *) as_fn_error $? "Invalid value of --enable-libatomic: ${enable_libatomic} " "$LINENO" 5;; diff --git a/src/configure.ac b/src/configure.ac index 162b9b8e3..297482eb0 100644 --- a/src/configure.ac +++ b/src/configure.ac @@ -192,8 +192,8 @@ AC_ARG_WITH(rt, AC_ARG_WITH(profile, AS_HELP_STRING( [--with-profile], [Deprecated! include CMUCL's simple profiler] - [(yes|builtin|no, default=YES if Boehm-Weiser garbage collector used)]), - [], [with_profile=NO]) + [(yes|builtin|no, default=NO)]), + [], [with_profile=no]) AC_ARG_WITH(dffi, AS_HELP_STRING( [--with-dffi], @@ -752,7 +752,6 @@ else boehm_configure_flags="${boehm_configure_flags} --enable-cplusplus" fi -ECL_GCC_BACKTRACE ECL_LIBATOMIC_OPS dnl ---------------------------------------------------------------------- diff --git a/src/ecl/configpre.h b/src/ecl/configpre.h index 2aa0c57bd..96795696f 100644 --- a/src/ecl/configpre.h +++ b/src/ecl/configpre.h @@ -431,9 +431,6 @@ /* Define to 1 if the system has the type `_Bool'. */ #undef HAVE__BOOL -/* HAVE___BUILTIN_RETURN_ADDRESS */ -#undef HAVE___BUILTIN_RETURN_ADDRESS - /* Define to 1 if `lstat' dereferences a symlink specified with a trailing slash. */ #undef LSTAT_FOLLOWS_SLASHED_SYMLINK diff --git a/src/h/config-internal.h.in b/src/h/config-internal.h.in index edffb87f3..2111d7df8 100644 --- a/src/h/config-internal.h.in +++ b/src/h/config-internal.h.in @@ -161,10 +161,8 @@ /* existence of char **environ */ #undef HAVE_ENVIRON /* existence of pointer -> function name functions */ -#undef HAVE_DLADDR #undef HAVE_BACKTRACE #undef HAVE_BACKTRACE_SYMBOLS -#undef HAVE___BUILTIN_RETURN_ADDRESS #undef HAVE_SCHED_H /* diff --git a/src/h/external.h b/src/h/external.h index 755cbbaa0..f1e7a72ce 100755 --- a/src/h/external.h +++ b/src/h/external.h @@ -632,7 +632,6 @@ extern ECL_API cl_object si_mmap_array(cl_object map); /* ffi/backtrace.d */ extern ECL_API cl_object si_dump_c_backtrace(cl_object size); -extern ECL_API cl_object si_backtrace(cl_object start, cl_object end); /* ffi.c */ diff --git a/src/lsp/top.lsp b/src/lsp/top.lsp index 493ca8ec1..f8c0b9202 100644 --- a/src/lsp/top.lsp +++ b/src/lsp/top.lsp @@ -55,33 +55,33 @@ (defconstant tpl-commands '(("Top level commands" ((:cf :compile-file) tpl-compile-command :string - ":cf Compile file" + ":cf Compile file" ":compile-file &string &rest files [Top level command]~@ :cf &string &rest files [Abbreviation]~@ ~@ Compile files. With no arguments, uses values from latest :cf~@ command. File extensions are optional.~%") ((:exit :eof) quit :eval - ":exit Exit Lisp" + ":exit Exit Lisp" ":exit &eval &optional (status 0) [Top level command]~@ ~@ Exit Lisp without further confirmation.~%") ((:ld :load) tpl-load-command :string - ":ld Load file" + ":ld Load file" ":load &string &rest files [Top level command]~@ :ld &string &rest files [Abbreviation]~@ ~@ Load files. With no arguments, uses values from latest :ld~@ or :cf command. File extensions are optional.~%") ((:step) tpl-step-command nil - ":step Single step form" + ":step Single step form" ":step form [Top level command]~@ ~@ Evaluate form in single step mode. While stepping, a new break~@ level is invoked before every evaluation. Extra commands are~@ available at this time to control stepping and form evaluation.~%") ((:tr :trace) tpl-trace-command nil - ":tr(ace) Trace function" + ":tr(ace) Trace function" ":trace &rest functions [Top level command]~@ :tr &rest functions [Abbreviation]~@ ~@ @@ -90,7 +90,7 @@ ~@ See also: :untrace.~%") ((:untr :untrace) tpl-untrace-command nil - ":untr(ace) Untrace function" + ":untr(ace) Untrace function" ":untrace &rest functions [Top level command]~@ :untr &rest functions [Abbreviation]~@ ~@ @@ -100,7 +100,7 @@ See also: :trace.~%") #+threads ((:s :switch) tpl-switch-command nil - ":s(witch) Switch to next process to debug" + ":s(witch) Switch to next process to debug" ":switch process [Break command]~@ :s processs [Abbreviation]~@ ~@ @@ -109,7 +109,7 @@ of the process in the debugger waiting list.~%") #+threads ((:br :break) tpl-interrupt-command nil - ":br(eak) Stop a given process" + ":br(eak) Stop a given process" ":break process [Break command]~@ :br processs [Abbreviation]~@ ~@ @@ -118,7 +118,7 @@ of the process in the debugger waiting list (:waiting).~%") #+threads ((:w :waiting) tpl-waiting-command nil - ":w(aiting) Display list of active toplevels" + ":w(aiting) Display list of active toplevels" ":waiting [Break command]~@ :w [Abbreviation]~@ ~@ @@ -126,19 +126,19 @@ ) ("Help commands" ((:apropos) tpl-apropos-command nil - ":apropos Apropos" + ":apropos Apropos" ":apropos string &optional package [Top level command]~@ ~@ Finds all available symbols whose print names contain string.~@ If a non NIL package is specified, only symbols in that package are considered.~@ ~%") ((:doc document) tpl-document-command nil - ":doc(ument) Document" + ":doc(ument) Document" ":document symbol [Top level command]~@ ~@ Displays documentation about function, print names contain string.~%") ((? :h :help) tpl-help-command nil - ":h(elp) or ? Help. Type \":help help\" for more information" + ":h(elp) or ? Help. Type \":help help\" for more information" ":help &optional topic [Top level command]~@ :h &optional topic [Abbreviation]~@ ~@ @@ -168,20 +168,20 @@ (defconstant break-commands '("Break commands" ((:q :quit) tpl-quit-command nil - ":q(uit) Return to some previous break level" + ":q(uit) Return to some previous break level" ":quit &optional n [Break command]~@ :q &optional n [Abbreviation]~@ ~@ Without argument, return to top level;~@ otherwise return to break level n.~%") ((:pop) (tpl-pop-command) :constant - ":pop Pop to previous break level" + ":pop Pop to previous break level" ":pop [Break command]~@ ~@ Pop to previous break level, or if already in top level,~@ exit Lisp after confirmation.~%") ((:c :continue) continue nil - ":c(ontinue) Continue execution" + ":c(ontinue) Continue execution" ":continue [Break command]~@ :c [Abbreviation]~@ ~@ @@ -189,7 +189,7 @@ This command is only available when the break level is continuable~@ (e.g., called from a correctable error or the function break).~%") ((:b :backtrace) tpl-backtrace nil - ":b(acktrace) Print backtrace" + ":b(acktrace) Print backtrace" ":backtrace &optional n [Break command]~@ :b &optional n [Abbreviation]~@ ~@ @@ -202,7 +202,7 @@ ~@ See also: :function, :previous, :next.~%") ((:f :function) tpl-print-current nil - ":f(unction) Show current function" + ":f(unction) Show current function" ":function [Break command]~@ :f [Abbreviation]~@ ~@ @@ -213,7 +213,7 @@ ~@ See also: :backtrace, :next, previous, :disassemble, :variables.~%") ((:p :previous) tpl-previous nil - ":p(revious) Go to previous function" + ":p(revious) Go to previous function" ":previous &optional (n 1) [Break command]~@ :p &optional (n 1) [Abbreviation]~@ ~@ @@ -222,11 +222,11 @@ ~@ See also: :backtrace, :function, :go, :next.~%") ((:d :down) tpl-previous nil - ":d(own) Alias to :previous" + ":d(own) Alias to :previous" "" ) ((:n :next) tpl-next nil - ":n(ext) Go to next function" + ":n(ext) Go to next function" ":next &optional (n 1) [Break command]~@ :n &optional (n 1) [Abbreviation]~@ ~@ @@ -235,18 +235,18 @@ ~@ See also: :backtrace, :function, :go, :previous.~%") ((:u :up) tpl-next nil - ":u(p) Alias to :next" + ":u(p) Alias to :next" "" ) ((:g :go) tpl-go nil - ":g(o) Go to next function" + ":g(o) Go to next function" ":go &optional (n 1) [Break command]~@ :g &optional (n 1) [Abbreviation]~@ ~@ Move to the function at IHS[i].~@ See also: :backtrace, :function, :next, :previous.~%") ((:fs :forward-search) tpl-forward-search :string - ":fs Search forward for function" + ":fs Search forward for function" ":forward-search &string substring [Break command]~@ :fs &string substring [Abbreviation]~@ ~@ @@ -255,7 +255,7 @@ ~@ See also: :backtrace, :function, :next.~%") ((:bs :backward-search) tpl-backward-search :string - ":bs Search backward for function" + ":bs Search backward for function" ":backward-search &string substring [Break command]~@ :bs &string substring [Abbreviation]~@ ~@ @@ -264,7 +264,7 @@ ~@ See also: :backtrace, :function, :previous.~%") ((:disassemble) tpl-disassemble-command nil - ":disassemble Disassemble current function" + ":disassemble Disassemble current function" ":disassemble [Break command]~@ :disassemble [Abbreviation]~@ ~@ @@ -278,7 +278,7 @@ Show the lisp code of the current function. Only works for interpreted~@ functions.~%") ((:v :variables) tpl-variables-command nil - ":v(ariables) Show local variables, functions, blocks, and tags" + ":v(ariables) Show local variables, functions, blocks, and tags" ":variables &optional no-values [Break command]~@ :v &optional no-values [Abbreviation]~@ ~@ @@ -288,7 +288,7 @@ unless the argument is non-null.~%") #| ((:l :local) tpl-local-command nil - ":l(ocal) Return the nth local value on the stack" + ":l(ocal) Return the nth local value on the stack" ":local &optional (n 0) [Break command]~@ :l &optional (n 0) [Abbreviation] ~@ @@ -297,14 +297,14 @@ level as well as saved in the variable *.~%") |# ((:hide) tpl-hide nil - ":hide Hide function" + ":hide Hide function" ":hide function [Break command]~@ ~@ Hide function. A hidden function is not displayed in a backtrace.~@ ~@ See also: :backtrace, :unhide, :hide-package.~%") ((:unhide) tpl-unhide nil - ":unhide Unhide function" + ":unhide Unhide function" ":unhide function [Break command]~@ ~@ Unhide function. The specified function will be displayed in future~@ @@ -312,7 +312,7 @@ ~@ See also: :backtrace, :hide, :unhide-package.~%") ((:hp :hide-package) tpl-hide-package nil - ":hp Hide package" + ":hp Hide package" ":hide-package package [Break command]~@ :hp package [Abbreviation]~@ ~@ @@ -321,7 +321,7 @@ ~@ See also: :backtrace, :unhide-package.~%") ((:unhp :unhide-package) tpl-unhide-package nil - ":unhp Unhide package" + ":unhp Unhide package" ":unhide-package package [Break command]~@ :unhp package [Abbreviation]~@ ~@ @@ -330,7 +330,7 @@ ~@ See also: :backtrace, :hide-package, :hide, :unhide.~%") ((:unhide-all) tpl-unhide-all nil - ":unhide-all Unhide all variables and packages" + ":unhide-all Unhide all variables and packages" ":unhide-all [Break command]~@ ~@ Unhide all variables and packages. All functions will be displayed~@ @@ -339,7 +339,7 @@ See also: :hide, :unhide, :hide-package, :unhide-package.~%") #| ((:vs :value-stack) tpl-vs-command nil - ":vs Show value stack" + ":vs Show value stack" ":value-stack &optional n [Break command]~@ :vs &optional n [Abbreviation]~@ ~@ @@ -350,7 +350,7 @@ See also: :local.~%") |# ((:bds :binding-stack) tpl-bds-command nil - ":bds Show binding stack" + ":bds Show binding stack" ":binding-stack &optional variable [Break command]~@ :bds &optional variable [Abbreviation]~@ ~@ @@ -358,23 +358,23 @@ break level. With a variable name, print nothing, but return the~@ value of the given variable on the binding stack.~%") ((:frs :frame-stack) tpl-frs-command nil - ":frs Show frame stack" + ":frs Show frame stack" "" ) ((:m :message) tpl-print-message nil - ":m(essage) Show error message" + ":m(essage) Show error message" ":message [Break command]~@ :m [Abbreviation]~@ ~@ Show current error message.~%") ((:hs :help-stack) tpl-help-stack-command nil - ":hs Help stack" + ":hs Help stack" ":help-stack [Break command]~@ :hs [Abbreviation]~@ ~@ Lists the functions to access the LISP system stacks.~%") ((:i :inspect) tpl-inspect-command nil - ":i(nspect) Inspect value of local variable" + ":i(nspect) Inspect value of local variable" ":inspect var-name [Break command]~@ :i var-name [Abbreviation]~@ ~@ @@ -383,6 +383,15 @@ then be used regardless of of the symbol's package.~@ ~@ See also: :variables.~%") + ((:cb :c-backtrace) ext::dump-c-backtrace nil + ":c(-)b(acktrace) Print a raw C backtrace" + ":c-backtrace n [Break command]~@ + :cb n [Abbreviation]~@ + ~@ + Show function call history of the n C functions above and~@ + including the current one.~@ + ~@ + See also: :backtrace.~%") )) (defparameter *lisp-initialized* nil)