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 | ||
5102fc37 EZ |
30 | #ifdef __MINGW32__ |
31 | # define WIN32_LEAN_AND_MEAN | |
32 | # include <windows.h> | |
33 | #endif | |
34 | ||
a0599745 | 35 | #include "libguile/_scm.h" |
5e3545d0 | 36 | #include "libguile/async.h" |
a0599745 | 37 | #include "libguile/eval.h" |
37c56aec | 38 | #include "libguile/list.h" |
a0599745 MD |
39 | #include "libguile/stackchk.h" |
40 | #include "libguile/throw.h" | |
41 | #include "libguile/macros.h" | |
42 | #include "libguile/smob.h" | |
6c2961a0 | 43 | #include "libguile/struct.h" |
a0599745 MD |
44 | #include "libguile/procprop.h" |
45 | #include "libguile/srcprop.h" | |
46 | #include "libguile/alist.h" | |
47 | #include "libguile/continuations.h" | |
48 | #include "libguile/strports.h" | |
49 | #include "libguile/read.h" | |
50 | #include "libguile/feature.h" | |
51 | #include "libguile/dynwind.h" | |
52 | #include "libguile/modules.h" | |
53 | #include "libguile/ports.h" | |
54 | #include "libguile/root.h" | |
b06a8b87 | 55 | #include "libguile/fluids.h" |
e311f5fa | 56 | #include "libguile/programs.h" |
b7742c6b | 57 | #include "libguile/memoize.h" |
14aa25e4 | 58 | #include "libguile/vm.h" |
a0599745 MD |
59 | |
60 | #include "libguile/validate.h" | |
61 | #include "libguile/debug.h" | |
22fc179a HWN |
62 | |
63 | #include "libguile/private-options.h" | |
f0e9217a MD |
64 | \f |
65 | ||
22fc179a | 66 | |
ab9c9100 AW |
67 | /* |
68 | * Debugging options. | |
69 | */ | |
70 | ||
71 | scm_t_option scm_debug_opts[] = { | |
72 | { SCM_OPTION_BOOLEAN, "backwards", 0, | |
73 | "Display backtrace in anti-chronological order." }, | |
74 | { SCM_OPTION_INTEGER, "width", 79, "Maximal width of backtrace." }, | |
75 | { SCM_OPTION_INTEGER, "depth", 20, "Maximal length of printed backtrace." }, | |
76 | { SCM_OPTION_BOOLEAN, "backtrace", 1, "Show backtrace on error." }, | |
77 | /* This default stack limit will be overridden by init_stack_limit(), | |
78 | if we have getrlimit() and the stack limit is not INFINITY. But it is still | |
79 | important, as some systems have both the soft and the hard limits set to | |
80 | INFINITY; in that case we fall back to this value. | |
81 | ||
82 | The situation is aggravated by certain compilers, which can consume | |
83 | "beaucoup de stack", as they say in France. | |
84 | ||
85 | See http://thread.gmane.org/gmane.lisp.guile.devel/8599/focus=8662 for | |
86 | more discussion. This setting is 640 KB on 32-bit arches (should be enough | |
87 | for anyone!) or a whoppin' 1280 KB on 64-bit arches. | |
88 | */ | |
89 | { SCM_OPTION_INTEGER, "stack", 160000, "Stack size limit (measured in words; 0 = no check)." }, | |
210c0325 | 90 | { SCM_OPTION_SCM, "show-file-name", SCM_BOOL_T_BITS, |
ab9c9100 AW |
91 | "Show file names and line numbers " |
92 | "in backtraces when not `#f'. A value of `base' " | |
93 | "displays only base names, while `#t' displays full names."}, | |
94 | { SCM_OPTION_BOOLEAN, "warn-deprecated", 0, | |
95 | "Warn when deprecated features are used." }, | |
96 | { 0 }, | |
97 | }; | |
98 | ||
99 | ||
f0e9217a MD |
100 | /* {Run time control of the debugging evaluator} |
101 | */ | |
102 | ||
a1ec6916 | 103 | SCM_DEFINE (scm_debug_options, "debug-options-interface", 0, 1, 0, |
1bbd0b84 | 104 | (SCM setting), |
ba94f79e MG |
105 | "Option interface for the debug options. Instead of using\n" |
106 | "this procedure directly, use the procedures @code{debug-enable},\n" | |
3939e9df | 107 | "@code{debug-disable}, @code{debug-set!} and @code{debug-options}.") |
1bbd0b84 | 108 | #define FUNC_NAME s_scm_debug_options |
f0e9217a MD |
109 | { |
110 | SCM ans; | |
5e3545d0 | 111 | |
661ae7ab MV |
112 | scm_dynwind_begin (0); |
113 | scm_dynwind_critical_section (SCM_BOOL_F); | |
5e3545d0 | 114 | |
62560650 | 115 | ans = scm_options (setting, scm_debug_opts, FUNC_NAME); |
a6e350dd | 116 | scm_stack_checking_enabled_p = SCM_STACK_CHECKING_P; |
5e3545d0 | 117 | |
661ae7ab | 118 | scm_dynwind_end (); |
f0e9217a MD |
119 | return ans; |
120 | } | |
1bbd0b84 | 121 | #undef FUNC_NAME |
260b1416 | 122 | |
4e237f14 | 123 | |
bfe3154c | 124 | \f |
f0e9217a | 125 | |
c75512d6 | 126 | #if 0 |
1bbd0b84 | 127 | SCM_REGISTER_PROC (s_reverse_lookup, "reverse-lookup", 2, 0, 0, scm_reverse_lookup); |
c75512d6 MD |
128 | #endif |
129 | ||
130 | SCM | |
131 | scm_reverse_lookup (SCM env, SCM data) | |
132 | { | |
d2e53ed6 | 133 | while (scm_is_pair (env) && scm_is_pair (SCM_CAR (env))) |
c75512d6 | 134 | { |
22a52da1 DH |
135 | SCM names = SCM_CAAR (env); |
136 | SCM values = SCM_CDAR (env); | |
d2e53ed6 | 137 | while (scm_is_pair (names)) |
c75512d6 | 138 | { |
bc36d050 | 139 | if (scm_is_eq (SCM_CAR (values), data)) |
c75512d6 MD |
140 | return SCM_CAR (names); |
141 | names = SCM_CDR (names); | |
142 | values = SCM_CDR (values); | |
143 | } | |
d2e53ed6 | 144 | if (!scm_is_null (names) && scm_is_eq (values, data)) |
c75512d6 MD |
145 | return names; |
146 | env = SCM_CDR (env); | |
147 | } | |
148 | return SCM_BOOL_F; | |
149 | } | |
150 | ||
f0e9217a MD |
151 | \f |
152 | ||
fe57f652 MD |
153 | /* Undocumented debugging procedure */ |
154 | #ifdef GUILE_DEBUG | |
a1ec6916 | 155 | SCM_DEFINE (scm_debug_hang, "debug-hang", 0, 1, 0, |
1bbd0b84 | 156 | (SCM obj), |
ba94f79e MG |
157 | "Go into an endless loop, which can be only terminated with\n" |
158 | "a debugger.") | |
1bbd0b84 | 159 | #define FUNC_NAME s_scm_debug_hang |
e38ecb05 MD |
160 | { |
161 | int go = 0; | |
162 | while (!go) ; | |
163 | return SCM_UNSPECIFIED; | |
164 | } | |
1bbd0b84 | 165 | #undef FUNC_NAME |
fe57f652 | 166 | #endif |
e38ecb05 | 167 | |
60617d81 MW |
168 | static SCM local_eval_var; |
169 | ||
170 | static void | |
171 | init_local_eval_var (void) | |
172 | { | |
173 | local_eval_var = scm_c_public_variable ("ice-9 local-eval", "local-eval"); | |
174 | } | |
175 | ||
d062a8c1 AW |
176 | SCM |
177 | scm_local_eval (SCM exp, SCM env) | |
178 | { | |
60617d81 MW |
179 | static scm_i_pthread_once_t once = SCM_I_PTHREAD_ONCE_INIT; |
180 | scm_i_pthread_once (&once, init_local_eval_var); | |
d062a8c1 | 181 | |
60617d81 | 182 | return scm_call_2 (scm_variable_ref (local_eval_var), exp, env); |
d062a8c1 AW |
183 | } |
184 | ||
ec900eac AW |
185 | static void |
186 | init_stack_limit (void) | |
187 | { | |
5102fc37 | 188 | #if defined HAVE_GETRLIMIT |
ec900eac AW |
189 | struct rlimit lim; |
190 | if (getrlimit (RLIMIT_STACK, &lim) == 0) | |
191 | { | |
6f36dbbe | 192 | rlim_t bytes = lim.rlim_cur; |
ec900eac | 193 | |
6f36dbbe | 194 | /* set our internal stack limit to 80% of the rlimit. */ |
ec900eac AW |
195 | if (bytes == RLIM_INFINITY) |
196 | bytes = lim.rlim_max; | |
197 | ||
6f36dbbe AW |
198 | if (bytes != RLIM_INFINITY) |
199 | SCM_STACK_LIMIT = bytes * 8 / 10 / sizeof (scm_t_bits); | |
ec900eac AW |
200 | } |
201 | errno = 0; | |
5102fc37 EZ |
202 | #elif defined __MINGW32__ |
203 | MEMORY_BASIC_INFORMATION m; | |
204 | uintptr_t bytes; | |
205 | ||
206 | if (VirtualQuery ((LPCVOID) &m, &m, sizeof m)) | |
207 | { | |
208 | bytes = (DWORD_PTR) m.BaseAddress + m.RegionSize | |
209 | - (DWORD_PTR) m.AllocationBase; | |
210 | SCM_STACK_LIMIT = bytes * 8 / 10 / sizeof (scm_t_bits); | |
211 | } | |
ec900eac AW |
212 | #endif |
213 | } | |
214 | ||
e38ecb05 MD |
215 | \f |
216 | ||
f0e9217a MD |
217 | void |
218 | scm_init_debug () | |
219 | { | |
ec900eac | 220 | init_stack_limit (); |
62560650 | 221 | scm_init_opts (scm_debug_options, scm_debug_opts); |
ee340120 | 222 | |
f0e9217a MD |
223 | scm_add_feature ("debug-extensions"); |
224 | ||
a0599745 | 225 | #include "libguile/debug.x" |
f0e9217a | 226 | } |
89e00824 ML |
227 | |
228 | /* | |
229 | Local Variables: | |
230 | c-file-style: "gnu" | |
231 | End: | |
232 | */ |