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