2 Copyright (C) 2001-2010, Parrot Foundation.
7 src/debug.c - Parrot debugging
11 This file implements Parrot debugging and is used by C<parrot_debugger>,
12 the Parrot debugger, and the C<debug> ops.
24 #include "parrot/parrot.h"
25 #include "parrot/extend.h"
26 #include "parrot/embed.h"
27 #include "parrot/oplib.h"
28 #include "parrot/debugger.h"
29 #include "parrot/oplib/ops.h"
30 #include "pmc/pmc_key.h"
31 #include "parrot/runcore_api.h"
32 #include "parrot/runcore_trace.h"
34 #include "pmc/pmc_continuation.h"
35 #include "pmc/pmc_callcontext.h"
37 /* Hand switched debugger tracing
38 * Set to 1 to enable tracing to stderr
41 #define TRACE_DEBUGGER 0
44 # define TRACEDEB_MSG(msg) fprintf(stderr, "%s\n", (msg))
46 # define TRACEDEB_MSG(msg)
49 /* Length of command line buffers */
50 #define DEBUG_CMD_BUFFER_LENGTH 255
52 /* Easier register access */
53 #define IREG(i) REG_INT(interp, (i))
54 #define NREG(i) REG_NUM(interp, (i))
55 #define SREG(i) REG_STR(interp, (i))
56 #define PREG(i) REG_PMC(interp, (i))
58 typedef struct DebuggerCmd DebuggerCmd
;
59 typedef struct DebuggerCmdList DebuggerCmdList
;
62 /* HEADERIZER HFILE: include/parrot/debugger.h */
64 /* HEADERIZER BEGIN: static */
65 /* Don't modify between HEADERIZER BEGIN / HEADERIZER END. Your changes will be lost. */
67 static void chop_newline(ARGMOD(char * buf
))
68 __attribute__nonnull__(1)
71 static void close_script_file(PARROT_INTERP
)
72 __attribute__nonnull__(1);
74 static unsigned short condition_regtype(ARGIN(const char *cmd
))
75 __attribute__nonnull__(1);
77 PARROT_CAN_RETURN_NULL
78 static PDB_breakpoint_t
* current_breakpoint(ARGIN(PDB_t
* pdb
))
79 __attribute__nonnull__(1);
81 static void debugger_cmdline(PARROT_INTERP
)
82 __attribute__nonnull__(1);
84 PARROT_WARN_UNUSED_RESULT
85 PARROT_CANNOT_RETURN_NULL
87 static STRING
* GDB_P(PARROT_INTERP
, ARGIN(const char *s
))
88 __attribute__nonnull__(1)
89 __attribute__nonnull__(2);
91 PARROT_WARN_UNUSED_RESULT
92 PARROT_CANNOT_RETURN_NULL
94 static STRING
* GDB_print_reg(PARROT_INTERP
, int t
, int n
)
95 __attribute__nonnull__(1);
97 PARROT_WARN_UNUSED_RESULT
98 PARROT_CAN_RETURN_NULL
99 static const DebuggerCmd
* get_cmd(ARGIN_NULLOK(const char **cmd
));
101 PARROT_WARN_UNUSED_RESULT
102 static unsigned long get_uint(ARGMOD(const char **cmd
), unsigned int def
)
103 __attribute__nonnull__(1)
106 PARROT_WARN_UNUSED_RESULT
107 static unsigned long get_ulong(ARGMOD(const char **cmd
), unsigned long def
)
108 __attribute__nonnull__(1)
111 static void list_breakpoints(ARGIN(PDB_t
*pdb
))
112 __attribute__nonnull__(1);
114 static void no_such_register(PARROT_INTERP
,
116 UINTVAL register_num
)
117 __attribute__nonnull__(1);
119 PARROT_WARN_UNUSED_RESULT
120 PARROT_CANNOT_RETURN_NULL
121 static const char * skip_whitespace(ARGIN(const char *cmd
))
122 __attribute__nonnull__(1);
124 #define ASSERT_ARGS_chop_newline __attribute__unused__ int _ASSERT_ARGS_CHECK = (\
125 PARROT_ASSERT_ARG(buf))
126 #define ASSERT_ARGS_close_script_file __attribute__unused__ int _ASSERT_ARGS_CHECK = (\
127 PARROT_ASSERT_ARG(interp))
128 #define ASSERT_ARGS_condition_regtype __attribute__unused__ int _ASSERT_ARGS_CHECK = (\
129 PARROT_ASSERT_ARG(cmd))
130 #define ASSERT_ARGS_current_breakpoint __attribute__unused__ int _ASSERT_ARGS_CHECK = (\
131 PARROT_ASSERT_ARG(pdb))
132 #define ASSERT_ARGS_debugger_cmdline __attribute__unused__ int _ASSERT_ARGS_CHECK = (\
133 PARROT_ASSERT_ARG(interp))
134 #define ASSERT_ARGS_GDB_P __attribute__unused__ int _ASSERT_ARGS_CHECK = (\
135 PARROT_ASSERT_ARG(interp) \
136 , PARROT_ASSERT_ARG(s))
137 #define ASSERT_ARGS_GDB_print_reg __attribute__unused__ int _ASSERT_ARGS_CHECK = (\
138 PARROT_ASSERT_ARG(interp))
139 #define ASSERT_ARGS_get_cmd __attribute__unused__ int _ASSERT_ARGS_CHECK = (0)
140 #define ASSERT_ARGS_get_uint __attribute__unused__ int _ASSERT_ARGS_CHECK = (\
141 PARROT_ASSERT_ARG(cmd))
142 #define ASSERT_ARGS_get_ulong __attribute__unused__ int _ASSERT_ARGS_CHECK = (\
143 PARROT_ASSERT_ARG(cmd))
144 #define ASSERT_ARGS_list_breakpoints __attribute__unused__ int _ASSERT_ARGS_CHECK = (\
145 PARROT_ASSERT_ARG(pdb))
146 #define ASSERT_ARGS_no_such_register __attribute__unused__ int _ASSERT_ARGS_CHECK = (\
147 PARROT_ASSERT_ARG(interp))
148 #define ASSERT_ARGS_skip_whitespace __attribute__unused__ int _ASSERT_ARGS_CHECK = (\
149 PARROT_ASSERT_ARG(cmd))
150 /* Don't modify between HEADERIZER BEGIN / HEADERIZER END. Your changes will be lost. */
151 /* HEADERIZER END: static */
154 * Command functions and help dispatch
157 typedef void (* debugger_func_t
)(PDB_t
* pdb
, const char * cmd
);
159 static int nomoreargs(PDB_t
* pdb
, const char * cmd
) /* HEADERIZER SKIP */
161 if (*skip_whitespace(cmd
) == '\0')
164 Parrot_io_eprintf(pdb
->debugger
, "Spurious arg\n");
169 static void dbg_assign(PDB_t
* pdb
, const char * cmd
) /* HEADERIZER SKIP */
171 TRACEDEB_MSG("dbg_assign");
173 PDB_assign(pdb
->debugee
, cmd
);
176 static void dbg_break(PDB_t
* pdb
, const char * cmd
) /* HEADERIZER SKIP */
178 TRACEDEB_MSG("dbg_break");
180 PDB_set_break(pdb
->debugee
, cmd
);
183 static void dbg_continue(PDB_t
* pdb
, const char * cmd
) /* HEADERIZER SKIP */
185 TRACEDEB_MSG("dbg_continue");
187 PDB_continue(pdb
->debugee
, cmd
);
190 static void dbg_delete(PDB_t
* pdb
, const char * cmd
) /* HEADERIZER SKIP */
192 TRACEDEB_MSG("dbg_delete");
194 PDB_delete_breakpoint(pdb
->debugee
, cmd
);
197 static void dbg_disable(PDB_t
* pdb
, const char * cmd
) /* HEADERIZER SKIP */
199 TRACEDEB_MSG("dbg_disable");
201 PDB_disable_breakpoint(pdb
->debugee
, cmd
);
204 static void dbg_disassemble(PDB_t
* pdb
, const char * cmd
) /* HEADERIZER SKIP */
206 TRACEDEB_MSG("dbg_disassemble");
208 PDB_disassemble(pdb
->debugee
, cmd
);
211 static void dbg_echo(PDB_t
* pdb
, const char * cmd
) /* HEADERIZER SKIP */
213 TRACEDEB_MSG("dbg_echo");
215 if (! nomoreargs(pdb
, cmd
))
218 if (pdb
->state
& PDB_ECHO
) {
219 TRACEDEB_MSG("Disabling echo");
220 pdb
->state
&= ~PDB_ECHO
;
223 TRACEDEB_MSG("Enabling echo");
224 pdb
->state
|= PDB_ECHO
;
228 static void dbg_enable(PDB_t
* pdb
, const char * cmd
) /* HEADERIZER SKIP */
230 PDB_enable_breakpoint(pdb
->debugee
, cmd
);
233 static void dbg_eval(PDB_t
* pdb
, const char * cmd
) /* HEADERIZER SKIP */
235 PDB_eval(pdb
->debugee
, cmd
);
238 static void dbg_gcdebug(PDB_t
* pdb
, const char * cmd
) /* HEADERIZER SKIP */
240 TRACEDEB_MSG("dbg_gcdebug");
242 if (! nomoreargs(pdb
, cmd
))
245 if (pdb
->state
& PDB_GCDEBUG
) {
246 TRACEDEB_MSG("Disabling gcdebug mode");
247 pdb
->state
&= ~PDB_GCDEBUG
;
250 TRACEDEB_MSG("Enabling gcdebug mode");
251 pdb
->state
|= PDB_GCDEBUG
;
255 static void dbg_help(PDB_t
* pdb
, const char * cmd
) /* HEADERIZER SKIP */
257 TRACEDEB_MSG("dbg_help");
259 PDB_help(pdb
->debugee
, cmd
);
262 static void dbg_info(PDB_t
* pdb
, const char * cmd
) /* HEADERIZER SKIP */
264 TRACEDEB_MSG("dbg_info");
266 if (! nomoreargs(pdb
, cmd
))
269 PDB_info(pdb
->debugger
);
272 static void dbg_list(PDB_t
* pdb
, const char * cmd
) /* HEADERIZER SKIP */
274 TRACEDEB_MSG("dbg_list");
276 PDB_list(pdb
->debugee
, cmd
);
279 static void dbg_listbreakpoints(PDB_t
* pdb
, SHIM(const char * cmd
)) /* HEADERIZER SKIP */
281 TRACEDEB_MSG("dbg_list");
283 list_breakpoints(pdb
);
286 static void dbg_load(PDB_t
* pdb
, const char * cmd
) /* HEADERIZER SKIP */
288 TRACEDEB_MSG("dbg_load");
290 PDB_load_source(pdb
->debugee
, cmd
);
293 static void dbg_next(PDB_t
* pdb
, const char * cmd
) /* HEADERIZER SKIP */
295 TRACEDEB_MSG("dbg_next");
297 PDB_next(pdb
->debugee
, cmd
);
300 static void dbg_print(PDB_t
* pdb
, const char * cmd
) /* HEADERIZER SKIP */
302 TRACEDEB_MSG("dbg_print");
304 PDB_print(pdb
->debugee
, cmd
);
307 static void dbg_quit(PDB_t
* pdb
, const char * cmd
) /* HEADERIZER SKIP */
309 TRACEDEB_MSG("dbg_quit");
311 if (! nomoreargs(pdb
, cmd
))
314 pdb
->state
|= PDB_EXIT
;
315 pdb
->state
&= ~PDB_STOPPED
;
318 static void dbg_run(PDB_t
* pdb
, const char * cmd
) /* HEADERIZER SKIP */
320 TRACEDEB_MSG("dbg_run");
322 PDB_init(pdb
->debugee
, cmd
);
323 PDB_continue(pdb
->debugee
, NULL
);
326 static void dbg_script(PDB_t
* pdb
, const char * cmd
) /* HEADERIZER SKIP */
328 TRACEDEB_MSG("dbg_script");
330 PDB_script_file(pdb
->debugee
, cmd
);
333 static void dbg_stack(PDB_t
* pdb
, const char * cmd
) /* HEADERIZER SKIP */
335 TRACEDEB_MSG("dbg_stack");
337 if (! nomoreargs(pdb
, cmd
))
340 PDB_backtrace(pdb
->debugee
);
343 static void dbg_trace(PDB_t
* pdb
, const char * cmd
) /* HEADERIZER SKIP */
345 TRACEDEB_MSG("dbg_trace");
347 PDB_trace(pdb
->debugee
, cmd
);
350 static void dbg_watch(PDB_t
* pdb
, const char * cmd
) /* HEADERIZER SKIP */
352 TRACEDEB_MSG("dbg_watch");
354 PDB_watchpoint(pdb
->debugee
, cmd
);
358 debugger_func_t func
;
359 PARROT_OBSERVER
const char * const shorthelp
;
360 PARROT_OBSERVER
const char * const help
;
363 static const DebuggerCmd
366 "assign to a register",
367 "Assign a value to a register. For example:\n\
370 The first command sets I0 to 42 and the second sets N1 to 3.14."
375 "Set a breakpoint at a given line number (which must be specified).\n\n\
376 Optionally, specify a condition, in which case the breakpoint will only\n\
377 activate if the condition is met. Conditions take the form:\n\n\
378 if [REGISTER] [COMPARISON] [REGISTER or CONSTANT]\n\n\
381 break 10 if I4 > I3\n\n\
382 break 45 if S1 == \"foo\"\n\n\
383 The command returns a number which is the breakpoint identifier."
387 "continue the program execution",
388 "Continue the program execution.\n\n\
389 Without arguments, the program runs until a breakpoint is found\n\
390 (or until the program terminates for some other reason).\n\n\
391 If a number is specified, then skip that many breakpoints.\n\n\
392 If the program has terminated, then \"continue\" will do nothing;\n\
393 use \"run\" to re-run the program."
397 "delete a breakpoint",
398 "Delete a breakpoint.\n\n\
399 The breakpoint to delete must be specified by its breakpoint number.\n\
400 Deleted breakpoints are gone completely. If instead you want to\n\
401 temporarily disable a breakpoint, use \"disable\"."
405 "disable a breakpoint",
406 "Disable a breakpoint.\n\n\
407 The breakpoint to disable must be specified by its breakpoint number.\n\
408 Disabled breakpoints are not forgotten, but have no effect until re-enabled\n\
409 with the \"enable\" command."
413 "disassemble the bytecode",
418 "toggle echo of script commands",
419 "Toggle echo mode.\n\n\
420 In echo mode the script commands are written to stderr before executing."
424 "reenable a disabled breakpoint",
425 "Re-enable a disabled breakpoint."
429 "run an instruction",
430 "No documentation yet"
434 "toggle gcdebug mode",
435 "Toggle gcdebug mode.\n\n\
436 In gcdebug mode a garbage collection cycle is run before each opcocde,\n\
437 same as using the gcdebug core."
442 "Print a list of available commands."
446 "print interpreter information",
447 "Print information about the current interpreter"
451 "list the source code file",
452 "List the source code.\n\n\
453 Optionally specify the line number to begin the listing from and the number\n\
454 of lines to display."
456 cmd_listbreakpoints
= {
457 & dbg_listbreakpoints
,
463 "load a source code file",
464 "Load a source code file."
468 "run the next instruction",
469 "Execute a specified number of instructions.\n\n\
470 If a number is specified with the command (e.g. \"next 5\"), then\n\
471 execute that number of instructions, unless the program reaches a\n\
472 breakpoint, or stops for some other reason.\n\n\
473 If no number is specified, it defaults to 1."
477 "print the interpreter registers",
478 "Print register: e.g. \"p i2\"\n\
479 Note that the register type is case-insensitive. If no digits appear\n\
480 after the register type, all registers of that type are printed."
490 "Run (or restart) the program being debugged.\n\n\
491 Arguments specified after \"run\" are passed as command line arguments to\n\
496 "interprets a file as user commands",
497 "Interprets a file s user commands.\n\
499 (pdb) script file.script"
504 "Print a stack trace of the parrot VM"
508 "trace the next instruction",
509 "Similar to \"next\", but prints additional trace information.\n\
510 This is the same as the information you get when running Parrot with\n\
519 struct DebuggerCmdList
{
520 PARROT_OBSERVER
const char * const name
;
522 PARROT_OBSERVER
const DebuggerCmd
* const cmd
;
525 DebuggerCmdList DebCmdList
[] = {
526 { "assign", 'a', &cmd_assign
},
527 { "break", '\0', &cmd_break
},
528 { "continue", '\0', &cmd_continue
},
529 { "delete", 'd', &cmd_delete
},
530 { "disable", '\0', &cmd_disable
},
531 { "disassemble", '\0', &cmd_disassemble
},
532 { "e", '\0', &cmd_eval
},
533 { "echo", '\0', &cmd_echo
},
534 { "enable", '\0', &cmd_enable
},
535 { "eval", '\0', &cmd_eval
},
536 { "f", '\0', &cmd_script
},
537 { "gcdebug", '\0', &cmd_gcdebug
},
538 { "help", '\0', &cmd_help
},
539 { "info", '\0', &cmd_info
},
540 { "L", '\0', &cmd_listbreakpoints
},
541 { "list", 'l', &cmd_list
},
542 { "load", '\0', &cmd_load
},
543 { "next", '\0', &cmd_next
},
544 { "print", '\0', &cmd_print
},
545 { "quit", '\0', &cmd_quit
},
546 { "run", '\0', &cmd_run
},
547 { "script", '\0', &cmd_script
},
548 { "stack", 's', &cmd_stack
},
549 { "trace", '\0', &cmd_trace
},
550 { "watch", '\0', &cmd_watch
}
555 =item C<static const DebuggerCmd * get_cmd(const char **cmd)>
557 Parse the debuggger command indicated by C<**cmd>. Return a pointer to the
558 matching function for known commands, or a NULL pointer otherwise.
564 PARROT_WARN_UNUSED_RESULT
565 PARROT_CAN_RETURN_NULL
566 static const DebuggerCmd
*
567 get_cmd(ARGIN_NULLOK(const char **cmd
))
571 const char * const start
= skip_whitespace(*cmd
);
572 const char *next
= start
;
579 for (; (c
= *next
) != '\0' && !isspace((unsigned char)c
); ++next
)
584 for (i
= 0; i
< sizeof (DebCmdList
) / sizeof (DebuggerCmdList
); ++i
) {
585 const DebuggerCmdList
* const cmdlist
= DebCmdList
+ i
;
586 if (l
== 1 && cmdlist
->shortname
== (*cmd
)[0]) {
591 if (strncmp(*cmd
, cmdlist
->name
, l
) == 0) {
592 if (strlen(cmdlist
->name
) == l
) {
604 *cmd
= skip_whitespace(next
);
605 return DebCmdList
[found
].cmd
;
613 =item C<static const char * skip_whitespace(const char *cmd)>
615 Return a pointer to the first non-whitespace character in C<cmd>.
621 PARROT_WARN_UNUSED_RESULT
622 PARROT_CANNOT_RETURN_NULL
624 skip_whitespace(ARGIN(const char *cmd
))
626 ASSERT_ARGS(skip_whitespace
)
627 while (*cmd
&& isspace((unsigned char)*cmd
))
634 =item C<static unsigned long get_uint(const char **cmd, unsigned int def)>
636 Get an unsigned int from C<**cmd>.
643 PARROT_WARN_UNUSED_RESULT
645 get_uint(ARGMOD(const char **cmd
), unsigned int def
)
647 ASSERT_ARGS(get_uint
)
649 unsigned int result
= strtoul(skip_whitespace(* cmd
), & cmdnext
, 0);
659 =item C<static unsigned long get_ulong(const char **cmd, unsigned long def)>
661 Get an unsigned long from C<**cmd>.
668 PARROT_WARN_UNUSED_RESULT
670 get_ulong(ARGMOD(const char **cmd
), unsigned long def
)
672 ASSERT_ARGS(get_ulong
)
674 unsigned long result
= strtoul(skip_whitespace(* cmd
), & cmdnext
, 0);
675 if (cmdnext
!= * cmd
)
684 =item C<static void chop_newline(char * buf)>
686 If the C string argument end with a newline, delete it.
693 chop_newline(ARGMOD(char * buf
))
695 ASSERT_ARGS(chop_newline
)
696 const size_t l
= strlen(buf
);
698 if (l
> 0 && buf
[l
- 1] == '\n')
704 =item C<static void debugger_cmdline(PARROT_INTERP)>
706 Debugger command line.
708 Gets and executes commands, looping until the debugger state
709 is changed, either to exit or to start executing code.
716 debugger_cmdline(PARROT_INTERP
)
718 ASSERT_ARGS(debugger_cmdline
)
719 TRACEDEB_MSG("debugger_cmdline");
721 /*while (!(interp->pdb->state & PDB_EXIT)) {*/
722 while (interp
->pdb
->state
& PDB_STOPPED
) {
723 const char * command
;
724 interp
->pdb
->state
&= ~PDB_TRACING
;
725 PDB_get_command(interp
);
726 command
= interp
->pdb
->cur_command
;
727 if (command
[0] == '\0')
728 command
= interp
->pdb
->last_command
;
730 PDB_run_command(interp
, command
);
732 TRACEDEB_MSG("debugger_cmdline finished");
737 =item C<static void close_script_file(PARROT_INTERP)>
739 Close the script file, returning to command prompt mode.
746 close_script_file(PARROT_INTERP
)
748 ASSERT_ARGS(close_script_file
)
749 TRACEDEB_MSG("Closing debugger script file");
750 if (interp
->pdb
->script_file
) {
751 fclose(interp
->pdb
->script_file
);
752 interp
->pdb
->script_file
= NULL
;
753 interp
->pdb
->state
|= PDB_STOPPED
;
754 interp
->pdb
->last_command
[0] = '\0';
755 interp
->pdb
->cur_command
[0] = '\0';
761 =item C<void Parrot_debugger_init(PARROT_INTERP)>
763 Initializes the Parrot debugger, if it's not already initialized.
771 Parrot_debugger_init(PARROT_INTERP
)
773 ASSERT_ARGS(Parrot_debugger_init
)
774 TRACEDEB_MSG("Parrot_debugger_init");
777 PDB_t
*pdb
= mem_gc_allocate_zeroed_typed(interp
, PDB_t
);
778 Parrot_Interp debugger
= Parrot_new(interp
);
781 pdb
->debugee
= interp
;
782 pdb
->debugger
= debugger
;
784 /* Allocate space for command line buffers, NUL terminated c strings */
785 pdb
->cur_command
= mem_gc_allocate_n_typed(interp
, DEBUG_CMD_BUFFER_LENGTH
+ 1, char);
786 pdb
->last_command
= mem_gc_allocate_n_typed(interp
, DEBUG_CMD_BUFFER_LENGTH
+ 1, char);
787 pdb
->file
= mem_gc_allocate_zeroed_typed(interp
, PDB_file_t
);
790 /* PDB_disassemble(interp, NULL); */
792 interp
->pdb
->state
|= PDB_RUNNING
;
797 =item C<void Parrot_debugger_destroy(PARROT_INTERP)>
799 Destroy the current Parrot debugger instance.
807 Parrot_debugger_destroy(PARROT_INTERP
)
809 ASSERT_ARGS(Parrot_debugger_destroy
)
811 Free all debugger allocated resources.
813 PDB_t
*pdb
= interp
->pdb
;
815 TRACEDEB_MSG("Parrot_debugger_destroy");
818 PARROT_ASSERT(pdb
->debugee
== interp
);
820 mem_gc_free(interp
, pdb
->last_command
);
821 mem_gc_free(interp
, pdb
->cur_command
);
823 mem_gc_free(interp
, pdb
);
829 =item C<void Parrot_debugger_load(PARROT_INTERP, STRING *filename)>
831 Loads a Parrot source file for the current program.
839 Parrot_debugger_load(PARROT_INTERP
, ARGIN_NULLOK(STRING
*filename
))
841 ASSERT_ARGS(Parrot_debugger_load
)
844 TRACEDEB_MSG("Parrot_debugger_load");
847 Parrot_ex_throw_from_c_args(interp
, NULL
, 0, "No debugger");
849 file
= Parrot_str_to_cstring(interp
, filename
);
850 PDB_load_source(interp
, file
);
851 Parrot_str_free_cstring(file
);
856 =item C<void Parrot_debugger_start(PARROT_INTERP, opcode_t * cur_opcode)>
866 Parrot_debugger_start(PARROT_INTERP
, ARGIN_NULLOK(opcode_t
* cur_opcode
))
868 ASSERT_ARGS(Parrot_debugger_start
)
869 TRACEDEB_MSG("Parrot_debugger_start");
872 Parrot_ex_throw_from_c_args(interp
, NULL
, 0, "No debugger");
874 interp
->pdb
->cur_opcode
= interp
->code
->base
.data
;
876 if (interp
->pdb
->state
& PDB_ENTER
) {
877 if (!interp
->pdb
->file
) {
878 /* PDB_disassemble(interp, NULL); */
880 interp
->pdb
->state
&= ~PDB_ENTER
;
883 interp
->pdb
->cur_opcode
= cur_opcode
;
885 interp
->pdb
->state
|= PDB_STOPPED
;
887 debugger_cmdline(interp
);
889 if (interp
->pdb
->state
& PDB_EXIT
) {
890 TRACEDEB_MSG("Parrot_debugger_start Parrot_exit");
891 Parrot_exit(interp
, 0);
893 TRACEDEB_MSG("Parrot_debugger_start ends");
898 =item C<void Parrot_debugger_break(PARROT_INTERP, opcode_t * cur_opcode)>
900 Breaks execution and drops into the debugger. If we are already into the
901 debugger and it is the first call, set a breakpoint.
903 When you re run/continue the program being debugged it will pay no attention to
912 Parrot_debugger_break(PARROT_INTERP
, ARGIN(opcode_t
* cur_opcode
))
914 ASSERT_ARGS(Parrot_debugger_break
)
915 TRACEDEB_MSG("Parrot_debugger_break");
918 Parrot_ex_throw_from_c_args(interp
, NULL
, 0, "No debugger");
920 if (!interp
->pdb
->file
)
921 Parrot_ex_throw_from_c_args(interp
, NULL
, 0, "No file loaded to debug");
923 if (!(interp
->pdb
->state
& PDB_BREAK
)) {
924 TRACEDEB_MSG("Parrot_debugger_break - in BREAK state");
925 new_runloop_jump_point(interp
);
926 if (setjmp(interp
->current_runloop
->resume
)) {
927 fprintf(stderr
, "Unhandled exception in debugger\n");
931 interp
->pdb
->state
|= PDB_BREAK
;
932 interp
->pdb
->state
|= PDB_STOPPED
;
933 interp
->pdb
->cur_opcode
= (opcode_t
*)cur_opcode
+ 1;
935 /*PDB_set_break(interp, NULL);*/
937 debugger_cmdline(interp
);
940 interp
->pdb
->cur_opcode
= (opcode_t
*)cur_opcode
+ 1;
941 /*PDB_set_break(interp, NULL);*/
943 TRACEDEB_MSG("Parrot_debugger_break done");
948 =item C<void PDB_get_command(PARROT_INTERP)>
950 Get a command from the user input to execute.
952 It saves the last command executed (in C<< pdb->last_command >>), so it
953 first frees the old one and updates it with the current one.
955 Also prints the next line to run if the program is still active.
957 The user input can't be longer than DEBUG_CMD_BUFFER_LENGTH characters.
959 The input is saved in C<< pdb->cur_command >>.
966 PDB_get_command(PARROT_INTERP
)
968 ASSERT_ARGS(PDB_get_command
)
970 PDB_t
* const pdb
= interp
->pdb
;
972 /***********************************
977 ***********************************/
979 /* flush the buffered data */
982 TRACEDEB_MSG("PDB_get_command");
984 PARROT_ASSERT(pdb
->last_command
);
985 PARROT_ASSERT(pdb
->cur_command
);
987 if (interp
->pdb
->script_file
) {
988 FILE * const fd
= interp
->pdb
->script_file
;
989 char buf
[DEBUG_CMD_BUFFER_LENGTH
+1];
993 if (fgets(buf
, DEBUG_CMD_BUFFER_LENGTH
, fd
) == NULL
) {
994 close_script_file(interp
);
1000 fprintf(stderr
, "script (%lu): '%s'\n", pdb
->script_line
, buf
);
1004 ptr
= skip_whitespace(buf
);
1006 /* skip blank and commented lines */
1007 } while (*ptr
== '\0' || *ptr
== '#');
1009 if (pdb
->state
& PDB_ECHO
)
1010 Parrot_io_eprintf(pdb
->debugger
, "[%lu %s]\n", pdb
->script_line
, buf
);
1013 fprintf(stderr
, "(script) %s\n", buf
);
1016 strcpy(pdb
->cur_command
, buf
);
1019 /* update the last command */
1020 if (pdb
->cur_command
[0] != '\0')
1021 strcpy(pdb
->last_command
, pdb
->cur_command
);
1023 c
= pdb
->cur_command
;
1025 Parrot_io_eprintf(pdb
->debugger
, "\n");
1028 Interp
* const interpdeb
= interp
->pdb
->debugger
;
1029 STRING
* const readline
= CONST_STRING(interpdeb
, "readline_interactive");
1030 STRING
* const prompt
= CONST_STRING(interpdeb
, "(pdb) ");
1031 STRING
* const s
= Parrot_str_new(interpdeb
, NULL
, 0);
1032 PMC
* const tmp_stdin
= Parrot_io_stdhandle(interpdeb
, 0, NULL
);
1034 Parrot_pcc_invoke_method_from_c_args(interpdeb
,
1035 tmp_stdin
, readline
,
1036 "S->S", prompt
, &s
);
1038 char * const aux
= Parrot_str_to_cstring(interpdeb
, s
);
1040 Parrot_str_free_cstring(aux
);
1048 =item C<void PDB_script_file(PARROT_INTERP, const char *command)>
1050 Interprets the contents of a file as user input commands
1058 PDB_script_file(PARROT_INTERP
, ARGIN(const char *command
))
1060 ASSERT_ARGS(PDB_script_file
)
1063 TRACEDEB_MSG("PDB_script_file");
1065 /* If already executing a script, close it */
1066 close_script_file(interp
);
1068 TRACEDEB_MSG("Opening debugger script file");
1070 fd
= fopen(command
, "r");
1072 Parrot_io_eprintf(interp
->pdb
->debugger
,
1073 "Error reading script file %s.\n",
1077 interp
->pdb
->script_file
= fd
;
1078 interp
->pdb
->script_line
= 0;
1079 TRACEDEB_MSG("PDB_script_file finished");
1084 =item C<int PDB_run_command(PARROT_INTERP, const char *command)>
1088 Hash the command to make a simple switch calling the correct handler.
1094 PARROT_IGNORABLE_RESULT
1096 PDB_run_command(PARROT_INTERP
, ARGIN(const char *command
))
1098 ASSERT_ARGS(PDB_run_command
)
1099 PDB_t
* const pdb
= interp
->pdb
;
1100 const DebuggerCmd
*cmd
;
1102 /* keep a pointer to the command, in case we need to report an error */
1104 const char * cmdline
= command
;
1106 TRACEDEB_MSG("PDB_run_command");
1107 cmd
= get_cmd(& cmdline
);
1110 (* cmd
->func
)(pdb
, cmdline
);
1114 if (*cmdline
== '\0') {
1118 Parrot_io_eprintf(pdb
->debugger
,
1119 "Undefined command: \"%s\"", command
);
1120 if (pdb
->script_file
)
1121 Parrot_io_eprintf(pdb
->debugger
, " in line %lu", pdb
->script_line
);
1122 Parrot_io_eprintf(pdb
->debugger
, ". Try \"help\".");
1123 close_script_file(interp
);
1131 =item C<void PDB_next(PARROT_INTERP, const char *command)>
1133 Execute the next N operation(s).
1135 Inits the program if needed, runs the next N >= 1 operations and stops.
1142 PDB_next(PARROT_INTERP
, ARGIN_NULLOK(const char *command
))
1144 ASSERT_ARGS(PDB_next
)
1145 PDB_t
* const pdb
= interp
->pdb
;
1148 TRACEDEB_MSG("PDB_next");
1150 /* Init the program if it's not running */
1151 if (!(pdb
->state
& PDB_RUNNING
))
1152 PDB_init(interp
, command
);
1154 /* Get the number of operations to execute if any */
1155 pdb
->tracing
= get_ulong(& command
, 1);
1157 /* Erase the stopped flag */
1158 pdb
->state
&= ~PDB_STOPPED
;
1160 debugee
= pdb
->debugee
;
1162 new_runloop_jump_point(debugee
);
1163 if (setjmp(debugee
->current_runloop
->resume
)) {
1164 Parrot_io_eprintf(pdb
->debugger
, "Unhandled exception while tracing\n");
1165 pdb
->state
|= PDB_STOPPED
;
1169 Parrot_runcore_switch(pdb
->debugee
, CONST_STRING(interp
, "debugger"));
1171 TRACEDEB_MSG("PDB_next finished");
1176 =item C<void PDB_trace(PARROT_INTERP, const char *command)>
1178 Execute the next N operations; if no number is specified, it defaults to 1.
1185 PDB_trace(PARROT_INTERP
, ARGIN_NULLOK(const char *command
))
1187 ASSERT_ARGS(PDB_trace
)
1188 PDB_t
* const pdb
= interp
->pdb
;
1191 TRACEDEB_MSG("PDB_trace");
1193 /* if debugger is not running yet, initialize */
1195 if (!(pdb->state & PDB_RUNNING))
1196 PDB_init(interp, command);
1199 /* get the number of ops to run, if specified */
1200 pdb
->tracing
= get_ulong(& command
, 1);
1202 /* clear the PDB_STOPPED flag, we'll be running n ops now */
1203 pdb
->state
&= ~PDB_STOPPED
;
1204 debugee
= pdb
->debugee
;
1207 new_runloop_jump_point(debugee
);
1208 if (setjmp(debugee
->current_runloop
->resume
)) {
1209 Parrot_io_eprintf(pdb
->debugger
, "Unhandled exception while tracing\n");
1210 pdb
->state
|= PDB_STOPPED
;
1214 pdb
->state
|= PDB_TRACING
;
1215 Parrot_runcore_switch(pdb
->debugee
, CONST_STRING(interp
, "debugger"));
1217 /* Clear the following when done some testing */
1219 /* we just stopped */
1220 pdb
->state
|= PDB_STOPPED
;
1222 /* If program ended */
1223 if (!pdb
->cur_opcode
)
1224 (void)PDB_program_end(interp
);
1225 pdb
->state
|= PDB_RUNNING
;
1226 pdb
->state
&= ~PDB_STOPPED
;
1228 TRACEDEB_MSG("PDB_trace finished");
1233 =item C<static unsigned short condition_regtype(const char *cmd)>
1235 Return the type of the register represented by C<*cmd>.
1241 static unsigned short
1242 condition_regtype(ARGIN(const char *cmd
))
1244 ASSERT_ARGS(condition_regtype
)
1248 return PDB_cond_int
;
1251 return PDB_cond_num
;
1254 return PDB_cond_str
;
1257 return PDB_cond_pmc
;
1265 =item C<PDB_condition_t * PDB_cond(PARROT_INTERP, const char *command)>
1267 Analyzes a condition from the user input.
1273 PARROT_CAN_RETURN_NULL
1275 PDB_cond(PARROT_INTERP
, ARGIN(const char *command
))
1277 ASSERT_ARGS(PDB_cond
)
1278 PDB_condition_t
*condition
;
1280 char str
[DEBUG_CMD_BUFFER_LENGTH
+ 1];
1281 unsigned short cond_argleft
;
1282 unsigned short cond_type
;
1285 TRACEDEB_MSG("PDB_cond");
1287 /* Return if no more arguments */
1288 if (!(command
&& *command
)) {
1289 Parrot_io_eprintf(interp
->pdb
->debugger
, "No condition specified\n");
1293 command
= skip_whitespace(command
);
1295 fprintf(stderr
, "PDB_trace: '%s'\n", command
);
1298 cond_argleft
= condition_regtype(command
);
1300 /* get the register number */
1302 reg_number
= get_uint(&command
, 0);
1304 if (auxcmd
== command
) {
1305 Parrot_io_eprintf(interp
->pdb
->debugger
, "Invalid register\n");
1309 /* Now the condition */
1310 command
= skip_whitespace(command
);
1313 if (*(command
+ 1) == '=')
1314 cond_type
= PDB_cond_ge
;
1316 cond_type
= PDB_cond_gt
;
1319 if (*(command
+ 1) == '=')
1320 cond_type
= PDB_cond_le
;
1322 cond_type
= PDB_cond_lt
;
1325 if (*(command
+ 1) == '=')
1326 cond_type
= PDB_cond_eq
;
1331 if (*(command
+ 1) == '=')
1332 cond_type
= PDB_cond_ne
;
1337 if (cond_argleft
!= PDB_cond_str
&& cond_argleft
!= PDB_cond_pmc
) {
1338 Parrot_io_eprintf(interp
->pdb
->debugger
, "Invalid null condition\n");
1341 cond_type
= PDB_cond_notnull
;
1345 Parrot_io_eprintf(interp
->pdb
->debugger
, "Invalid condition\n");
1349 /* if there's an '=', skip it */
1350 if (*(command
+ 1) == '=')
1355 command
= skip_whitespace(command
);
1357 /* return if no notnull condition and no more arguments */
1358 if (!(command
&& *command
) && (cond_type
!= PDB_cond_notnull
)) {
1359 Parrot_io_eprintf(interp
->pdb
->debugger
, "Can't compare a register with nothing\n");
1363 /* Allocate new condition */
1364 condition
= mem_gc_allocate_zeroed_typed(interp
, PDB_condition_t
);
1366 condition
->type
= cond_argleft
| cond_type
;
1368 if (cond_type
!= PDB_cond_notnull
) {
1370 if (isalpha((unsigned char)*command
)) {
1371 /* It's a register - we first check that it's the correct type */
1373 unsigned short cond_argright
= condition_regtype(command
);
1375 if (cond_argright
!= cond_argleft
) {
1376 Parrot_io_eprintf(interp
->pdb
->debugger
, "Register types don't agree\n");
1377 mem_gc_free(interp
, condition
);
1381 /* Now we check and store the register number */
1383 reg_number
= (int)get_uint(&command
, 0);
1384 if (auxcmd
== command
) {
1385 Parrot_io_eprintf(interp
->pdb
->debugger
, "Invalid register\n");
1386 mem_gc_free(interp
, condition
);
1390 if (reg_number
< 0) {
1391 Parrot_io_eprintf(interp
->pdb
->debugger
, "Out-of-bounds register\n");
1392 mem_gc_free(interp
, condition
);
1396 condition
->value
= mem_gc_allocate_typed(interp
, int);
1397 *(int *)condition
->value
= reg_number
;
1399 /* If the first argument was an integer */
1400 else if (condition
->type
& PDB_cond_int
) {
1401 /* This must be either an integer constant or register */
1402 condition
->value
= mem_gc_allocate_typed(interp
, INTVAL
);
1403 *(INTVAL
*)condition
->value
= (INTVAL
)atoi(command
);
1404 condition
->type
|= PDB_cond_const
;
1406 else if (condition
->type
& PDB_cond_num
) {
1407 condition
->value
= mem_gc_allocate_typed(interp
, FLOATVAL
);
1408 *(FLOATVAL
*)condition
->value
= (FLOATVAL
)atof(command
);
1409 condition
->type
|= PDB_cond_const
;
1411 else if (condition
->type
& PDB_cond_str
) {
1412 for (i
= 1; ((command
[i
] != '"') && (i
< DEBUG_CMD_BUFFER_LENGTH
)); ++i
)
1413 str
[i
- 1] = command
[i
];
1416 fprintf(stderr
, "PDB_break: '%s'\n", str
);
1418 condition
->value
= string_make(interp
, str
, (UINTVAL
)(i
- 1),
1421 condition
->type
|= PDB_cond_const
;
1423 else if (condition
->type
& PDB_cond_pmc
) {
1424 /* TT #1259: Need to figure out what to do in this case.
1425 * For the time being, we just bail. */
1426 Parrot_io_eprintf(interp
->pdb
->debugger
, "Can't compare PMC with constant\n");
1427 mem_gc_free(interp
, condition
);
1438 =item C<void PDB_watchpoint(PARROT_INTERP, const char *command)>
1447 PDB_watchpoint(PARROT_INTERP
, ARGIN(const char *command
))
1449 ASSERT_ARGS(PDB_watchpoint
)
1450 PDB_t
* const pdb
= interp
->pdb
;
1451 PDB_condition_t
* const condition
= PDB_cond(interp
, command
);
1456 /* Add it to the head of the list */
1457 if (pdb
->watchpoint
)
1458 condition
->next
= pdb
->watchpoint
;
1459 pdb
->watchpoint
= condition
;
1460 fprintf(stderr
, "Adding watchpoint\n");
1465 =item C<void PDB_set_break(PARROT_INTERP, const char *command)>
1467 Set a break point, the source code file must be loaded.
1474 PDB_set_break(PARROT_INTERP
, ARGIN_NULLOK(const char *command
))
1476 ASSERT_ARGS(PDB_set_break
)
1477 PDB_t
* const pdb
= interp
->pdb
;
1478 PDB_breakpoint_t
*newbreak
;
1479 PDB_breakpoint_t
**lbreak
;
1480 PDB_line_t
*line
= NULL
;
1482 opcode_t
*breakpos
= NULL
;
1484 unsigned long ln
= get_ulong(& command
, 0);
1486 TRACEDEB_MSG("PDB_set_break");
1488 /* If there is a source file use line number, else opcode position */
1490 if (pdb
->file
&& pdb
->file
->size
) {
1491 TRACEDEB_MSG("PDB_set_break file");
1493 /* If no line number was specified, set it at the current line */
1497 /* Move to the line where we will set the break point */
1498 line
= pdb
->file
->line
;
1500 for (i
= 1; ((i
< ln
) && (line
->next
)); ++i
)
1503 /* Abort if the line number provided doesn't exist */
1504 if (line
== NULL
|| !line
->next
) {
1505 Parrot_io_eprintf(pdb
->debugger
,
1506 "Can't set a breakpoint at line number %li\n", ln
);
1511 /* Get the line to set it */
1512 line
= pdb
->file
->line
;
1514 TRACEDEB_MSG("PDB_set_break reading ops");
1515 while (line
->opcode
!= pdb
->cur_opcode
) {
1518 Parrot_io_eprintf(pdb
->debugger
,
1519 "No current line found and no line number specified\n");
1524 /* Skip lines that are not related to an opcode */
1525 while (line
&& !line
->opcode
)
1527 /* Abort if the line number provided doesn't exist */
1529 Parrot_io_eprintf(pdb
->debugger
,
1530 "Can't set a breakpoint at line number %li\n", ln
);
1534 breakpos
= line
->opcode
;
1537 TRACEDEB_MSG("PDB_set_break no file");
1538 breakpos
= interp
->code
->base
.data
+ ln
;
1541 TRACEDEB_MSG("PDB_set_break allocate breakpoint");
1542 /* Allocate the new break point */
1543 newbreak
= mem_gc_allocate_zeroed_typed(interp
, PDB_breakpoint_t
);
1546 Parrot_ex_throw_from_c_args(interp
, NULL
, 1,
1547 "NULL command passed to PDB_set_break");
1550 /* if there is another argument to break, besides the line number,
1551 * it should be an 'if', so we call another handler. */
1552 if (command
&& *command
) {
1553 command
= skip_whitespace(command
);
1554 while (! isspace((unsigned char)*command
))
1556 command
= skip_whitespace(command
);
1557 newbreak
->condition
= PDB_cond(interp
, command
);
1560 /* Set the address where to stop */
1561 newbreak
->pc
= breakpos
;
1563 /* No next breakpoint */
1564 newbreak
->next
= NULL
;
1566 /* Don't skip (at least initially) */
1569 /* Add the breakpoint to the end of the list */
1571 lbreak
= & pdb
->breakpoint
;
1573 bp_id
= (*lbreak
)->id
+ 1;
1574 lbreak
= & (*lbreak
)->next
;
1576 newbreak
->prev
= *lbreak
;
1578 newbreak
->id
= bp_id
;
1580 /* Show breakpoint position */
1582 Parrot_io_eprintf(pdb
->debugger
, "Breakpoint %li at", newbreak
->id
);
1584 Parrot_io_eprintf(pdb
->debugger
, " line %li", line
->number
);
1585 Parrot_io_eprintf(pdb
->debugger
, " pos %li\n", newbreak
->pc
- interp
->code
->base
.data
);
1590 =item C<static void list_breakpoints(PDB_t *pdb)>
1592 Print all breakpoints for this debugger session to C<pdb->debugger>.
1599 list_breakpoints(ARGIN(PDB_t
*pdb
))
1601 ASSERT_ARGS(list_breakpoints
)
1603 PDB_breakpoint_t
**lbreak
;
1604 for (lbreak
= & pdb
->breakpoint
; *lbreak
; lbreak
= & (*lbreak
)->next
) {
1605 PDB_breakpoint_t
*br
= *lbreak
;
1606 Parrot_io_eprintf(pdb
->debugger
, "Breakpoint %li at", br
->id
);
1607 Parrot_io_eprintf(pdb
->debugger
, " pos %li", br
->pc
- pdb
->debugee
->code
->base
.data
);
1609 Parrot_io_eprintf(pdb
->debugger
, " (disabled)");
1610 Parrot_io_eprintf(pdb
->debugger
, "\n");
1616 =item C<void PDB_init(PARROT_INTERP, const char *command)>
1625 PDB_init(PARROT_INTERP
, SHIM(const char *command
))
1627 ASSERT_ARGS(PDB_init
)
1628 PDB_t
* const pdb
= interp
->pdb
;
1630 /* Restart if we are already running */
1631 if (pdb
->state
& PDB_RUNNING
)
1632 Parrot_io_eprintf(pdb
->debugger
, "Restarting\n");
1634 /* Add the RUNNING state */
1635 pdb
->state
|= PDB_RUNNING
;
1640 =item C<void PDB_continue(PARROT_INTERP, const char *command)>
1642 Continue running the program. If a number is specified, skip that many
1650 PDB_continue(PARROT_INTERP
, ARGIN_NULLOK(const char *command
))
1652 ASSERT_ARGS(PDB_continue
)
1653 PDB_t
* const pdb
= interp
->pdb
;
1654 unsigned long ln
= 0;
1656 TRACEDEB_MSG("PDB_continue");
1658 /* Skip any breakpoint? */
1660 ln
= get_ulong(& command
, 0);
1663 if (!pdb
->breakpoint
) {
1664 Parrot_io_eprintf(pdb
->debugger
, "No breakpoints to skip\n");
1668 PDB_skip_breakpoint(interp
, ln
);
1671 pdb
->state
|= PDB_RUNNING
;
1672 pdb
->state
&= ~PDB_BREAK
;
1673 pdb
->state
&= ~PDB_STOPPED
;
1678 =item C<PDB_breakpoint_t * PDB_find_breakpoint(PARROT_INTERP, const char
1681 Find breakpoint number N; returns C<NULL> if the breakpoint doesn't
1682 exist or if no breakpoint was specified.
1688 PARROT_CAN_RETURN_NULL
1689 PARROT_WARN_UNUSED_RESULT
1691 PDB_find_breakpoint(PARROT_INTERP
, ARGIN(const char *command
))
1693 ASSERT_ARGS(PDB_find_breakpoint
)
1694 const char *oldcmd
= command
;
1695 const unsigned long n
= get_ulong(&command
, 0);
1696 if (command
!= oldcmd
) {
1697 PDB_breakpoint_t
*breakpoint
= interp
->pdb
->breakpoint
;
1699 while (breakpoint
&& breakpoint
->id
!= n
)
1700 breakpoint
= breakpoint
->next
;
1703 Parrot_io_eprintf(interp
->pdb
->debugger
, "No breakpoint number %ld", n
);
1710 /* Report an appropriate error */
1712 Parrot_io_eprintf(interp
->pdb
->debugger
, "Not a valid breakpoint");
1714 Parrot_io_eprintf(interp
->pdb
->debugger
, "No breakpoint specified");
1722 =item C<void PDB_disable_breakpoint(PARROT_INTERP, const char *command)>
1724 Disable a breakpoint; it can be reenabled with the enable command.
1731 PDB_disable_breakpoint(PARROT_INTERP
, ARGIN(const char *command
))
1733 ASSERT_ARGS(PDB_disable_breakpoint
)
1734 PDB_breakpoint_t
* const breakpoint
= PDB_find_breakpoint(interp
, command
);
1736 /* if the breakpoint exists, disable it. */
1738 breakpoint
->skip
= -1;
1743 =item C<void PDB_enable_breakpoint(PARROT_INTERP, const char *command)>
1745 Reenable a disabled breakpoint; if the breakpoint was not disabled, has
1753 PDB_enable_breakpoint(PARROT_INTERP
, ARGIN(const char *command
))
1755 ASSERT_ARGS(PDB_enable_breakpoint
)
1756 PDB_breakpoint_t
* const breakpoint
= PDB_find_breakpoint(interp
, command
);
1758 /* if the breakpoint exists, and it was disabled, enable it. */
1759 if (breakpoint
&& breakpoint
->skip
== -1)
1760 breakpoint
->skip
= 0;
1765 =item C<void PDB_delete_breakpoint(PARROT_INTERP, const char *command)>
1767 Delete a breakpoint.
1774 PDB_delete_breakpoint(PARROT_INTERP
, ARGIN(const char *command
))
1776 ASSERT_ARGS(PDB_delete_breakpoint
)
1777 PDB_breakpoint_t
* const breakpoint
= PDB_find_breakpoint(interp
, command
);
1778 const PDB_line_t
*line
;
1782 if (!interp
->pdb
->file
)
1783 Parrot_ex_throw_from_c_args(interp
, NULL
, 0, "No file loaded");
1785 line
= interp
->pdb
->file
->line
;
1786 while (line
->opcode
!= breakpoint
->pc
)
1789 /* Delete the condition structure, if there is one */
1790 if (breakpoint
->condition
) {
1791 PDB_delete_condition(interp
, breakpoint
);
1792 breakpoint
->condition
= NULL
;
1795 /* Remove the breakpoint from the list */
1796 if (breakpoint
->prev
&& breakpoint
->next
) {
1797 breakpoint
->prev
->next
= breakpoint
->next
;
1798 breakpoint
->next
->prev
= breakpoint
->prev
;
1800 else if (breakpoint
->prev
&& !breakpoint
->next
) {
1801 breakpoint
->prev
->next
= NULL
;
1803 else if (!breakpoint
->prev
&& breakpoint
->next
) {
1804 breakpoint
->next
->prev
= NULL
;
1805 interp
->pdb
->breakpoint
= breakpoint
->next
;
1808 interp
->pdb
->breakpoint
= NULL
;
1810 bp_id
= breakpoint
->id
;
1811 /* Kill the breakpoint */
1812 mem_gc_free(interp
, breakpoint
);
1814 Parrot_io_eprintf(interp
->pdb
->debugger
, "Breakpoint %li deleted\n", bp_id
);
1820 =item C<void PDB_delete_condition(PARROT_INTERP, PDB_breakpoint_t *breakpoint)>
1822 Delete a condition associated with a breakpoint.
1829 PDB_delete_condition(PARROT_INTERP
, ARGMOD(PDB_breakpoint_t
*breakpoint
))
1831 ASSERT_ARGS(PDB_delete_condition
)
1832 if (breakpoint
->condition
->value
) {
1833 if (breakpoint
->condition
->type
& PDB_cond_str
) {
1834 /* 'value' is a string, so we need to be careful */
1835 PObj_external_CLEAR((STRING
*)breakpoint
->condition
->value
);
1836 PObj_on_free_list_SET((STRING
*)breakpoint
->condition
->value
);
1837 /* it should now be properly garbage collected after
1838 we destroy the condition */
1841 /* 'value' is a float or an int, so we can just free it */
1842 mem_gc_free(interp
, breakpoint
->condition
->value
);
1843 breakpoint
->condition
->value
= NULL
;
1847 mem_gc_free(interp
, breakpoint
->condition
);
1848 breakpoint
->condition
= NULL
;
1853 =item C<void PDB_skip_breakpoint(PARROT_INTERP, unsigned long i)>
1855 Skip C<i> times all breakpoints.
1862 PDB_skip_breakpoint(PARROT_INTERP
, unsigned long i
)
1864 ASSERT_ARGS(PDB_skip_breakpoint
)
1866 fprintf(stderr
, "PDB_skip_breakpoint: %li\n", i
);
1869 interp
->pdb
->breakpoint_skip
= i
;
1874 =item C<char PDB_program_end(PARROT_INTERP)>
1883 PDB_program_end(PARROT_INTERP
)
1885 ASSERT_ARGS(PDB_program_end
)
1886 PDB_t
* const pdb
= interp
->pdb
;
1888 TRACEDEB_MSG("PDB_program_end");
1890 /* Remove the RUNNING state */
1891 pdb
->state
&= ~PDB_RUNNING
;
1893 Parrot_io_eprintf(pdb
->debugger
, "Program exited.\n");
1899 =item C<char PDB_check_condition(PARROT_INTERP, const PDB_condition_t
1902 Returns true if the condition was met.
1908 PARROT_WARN_UNUSED_RESULT
1910 PDB_check_condition(PARROT_INTERP
, ARGIN(const PDB_condition_t
*condition
))
1912 ASSERT_ARGS(PDB_check_condition
)
1913 PMC
* const ctx
= CURRENT_CONTEXT(interp
);
1915 TRACEDEB_MSG("PDB_check_condition");
1919 if (condition
->type
& PDB_cond_int
) {
1921 if (condition
->reg
>= Parrot_pcc_get_regs_used(interp
, ctx
, REGNO_INT
))
1923 i
= CTX_REG_INT(ctx
, condition
->reg
);
1925 if (condition
->type
& PDB_cond_const
)
1926 j
= *(INTVAL
*)condition
->value
;
1928 j
= REG_INT(interp
, *(int *)condition
->value
);
1930 if (((condition
->type
& PDB_cond_gt
) && (i
> j
)) ||
1931 ((condition
->type
& PDB_cond_ge
) && (i
>= j
)) ||
1932 ((condition
->type
& PDB_cond_eq
) && (i
== j
)) ||
1933 ((condition
->type
& PDB_cond_ne
) && (i
!= j
)) ||
1934 ((condition
->type
& PDB_cond_le
) && (i
<= j
)) ||
1935 ((condition
->type
& PDB_cond_lt
) && (i
< j
)))
1940 else if (condition
->type
& PDB_cond_num
) {
1943 if (condition
->reg
>= Parrot_pcc_get_regs_used(interp
, ctx
, REGNO_NUM
))
1945 k
= CTX_REG_NUM(ctx
, condition
->reg
);
1947 if (condition
->type
& PDB_cond_const
)
1948 l
= *(FLOATVAL
*)condition
->value
;
1950 l
= REG_NUM(interp
, *(int *)condition
->value
);
1952 if (((condition
->type
& PDB_cond_gt
) && (k
> l
)) ||
1953 ((condition
->type
& PDB_cond_ge
) && (k
>= l
)) ||
1954 ((condition
->type
& PDB_cond_eq
) && (k
== l
)) ||
1955 ((condition
->type
& PDB_cond_ne
) && (k
!= l
)) ||
1956 ((condition
->type
& PDB_cond_le
) && (k
<= l
)) ||
1957 ((condition
->type
& PDB_cond_lt
) && (k
< l
)))
1962 else if (condition
->type
& PDB_cond_str
) {
1965 if (condition
->reg
>= Parrot_pcc_get_regs_used(interp
, ctx
, REGNO_STR
))
1967 m
= CTX_REG_STR(ctx
, condition
->reg
);
1969 if (condition
->type
& PDB_cond_notnull
)
1970 return ! STRING_IS_NULL(m
);
1972 if (condition
->type
& PDB_cond_const
)
1973 n
= (STRING
*)condition
->value
;
1975 n
= REG_STR(interp
, *(int *)condition
->value
);
1977 if (((condition
->type
& PDB_cond_gt
) &&
1978 (Parrot_str_compare(interp
, m
, n
) > 0)) ||
1979 ((condition
->type
& PDB_cond_ge
) &&
1980 (Parrot_str_compare(interp
, m
, n
) >= 0)) ||
1981 ((condition
->type
& PDB_cond_eq
) &&
1982 (Parrot_str_compare(interp
, m
, n
) == 0)) ||
1983 ((condition
->type
& PDB_cond_ne
) &&
1984 (Parrot_str_compare(interp
, m
, n
) != 0)) ||
1985 ((condition
->type
& PDB_cond_le
) &&
1986 (Parrot_str_compare(interp
, m
, n
) <= 0)) ||
1987 ((condition
->type
& PDB_cond_lt
) &&
1988 (Parrot_str_compare(interp
, m
, n
) < 0)))
1993 else if (condition
->type
& PDB_cond_pmc
) {
1996 if (condition
->reg
>= Parrot_pcc_get_regs_used(interp
, ctx
, REGNO_PMC
))
1998 m
= CTX_REG_PMC(ctx
, condition
->reg
);
2000 if (condition
->type
& PDB_cond_notnull
)
2001 return ! PMC_IS_NULL(m
);
2010 =item C<static PDB_breakpoint_t * current_breakpoint(PDB_t * pdb)>
2012 Returns a pointer to the breakpoint at the current position,
2013 or NULL if there is none.
2019 PARROT_CAN_RETURN_NULL
2020 static PDB_breakpoint_t
*
2021 current_breakpoint(ARGIN(PDB_t
* pdb
))
2023 ASSERT_ARGS(current_breakpoint
)
2024 PDB_breakpoint_t
*breakpoint
= pdb
->breakpoint
;
2025 while (breakpoint
) {
2026 if (pdb
->cur_opcode
== breakpoint
->pc
)
2028 breakpoint
= breakpoint
->next
;
2035 =item C<char PDB_break(PARROT_INTERP)>
2037 Returns true if we have to stop running.
2043 PARROT_WARN_UNUSED_RESULT
2045 PDB_break(PARROT_INTERP
)
2047 ASSERT_ARGS(PDB_break
)
2048 PDB_t
* const pdb
= interp
->pdb
;
2049 PDB_condition_t
*watchpoint
= pdb
->watchpoint
;
2050 PDB_breakpoint_t
*breakpoint
;
2053 TRACEDEB_MSG("PDB_break");
2056 /* Check the watchpoints first. */
2057 while (watchpoint
) {
2058 if (PDB_check_condition(interp
, watchpoint
)) {
2059 pdb
->state
|= PDB_STOPPED
;
2063 watchpoint
= watchpoint
->next
;
2066 /* If program ended */
2067 if (!pdb
->cur_opcode
)
2068 return PDB_program_end(interp
);
2070 /* If the program is STOPPED allow it to continue */
2071 if (pdb
->state
& PDB_STOPPED
) {
2072 pdb
->state
&= ~PDB_STOPPED
;
2076 breakpoint
= current_breakpoint(pdb
);
2078 /* If we have to skip breakpoints, do so. */
2079 if (pdb
->breakpoint_skip
) {
2080 TRACEDEB_MSG("PDB_break skipping");
2081 --pdb
->breakpoint_skip
;
2085 if (breakpoint
->skip
< 0)
2088 /* Check if there is a condition for this breakpoint */
2089 if ((breakpoint
->condition
) &&
2090 (!PDB_check_condition(interp
, breakpoint
->condition
)))
2093 TRACEDEB_MSG("PDB_break stopping");
2095 /* Add the STOPPED state and stop */
2096 pdb
->state
|= PDB_STOPPED
;
2105 =item C<char * PDB_escape(PARROT_INTERP, const char *string, UINTVAL length)>
2107 Escapes C<">, C<\r>, C<\n>, C<\t>, C<\a> and C<\\>.
2109 The returned string must be freed.
2115 PARROT_WARN_UNUSED_RESULT
2116 PARROT_CAN_RETURN_NULL
2119 PDB_escape(PARROT_INTERP
, ARGIN(const char *string
), UINTVAL length
)
2121 ASSERT_ARGS(PDB_escape
)
2125 length
= length
> 20 ? 20 : length
;
2126 end
= string
+ length
;
2128 /* Return if there is no string to escape*/
2132 fill
= _new
= mem_gc_allocate_n_typed(interp
, length
* 2 + 1, char);
2134 for (; string
< end
; ++string
) {
2165 /* Hide non-ascii chars that may come from utf8 or latin-1
2166 * strings in constant strings.
2167 * Workaround for TT #1557
2169 if ((unsigned char)*string
> 127)
2172 *(fill
++) = *string
;
2184 =item C<int PDB_unescape(char *string)>
2186 Do inplace unescape of C<\r>, C<\n>, C<\t>, C<\a> and C<\\>.
2193 PDB_unescape(ARGMOD(char *string
))
2195 ASSERT_ARGS(PDB_unescape
)
2198 for (; *string
; ++string
) {
2201 if (*string
== '\\') {
2205 switch (string
[1]) {
2227 for (i
= 1; fill
[i
+ 1]; ++i
)
2228 fill
[i
] = fill
[i
+ 1];
2239 =item C<size_t PDB_disassemble_op(PARROT_INTERP, char *dest, size_t space, const
2240 op_info_t *info, const opcode_t *op, PDB_file_t *file, const opcode_t
2241 *code_start, int full_name)>
2250 PDB_disassemble_op(PARROT_INTERP
, ARGOUT(char *dest
), size_t space
,
2251 ARGIN(const op_info_t
*info
), ARGIN(const opcode_t
*op
),
2252 ARGMOD_NULLOK(PDB_file_t
*file
), ARGIN_NULLOK(const opcode_t
*code_start
),
2255 ASSERT_ARGS(PDB_disassemble_op
)
2260 /* Write the opcode name */
2261 const char * p
= full_name
? info
->full_name
: info
->name
;
2263 TRACEDEB_MSG("PDB_disassemble_op");
2272 /* Concat the arguments */
2273 for (j
= 1; j
< info
->op_count
; ++j
) {
2277 PARROT_ASSERT(size
+ 2 < space
);
2279 switch (info
->types
[j
- 1]) {
2293 /* If the opcode jumps and this is the last argument,
2294 that means this is a label */
2295 if ((j
== info
->op_count
- 1) &&
2296 (info
->jump
& PARROT_JUMP_RELATIVE
)) {
2299 i
= PDB_add_label(interp
, file
, op
, op
[j
]);
2301 else if (code_start
) {
2304 i
= op
[j
] + (op
- code_start
);
2313 /* Convert the integer to a string */
2318 PARROT_ASSERT(size
+ 20 < space
);
2320 size
+= sprintf(&dest
[size
], INTVAL_FMT
, i
);
2325 /* Convert the float to a string */
2326 const FLOATVAL f
= interp
->code
->const_table
->constants
[op
[j
]]->u
.number
;
2327 Parrot_snprintf(interp
, buf
, sizeof (buf
), FLOATVAL_FMT
, f
);
2328 strcpy(&dest
[size
], buf
);
2329 size
+= strlen(buf
);
2334 if (interp
->code
->const_table
->constants
[op
[j
]]-> u
.string
->strlen
) {
2335 char * const unescaped
=
2336 Parrot_str_to_cstring(interp
, interp
->code
->
2337 const_table
->constants
[op
[j
]]->u
.string
);
2338 char * const escaped
=
2339 PDB_escape(interp
, unescaped
, interp
->code
->const_table
->
2340 constants
[op
[j
]]->u
.string
->strlen
);
2342 strcpy(&dest
[size
], escaped
);
2343 size
+= strlen(escaped
);
2344 mem_gc_free(interp
, escaped
);
2346 Parrot_str_free_cstring(unescaped
);
2351 Parrot_snprintf(interp
, buf
, sizeof (buf
), "PMC_CONST(%d)", op
[j
]);
2352 strcpy(&dest
[size
], buf
);
2353 size
+= strlen(buf
);
2356 dest
[size
- 1] = '[';
2357 Parrot_snprintf(interp
, buf
, sizeof (buf
), "P" INTVAL_FMT
, op
[j
]);
2358 strcpy(&dest
[size
], buf
);
2359 size
+= strlen(buf
);
2364 PMC
* k
= interp
->code
->const_table
->constants
[op
[j
]]->u
.key
;
2365 dest
[size
- 1] = '[';
2367 switch (PObj_get_FLAGS(k
)) {
2370 case KEY_integer_FLAG
:
2371 Parrot_snprintf(interp
, buf
, sizeof (buf
),
2372 INTVAL_FMT
, VTABLE_get_integer(interp
, k
));
2373 strcpy(&dest
[size
], buf
);
2374 size
+= strlen(buf
);
2376 case KEY_number_FLAG
:
2377 Parrot_snprintf(interp
, buf
, sizeof (buf
),
2378 FLOATVAL_FMT
, VTABLE_get_number(interp
, k
));
2379 strcpy(&dest
[size
], buf
);
2380 size
+= strlen(buf
);
2382 case KEY_string_FLAG
:
2385 char * const temp
= Parrot_str_to_cstring(interp
,
2386 VTABLE_get_string(interp
, k
));
2387 strcpy(&dest
[size
], temp
);
2388 Parrot_str_free_cstring(temp
);
2390 size
+= Parrot_str_byte_length(interp
,
2391 VTABLE_get_string(interp
, (k
)));
2394 case KEY_integer_FLAG
|KEY_register_FLAG
:
2395 Parrot_snprintf(interp
, buf
, sizeof (buf
),
2396 "I" INTVAL_FMT
, VTABLE_get_integer(interp
, k
));
2397 strcpy(&dest
[size
], buf
);
2398 size
+= strlen(buf
);
2400 case KEY_number_FLAG
|KEY_register_FLAG
:
2401 Parrot_snprintf(interp
, buf
, sizeof (buf
),
2402 "N" INTVAL_FMT
, VTABLE_get_integer(interp
, k
));
2403 strcpy(&dest
[size
], buf
);
2404 size
+= strlen(buf
);
2406 case KEY_string_FLAG
|KEY_register_FLAG
:
2407 Parrot_snprintf(interp
, buf
, sizeof (buf
),
2408 "S" INTVAL_FMT
, VTABLE_get_integer(interp
, k
));
2409 strcpy(&dest
[size
], buf
);
2410 size
+= strlen(buf
);
2412 case KEY_pmc_FLAG
|KEY_register_FLAG
:
2413 Parrot_snprintf(interp
, buf
, sizeof (buf
),
2414 "P" INTVAL_FMT
, VTABLE_get_integer(interp
, k
));
2415 strcpy(&dest
[size
], buf
);
2416 size
+= strlen(buf
);
2422 GETATTR_Key_next_key(interp
, k
, k
);
2430 dest
[size
- 1] = '[';
2431 Parrot_snprintf(interp
, buf
, sizeof (buf
), "I" INTVAL_FMT
, op
[j
]);
2432 strcpy(&dest
[size
], buf
);
2433 size
+= strlen(buf
);
2436 case PARROT_ARG_KIC
:
2437 dest
[size
- 1] = '[';
2438 Parrot_snprintf(interp
, buf
, sizeof (buf
), INTVAL_FMT
, op
[j
]);
2439 strcpy(&dest
[size
], buf
);
2440 size
+= strlen(buf
);
2444 Parrot_ex_throw_from_c_args(interp
, NULL
, 1, "Unknown opcode type");
2447 if (j
!= info
->op_count
- 1)
2451 /* Special decoding for the signature used in args/returns. Such ops have
2452 one fixed parameter (the signature vector), plus a varying number of
2453 registers/constants. For each arg/return, we show the register and its
2454 flags using PIR syntax. */
2455 if (*(op
) == PARROT_OP_set_args_pc
|| *(op
) == PARROT_OP_set_returns_pc
)
2458 /* if it's a retrieving op, specialop = 2, so that later a :flat flag
2459 * can be changed into a :slurpy flag. See flag handling below.
2461 if (*(op
) == PARROT_OP_get_results_pc
|| *(op
) == PARROT_OP_get_params_pc
)
2464 if (specialop
> 0) {
2466 PMC
* const sig
= interp
->code
->const_table
->constants
[op
[1]]->u
.key
;
2467 const int n_values
= VTABLE_elements(interp
, sig
);
2468 /* The flag_names strings come from Call_bits_enum_t (with which it
2469 should probably be colocated); they name the bits from LSB to MSB.
2470 The two least significant bits are not flags; they are the register
2471 type, which is decoded elsewhere. We also want to show unused bits,
2472 which could indicate problems.
2474 PARROT_OBSERVER
const char * const flag_names
[] = {
2480 " :flat", /* should be :slurpy for args */
2488 /* Register decoding. It would be good to abstract this, too. */
2489 PARROT_OBSERVER
static const char regs
[] = "ISPN";
2491 for (j
= 0; j
< n_values
; ++j
) {
2493 const int sig_value
= VTABLE_get_integer_keyed_int(interp
, sig
, j
);
2495 /* Print the register name, e.g. P37. */
2498 buf
[idx
++] = regs
[sig_value
& PARROT_ARG_TYPE_MASK
];
2499 Parrot_snprintf(interp
, &buf
[idx
], sizeof (buf
)-idx
,
2500 INTVAL_FMT
, op
[j
+2]);
2503 /* Add flags, if we have any. */
2505 unsigned int flag_idx
= 0;
2506 int flags
= sig_value
;
2508 /* End when we run out of flags, off the end of flag_names, or
2509 * get too close to the end of buf.
2510 * 100 is just an estimate of all buf lengths added together.
2512 while (flags
&& idx
< sizeof (buf
) - 100) {
2513 const char * const flag_string
=
2514 flag_idx
< (sizeof flag_names
/ sizeof (char *))
2515 ? (specialop
== 2 && STREQ(flag_names
[flag_idx
], " :flat"))
2517 : flag_names
[flag_idx
]
2518 : (const char *) NULL
;
2522 if (flags
& 1 && *flag_string
) {
2523 const size_t n
= strlen(flag_string
);
2524 strcpy(&buf
[idx
], flag_string
);
2532 /* Add it to dest. */
2534 strcpy(&dest
[size
], buf
);
2535 size
+= strlen(buf
);
2545 =item C<void PDB_disassemble(PARROT_INTERP, const char *command)>
2547 Disassemble the bytecode.
2554 PDB_disassemble(PARROT_INTERP
, SHIM(const char *command
))
2556 ASSERT_ARGS(PDB_disassemble
)
2557 PDB_t
* const pdb
= interp
->pdb
;
2558 opcode_t
* pc
= interp
->code
->base
.data
;
2561 PDB_line_t
*pline
, *newline
;
2565 const unsigned int default_size
= 32768;
2566 size_t space
; /* How much space do we have? */
2567 size_t size
, alloced
, n
;
2569 TRACEDEB_MSG("PDB_disassemble");
2571 pfile
= mem_gc_allocate_zeroed_typed(interp
, PDB_file_t
);
2572 pline
= mem_gc_allocate_zeroed_typed(interp
, PDB_line_t
);
2574 /* If we already got a source, free it */
2576 PDB_free_file(interp
, pdb
->file
);
2580 pfile
->line
= pline
;
2582 pfile
->source
= mem_gc_allocate_n_typed(interp
, default_size
, char);
2584 alloced
= space
= default_size
;
2585 code_end
= pc
+ interp
->code
->base
.size
;
2587 while (pc
!= code_end
) {
2589 if (space
< default_size
) {
2590 alloced
+= default_size
;
2591 space
+= default_size
;
2592 pfile
->source
= mem_gc_realloc_n_typed(interp
, pfile
->source
, alloced
, char);
2595 size
= PDB_disassemble_op(interp
, pfile
->source
+ pfile
->size
,
2596 space
, &interp
->op_info_table
[*pc
], pc
, pfile
, NULL
, 1);
2598 pfile
->size
+= size
;
2599 pfile
->source
[pfile
->size
- 1] = '\n';
2601 /* Store the opcode of this line */
2603 n
= interp
->op_info_table
[*pc
].op_count
;
2605 ADD_OP_VAR_PART(interp
, interp
->code
, pc
, n
);
2608 /* Prepare for next line */
2609 newline
= mem_gc_allocate_zeroed_typed(interp
, PDB_line_t
);
2610 newline
->label
= NULL
;
2611 newline
->next
= NULL
;
2612 newline
->number
= pline
->number
+ 1;
2613 pline
->next
= newline
;
2615 pline
->source_offset
= pfile
->size
;
2618 /* Add labels to the lines they belong to */
2619 label
= pfile
->label
;
2622 /* Get the line to apply the label */
2623 pline
= pfile
->line
;
2625 while (pline
&& pline
->opcode
!= label
->opcode
)
2626 pline
= pline
->next
;
2629 Parrot_io_eprintf(pdb
->debugger
,
2630 "Label number %li out of bounds.\n", label
->number
);
2632 PDB_free_file(interp
, pfile
);
2636 pline
->label
= label
;
2638 label
= label
->next
;
2641 pdb
->state
|= PDB_SRC_LOADED
;
2647 =item C<long PDB_add_label(PARROT_INTERP, PDB_file_t *file, const opcode_t
2648 *cur_opcode, opcode_t offset)>
2650 Add a label to the label list.
2657 PDB_add_label(PARROT_INTERP
, ARGMOD(PDB_file_t
*file
),
2658 ARGIN(const opcode_t
*cur_opcode
),
2661 ASSERT_ARGS(PDB_add_label
)
2663 PDB_label_t
*label
= file
->label
;
2665 /* See if there is already a label at this line */
2667 if (label
->opcode
== cur_opcode
+ offset
)
2668 return label
->number
;
2669 label
= label
->next
;
2672 /* Allocate a new label */
2673 label
= file
->label
;
2674 _new
= mem_gc_allocate_zeroed_typed(interp
, PDB_label_t
);
2675 _new
->opcode
= cur_opcode
+ offset
;
2680 label
= label
->next
;
2682 _new
->number
= label
->number
+ 1;
2690 return _new
->number
;
2695 =item C<void PDB_free_file(PARROT_INTERP, PDB_file_t *file)>
2697 Frees any allocated source files.
2704 PDB_free_file(PARROT_INTERP
, ARGIN_NULLOK(PDB_file_t
*file
))
2706 ASSERT_ARGS(PDB_free_file
)
2708 /* Free all of the allocated line structures */
2709 PDB_line_t
*line
= file
->line
;
2714 PDB_line_t
* const nline
= line
->next
;
2715 mem_gc_free(interp
, line
);
2719 /* Free all of the allocated label structures */
2720 label
= file
->label
;
2723 PDB_label_t
* const nlabel
= label
->next
;
2725 mem_gc_free(interp
, label
);
2729 /* Free the remaining allocated portions of the file structure */
2730 if (file
->sourcefilename
)
2731 mem_gc_free(interp
, file
->sourcefilename
);
2734 mem_gc_free(interp
, file
->source
);
2737 mem_gc_free(interp
, file
);
2744 =item C<void PDB_load_source(PARROT_INTERP, const char *command)>
2746 Load a source code file.
2754 PDB_load_source(PARROT_INTERP
, ARGIN(const char *command
))
2756 ASSERT_ARGS(PDB_load_source
)
2758 char f
[DEBUG_CMD_BUFFER_LENGTH
+ 1];
2762 PDB_t
* const pdb
= interp
->pdb
;
2763 opcode_t
*pc
= interp
->code
->base
.data
;
2765 unsigned long size
= 0;
2767 TRACEDEB_MSG("PDB_load_source");
2769 /* If there was a file already loaded or the bytecode was
2770 disassembled, free it */
2772 PDB_free_file(interp
->pdb
->debugee
, interp
->pdb
->debugee
->pdb
->file
);
2773 interp
->pdb
->debugee
->pdb
->file
= NULL
;
2776 /* Get the name of the file */
2777 for (j
= 0; command
[j
] == ' '; ++j
)
2779 for (i
= 0; command
[j
]; ++i
, ++j
)
2785 file
= fopen(f
, "r");
2787 /* abort if fopen failed */
2789 Parrot_io_eprintf(pdb
->debugger
, "Unable to load '%s'\n", f
);
2793 pfile
= mem_gc_allocate_zeroed_typed(interp
, PDB_file_t
);
2794 pline
= mem_gc_allocate_zeroed_typed(interp
, PDB_line_t
);
2796 pfile
->source
= mem_gc_allocate_n_typed(interp
, 1024, char);
2797 pfile
->line
= pline
;
2800 PARROT_ASSERT(interp
->op_info_table
);
2803 while ((c
= fgetc(file
)) != EOF
) {
2805 if (++size
== 1024) {
2806 pfile
->source
= mem_gc_realloc_n_typed(interp
, pfile
->source
,
2807 (size_t)pfile
->size
+ 1024, char);
2810 pfile
->source
[pfile
->size
] = (char)c
;
2815 /* If the line has an opcode move to the next one,
2816 otherwise leave it with NULL to skip it. */
2817 PDB_line_t
*newline
= mem_gc_allocate_zeroed_typed(interp
, PDB_line_t
);
2819 if (PDB_hasinstruction(pfile
->source
+ pline
->source_offset
)) {
2820 size_t n
= interp
->op_info_table
[*pc
].op_count
;
2822 ADD_OP_VAR_PART(interp
, interp
->code
, pc
, n
);
2825 /* don't walk off the end of the program into neverland */
2826 if (pc
>= interp
->code
->base
.data
+ interp
->code
->base
.size
)
2830 newline
->number
= pline
->number
+ 1;
2831 pline
->next
= newline
;
2833 pline
->source_offset
= pfile
->size
;
2834 pline
->opcode
= NULL
;
2835 pline
->label
= NULL
;
2841 pdb
->state
|= PDB_SRC_LOADED
;
2844 TRACEDEB_MSG("PDB_load_source finished");
2849 =item C<char PDB_hasinstruction(const char *c)>
2851 Return true if the line has an instruction.
2857 PARROT_WARN_UNUSED_RESULT
2858 PARROT_PURE_FUNCTION
2860 PDB_hasinstruction(ARGIN(const char *c
))
2862 ASSERT_ARGS(PDB_hasinstruction
)
2865 /* as long as c is not NULL, we're not looking at a comment (#...) or a '\n'... */
2866 while (*c
&& *c
!= '#' && *c
!= '\n') {
2867 /* ... and c is alphanumeric or a quoted string then the line contains
2868 * an instruction. */
2869 if (isalnum((unsigned char) *c
) || *c
== '"') {
2872 else if (*c
== ':') {
2873 /* probably a label */
2885 =item C<static void no_such_register(PARROT_INTERP, char register_type, UINTVAL
2888 Auxiliar error message function.
2895 no_such_register(PARROT_INTERP
, char register_type
, UINTVAL register_num
)
2897 ASSERT_ARGS(no_such_register
)
2899 Parrot_io_eprintf(interp
, "%c%u = no such register\n",
2900 register_type
, register_num
);
2905 =item C<void PDB_assign(PARROT_INTERP, const char *command)>
2907 Assign to registers.
2914 PDB_assign(PARROT_INTERP
, ARGIN(const char *command
))
2916 ASSERT_ARGS(PDB_assign
)
2917 UINTVAL register_num
;
2920 PDB_t
*pdb
= interp
->pdb
;
2921 Interp
*debugger
= pdb
? pdb
->debugger
: interp
;
2922 Interp
*debugee
= pdb
? pdb
->debugee
: interp
;
2924 /* smallest valid commad length is 4, i.e. "I0 1" */
2925 if (strlen(command
) < 4) {
2926 Parrot_io_eprintf(debugger
, "Must give a register number and value to assign\n");
2929 reg_type_id
= (unsigned char) toupper((unsigned char) command
[0]);
2931 register_num
= get_ulong(&command
, 0);
2933 switch (reg_type_id
) {
2935 reg_type
= REGNO_INT
;
2938 reg_type
= REGNO_NUM
;
2941 reg_type
= REGNO_STR
;
2944 reg_type
= REGNO_PMC
;
2945 Parrot_io_eprintf(debugger
, "Assigning to PMCs is not currently supported\n");
2948 Parrot_io_eprintf(debugger
, "Invalid register type %c\n", reg_type_id
);
2951 if (register_num
>= Parrot_pcc_get_regs_used(debugee
,
2952 CURRENT_CONTEXT(debugee
), reg_type
)) {
2953 no_such_register(debugger
, reg_type_id
, register_num
);
2958 IREG(register_num
) = get_ulong(&command
, 0);
2961 NREG(register_num
) = atof(command
);
2964 SREG(register_num
) = Parrot_str_new(debugee
, command
, strlen(command
));
2967 ; /* Must never come here */
2969 Parrot_io_eprintf(debugger
, "\n %c%u = ", reg_type_id
, register_num
);
2970 Parrot_io_eprintf(debugger
, "%Ss\n", GDB_print_reg(debugee
, reg_type
, register_num
));
2975 =item C<void PDB_list(PARROT_INTERP, const char *command)>
2977 Show lines from the source code file.
2984 PDB_list(PARROT_INTERP
, ARGIN(const char *command
))
2986 ASSERT_ARGS(PDB_list
)
2988 unsigned long line_number
;
2991 PDB_t
*pdb
= interp
->pdb
;
2992 unsigned long n
= 10;
2994 TRACEDEB_MSG("PDB_list");
2995 if (!pdb
->file
|| !pdb
->file
->line
) {
2996 Parrot_io_eprintf(pdb
->debugger
, "No source file loaded\n");
3000 /* set the list line if provided */
3001 line_number
= get_ulong(&command
, 0);
3002 pdb
->file
->list_line
= (unsigned long) line_number
;
3004 /* set the number of lines to print */
3005 n
= get_ulong(&command
, 10);
3007 /* if n is zero, we simply return, as we don't have to print anything */
3011 line
= pdb
->file
->line
;
3013 for (i
= 0; i
< pdb
->file
->list_line
&& line
->next
; ++i
)
3017 while (line
->next
) {
3018 Parrot_io_eprintf(pdb
->debugger
, "%li ", pdb
->file
->list_line
+ i
);
3019 /* If it has a label print it */
3021 Parrot_io_eprintf(pdb
->debugger
, "L%li:\t", line
->label
->number
);
3023 c
= pdb
->file
->source
+ line
->source_offset
;
3026 Parrot_io_eprintf(pdb
->debugger
, "%c", *(c
++));
3028 Parrot_io_eprintf(pdb
->debugger
, "\n");
3037 pdb
->file
->list_line
= 0;
3039 pdb
->file
->list_line
+= n
;
3044 =item C<void PDB_eval(PARROT_INTERP, const char *command)>
3046 C<eval>s an instruction.
3053 PDB_eval(PARROT_INTERP
, ARGIN(const char *command
))
3055 ASSERT_ARGS(PDB_eval
)
3057 Interp
*warninterp
= (interp
->pdb
&& interp
->pdb
->debugger
) ?
3058 interp
->pdb
->debugger
: interp
;
3059 TRACEDEB_MSG("PDB_eval");
3061 Parrot_io_eprintf(warninterp
, "The eval command is currently unimplemeneted\n");
3066 =item C<void PDB_print(PARROT_INTERP, const char *command)>
3068 Print interp registers.
3076 PDB_print(PARROT_INTERP
, ARGIN(const char *command
))
3078 ASSERT_ARGS(PDB_print
)
3079 const STRING
*s
= GDB_P(interp
->pdb
->debugee
, command
);
3081 TRACEDEB_MSG("PDB_print");
3082 Parrot_io_eprintf(interp
, "%Ss\n", s
);
3088 =item C<void PDB_info(PARROT_INTERP)>
3090 Print the interpreter info.
3097 PDB_info(PARROT_INTERP
)
3099 ASSERT_ARGS(PDB_info
)
3101 /* If a debugger is created, use it for printing and use the
3102 * data in his debugee. Otherwise, use current interpreter
3104 Parrot_Interp itdeb
= interp
->pdb
? interp
->pdb
->debugger
: interp
;
3105 Parrot_Interp itp
= interp
->pdb
? interp
->pdb
->debugee
: interp
;
3107 Parrot_io_eprintf(itdeb
, "Total memory allocated = %ld\n",
3108 interpinfo(itp
, TOTAL_MEM_ALLOC
));
3109 Parrot_io_eprintf(itdeb
, "GC mark runs = %ld\n",
3110 interpinfo(itp
, GC_MARK_RUNS
));
3111 Parrot_io_eprintf(itdeb
, "Lazy gc mark runs = %ld\n",
3112 interpinfo(itp
, GC_LAZY_MARK_RUNS
));
3113 Parrot_io_eprintf(itdeb
, "GC collect runs = %ld\n",
3114 interpinfo(itp
, GC_COLLECT_RUNS
));
3115 Parrot_io_eprintf(itdeb
, "Collect memory = %ld\n",
3116 interpinfo(itp
, TOTAL_COPIED
));
3117 Parrot_io_eprintf(itdeb
, "Active PMCs = %ld\n",
3118 interpinfo(itp
, ACTIVE_PMCS
));
3119 Parrot_io_eprintf(itdeb
, "Extended PMCs = %ld\n",
3120 interpinfo(itp
, EXTENDED_PMCS
));
3121 Parrot_io_eprintf(itdeb
, "Timely GC PMCs = %ld\n",
3122 interpinfo(itp
, IMPATIENT_PMCS
));
3123 Parrot_io_eprintf(itdeb
, "Total PMCs = %ld\n",
3124 interpinfo(itp
, TOTAL_PMCS
));
3125 Parrot_io_eprintf(itdeb
, "Active buffers = %ld\n",
3126 interpinfo(itp
, ACTIVE_BUFFERS
));
3127 Parrot_io_eprintf(itdeb
, "Total buffers = %ld\n",
3128 interpinfo(itp
, TOTAL_BUFFERS
));
3129 Parrot_io_eprintf(itdeb
, "Header allocations since last collect = %ld\n",
3130 interpinfo(itp
, HEADER_ALLOCS_SINCE_COLLECT
));
3131 Parrot_io_eprintf(itdeb
, "Memory allocations since last collect = %ld\n",
3132 interpinfo(itp
, MEM_ALLOCS_SINCE_COLLECT
));
3137 =item C<void PDB_help(PARROT_INTERP, const char *command)>
3139 Print the help text. "Help" with no arguments prints a list of commands.
3140 "Help xxx" prints information on command xxx.
3147 PDB_help(PARROT_INTERP
, ARGIN(const char *command
))
3149 ASSERT_ARGS(PDB_help
)
3150 const DebuggerCmd
*cmd
;
3152 const char * cmdline
= command
;
3153 cmd
= get_cmd(& cmdline
);
3156 Parrot_io_eprintf(interp
->pdb
->debugger
, "%s\n", cmd
->help
);
3159 if (*cmdline
== '\0') {
3161 Parrot_io_eprintf(interp
->pdb
->debugger
, "List of commands:\n");
3162 for (i
= 0; i
< sizeof (DebCmdList
) / sizeof (DebuggerCmdList
); ++i
) {
3163 const DebuggerCmdList
*cmdlist
= DebCmdList
+ i
;
3164 Parrot_io_eprintf(interp
->pdb
->debugger
,
3165 " %-12s-- %s\n", cmdlist
->name
, cmdlist
->cmd
->shorthelp
);
3167 Parrot_io_eprintf(interp
->pdb
->debugger
, "\n"
3168 "Type \"help\" followed by a command name for full documentation.\n\n");
3172 Parrot_io_eprintf(interp
->pdb
->debugger
, "Unknown command: %s\n", command
);
3179 =item C<void PDB_backtrace(PARROT_INTERP)>
3181 Prints a backtrace of the interp's call chain.
3189 PDB_backtrace(PARROT_INTERP
)
3191 ASSERT_ARGS(PDB_backtrace
)
3195 int limit_count
= 0;
3197 /* information about the current sub */
3198 PMC
*sub
= interpinfo_p(interp
, CURRENT_SUB
);
3199 PMC
*ctx
= CURRENT_CONTEXT(interp
);
3201 if (!PMC_IS_NULL(sub
)) {
3202 str
= Parrot_Context_infostr(interp
, ctx
);
3204 Parrot_io_eprintf(interp
, "%Ss", str
);
3205 if (interp
->code
->annotations
) {
3206 PMC
*annot
= PackFile_Annotations_lookup(interp
, interp
->code
->annotations
,
3207 Parrot_pcc_get_pc(interp
, ctx
) - interp
->code
->base
.data
+ 1, NULL
);
3208 if (!PMC_IS_NULL(annot
)) {
3209 PMC
*pfile
= VTABLE_get_pmc_keyed_str(interp
, annot
,
3210 Parrot_str_new_constant(interp
, "file"));
3211 PMC
*pline
= VTABLE_get_pmc_keyed_str(interp
, annot
,
3212 Parrot_str_new_constant(interp
, "line"));
3213 if ((!PMC_IS_NULL(pfile
)) && (!PMC_IS_NULL(pline
))) {
3214 STRING
*file
= VTABLE_get_string(interp
, pfile
);
3215 INTVAL line
= VTABLE_get_integer(interp
, pline
);
3216 Parrot_io_eprintf(interp
, " (%Ss:%li)", file
, (long)line
);
3220 Parrot_io_eprintf(interp
, "\n");
3224 /* backtrace: follow the continuation chain */
3226 Parrot_Continuation_attributes
*sub_cont
;
3228 /* Limit the levels dumped, no segfault on infinite recursion */
3229 if (++limit_count
> RECURSION_LIMIT
)
3232 sub
= Parrot_pcc_get_continuation(interp
, ctx
);
3234 if (PMC_IS_NULL(sub
))
3238 sub_cont
= PARROT_CONTINUATION(sub
);
3244 str
= Parrot_Context_infostr(interp
, Parrot_pcc_get_caller_ctx(interp
, ctx
));
3251 /* recursion detection */
3252 if (ctx
== sub_cont
->to_ctx
) {
3255 else if (!PMC_IS_NULL(old
) && PMC_cont(old
) &&
3256 Parrot_pcc_get_pc(interp
, PMC_cont(old
)->to_ctx
) ==
3257 Parrot_pcc_get_pc(interp
, PMC_cont(sub
)->to_ctx
) &&
3258 Parrot_pcc_get_sub(interp
, PMC_cont(old
)->to_ctx
) ==
3259 Parrot_pcc_get_sub(interp
, PMC_cont(sub
)->to_ctx
)) {
3262 else if (rec_level
!= 0) {
3263 Parrot_io_eprintf(interp
, "... call repeated %d times\n", rec_level
);
3267 /* print the context description */
3268 if (rec_level
== 0) {
3269 PackFile_ByteCode
*seg
= sub_cont
->seg
;
3270 Parrot_io_eprintf(interp
, "%Ss", str
);
3271 if (seg
->annotations
) {
3272 PMC
*annot
= PackFile_Annotations_lookup(interp
, seg
->annotations
,
3273 Parrot_pcc_get_pc(interp
, sub_cont
->to_ctx
) - seg
->base
.data
,
3276 if (!PMC_IS_NULL(annot
)) {
3277 PMC
*pfile
= VTABLE_get_pmc_keyed_str(interp
, annot
,
3278 Parrot_str_new_constant(interp
, "file"));
3279 PMC
*pline
= VTABLE_get_pmc_keyed_str(interp
, annot
,
3280 Parrot_str_new_constant(interp
, "line"));
3281 if ((!PMC_IS_NULL(pfile
)) && (!PMC_IS_NULL(pline
))) {
3282 STRING
*file
= VTABLE_get_string(interp
, pfile
);
3283 INTVAL line
= VTABLE_get_integer(interp
, pline
);
3284 Parrot_io_eprintf(interp
, " (%Ss:%li)", file
, (long)line
);
3288 Parrot_io_eprintf(interp
, "\n");
3291 /* get the next Continuation */
3292 ctx
= Parrot_pcc_get_caller_ctx(interp
, ctx
);
3300 Parrot_io_eprintf(interp
, "... call repeated %d times\n", rec_level
);
3306 * GDB_P gdb> pp $I0 print register I0 value
3308 * RT46139 more, more
3313 =item C<static STRING * GDB_print_reg(PARROT_INTERP, int t, int n)>
3315 Used by GDB_P to convert register values for display. Takes register
3316 type and number as arguments.
3318 Returns a pointer to the start of the string, (except for PMCs, which
3319 print directly and return "").
3325 PARROT_WARN_UNUSED_RESULT
3326 PARROT_CANNOT_RETURN_NULL
3329 GDB_print_reg(PARROT_INTERP
, int t
, int n
)
3331 ASSERT_ARGS(GDB_print_reg
)
3334 if (n
>= 0 && (UINTVAL
)n
< Parrot_pcc_get_regs_used(interp
, CURRENT_CONTEXT(interp
), t
)) {
3337 return Parrot_str_from_int(interp
, IREG(n
));
3339 return Parrot_str_from_num(interp
, NREG(n
));
3341 /* This hack is needed because we occasionally are told
3342 that we have string registers when we actually don't */
3343 string
= (char *) SREG(n
);
3346 return Parrot_str_new(interp
, "", 0);
3350 /* prints directly */
3351 trace_pmc_dump(interp
, PREG(n
));
3352 return Parrot_str_new(interp
, "", 0);
3357 return Parrot_str_new(interp
, "no such register", 0);
3362 =item C<static STRING * GDB_P(PARROT_INTERP, const char *s)>
3364 Used by PDB_print to print register values. Takes a pointer to the
3367 Returns "" or error message.
3373 PARROT_WARN_UNUSED_RESULT
3374 PARROT_CANNOT_RETURN_NULL
3377 GDB_P(PARROT_INTERP
, ARGIN(const char *s
))
3383 TRACEDEB_MSG("GDB_P");
3384 /* Skip leading whitespace. */
3385 while (isspace((unsigned char)*s
))
3388 reg_type
= (unsigned char) toupper((unsigned char)*s
);
3391 case 'I': t
= REGNO_INT
; break;
3392 case 'N': t
= REGNO_NUM
; break;
3393 case 'S': t
= REGNO_STR
; break;
3394 case 'P': t
= REGNO_PMC
; break;
3395 default: return Parrot_str_new(interp
, "Need a register.", 0);
3398 /* Print all registers of this type. */
3399 const int max_reg
= Parrot_pcc_get_regs_used(interp
, CURRENT_CONTEXT(interp
), t
);
3402 for (n
= 0; n
< max_reg
; ++n
) {
3403 /* this must be done in two chunks because PMC's print directly. */
3404 Parrot_io_eprintf(interp
, "\n %c%d = ", reg_type
, n
);
3405 Parrot_io_eprintf(interp
, "%Ss", GDB_print_reg(interp
, t
, n
));
3407 return Parrot_str_new(interp
, "", 0);
3409 else if (s
[1] && isdigit((unsigned char)s
[1])) {
3410 const int n
= atoi(s
+ 1);
3411 return GDB_print_reg(interp
, t
, n
);
3414 return Parrot_str_new(interp
, "no such register", 0);
3424 F<include/parrot/debugger.h>, F<src/parrot_debugger.c> and F<ops/debug.ops>.
3430 =item Initial version by Daniel Grunblatt on 2002.5.19.
3432 =item Start of rewrite - leo 2005.02.16
3434 The debugger now uses its own interpreter. User code is run in
3435 Interp *debugee. We have:
3437 debug_interp->pdb->debugee->debugger
3440 +------------- := -----------+
3442 Debug commands are mostly run inside the C<debugger>. User code
3443 runs of course in the C<debugee>.
3454 * c-file-style: "parrot"
3456 * vim: expandtab shiftwidth=4: