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