backtrace.c 9.3 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332
  1. /* Printing of backtraces and error messages
  2. Copyright 1996-2001,2003-2004,2006,2009-2011,2014,2018
  3. Free Software Foundation, Inc.
  4. This file is part of Guile.
  5. Guile is free software: you can redistribute it and/or modify it
  6. under the terms of the GNU Lesser General Public License as published
  7. by the Free Software Foundation, either version 3 of the License, or
  8. (at your option) any later version.
  9. Guile is distributed in the hope that it will be useful, but WITHOUT
  10. ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
  11. FITNESS FOR A PARTICULAR PURPOSE. See the GNU Lesser General Public
  12. License for more details.
  13. You should have received a copy of the GNU Lesser General Public
  14. License along with Guile. If not, see
  15. <https://www.gnu.org/licenses/>. */
  16. #ifdef HAVE_CONFIG_H
  17. # include <config.h>
  18. #endif
  19. #include <stdio.h>
  20. #include <ctype.h>
  21. #include <unistd.h>
  22. #ifdef HAVE_IO_H
  23. #include <io.h>
  24. #endif
  25. #include "boolean.h"
  26. #include "deprecation.h"
  27. #include "dynwind.h"
  28. #include "eval.h"
  29. #include "filesys.h"
  30. #include "fluids.h"
  31. #include "frames.h"
  32. #include "gsubr.h"
  33. #include "keywords.h"
  34. #include "list.h"
  35. #include "modules.h"
  36. #include "numbers.h"
  37. #include "ports.h"
  38. #include "posix.h"
  39. #include "private-options.h"
  40. #include "srcprop.h"
  41. #include "stacks.h"
  42. #include "strings.h"
  43. #include "strports.h"
  44. #include "struct.h"
  45. #include "symbols.h"
  46. #include "throw.h"
  47. #include "variable.h"
  48. #include "backtrace.h"
  49. /* {Error reporting and backtraces}
  50. *
  51. * Note that these functions shouldn't generate errors themselves.
  52. */
  53. static SCM
  54. boot_print_exception (SCM port, SCM frame, SCM key, SCM args)
  55. #define FUNC_NAME "boot-print-exception"
  56. {
  57. scm_puts ("Throw to key ", port);
  58. scm_write (key, port);
  59. scm_puts (" with args ", port);
  60. scm_write (args, port);
  61. return SCM_UNSPECIFIED;
  62. }
  63. #undef FUNC_NAME
  64. static SCM print_exception_var;
  65. static SCM print_frame_var;
  66. static SCM kw_count;
  67. static SCM print_frames_var;
  68. static SCM frame_to_stack_vector_var;
  69. static void
  70. init_print_exception_var (void)
  71. {
  72. print_exception_var
  73. = scm_module_variable (scm_the_root_module (),
  74. scm_from_latin1_symbol ("print-exception"));
  75. }
  76. static void
  77. init_print_frame_var (void)
  78. {
  79. print_frame_var =
  80. scm_c_public_variable ("system repl debug", "print-frame");
  81. }
  82. static void
  83. init_print_frames_var_and_frame_to_stack_vector_var (void)
  84. {
  85. kw_count = scm_from_latin1_keyword ("count");
  86. print_frames_var =
  87. scm_c_public_variable ("system repl debug", "print-frames");
  88. frame_to_stack_vector_var =
  89. scm_c_public_variable ("system repl debug", "frame->stack-vector");
  90. }
  91. SCM
  92. scm_print_exception (SCM port, SCM frame, SCM key, SCM args)
  93. #define FUNC_NAME "print-exception"
  94. {
  95. static scm_i_pthread_once_t once = SCM_I_PTHREAD_ONCE_INIT;
  96. scm_i_pthread_once (&once, init_print_exception_var);
  97. SCM_VALIDATE_OPOUTPORT (1, port);
  98. if (scm_is_true (frame))
  99. SCM_VALIDATE_FRAME (2, frame);
  100. SCM_VALIDATE_SYMBOL (3, key);
  101. SCM_VALIDATE_LIST (4, args);
  102. return scm_call_4 (scm_variable_ref (print_exception_var),
  103. port, frame, key, args);
  104. }
  105. #undef FUNC_NAME
  106. /* Print parameters for error messages. */
  107. #define DISPLAY_ERROR_MESSAGE_MAX_LEVEL 7
  108. #define DISPLAY_ERROR_MESSAGE_MAX_LENGTH 10
  109. /* Print parameters for failing expressions in error messages.
  110. * (See also `print_params' below for backtrace print parameters.)
  111. */
  112. #define DISPLAY_EXPRESSION_MAX_LEVEL 2
  113. #define DISPLAY_EXPRESSION_MAX_LENGTH 3
  114. #undef SCM_ASSERT
  115. #define SCM_ASSERT(_cond, _arg, _pos, _subr) \
  116. if (!(_cond)) \
  117. return SCM_BOOL_F;
  118. void
  119. scm_display_error_message (SCM message, SCM args, SCM port)
  120. {
  121. scm_print_exception (port, SCM_BOOL_F, scm_misc_error_key,
  122. scm_list_3 (SCM_BOOL_F, message, args));
  123. }
  124. /* The function scm_i_display_error prints out a detailed error message. This
  125. * function will be called directly within libguile to signal error messages.
  126. * No parameter checks will be performed by scm_i_display_error. Thus, User
  127. * code should rather use the function scm_display_error.
  128. */
  129. void
  130. scm_i_display_error (SCM frame, SCM port, SCM subr, SCM message, SCM args, SCM rest)
  131. {
  132. scm_print_exception (port, frame, scm_misc_error_key,
  133. scm_list_3 (subr, message, args));
  134. }
  135. SCM_DEFINE (scm_display_error, "display-error", 6, 0, 0,
  136. (SCM frame, SCM port, SCM subr, SCM message, SCM args, SCM rest),
  137. "Display an error message to the output port @var{port}.\n"
  138. "@var{frame} is the frame in which the error occurred, @var{subr} is\n"
  139. "the name of the procedure in which the error occurred and\n"
  140. "@var{message} is the actual error message, which may contain\n"
  141. "formatting instructions. These will format the arguments in\n"
  142. "the list @var{args} accordingly. @var{rest} is currently\n"
  143. "ignored.")
  144. #define FUNC_NAME s_scm_display_error
  145. {
  146. SCM_VALIDATE_OUTPUT_PORT (2, port);
  147. scm_i_display_error (frame, port, subr, message, args, rest);
  148. return SCM_UNSPECIFIED;
  149. }
  150. #undef FUNC_NAME
  151. SCM_DEFINE (scm_display_application, "display-application", 1, 2, 0,
  152. (SCM frame, SCM port, SCM indent),
  153. "Display a procedure application @var{frame} to the output port\n"
  154. "@var{port}. @var{indent} specifies the indentation of the\n"
  155. "output.")
  156. #define FUNC_NAME s_scm_display_application
  157. {
  158. static scm_i_pthread_once_t once = SCM_I_PTHREAD_ONCE_INIT;
  159. scm_i_pthread_once (&once, init_print_frame_var);
  160. /* FIXME perhaps: ignoring indent. But really we should deprecate
  161. this procedure in favor of print-frame. */
  162. return scm_call_2 (scm_variable_ref (print_frame_var), frame, port);
  163. }
  164. #undef FUNC_NAME
  165. struct display_backtrace_args {
  166. SCM stack;
  167. SCM port;
  168. SCM first;
  169. SCM depth;
  170. SCM highlight_objects;
  171. };
  172. static SCM
  173. display_backtrace_body (struct display_backtrace_args *a)
  174. #define FUNC_NAME "display-backtrace"
  175. {
  176. static scm_i_pthread_once_t once = SCM_I_PTHREAD_ONCE_INIT;
  177. SCM frames;
  178. scm_i_pthread_once (&once,
  179. init_print_frames_var_and_frame_to_stack_vector_var);
  180. a->port = SCM_COERCE_OUTPORT (a->port);
  181. /* Argument checking and extraction. */
  182. SCM_VALIDATE_STACK (1, a->stack);
  183. SCM_VALIDATE_OPOUTPORT (2, a->port);
  184. if (scm_is_false (a->first))
  185. a->first = SCM_INUM0;
  186. if (scm_is_false (a->depth))
  187. a->depth = scm_from_int (SCM_BACKTRACE_DEPTH);
  188. if (scm_is_false (scm_less_p (a->first, scm_stack_length (a->stack))))
  189. return SCM_UNSPECIFIED;
  190. frames = scm_call_1 (scm_variable_ref (frame_to_stack_vector_var),
  191. scm_stack_ref (a->stack, a->first));
  192. /* FIXME: highlight_objects */
  193. scm_call_4 (scm_variable_ref (print_frames_var), frames, a->port,
  194. kw_count, a->depth);
  195. return SCM_UNSPECIFIED;
  196. }
  197. #undef FUNC_NAME
  198. static SCM
  199. error_during_backtrace (void *data, SCM tag, SCM throw_args)
  200. {
  201. SCM port = SCM_PACK_POINTER (data);
  202. scm_puts ("Exception thrown while printing backtrace:\n", port);
  203. scm_print_exception (port, SCM_BOOL_F, tag, throw_args);
  204. return SCM_UNSPECIFIED;
  205. }
  206. SCM_DEFINE (scm_display_backtrace_with_highlights, "display-backtrace", 2, 3, 0,
  207. (SCM stack, SCM port, SCM first, SCM depth, SCM highlights),
  208. "Display a backtrace to the output port @var{port}. @var{stack}\n"
  209. "is the stack to take the backtrace from, @var{first} specifies\n"
  210. "where in the stack to start and @var{depth} how many frames\n"
  211. "to display. @var{first} and @var{depth} can be @code{#f},\n"
  212. "which means that default values will be used.\n"
  213. "If @var{highlights} is given it should be a list; the elements\n"
  214. "of this list will be highlighted wherever they appear in the\n"
  215. "backtrace.")
  216. #define FUNC_NAME s_scm_display_backtrace_with_highlights
  217. {
  218. struct display_backtrace_args a;
  219. a.stack = stack;
  220. a.port = port;
  221. a.first = SCM_UNBNDP (first) ? SCM_BOOL_F : first;
  222. a.depth = SCM_UNBNDP (depth) ? SCM_BOOL_F : depth;
  223. a.highlight_objects = SCM_UNBNDP (highlights) ? SCM_EOL : highlights;
  224. scm_internal_catch (SCM_BOOL_T,
  225. (scm_t_catch_body) display_backtrace_body, &a,
  226. (scm_t_catch_handler) error_during_backtrace, SCM_UNPACK_POINTER (port));
  227. return SCM_UNSPECIFIED;
  228. }
  229. #undef FUNC_NAME
  230. SCM
  231. scm_display_backtrace (SCM stack, SCM port, SCM first, SCM depth)
  232. {
  233. return scm_display_backtrace_with_highlights (stack, port, first, depth,
  234. SCM_EOL);
  235. }
  236. SCM_VARIABLE (scm_has_shown_backtrace_hint_p_var, "has-shown-backtrace-hint?");
  237. SCM_DEFINE (scm_backtrace_with_highlights, "backtrace", 0, 1, 0,
  238. (SCM highlights),
  239. "Display a backtrace of the current stack to the current\n"
  240. "output port. If @var{highlights} is given, it should be\n"
  241. "a list; the elements of this list will be highlighted\n"
  242. "wherever they appear in the backtrace.")
  243. #define FUNC_NAME s_scm_backtrace_with_highlights
  244. {
  245. SCM port = scm_current_output_port ();
  246. SCM stack = scm_make_stack (SCM_BOOL_T, SCM_EOL);
  247. if (SCM_UNBNDP (highlights))
  248. highlights = SCM_EOL;
  249. scm_newline (port);
  250. scm_puts ("Backtrace:\n", port);
  251. scm_display_backtrace_with_highlights (stack, port, SCM_BOOL_F, SCM_BOOL_F,
  252. highlights);
  253. scm_newline (port);
  254. return SCM_UNSPECIFIED;
  255. }
  256. #undef FUNC_NAME
  257. SCM
  258. scm_backtrace (void)
  259. {
  260. return scm_backtrace_with_highlights (SCM_EOL);
  261. }
  262. void
  263. scm_init_backtrace ()
  264. {
  265. scm_c_define_gsubr ("print-exception", 4, 0, 0, boot_print_exception);
  266. #include "backtrace.x"
  267. }