Commit | Line | Data |
---|---|---|
68baa7e7 | 1 | /* Debugging extensions for Guile |
e2cbf527 | 2 | * Copyright (C) 1995,1996,1997,1998,1999,2000,2001, 2002, 2003, 2006, 2008, 2009, 2010, 2011, 2012, 2013 Free Software Foundation |
ee340120 | 3 | * |
73be1d9e | 4 | * This library is free software; you can redistribute it and/or |
53befeb7 NJ |
5 | * modify it under the terms of the GNU Lesser General Public License |
6 | * as published by the Free Software Foundation; either version 3 of | |
7 | * the License, or (at your option) any later version. | |
ee340120 | 8 | * |
53befeb7 NJ |
9 | * This library is distributed in the hope that it will be useful, but |
10 | * WITHOUT ANY WARRANTY; without even the implied warranty of | |
73be1d9e MV |
11 | * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU |
12 | * Lesser General Public License for more details. | |
ee340120 | 13 | * |
73be1d9e MV |
14 | * You should have received a copy of the GNU Lesser General Public |
15 | * License along with this library; if not, write to the Free Software | |
53befeb7 NJ |
16 | * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA |
17 | * 02110-1301 USA | |
73be1d9e | 18 | */ |
f0e9217a | 19 | |
1bbd0b84 | 20 | |
dbb605f5 LC |
21 | #ifdef HAVE_CONFIG_H |
22 | # include <config.h> | |
23 | #endif | |
1bbd0b84 | 24 | |
ec900eac AW |
25 | #ifdef HAVE_GETRLIMIT |
26 | #include <sys/time.h> | |
27 | #include <sys/resource.h> | |
28 | #endif | |
29 | ||
a0599745 | 30 | #include "libguile/_scm.h" |
5e3545d0 | 31 | #include "libguile/async.h" |
a0599745 | 32 | #include "libguile/eval.h" |
37c56aec | 33 | #include "libguile/list.h" |
a0599745 MD |
34 | #include "libguile/stackchk.h" |
35 | #include "libguile/throw.h" | |
36 | #include "libguile/macros.h" | |
37 | #include "libguile/smob.h" | |
6c2961a0 | 38 | #include "libguile/struct.h" |
a0599745 MD |
39 | #include "libguile/procprop.h" |
40 | #include "libguile/srcprop.h" | |
41 | #include "libguile/alist.h" | |
42 | #include "libguile/continuations.h" | |
43 | #include "libguile/strports.h" | |
44 | #include "libguile/read.h" | |
45 | #include "libguile/feature.h" | |
46 | #include "libguile/dynwind.h" | |
47 | #include "libguile/modules.h" | |
48 | #include "libguile/ports.h" | |
49 | #include "libguile/root.h" | |
b06a8b87 | 50 | #include "libguile/fluids.h" |
e311f5fa | 51 | #include "libguile/programs.h" |
b7742c6b | 52 | #include "libguile/memoize.h" |
14aa25e4 | 53 | #include "libguile/vm.h" |
a0599745 MD |
54 | |
55 | #include "libguile/validate.h" | |
56 | #include "libguile/debug.h" | |
22fc179a HWN |
57 | |
58 | #include "libguile/private-options.h" | |
f0e9217a MD |
59 | \f |
60 | ||
22fc179a | 61 | |
ab9c9100 AW |
62 | /* |
63 | * Debugging options. | |
64 | */ | |
65 | ||
66 | scm_t_option scm_debug_opts[] = { | |
67 | { SCM_OPTION_BOOLEAN, "backwards", 0, | |
68 | "Display backtrace in anti-chronological order." }, | |
69 | { SCM_OPTION_INTEGER, "width", 79, "Maximal width of backtrace." }, | |
70 | { SCM_OPTION_INTEGER, "depth", 20, "Maximal length of printed backtrace." }, | |
71 | { SCM_OPTION_BOOLEAN, "backtrace", 1, "Show backtrace on error." }, | |
72 | /* This default stack limit will be overridden by init_stack_limit(), | |
73 | if we have getrlimit() and the stack limit is not INFINITY. But it is still | |
74 | important, as some systems have both the soft and the hard limits set to | |
75 | INFINITY; in that case we fall back to this value. | |
76 | ||
77 | The situation is aggravated by certain compilers, which can consume | |
78 | "beaucoup de stack", as they say in France. | |
79 | ||
80 | See http://thread.gmane.org/gmane.lisp.guile.devel/8599/focus=8662 for | |
81 | more discussion. This setting is 640 KB on 32-bit arches (should be enough | |
82 | for anyone!) or a whoppin' 1280 KB on 64-bit arches. | |
83 | */ | |
84 | { SCM_OPTION_INTEGER, "stack", 160000, "Stack size limit (measured in words; 0 = no check)." }, | |
210c0325 | 85 | { SCM_OPTION_SCM, "show-file-name", SCM_BOOL_T_BITS, |
ab9c9100 AW |
86 | "Show file names and line numbers " |
87 | "in backtraces when not `#f'. A value of `base' " | |
88 | "displays only base names, while `#t' displays full names."}, | |
89 | { SCM_OPTION_BOOLEAN, "warn-deprecated", 0, | |
90 | "Warn when deprecated features are used." }, | |
91 | { 0 }, | |
92 | }; | |
93 | ||
94 | ||
f0e9217a MD |
95 | /* {Run time control of the debugging evaluator} |
96 | */ | |
97 | ||
a1ec6916 | 98 | SCM_DEFINE (scm_debug_options, "debug-options-interface", 0, 1, 0, |
1bbd0b84 | 99 | (SCM setting), |
ba94f79e MG |
100 | "Option interface for the debug options. Instead of using\n" |
101 | "this procedure directly, use the procedures @code{debug-enable},\n" | |
3939e9df | 102 | "@code{debug-disable}, @code{debug-set!} and @code{debug-options}.") |
1bbd0b84 | 103 | #define FUNC_NAME s_scm_debug_options |
f0e9217a MD |
104 | { |
105 | SCM ans; | |
5e3545d0 | 106 | |
661ae7ab MV |
107 | scm_dynwind_begin (0); |
108 | scm_dynwind_critical_section (SCM_BOOL_F); | |
5e3545d0 | 109 | |
62560650 | 110 | ans = scm_options (setting, scm_debug_opts, FUNC_NAME); |
a6e350dd | 111 | scm_stack_checking_enabled_p = SCM_STACK_CHECKING_P; |
5e3545d0 | 112 | |
661ae7ab | 113 | scm_dynwind_end (); |
f0e9217a MD |
114 | return ans; |
115 | } | |
1bbd0b84 | 116 | #undef FUNC_NAME |
260b1416 | 117 | |
4e237f14 | 118 | |
bfe3154c | 119 | \f |
f0e9217a | 120 | |
c75512d6 | 121 | #if 0 |
1bbd0b84 | 122 | SCM_REGISTER_PROC (s_reverse_lookup, "reverse-lookup", 2, 0, 0, scm_reverse_lookup); |
c75512d6 MD |
123 | #endif |
124 | ||
125 | SCM | |
126 | scm_reverse_lookup (SCM env, SCM data) | |
127 | { | |
d2e53ed6 | 128 | while (scm_is_pair (env) && scm_is_pair (SCM_CAR (env))) |
c75512d6 | 129 | { |
22a52da1 DH |
130 | SCM names = SCM_CAAR (env); |
131 | SCM values = SCM_CDAR (env); | |
d2e53ed6 | 132 | while (scm_is_pair (names)) |
c75512d6 | 133 | { |
bc36d050 | 134 | if (scm_is_eq (SCM_CAR (values), data)) |
c75512d6 MD |
135 | return SCM_CAR (names); |
136 | names = SCM_CDR (names); | |
137 | values = SCM_CDR (values); | |
138 | } | |
d2e53ed6 | 139 | if (!scm_is_null (names) && scm_is_eq (values, data)) |
c75512d6 MD |
140 | return names; |
141 | env = SCM_CDR (env); | |
142 | } | |
143 | return SCM_BOOL_F; | |
144 | } | |
145 | ||
f0e9217a MD |
146 | \f |
147 | ||
fe57f652 MD |
148 | /* Undocumented debugging procedure */ |
149 | #ifdef GUILE_DEBUG | |
a1ec6916 | 150 | SCM_DEFINE (scm_debug_hang, "debug-hang", 0, 1, 0, |
1bbd0b84 | 151 | (SCM obj), |
ba94f79e MG |
152 | "Go into an endless loop, which can be only terminated with\n" |
153 | "a debugger.") | |
1bbd0b84 | 154 | #define FUNC_NAME s_scm_debug_hang |
e38ecb05 MD |
155 | { |
156 | int go = 0; | |
157 | while (!go) ; | |
158 | return SCM_UNSPECIFIED; | |
159 | } | |
1bbd0b84 | 160 | #undef FUNC_NAME |
fe57f652 | 161 | #endif |
e38ecb05 | 162 | |
60617d81 MW |
163 | static SCM local_eval_var; |
164 | ||
165 | static void | |
166 | init_local_eval_var (void) | |
167 | { | |
168 | local_eval_var = scm_c_public_variable ("ice-9 local-eval", "local-eval"); | |
169 | } | |
170 | ||
d062a8c1 AW |
171 | SCM |
172 | scm_local_eval (SCM exp, SCM env) | |
173 | { | |
60617d81 MW |
174 | static scm_i_pthread_once_t once = SCM_I_PTHREAD_ONCE_INIT; |
175 | scm_i_pthread_once (&once, init_local_eval_var); | |
d062a8c1 | 176 | |
60617d81 | 177 | return scm_call_2 (scm_variable_ref (local_eval_var), exp, env); |
d062a8c1 AW |
178 | } |
179 | ||
ec900eac AW |
180 | static void |
181 | init_stack_limit (void) | |
182 | { | |
183 | #ifdef HAVE_GETRLIMIT | |
184 | struct rlimit lim; | |
185 | if (getrlimit (RLIMIT_STACK, &lim) == 0) | |
186 | { | |
6f36dbbe | 187 | rlim_t bytes = lim.rlim_cur; |
ec900eac | 188 | |
6f36dbbe | 189 | /* set our internal stack limit to 80% of the rlimit. */ |
ec900eac AW |
190 | if (bytes == RLIM_INFINITY) |
191 | bytes = lim.rlim_max; | |
192 | ||
6f36dbbe AW |
193 | if (bytes != RLIM_INFINITY) |
194 | SCM_STACK_LIMIT = bytes * 8 / 10 / sizeof (scm_t_bits); | |
ec900eac AW |
195 | } |
196 | errno = 0; | |
197 | #endif | |
198 | } | |
199 | ||
e38ecb05 MD |
200 | \f |
201 | ||
f0e9217a MD |
202 | void |
203 | scm_init_debug () | |
204 | { | |
ec900eac | 205 | init_stack_limit (); |
62560650 | 206 | scm_init_opts (scm_debug_options, scm_debug_opts); |
ee340120 | 207 | |
f0e9217a MD |
208 | scm_add_feature ("debug-extensions"); |
209 | ||
a0599745 | 210 | #include "libguile/debug.x" |
f0e9217a | 211 | } |
89e00824 ML |
212 | |
213 | /* | |
214 | Local Variables: | |
215 | c-file-style: "gnu" | |
216 | End: | |
217 | */ |