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