1 /*
2 Copyright (C) 2001-2015, Parrot Foundation.
3 
4 =head1 NAME
5 
6 src/debug.c - Parrot debugger support
7 
8 =head1 DESCRIPTION
9 
10 This file implements Parrot debugging and is used by C<parrot_debugger>
11 the Parrot debugger, and the C<debug> ops.
12 
13 =head2 Functions
14 
15 =over 4
16 
17 =cut
18 
19 */
20 
21 #include <stdio.h>
22 #include <stdlib.h>
23 #include "parrot/parrot.h"
24 #include "parrot/oplib.h"
25 #include "parrot/debugger.h"
26 #include "parrot/oplib/ops.h"
27 #include "pmc/pmc_key.h"
28 #include "parrot/runcore_api.h"
29 #include "parrot/runcore_trace.h"
30 #include "debug.str"
31 #include "pmc/pmc_continuation.h"
32 #include "pmc/pmc_callcontext.h"
33 #include "pmc/pmc_sub.h"
34 #include "parrot/oplib/core_ops.h"
35 
36 /* Hand switched debugger tracing
37  * Set to 1 to enable tracing to stderr
38  * Set to 0 to disable
39  */
40 #define TRACE_DEBUGGER 0
41 
42 #if TRACE_DEBUGGER
43 #  define TRACEDEB_MSG(msg) fprintf(stderr, "%s\n", (msg))
44 #else
45 #  define TRACEDEB_MSG(msg)
46 #endif
47 
48 /* Length of command line buffers */
49 #define DEBUG_CMD_BUFFER_LENGTH 255
50 
51 /* Easier register access */
52 #define IREG(i) REG_INT(interp, (i))
53 #define NREG(i) REG_NUM(interp, (i))
54 #define SREG(i) REG_STR(interp, (i))
55 #define PREG(i) REG_PMC(interp, (i))
56 
57 typedef struct DebuggerCmd DebuggerCmd;
58 typedef struct DebuggerCmdList DebuggerCmdList;
59 
60 
61 /* HEADERIZER HFILE: include/parrot/debugger.h */
62 
63 /* HEADERIZER BEGIN: static */
64 /* Don't modify between HEADERIZER BEGIN / HEADERIZER END.  Your changes will be lost. */
65 
66 static void chop_newline(ARGMOD(char * buf))
67         __attribute__nonnull__(1)
68         FUNC_MODIFIES(* buf);
69 
70 static void close_script_file(PARROT_INTERP)
71         __attribute__nonnull__(1);
72 
73 static unsigned short condition_regtype(ARGIN(const char *cmd))
74         __attribute__nonnull__(1);
75 
76 PARROT_WARN_UNUSED_RESULT
77 PARROT_CAN_RETURN_NULL
78 static PDB_breakpoint_t * current_breakpoint(ARGIN(const PDB_t *pdb))
79         __attribute__nonnull__(1);
80 
81 static void dbg_assign(ARGIN(PDB_t *pdb), ARGIN(const char *cmd))
82         __attribute__nonnull__(1)
83         __attribute__nonnull__(2);
84 
85 static void dbg_break(ARGIN(PDB_t *pdb), ARGIN(const char *cmd))
86         __attribute__nonnull__(1)
87         __attribute__nonnull__(2);
88 
89 static void dbg_continue(ARGIN(PDB_t *pdb), ARGIN(const char *cmd))
90         __attribute__nonnull__(1)
91         __attribute__nonnull__(2);
92 
93 static void dbg_delete(ARGIN(PDB_t *pdb), ARGIN(const char *cmd))
94         __attribute__nonnull__(1)
95         __attribute__nonnull__(2);
96 
97 static void dbg_disable(ARGIN(PDB_t *pdb), ARGIN(const char *cmd))
98         __attribute__nonnull__(1)
99         __attribute__nonnull__(2);
100 
101 static void dbg_disassemble(ARGIN(PDB_t *pdb), ARGIN(const char *cmd))
102         __attribute__nonnull__(1)
103         __attribute__nonnull__(2);
104 
105 static void dbg_echo(ARGIN(PDB_t *pdb), ARGIN(const char *cmd))
106         __attribute__nonnull__(1)
107         __attribute__nonnull__(2);
108 
109 static void dbg_enable(ARGIN(PDB_t *pdb), ARGIN(const char *cmd))
110         __attribute__nonnull__(1)
111         __attribute__nonnull__(2);
112 
113 static void dbg_eval(ARGIN(PDB_t *pdb), ARGIN(const char *cmd))
114         __attribute__nonnull__(1)
115         __attribute__nonnull__(2);
116 
117 static void dbg_gcdebug(ARGIN(PDB_t *pdb), ARGIN(const char *cmd))
118         __attribute__nonnull__(1)
119         __attribute__nonnull__(2);
120 
121 static void dbg_help(ARGIN(PDB_t *pdb), ARGIN(const char *cmd))
122         __attribute__nonnull__(1)
123         __attribute__nonnull__(2);
124 
125 static void dbg_info(ARGIN(PDB_t *pdb), ARGIN(const char *cmd))
126         __attribute__nonnull__(1)
127         __attribute__nonnull__(2);
128 
129 static void dbg_list(ARGIN(PDB_t *pdb), ARGIN(const char *cmd))
130         __attribute__nonnull__(1)
131         __attribute__nonnull__(2);
132 
133 static void dbg_listbreakpoints(ARGIN(PDB_t *pdb), const char *cmd)
134         __attribute__nonnull__(1);
135 
136 static void dbg_load(ARGIN(PDB_t *pdb), ARGIN(const char *cmd))
137         __attribute__nonnull__(1)
138         __attribute__nonnull__(2);
139 
140 static void dbg_next(ARGIN(PDB_t *pdb), ARGIN(const char *cmd))
141         __attribute__nonnull__(1)
142         __attribute__nonnull__(2);
143 
144 static void dbg_print(ARGIN(PDB_t *pdb), ARGIN(const char *cmd))
145         __attribute__nonnull__(1)
146         __attribute__nonnull__(2);
147 
148 static void dbg_quit(ARGIN(PDB_t *pdb), ARGIN(const char *cmd))
149         __attribute__nonnull__(1)
150         __attribute__nonnull__(2);
151 
152 static void dbg_run(ARGIN(PDB_t *pdb), ARGIN(const char *cmd))
153         __attribute__nonnull__(1)
154         __attribute__nonnull__(2);
155 
156 static void dbg_script(ARGIN(PDB_t *pdb), ARGIN(const char *cmd))
157         __attribute__nonnull__(1)
158         __attribute__nonnull__(2);
159 
160 static void dbg_stack(ARGIN(PDB_t *pdb), ARGIN(const char *cmd))
161         __attribute__nonnull__(1)
162         __attribute__nonnull__(2);
163 
164 static void dbg_trace(ARGIN(PDB_t *pdb), ARGIN(const char *cmd))
165         __attribute__nonnull__(1)
166         __attribute__nonnull__(2);
167 
168 static void dbg_watch(ARGIN(PDB_t *pdb), ARGIN(const char *cmd))
169         __attribute__nonnull__(1)
170         __attribute__nonnull__(2);
171 
172 static void debugger_cmdline(PARROT_INTERP)
173         __attribute__nonnull__(1);
174 
175 static void display_breakpoint(
176     ARGIN(const PDB_t *pdb),
177     ARGIN(const PDB_breakpoint_t *breakpoint))
178         __attribute__nonnull__(1)
179         __attribute__nonnull__(2);
180 
181 PARROT_WARN_UNUSED_RESULT
182 PARROT_CANNOT_RETURN_NULL
183 PARROT_OBSERVER
184 static STRING * GDB_P(PARROT_INTERP, ARGIN(const char *s))
185         __attribute__nonnull__(1)
186         __attribute__nonnull__(2);
187 
188 PARROT_WARN_UNUSED_RESULT
189 PARROT_CANNOT_RETURN_NULL
190 PARROT_OBSERVER
191 static STRING * GDB_print_reg(PARROT_INTERP, int t, int n)
192         __attribute__nonnull__(1);
193 
194 PARROT_WARN_UNUSED_RESULT
195 PARROT_CAN_RETURN_NULL
196 static const DebuggerCmd * get_cmd(ARGIN_NULLOK(const char **cmd));
197 
198 PARROT_WARN_UNUSED_RESULT
199 PARROT_CANNOT_RETURN_NULL
200 static PMC * get_exception_context(PARROT_INTERP, ARGMOD(PMC * exception))
201         __attribute__nonnull__(1)
202         __attribute__nonnull__(2)
203         FUNC_MODIFIES(* exception);
204 
205 PARROT_WARN_UNUSED_RESULT
206 static unsigned long get_uint(ARGMOD(const char **cmd), unsigned int def)
207         __attribute__nonnull__(1)
208         FUNC_MODIFIES(*cmd);
209 
210 PARROT_WARN_UNUSED_RESULT
211 static unsigned long get_ulong(ARGMOD(const char **cmd), unsigned long def)
212         __attribute__nonnull__(1)
213         FUNC_MODIFIES(*cmd);
214 
215 static void list_breakpoints(ARGIN(const PDB_t *pdb))
216         __attribute__nonnull__(1);
217 
218 static void no_such_register(PARROT_INTERP,
219     char register_type,
220     UINTVAL register_num)
221         __attribute__nonnull__(1);
222 
223 static int nomoreargs(ARGIN(PDB_t *pdb), ARGIN(const char *cmd))
224         __attribute__nonnull__(1)
225         __attribute__nonnull__(2);
226 
227 PARROT_WARN_UNUSED_RESULT
228 PARROT_CANNOT_RETURN_NULL
229 static STRING * PDB_get_continuation_backtrace(PARROT_INTERP,
230     ARGIN(PMC *ctx))
231         __attribute__nonnull__(1)
232         __attribute__nonnull__(2);
233 
234 PARROT_WARN_UNUSED_RESULT
235 PARROT_CANNOT_RETURN_NULL
236 PARROT_PURE_FUNCTION
237 static const char * skip_whitespace(ARGIN(const char *cmd))
238         __attribute__nonnull__(1);
239 
240 #define ASSERT_ARGS_chop_newline __attribute__unused__ int _ASSERT_ARGS_CHECK = (\
241        PARROT_ASSERT_ARG(buf))
242 #define ASSERT_ARGS_close_script_file __attribute__unused__ int _ASSERT_ARGS_CHECK = (\
243        PARROT_ASSERT_ARG(interp))
244 #define ASSERT_ARGS_condition_regtype __attribute__unused__ int _ASSERT_ARGS_CHECK = (\
245        PARROT_ASSERT_ARG(cmd))
246 #define ASSERT_ARGS_current_breakpoint __attribute__unused__ int _ASSERT_ARGS_CHECK = (\
247        PARROT_ASSERT_ARG(pdb))
248 #define ASSERT_ARGS_dbg_assign __attribute__unused__ int _ASSERT_ARGS_CHECK = (\
249        PARROT_ASSERT_ARG(pdb) \
250     , PARROT_ASSERT_ARG(cmd))
251 #define ASSERT_ARGS_dbg_break __attribute__unused__ int _ASSERT_ARGS_CHECK = (\
252        PARROT_ASSERT_ARG(pdb) \
253     , PARROT_ASSERT_ARG(cmd))
254 #define ASSERT_ARGS_dbg_continue __attribute__unused__ int _ASSERT_ARGS_CHECK = (\
255        PARROT_ASSERT_ARG(pdb) \
256     , PARROT_ASSERT_ARG(cmd))
257 #define ASSERT_ARGS_dbg_delete __attribute__unused__ int _ASSERT_ARGS_CHECK = (\
258        PARROT_ASSERT_ARG(pdb) \
259     , PARROT_ASSERT_ARG(cmd))
260 #define ASSERT_ARGS_dbg_disable __attribute__unused__ int _ASSERT_ARGS_CHECK = (\
261        PARROT_ASSERT_ARG(pdb) \
262     , PARROT_ASSERT_ARG(cmd))
263 #define ASSERT_ARGS_dbg_disassemble __attribute__unused__ int _ASSERT_ARGS_CHECK = (\
264        PARROT_ASSERT_ARG(pdb) \
265     , PARROT_ASSERT_ARG(cmd))
266 #define ASSERT_ARGS_dbg_echo __attribute__unused__ int _ASSERT_ARGS_CHECK = (\
267        PARROT_ASSERT_ARG(pdb) \
268     , PARROT_ASSERT_ARG(cmd))
269 #define ASSERT_ARGS_dbg_enable __attribute__unused__ int _ASSERT_ARGS_CHECK = (\
270        PARROT_ASSERT_ARG(pdb) \
271     , PARROT_ASSERT_ARG(cmd))
272 #define ASSERT_ARGS_dbg_eval __attribute__unused__ int _ASSERT_ARGS_CHECK = (\
273        PARROT_ASSERT_ARG(pdb) \
274     , PARROT_ASSERT_ARG(cmd))
275 #define ASSERT_ARGS_dbg_gcdebug __attribute__unused__ int _ASSERT_ARGS_CHECK = (\
276        PARROT_ASSERT_ARG(pdb) \
277     , PARROT_ASSERT_ARG(cmd))
278 #define ASSERT_ARGS_dbg_help __attribute__unused__ int _ASSERT_ARGS_CHECK = (\
279        PARROT_ASSERT_ARG(pdb) \
280     , PARROT_ASSERT_ARG(cmd))
281 #define ASSERT_ARGS_dbg_info __attribute__unused__ int _ASSERT_ARGS_CHECK = (\
282        PARROT_ASSERT_ARG(pdb) \
283     , PARROT_ASSERT_ARG(cmd))
284 #define ASSERT_ARGS_dbg_list __attribute__unused__ int _ASSERT_ARGS_CHECK = (\
285        PARROT_ASSERT_ARG(pdb) \
286     , PARROT_ASSERT_ARG(cmd))
287 #define ASSERT_ARGS_dbg_listbreakpoints __attribute__unused__ int _ASSERT_ARGS_CHECK = (\
288        PARROT_ASSERT_ARG(pdb))
289 #define ASSERT_ARGS_dbg_load __attribute__unused__ int _ASSERT_ARGS_CHECK = (\
290        PARROT_ASSERT_ARG(pdb) \
291     , PARROT_ASSERT_ARG(cmd))
292 #define ASSERT_ARGS_dbg_next __attribute__unused__ int _ASSERT_ARGS_CHECK = (\
293        PARROT_ASSERT_ARG(pdb) \
294     , PARROT_ASSERT_ARG(cmd))
295 #define ASSERT_ARGS_dbg_print __attribute__unused__ int _ASSERT_ARGS_CHECK = (\
296        PARROT_ASSERT_ARG(pdb) \
297     , PARROT_ASSERT_ARG(cmd))
298 #define ASSERT_ARGS_dbg_quit __attribute__unused__ int _ASSERT_ARGS_CHECK = (\
299        PARROT_ASSERT_ARG(pdb) \
300     , PARROT_ASSERT_ARG(cmd))
301 #define ASSERT_ARGS_dbg_run __attribute__unused__ int _ASSERT_ARGS_CHECK = (\
302        PARROT_ASSERT_ARG(pdb) \
303     , PARROT_ASSERT_ARG(cmd))
304 #define ASSERT_ARGS_dbg_script __attribute__unused__ int _ASSERT_ARGS_CHECK = (\
305        PARROT_ASSERT_ARG(pdb) \
306     , PARROT_ASSERT_ARG(cmd))
307 #define ASSERT_ARGS_dbg_stack __attribute__unused__ int _ASSERT_ARGS_CHECK = (\
308        PARROT_ASSERT_ARG(pdb) \
309     , PARROT_ASSERT_ARG(cmd))
310 #define ASSERT_ARGS_dbg_trace __attribute__unused__ int _ASSERT_ARGS_CHECK = (\
311        PARROT_ASSERT_ARG(pdb) \
312     , PARROT_ASSERT_ARG(cmd))
313 #define ASSERT_ARGS_dbg_watch __attribute__unused__ int _ASSERT_ARGS_CHECK = (\
314        PARROT_ASSERT_ARG(pdb) \
315     , PARROT_ASSERT_ARG(cmd))
316 #define ASSERT_ARGS_debugger_cmdline __attribute__unused__ int _ASSERT_ARGS_CHECK = (\
317        PARROT_ASSERT_ARG(interp))
318 #define ASSERT_ARGS_display_breakpoint __attribute__unused__ int _ASSERT_ARGS_CHECK = (\
319        PARROT_ASSERT_ARG(pdb) \
320     , PARROT_ASSERT_ARG(breakpoint))
321 #define ASSERT_ARGS_GDB_P __attribute__unused__ int _ASSERT_ARGS_CHECK = (\
322        PARROT_ASSERT_ARG(interp) \
323     , PARROT_ASSERT_ARG(s))
324 #define ASSERT_ARGS_GDB_print_reg __attribute__unused__ int _ASSERT_ARGS_CHECK = (\
325        PARROT_ASSERT_ARG(interp))
326 #define ASSERT_ARGS_get_cmd __attribute__unused__ int _ASSERT_ARGS_CHECK = (0)
327 #define ASSERT_ARGS_get_exception_context __attribute__unused__ int _ASSERT_ARGS_CHECK = (\
328        PARROT_ASSERT_ARG(interp) \
329     , PARROT_ASSERT_ARG(exception))
330 #define ASSERT_ARGS_get_uint __attribute__unused__ int _ASSERT_ARGS_CHECK = (\
331        PARROT_ASSERT_ARG(cmd))
332 #define ASSERT_ARGS_get_ulong __attribute__unused__ int _ASSERT_ARGS_CHECK = (\
333        PARROT_ASSERT_ARG(cmd))
334 #define ASSERT_ARGS_list_breakpoints __attribute__unused__ int _ASSERT_ARGS_CHECK = (\
335        PARROT_ASSERT_ARG(pdb))
336 #define ASSERT_ARGS_no_such_register __attribute__unused__ int _ASSERT_ARGS_CHECK = (\
337        PARROT_ASSERT_ARG(interp))
338 #define ASSERT_ARGS_nomoreargs __attribute__unused__ int _ASSERT_ARGS_CHECK = (\
339        PARROT_ASSERT_ARG(pdb) \
340     , PARROT_ASSERT_ARG(cmd))
341 #define ASSERT_ARGS_PDB_get_continuation_backtrace \
342      __attribute__unused__ int _ASSERT_ARGS_CHECK = (\
343        PARROT_ASSERT_ARG(interp) \
344     , PARROT_ASSERT_ARG(ctx))
345 #define ASSERT_ARGS_skip_whitespace __attribute__unused__ int _ASSERT_ARGS_CHECK = (\
346        PARROT_ASSERT_ARG(cmd))
347 /* Don't modify between HEADERIZER BEGIN / HEADERIZER END.  Your changes will be lost. */
348 /* HEADERIZER END: static */
349 
350 /*
351  *  Command functions and help dispatch
352  */
353 
354 /*
355 
356 =item C<static int nomoreargs(PDB_t *pdb, const char *cmd)>
357 
358 =item C<static void dbg_assign(PDB_t *pdb, const char *cmd)>
359 
360 =item C<static void dbg_break(PDB_t *pdb, const char *cmd)>
361 
362 =item C<static void dbg_continue(PDB_t *pdb, const char *cmd)>
363 
364 =item C<static void dbg_delete(PDB_t *pdb, const char *cmd)>
365 
366 =item C<static void dbg_disable(PDB_t *pdb, const char *cmd)>
367 
368 =item C<static void dbg_disassemble(PDB_t *pdb, const char *cmd)>
369 
370 =item C<static void dbg_echo(PDB_t *pdb, const char *cmd)>
371 
372 =item C<static void dbg_enable(PDB_t *pdb, const char *cmd)>
373 
374 =item C<static void dbg_eval(PDB_t *pdb, const char *cmd)>
375 
376 =item C<static void dbg_gcdebug(PDB_t *pdb, const char *cmd)>
377 
378 =item C<static void dbg_help(PDB_t *pdb, const char *cmd)>
379 
380 =item C<static void dbg_info(PDB_t *pdb, const char *cmd)>
381 
382 =item C<static void dbg_list(PDB_t *pdb, const char *cmd)>
383 
384 =item C<static void dbg_listbreakpoints(PDB_t *pdb, const char *cmd)>
385 
386 =item C<static void dbg_load(PDB_t *pdb, const char *cmd)>
387 
388 =item C<static void dbg_next(PDB_t *pdb, const char *cmd)>
389 
390 =item C<static void dbg_print(PDB_t *pdb, const char *cmd)>
391 
392 =item C<static void dbg_quit(PDB_t *pdb, const char *cmd)>
393 
394 =item C<static void dbg_run(PDB_t *pdb, const char *cmd)>
395 
396 =item C<static void dbg_script(PDB_t *pdb, const char *cmd)>
397 
398 =item C<static void dbg_stack(PDB_t *pdb, const char *cmd)>
399 
400 =item C<static void dbg_trace(PDB_t *pdb, const char *cmd)>
401 
402 =item C<static void dbg_watch(PDB_t *pdb, const char *cmd)>
403 
404 These are command and help dispatch functions
405 
406 =cut
407 
408 */
409 
410 
411 typedef void (* debugger_func_t)(ARGIN(PDB_t *pdb), ARGIN(const char *cmd));
412 
413 static int
nomoreargs(ARGIN (PDB_t * pdb),ARGIN (const char * cmd))414 nomoreargs(ARGIN(PDB_t *pdb), ARGIN(const char *cmd))
415 {
416     ASSERT_ARGS(nomoreargs)
417 
418     if (*skip_whitespace(cmd) == '\0')
419         return 1;
420     else {
421         Parrot_io_eprintf(pdb->debugger, "Spurious arg\n");
422         return 0;
423     }
424 }
425 
426 static void
dbg_assign(ARGIN (PDB_t * pdb),ARGIN (const char * cmd))427 dbg_assign(ARGIN(PDB_t *pdb), ARGIN(const char *cmd))
428 {
429     ASSERT_ARGS(dbg_assign)
430 
431     TRACEDEB_MSG("dbg_assign");
432 
433     PDB_assign(pdb->debugee, cmd);
434 }
435 
436 static void
dbg_break(ARGIN (PDB_t * pdb),ARGIN (const char * cmd))437 dbg_break(ARGIN(PDB_t *pdb), ARGIN(const char *cmd))
438 {
439     ASSERT_ARGS(dbg_break)
440 
441     TRACEDEB_MSG("dbg_break");
442 
443     PDB_set_break(pdb->debugee, cmd);
444 }
445 
446 static void
dbg_continue(ARGIN (PDB_t * pdb),ARGIN (const char * cmd))447 dbg_continue(ARGIN(PDB_t *pdb), ARGIN(const char *cmd))
448 {
449     ASSERT_ARGS(dbg_continue)
450 
451     TRACEDEB_MSG("dbg_continue");
452 
453     PDB_continue(pdb->debugee, cmd);
454 }
455 
456 static void
dbg_delete(ARGIN (PDB_t * pdb),ARGIN (const char * cmd))457 dbg_delete(ARGIN(PDB_t *pdb), ARGIN(const char *cmd))
458 {
459     ASSERT_ARGS(dbg_delete)
460 
461     TRACEDEB_MSG("dbg_delete");
462 
463     PDB_delete_breakpoint(pdb->debugee, cmd);
464 }
465 
466 static void
dbg_disable(ARGIN (PDB_t * pdb),ARGIN (const char * cmd))467 dbg_disable(ARGIN(PDB_t *pdb), ARGIN(const char *cmd))
468 {
469     ASSERT_ARGS(dbg_disable)
470 
471     TRACEDEB_MSG("dbg_disable");
472 
473     PDB_disable_breakpoint(pdb->debugee, cmd);
474 }
475 
476 static void
dbg_disassemble(ARGIN (PDB_t * pdb),ARGIN (const char * cmd))477 dbg_disassemble(ARGIN(PDB_t *pdb), ARGIN(const char *cmd))
478 {
479     ASSERT_ARGS(dbg_disassemble)
480 
481     TRACEDEB_MSG("dbg_disassemble");
482 
483     PDB_disassemble(pdb->debugee, cmd);
484 }
485 
486 static void
dbg_echo(ARGIN (PDB_t * pdb),ARGIN (const char * cmd))487 dbg_echo(ARGIN(PDB_t *pdb), ARGIN(const char *cmd))
488 {
489     ASSERT_ARGS(dbg_echo)
490 
491     TRACEDEB_MSG("dbg_echo");
492 
493     if (! nomoreargs(pdb, cmd))
494         return;
495 
496     if (pdb->state & PDB_ECHO) {
497         TRACEDEB_MSG("Disabling echo");
498         pdb->state &= ~PDB_ECHO;
499     }
500     else {
501         TRACEDEB_MSG("Enabling echo");
502         pdb->state |= PDB_ECHO;
503     }
504 }
505 
506 static void
dbg_enable(ARGIN (PDB_t * pdb),ARGIN (const char * cmd))507 dbg_enable(ARGIN(PDB_t *pdb), ARGIN(const char *cmd))
508 {
509     ASSERT_ARGS(dbg_enable)
510 
511     PDB_enable_breakpoint(pdb->debugee, cmd);
512 }
513 
514 static void
dbg_eval(ARGIN (PDB_t * pdb),ARGIN (const char * cmd))515 dbg_eval(ARGIN(PDB_t *pdb), ARGIN(const char *cmd))
516 {
517     ASSERT_ARGS(dbg_eval)
518 
519     PDB_eval(pdb->debugee, cmd);
520 }
521 
522 static void
dbg_gcdebug(ARGIN (PDB_t * pdb),ARGIN (const char * cmd))523 dbg_gcdebug(ARGIN(PDB_t *pdb), ARGIN(const char *cmd))
524 {
525     ASSERT_ARGS(dbg_gcdebug)
526 
527     TRACEDEB_MSG("dbg_gcdebug");
528 
529     if (! nomoreargs(pdb, cmd))
530         return;
531 
532     if (pdb->state & PDB_GCDEBUG) {
533         TRACEDEB_MSG("Disabling gcdebug mode");
534         pdb->state &= ~PDB_GCDEBUG;
535     }
536     else {
537         TRACEDEB_MSG("Enabling gcdebug mode");
538         pdb->state |= PDB_GCDEBUG;
539     }
540 }
541 
542 static void
dbg_help(ARGIN (PDB_t * pdb),ARGIN (const char * cmd))543 dbg_help(ARGIN(PDB_t *pdb), ARGIN(const char *cmd))
544 {
545     ASSERT_ARGS(dbg_help)
546 
547     TRACEDEB_MSG("dbg_help");
548 
549     PDB_help(pdb->debugee, cmd);
550 }
551 
552 static void
dbg_info(ARGIN (PDB_t * pdb),ARGIN (const char * cmd))553 dbg_info(ARGIN(PDB_t *pdb), ARGIN(const char *cmd))
554 {
555     ASSERT_ARGS(dbg_info)
556 
557     TRACEDEB_MSG("dbg_info");
558 
559     if (! nomoreargs(pdb, cmd))
560         return;
561 
562     PDB_info(pdb->debugger);
563 }
564 
565 static void
dbg_list(ARGIN (PDB_t * pdb),ARGIN (const char * cmd))566 dbg_list(ARGIN(PDB_t *pdb), ARGIN(const char *cmd))
567 {
568     ASSERT_ARGS(dbg_list)
569 
570     TRACEDEB_MSG("dbg_list");
571 
572     PDB_list(pdb->debugee, cmd);
573 }
574 
575 static void
dbg_listbreakpoints(ARGIN (PDB_t * pdb),SHIM (const char * cmd))576 dbg_listbreakpoints(ARGIN(PDB_t *pdb), SHIM(const char *cmd))
577 {
578     ASSERT_ARGS(dbg_listbreakpoints)
579 
580     TRACEDEB_MSG("dbg_list");
581 
582     list_breakpoints(pdb);
583 }
584 
585 static void
dbg_load(ARGIN (PDB_t * pdb),ARGIN (const char * cmd))586 dbg_load(ARGIN(PDB_t *pdb), ARGIN(const char *cmd))
587 {
588     ASSERT_ARGS(dbg_load)
589 
590     TRACEDEB_MSG("dbg_load");
591 
592     PDB_load_source(pdb->debugee, cmd);
593 }
594 
595 static void
dbg_next(ARGIN (PDB_t * pdb),ARGIN (const char * cmd))596 dbg_next(ARGIN(PDB_t *pdb), ARGIN(const char *cmd))
597 {
598     ASSERT_ARGS(dbg_next)
599 
600     TRACEDEB_MSG("dbg_next");
601 
602     PDB_next(pdb->debugee, cmd);
603 }
604 
605 static void
dbg_print(ARGIN (PDB_t * pdb),ARGIN (const char * cmd))606 dbg_print(ARGIN(PDB_t *pdb), ARGIN(const char *cmd))
607 {
608     ASSERT_ARGS(dbg_print)
609 
610     TRACEDEB_MSG("dbg_print");
611 
612     PDB_print(pdb->debugee, cmd);
613 }
614 
615 static void
dbg_quit(ARGIN (PDB_t * pdb),ARGIN (const char * cmd))616 dbg_quit(ARGIN(PDB_t *pdb), ARGIN(const char *cmd))
617 {
618     ASSERT_ARGS(dbg_quit)
619 
620     TRACEDEB_MSG("dbg_quit");
621 
622     if (! nomoreargs(pdb, cmd))
623         return;
624 
625     pdb->state |= PDB_EXIT;
626     pdb->state &= ~PDB_STOPPED;
627 }
628 
629 static void
dbg_run(ARGIN (PDB_t * pdb),ARGIN (const char * cmd))630 dbg_run(ARGIN(PDB_t *pdb), ARGIN(const char *cmd))
631 {
632     ASSERT_ARGS(dbg_run)
633 
634     TRACEDEB_MSG("dbg_run");
635 
636     PDB_init(pdb->debugee, cmd);
637     PDB_continue(pdb->debugee, NULL);
638 }
639 
640 static void
dbg_script(ARGIN (PDB_t * pdb),ARGIN (const char * cmd))641 dbg_script(ARGIN(PDB_t *pdb), ARGIN(const char *cmd))
642 {
643     ASSERT_ARGS(dbg_script)
644 
645     TRACEDEB_MSG("dbg_script");
646 
647     PDB_script_file(pdb->debugee, cmd);
648 }
649 
650 static void
dbg_stack(ARGIN (PDB_t * pdb),ARGIN (const char * cmd))651 dbg_stack(ARGIN(PDB_t *pdb), ARGIN(const char *cmd))
652 {
653     ASSERT_ARGS(dbg_stack)
654 
655     TRACEDEB_MSG("dbg_stack");
656 
657     if (! nomoreargs(pdb, cmd))
658         return;
659 
660     PDB_backtrace(pdb->debugee);
661 }
662 
663 static void
dbg_trace(ARGIN (PDB_t * pdb),ARGIN (const char * cmd))664 dbg_trace(ARGIN(PDB_t *pdb), ARGIN(const char *cmd))
665 {
666     ASSERT_ARGS(dbg_trace)
667 
668     TRACEDEB_MSG("dbg_trace");
669 
670     PDB_trace(pdb->debugee, cmd);
671 }
672 
673 static void
dbg_watch(ARGIN (PDB_t * pdb),ARGIN (const char * cmd))674 dbg_watch(ARGIN(PDB_t *pdb), ARGIN(const char *cmd))
675 {
676     ASSERT_ARGS(dbg_watch)
677 
678     TRACEDEB_MSG("dbg_watch");
679 
680     PDB_watchpoint(pdb->debugee, cmd);
681 }
682 
683 struct DebuggerCmd {
684     debugger_func_t func;
685     PARROT_OBSERVER const char * const shorthelp;
686     PARROT_OBSERVER const char * const help;
687 };
688 
689 static const DebuggerCmd
690     cmd_assign = {
691         & dbg_assign,
692         "assign to a register",
693 "Assign a value to a register. For example:\n\
694     a I0 42\n\
695     a N1 3.14\n\
696 The first command sets I0 to 42 and the second sets N1 to 3.14."
697     },
698     cmd_break = {
699         & dbg_break,
700         "add a breakpoint",
701 "Set a breakpoint at a given line number (which must be specified).\n\n\
702 Optionally, specify a condition, in which case the breakpoint will only\n\
703 activate if the condition is met. Conditions take the form:\n\n\
704            if [REGISTER] [COMPARISON] [REGISTER or CONSTANT]\n\n\
705 \
706 For example:\n\n\
707            break 10 if I4 > I3\n\n\
708            break 45 if S1 == \"foo\"\n\n\
709 The command returns a number which is the breakpoint identifier."
710     },
711     cmd_continue = {
712         & dbg_continue,
713         "continue the program execution",
714 "Continue the program execution.\n\n\
715 Without arguments, the program runs until a breakpoint is found\n\
716 (or until the program terminates for some other reason).\n\n\
717 If a number is specified, then skip that many breakpoints.\n\n\
718 If the program has terminated, then \"continue\" will do nothing;\n\
719 use \"run\" to re-run the program."
720     },
721     cmd_delete = {
722         & dbg_delete,
723         "delete a breakpoint",
724 "Delete a breakpoint.\n\n\
725 The breakpoint to delete must be specified by its breakpoint number.\n\
726 Deleted breakpoints are gone completely. If instead you want to\n\
727 temporarily disable a breakpoint, use \"disable\"."
728     },
729     cmd_disable = {
730         & dbg_disable,
731         "disable a breakpoint",
732 "Disable a breakpoint.\n\n\
733 The breakpoint to disable must be specified by its breakpoint number.\n\
734 Disabled breakpoints are not forgotten, but have no effect until re-enabled\n\
735 with the \"enable\" command."
736     },
737     cmd_disassemble = {
738         & dbg_disassemble,
739         "disassemble the bytecode",
740 "Disassemble code"
741     },
742     cmd_echo = {
743         & dbg_echo,
744         "toggle echo of script commands",
745 "Toggle echo mode.\n\n\
746 In echo mode the script commands are written to stderr before executing."
747     },
748     cmd_enable = {
749         & dbg_enable,
750         "re-enable a disabled breakpoint",
751 "Re-enable a disabled breakpoint."
752     },
753     cmd_eval = {
754         & dbg_eval,
755         "run an instruction",
756 "No documentation yet"
757     },
758     cmd_gcdebug = {
759         & dbg_gcdebug,
760         "toggle gcdebug mode",
761 "Toggle gcdebug mode.\n\n\
762 In gcdebug mode a garbage collection cycle is run before each opcode,\n\
763 same as using the gcdebug core."
764     },
765     cmd_help = {
766         & dbg_help,
767         "print this help",
768 "Print a list of available commands."
769     },
770     cmd_info = {
771         & dbg_info,
772         "print interpreter information",
773 "Print information about the current interpreter"
774     },
775     cmd_list = {
776         & dbg_list,
777         "list the source code file",
778 "List the source code.\n\n\
779 Optionally specify the line number to begin the listing from and the number\n\
780 of lines to display."
781     },
782     cmd_listbreakpoints = {
783         & dbg_listbreakpoints,
784         "list breakpoints",
785 "List breakpoints."
786     },
787     cmd_load = {
788         & dbg_load,
789         "load a source code file",
790 "Load a source code file."
791     },
792     cmd_next = {
793         & dbg_next,
794         "run the next instruction",
795 "Execute a specified number of instructions.\n\n\
796 If a number is specified with the command (e.g. \"next 5\"), then\n\
797 execute that number of instructions, unless the program reaches a\n\
798 breakpoint, or stops for some other reason.\n\n\
799 If no number is specified, it defaults to 1."
800     },
801     cmd_print = {
802         & dbg_print,
803         "print the interpreter registers",
804 "Print register: e.g. \"p i2\"\n\
805 Note that the register type is case-insensitive. If no digits appear\n\
806 after the register type, all registers of that type are printed."
807     },
808     cmd_quit = {
809         & dbg_quit,
810         "exit the debugger",
811 "Exit the debugger"
812     },
813     cmd_run = {
814         & dbg_run,
815         "run the program",
816 "Run (or restart) the program being debugged.\n\n\
817 Arguments specified after \"run\" are passed as command line arguments to\n\
818 the program.\n"
819     },
820     cmd_script = {
821         & dbg_script,
822         "interprets a file as user commands",
823 "Interprets a file s user commands.\n\
824 Usage:\n\
825 (pdb) script file.script"
826     },
827     cmd_stack = {
828         & dbg_stack,
829         "examine the stack",
830 "Print a stack trace of the parrot VM"
831     },
832     cmd_trace = {
833         & dbg_trace,
834         "trace the next instruction",
835 "Similar to \"next\", but prints additional trace information.\n\
836 This is the same as the information you get when running Parrot with\n\
837 the -t option.\n"
838     },
839     cmd_watch = {
840         & dbg_watch,
841         "add a watchpoint",
842 "Add a watchpoint"
843     };
844 
845 struct DebuggerCmdList {
846     PARROT_OBSERVER const char * const name;
847     char shortname;
848     PARROT_OBSERVER const DebuggerCmd * const cmd;
849 };
850 
851 const DebuggerCmdList DebCmdList [] = {
852     { "assign",      'a',  &cmd_assign },
853     { "blist",       '\0', &cmd_listbreakpoints },
854     { "break",       '\0', &cmd_break },
855     { "continue",    '\0', &cmd_continue },
856     { "delete",      'd',  &cmd_delete },
857     { "disable",     '\0', &cmd_disable },
858     { "disassemble", '\0', &cmd_disassemble },
859     { "e",           '\0', &cmd_eval },
860     { "echo",        '\0', &cmd_echo },
861     { "enable",      '\0', &cmd_enable },
862     { "eval",        '\0', &cmd_eval },
863     { "f",           '\0', &cmd_script },
864     { "gcdebug",     '\0', &cmd_gcdebug },
865     { "help",        '\0', &cmd_help },
866     { "info",        '\0', &cmd_info },
867     { "L",           '\0', &cmd_listbreakpoints },
868     { "list",        'l',  &cmd_list },
869     { "load",        '\0', &cmd_load },
870     { "next",        '\0', &cmd_next },
871     { "print",       '\0', &cmd_print },
872     { "quit",        '\0', &cmd_quit },
873     { "run",         '\0', &cmd_run },
874     { "script",      '\0', &cmd_script },
875     { "stack",       's',  &cmd_stack },
876     { "trace",       '\0', &cmd_trace },
877     { "watch",       '\0', &cmd_watch }
878 };
879 
880 /*
881 
882 =item C<static const DebuggerCmd * get_cmd(const char **cmd)>
883 
884 Parse the debuggger command indicated by C<**cmd>.  Return a pointer to the
885 matching function for known commands, or a NULL pointer otherwise.
886 
887 =cut
888 
889 */
890 
891 PARROT_WARN_UNUSED_RESULT
892 PARROT_CAN_RETURN_NULL
893 static const DebuggerCmd *
get_cmd(ARGIN_NULLOK (const char ** cmd))894 get_cmd(ARGIN_NULLOK(const char **cmd))
895 {
896     ASSERT_ARGS(get_cmd)
897     if (cmd && *cmd) {
898         const char * const start = skip_whitespace(*cmd);
899         const char *next = start;
900         char c;
901         unsigned int i, l;
902         int found = -1;
903         int hits = 0;
904 
905         *cmd = start;
906         for (; (c= *next) != '\0' && !isspace((unsigned char)c); ++next)
907             continue;
908         l = next - start;
909         if (l == 0)
910             return NULL;
911         for (i= 0; i < sizeof (DebCmdList) / sizeof (DebuggerCmdList); ++i) {
912             const DebuggerCmdList * const cmdlist = DebCmdList + i;
913             if (l == 1 && cmdlist->shortname == (*cmd)[0]) {
914                 hits = 1;
915                 found = i;
916                 break;
917             }
918             if (strncmp(*cmd, cmdlist->name, l) == 0) {
919                 if (strlen(cmdlist->name) == l) {
920                     hits = 1;
921                     found = i;
922                     break;
923                 }
924                 else {
925                     ++hits;
926                     found = i;
927                 }
928             }
929         }
930         if (hits == 1) {
931             *cmd = skip_whitespace(next);
932             return DebCmdList[found].cmd;
933         }
934     }
935     return NULL;
936 }
937 
938 /*
939 
940 =item C<static const char * skip_whitespace(const char *cmd)>
941 
942 Return a pointer to the first non-whitespace character in C<cmd>.
943 
944 =cut
945 
946 */
947 
948 PARROT_WARN_UNUSED_RESULT
949 PARROT_CANNOT_RETURN_NULL
950 PARROT_PURE_FUNCTION
951 static const char *
skip_whitespace(ARGIN (const char * cmd))952 skip_whitespace(ARGIN(const char *cmd))
953 {
954     ASSERT_ARGS(skip_whitespace)
955     while (*cmd && isspace((unsigned char)*cmd))
956         ++cmd;
957     return cmd;
958 }
959 
960 /*
961 
962 =item C<static unsigned long get_uint(const char **cmd, unsigned int def)>
963 
964 Get an unsigned int from C<**cmd>.
965 
966 =cut
967 
968 */
969 
970 
971 PARROT_WARN_UNUSED_RESULT
972 static unsigned long
get_uint(ARGMOD (const char ** cmd),unsigned int def)973 get_uint(ARGMOD(const char **cmd), unsigned int def)
974 {
975     ASSERT_ARGS(get_uint)
976     char *cmdnext;
977     unsigned int result = strtoul(skip_whitespace(* cmd), & cmdnext, 0);
978     if (cmdnext != *cmd)
979         *cmd = cmdnext;
980     else
981         result = def;
982     return result;
983 }
984 
985 /*
986 
987 =item C<static unsigned long get_ulong(const char **cmd, unsigned long def)>
988 
989 Get an unsigned long from C<**cmd>.
990 
991 =cut
992 
993 */
994 
995 
996 PARROT_WARN_UNUSED_RESULT
997 static unsigned long
get_ulong(ARGMOD (const char ** cmd),unsigned long def)998 get_ulong(ARGMOD(const char **cmd), unsigned long def)
999 {
1000     ASSERT_ARGS(get_ulong)
1001     char *cmdnext;
1002     unsigned long result = strtoul(skip_whitespace(* cmd), & cmdnext, 0);
1003     if (cmdnext != * cmd)
1004         * cmd = cmdnext;
1005     else
1006         result = def;
1007     return result;
1008 }
1009 
1010 /*
1011 
1012 =item C<static void chop_newline(char * buf)>
1013 
1014 If the C string argument end with a newline, delete it.
1015 
1016 =cut
1017 
1018 */
1019 
1020 static void
chop_newline(ARGMOD (char * buf))1021 chop_newline(ARGMOD(char * buf))
1022 {
1023     ASSERT_ARGS(chop_newline)
1024     const size_t l = strlen(buf);
1025 
1026     if (l > 0 && buf [l - 1] == '\n')
1027         buf [l - 1] = '\0';
1028 }
1029 
1030 /*
1031 
1032 =item C<static void debugger_cmdline(PARROT_INTERP)>
1033 
1034 Debugger command line.
1035 
1036 Gets and executes commands, looping until the debugger state
1037 is changed, either to exit or to start executing code.
1038 
1039 =cut
1040 
1041 */
1042 
1043 static void
debugger_cmdline(PARROT_INTERP)1044 debugger_cmdline(PARROT_INTERP)
1045 {
1046     ASSERT_ARGS(debugger_cmdline)
1047     TRACEDEB_MSG("debugger_cmdline");
1048 
1049     /*while (!(interp->pdb->state & PDB_EXIT)) {*/
1050     while (interp->pdb->state & PDB_STOPPED) {
1051         const char * command;
1052         interp->pdb->state &= ~PDB_TRACING;
1053         PDB_get_command(interp);
1054         command = interp->pdb->cur_command;
1055         if (command[0] == '\0')
1056             command = interp->pdb->last_command;
1057 
1058         PDB_run_command(interp, command);
1059     }
1060     TRACEDEB_MSG("debugger_cmdline finished");
1061 }
1062 
1063 /*
1064 
1065 =item C<static void close_script_file(PARROT_INTERP)>
1066 
1067 Close the script file, returning to command prompt mode.
1068 
1069 =cut
1070 
1071 */
1072 
1073 static void
close_script_file(PARROT_INTERP)1074 close_script_file(PARROT_INTERP)
1075 {
1076     ASSERT_ARGS(close_script_file)
1077     TRACEDEB_MSG("Closing debugger script file");
1078     if (interp->pdb->script_file) {
1079         fclose(interp->pdb->script_file);
1080         interp->pdb->script_file = NULL;
1081         interp->pdb->state|= PDB_STOPPED;
1082         interp->pdb->last_command[0] = '\0';
1083         interp->pdb->cur_command[0] = '\0';
1084     }
1085 }
1086 
1087 /*
1088 
1089 =item C<void Parrot_debugger_init(PARROT_INTERP)>
1090 
1091 Initializes the Parrot debugger, if it's not already initialized.
1092 
1093 =cut
1094 
1095 */
1096 
1097 PARROT_EXPORT
1098 void
Parrot_debugger_init(PARROT_INTERP)1099 Parrot_debugger_init(PARROT_INTERP)
1100 {
1101     ASSERT_ARGS(Parrot_debugger_init)
1102     TRACEDEB_MSG("Parrot_debugger_init");
1103 
1104     if (! interp->pdb) {
1105         PDB_t          *pdb      = mem_gc_allocate_zeroed_typed(interp, PDB_t);
1106         Parrot_Interp   debugger = Parrot_interp_new(interp);
1107         interp->pdb              = pdb;
1108         debugger->pdb            = pdb;
1109         pdb->debugee             = interp;
1110         pdb->debugger            = debugger;
1111 
1112         /* Allocate space for command line buffers, NUL terminated c strings */
1113         pdb->cur_command = mem_gc_allocate_n_typed(interp, DEBUG_CMD_BUFFER_LENGTH + 1, char);
1114         pdb->last_command = mem_gc_allocate_n_typed(interp, DEBUG_CMD_BUFFER_LENGTH + 1, char);
1115         pdb->file = mem_gc_allocate_zeroed_typed(interp, PDB_file_t);
1116     }
1117 
1118     /* PDB_disassemble(interp, NULL); */
1119 
1120     interp->pdb->state     |= PDB_RUNNING;
1121 }
1122 
1123 /*
1124 
1125 =item C<void Parrot_debugger_destroy(PARROT_INTERP)>
1126 
1127 Destroy the current Parrot debugger instance.
1128 
1129 =cut
1130 
1131 */
1132 
1133 PARROT_EXPORT
1134 void
Parrot_debugger_destroy(PARROT_INTERP)1135 Parrot_debugger_destroy(PARROT_INTERP)
1136 {
1137     ASSERT_ARGS(Parrot_debugger_destroy)
1138     /* Unfinished.
1139        Free all debugger allocated resources.
1140      */
1141     PDB_t * const pdb = interp->pdb;
1142 
1143     TRACEDEB_MSG("Parrot_debugger_destroy");
1144 
1145     PARROT_ASSERT(pdb);
1146     PARROT_ASSERT(pdb->debugee == interp);
1147 
1148     mem_gc_free(interp, pdb->last_command);
1149     mem_gc_free(interp, pdb->cur_command);
1150 
1151     mem_gc_free(interp, pdb);
1152     interp->pdb = NULL;
1153 }
1154 
1155 /*
1156 
1157 =item C<void Parrot_debugger_load(PARROT_INTERP, const STRING *filename)>
1158 
1159 Loads a Parrot source file for the current program.
1160 
1161 =cut
1162 
1163 */
1164 
1165 PARROT_EXPORT
1166 void
Parrot_debugger_load(PARROT_INTERP,ARGIN_NULLOK (const STRING * filename))1167 Parrot_debugger_load(PARROT_INTERP, ARGIN_NULLOK(const STRING *filename))
1168 {
1169     ASSERT_ARGS(Parrot_debugger_load)
1170     char *file;
1171 
1172     TRACEDEB_MSG("Parrot_debugger_load");
1173 
1174     if (!interp->pdb)
1175         Parrot_ex_throw_from_c_noargs(interp, EXCEPTION_PARROT_USAGE_ERROR,
1176                 "No debugger");
1177 
1178     file = Parrot_str_to_cstring(interp, filename);
1179     PDB_load_source(interp, file);
1180     Parrot_str_free_cstring(file);
1181 }
1182 
1183 /*
1184 
1185 =item C<void Parrot_debugger_start(PARROT_INTERP, opcode_t * cur_opcode)>
1186 
1187 Start debugger.
1188 
1189 =cut
1190 
1191 */
1192 
1193 PARROT_EXPORT
1194 void
Parrot_debugger_start(PARROT_INTERP,ARGIN_NULLOK (opcode_t * cur_opcode))1195 Parrot_debugger_start(PARROT_INTERP, ARGIN_NULLOK(opcode_t * cur_opcode))
1196 {
1197     ASSERT_ARGS(Parrot_debugger_start)
1198     TRACEDEB_MSG("Parrot_debugger_start");
1199 
1200     if (!interp->pdb)
1201         Parrot_ex_throw_from_c_noargs(interp, EXCEPTION_PARROT_USAGE_ERROR,
1202                 "No debugger");
1203 
1204     interp->pdb->cur_opcode = interp->code->base.data;
1205 
1206     if (interp->pdb->state & PDB_ENTER) {
1207         if (!interp->pdb->file) {
1208             /* PDB_disassemble(interp, NULL); */
1209         }
1210         interp->pdb->state &= ~PDB_ENTER;
1211     }
1212 
1213     interp->pdb->cur_opcode = cur_opcode;
1214 
1215     interp->pdb->state |= PDB_STOPPED;
1216 
1217     debugger_cmdline(interp);
1218 
1219     if (interp->pdb->state & PDB_EXIT) {
1220         TRACEDEB_MSG("Parrot_debugger_start Parrot_x_exit");
1221         Parrot_x_exit(interp, 0);
1222     }
1223     TRACEDEB_MSG("Parrot_debugger_start ends");
1224 }
1225 
1226 /*
1227 
1228 =item C<void Parrot_debugger_break(PARROT_INTERP, opcode_t * cur_opcode)>
1229 
1230 Breaks execution and drops into the debugger.  If we are already into the
1231 debugger and it is the first call, set a breakpoint.
1232 
1233 When you re run/continue the program being debugged it will pay no attention to
1234 the debug ops.
1235 
1236 =cut
1237 
1238 */
1239 
1240 PARROT_EXPORT
1241 void
Parrot_debugger_break(PARROT_INTERP,ARGIN (opcode_t * cur_opcode))1242 Parrot_debugger_break(PARROT_INTERP, ARGIN(opcode_t * cur_opcode))
1243 {
1244     ASSERT_ARGS(Parrot_debugger_break)
1245     TRACEDEB_MSG("Parrot_debugger_break");
1246 
1247     if (!interp->pdb)
1248         Parrot_ex_throw_from_c_noargs(interp, EXCEPTION_PARROT_USAGE_ERROR,
1249                 "No debugger");
1250 
1251     if (!interp->pdb->file)
1252         Parrot_ex_throw_from_c_noargs(interp, EXCEPTION_PARROT_USAGE_ERROR,
1253                 "No file loaded to debug");
1254 
1255     if (!(interp->pdb->state & PDB_BREAK)) {
1256         TRACEDEB_MSG("Parrot_debugger_break - in BREAK state");
1257         Parrot_runloop_new_jump_point(interp);
1258         if (setjmp(interp->current_runloop->resume)) {
1259             fprintf(stderr, "Unhandled exception in debugger\n");
1260             return;
1261         }
1262 
1263         interp->pdb->state     |= PDB_BREAK;
1264         interp->pdb->state     |= PDB_STOPPED;
1265         interp->pdb->cur_opcode = cur_opcode + 1;
1266 
1267         /*PDB_set_break(interp, NULL);*/
1268 
1269         debugger_cmdline(interp);
1270     }
1271     else {
1272         interp->pdb->cur_opcode = cur_opcode + 1;
1273         /*PDB_set_break(interp, NULL);*/
1274     }
1275     TRACEDEB_MSG("Parrot_debugger_break done");
1276 }
1277 
1278 /*
1279 
1280 =item C<void PDB_get_command(PARROT_INTERP)>
1281 
1282 Get a command from the user input to execute.
1283 
1284 It saves the last command executed (in C<< pdb->last_command >>), so it
1285 first frees the old one and updates it with the current one.
1286 
1287 Also prints the next line to run if the program is still active.
1288 
1289 The user input can't be longer than DEBUG_CMD_BUFFER_LENGTH characters.
1290 
1291 The input is saved in C<< pdb->cur_command >>.
1292 
1293 =cut
1294 
1295 */
1296 
1297 void
PDB_get_command(PARROT_INTERP)1298 PDB_get_command(PARROT_INTERP)
1299 {
1300     ASSERT_ARGS(PDB_get_command)
1301     char         *c;
1302     PDB_t        * const pdb = interp->pdb;
1303 
1304 /***********************************
1305    **** Testing ****
1306    Do not delete yet
1307    the commented out
1308    parts
1309 ***********************************/
1310 
1311     /* flush the buffered data */
1312     fflush(stdout);
1313 
1314     TRACEDEB_MSG("PDB_get_command");
1315 
1316     PARROT_ASSERT(pdb->last_command);
1317     PARROT_ASSERT(pdb->cur_command);
1318 
1319     if (interp->pdb->script_file) {
1320         FILE * const fd = interp->pdb->script_file;
1321         char buf[DEBUG_CMD_BUFFER_LENGTH+1];
1322         const char *ptr;
1323 
1324         do {
1325             if (fgets(buf, DEBUG_CMD_BUFFER_LENGTH, fd) == NULL) {
1326                 close_script_file(interp);
1327                 return;
1328             }
1329             ++pdb->script_line;
1330             chop_newline(buf);
1331 #if TRACE_DEBUGGER
1332             fprintf(stderr, "script (%lu): '%s'\n", pdb->script_line, buf);
1333 #endif
1334 
1335             /* skip spaces */
1336             ptr = skip_whitespace(buf);
1337 
1338             /* skip blank and commented lines */
1339        } while (*ptr == '\0' || *ptr == '#');
1340 
1341         if (pdb->state & PDB_ECHO)
1342             Parrot_io_eprintf(pdb->debugger, "[%lu %s]\n", pdb->script_line, buf);
1343 
1344 #if TRACE_DEBUGGER
1345         fprintf(stderr, "(script) %s\n", buf);
1346 #endif
1347 
1348         strcpy(pdb->cur_command, buf);
1349     }
1350     else {
1351         /* update the last command */
1352         if (pdb->cur_command[0] != '\0')
1353             strcpy(pdb->last_command, pdb->cur_command);
1354 
1355         c = pdb->cur_command;
1356 
1357         Parrot_io_eprintf(pdb->debugger, "\n");
1358 
1359         {
1360             Interp * const interpdeb = interp->pdb->debugger;
1361             STRING * const readline  = CONST_STRING(interpdeb, "readline_interactive");
1362             STRING * const prompt    = CONST_STRING(interpdeb, "(pdb) ");
1363             STRING * const s         = Parrot_str_new(interpdeb, NULL, 0);
1364             PMC    * const tmp_stdin = Parrot_io_stdhandle(interpdeb, 0, NULL);
1365 
1366             Parrot_pcc_invoke_method_from_c_args(interpdeb,
1367                 tmp_stdin, readline,
1368                 "S->S", prompt, &s);
1369             {
1370                 char * const aux = Parrot_str_to_cstring(interpdeb, s);
1371                 strcpy(c, aux);
1372                 Parrot_str_free_cstring(aux);
1373             }
1374         }
1375     }
1376 }
1377 
1378 /*
1379 
1380 =item C<void PDB_script_file(PARROT_INTERP, const char *command)>
1381 
1382 Interprets the contents of a file as user input commands
1383 
1384 =cut
1385 
1386 */
1387 
1388 PARROT_EXPORT
1389 void
PDB_script_file(PARROT_INTERP,ARGIN (const char * command))1390 PDB_script_file(PARROT_INTERP, ARGIN(const char *command))
1391 {
1392     ASSERT_ARGS(PDB_script_file)
1393     FILE *fd;
1394 
1395     TRACEDEB_MSG("PDB_script_file");
1396 
1397     /* If already executing a script, close it */
1398     close_script_file(interp);
1399 
1400     TRACEDEB_MSG("Opening debugger script file");
1401 
1402     fd = fopen(command, "r");
1403     if (!fd) {
1404         Parrot_io_eprintf(interp->pdb->debugger,
1405                 "Error reading script file %s.\n",
1406                 command);
1407         return;
1408     }
1409     interp->pdb->script_file = fd;
1410     interp->pdb->script_line = 0;
1411     TRACEDEB_MSG("PDB_script_file finished");
1412 }
1413 
1414 /*
1415 
1416 =item C<int PDB_run_command(PARROT_INTERP, const char *command)>
1417 
1418 Run a command.
1419 
1420 Hash the command to make a simple switch calling the correct handler.
1421 
1422 =cut
1423 
1424 */
1425 
1426 PARROT_IGNORABLE_RESULT
1427 int
PDB_run_command(PARROT_INTERP,ARGIN (const char * command))1428 PDB_run_command(PARROT_INTERP, ARGIN(const char *command))
1429 {
1430     ASSERT_ARGS(PDB_run_command)
1431     PDB_t        * const pdb = interp->pdb;
1432     const DebuggerCmd *cmd;
1433 
1434     /* keep a pointer to the command, in case we need to report an error */
1435 
1436     const char * cmdline = command;
1437 
1438     TRACEDEB_MSG("PDB_run_command");
1439     cmd = get_cmd(& cmdline);
1440 
1441     if (cmd) {
1442         (* cmd->func)(pdb, cmdline);
1443         return 0;
1444     }
1445     else {
1446         if (*cmdline == '\0') {
1447             return 0;
1448         }
1449         else {
1450             Parrot_io_eprintf(pdb->debugger,
1451                         "Undefined command: \"%s\"", command);
1452             if (pdb->script_file)
1453                 Parrot_io_eprintf(pdb->debugger, " in line %lu", pdb->script_line);
1454             Parrot_io_eprintf(pdb->debugger, ".  Try \"help\".");
1455             close_script_file(interp);
1456             return 1;
1457         }
1458     }
1459 }
1460 
1461 /*
1462 
1463 =item C<void PDB_next(PARROT_INTERP, const char *command)>
1464 
1465 Execute the next N operation(s).
1466 
1467 Inits the program if needed, runs the next N >= 1 operations and stops.
1468 
1469 =cut
1470 
1471 */
1472 
1473 void
PDB_next(PARROT_INTERP,ARGIN_NULLOK (const char * command))1474 PDB_next(PARROT_INTERP, ARGIN_NULLOK(const char *command))
1475 {
1476     ASSERT_ARGS(PDB_next)
1477     PDB_t  * const pdb = interp->pdb;
1478     Interp *debugee;
1479 
1480     TRACEDEB_MSG("PDB_next");
1481 
1482     /* Init the program if it's not running */
1483     if (!(pdb->state & PDB_RUNNING))
1484         PDB_init(interp, command);
1485 
1486     /* Get the number of operations to execute if any */
1487     pdb->tracing = get_ulong(& command, 1);
1488 
1489     /* Erase the stopped flag */
1490     pdb->state &= ~PDB_STOPPED;
1491 
1492     debugee     = pdb->debugee;
1493 
1494     Parrot_runloop_new_jump_point(debugee);
1495     if (setjmp(debugee->current_runloop->resume)) {
1496         Parrot_io_eprintf(pdb->debugger, "Unhandled exception while tracing\n");
1497         pdb->state |= PDB_STOPPED;
1498         return;
1499     }
1500 
1501     Parrot_runcore_switch(pdb->debugee, CONST_STRING(interp, "debugger"));
1502 
1503     TRACEDEB_MSG("PDB_next finished");
1504 }
1505 
1506 /*
1507 
1508 =item C<void PDB_trace(PARROT_INTERP, const char *command)>
1509 
1510 Execute the next N operations; if no number is specified, it defaults to 1.
1511 
1512 =cut
1513 
1514 */
1515 
1516 void
PDB_trace(PARROT_INTERP,ARGIN_NULLOK (const char * command))1517 PDB_trace(PARROT_INTERP, ARGIN_NULLOK(const char *command))
1518 {
1519     ASSERT_ARGS(PDB_trace)
1520     PDB_t *  const pdb = interp->pdb;
1521     Interp        *debugee;
1522 
1523     TRACEDEB_MSG("PDB_trace");
1524 
1525     /* if debugger is not running yet, initialize */
1526     /*
1527     if (!(pdb->state & PDB_RUNNING))
1528         PDB_init(interp, command);
1529     */
1530 
1531     /* get the number of ops to run, if specified */
1532     pdb->tracing = get_ulong(& command, 1);
1533 
1534     /* clear the PDB_STOPPED flag, we'll be running n ops now */
1535     pdb->state &= ~PDB_STOPPED;
1536     debugee     = pdb->debugee;
1537 
1538     /* execute n ops */
1539     Parrot_runloop_new_jump_point(debugee);
1540     if (setjmp(debugee->current_runloop->resume)) {
1541         Parrot_io_eprintf(pdb->debugger, "Unhandled exception while tracing\n");
1542         pdb->state |= PDB_STOPPED;
1543         return;
1544     }
1545 
1546     pdb->state |= PDB_TRACING;
1547     Parrot_runcore_switch(pdb->debugee, CONST_STRING(interp, "debugger"));
1548 
1549     /* Clear the following when done some testing */
1550 
1551     /* we just stopped */
1552     pdb->state |= PDB_STOPPED;
1553 
1554     /* If program ended */
1555     if (!pdb->cur_opcode)
1556         (void)PDB_program_end(interp);
1557     pdb->state |= PDB_RUNNING;
1558     pdb->state &= ~PDB_STOPPED;
1559 
1560     TRACEDEB_MSG("PDB_trace finished");
1561 }
1562 
1563 /*
1564 
1565 =item C<static unsigned short condition_regtype(const char *cmd)>
1566 
1567 Return the type of the register represented by C<*cmd>.
1568 
1569 =cut
1570 
1571 */
1572 
1573 static unsigned short
condition_regtype(ARGIN (const char * cmd))1574 condition_regtype(ARGIN(const char *cmd))
1575 {
1576     ASSERT_ARGS(condition_regtype)
1577     switch (*cmd) {
1578       case 'i':
1579       case 'I':
1580         return PDB_cond_int;
1581       case 'n':
1582       case 'N':
1583         return PDB_cond_num;
1584       case 's':
1585       case 'S':
1586         return PDB_cond_str;
1587       case 'p':
1588       case 'P':
1589         return PDB_cond_pmc;
1590       default:
1591         return 0;
1592     }
1593 }
1594 
1595 /*
1596 
1597 =item C<PDB_condition_t * PDB_cond(PARROT_INTERP, const char *command)>
1598 
1599 Analyzes a condition from the user input.
1600 
1601 =cut
1602 
1603 */
1604 
1605 PARROT_CAN_RETURN_NULL
1606 PDB_condition_t *
PDB_cond(PARROT_INTERP,ARGIN (const char * command))1607 PDB_cond(PARROT_INTERP, ARGIN(const char *command))
1608 {
1609     ASSERT_ARGS(PDB_cond)
1610     PDB_condition_t *condition;
1611     const char      *auxcmd;
1612     char             str[DEBUG_CMD_BUFFER_LENGTH + 1];
1613     unsigned short   cond_argleft;
1614     unsigned short   cond_type;
1615     int              i, reg_number;
1616 
1617     TRACEDEB_MSG("PDB_cond");
1618 
1619     /* Return if no more arguments */
1620     if (!(command && *command)) {
1621         Parrot_io_eprintf(interp->pdb->debugger, "No condition specified\n");
1622         return NULL;
1623     }
1624 
1625     command = skip_whitespace(command);
1626 #if TRACE_DEBUGGER
1627     fprintf(stderr, "PDB_trace: '%s'\n", command);
1628 #endif
1629 
1630     cond_argleft = condition_regtype(command);
1631 
1632     /* get the register number */
1633     auxcmd     = ++command;
1634     reg_number = get_uint(&command, 0);
1635 
1636     if (auxcmd == command) {
1637         Parrot_io_eprintf(interp->pdb->debugger, "Invalid register\n");
1638             return NULL;
1639     }
1640 
1641     /* Now the condition */
1642     command = skip_whitespace(command);
1643     switch (*command) {
1644       case '>':
1645         if (*(command + 1) == '=')
1646             cond_type = PDB_cond_ge;
1647         else
1648             cond_type = PDB_cond_gt;
1649         break;
1650       case '<':
1651         if (*(command + 1) == '=')
1652             cond_type = PDB_cond_le;
1653         else
1654             cond_type = PDB_cond_lt;
1655         break;
1656       case '=':
1657         if (*(command + 1) == '=')
1658             cond_type = PDB_cond_eq;
1659         else
1660             goto INV_COND;
1661         break;
1662       case '!':
1663         if (*(command + 1) == '=')
1664             cond_type = PDB_cond_ne;
1665         else
1666             goto INV_COND;
1667         break;
1668       case '\0':
1669         if (cond_argleft != PDB_cond_str && cond_argleft != PDB_cond_pmc) {
1670             Parrot_io_eprintf(interp->pdb->debugger, "Invalid null condition\n");
1671             return NULL;
1672         }
1673         cond_type = PDB_cond_notnull;
1674         break;
1675       default:
1676   INV_COND:
1677         Parrot_io_eprintf(interp->pdb->debugger, "Invalid condition\n");
1678         return NULL;
1679     }
1680 
1681     /* if there's an '=', skip it */
1682     if (*(command + 1) == '=')
1683         command += 2;
1684     else
1685         ++command;
1686 
1687     command = skip_whitespace(command);
1688 
1689     /* return if no notnull condition and no more arguments */
1690     if (!(command && *command) && (cond_type != PDB_cond_notnull)) {
1691         Parrot_io_eprintf(interp->pdb->debugger, "Can't compare a register with nothing\n");
1692         return NULL;
1693     }
1694 
1695     /* Allocate new condition */
1696     condition = mem_gc_allocate_zeroed_typed(interp, PDB_condition_t);
1697 
1698     condition->type = cond_argleft | cond_type;
1699 
1700     if (cond_type != PDB_cond_notnull) {
1701 
1702         if (isalpha((unsigned char)*command)) {
1703             /* It's a register - we first check that it's the correct type */
1704 
1705             unsigned short cond_argright = condition_regtype(command);
1706 
1707             if (cond_argright != cond_argleft) {
1708                 Parrot_io_eprintf(interp->pdb->debugger, "Register types don't agree\n");
1709                 mem_gc_free(interp, condition);
1710                 return NULL;
1711             }
1712 
1713             /* Now we check and store the register number */
1714             auxcmd = ++command;
1715             reg_number = (int)get_uint(&command, 0);
1716             if (auxcmd == command) {
1717                 Parrot_io_eprintf(interp->pdb->debugger, "Invalid register\n");
1718                     mem_gc_free(interp, condition);
1719                     return NULL;
1720             }
1721 
1722             if (reg_number < 0) {
1723                 Parrot_io_eprintf(interp->pdb->debugger, "Out-of-bounds register\n");
1724                 mem_gc_free(interp, condition);
1725                 return NULL;
1726             }
1727 
1728             condition->value         = mem_gc_allocate_typed(interp, int);
1729             *(int *)condition->value = reg_number;
1730         }
1731         /* If the first argument was an integer */
1732         else if (condition->type & PDB_cond_int) {
1733             /* This must be either an integer constant or register */
1734             condition->value             = mem_gc_allocate_typed(interp, INTVAL);
1735             *(INTVAL *)condition->value  = (INTVAL)atoi(command);
1736             condition->type             |= PDB_cond_const;
1737         }
1738         else if (condition->type & PDB_cond_num) {
1739             condition->value               = mem_gc_allocate_typed(interp, FLOATVAL);
1740             *(FLOATVAL *)condition->value  = (FLOATVAL)atof(command);
1741             condition->type               |= PDB_cond_const;
1742         }
1743         else if (condition->type & PDB_cond_str) {
1744             for (i = 1; ((command[i] != '"') && (i < DEBUG_CMD_BUFFER_LENGTH)); ++i)
1745                 str[i - 1] = command[i];
1746             str[i - 1] = '\0';
1747 #if TRACE_DEBUGGER
1748             fprintf(stderr, "PDB_break: '%s'\n", str);
1749 #endif
1750             condition->value = Parrot_str_new_init(interp, str, (UINTVAL)(i - 1),
1751                 Parrot_default_encoding_ptr, 0);
1752 
1753             condition->type |= PDB_cond_const;
1754         }
1755         else if (condition->type & PDB_cond_pmc) {
1756             /* GH #671: Need to figure out what to do in this case.
1757              * For the time being, we just bail. */
1758             Parrot_io_eprintf(interp->pdb->debugger, "Can't compare PMC with constant\n");
1759             mem_gc_free(interp, condition);
1760             return NULL;
1761         }
1762 
1763     }
1764 
1765     return condition;
1766 }
1767 
1768 /*
1769 
1770 =item C<void PDB_watchpoint(PARROT_INTERP, const char *command)>
1771 
1772 Set a watchpoint.
1773 
1774 =cut
1775 
1776 */
1777 
1778 void
PDB_watchpoint(PARROT_INTERP,ARGIN (const char * command))1779 PDB_watchpoint(PARROT_INTERP, ARGIN(const char *command))
1780 {
1781     ASSERT_ARGS(PDB_watchpoint)
1782     PDB_t           * const pdb = interp->pdb;
1783     PDB_condition_t * const condition = PDB_cond(interp, command);
1784 
1785     if (!condition)
1786         return;
1787 
1788     /* Add it to the head of the list */
1789     if (pdb->watchpoint)
1790         condition->next = pdb->watchpoint;
1791     pdb->watchpoint = condition;
1792     fprintf(stderr, "Adding watchpoint\n");
1793 }
1794 
1795 /*
1796 
1797 =item C<void PDB_set_break(PARROT_INTERP, const char *command)>
1798 
1799 Set a break point, the source code file must be loaded.
1800 
1801 =cut
1802 
1803 */
1804 
1805 void
PDB_set_break(PARROT_INTERP,ARGIN_NULLOK (const char * command))1806 PDB_set_break(PARROT_INTERP, ARGIN_NULLOK(const char *command))
1807 {
1808     ASSERT_ARGS(PDB_set_break)
1809     PDB_t            * const pdb      = interp->pdb;
1810     PDB_breakpoint_t *newbreak;
1811     PDB_line_t       *line = NULL;
1812     opcode_t         *breakpos = NULL;
1813 
1814     unsigned long ln = get_ulong(& command, 0);
1815 
1816     TRACEDEB_MSG("PDB_set_break");
1817 
1818     /* If there is a source file use line number, else opcode position */
1819 
1820     if (pdb->file && pdb->file->size) {
1821         TRACEDEB_MSG("PDB_set_break file");
1822 
1823         /* If no line number was specified, set it at the current line */
1824         if (ln != 0) {
1825             unsigned long i;
1826 
1827             /* Move to the line where we will set the break point */
1828             line = pdb->file->line;
1829 
1830             for (i = 1; ((i < ln) && (line->next)); ++i)
1831                 line = line->next;
1832 
1833             /* Abort if the line number provided doesn't exist */
1834             if (line == NULL || !line->next) {
1835                 Parrot_io_eprintf(pdb->debugger,
1836                     "Can't set a breakpoint at line number %li\n", ln);
1837                 return;
1838             }
1839         }
1840         else {
1841             /* Get the line to set it */
1842             line = pdb->file->line;
1843 
1844             TRACEDEB_MSG("PDB_set_break reading ops");
1845             while (line->opcode != pdb->cur_opcode) {
1846                 line = line->next;
1847                 if (!line) {
1848                     Parrot_io_eprintf(pdb->debugger,
1849                        "No current line found and no line number specified\n");
1850                     return;
1851                 }
1852             }
1853         }
1854         /* Skip lines that are not related to an opcode */
1855         while (line && !line->opcode)
1856             line = line->next;
1857         /* Abort if the line number provided doesn't exist */
1858         if (!line) {
1859             Parrot_io_eprintf(pdb->debugger,
1860                 "Can't set a breakpoint at line number %li\n", ln);
1861             return;
1862         }
1863 
1864         breakpos = line->opcode;
1865     }
1866     else {
1867         TRACEDEB_MSG("PDB_set_break no file");
1868         breakpos = interp->code->base.data + ln;
1869     }
1870 
1871     TRACEDEB_MSG("PDB_set_break allocate breakpoint");
1872     /* Allocate the new break point */
1873     newbreak = mem_gc_allocate_zeroed_typed(interp, PDB_breakpoint_t);
1874 
1875     if (! command) {
1876         Parrot_ex_throw_from_c_noargs(interp, EXCEPTION_UNEXPECTED_NULL,
1877             "NULL command passed to PDB_set_break");
1878     }
1879 
1880     /* if there is another argument to break, besides the line number,
1881      * it should be an 'if', so we call another handler. */
1882     if (command && *command) {
1883         command = skip_whitespace(command);
1884         while (! isspace((unsigned char)*command))
1885             ++command;
1886         command = skip_whitespace(command);
1887         newbreak->condition = PDB_cond(interp, command);
1888     }
1889 
1890     /* Set the address where to stop and the line number. */
1891     newbreak->pc   = breakpos;
1892     newbreak->line = line->number;
1893 
1894     /* Don't skip (at least initially) */
1895     newbreak->skip = 0;
1896 
1897     /* Add the breakpoint to the end of the list, dealing with the first
1898        breakpoint as a special case. */
1899 
1900     if (!pdb->breakpoint) {
1901         newbreak->id = 1;
1902         pdb->breakpoint = newbreak;
1903     }
1904     else {
1905         PDB_breakpoint_t *oldbreak;
1906 
1907         for (oldbreak = pdb->breakpoint; oldbreak->next; oldbreak = oldbreak->next)
1908             ;
1909         newbreak->id = oldbreak->id + 1;
1910         oldbreak->next = newbreak;
1911         newbreak->prev = oldbreak;
1912     }
1913 
1914     /* Show breakpoint position */
1915 
1916     display_breakpoint(pdb, newbreak);
1917 }
1918 
1919 /*
1920 
1921 =item C<static void list_breakpoints(const PDB_t *pdb)>
1922 
1923 Print all breakpoints for this debugger session to C<pdb->debugger>.
1924 
1925 =cut
1926 
1927 */
1928 
1929 static void
list_breakpoints(ARGIN (const PDB_t * pdb))1930 list_breakpoints(ARGIN(const PDB_t *pdb))
1931 {
1932     ASSERT_ARGS(list_breakpoints)
1933 
1934     if (pdb->breakpoint) {
1935         const PDB_breakpoint_t *breakpoint;
1936 
1937         for (breakpoint = pdb->breakpoint;
1938              breakpoint;
1939              breakpoint = breakpoint->next)
1940             display_breakpoint(pdb, breakpoint);
1941     }
1942     else
1943         Parrot_io_eprintf(pdb->debugger, "No breakpoints set\n");
1944 }
1945 
1946 /*
1947 
1948 =item C<void PDB_init(PARROT_INTERP, const char *command)>
1949 
1950 Init the program.
1951 
1952 =cut
1953 
1954 */
1955 
1956 void
PDB_init(PARROT_INTERP,ARGIN_NULLOK (SHIM (const char * command)))1957 PDB_init(PARROT_INTERP, ARGIN_NULLOK(SHIM(const char *command)))
1958 {
1959     ASSERT_ARGS(PDB_init)
1960     PDB_t * const pdb = interp->pdb;
1961 
1962     /* Restart if we are already running */
1963     if (pdb->state & PDB_RUNNING)
1964         Parrot_io_eprintf(pdb->debugger, "Restarting\n");
1965 
1966     /* Add the RUNNING state */
1967     pdb->state |= PDB_RUNNING;
1968 }
1969 
1970 /*
1971 
1972 =item C<void PDB_continue(PARROT_INTERP, const char *command)>
1973 
1974 Continue running the program. If a number is specified, skip that many
1975 breakpoints.
1976 
1977 =cut
1978 
1979 */
1980 
1981 void
PDB_continue(PARROT_INTERP,ARGIN_NULLOK (const char * command))1982 PDB_continue(PARROT_INTERP, ARGIN_NULLOK(const char *command))
1983 {
1984     ASSERT_ARGS(PDB_continue)
1985     PDB_t * const pdb = interp->pdb;
1986     unsigned long ln = 0;
1987 
1988     TRACEDEB_MSG("PDB_continue");
1989 
1990     /* Skip any breakpoint? */
1991     if (command)
1992         ln = get_ulong(& command, 0);
1993 
1994     if (ln != 0) {
1995         if (!pdb->breakpoint) {
1996             Parrot_io_eprintf(pdb->debugger, "No breakpoints to skip\n");
1997             return;
1998         }
1999 
2000         PDB_skip_breakpoint(interp, ln);
2001     }
2002 
2003     pdb->state |= PDB_RUNNING;
2004     pdb->state &= ~PDB_BREAK;
2005     pdb->state &= ~PDB_STOPPED;
2006 }
2007 
2008 /*
2009 
2010 =item C<PDB_breakpoint_t * PDB_find_breakpoint(PARROT_INTERP, const char
2011 *command)>
2012 
2013 Find breakpoint number N; returns C<NULL> if the breakpoint doesn't
2014 exist or if no breakpoint was specified.
2015 
2016 =cut
2017 
2018 */
2019 
2020 PARROT_CAN_RETURN_NULL
2021 PARROT_WARN_UNUSED_RESULT
2022 PDB_breakpoint_t *
PDB_find_breakpoint(PARROT_INTERP,ARGIN (const char * command))2023 PDB_find_breakpoint(PARROT_INTERP, ARGIN(const char *command))
2024 {
2025     ASSERT_ARGS(PDB_find_breakpoint)
2026     const char * const oldcmd = command;
2027     const unsigned long n = get_ulong(&command, 0);
2028 
2029     if (command != oldcmd) {
2030         PDB_breakpoint_t *breakpoint = interp->pdb->breakpoint;
2031 
2032         while (breakpoint && breakpoint->id != n)
2033             breakpoint = breakpoint->next;
2034 
2035         if (!breakpoint) {
2036             Parrot_io_eprintf(interp->pdb->debugger, "No breakpoint [%ld]", n);
2037             return NULL;
2038         }
2039 
2040         return breakpoint;
2041     }
2042     else {
2043         /* Report an appropriate error */
2044         if (*command)
2045             Parrot_io_eprintf(interp->pdb->debugger, "Not a valid breakpoint");
2046         else
2047             Parrot_io_eprintf(interp->pdb->debugger, "No breakpoint specified");
2048 
2049         return NULL;
2050     }
2051 }
2052 
2053 /*
2054 
2055 =item C<void PDB_disable_breakpoint(PARROT_INTERP, const char *command)>
2056 
2057 Disable a breakpoint; it can be reenabled with the enable command.
2058 
2059 =cut
2060 
2061 */
2062 
2063 void
PDB_disable_breakpoint(PARROT_INTERP,ARGIN (const char * command))2064 PDB_disable_breakpoint(PARROT_INTERP, ARGIN(const char *command))
2065 {
2066     ASSERT_ARGS(PDB_disable_breakpoint)
2067     PDB_breakpoint_t * const breakpoint = PDB_find_breakpoint(interp, command);
2068 
2069     /* if the breakpoint exists, disable it. */
2070     if (breakpoint) {
2071         breakpoint->skip = -1;
2072         display_breakpoint(interp->pdb, breakpoint);
2073     }
2074 }
2075 
2076 /*
2077 
2078 =item C<void PDB_enable_breakpoint(PARROT_INTERP, const char *command)>
2079 
2080 Reenable a disabled breakpoint.
2081 
2082 =cut
2083 
2084 */
2085 
2086 void
PDB_enable_breakpoint(PARROT_INTERP,ARGIN (const char * command))2087 PDB_enable_breakpoint(PARROT_INTERP, ARGIN(const char *command))
2088 {
2089     ASSERT_ARGS(PDB_enable_breakpoint)
2090     PDB_breakpoint_t * const breakpoint = PDB_find_breakpoint(interp, command);
2091 
2092     /* If there is a breakpoint and it's disabled, re-enable it.
2093        If it's not disabled, tell the user. */
2094 
2095     if (breakpoint) {
2096         if (breakpoint->skip < 0) {
2097             breakpoint->skip = 0;
2098             display_breakpoint(interp->pdb, breakpoint);
2099         }
2100         else
2101             Parrot_io_eprintf(interp->pdb->debugger,
2102                               "Breakpoint [%d] is not disabled",
2103                               breakpoint->id);
2104     }
2105 }
2106 
2107 /*
2108 
2109 =item C<void PDB_delete_breakpoint(PARROT_INTERP, const char *command)>
2110 
2111 Delete a breakpoint.
2112 
2113 =cut
2114 
2115 */
2116 
2117 void
PDB_delete_breakpoint(PARROT_INTERP,ARGIN (const char * command))2118 PDB_delete_breakpoint(PARROT_INTERP, ARGIN(const char *command))
2119 {
2120     ASSERT_ARGS(PDB_delete_breakpoint)
2121     PDB_t * const pdb = interp->pdb;
2122     PDB_breakpoint_t * const breakpoint = PDB_find_breakpoint(interp, command);
2123 
2124     if (breakpoint) {
2125         display_breakpoint(pdb, breakpoint);
2126 
2127         /* Delete the condition structure, if there is one */
2128         if (breakpoint->condition) {
2129             PDB_delete_condition(interp, breakpoint);
2130             breakpoint->condition = NULL;
2131         }
2132 
2133         /* Remove the breakpoint from the list */
2134         if (breakpoint->prev && breakpoint->next) {
2135             breakpoint->prev->next = breakpoint->next;
2136             breakpoint->next->prev = breakpoint->prev;
2137         }
2138         else if (breakpoint->prev && !breakpoint->next) {
2139             breakpoint->prev->next = NULL;
2140         }
2141         else if (!breakpoint->prev && breakpoint->next) {
2142             breakpoint->next->prev  = NULL;
2143             pdb->breakpoint = breakpoint->next;
2144         }
2145         else {
2146             pdb->breakpoint = NULL;
2147         }
2148 
2149         /* Kill the breakpoint */
2150         mem_gc_free(interp, breakpoint);
2151 
2152         Parrot_io_eprintf(pdb->debugger, "Deleted\n");
2153     }
2154 }
2155 
2156 /*
2157 
2158 =item C<void PDB_delete_condition(PARROT_INTERP, PDB_breakpoint_t *breakpoint)>
2159 
2160 Delete a condition associated with a breakpoint.
2161 
2162 =cut
2163 
2164 */
2165 
2166 void
PDB_delete_condition(PARROT_INTERP,ARGMOD (PDB_breakpoint_t * breakpoint))2167 PDB_delete_condition(PARROT_INTERP, ARGMOD(PDB_breakpoint_t *breakpoint))
2168 {
2169     ASSERT_ARGS(PDB_delete_condition)
2170     if (breakpoint->condition->value) {
2171         if (breakpoint->condition->type & PDB_cond_str) {
2172             /* 'value' is a string, so we need to be careful */
2173             PObj_external_CLEAR((STRING*)breakpoint->condition->value);
2174             PObj_on_free_list_SET((STRING*)breakpoint->condition->value);
2175             /* it should now be properly garbage collected after
2176                we destroy the condition */
2177         }
2178         else {
2179             /* 'value' is a float or an int, so we can just free it */
2180             mem_gc_free(interp, breakpoint->condition->value);
2181             breakpoint->condition->value = NULL;
2182         }
2183     }
2184 
2185     mem_gc_free(interp, breakpoint->condition);
2186     breakpoint->condition = NULL;
2187 }
2188 
2189 /*
2190 
2191 =item C<void PDB_skip_breakpoint(PARROT_INTERP, unsigned long i)>
2192 
2193 Skip C<i> times all breakpoints.
2194 
2195 =cut
2196 
2197 */
2198 
2199 void
PDB_skip_breakpoint(PARROT_INTERP,unsigned long i)2200 PDB_skip_breakpoint(PARROT_INTERP, unsigned long i)
2201 {
2202     ASSERT_ARGS(PDB_skip_breakpoint)
2203 #if TRACE_DEBUGGER
2204         fprintf(stderr, "PDB_skip_breakpoint: %li\n", i);
2205 #endif
2206 
2207     interp->pdb->breakpoint_skip = i;
2208 }
2209 
2210 /*
2211 
2212 =item C<char PDB_program_end(PARROT_INTERP)>
2213 
2214 End the program.
2215 
2216 =cut
2217 
2218 */
2219 
2220 char
PDB_program_end(PARROT_INTERP)2221 PDB_program_end(PARROT_INTERP)
2222 {
2223     ASSERT_ARGS(PDB_program_end)
2224     PDB_t * const pdb = interp->pdb;
2225 
2226     TRACEDEB_MSG("PDB_program_end");
2227 
2228     /* Remove the RUNNING state */
2229     pdb->state &= ~PDB_RUNNING;
2230 
2231     Parrot_io_eprintf(pdb->debugger, "[program exited]\n");
2232     return 1;
2233 }
2234 
2235 /*
2236 
2237 =item C<char PDB_check_condition(PARROT_INTERP, const PDB_condition_t
2238 *condition)>
2239 
2240 Returns true if the condition was met.
2241 
2242 =cut
2243 
2244 */
2245 
2246 PARROT_WARN_UNUSED_RESULT
2247 char
PDB_check_condition(PARROT_INTERP,ARGIN (const PDB_condition_t * condition))2248 PDB_check_condition(PARROT_INTERP, ARGIN(const PDB_condition_t *condition))
2249 {
2250     ASSERT_ARGS(PDB_check_condition)
2251     PMC * const ctx = CURRENT_CONTEXT(interp);
2252 
2253     TRACEDEB_MSG("PDB_check_condition");
2254 
2255     PARROT_ASSERT(ctx);
2256 
2257     if (condition->type & PDB_cond_int) {
2258         INTVAL   i,  j;
2259         if (condition->reg >= PCC_GET_REGS_USED(ctx, REGNO_INT))
2260             return 0;
2261         i = CTX_REG_INT(interp, ctx, condition->reg);
2262 
2263         if (condition->type & PDB_cond_const)
2264             j = *(INTVAL *)condition->value;
2265         else
2266             j = REG_INT(interp, *(int *)condition->value);
2267 
2268         if (((condition->type & PDB_cond_gt) && (i >  j)) ||
2269             ((condition->type & PDB_cond_ge) && (i >= j)) ||
2270             ((condition->type & PDB_cond_eq) && (i == j)) ||
2271             ((condition->type & PDB_cond_ne) && (i != j)) ||
2272             ((condition->type & PDB_cond_le) && (i <= j)) ||
2273             ((condition->type & PDB_cond_lt) && (i <  j)))
2274                 return 1;
2275 
2276         return 0;
2277     }
2278     else if (condition->type & PDB_cond_num) {
2279         FLOATVAL k,  l;
2280 
2281         if (condition->reg >= PCC_GET_REGS_USED(ctx, REGNO_NUM))
2282             return 0;
2283         k = CTX_REG_NUM(interp, ctx, condition->reg);
2284 
2285         if (condition->type & PDB_cond_const)
2286             l = *(FLOATVAL *)condition->value;
2287         else
2288             l = REG_NUM(interp, *(int *)condition->value);
2289 
2290         if (((condition->type & PDB_cond_gt) && (k >  l)) ||
2291             ((condition->type & PDB_cond_ge) && (k >= l)) ||
2292             ((condition->type & PDB_cond_eq) && (k == l)) ||
2293             ((condition->type & PDB_cond_ne) && (k != l)) ||
2294             ((condition->type & PDB_cond_le) && (k <= l)) ||
2295             ((condition->type & PDB_cond_lt) && (k <  l)))
2296                 return 1;
2297 
2298         return 0;
2299     }
2300     else if (condition->type & PDB_cond_str) {
2301         STRING  *m, *n;
2302 
2303         if (condition->reg >= PCC_GET_REGS_USED(ctx, REGNO_STR))
2304             return 0;
2305         m = CTX_REG_STR(interp, ctx, condition->reg);
2306 
2307         if (condition->type & PDB_cond_notnull)
2308             return ! STRING_IS_NULL(m);
2309 
2310         if (condition->type & PDB_cond_const)
2311             n = (STRING *)condition->value;
2312         else
2313             n = REG_STR(interp, *(int *)condition->value);
2314 
2315         if (((condition->type & PDB_cond_gt) &&
2316                 (STRING_compare(interp, m, n) >  0)) ||
2317             ((condition->type & PDB_cond_ge) &&
2318                 (STRING_compare(interp, m, n) >= 0)) ||
2319             ((condition->type & PDB_cond_eq) &&
2320                 (STRING_compare(interp, m, n) == 0)) ||
2321             ((condition->type & PDB_cond_ne) &&
2322                 (STRING_compare(interp, m, n) != 0)) ||
2323             ((condition->type & PDB_cond_le) &&
2324                 (STRING_compare(interp, m, n) <= 0)) ||
2325             ((condition->type & PDB_cond_lt) &&
2326                 (STRING_compare(interp, m, n) <  0)))
2327                     return 1;
2328 
2329         return 0;
2330     }
2331     else if (condition->type & PDB_cond_pmc) {
2332         PMC *m;
2333 
2334         if (condition->reg >= PCC_GET_REGS_USED(ctx, REGNO_PMC))
2335             return 0;
2336         m = CTX_REG_PMC(interp, ctx, condition->reg);
2337 
2338         if (condition->type & PDB_cond_notnull)
2339             return ! PMC_IS_NULL(m);
2340         return 0;
2341     }
2342     else
2343         return 0;
2344 }
2345 
2346 /*
2347 
2348 =item C<static PDB_breakpoint_t * current_breakpoint(const PDB_t *pdb)>
2349 
2350 Returns a pointer to the breakpoint at the current position,
2351 or NULL if there is none.
2352 
2353 =cut
2354 
2355 */
2356 
2357 PARROT_WARN_UNUSED_RESULT
2358 PARROT_CAN_RETURN_NULL
2359 static PDB_breakpoint_t *
current_breakpoint(ARGIN (const PDB_t * pdb))2360 current_breakpoint(ARGIN(const PDB_t *pdb))
2361 {
2362     ASSERT_ARGS(current_breakpoint)
2363     PDB_breakpoint_t *breakpoint = pdb->breakpoint;
2364     while (breakpoint) {
2365         if (pdb->cur_opcode == breakpoint->pc)
2366             break;
2367         breakpoint = breakpoint->next;
2368     }
2369     return breakpoint;
2370 }
2371 
2372 /*
2373 
2374 =item C<char PDB_break(PARROT_INTERP)>
2375 
2376 Returns true if we have to stop running.
2377 
2378 =cut
2379 
2380 */
2381 
2382 PARROT_WARN_UNUSED_RESULT
2383 char
PDB_break(PARROT_INTERP)2384 PDB_break(PARROT_INTERP)
2385 {
2386     ASSERT_ARGS(PDB_break)
2387     PDB_t            * const pdb = interp->pdb;
2388     PDB_condition_t  *watchpoint = pdb->watchpoint;
2389     PDB_breakpoint_t *breakpoint;
2390 
2391 /*
2392     TRACEDEB_MSG("PDB_break");
2393 */
2394 
2395     /* Check the watchpoints first. */
2396     while (watchpoint) {
2397         if (PDB_check_condition(interp, watchpoint)) {
2398             pdb->state |= PDB_STOPPED;
2399             return 1;
2400         }
2401 
2402         watchpoint = watchpoint->next;
2403     }
2404 
2405     /* If program ended */
2406     if (!pdb->cur_opcode)
2407         return PDB_program_end(interp);
2408 
2409     /* If the program is STOPPED allow it to continue */
2410     if (pdb->state & PDB_STOPPED) {
2411         pdb->state &= ~PDB_STOPPED;
2412         return 0;
2413     }
2414 
2415     breakpoint = current_breakpoint(pdb);
2416     if (breakpoint) {
2417         /* If we have to skip breakpoints, do so. */
2418         if (pdb->breakpoint_skip) {
2419             TRACEDEB_MSG("PDB_break skipping");
2420             --pdb->breakpoint_skip;
2421             return 0;
2422         }
2423 
2424         if (breakpoint->skip < 0)
2425             return 0;
2426 
2427         /* Check if there is a condition for this breakpoint */
2428         if ((breakpoint->condition) &&
2429             (!PDB_check_condition(interp, breakpoint->condition)))
2430                 return 0;
2431 
2432         TRACEDEB_MSG("PDB_break stopping");
2433 
2434         /* Add the STOPPED state and stop */
2435         pdb->state |= PDB_STOPPED;
2436         Parrot_io_eprintf(pdb->debugger, "Stop at ");
2437         display_breakpoint(pdb, breakpoint);
2438         return 1;
2439     }
2440 
2441     return 0;
2442 }
2443 
2444 /*
2445 
2446 =item C<char * PDB_escape(PARROT_INTERP, const char *string, UINTVAL length)>
2447 
2448 Escapes C<">, C<\r>, C<\n>, C<\t>, C<\a> and C<\\>.
2449 
2450 The returned string must be freed.
2451 
2452 =cut
2453 
2454 */
2455 
2456 PARROT_WARN_UNUSED_RESULT
2457 PARROT_CAN_RETURN_NULL
2458 PARROT_MALLOC
2459 char *
PDB_escape(PARROT_INTERP,ARGIN (const char * string),UINTVAL length)2460 PDB_escape(PARROT_INTERP, ARGIN(const char *string), UINTVAL length)
2461 {
2462     ASSERT_ARGS(PDB_escape)
2463     const char *end;
2464     char       *_new, *fill;
2465 
2466     length = length > 20 ? 20 : length;
2467     end    = string + length;
2468 
2469     /* Return if there is no string to escape*/
2470     if (!string)
2471         return NULL;
2472 
2473     fill = _new = mem_gc_allocate_n_typed(interp, length * 2 + 1, char);
2474 
2475     for (; string < end; ++string) {
2476         switch (*string) {
2477           case '\0':
2478             *(fill++) = '\\';
2479             *(fill++) = '0';
2480             break;
2481           case '\n':
2482             *(fill++) = '\\';
2483             *(fill++) = 'n';
2484             break;
2485           case '\r':
2486             *(fill++) = '\\';
2487             *(fill++) = 'r';
2488             break;
2489           case '\t':
2490             *(fill++) = '\\';
2491             *(fill++) = 't';
2492             break;
2493           case '\a':
2494             *(fill++) = '\\';
2495             *(fill++) = 'a';
2496             break;
2497           case '\\':
2498             *(fill++) = '\\';
2499             *(fill++) = '\\';
2500             break;
2501           case '"':
2502             *(fill++) = '\\';
2503             *(fill++) = '"';
2504             break;
2505           default:
2506             /* Hide non-ascii chars that may come from utf8 or latin-1
2507              * strings in constant strings.
2508              * Workaround for GH #326
2509              */
2510             if ((unsigned char)*string > 127)
2511                 *(fill++) = '?';
2512             else
2513                 *(fill++) = *string;
2514             break;
2515         }
2516     }
2517 
2518     *fill = '\0';
2519 
2520     return _new;
2521 }
2522 
2523 /*
2524 
2525 =item C<int PDB_unescape(char *string)>
2526 
2527 Do inplace unescape of C<\r>, C<\n>, C<\t>, C<\a> and C<\\>.
2528 
2529 =cut
2530 
2531 */
2532 
2533 int
PDB_unescape(ARGMOD (char * string))2534 PDB_unescape(ARGMOD(char *string))
2535 {
2536     ASSERT_ARGS(PDB_unescape)
2537     int l = 0;
2538 
2539     for (; *string; ++string) {
2540         ++l;
2541 
2542         if (*string == '\\') {
2543             char *fill;
2544             int i;
2545 
2546             switch (string[1]) {
2547               case 'n':
2548                 *string = '\n';
2549                 break;
2550               case 'r':
2551                 *string = '\r';
2552                 break;
2553               case 't':
2554                 *string = '\t';
2555                 break;
2556               case 'a':
2557                 *string = '\a';
2558                 break;
2559               case '\\':
2560                 *string = '\\';
2561                 break;
2562               default:
2563                 continue;
2564             }
2565 
2566             fill = string;
2567 
2568             for (i = 1; fill[i + 1]; ++i)
2569                 fill[i] = fill[i + 1];
2570 
2571             fill[i] = '\0';
2572         }
2573     }
2574 
2575     return l;
2576 }
2577 
2578 /*
2579 
2580 =item C<size_t PDB_disassemble_op(PARROT_INTERP, char *dest, size_t space, const
2581 op_info_t *info, const opcode_t *op, PDB_file_t *file, const opcode_t
2582 *code_start, int full_name)>
2583 
2584 Disassembles C<op>.
2585 
2586 =cut
2587 
2588 */
2589 
2590 size_t
PDB_disassemble_op(PARROT_INTERP,ARGOUT (char * dest),size_t space,ARGIN (const op_info_t * info),ARGIN (const opcode_t * op),ARGMOD_NULLOK (PDB_file_t * file),ARGIN_NULLOK (const opcode_t * code_start),int full_name)2591 PDB_disassemble_op(PARROT_INTERP, ARGOUT(char *dest), size_t space,
2592         ARGIN(const op_info_t *info), ARGIN(const opcode_t *op),
2593         ARGMOD_NULLOK(PDB_file_t *file), ARGIN_NULLOK(const opcode_t *code_start),
2594         int full_name)
2595 {
2596     ASSERT_ARGS(PDB_disassemble_op)
2597     int         j;
2598     size_t     size = 0;
2599     int        specialop = 0;
2600     op_lib_t  *core_ops = PARROT_GET_CORE_OPLIB(interp);
2601     /* Write the opcode name */
2602     const char * p = full_name ? info->full_name : info->name;
2603 #if !defined(PARROT_ASSERTS_ON)
2604     UNUSED(space)
2605 #endif
2606 
2607     TRACEDEB_MSG("PDB_disassemble_op");
2608 
2609     if (! p)
2610         p= "**UNKNOWN**";
2611     strcpy(dest, p);
2612     size += strlen(p);
2613 
2614     dest[size++] = ' ';
2615 
2616     /* Concat the arguments */
2617     for (j = 1; j < info->op_count; ++j) {
2618         char      buf[256];
2619         INTVAL    i = 0;
2620 
2621         PARROT_ASSERT(size + 2 < space);
2622 
2623         switch (info->types[j - 1]) {
2624           case PARROT_ARG_I:
2625             dest[size++] = 'I';
2626             goto INTEGER;
2627           case PARROT_ARG_N:
2628             dest[size++] = 'N';
2629             goto INTEGER;
2630           case PARROT_ARG_S:
2631             dest[size++] = 'S';
2632             goto INTEGER;
2633           case PARROT_ARG_P:
2634             dest[size++] = 'P';
2635             goto INTEGER;
2636           case PARROT_ARG_IC:
2637             /* If the opcode jumps and this is the last argument,
2638                that means this is a label */
2639             if ((j == info->op_count - 1) &&
2640                 (info->jump & PARROT_JUMP_RELATIVE)) {
2641                 if (file) {
2642                     dest[size++] = 'L';
2643                     i            = PDB_add_label(interp, file, op, op[j]);
2644                 }
2645                 else if (code_start) {
2646                     dest[size++] = 'O';
2647                     dest[size++] = 'P';
2648                     i            = op[j] + (op - code_start);
2649                 }
2650                 else {
2651                     if (op[j] > 0)
2652                         dest[size++] = '+';
2653                     i = op[j];
2654                 }
2655             }
2656 
2657             /* Convert the integer to a string */
2658             INTEGER:
2659             if (i == 0)
2660                 i = (INTVAL) op[j];
2661 
2662             PARROT_ASSERT(size + 20 < space);
2663 
2664             size += sprintf(&dest[size], INTVAL_FMT, i);
2665 
2666             break;
2667           case PARROT_ARG_NC:
2668             {
2669                 /* Convert the float to a string */
2670                 const FLOATVAL f = interp->code->const_table->num.constants[op[j]];
2671                 Parrot_snprintf(interp, buf, sizeof (buf), FLOATVAL_FMT, f);
2672                 strcpy(&dest[size], buf);
2673                 size += strlen(buf);
2674             }
2675             break;
2676           case PARROT_ARG_SC:
2677             {
2678                 const STRING *s = interp->code->const_table->str.constants[op[j]];
2679 
2680                 if (s->encoding != Parrot_ascii_encoding_ptr) {
2681                     strcpy(&dest[size], s->encoding->name);
2682                     size += strlen(s->encoding->name);
2683                     dest[size++] = ':';
2684                 }
2685 
2686                 dest[size++] = '"';
2687                 if (s->strlen) {
2688                     char * const unescaped =
2689                         Parrot_str_to_cstring(interp, s);
2690                     char * const escaped =
2691                         PDB_escape(interp, unescaped, s->bufused);
2692                     if (escaped) {
2693                         strcpy(&dest[size], escaped);
2694                         size += strlen(escaped);
2695                         mem_gc_free(interp, escaped);
2696                     }
2697                     Parrot_str_free_cstring(unescaped);
2698                 }
2699                 dest[size++] = '"';
2700             }
2701             break;
2702           case PARROT_ARG_PC:
2703             Parrot_snprintf(interp, buf, sizeof (buf), "PMC_CONST(%ld)", op[j]);
2704             strcpy(&dest[size], buf);
2705             size += strlen(buf);
2706             break;
2707           case PARROT_ARG_K:
2708             dest[size - 1] = '[';
2709             Parrot_snprintf(interp, buf, sizeof (buf), "P" INTVAL_FMT, op[j]);
2710             strcpy(&dest[size], buf);
2711             size += strlen(buf);
2712             dest[size++] = ']';
2713             break;
2714           case PARROT_ARG_KC:
2715             {
2716                 PMC * k = interp->code->const_table->pmc.constants[op[j]];
2717                 dest[size - 1] = '[';
2718                 while (k) {
2719                     switch (PObj_get_FLAGS(k)) {
2720                       case 0:
2721                         break;
2722                       case KEY_integer_FLAG:
2723                         Parrot_snprintf(interp, buf, sizeof (buf),
2724                                     INTVAL_FMT, VTABLE_get_integer(interp, k));
2725                         strcpy(&dest[size], buf);
2726                         size += strlen(buf);
2727                         break;
2728                       case KEY_string_FLAG:
2729                         dest[size++] = '"';
2730                         {
2731                             char * const temp = Parrot_str_to_cstring(interp,
2732                                     VTABLE_get_string(interp, k));
2733                             strcpy(&dest[size], temp);
2734                             Parrot_str_free_cstring(temp);
2735                         }
2736                         size += Parrot_str_byte_length(interp,
2737                                 VTABLE_get_string(interp, (k)));
2738                         dest[size++] = '"';
2739                         break;
2740                       case KEY_integer_FLAG|KEY_register_FLAG:
2741                         Parrot_snprintf(interp, buf, sizeof (buf),
2742                                     "I" INTVAL_FMT, VTABLE_get_integer(interp, k));
2743                         strcpy(&dest[size], buf);
2744                         size += strlen(buf);
2745                         break;
2746                       case KEY_string_FLAG|KEY_register_FLAG:
2747                         Parrot_snprintf(interp, buf, sizeof (buf),
2748                                     "S" INTVAL_FMT, VTABLE_get_integer(interp, k));
2749                         strcpy(&dest[size], buf);
2750                         size += strlen(buf);
2751                         break;
2752                       case KEY_pmc_FLAG|KEY_register_FLAG:
2753                         Parrot_snprintf(interp, buf, sizeof (buf),
2754                                     "P" INTVAL_FMT, VTABLE_get_integer(interp, k));
2755                         strcpy(&dest[size], buf);
2756                         size += strlen(buf);
2757                         break;
2758                       default:
2759                         dest[size++] = '?';
2760                         break;
2761                     }
2762                     GETATTR_Key_next_key(interp, k, k);
2763                     if (k)
2764                         dest[size++] = ';';
2765                 }
2766                 dest[size++] = ']';
2767             }
2768             break;
2769           case PARROT_ARG_KI:
2770             dest[size - 1] = '[';
2771             Parrot_snprintf(interp, buf, sizeof (buf), "I" INTVAL_FMT, op[j]);
2772             strcpy(&dest[size], buf);
2773             size += strlen(buf);
2774             dest[size++] = ']';
2775             break;
2776           case PARROT_ARG_KIC:
2777             dest[size - 1] = '[';
2778             Parrot_snprintf(interp, buf, sizeof (buf), INTVAL_FMT, op[j]);
2779             strcpy(&dest[size], buf);
2780             size += strlen(buf);
2781             dest[size++] = ']';
2782             break;
2783           default:
2784             Parrot_ex_throw_from_c_args(interp, NULL, EXCEPTION_ARG_OP_NOT_HANDLED,
2785                                         "Unknown opcode type %c", info->types[j - 1]);
2786         }
2787 
2788         if (j != info->op_count - 1)
2789             dest[size++] = ',';
2790     }
2791 
2792     /* Special decoding for the signature used in args/returns.  Such ops have
2793        one fixed parameter (the signature vector), plus a varying number of
2794        registers/constants.  For each arg/return, we show the register and its
2795        flags using PIR syntax. */
2796     if (OPCODE_IS(interp, interp->code, *(op), core_ops, PARROT_OP_set_args_pc)
2797     ||  OPCODE_IS(interp, interp->code, *(op), core_ops, PARROT_OP_set_returns_pc))
2798         specialop = 1;
2799 
2800     /* if it's a retrieving op, specialop = 2, so that later a :flat flag
2801      * can be changed into a :slurpy flag. See flag handling below.
2802      */
2803     if (OPCODE_IS(interp, interp->code, *(op), core_ops, PARROT_OP_get_results_pc)
2804     ||  OPCODE_IS(interp, interp->code, *(op), core_ops, PARROT_OP_get_params_pc))
2805         specialop = 2;
2806 
2807     if (specialop > 0) {
2808         char buf[1000];
2809         PMC * const sig = interp->code->const_table->pmc.constants[op[1]];
2810         const int n_values = VTABLE_elements(interp, sig);
2811         /* The flag_names strings come from Call_bits_enum_t (with which it
2812            should probably be colocated); they name the bits from LSB to MSB.
2813            The two least significant bits are not flags; they are the register
2814            type, which is decoded elsewhere.  We also want to show unused bits,
2815            which could indicate problems.
2816         */
2817         PARROT_OBSERVER const char * const flag_names[] = {
2818                                      "",
2819                                      "",
2820                                      " :unused004",
2821                                      " :unused008",
2822                                      " :const",
2823                                      " :flat", /* should be :slurpy for args */
2824                                      " :unused040",
2825                                      " :optional",
2826                                      " :opt_flag",
2827                                      " :named"
2828         };
2829 
2830 
2831         /* Register decoding.  It would be good to abstract this, too. */
2832         PARROT_OBSERVER static const char regs[] = "ISPN";
2833 
2834         for (j = 0; j < n_values; ++j) {
2835             size_t idx = 0;
2836             const int sig_value = VTABLE_get_integer_keyed_int(interp, sig, j);
2837 
2838             /* Print the register name, e.g. P37. */
2839             buf[idx++] = ',';
2840             buf[idx++] = ' ';
2841             buf[idx++] = regs[sig_value & PARROT_ARG_TYPE_MASK];
2842             Parrot_snprintf(interp, &buf[idx], sizeof (buf)-idx,
2843                             INTVAL_FMT, op[j+2]);
2844             idx = strlen(buf);
2845 
2846             /* Add flags, if we have any. */
2847             {
2848                 unsigned int flag_idx = 0;
2849                 int flags = sig_value;
2850 
2851                 /* End when we run out of flags, off the end of flag_names, or
2852                  * get too close to the end of buf.
2853                  * 100 is just an estimate of all buf lengths added together.
2854                  */
2855                 while (flags && idx < sizeof (buf) - 100) {
2856                     const char * const flag_string =
2857                             flag_idx < (sizeof flag_names / sizeof (char *))
2858                                 ? (specialop == 2  && STREQ(flag_names[flag_idx], " :flat"))
2859                                     ? " :slurpy"
2860                                     : flag_names[flag_idx]
2861                                 : (const char *) NULL;
2862 
2863                     if (! flag_string)
2864                         break;
2865                     if (flags & 1 && *flag_string) {
2866                         const size_t n = strlen(flag_string);
2867                         strcpy(&buf[idx], flag_string);
2868                         idx += n;
2869                     }
2870                     flags >>= 1;
2871                     flag_idx++;
2872                 }
2873             }
2874 
2875             /* Add it to dest. */
2876             buf[idx++] = '\0';
2877             strcpy(&dest[size], buf);
2878             size += strlen(buf);
2879         }
2880     }
2881 
2882     dest[size] = '\0';
2883     return ++size;
2884 }
2885 
2886 /*
2887 
2888 =item C<void PDB_disassemble(PARROT_INTERP, const char *command)>
2889 
2890 Disassemble the bytecode.
2891 
2892 =cut
2893 
2894 */
2895 
2896 void
PDB_disassemble(PARROT_INTERP,ARGIN_NULLOK (SHIM (const char * command)))2897 PDB_disassemble(PARROT_INTERP, ARGIN_NULLOK(SHIM(const char *command)))
2898 {
2899     ASSERT_ARGS(PDB_disassemble)
2900     PDB_t    * const pdb = interp->pdb;
2901     opcode_t * pc        = interp->code->base.data;
2902 
2903     PDB_file_t  *pfile;
2904     PDB_line_t  *pline;
2905     PDB_label_t *label;
2906     opcode_t    *code_end;
2907 
2908     const unsigned int default_size = 32768;
2909     size_t space;  /* How much space do we have? */
2910     size_t alloced, n;
2911 
2912     TRACEDEB_MSG("PDB_disassemble");
2913 
2914     pfile = mem_gc_allocate_zeroed_typed(interp, PDB_file_t);
2915     pline = mem_gc_allocate_zeroed_typed(interp, PDB_line_t);
2916 
2917     /* If we already got a source, free it */
2918     if (pdb->file) {
2919         PDB_free_file(interp, pdb->file);
2920         pdb->file = NULL;
2921     }
2922 
2923     pfile->line   = pline;
2924     pline->number = 1;
2925     pfile->source = mem_gc_allocate_n_typed(interp, default_size, char);
2926 
2927     alloced       = space = default_size;
2928     code_end      = pc + interp->code->base.size;
2929 
2930     while (pc != code_end) {
2931         size_t size;
2932 
2933         /* Grow it early */
2934         if (space < default_size) {
2935             alloced += default_size;
2936             space   += default_size;
2937             pfile->source = mem_gc_realloc_n_typed(interp, pfile->source, alloced, char);
2938         }
2939 
2940         size = PDB_disassemble_op(interp, pfile->source + pfile->size,
2941                 space, interp->code->op_info_table[*pc], pc, pfile, NULL, 1);
2942         space       -= size;
2943         pfile->size += size;
2944         pfile->source[pfile->size - 1] = '\n';
2945 
2946         /* Store the opcode of this line */
2947         pline->opcode = pc;
2948         n             = interp->code->op_info_table[*pc]->op_count;
2949 
2950         ADD_OP_VAR_PART(interp, interp->code, pc, n);
2951         pc += n;
2952 
2953         /* Prepare for next line unless there will be no next line. */
2954 
2955         if (pc < code_end) {
2956             PDB_line_t * const newline = mem_gc_allocate_zeroed_typed(interp, PDB_line_t);
2957 
2958             newline->label       = NULL;
2959             newline->next        = NULL;
2960             newline->number      = pline->number + 1;
2961             pline->next          = newline;
2962             pline                = newline;
2963             pline->source_offset = pfile->size;
2964         }
2965     }
2966 
2967     /* Add labels to the lines they belong to */
2968     label = pfile->label;
2969 
2970     while (label) {
2971         /* Get the line to apply the label */
2972         pline = pfile->line;
2973 
2974         while (pline && pline->opcode != label->opcode)
2975             pline = pline->next;
2976 
2977         if (!pline) {
2978             Parrot_io_eprintf(pdb->debugger,
2979                         "Label number %li out of bounds.\n", label->number);
2980 
2981             PDB_free_file(interp, pfile);
2982             return;
2983         }
2984 
2985         pline->label = label;
2986 
2987         label        = label->next;
2988     }
2989 
2990     pdb->state |= PDB_SRC_LOADED;
2991     pdb->file   = pfile;
2992 }
2993 
2994 /*
2995 
2996 =item C<long PDB_add_label(PARROT_INTERP, PDB_file_t *file, const opcode_t
2997 *cur_opcode, opcode_t offset)>
2998 
2999 Add a label to the label list.
3000 
3001 =cut
3002 
3003 */
3004 
3005 long
PDB_add_label(PARROT_INTERP,ARGMOD (PDB_file_t * file),ARGIN (const opcode_t * cur_opcode),opcode_t offset)3006 PDB_add_label(PARROT_INTERP, ARGMOD(PDB_file_t *file),
3007         ARGIN(const opcode_t *cur_opcode),
3008         opcode_t offset)
3009 {
3010     ASSERT_ARGS(PDB_add_label)
3011     PDB_label_t *_new;
3012     PDB_label_t *label = file->label;
3013 
3014     /* See if there is already a label at this line */
3015     while (label) {
3016         if (label->opcode == cur_opcode + offset)
3017             return label->number;
3018         label = label->next;
3019     }
3020 
3021     /* Allocate a new label */
3022     label        = file->label;
3023     _new         = mem_gc_allocate_zeroed_typed(interp, PDB_label_t);
3024     _new->opcode = cur_opcode + offset;
3025     _new->next   = NULL;
3026 
3027     if (label) {
3028         while (label->next)
3029             label = label->next;
3030 
3031         _new->number = label->number + 1;
3032         label->next  = _new;
3033     }
3034     else {
3035         file->label  = _new;
3036         _new->number = 1;
3037     }
3038 
3039     return _new->number;
3040 }
3041 
3042 /*
3043 
3044 =item C<void PDB_free_file(PARROT_INTERP, PDB_file_t *file)>
3045 
3046 Frees any allocated source files.
3047 
3048 =cut
3049 
3050 */
3051 
3052 void
PDB_free_file(PARROT_INTERP,ARGIN_NULLOK (PDB_file_t * file))3053 PDB_free_file(PARROT_INTERP, ARGIN_NULLOK(PDB_file_t *file))
3054 {
3055     ASSERT_ARGS(PDB_free_file)
3056     while (file) {
3057         /* Free all of the allocated line structures */
3058         PDB_line_t  *line = file->line;
3059         PDB_label_t *label;
3060         PDB_file_t  *nfile;
3061 
3062         while (line) {
3063             PDB_line_t * const nline = line->next;
3064             mem_gc_free(interp, line);
3065             line = nline;
3066         }
3067 
3068         /* Free all of the allocated label structures */
3069         label = file->label;
3070 
3071         while (label) {
3072             PDB_label_t * const nlabel = label->next;
3073 
3074             mem_gc_free(interp, label);
3075             label  = nlabel;
3076         }
3077 
3078         /* Free the remaining allocated portions of the file structure */
3079         if (file->sourcefilename)
3080             mem_gc_free(interp, file->sourcefilename);
3081 
3082         if (file->source)
3083             mem_gc_free(interp, file->source);
3084 
3085         nfile = file->next;
3086         mem_gc_free(interp, file);
3087         file  = nfile;
3088     }
3089 }
3090 
3091 /*
3092 
3093 =item C<void PDB_load_source(PARROT_INTERP, const char *command)>
3094 
3095 Load a source code file.
3096 
3097 =cut
3098 
3099 */
3100 
3101 #define DEBUG_SOURCE_BUFFER_CHUNK 1024
3102 
3103 PARROT_EXPORT
3104 void
PDB_load_source(PARROT_INTERP,ARGIN (const char * command))3105 PDB_load_source(PARROT_INTERP, ARGIN(const char *command))
3106 {
3107     ASSERT_ARGS(PDB_load_source)
3108 
3109     PDB_t * const pdb = interp->pdb;
3110     char file_spec[DEBUG_CMD_BUFFER_LENGTH+1];
3111     FILE *file_desc;
3112     PDB_file_t *dfile;
3113     PDB_line_t *dline,
3114                *prev_dline = NULL;
3115     size_t buffer_size;
3116     ptrdiff_t start_offset;
3117     int line = 0;
3118     opcode_t *PC = interp->code->base.data;
3119     int ci, i, ch;
3120 
3121     TRACEDEB_MSG("PDB_load_source");
3122 
3123     /* Free any previous source lines. */
3124 
3125     if (pdb->file) {
3126         PDB_free_file(pdb->debugee, pdb->debugee->pdb->file);
3127         pdb->debugee->pdb->file = NULL;
3128     }
3129 
3130     /* Get the source file specification. */
3131 
3132     for (ci = 0; command[ci] == ' '; ++ci) ;
3133     for (i = 0; command[ci]; ++i, ++ci)
3134         file_spec[i] = command[ci];
3135     file_spec[i] = '\0';
3136 
3137     /* Open the file for reading. */
3138 
3139     file_desc = fopen(file_spec, "r");
3140     if (!file_desc) {
3141         Parrot_io_eprintf(pdb->debugger, "Cannot open '%s' for reading\n",
3142                                          file_spec);
3143         return;
3144     }
3145 
3146     /* Allocate a file block and the source buffer. */
3147 
3148     dfile = mem_gc_allocate_zeroed_typed(interp, PDB_file_t);
3149     dfile->source = mem_gc_allocate_n_typed(interp, DEBUG_SOURCE_BUFFER_CHUNK,
3150                                                     char);
3151     buffer_size = DEBUG_SOURCE_BUFFER_CHUNK;
3152 
3153     /* Load the source lines. */
3154 
3155     do {
3156 
3157         /* Load characters until a newline or EOF is found. If the source
3158            buffer fills up, extend it. */
3159 
3160         start_offset = dfile->size;
3161         do {
3162             ch = fgetc(file_desc);
3163             if (ch == EOF)
3164                 break;
3165             dfile->source[dfile->size] = (char)ch;
3166             if (++dfile->size >= buffer_size) {
3167                 buffer_size += DEBUG_SOURCE_BUFFER_CHUNK;
3168                 dfile->source = mem_gc_realloc_n_typed(interp,
3169                                                        dfile->source,
3170                                                        buffer_size,
3171                                                        char);
3172             }
3173         } while (ch != '\n');
3174 
3175         /* We're done at EOF unless the last line didn't end with a newline. */
3176 
3177         if (ch == EOF && (dfile->size == 0 || dfile->source[dfile->size-1] == '\n'))
3178             break;
3179 
3180         if (ch == EOF) {
3181             dfile->source[dfile->size++] = '\n';
3182             Parrot_io_eprintf(pdb->debugger,
3183                               "(Newline appended to last line of file)\n");
3184         }
3185 
3186         /* Allocate a line block and store information about the line.
3187            Attempt to match the line with its opcode PC (does not work). */
3188 
3189         dline = mem_gc_allocate_zeroed_typed(interp, PDB_line_t);
3190         dline->source_offset = start_offset;
3191         dline->number        = ++line;
3192         if (PDB_hasinstruction(dfile->source + start_offset)) {
3193             if (PC < interp->code->base.data + interp->code->base.size) {
3194                 size_t n = interp->code->op_info_table[*PC]->op_count;
3195                 dline->opcode = PC;
3196                 ADD_OP_VAR_PART(interp, interp->code, PC, n);
3197                 PC += n;
3198             }
3199         }
3200 
3201         /* Chain the line onto the file block or previous line. */
3202 
3203         if (prev_dline)
3204             prev_dline->next = dline;
3205         else
3206             dfile->line = dline;
3207         prev_dline = dline;
3208 
3209     } while (ch != EOF);
3210 
3211     /* Close the source file, mark the file loaded, and line the file
3212        block onto the PDB structure. */
3213 
3214     fclose(file_desc);
3215 
3216     pdb->state |= PDB_SRC_LOADED;
3217     pdb->file   = dfile;
3218 }
3219 
3220 /*
3221 
3222 =item C<char PDB_hasinstruction(const char *c)>
3223 
3224 Return true if the line has an instruction. This test does not provide
3225 the ability to match source lines with opcode PCs.
3226 
3227 =cut
3228 
3229 */
3230 
3231 PARROT_WARN_UNUSED_RESULT
3232 PARROT_PURE_FUNCTION
3233 char
PDB_hasinstruction(ARGIN (const char * c))3234 PDB_hasinstruction(ARGIN(const char *c))
3235 {
3236     ASSERT_ARGS(PDB_hasinstruction)
3237     char h = 0;
3238 
3239     /* as long as c is not NULL, we're not looking at a comment (#...) or a '\n'... */
3240     while (*c && *c != '#' && *c != '\n') {
3241         /* ... and c is alphanumeric or a quoted string then the line contains
3242          * an instruction. */
3243         if (isalnum((unsigned char) *c) || *c == '"') {
3244             h = 1;
3245         }
3246         else if (*c == ':') {
3247             /* probably a label */
3248             h = 0;
3249         }
3250 
3251         ++c;
3252     }
3253 
3254     return h;
3255 }
3256 
3257 /*
3258 
3259 =item C<static void no_such_register(PARROT_INTERP, char register_type, UINTVAL
3260 register_num)>
3261 
3262 Auxiliar error message function.
3263 
3264 =cut
3265 
3266 */
3267 
3268 static void
no_such_register(PARROT_INTERP,char register_type,UINTVAL register_num)3269 no_such_register(PARROT_INTERP, char register_type, UINTVAL register_num)
3270 {
3271     ASSERT_ARGS(no_such_register)
3272 
3273     Parrot_io_eprintf(interp, "%c%u = no such register\n",
3274         register_type, register_num);
3275 }
3276 
3277 /*
3278 
3279 =item C<void PDB_assign(PARROT_INTERP, const char *command)>
3280 
3281 Assign to registers.
3282 
3283 =cut
3284 
3285 */
3286 
3287 void
PDB_assign(PARROT_INTERP,ARGIN (const char * command))3288 PDB_assign(PARROT_INTERP, ARGIN(const char *command))
3289 {
3290     ASSERT_ARGS(PDB_assign)
3291     UINTVAL register_num;
3292     char reg_type_id;
3293     int reg_type;
3294     PDB_t  * const pdb      = interp->pdb;
3295     Interp * const debugger = pdb ? pdb->debugger : interp;
3296     Interp * const debugee  = pdb ? pdb->debugee  : interp;
3297 
3298     /* smallest valid commad length is 4, i.e. "I0 1" */
3299     if (strlen(command) < 4) {
3300         Parrot_io_eprintf(debugger, "Must give a register number and value to assign\n");
3301         return;
3302     }
3303     reg_type_id = (unsigned char) toupper((unsigned char) command[0]);
3304     ++command;
3305     register_num = get_ulong(&command, 0);
3306 
3307     switch (reg_type_id) {
3308       case 'I':
3309         reg_type = REGNO_INT;
3310         break;
3311       case 'N':
3312         reg_type = REGNO_NUM;
3313         break;
3314       case 'S':
3315         reg_type = REGNO_STR;
3316         break;
3317       case 'P':
3318         reg_type = REGNO_PMC;
3319         Parrot_io_eprintf(debugger, "Assigning to PMCs is not currently supported\n");
3320         return;
3321       default:
3322         Parrot_io_eprintf(debugger, "Invalid register type %c\n", reg_type_id);
3323         return;
3324     }
3325     if (register_num >= PCC_GET_REGS_USED(CURRENT_CONTEXT(debugee), reg_type)) {
3326         no_such_register(debugger, reg_type_id, register_num);
3327         return;
3328     }
3329     switch (reg_type) {
3330       case REGNO_INT:
3331         IREG(register_num) = get_ulong(&command, 0);
3332         break;
3333       case REGNO_NUM:
3334         NREG(register_num) = atof(command);
3335         break;
3336       case REGNO_STR:
3337         SREG(register_num) = Parrot_str_new(debugee, command, strlen(command));
3338         break;
3339       default:
3340         ; /* Must never come here */
3341     }
3342     Parrot_io_eprintf(debugger, "\n  %c%u = ", reg_type_id, register_num);
3343     Parrot_io_eprintf(debugger, "%Ss\n", GDB_print_reg(debugee, reg_type, register_num));
3344 }
3345 
3346 /*
3347 
3348 =item C<void PDB_list(PARROT_INTERP, const char *command)>
3349 
3350 Display lines from the source code file.
3351 
3352 =cut
3353 
3354 */
3355 
3356 void
PDB_list(PARROT_INTERP,ARGIN (const char * command))3357 PDB_list(PARROT_INTERP, ARGIN(const char *command))
3358 {
3359     ASSERT_ARGS(PDB_list)
3360     PDB_t         *pdb = interp->pdb;
3361     unsigned long start_line;
3362     unsigned long line_count;
3363     PDB_line_t    *line;
3364     unsigned long i;
3365     char          *ch;
3366 
3367     TRACEDEB_MSG("PDB_list");
3368 
3369     /* Make sure the source file has been loaded. Get the starting
3370        line and the number of lines from the command. Quit if zero
3371        lines requested. */
3372 
3373     if (!pdb->file || !pdb->file->line) {
3374         Parrot_io_eprintf(pdb->debugger, "No source file loaded\n");
3375         return;
3376     }
3377 
3378     start_line = get_ulong(&command, 1);
3379     pdb->file->list_line = start_line;
3380 
3381     line_count = get_ulong(&command, 20);
3382 
3383     if (line_count == 0) {
3384         Parrot_io_eprintf(pdb->debugger, "Zero lines were requested");
3385         return;
3386     }
3387 
3388     /* Run down the line list to the starting line. Quit if the
3389        starting line number is too high. */
3390 
3391     for (i = 1, line = pdb->file->line;
3392          i < pdb->file->list_line && line->next;
3393          ++i)
3394         line = line->next;
3395 
3396     if (i < start_line) {
3397         Parrot_io_eprintf(pdb->debugger, "Starting line %d not in file\n",
3398                                          start_line);
3399         return;
3400     }
3401 
3402     /* Run down the lines to be displayed. Include the PC, line number,
3403        and line text. Quit if we run out of lines. */
3404 
3405     for (i = 0; i < line_count; ++i) {
3406         if (line->opcode)
3407             Parrot_io_eprintf(pdb->debugger, "%04d  ",
3408                               line->opcode - pdb->debugee->code->base.data);
3409         else
3410             Parrot_io_eprintf(pdb->debugger, "      ");
3411 
3412         Parrot_io_eprintf(pdb->debugger, "%4li  ", line->number);
3413 
3414         for (ch = pdb->file->source + line->source_offset; *ch != '\n'; ++ch)
3415             Parrot_io_eprintf(pdb->debugger, "%c", *ch);
3416 
3417         Parrot_io_eprintf(pdb->debugger, "\n");
3418 
3419         line = line->next;
3420         if (!line) break;
3421     }
3422 
3423     /* Let the user know if there are any more lines. */
3424 
3425     Parrot_io_eprintf(pdb->debugger, (line) ? "[more]\n" : "[end]\n");
3426 }
3427 
3428 /*
3429 
3430 =item C<void PDB_eval(PARROT_INTERP, const char *command)>
3431 
3432 C<eval>s an instruction.
3433 
3434 =cut
3435 
3436 */
3437 
3438 void
PDB_eval(PARROT_INTERP,SHIM (const char * command))3439 PDB_eval(PARROT_INTERP, SHIM(const char *command))
3440 {
3441     ASSERT_ARGS(PDB_eval)
3442 
3443     Interp *warninterp = (interp->pdb && interp->pdb->debugger) ?
3444         interp->pdb->debugger : interp;
3445     TRACEDEB_MSG("PDB_eval");
3446 
3447     Parrot_io_eprintf(warninterp, "The eval command is currently unimplemeneted\n");
3448 }
3449 
3450 /*
3451 
3452 =item C<void PDB_print(PARROT_INTERP, const char *command)>
3453 
3454 Print interp registers.
3455 
3456 =cut
3457 
3458 */
3459 
3460 PARROT_EXPORT
3461 void
PDB_print(PARROT_INTERP,ARGIN (const char * command))3462 PDB_print(PARROT_INTERP, ARGIN(const char *command))
3463 {
3464     ASSERT_ARGS(PDB_print)
3465     const STRING *s = GDB_P(interp->pdb->debugee, command);
3466 
3467     TRACEDEB_MSG("PDB_print");
3468     Parrot_io_eprintf(interp, "%Ss\n", s);
3469 }
3470 
3471 
3472 /*
3473 
3474 =item C<void PDB_info(PARROT_INTERP)>
3475 
3476 Print the interpreter info.
3477 
3478 =cut
3479 
3480 */
3481 
3482 void
PDB_info(PARROT_INTERP)3483 PDB_info(PARROT_INTERP)
3484 {
3485     ASSERT_ARGS(PDB_info)
3486 
3487     /* If a debugger is created, use it for printing and use the
3488      * data in his debugee. Otherwise, use current interpreter
3489      * for both */
3490     Parrot_Interp itdeb = interp->pdb ? interp->pdb->debugger : interp;
3491     Parrot_Interp itp = interp->pdb ? interp->pdb->debugee : interp;
3492 
3493     Parrot_io_eprintf(itdeb, "Total memory allocated: %ld\n",
3494             Parrot_interp_info(itp, TOTAL_MEM_ALLOC));
3495     Parrot_io_eprintf(itdeb, "GC mark runs: %ld\n",
3496             Parrot_interp_info(itp, GC_MARK_RUNS));
3497     Parrot_io_eprintf(itdeb, "Lazy gc mark runs: %ld\n",
3498             Parrot_interp_info(itp, GC_LAZY_MARK_RUNS));
3499     Parrot_io_eprintf(itdeb, "GC collect runs: %ld\n",
3500             Parrot_interp_info(itp, GC_COLLECT_RUNS));
3501     Parrot_io_eprintf(itdeb, "Collect memory: %ld\n",
3502             Parrot_interp_info(itp, TOTAL_COPIED));
3503     Parrot_io_eprintf(itdeb, "Active PMCs: %ld\n",
3504             Parrot_interp_info(itp, ACTIVE_PMCS));
3505     Parrot_io_eprintf(itdeb, "Timely GC PMCs: %ld\n",
3506             Parrot_interp_info(itp, IMPATIENT_PMCS));
3507     Parrot_io_eprintf(itdeb, "Total PMCs: %ld\n",
3508             Parrot_interp_info(itp, TOTAL_PMCS));
3509     Parrot_io_eprintf(itdeb, "Active buffers: %ld\n",
3510             Parrot_interp_info(itp, ACTIVE_BUFFERS));
3511     Parrot_io_eprintf(itdeb, "Total buffers: %ld\n",
3512             Parrot_interp_info(itp, TOTAL_BUFFERS));
3513     Parrot_io_eprintf(itdeb, "Header allocations since last collect: %ld\n",
3514             Parrot_interp_info(itp, HEADER_ALLOCS_SINCE_COLLECT));
3515     Parrot_io_eprintf(itdeb, "Memory allocations since last collect: %ld\n",
3516             Parrot_interp_info(itp, MEM_ALLOCS_SINCE_COLLECT));
3517 }
3518 
3519 /*
3520 
3521 =item C<void PDB_help(PARROT_INTERP, const char *command)>
3522 
3523 Print the help text. "Help" with no arguments prints a list of commands.
3524 "Help xxx" prints information on command xxx.
3525 
3526 =cut
3527 
3528 */
3529 
3530 void
PDB_help(PARROT_INTERP,ARGIN (const char * command))3531 PDB_help(PARROT_INTERP, ARGIN(const char *command))
3532 {
3533     ASSERT_ARGS(PDB_help)
3534     const DebuggerCmd *cmd;
3535 
3536     const char * cmdline = command;
3537     cmd = get_cmd(& cmdline);
3538 
3539     if (cmd) {
3540         Parrot_io_eprintf(interp->pdb->debugger, "%s\n", cmd->help);
3541     }
3542     else {
3543         if (*cmdline == '\0') {
3544             unsigned int i;
3545             Parrot_io_eprintf(interp->pdb->debugger, "List of commands:\n");
3546             for (i= 0; i < sizeof (DebCmdList) / sizeof (DebuggerCmdList); ++i) {
3547                 const DebuggerCmdList *cmdlist = DebCmdList + i;
3548                 Parrot_io_eprintf(interp->pdb->debugger,
3549                     "   %-12s  %s\n", cmdlist->name, cmdlist->cmd->shorthelp);
3550             }
3551             Parrot_io_eprintf(interp->pdb->debugger, "\n"
3552 "Type \"help\" followed by a command name for full documentation.\n\n");
3553 
3554         }
3555         else {
3556             Parrot_io_eprintf(interp->pdb->debugger, "Unknown command: %s\n", command);
3557         }
3558     }
3559 }
3560 
3561 /*
3562 
3563 =item C<STRING * Parrot_dbg_get_exception_backtrace(PARROT_INTERP, PMC *
3564 exception)>
3565 
3566 Returns an string containing the backtrace of the interpreter's call chain for a given exception.
3567 
3568 =cut
3569 
3570 */
3571 
3572 
3573 PARROT_WARN_UNUSED_RESULT
3574 PARROT_CANNOT_RETURN_NULL
3575 STRING *
Parrot_dbg_get_exception_backtrace(PARROT_INTERP,ARGMOD (PMC * exception))3576 Parrot_dbg_get_exception_backtrace(PARROT_INTERP, ARGMOD(PMC * exception))
3577 {
3578     ASSERT_ARGS(Parrot_dbg_get_exception_backtrace)
3579 
3580     PMC * const ctx = get_exception_context(interp, exception);
3581 
3582     if (PMC_IS_NULL(ctx))
3583         return STRINGNULL;
3584     else {
3585         STRING * const bt = PDB_get_continuation_backtrace(interp, ctx);
3586         return bt;
3587     }
3588 }
3589 
3590 /*
3591 
3592 =item C<static PMC * get_exception_context(PARROT_INTERP, PMC * exception)>
3593 
3594 Returns the context in which the exception was generated.
3595 
3596 =cut
3597 
3598 */
3599 
3600 PARROT_WARN_UNUSED_RESULT
3601 PARROT_CANNOT_RETURN_NULL
3602 static PMC *
get_exception_context(PARROT_INTERP,ARGMOD (PMC * exception))3603 get_exception_context(PARROT_INTERP, ARGMOD(PMC * exception))
3604 {
3605     ASSERT_ARGS(get_exception_context)
3606     PMC * const thrower = VTABLE_get_attr_str(interp, exception, CONST_STRING(interp, "thrower"));
3607     if (!PMC_IS_NULL(thrower))
3608         return thrower;
3609     else {
3610         PMC * const resume = VTABLE_get_attr_str(interp, exception, CONST_STRING(interp, "resume"));
3611         if (PMC_IS_NULL(resume))
3612             return PMCNULL;
3613         else {
3614             const Parrot_Continuation_attributes * const cont = PARROT_CONTINUATION(resume);
3615             return cont->to_ctx;
3616         }
3617     }
3618 }
3619 
3620 /*
3621 
3622 =item C<void PDB_backtrace(PARROT_INTERP)>
3623 
3624 Prints a backtrace of the interp's call chain.
3625 
3626 =cut
3627 
3628 */
3629 
3630 PARROT_EXPORT
3631 void
PDB_backtrace(PARROT_INTERP)3632 PDB_backtrace(PARROT_INTERP)
3633 {
3634     ASSERT_ARGS(PDB_backtrace)
3635     /* information about the current sub */
3636     STRING * const bt = PDB_get_continuation_backtrace(interp, CURRENT_CONTEXT(interp));
3637     Parrot_io_eprintf(interp, "%Ss", bt);
3638 }
3639 
3640 /*
3641 
3642 =item C<static STRING * PDB_get_continuation_backtrace(PARROT_INTERP, PMC *ctx)>
3643 
3644 Returns an string with the backtrace of interpreter's call chain for the given context information.
3645 
3646 =cut
3647 
3648 */
3649 
3650 PARROT_WARN_UNUSED_RESULT
3651 PARROT_CANNOT_RETURN_NULL
3652 static STRING *
PDB_get_continuation_backtrace(PARROT_INTERP,ARGIN (PMC * ctx))3653 PDB_get_continuation_backtrace(PARROT_INTERP, ARGIN(PMC *ctx))
3654 {
3655     ASSERT_ARGS(PDB_get_continuation_backtrace)
3656     PMC * const output = Parrot_pmc_new(interp, enum_class_StringBuilder);
3657     UINTVAL rec_level  = 0;
3658     UINTVAL loop_count = 0;
3659     PMC    *prev_ctx   = PMCNULL;
3660     int     is_top     = 1;
3661 
3662     /* backtrace: follow the continuation chain */
3663     while (ctx && (loop_count < RECURSION_LIMIT)) {
3664         STRING * const info_str = Parrot_sub_Context_infostr(interp, ctx, is_top);
3665         if (!info_str)
3666             break;
3667 
3668         /* recursion detection */
3669         if (ctx == prev_ctx) {
3670             ++rec_level;
3671         }
3672         else if (!PMC_IS_NULL(prev_ctx)
3673         &&       Parrot_pcc_get_pc(interp,  ctx) == Parrot_pcc_get_pc(interp,  prev_ctx)
3674         &&       Parrot_pcc_get_sub(interp, ctx) == Parrot_pcc_get_sub(interp, prev_ctx)) {
3675             ++rec_level;
3676         }
3677         else if (rec_level != 0) {
3678             STRING * const fmt =
3679                 Parrot_sprintf_c(interp, "... call repeated "UINTVAL_FMT" times\n", rec_level);
3680             VTABLE_push_string(interp, output, fmt);
3681             rec_level = 0;
3682         }
3683 
3684         /* print the context description */
3685         if (rec_level == 0) {
3686             const PMC * const sub               = Parrot_pcc_get_sub(interp, ctx);
3687             const PackFile_ByteCode * const seg = PARROT_SUB(sub)->seg;
3688             VTABLE_push_string(interp, output, info_str);
3689             if (seg->annotations) {
3690                 PMC * const annot = Parrot_pf_annotations_lookup(interp, seg->annotations,
3691                         Parrot_pcc_get_pc(interp, ctx) - seg->base.data,
3692                         NULL);
3693 
3694                 if (!PMC_IS_NULL(annot)) {
3695                     PMC * const pfile = VTABLE_get_pmc_keyed_str(interp, annot,
3696                             Parrot_str_new_constant(interp, "file"));
3697                     PMC * const pline = VTABLE_get_pmc_keyed_str(interp, annot,
3698                             Parrot_str_new_constant(interp, "line"));
3699                     if ((!PMC_IS_NULL(pfile)) && (!PMC_IS_NULL(pline))) {
3700                         STRING * const file = VTABLE_get_string(interp, pfile);
3701                         const INTVAL line   = VTABLE_get_integer(interp, pline);
3702                         STRING * const fmt =
3703                             Parrot_sprintf_c(interp, " (%Ss:%li)", file, (long)line);
3704                         VTABLE_push_string(interp, output, fmt);
3705                     }
3706                 }
3707             }
3708             VTABLE_push_string(interp, output, CONST_STRING(interp, "\n"));
3709         }
3710         ++loop_count;
3711         is_top   = 0;
3712         prev_ctx = ctx;
3713         ctx      = Parrot_pcc_get_caller_ctx(interp, ctx);
3714     }
3715 
3716     if (rec_level != 0) {
3717         STRING * const fmt = Parrot_sprintf_c(interp,
3718                                "... call repeated "UINTVAL_FMT" times\n", rec_level);
3719         VTABLE_push_string(interp, output, fmt);
3720     }
3721     return VTABLE_get_string(interp, output);
3722 }
3723 
3724 
3725 
3726 /*
3727  * GDB functions
3728  *
3729  * GDB_P  gdb> pp $I0   print register I0 value
3730  *
3731  * RT46139 more, more
3732  */
3733 
3734 /*
3735 
3736 =item C<static STRING * GDB_print_reg(PARROT_INTERP, int t, int n)>
3737 
3738 Used by GDB_P to convert register values for display.  Takes register
3739 type and number as arguments.
3740 
3741 Returns a pointer to the start of the string, (except for PMCs, which
3742 print directly and return "").
3743 
3744 =cut
3745 
3746 */
3747 
3748 PARROT_WARN_UNUSED_RESULT
3749 PARROT_CANNOT_RETURN_NULL
3750 PARROT_OBSERVER
3751 static STRING *
GDB_print_reg(PARROT_INTERP,int t,int n)3752 GDB_print_reg(PARROT_INTERP, int t, int n)
3753 {
3754     ASSERT_ARGS(GDB_print_reg)
3755     char * string;
3756 
3757     if (n >= 0 && (UINTVAL)n < PCC_GET_REGS_USED(CURRENT_CONTEXT(interp), t)) {
3758         switch (t) {
3759           case REGNO_INT:
3760             return Parrot_str_from_int(interp, IREG(n));
3761           case REGNO_NUM:
3762             return Parrot_str_from_num(interp, NREG(n));
3763           case REGNO_STR:
3764             /* This hack is needed because we occasionally are told
3765                that we have string registers when we actually don't */
3766             string = (char *) SREG(n);
3767 
3768             if (string == NULL)
3769                 return Parrot_str_new(interp, "", 0);
3770             else
3771                 return SREG(n);
3772           case REGNO_PMC:
3773             /* prints directly */
3774             trace_pmc_dump(interp, PREG(n));
3775             return Parrot_str_new(interp, "", 0);
3776           default:
3777             break;
3778         }
3779     }
3780     return Parrot_str_new(interp, "no such register", 0);
3781 }
3782 
3783 /*
3784 
3785 =item C<static STRING * GDB_P(PARROT_INTERP, const char *s)>
3786 
3787 Used by PDB_print to print register values.  Takes a pointer to the
3788 register name(s).
3789 
3790 Returns "" or error message.
3791 
3792 =cut
3793 
3794 */
3795 
3796 PARROT_WARN_UNUSED_RESULT
3797 PARROT_CANNOT_RETURN_NULL
3798 PARROT_OBSERVER
3799 static STRING *
GDB_P(PARROT_INTERP,ARGIN (const char * s))3800 GDB_P(PARROT_INTERP, ARGIN(const char *s))
3801 {
3802     ASSERT_ARGS(GDB_P)
3803     int t;
3804     char reg_type;
3805 
3806     TRACEDEB_MSG("GDB_P");
3807     /* Skip leading whitespace. */
3808     while (isspace((unsigned char)*s))
3809         ++s;
3810 
3811     reg_type = (unsigned char) toupper((unsigned char)*s);
3812 
3813     switch (reg_type) {
3814         case 'I': t = REGNO_INT; break;
3815         case 'N': t = REGNO_NUM; break;
3816         case 'S': t = REGNO_STR; break;
3817         case 'P': t = REGNO_PMC; break;
3818         default: return Parrot_str_new(interp, "Need a register.", 0);
3819     }
3820     if (! s[1]) {
3821         /* Print all registers of this type. */
3822         const int max_reg = PCC_GET_REGS_USED(CURRENT_CONTEXT(interp), t);
3823         int n;
3824 
3825         for (n = 0; n < max_reg; ++n) {
3826             /* this must be done in two chunks because PMC's print directly. */
3827             Parrot_io_eprintf(interp, "\n  %c%d = ", reg_type, n);
3828             Parrot_io_eprintf(interp, "%Ss", GDB_print_reg(interp, t, n));
3829         }
3830         return Parrot_str_new(interp, "", 0);
3831     }
3832     else if (s[1] && isdigit((unsigned char)s[1])) {
3833         const int n = atoi(s + 1);
3834         return GDB_print_reg(interp, t, n);
3835     }
3836     else
3837         return Parrot_str_new(interp, "no such register", 0);
3838 
3839 }
3840 
3841 /*
3842 
3843 =item C<static void display_breakpoint(const PDB_t *pdb, const PDB_breakpoint_t
3844 *breakpoint)>
3845 
3846 Displays a breakpoint.
3847 
3848 =cut
3849 
3850 */
3851 
3852 static void
display_breakpoint(ARGIN (const PDB_t * pdb),ARGIN (const PDB_breakpoint_t * breakpoint))3853 display_breakpoint(ARGIN(const PDB_t *pdb), ARGIN(const PDB_breakpoint_t *breakpoint))
3854 {
3855     ASSERT_ARGS(display_breakpoint)
3856 
3857     /* Display the breakpoint id, PC, line number (if known),
3858        and disabled flag. */
3859 
3860     Parrot_io_eprintf(pdb->debugger,
3861                       "[%d] breakpoint at PC %04d",
3862                       breakpoint->id,
3863                       breakpoint->pc - pdb->debugee->code->base.data);
3864     if (breakpoint->line)
3865         Parrot_io_eprintf(pdb->debugger, ", line %d", breakpoint->line);
3866     if (breakpoint->skip < 0)
3867         Parrot_io_eprintf(pdb->debugger, "  (DISABLED)");
3868     Parrot_io_eprintf(pdb->debugger, "\n");
3869 }
3870 
3871 
3872 /*
3873 
3874 =back
3875 
3876 =head1 SEE ALSO
3877 
3878 F<include/parrot/debugger.h>, F<src/parrot_debugger.c> and F<ops/debug.ops>.
3879 
3880 =head1 HISTORY
3881 
3882 =over 4
3883 
3884 =item Initial version by Daniel Grunblatt on 2002.5.19.
3885 
3886 =item Start of rewrite - leo 2005.02.16
3887 
3888 The debugger now uses its own interpreter. User code is run in
3889 Interp *debugee. We have:
3890 
3891   debug_interp->pdb->debugee->debugger
3892     ^                            |
3893     |                            v
3894     +------------- := -----------+
3895 
3896 Debug commands are mostly run inside the C<debugger>. User code
3897 runs of course in the C<debugee>.
3898 
3899 =back
3900 
3901 =cut
3902 
3903 */
3904 
3905 /*
3906  * Local variables:
3907  *   c-file-style: "parrot"
3908  * End:
3909  * vim: expandtab shiftwidth=4 cinoptions='\:2=2' :
3910  */
3911