?  search:
summary | log | graphiclog1 | graphiclog2 | commit | commitdiff | tree | refs | edit | fork
blame | history | raw | HEAD
[t][cage] Remove PGE-dependence from t/op/inf_nan.t since it is part of 'make coretest'
[parrot.git] / src / debug.c
blob9d2a6ad05b3bab543b4aaad6a4b80794ce30a8d8
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 else {
1167 interp->pdb->cur_opcode = (opcode_t *)cur_opcode + 1;
1168 /*PDB_set_break(interp, NULL);*/
1169 }
1170 TRACEDEB_MSG("Parrot_debugger_break done");
1171 }
1172
1173 /*
1174
1175 =item C<void PDB_get_command(PARROT_INTERP)>
1176
1177 Get a command from the user input to execute.
1178
1179 It saves the last command executed (in C<< pdb->last_command >>), so it
1180 first frees the old one and updates it with the current one.
1181
1182 Also prints the next line to run if the program is still active.
1183
1184 The user input can't be longer than DEBUG_CMD_BUFFER_LENGTH characters.
1185
1186 The input is saved in C<< pdb->cur_command >>.
1187
1188 =cut
1189
1190 */
1191
1192 void
1193 PDB_get_command(PARROT_INTERP)
1194 {
1195 ASSERT_ARGS(PDB_get_command)
1196 unsigned int i;
1197 int ch;
1198 char *c;
1199 PDB_t * const pdb = interp->pdb;
1200
1201 /***********************************
1202 **** Testing ****
1203 Do not delete yet
1204 the commented out
1205 parts
1206 ***********************************/
1207
1208 /* flush the buffered data */
1209 fflush(stdout);
1210
1211 TRACEDEB_MSG("PDB_get_command");
1212
1213 PARROT_ASSERT(pdb->last_command);
1214 PARROT_ASSERT(pdb->cur_command);
1215
1216 if (interp->pdb->script_file) {
1217 FILE *fd = interp->pdb->script_file;
1218 char buf[DEBUG_CMD_BUFFER_LENGTH+1];
1219 const char *ptr;
1220
1221 do {
1222 if (fgets(buf, DEBUG_CMD_BUFFER_LENGTH, fd) == NULL) {
1223 close_script_file(interp);
1224 return;
1225 }
1226 ++pdb->script_line;
1227 chop_newline(buf);
1228 #if TRACE_DEBUGGER
1229 fprintf(stderr, "script (%lu): '%s'\n", pdb->script_line, buf);
1230 #endif
1231
1232 /* skip spaces */
1233 ptr = skip_whitespace(buf);
1234
1235 /* skip blank and commented lines */
1236 } while (*ptr == '\0' || *ptr == '#');
1237
1238 if (pdb->state & PDB_ECHO)
1239 Parrot_io_eprintf(pdb->debugger, "[%lu %s]\n", pdb->script_line, buf);
1240
1241 #if TRACE_DEBUGGER
1242 fprintf(stderr, "(script) %s\n", buf);
1243 #endif
1244
1245 strcpy(pdb->cur_command, buf);
1246 }
1247 else {
1248
1249 /* update the last command */
1250 if (pdb->cur_command[0] != '\0')
1251 strcpy(pdb->last_command, pdb->cur_command);
1252
1253 i = 0;
1254
1255 c = pdb->cur_command;
1256
1257 /*Parrot_io_eprintf(pdb->debugger, "\n(pdb) ");*/
1258 Parrot_io_eprintf(pdb->debugger, "\n");
1259
1260 /* skip leading whitespace */
1261 /*
1262 do {
1263 ch = fgetc(stdin);
1264 } while (isspace((unsigned char)ch) && ch != '\n');
1265 */
1266 {
1267 Interp * interpdeb = interp->pdb->debugger;
1268 STRING * readline = CONST_STRING(interpdeb, "readline_interactive");
1269 STRING * prompt = CONST_STRING(interpdeb, "(pdb) ");
1270 STRING *s= Parrot_str_new(interpdeb, NULL, 0);
1271 PMC *tmp_stdin = Parrot_io_stdhandle(interpdeb, 0, NULL);
1272
1273 Parrot_pcc_invoke_method_from_c_args(interpdeb,
1274 tmp_stdin, readline,
1275 "S->S", prompt, & s);
1276 {
1277 char * aux = Parrot_str_to_cstring(interpdeb, s);
1278 strcpy(c, aux);
1279 Parrot_str_free_cstring(aux);
1280 }
1281 ch = '\n';
1282 }
1283
1284 /* generate string (no more than buffer length) */
1285 /*
1286 while (ch != EOF && ch != '\n' && (i < DEBUG_CMD_BUFFER_LENGTH)) {
1287 c[i++] = (char)ch;
1288 ch = fgetc(tmp_stdin);
1289 }
1290
1291 c[i] = '\0';
1292 */
1293 if (ch == -1)
1294 strcpy(c, "quit");
1295 }
1296 }
1297
1298 /*
1299
1300 =item C<void PDB_script_file(PARROT_INTERP, const char *command)>
1301
1302 Interprets the contents of a file as user input commands
1303
1304 =cut
1305
1306 */
1307
1308 PARROT_EXPORT
1309 void
1310 PDB_script_file(PARROT_INTERP, ARGIN(const char *command))
1311 {
1312 ASSERT_ARGS(PDB_script_file)
1313 FILE *fd;
1314
1315 TRACEDEB_MSG("PDB_script_file");
1316
1317 /* If already executing a script, close it */
1318 close_script_file(interp);
1319
1320 TRACEDEB_MSG("Opening debugger script file");
1321
1322 fd = fopen(command, "r");
1323 if (!fd) {
1324 Parrot_io_eprintf(interp->pdb->debugger,
1325 "Error reading script file %s.\n",
1326 command);
1327 return;
1328 }
1329 interp->pdb->script_file = fd;
1330 interp->pdb->script_line = 0;
1331 TRACEDEB_MSG("PDB_script_file finished");
1332 }
1333
1334 /*
1335
1336 =item C<int PDB_run_command(PARROT_INTERP, const char *command)>
1337
1338 Run a command.
1339
1340 Hash the command to make a simple switch calling the correct handler.
1341
1342 =cut
1343
1344 */
1345
1346 PARROT_IGNORABLE_RESULT
1347 int
1348 PDB_run_command(PARROT_INTERP, ARGIN(const char *command))
1349 {
1350 ASSERT_ARGS(PDB_run_command)
1351 PDB_t * const pdb = interp->pdb;
1352 const DebuggerCmd *cmd;
1353
1354 /* keep a pointer to the command, in case we need to report an error */
1355
1356 const char * cmdline = command;
1357
1358 TRACEDEB_MSG("PDB_run_command");
1359 cmd = get_cmd(& cmdline);
1360
1361 if (cmd) {
1362 (* cmd->func)(pdb, cmdline);
1363 return 0;
1364 }
1365 else {
1366 if (*cmdline == '\0') {
1367 return 0;
1368 }
1369 else {
1370 Parrot_io_eprintf(pdb->debugger,
1371 "Undefined command: \"%s\"", command);
1372 if (pdb->script_file)
1373 Parrot_io_eprintf(pdb->debugger, " in line %lu", pdb->script_line);
1374 Parrot_io_eprintf(pdb->debugger, ". Try \"help\".");
1375 close_script_file(interp);
1376 return 1;
1377 }
1378 }
1379 }
1380
1381 /*
1382
1383 =item C<void PDB_next(PARROT_INTERP, const char *command)>
1384
1385 Execute the next N operation(s).
1386
1387 Inits the program if needed, runs the next N >= 1 operations and stops.
1388
1389 =cut
1390
1391 */
1392
1393 void
1394 PDB_next(PARROT_INTERP, ARGIN_NULLOK(const char *command))
1395 {
1396 ASSERT_ARGS(PDB_next)
1397 PDB_t * const pdb = interp->pdb;
1398 Interp *debugee;
1399
1400 TRACEDEB_MSG("PDB_next");
1401
1402 /* Init the program if it's not running */
1403 if (!(pdb->state & PDB_RUNNING))
1404 PDB_init(interp, command);
1405
1406 /* Get the number of operations to execute if any */
1407 pdb->tracing = get_ulong(& command, 1);
1408
1409 /* Erase the stopped flag */
1410 pdb->state &= ~PDB_STOPPED;
1411
1412 /* Testing use of the debugger runloop */
1413 #if 0
1414
1415 /* Execute */
1416 for (; n && pdb->cur_opcode; n--)
1417 DO_OP(pdb->cur_opcode, pdb->debugee);
1418
1419 /* Set the stopped flag */
1420 pdb->state |= PDB_STOPPED;
1421
1422 /* If program ended */
1423
1424 if (!pdb->cur_opcode)
1425 (void)PDB_program_end(interp);
1426 #endif
1427
1428 debugee = pdb->debugee;
1429
1430 new_runloop_jump_point(debugee);
1431 if (setjmp(debugee->current_runloop->resume)) {
1432 Parrot_io_eprintf(pdb->debugger, "Unhandled exception while tracing\n");
1433 pdb->state |= PDB_STOPPED;
1434 return;
1435 }
1436
1437 Parrot_runcore_switch(pdb->debugee, CONST_STRING(interp, "debugger"));
1438
1439 TRACEDEB_MSG("PDB_next finished");
1440 }
1441
1442 /*
1443
1444 =item C<void PDB_trace(PARROT_INTERP, const char *command)>
1445
1446 Execute the next N operations; if no number is specified, it defaults to 1.
1447
1448 =cut
1449
1450 */
1451
1452 void
1453 PDB_trace(PARROT_INTERP, ARGIN_NULLOK(const char *command))
1454 {
1455 ASSERT_ARGS(PDB_trace)
1456 PDB_t * const pdb = interp->pdb;
1457 Interp *debugee;
1458
1459 TRACEDEB_MSG("PDB_trace");
1460
1461 /* if debugger is not running yet, initialize */
1462 /*
1463 if (!(pdb->state & PDB_RUNNING))
1464 PDB_init(interp, command);
1465 */
1466
1467 /* get the number of ops to run, if specified */
1468 pdb->tracing = get_ulong(& command, 1);
1469
1470 /* clear the PDB_STOPPED flag, we'll be running n ops now */
1471 pdb->state &= ~PDB_STOPPED;
1472 debugee = pdb->debugee;
1473
1474 /* execute n ops */
1475 new_runloop_jump_point(debugee);
1476 if (setjmp(debugee->current_runloop->resume)) {
1477 Parrot_io_eprintf(pdb->debugger, "Unhandled exception while tracing\n");
1478 pdb->state |= PDB_STOPPED;
1479 return;
1480 }
1481
1482 pdb->state |= PDB_TRACING;
1483 Parrot_runcore_switch(pdb->debugee, CONST_STRING(interp, "debugger"));
1484
1485 /* Clear the following when done some testing */
1486
1487 /* we just stopped */
1488 pdb->state |= PDB_STOPPED;
1489
1490 /* If program ended */
1491 if (!pdb->cur_opcode)
1492 (void)PDB_program_end(interp);
1493 pdb->state |= PDB_RUNNING;
1494 pdb->state &= ~PDB_STOPPED;
1495
1496 TRACEDEB_MSG("PDB_trace finished");
1497 }
1498
1499 /*
1500
1501 =item C<static unsigned short condition_regtype(const char *cmd)>
1502
1503 =cut
1504
1505 */
1506
1507 static unsigned short
1508 condition_regtype(ARGIN(const char *cmd))
1509 {
1510 ASSERT_ARGS(condition_regtype)
1511 switch (*cmd) {
1512 case 'i':
1513 case 'I':
1514 return PDB_cond_int;
1515 case 'n':
1516 case 'N':
1517 return PDB_cond_num;
1518 case 's':
1519 case 'S':
1520 return PDB_cond_str;
1521 case 'p':
1522 case 'P':
1523 return PDB_cond_pmc;
1524 default:
1525 return 0;
1526 }
1527 }
1528
1529 /*
1530
1531 =item C<PDB_condition_t * PDB_cond(PARROT_INTERP, const char *command)>
1532
1533 Analyzes a condition from the user input.
1534
1535 =cut
1536
1537 */
1538
1539 PARROT_CAN_RETURN_NULL
1540 PDB_condition_t *
1541 PDB_cond(PARROT_INTERP, ARGIN(const char *command))
1542 {
1543 ASSERT_ARGS(PDB_cond)
1544 PDB_condition_t *condition;
1545 const char *auxcmd;
1546 char str[DEBUG_CMD_BUFFER_LENGTH + 1];
1547 unsigned short cond_argleft;
1548 unsigned short cond_type;
1549 unsigned char regleft;
1550 int i, reg_number;
1551
1552 TRACEDEB_MSG("PDB_cond");
1553
1554 /* Return if no more arguments */
1555 if (!(command && *command)) {
1556 Parrot_io_eprintf(interp->pdb->debugger, "No condition specified\n");
1557 return NULL;
1558 }
1559
1560 command = skip_whitespace(command);
1561 #if TRACE_DEBUGGER
1562 fprintf(stderr, "PDB_trace: '%s'\n", command);
1563 #endif
1564
1565 cond_argleft = condition_regtype(command);
1566
1567 /* get the register number */
1568 auxcmd = ++command;
1569 regleft = (unsigned char)get_uint(&command, 0);
1570 if (auxcmd == command) {
1571 Parrot_io_eprintf(interp->pdb->debugger, "Invalid register\n");
1572 return NULL;
1573 }
1574
1575 /* Now the condition */
1576 command = skip_whitespace(command);
1577 switch (*command) {
1578 case '>':
1579 if (*(command + 1) == '=')
1580 cond_type = PDB_cond_ge;
1581 else
1582 cond_type = PDB_cond_gt;
1583 break;
1584 case '<':
1585 if (*(command + 1) == '=')
1586 cond_type = PDB_cond_le;
1587 else
1588 cond_type = PDB_cond_lt;
1589 break;
1590 case '=':
1591 if (*(command + 1) == '=')
1592 cond_type = PDB_cond_eq;
1593 else
1594 goto INV_COND;
1595 break;
1596 case '!':
1597 if (*(command + 1) == '=')
1598 cond_type = PDB_cond_ne;
1599 else
1600 goto INV_COND;
1601 break;
1602 case '\0':
1603 if (cond_argleft != PDB_cond_str && cond_argleft != PDB_cond_pmc) {
1604 Parrot_io_eprintf(interp->pdb->debugger, "Invalid null condition\n");
1605 return NULL;
1606 }
1607 cond_type = PDB_cond_notnull;
1608 break;
1609 default:
1610 INV_COND: Parrot_io_eprintf(interp->pdb->debugger, "Invalid condition\n");
1611 return NULL;
1612 }
1613
1614 /* if there's an '=', skip it */
1615 if (*(command + 1) == '=')
1616 command += 2;
1617 else
1618 command++;
1619
1620 command = skip_whitespace(command);
1621
1622 /* return if no notnull condition and no more arguments */
1623 if (!(command && *command) && (cond_type != PDB_cond_notnull)) {
1624 Parrot_io_eprintf(interp->pdb->debugger, "Can't compare a register with nothing\n");
1625 return NULL;
1626 }
1627
1628 /* Allocate new condition */
1629 condition = mem_allocate_zeroed_typed(PDB_condition_t);
1630
1631 condition->type = cond_argleft | cond_type;
1632
1633 if (cond_type != PDB_cond_notnull) {
1634
1635 if (isalpha((unsigned char)*command)) {
1636 /* It's a register - we first check that it's the correct type */
1637
1638 unsigned short cond_argright = condition_regtype(command);
1639
1640 if (cond_argright != cond_argleft) {
1641 Parrot_io_eprintf(interp->pdb->debugger, "Register types don't agree\n");
1642 mem_sys_free(condition);
1643 return NULL;
1644 }
1645
1646 /* Now we check and store the register number */
1647 auxcmd = ++command;
1648 reg_number = (int)get_uint(&command, 0);
1649 if (auxcmd == command) {
1650 Parrot_io_eprintf(interp->pdb->debugger, "Invalid register\n");
1651 mem_sys_free(condition);
1652 return NULL;
1653 }
1654
1655 if (reg_number < 0) {
1656 Parrot_io_eprintf(interp->pdb->debugger, "Out-of-bounds register\n");
1657 mem_sys_free(condition);
1658 return NULL;
1659 }
1660
1661 condition->value = mem_allocate_typed(int);
1662 *(int *)condition->value = reg_number;
1663 }
1664 /* If the first argument was an integer */
1665 else if (condition->type & PDB_cond_int) {
1666 /* This must be either an integer constant or register */
1667 condition->value = mem_allocate_typed(INTVAL);
1668 *(INTVAL *)condition->value = (INTVAL)atoi(command);
1669 condition->type |= PDB_cond_const;
1670 }
1671 else if (condition->type & PDB_cond_num) {
1672 condition->value = mem_allocate_typed(FLOATVAL);
1673 *(FLOATVAL *)condition->value = (FLOATVAL)atof(command);
1674 condition->type |= PDB_cond_const;
1675 }
1676 else if (condition->type & PDB_cond_str) {
1677 for (i = 1; ((command[i] != '"') && (i < DEBUG_CMD_BUFFER_LENGTH)); i++)
1678 str[i - 1] = command[i];
1679 str[i - 1] = '\0';
1680 #if TRACE_DEBUGGER
1681 fprintf(stderr, "PDB_break: '%s'\n", str);
1682 #endif
1683 condition->value = string_make(interp, str, (UINTVAL)(i - 1),
1684 NULL, 0);
1685
1686 condition->type |= PDB_cond_const;
1687 }
1688 else if (condition->type & PDB_cond_pmc) {
1689 /* TT #1259: Need to figure out what to do in this case.
1690 * For the time being, we just bail. */
1691 Parrot_io_eprintf(interp->pdb->debugger, "Can't compare PMC with constant\n");
1692 mem_sys_free(condition);
1693 return NULL;
1694 }
1695
1696 }
1697
1698 return condition;
1699 }
1700
1701 /*
1702
1703 =item C<void PDB_watchpoint(PARROT_INTERP, const char *command)>
1704
1705 Set a watchpoint.
1706
1707 =cut
1708
1709 */
1710
1711 void
1712 PDB_watchpoint(PARROT_INTERP, ARGIN(const char *command))
1713 {
1714 ASSERT_ARGS(PDB_watchpoint)
1715 PDB_t * const pdb = interp->pdb;
1716 PDB_condition_t * const condition = PDB_cond(interp, command);
1717
1718 if (!condition)
1719 return;
1720
1721 /* Add it to the head of the list */
1722 if (pdb->watchpoint)
1723 condition->next = pdb->watchpoint;
1724 pdb->watchpoint = condition;
1725 fprintf(stderr, "Adding watchpoint\n");
1726 }
1727
1728 /*
1729
1730 =item C<void PDB_set_break(PARROT_INTERP, const char *command)>
1731
1732 Set a break point, the source code file must be loaded.
1733
1734 =cut
1735
1736 */
1737
1738 void
1739 PDB_set_break(PARROT_INTERP, ARGIN_NULLOK(const char *command))
1740 {
1741 ASSERT_ARGS(PDB_set_break)
1742 PDB_t * const pdb = interp->pdb;
1743 PDB_breakpoint_t *newbreak;
1744 PDB_breakpoint_t **lbreak;
1745 PDB_line_t *line = NULL;
1746 long bp_id;
1747 opcode_t *breakpos = NULL;
1748
1749 unsigned long ln = get_ulong(& command, 0);
1750
1751 TRACEDEB_MSG("PDB_set_break");
1752
1753 /* If there is a source file use line number, else opcode position */
1754
1755
1756 if (pdb->file) {
1757 TRACEDEB_MSG("PDB_set_break file");
1758
1759 if (!pdb->file->size) {
1760 Parrot_io_eprintf(pdb->debugger,
1761 "Can't set a breakpoint in empty file\n");
1762 return;
1763 }
1764
1765 /* If no line number was specified, set it at the current line */
1766 if (ln != 0) {
1767 unsigned long i;
1768
1769 /* Move to the line where we will set the break point */
1770 line = pdb->file->line;
1771
1772 for (i = 1; ((i < ln) && (line->next)); i++)
1773 line = line->next;
1774
1775 /* Abort if the line number provided doesn't exist */
1776 if (line == NULL || !line->next) {
1777 Parrot_io_eprintf(pdb->debugger,
1778 "Can't set a breakpoint at line number %li\n", ln);
1779 return;
1780 }
1781 }
1782 else {
1783 /* Get the line to set it */
1784 line = pdb->file->line;
1785
1786 TRACEDEB_MSG("PDB_set_break reading ops");
1787 while (line->opcode != pdb->cur_opcode) {
1788 line = line->next;
1789 if (!line) {
1790 Parrot_io_eprintf(pdb->debugger,
1791 "No current line found and no line number specified\n");
1792 return;
1793 }
1794 }
1795 }
1796 /* Skip lines that are not related to an opcode */
1797 while (line && !line->opcode)
1798 line = line->next;
1799 /* Abort if the line number provided doesn't exist */
1800 if (!line) {
1801 Parrot_io_eprintf(pdb->debugger,
1802 "Can't set a breakpoint at line number %li\n", ln);
1803 return;
1804 }
1805
1806 breakpos = line->opcode;
1807 }
1808 else {
1809 TRACEDEB_MSG("PDB_set_break no file");
1810 breakpos = interp->code->base.data + ln;
1811 }
1812
1813 TRACEDEB_MSG("PDB_set_break allocate breakpoint");
1814 /* Allocate the new break point */
1815 newbreak = mem_allocate_zeroed_typed(PDB_breakpoint_t);
1816
1817 if (command) {
1818 /*command = skip_command(command);*/
1819 }
1820 else {
1821 Parrot_ex_throw_from_c_args(interp, NULL, 1,
1822 "NULL command passed to PDB_set_break");
1823 }
1824
1825 /* if there is another argument to break, besides the line number,
1826 * it should be an 'if', so we call another handler. */
1827 if (command && *command) {
1828 command = skip_whitespace(command);
1829 while (! isspace((unsigned char)*command))
1830 ++command;
1831 command = skip_whitespace(command);
1832 newbreak->condition = PDB_cond(interp, command);
1833 }
1834
1835 /* Set the address where to stop */
1836 newbreak->pc = breakpos;
1837
1838 /* No next breakpoint */
1839 newbreak->next = NULL;
1840
1841 /* Don't skip (at least initially) */
1842 newbreak->skip = 0;
1843
1844 /* Add the breakpoint to the end of the list */
1845 bp_id = 1;
1846 lbreak = & pdb->breakpoint;
1847 while (*lbreak) {
1848 bp_id = (*lbreak)->id + 1;
1849 lbreak = & (*lbreak)->next;
1850 }
1851 newbreak->prev = *lbreak;
1852 *lbreak = newbreak;
1853 newbreak->id = bp_id;
1854
1855 /* Show breakpoint position */
1856
1857 Parrot_io_eprintf(pdb->debugger, "Breakpoint %li at", newbreak->id);
1858 if (line)
1859 Parrot_io_eprintf(pdb->debugger, " line %li", line->number);
1860 Parrot_io_eprintf(pdb->debugger, " pos %li\n", newbreak->pc - interp->code->base.data);
1861 }
1862
1863 /*
1864
1865 =item C<static void list_breakpoints(PDB_t *pdb)>
1866
1867 =cut
1868
1869 */
1870
1871 static void
1872 list_breakpoints(ARGIN(PDB_t *pdb))
1873 {
1874 ASSERT_ARGS(list_breakpoints)
1875
1876 PDB_breakpoint_t **lbreak;
1877 for (lbreak = & pdb->breakpoint; *lbreak; lbreak = & (*lbreak)->next) {
1878 PDB_breakpoint_t *br = *lbreak;
1879 Parrot_io_eprintf(pdb->debugger, "Breakpoint %li at", br->id);
1880 Parrot_io_eprintf(pdb->debugger, " pos %li", br->pc - pdb->debugee->code->base.data);
1881 if (br->skip == -1)
1882 Parrot_io_eprintf(pdb->debugger, " (disabled)");
1883 Parrot_io_eprintf(pdb->debugger, "\n");
1884 }
1885 }
1886
1887 /*
1888
1889 =item C<void PDB_init(PARROT_INTERP, const char *command)>
1890
1891 Init the program.
1892
1893 =cut
1894
1895 */
1896
1897 void
1898 PDB_init(PARROT_INTERP, SHIM(const char *command))
1899 {
1900 ASSERT_ARGS(PDB_init)
1901 PDB_t * const pdb = interp->pdb;
1902
1903 /* Restart if we are already running */
1904 if (pdb->state & PDB_RUNNING)
1905 Parrot_io_eprintf(pdb->debugger, "Restarting\n");
1906
1907 /* Add the RUNNING state */
1908 pdb->state |= PDB_RUNNING;
1909 }
1910
1911 /*
1912
1913 =item C<void PDB_continue(PARROT_INTERP, const char *command)>
1914
1915 Continue running the program. If a number is specified, skip that many
1916 breakpoints.
1917
1918 =cut
1919
1920 */
1921
1922 void
1923 PDB_continue(PARROT_INTERP, ARGIN_NULLOK(const char *command))
1924 {
1925 ASSERT_ARGS(PDB_continue)
1926 PDB_t * const pdb = interp->pdb;
1927 unsigned long ln = 0;
1928
1929 TRACEDEB_MSG("PDB_continue");
1930
1931 /* Skip any breakpoint? */
1932 if (command)
1933 ln = get_ulong(& command, 0);
1934
1935 if (ln != 0) {
1936 if (!pdb->breakpoint) {
1937 Parrot_io_eprintf(pdb->debugger, "No breakpoints to skip\n");
1938 return;
1939 }
1940
1941 PDB_skip_breakpoint(interp, ln);
1942 }
1943
1944 /* Run while no break point is reached */
1945 /*
1946 while (!PDB_break(interp))
1947 DO_OP(pdb->cur_opcode, pdb->debugee);
1948 */
1949
1950 #if 0
1951 pdb->tracing = 0;
1952 Parrot_runcore_switch(pdb->debugee, CONST_STRING(interp, "debugger"));
1953
1954 new_internal_exception(pdb->debugee);
1955 if (setjmp(pdb->debugee->exceptions->destination)) {
1956 Parrot_io_eprintf(pdb->debugee, "Unhandled exception while debugging: %Ss\n",
1957 pdb->debugee->exceptions->msg);
1958 pdb->state |= PDB_STOPPED;
1959 return;
1960 }
1961 runops_int(pdb->debugee, pdb->debugee->code->base.data - pdb->cur_opcode);
1962 if (!pdb->cur_opcode)
1963 (void)PDB_program_end(interp);
1964 #endif
1965 pdb->state |= PDB_RUNNING;
1966 pdb->state &= ~PDB_BREAK;
1967 pdb->state &= ~PDB_STOPPED;
1968 }
1969
1970 /*
1971
1972 =item C<PDB_breakpoint_t * PDB_find_breakpoint(PARROT_INTERP, const char
1973 *command)>
1974
1975 Find breakpoint number N; returns C<NULL> if the breakpoint doesn't
1976 exist or if no breakpoint was specified.
1977
1978 =cut
1979
1980 */
1981
1982 PARROT_CAN_RETURN_NULL
1983 PARROT_WARN_UNUSED_RESULT
1984 PDB_breakpoint_t *
1985 PDB_find_breakpoint(PARROT_INTERP, ARGIN(const char *command))
1986 {
1987 ASSERT_ARGS(PDB_find_breakpoint)
1988 const char *oldcmd = command;
1989 const unsigned long n = get_ulong(&command, 0);
1990 if (command != oldcmd) {
1991 PDB_breakpoint_t *breakpoint = interp->pdb->breakpoint;
1992
1993 while (breakpoint && breakpoint->id != n)
1994 breakpoint = breakpoint->next;
1995
1996 if (!breakpoint) {
1997 Parrot_io_eprintf(interp->pdb->debugger, "No breakpoint number %ld", n);
1998 return NULL;
1999 }
2000
2001 return breakpoint;
2002 }
2003 else {
2004 /* Report an appropriate error */
2005 if (*command)
2006 Parrot_io_eprintf(interp->pdb->debugger, "Not a valid breakpoint");
2007 else
2008 Parrot_io_eprintf(interp->pdb->debugger, "No breakpoint specified");
2009
2010 return NULL;
2011 }
2012 }
2013
2014 /*
2015
2016 =item C<void PDB_disable_breakpoint(PARROT_INTERP, const char *command)>
2017
2018 Disable a breakpoint; it can be reenabled with the enable command.
2019
2020 =cut
2021
2022 */
2023
2024 void
2025 PDB_disable_breakpoint(PARROT_INTERP, ARGIN(const char *command))
2026 {
2027 ASSERT_ARGS(PDB_disable_breakpoint)
2028 PDB_breakpoint_t * const breakpoint = PDB_find_breakpoint(interp, command);
2029
2030 /* if the breakpoint exists, disable it. */
2031 if (breakpoint)
2032 breakpoint->skip = -1;
2033 }
2034
2035 /*
2036
2037 =item C<void PDB_enable_breakpoint(PARROT_INTERP, const char *command)>
2038
2039 Reenable a disabled breakpoint; if the breakpoint was not disabled, has
2040 no effect.
2041
2042 =cut
2043
2044 */
2045
2046 void
2047 PDB_enable_breakpoint(PARROT_INTERP, ARGIN(const char *command))
2048 {
2049 ASSERT_ARGS(PDB_enable_breakpoint)
2050 PDB_breakpoint_t * const breakpoint = PDB_find_breakpoint(interp, command);
2051
2052 /* if the breakpoint exists, and it was disabled, enable it. */
2053 if (breakpoint && breakpoint->skip == -1)
2054 breakpoint->skip = 0;
2055 }
2056
2057 /*
2058
2059 =item C<void PDB_delete_breakpoint(PARROT_INTERP, const char *command)>
2060
2061 Delete a breakpoint.
2062
2063 =cut
2064
2065 */
2066
2067 void
2068 PDB_delete_breakpoint(PARROT_INTERP, ARGIN(const char *command))
2069 {
2070 ASSERT_ARGS(PDB_delete_breakpoint)
2071 PDB_breakpoint_t * const breakpoint = PDB_find_breakpoint(interp, command);
2072 const PDB_line_t *line;
2073 long bp_id;
2074
2075 if (breakpoint) {
2076 if (!interp->pdb->file)
2077 Parrot_ex_throw_from_c_args(interp, NULL, 0, "No file loaded");
2078
2079 line = interp->pdb->file->line;
2080 while (line->opcode != breakpoint->pc)
2081 line = line->next;
2082
2083 /* Delete the condition structure, if there is one */
2084 if (breakpoint->condition) {
2085 PDB_delete_condition(interp, breakpoint);
2086 breakpoint->condition = NULL;
2087 }
2088
2089 /* Remove the breakpoint from the list */
2090 if (breakpoint->prev && breakpoint->next) {
2091 breakpoint->prev->next = breakpoint->next;
2092 breakpoint->next->prev = breakpoint->prev;
2093 }
2094 else if (breakpoint->prev && !breakpoint->next) {
2095 breakpoint->prev->next = NULL;
2096 }
2097 else if (!breakpoint->prev && breakpoint->next) {
2098 breakpoint->next->prev = NULL;
2099 interp->pdb->breakpoint = breakpoint->next;
2100 }
2101 else {
2102 interp->pdb->breakpoint = NULL;
2103 }
2104 bp_id = breakpoint->id;
2105 /* Kill the breakpoint */
2106 mem_sys_free(breakpoint);
2107
2108 Parrot_io_eprintf(interp->pdb->debugger, "Breakpoint %li deleted\n", bp_id);
2109 }
2110 }
2111
2112 /*
2113
2114 =item C<void PDB_delete_condition(PARROT_INTERP, PDB_breakpoint_t *breakpoint)>
2115
2116 Delete a condition associated with a breakpoint.
2117
2118 =cut
2119
2120 */
2121
2122 void
2123 PDB_delete_condition(SHIM_INTERP, ARGMOD(PDB_breakpoint_t *breakpoint))
2124 {
2125 ASSERT_ARGS(PDB_delete_condition)
2126 if (breakpoint->condition->value) {
2127 if (breakpoint->condition->type & PDB_cond_str) {
2128 /* 'value' is a string, so we need to be careful */
2129 PObj_external_CLEAR((STRING*)breakpoint->condition->value);
2130 PObj_on_free_list_SET((STRING*)breakpoint->condition->value);
2131 /* it should now be properly garbage collected after
2132 we destroy the condition */
2133 }
2134 else {
2135 /* 'value' is a float or an int, so we can just free it */
2136 mem_sys_free(breakpoint->condition->value);
2137 breakpoint->condition->value = NULL;
2138 }
2139 }
2140
2141 mem_sys_free(breakpoint->condition);
2142 breakpoint->condition = NULL;
2143 }
2144
2145 /*
2146
2147 =item C<void PDB_skip_breakpoint(PARROT_INTERP, unsigned long i)>
2148
2149 Skip C<i> times all breakpoints.
2150
2151 =cut
2152
2153 */
2154
2155 void
2156 PDB_skip_breakpoint(PARROT_INTERP, unsigned long i)
2157 {
2158 ASSERT_ARGS(PDB_skip_breakpoint)
2159 #if TRACE_DEBUGGER
2160 fprintf(stderr, "PDB_skip_breakpoint: %li\n", i);
2161 #endif
2162
2163 interp->pdb->breakpoint_skip = i;
2164 }
2165
2166 /*
2167
2168 =item C<char PDB_program_end(PARROT_INTERP)>
2169
2170 End the program.
2171
2172 =cut
2173
2174 */
2175
2176 char
2177 PDB_program_end(PARROT_INTERP)
2178 {
2179 ASSERT_ARGS(PDB_program_end)
2180 PDB_t * const pdb = interp->pdb;
2181
2182 TRACEDEB_MSG("PDB_program_end");
2183
2184 /* Remove the RUNNING state */
2185 pdb->state &= ~PDB_RUNNING;
2186
2187 Parrot_io_eprintf(pdb->debugger, "Program exited.\n");
2188 return 1;
2189 }
2190
2191 /*
2192
2193 =item C<char PDB_check_condition(PARROT_INTERP, const PDB_condition_t
2194 *condition)>
2195
2196 Returns true if the condition was met.
2197
2198 =cut
2199
2200 */
2201
2202 PARROT_WARN_UNUSED_RESULT
2203 char
2204 PDB_check_condition(PARROT_INTERP, ARGIN(const PDB_condition_t *condition))
2205 {
2206 ASSERT_ARGS(PDB_check_condition)
2207 PMC *ctx = CURRENT_CONTEXT(interp);
2208
2209 TRACEDEB_MSG("PDB_check_condition");
2210
2211 PARROT_ASSERT(ctx);
2212
2213 if (condition->type & PDB_cond_int) {
2214 INTVAL i, j;
2215 if (condition->reg >= Parrot_pcc_get_regs_used(interp, ctx, REGNO_INT))
2216 return 0;
2217 i = CTX_REG_INT(ctx, condition->reg);
2218
2219 if (condition->type & PDB_cond_const)
2220 j = *(INTVAL *)condition->value;
2221 else
2222 j = REG_INT(interp, *(int *)condition->value);
2223
2224 if (((condition->type & PDB_cond_gt) && (i > j)) ||
2225 ((condition->type & PDB_cond_ge) && (i >= j)) ||
2226 ((condition->type & PDB_cond_eq) && (i == j)) ||
2227 ((condition->type & PDB_cond_ne) && (i != j)) ||
2228 ((condition->type & PDB_cond_le) && (i <= j)) ||
2229 ((condition->type & PDB_cond_lt) && (i < j)))
2230 return 1;
2231
2232 return 0;
2233 }
2234 else if (condition->type & PDB_cond_num) {
2235 FLOATVAL k, l;
2236
2237 if (condition->reg >= Parrot_pcc_get_regs_used(interp, ctx, REGNO_NUM))
2238 return 0;
2239 k = CTX_REG_NUM(ctx, condition->reg);
2240
2241 if (condition->type & PDB_cond_const)
2242 l = *(FLOATVAL *)condition->value;
2243 else
2244 l = REG_NUM(interp, *(int *)condition->value);
2245
2246 if (((condition->type & PDB_cond_gt) && (k > l)) ||
2247 ((condition->type & PDB_cond_ge) && (k >= l)) ||
2248 ((condition->type & PDB_cond_eq) && (k == l)) ||
2249 ((condition->type & PDB_cond_ne) && (k != l)) ||
2250 ((condition->type & PDB_cond_le) && (k <= l)) ||
2251 ((condition->type & PDB_cond_lt) && (k < l)))
2252 return 1;
2253
2254 return 0;
2255 }
2256 else if (condition->type & PDB_cond_str) {
2257 STRING *m, *n;
2258
2259 if (condition->reg >= Parrot_pcc_get_regs_used(interp, ctx, REGNO_STR))
2260 return 0;
2261 m = CTX_REG_STR(ctx, condition->reg);
2262
2263 if (condition->type & PDB_cond_notnull)
2264 return ! STRING_IS_NULL(m);
2265
2266 if (condition->type & PDB_cond_const)
2267 n = (STRING *)condition->value;
2268 else
2269 n = REG_STR(interp, *(int *)condition->value);
2270
2271 if (((condition->type & PDB_cond_gt) &&
2272 (Parrot_str_compare(interp, m, n) > 0)) ||
2273 ((condition->type & PDB_cond_ge) &&
2274 (Parrot_str_compare(interp, m, n) >= 0)) ||
2275 ((condition->type & PDB_cond_eq) &&
2276 (Parrot_str_compare(interp, m, n) == 0)) ||
2277 ((condition->type & PDB_cond_ne) &&
2278 (Parrot_str_compare(interp, m, n) != 0)) ||
2279 ((condition->type & PDB_cond_le) &&
2280 (Parrot_str_compare(interp, m, n) <= 0)) ||
2281 ((condition->type & PDB_cond_lt) &&
2282 (Parrot_str_compare(interp, m, n) < 0)))
2283 return 1;
2284
2285 return 0;
2286 }
2287 else if (condition->type & PDB_cond_pmc) {
2288 PMC *m;
2289
2290 if (condition->reg >= Parrot_pcc_get_regs_used(interp, ctx, REGNO_PMC))
2291 return 0;
2292 m = CTX_REG_PMC(ctx, condition->reg);
2293
2294 if (condition->type & PDB_cond_notnull)
2295 return ! PMC_IS_NULL(m);
2296 return 0;
2297 }
2298 else
2299 return 0;
2300 }
2301
2302 /*
2303
2304 =item C<static PDB_breakpoint_t * current_breakpoint(PDB_t * pdb)>
2305
2306 Returns a pointer to the breakpoint at the current position,
2307 or NULL if there is none.
2308
2309 =cut
2310
2311 */
2312
2313 PARROT_CAN_RETURN_NULL
2314 static PDB_breakpoint_t *
2315 current_breakpoint(ARGIN(PDB_t * pdb))
2316 {
2317 ASSERT_ARGS(current_breakpoint)
2318 PDB_breakpoint_t *breakpoint = pdb->breakpoint;
2319 while (breakpoint) {
2320 if (pdb->cur_opcode == breakpoint->pc)
2321 break;
2322 breakpoint = breakpoint->next;
2323 }
2324 return breakpoint;
2325 }
2326
2327 /*
2328
2329 =item C<char PDB_break(PARROT_INTERP)>
2330
2331 Returns true if we have to stop running.
2332
2333 =cut
2334
2335 */
2336
2337 PARROT_WARN_UNUSED_RESULT
2338 char
2339 PDB_break(PARROT_INTERP)
2340 {
2341 ASSERT_ARGS(PDB_break)
2342 PDB_t * const pdb = interp->pdb;
2343 PDB_condition_t *watchpoint = pdb->watchpoint;
2344 PDB_breakpoint_t *breakpoint;
2345
2346 /*
2347 TRACEDEB_MSG("PDB_break");
2348 */
2349
2350 /* Check the watchpoints first. */
2351 while (watchpoint) {
2352 if (PDB_check_condition(interp, watchpoint)) {
2353 pdb->state |= PDB_STOPPED;
2354 return 1;
2355 }
2356
2357 watchpoint = watchpoint->next;
2358 }
2359
2360 /* If program ended */
2361 if (!pdb->cur_opcode)
2362 return PDB_program_end(interp);
2363
2364 /* If the program is STOPPED allow it to continue */
2365 if (pdb->state & PDB_STOPPED) {
2366 pdb->state &= ~PDB_STOPPED;
2367 return 0;
2368 }
2369
2370 breakpoint = current_breakpoint(pdb);
2371 if (breakpoint) {
2372 /* If we have to skip breakpoints, do so. */
2373 if (pdb->breakpoint_skip) {
2374 TRACEDEB_MSG("PDB_break skipping");
2375 pdb->breakpoint_skip--;
2376 return 0;
2377 }
2378
2379 if (breakpoint->skip < 0)
2380 return 0;
2381
2382 /* Check if there is a condition for this breakpoint */
2383 if ((breakpoint->condition) &&
2384 (!PDB_check_condition(interp, breakpoint->condition)))
2385 return 0;
2386
2387 TRACEDEB_MSG("PDB_break stopping");
2388
2389 /* Add the STOPPED state and stop */
2390 pdb->state |= PDB_STOPPED;
2391 return 1;
2392 }
2393
2394 return 0;
2395 }
2396
2397 /*
2398
2399 =item C<char * PDB_escape(const char *string, UINTVAL length)>
2400
2401 Escapes C<">, C<\r>, C<\n>, C<\t>, C<\a> and C<\\>.
2402
2403 The returned string must be freed.
2404
2405 =cut
2406
2407 */
2408
2409 PARROT_WARN_UNUSED_RESULT
2410 PARROT_CAN_RETURN_NULL
2411 PARROT_MALLOC
2412 char *
2413 PDB_escape(ARGIN(const char *string), UINTVAL length)
2414 {
2415 ASSERT_ARGS(PDB_escape)
2416 const char *end;
2417 char *_new, *fill;
2418
2419 length = length > 20 ? 20 : length;
2420 end = string + length;
2421
2422 /* Return if there is no string to escape*/
2423 if (!string)
2424 return NULL;
2425
2426 fill = _new = (char *)mem_sys_allocate(length * 2 + 1);
2427
2428 for (; string < end; string++) {
2429 switch (*string) {
2430 case '\0':
2431 *(fill++) = '\\';
2432 *(fill++) = '0';
2433 break;
2434 case '\n':
2435 *(fill++) = '\\';
2436 *(fill++) = 'n';
2437 break;
2438 case '\r':
2439 *(fill++) = '\\';
2440 *(fill++) = 'r';
2441 break;
2442 case '\t':
2443 *(fill++) = '\\';
2444 *(fill++) = 't';
2445 break;
2446 case '\a':
2447 *(fill++) = '\\';
2448 *(fill++) = 'a';
2449 break;
2450 case '\\':
2451 *(fill++) = '\\';
2452 *(fill++) = '\\';
2453 break;
2454 case '"':
2455 *(fill++) = '\\';
2456 *(fill++) = '"';
2457 break;
2458 default:
2459 *(fill++) = *string;
2460 break;
2461 }
2462 }
2463
2464 *fill = '\0';
2465
2466 return _new;
2467 }
2468
2469 /*
2470
2471 =item C<int PDB_unescape(char *string)>
2472
2473 Do inplace unescape of C<\r>, C<\n>, C<\t>, C<\a> and C<\\>.
2474
2475 =cut
2476
2477 */
2478
2479 int
2480 PDB_unescape(ARGMOD(char *string))
2481 {
2482 ASSERT_ARGS(PDB_unescape)
2483 int l = 0;
2484
2485 for (; *string; string++) {
2486 l++;
2487
2488 if (*string == '\\') {
2489 char *fill;
2490 int i;
2491
2492 switch (string[1]) {
2493 case 'n':
2494 *string = '\n';
2495 break;
2496 case 'r':
2497 *string = '\r';
2498 break;
2499 case 't':
2500 *string = '\t';
2501 break;
2502 case 'a':
2503 *string = '\a';
2504 break;
2505 case '\\':
2506 *string = '\\';
2507 break;
2508 default:
2509 continue;
2510 }
2511
2512 fill = string;
2513
2514 for (i = 1; fill[i + 1]; i++)
2515 fill[i] = fill[i + 1];
2516
2517 fill[i] = '\0';
2518 }
2519 }
2520
2521 return l;
2522 }
2523
2524 /*
2525
2526 =item C<size_t PDB_disassemble_op(PARROT_INTERP, char *dest, size_t space, const
2527 op_info_t *info, const opcode_t *op, PDB_file_t *file, const opcode_t
2528 *code_start, int full_name)>
2529
2530 Disassembles C<op>.
2531
2532 =cut
2533
2534 */
2535
2536 size_t
2537 PDB_disassemble_op(PARROT_INTERP, ARGOUT(char *dest), size_t space,
2538 ARGIN(const op_info_t *info), ARGIN(const opcode_t *op),
2539 ARGMOD_NULLOK(PDB_file_t *file), ARGIN_NULLOK(const opcode_t *code_start),
2540 int full_name)
2541 {
2542 ASSERT_ARGS(PDB_disassemble_op)
2543 int j;
2544 size_t size = 0;
2545 int specialop = 0;
2546
2547 /* Write the opcode name */
2548 const char * p = full_name ? info->full_name : info->name;
2549
2550 TRACEDEB_MSG("PDB_disassemble_op");
2551
2552 if (! p)
2553 p= "**UNKNOWN**";
2554 strcpy(dest, p);
2555 size += strlen(p);
2556
2557 dest[size++] = ' ';
2558
2559 /* Concat the arguments */
2560 for (j = 1; j < info->op_count; j++) {
2561 char buf[256];
2562 INTVAL i = 0;
2563
2564 PARROT_ASSERT(size + 2 < space);
2565
2566 switch (info->types[j - 1]) {
2567 case PARROT_ARG_I:
2568 dest[size++] = 'I';
2569 goto INTEGER;
2570 case PARROT_ARG_N:
2571 dest[size++] = 'N';
2572 goto INTEGER;
2573 case PARROT_ARG_S:
2574 dest[size++] = 'S';
2575 goto INTEGER;
2576 case PARROT_ARG_P:
2577 dest[size++] = 'P';
2578 goto INTEGER;
2579 case PARROT_ARG_IC:
2580 /* If the opcode jumps and this is the last argument,
2581 that means this is a label */
2582 if ((j == info->op_count - 1) &&
2583 (info->jump & PARROT_JUMP_RELATIVE)) {
2584 if (file) {
2585 dest[size++] = 'L';
2586 i = PDB_add_label(file, op, op[j]);
2587 }
2588 else if (code_start) {
2589 dest[size++] = 'O';
2590 dest[size++] = 'P';
2591 i = op[j] + (op - code_start);
2592 }
2593 else {
2594 if (op[j] > 0)
2595 dest[size++] = '+';
2596 i = op[j];
2597 }
2598 }
2599
2600 /* Convert the integer to a string */
2601 INTEGER:
2602 if (i == 0)
2603 i = (INTVAL) op[j];
2604
2605 PARROT_ASSERT(size + 20 < space);
2606
2607 size += sprintf(&dest[size], INTVAL_FMT, i);
2608
2609 break;
2610 case PARROT_ARG_NC:
2611 {
2612 /* Convert the float to a string */
2613 const FLOATVAL f = interp->code->const_table->constants[op[j]]->u.number;
2614 Parrot_snprintf(interp, buf, sizeof (buf), FLOATVAL_FMT, f);
2615 strcpy(&dest[size], buf);
2616 size += strlen(buf);
2617 }
2618 break;
2619 case PARROT_ARG_SC:
2620 dest[size++] = '"';
2621 if (interp->code->const_table->constants[op[j]]-> u.string->strlen) {
2622 char * const unescaped =
2623 Parrot_str_to_cstring(interp, interp->code->
2624 const_table->constants[op[j]]->u.string);
2625 char * const escaped =
2626 PDB_escape(unescaped, interp->code->const_table->
2627 constants[op[j]]->u.string->strlen);
2628 if (escaped) {
2629 strcpy(&dest[size], escaped);
2630 size += strlen(escaped);
2631 mem_sys_free(escaped);
2632 }
2633 Parrot_str_free_cstring(unescaped);
2634 }
2635 dest[size++] = '"';
2636 break;
2637 case PARROT_ARG_PC:
2638 Parrot_snprintf(interp, buf, sizeof (buf), "PMC_CONST(%d)", op[j]);
2639 strcpy(&dest[size], buf);
2640 size += strlen(buf);
2641 break;
2642 case PARROT_ARG_K:
2643 dest[size - 1] = '[';
2644 Parrot_snprintf(interp, buf, sizeof (buf), "P" INTVAL_FMT, op[j]);
2645 strcpy(&dest[size], buf);
2646 size += strlen(buf);
2647 dest[size++] = ']';
2648 break;
2649 case PARROT_ARG_KC:
2650 {
2651 PMC * k = interp->code->const_table->constants[op[j]]->u.key;
2652 dest[size - 1] = '[';
2653 while (k) {
2654 switch (PObj_get_FLAGS(k)) {
2655 case 0:
2656 break;
2657 case KEY_integer_FLAG:
2658 Parrot_snprintf(interp, buf, sizeof (buf),
2659 INTVAL_FMT, VTABLE_get_integer(interp, k));
2660 strcpy(&dest[size], buf);
2661 size += strlen(buf);
2662 break;
2663 case KEY_number_FLAG:
2664 Parrot_snprintf(interp, buf, sizeof (buf),
2665 FLOATVAL_FMT, VTABLE_get_number(interp, k));
2666 strcpy(&dest[size], buf);
2667 size += strlen(buf);
2668 break;
2669 case KEY_string_FLAG:
2670 dest[size++] = '"';
2671 {
2672 char * const temp = Parrot_str_to_cstring(interp,
2673 VTABLE_get_string(interp, k));
2674 strcpy(&dest[size], temp);
2675 Parrot_str_free_cstring(temp);
2676 }
2677 size += Parrot_str_byte_length(interp,
2678 VTABLE_get_string(interp, (k)));
2679 dest[size++] = '"';
2680 break;
2681 case KEY_integer_FLAG|KEY_register_FLAG:
2682 Parrot_snprintf(interp, buf, sizeof (buf),
2683 "I" INTVAL_FMT, VTABLE_get_integer(interp, k));
2684 strcpy(&dest[size], buf);
2685 size += strlen(buf);
2686 break;
2687 case KEY_number_FLAG|KEY_register_FLAG:
2688 Parrot_snprintf(interp, buf, sizeof (buf),
2689 "N" INTVAL_FMT, VTABLE_get_integer(interp, k));
2690 strcpy(&dest[size], buf);
2691 size += strlen(buf);
2692 break;
2693 case KEY_string_FLAG|KEY_register_FLAG:
2694 Parrot_snprintf(interp, buf, sizeof (buf),
2695 "S" INTVAL_FMT, VTABLE_get_integer(interp, k));
2696 strcpy(&dest[size], buf);
2697 size += strlen(buf);
2698 break;
2699 case KEY_pmc_FLAG|KEY_register_FLAG:
2700 Parrot_snprintf(interp, buf, sizeof (buf),
2701 "P" INTVAL_FMT, VTABLE_get_integer(interp, k));
2702 strcpy(&dest[size], buf);
2703 size += strlen(buf);
2704 break;
2705 default:
2706 dest[size++] = '?';
2707 break;
2708 }
2709 GETATTR_Key_next_key(interp, k, k);
2710 if (k)
2711 dest[size++] = ';';
2712 }
2713 dest[size++] = ']';
2714 }
2715 break;
2716 case PARROT_ARG_KI:
2717 dest[size - 1] = '[';
2718 Parrot_snprintf(interp, buf, sizeof (buf), "I" INTVAL_FMT, op[j]);
2719 strcpy(&dest[size], buf);
2720 size += strlen(buf);
2721 dest[size++] = ']';
2722 break;
2723 case PARROT_ARG_KIC:
2724 dest[size - 1] = '[';
2725 Parrot_snprintf(interp, buf, sizeof (buf), INTVAL_FMT, op[j]);
2726 strcpy(&dest[size], buf);
2727 size += strlen(buf);
2728 dest[size++] = ']';
2729 break;
2730 default:
2731 Parrot_ex_throw_from_c_args(interp, NULL, 1, "Unknown opcode type");
2732 }
2733
2734 if (j != info->op_count - 1)
2735 dest[size++] = ',';
2736 }
2737
2738 /* Special decoding for the signature used in args/returns. Such ops have
2739 one fixed parameter (the signature vector), plus a varying number of
2740 registers/constants. For each arg/return, we show the register and its
2741 flags using PIR syntax. */
2742 if (*(op) == PARROT_OP_set_args_pc || *(op) == PARROT_OP_set_returns_pc)
2743 specialop = 1;
2744
2745 /* if it's a retrieving op, specialop = 2, so that later a :flat flag
2746 * can be changed into a :slurpy flag. See flag handling below.
2747 */
2748 if (*(op) == PARROT_OP_get_results_pc || *(op) == PARROT_OP_get_params_pc)
2749 specialop = 2;
2750
2751 if (specialop > 0) {
2752 char buf[1000];
2753 PMC * const sig = interp->code->const_table->constants[op[1]]->u.key;
2754 const int n_values = VTABLE_elements(interp, sig);
2755 /* The flag_names strings come from Call_bits_enum_t (with which it
2756 should probably be colocated); they name the bits from LSB to MSB.
2757 The two least significant bits are not flags; they are the register
2758 type, which is decoded elsewhere. We also want to show unused bits,
2759 which could indicate problems.
2760 */
2761 PARROT_OBSERVER const char * const flag_names[] = {
2762 "",
2763 "",
2764 " :unused004",
2765 " :unused008",
2766 " :const",
2767 " :flat", /* should be :slurpy for args */
2768 " :unused040",
2769 " :optional",
2770 " :opt_flag",
2771 " :named",
2772 NULL
2773 };
2774
2775
2776 /* Register decoding. It would be good to abstract this, too. */
2777 PARROT_OBSERVER static const char regs[] = "ISPN";
2778
2779 for (j = 0; j < n_values; j++) {
2780 size_t idx = 0;
2781 const int sig_value = VTABLE_get_integer_keyed_int(interp, sig, j);
2782
2783 /* Print the register name, e.g. P37. */
2784 buf[idx++] = ',';
2785 buf[idx++] = ' ';
2786 buf[idx++] = regs[sig_value & PARROT_ARG_TYPE_MASK];
2787 Parrot_snprintf(interp, &buf[idx], sizeof (buf)-idx,
2788 INTVAL_FMT, op[j+2]);
2789 idx = strlen(buf);
2790
2791 /* Add flags, if we have any. */
2792 {
2793 int flag_idx = 0;
2794 int flags = sig_value;
2795
2796 /* End when we run out of flags, off the end of flag_names, or
2797 * get too close to the end of buf.
2798 * 100 is just an estimate of all buf lengths added together.
2799 */
2800 while (flags && idx < sizeof (buf) - 100) {
2801 const char * const flag_string
2802 = (specialop == 2 && STREQ(flag_names[flag_idx], " :flat"))
2803 ? " :slurpy"
2804 : flag_names[flag_idx];
2805
2806 if (! flag_string)
2807 break;
2808 if (flags & 1 && *flag_string) {
2809 const size_t n = strlen(flag_string);
2810 strcpy(&buf[idx], flag_string);
2811 idx += n;
2812 }
2813 flags >>= 1;
2814 flag_idx++;
2815 }
2816 }
2817
2818 /* Add it to dest. */
2819 buf[idx++] = '\0';
2820 strcpy(&dest[size], buf);
2821 size += strlen(buf);
2822 }
2823 }
2824
2825 dest[size] = '\0';
2826 return ++size;
2827 }
2828
2829 /*
2830
2831 =item C<void PDB_disassemble(PARROT_INTERP, const char *command)>
2832
2833 Disassemble the bytecode.
2834
2835 =cut
2836
2837 */
2838
2839 void
2840 PDB_disassemble(PARROT_INTERP, SHIM(const char *command))
2841 {
2842 ASSERT_ARGS(PDB_disassemble)
2843 PDB_t * const pdb = interp->pdb;
2844 opcode_t * pc = interp->code->base.data;
2845
2846 PDB_file_t *pfile;
2847 PDB_line_t *pline, *newline;
2848 PDB_label_t *label;
2849 opcode_t *code_end;
2850
2851 const unsigned int default_size = 32768;
2852 size_t space; /* How much space do we have? */
2853 size_t size, alloced, n;
2854
2855 TRACEDEB_MSG("PDB_disassemble");
2856
2857 pfile = mem_allocate_zeroed_typed(PDB_file_t);
2858 pline = mem_allocate_zeroed_typed(PDB_line_t);
2859
2860 /* If we already got a source, free it */
2861 if (pdb->file) {
2862 PDB_free_file(interp, pdb->file);
2863 pdb->file = NULL;
2864 }
2865
2866 pfile->line = pline;
2867 pline->number = 1;
2868 pfile->source = (char *)mem_sys_allocate(default_size);
2869
2870 alloced = space = default_size;
2871 code_end = pc + interp->code->base.size;
2872
2873 while (pc != code_end) {
2874 /* Grow it early */
2875 if (space < default_size) {
2876 alloced += default_size;
2877 space += default_size;
2878 pfile->source = (char *)mem_sys_realloc(pfile->source, alloced);
2879 }
2880
2881 size = PDB_disassemble_op(interp, pfile->source + pfile->size,
2882 space, &interp->op_info_table[*pc], pc, pfile, NULL, 1);
2883 space -= size;
2884 pfile->size += size;
2885 pfile->source[pfile->size - 1] = '\n';
2886
2887 /* Store the opcode of this line */
2888 pline->opcode = pc;
2889 n = interp->op_info_table[*pc].op_count;
2890
2891 ADD_OP_VAR_PART(interp, interp->code, pc, n);
2892 pc += n;
2893
2894 /* Prepare for next line */
2895 newline = mem_allocate_typed(PDB_line_t);
2896 newline->label = NULL;
2897 newline->next = NULL;
2898 newline->number = pline->number + 1;
2899 pline->next = newline;
2900 pline = newline;
2901 pline->source_offset = pfile->size;
2902 }
2903
2904 /* Add labels to the lines they belong to */
2905 label = pfile->label;
2906
2907 while (label) {
2908 /* Get the line to apply the label */
2909 pline = pfile->line;
2910
2911 while (pline && pline->opcode != label->opcode)
2912 pline = pline->next;
2913
2914 if (!pline) {
2915 Parrot_io_eprintf(pdb->debugger,
2916 "Label number %li out of bounds.\n", label->number);
2917
2918 PDB_free_file(interp, pfile);
2919 return;
2920 }
2921
2922 pline->label = label;
2923
2924 label = label->next;
2925 }
2926
2927 pdb->state |= PDB_SRC_LOADED;
2928 pdb->file = pfile;
2929 }
2930
2931 /*
2932
2933 =item C<long PDB_add_label(PDB_file_t *file, const opcode_t *cur_opcode,
2934 opcode_t offset)>
2935
2936 Add a label to the label list.
2937
2938 =cut
2939
2940 */
2941
2942 long
2943 PDB_add_label(ARGMOD(PDB_file_t *file), ARGIN(const opcode_t *cur_opcode),
2944 opcode_t offset)
2945 {
2946 ASSERT_ARGS(PDB_add_label)
2947 PDB_label_t *_new;
2948 PDB_label_t *label = file->label;
2949
2950 /* See if there is already a label at this line */
2951 while (label) {
2952 if (label->opcode == cur_opcode + offset)
2953 return label->number;
2954 label = label->next;
2955 }
2956
2957 /* Allocate a new label */
2958 label = file->label;
2959 _new = mem_allocate_typed(PDB_label_t);
2960 _new->opcode = cur_opcode + offset;
2961 _new->next = NULL;
2962
2963 if (label) {
2964 while (label->next)
2965 label = label->next;
2966
2967 _new->number = label->number + 1;
2968 label->next = _new;
2969 }
2970 else {
2971 file->label = _new;
2972 _new->number = 1;
2973 }
2974
2975 return _new->number;
2976 }
2977
2978 /*
2979
2980 =item C<void PDB_free_file(PARROT_INTERP, PDB_file_t *file)>
2981
2982 Frees any allocated source files.
2983
2984 =cut
2985
2986 */
2987
2988 void
2989 PDB_free_file(SHIM_INTERP, ARGIN_NULLOK(PDB_file_t *file))
2990 {
2991 ASSERT_ARGS(PDB_free_file)
2992 while (file) {
2993 /* Free all of the allocated line structures */
2994 PDB_line_t *line = file->line;
2995 PDB_label_t *label;
2996 PDB_file_t *nfile;
2997
2998 while (line) {
2999 PDB_line_t * const nline = line->next;
3000 mem_sys_free(line);
3001 line = nline;
3002 }
3003
3004 /* Free all of the allocated label structures */
3005 label = file->label;
3006
3007 while (label) {
3008 PDB_label_t * const nlabel = label->next;
3009
3010 mem_sys_free(label);
3011 label = nlabel;
3012 }
3013
3014 /* Free the remaining allocated portions of the file structure */
3015 if (file->sourcefilename)
3016 mem_sys_free(file->sourcefilename);
3017
3018 if (file->source)
3019 mem_sys_free(file->source);
3020
3021 nfile = file->next;
3022 mem_sys_free(file);
3023 file = nfile;
3024 }
3025 }
3026
3027 /*
3028
3029 =item C<void PDB_load_source(PARROT_INTERP, const char *command)>
3030
3031 Load a source code file.
3032
3033 =cut
3034
3035 */
3036
3037 PARROT_EXPORT
3038 void
3039 PDB_load_source(PARROT_INTERP, ARGIN(const char *command))
3040 {
3041 ASSERT_ARGS(PDB_load_source)
3042 FILE *file;
3043 char f[DEBUG_CMD_BUFFER_LENGTH + 1];
3044 int i, j, c;
3045 PDB_file_t *pfile;
3046 PDB_line_t *pline;
3047 PDB_t * const pdb = interp->pdb;
3048 opcode_t *pc = interp->code->base.data;
3049
3050 unsigned long size = 0;
3051
3052 TRACEDEB_MSG("PDB_load_source");
3053
3054 /* If there was a file already loaded or the bytecode was
3055 disassembled, free it */
3056 if (pdb->file) {
3057 PDB_free_file(interp->pdb->debugee, interp->pdb->debugee->pdb->file);
3058 interp->pdb->debugee->pdb->file = NULL;
3059 }
3060
3061 /* Get the name of the file */
3062 for (j = 0; command[j] == ' '; ++j)
3063 continue;
3064 for (i = 0; command[j]; i++, j++)
3065 f[i] = command[j];
3066
3067 f[i] = '\0';
3068
3069 /* open the file */
3070 file = fopen(f, "r");
3071
3072 /* abort if fopen failed */
3073 if (!file) {
3074 Parrot_io_eprintf(pdb->debugger, "Unable to load '%s'\n", f);
3075 return;
3076 }
3077
3078 pfile = mem_allocate_zeroed_typed(PDB_file_t);
3079 pline = mem_allocate_zeroed_typed(PDB_line_t);
3080
3081 pfile->source = (char *)mem_sys_allocate(1024);
3082 pfile->line = pline;
3083 pline->number = 1;
3084
3085 PARROT_ASSERT(interp->op_info_table);
3086 PARROT_ASSERT(pc);
3087
3088 while ((c = fgetc(file)) != EOF) {
3089 /* Grow it */
3090 if (++size == 1024) {
3091 pfile->source = (char *)mem_sys_realloc(pfile->source,
3092 (size_t)pfile->size + 1024);
3093 size = 0;
3094 }
3095 pfile->source[pfile->size] = (char)c;
3096
3097 pfile->size++;
3098
3099 if (c == '\n') {
3100 /* If the line has an opcode move to the next one,
3101 otherwise leave it with NULL to skip it. */
3102 PDB_line_t *newline = mem_allocate_zeroed_typed(PDB_line_t);
3103
3104 if (PDB_hasinstruction(pfile->source + pline->source_offset)) {
3105 size_t n = interp->op_info_table[*pc].op_count;
3106 pline->opcode = pc;
3107 ADD_OP_VAR_PART(interp, interp->code, pc, n);
3108 pc += n;
3109
3110 /* don't walk off the end of the program into neverland */
3111 if (pc >= interp->code->base.data + interp->code->base.size)
3112 break;
3113 }
3114
3115 newline->number = pline->number + 1;
3116 pline->next = newline;
3117 pline = newline;
3118 pline->source_offset = pfile->size;
3119 pline->opcode = NULL;
3120 pline->label = NULL;
3121 }
3122 }
3123
3124 fclose(file);
3125
3126 pdb->state |= PDB_SRC_LOADED;
3127 pdb->file = pfile;
3128
3129 TRACEDEB_MSG("PDB_load_source finished");
3130 }
3131
3132 /*
3133
3134 =item C<char PDB_hasinstruction(const char *c)>
3135
3136 Return true if the line has an instruction.
3137
3138 =cut
3139
3140 */
3141
3142 PARROT_WARN_UNUSED_RESULT
3143 PARROT_PURE_FUNCTION
3144 char
3145 PDB_hasinstruction(ARGIN(const char *c))
3146 {
3147 ASSERT_ARGS(PDB_hasinstruction)
3148 char h = 0;
3149
3150 /* as long as c is not NULL, we're not looking at a comment (#...) or a '\n'... */
3151 while (*c && *c != '#' && *c != '\n') {
3152 /* ... and c is alphanumeric or a quoted string then the line contains
3153 * an instruction. */
3154 if (isalnum((unsigned char) *c) || *c == '"') {
3155 h = 1;
3156 }
3157 else if (*c == ':') {
3158 /* probably a label */
3159 h = 0;
3160 }
3161
3162 c++;
3163 }
3164
3165 return h;
3166 }
3167
3168 /*
3169
3170 =item C<static void no_such_register(PARROT_INTERP, char register_type, UINTVAL
3171 register_num)>
3172
3173 Auxiliar error message function.
3174
3175 =cut
3176
3177 */
3178
3179 static void
3180 no_such_register(PARROT_INTERP, char register_type, UINTVAL register_num)
3181 {
3182 ASSERT_ARGS(no_such_register)
3183
3184 Parrot_io_eprintf(interp, "%c%u = no such register\n",
3185 register_type, register_num);
3186 }
3187
3188 /*
3189
3190 =item C<void PDB_assign(PARROT_INTERP, const char *command)>
3191
3192 Assign to registers.
3193
3194 =cut
3195
3196 */
3197
3198 void
3199 PDB_assign(PARROT_INTERP, ARGIN(const char *command))
3200 {
3201 ASSERT_ARGS(PDB_assign)
3202 UINTVAL register_num;
3203 char reg_type_id;
3204 int reg_type;
3205 PDB_t *pdb = interp->pdb;
3206 Interp *debugger = pdb ? pdb->debugger : interp;
3207 Interp *debugee = pdb ? pdb->debugee : interp;
3208
3209 /* smallest valid commad length is 4, i.e. "I0 1" */
3210 if (strlen(command) < 4) {
3211 Parrot_io_eprintf(debugger, "Must give a register number and value to assign\n");
3212 return;
3213 }
3214 reg_type_id = (unsigned char) toupper((unsigned char) command[0]);
3215 command++;
3216 register_num = get_ulong(&command, 0);
3217
3218 switch (reg_type_id) {
3219 case 'I':
3220 reg_type = REGNO_INT;
3221 break;
3222 case 'N':
3223 reg_type = REGNO_NUM;
3224 break;
3225 case 'S':
3226 reg_type = REGNO_STR;
3227 break;
3228 case 'P':
3229 reg_type = REGNO_PMC;
3230 Parrot_io_eprintf(debugger, "Assigning to PMCs is not currently supported\n");
3231 return;
3232 default:
3233 Parrot_io_eprintf(debugger, "Invalid register type %c\n", reg_type_id);
3234 return;
3235 }
3236 if (register_num >= Parrot_pcc_get_regs_used(debugee,
3237 CURRENT_CONTEXT(debugee), reg_type)) {
3238 no_such_register(debugger, reg_type_id, register_num);
3239 return;
3240 }
3241 switch (reg_type) {
3242 case REGNO_INT:
3243 IREG(register_num) = get_ulong(&command, 0);
3244 break;
3245 case REGNO_NUM:
3246 NREG(register_num) = atof(command);
3247 break;
3248 case REGNO_STR:
3249 SREG(register_num) = Parrot_str_new(debugee, command, strlen(command));
3250 break;
3251 default: ; /* Must never come here */
3252 }
3253 Parrot_io_eprintf(debugger, "\n %c%u = ", reg_type_id, register_num);
3254 Parrot_io_eprintf(debugger, "%Ss\n", GDB_print_reg(debugee, reg_type, register_num));
3255 }
3256
3257 /*
3258
3259 =item C<void PDB_list(PARROT_INTERP, const char *command)>
3260
3261 Show lines from the source code file.
3262
3263 =cut
3264
3265 */
3266
3267 void
3268 PDB_list(PARROT_INTERP, ARGIN(const char *command))
3269 {
3270 ASSERT_ARGS(PDB_list)
3271 char *c;
3272 unsigned long line_number;
3273 unsigned long i;
3274 PDB_line_t *line;
3275 PDB_t *pdb = interp->pdb;
3276 unsigned long n = 10;
3277
3278 TRACEDEB_MSG("PDB_list");
3279 if (!pdb->file || !pdb->file->line) {
3280 Parrot_io_eprintf(pdb->debugger, "No source file loaded\n");
3281 return;
3282 }
3283
3284 /* set the list line if provided */
3285 line_number = get_ulong(&command, 0);
3286 pdb->file->list_line = (unsigned long) line_number;
3287
3288 /* set the number of lines to print */
3289 n = get_ulong(&command, 10);
3290
3291 /* if n is zero, we simply return, as we don't have to print anything */
3292 if (n == 0)
3293 return;
3294
3295 line = pdb->file->line;
3296
3297 for (i = 0; i < pdb->file->list_line && line->next; i++)
3298 line = line->next;
3299
3300 i = 1;
3301 while (line->next) {
3302 Parrot_io_eprintf(pdb->debugger, "%li ", pdb->file->list_line + i);
3303 /* If it has a label print it */
3304 if (line->label)
3305 Parrot_io_eprintf(pdb->debugger, "L%li:\t", line->label->number);
3306
3307 c = pdb->file->source + line->source_offset;
3308
3309 while (*c != '\n')
3310 Parrot_io_eprintf(pdb->debugger, "%c", *(c++));
3311
3312 Parrot_io_eprintf(pdb->debugger, "\n");
3313
3314 line = line->next;
3315
3316 if (i++ == n)
3317 break;
3318 }
3319
3320 if (--i != n)
3321 pdb->file->list_line = 0;
3322 else
3323 pdb->file->list_line += n;
3324 }
3325
3326 /*
3327
3328 =item C<void PDB_eval(PARROT_INTERP, const char *command)>
3329
3330 C<eval>s an instruction.
3331
3332 =cut
3333
3334 */
3335
3336 void
3337 PDB_eval(PARROT_INTERP, ARGIN(const char *command))
3338 {
3339 ASSERT_ARGS(PDB_eval)
3340
3341 PDB_t *pdb = interp->pdb;
3342 Interp *warninterp = (interp->pdb && interp->pdb->debugger) ?
3343 interp->pdb->debugger : interp;
3344 TRACEDEB_MSG("PDB_eval");
3345 UNUSED(command);
3346 Parrot_io_eprintf(warninterp, "The eval command is currently unimplemeneted\n");
3347 }
3348
3349 /*
3350
3351 =item C<opcode_t * PDB_compile(PARROT_INTERP, const char *command)>
3352
3353 Compiles instructions with the PASM compiler.
3354
3355 Appends an C<end> op.
3356
3357 This may be called from C<PDB_eval> above or from the compile opcode
3358 which generates a malloced string.
3359
3360 =cut
3361
3362 */
3363
3364 PARROT_CAN_RETURN_NULL
3365 opcode_t *
3366 PDB_compile(PARROT_INTERP, ARGIN(const char *command))
3367 {
3368 ASSERT_ARGS(PDB_compile)
3369
3370 UNUSED(command);
3371 Parrot_ex_throw_from_c_args(interp, NULL,
3372 EXCEPTION_UNIMPLEMENTED,
3373 "PDB_compile ('PASM1' compiler) has been deprecated");
3374 }
3375
3376 /*
3377
3378 =item C<void PDB_print(PARROT_INTERP, const char *command)>
3379
3380 Print interp registers.
3381
3382 =cut
3383
3384 */
3385
3386 void
3387 PDB_print(PARROT_INTERP, ARGIN(const char *command))
3388 {
3389 ASSERT_ARGS(PDB_print)
3390 const STRING *s = GDB_P(interp->pdb->debugee, command);
3391
3392 TRACEDEB_MSG("PDB_print");
3393 Parrot_io_eprintf(interp, "%Ss\n", s);
3394 }
3395
3396
3397 /*
3398
3399 =item C<void PDB_info(PARROT_INTERP)>
3400
3401 Print the interpreter info.
3402
3403 =cut
3404
3405 */
3406
3407 void
3408 PDB_info(PARROT_INTERP)
3409 {
3410 ASSERT_ARGS(PDB_info)
3411
3412 /* If a debugger is created, use it for printing and use the
3413 * data in his debugee. Otherwise, use current interpreter
3414 * for both */
3415 Parrot_Interp itdeb = interp->pdb ? interp->pdb->debugger : interp;
3416 Parrot_Interp itp = interp->pdb ? interp->pdb->debugee : interp;
3417
3418 Parrot_io_eprintf(itdeb, "Total memory allocated = %ld\n",
3419 interpinfo(itp, TOTAL_MEM_ALLOC));
3420 Parrot_io_eprintf(itdeb, "GC mark runs = %ld\n",
3421 interpinfo(itp, GC_MARK_RUNS));
3422 Parrot_io_eprintf(itdeb, "Lazy gc mark runs = %ld\n",
3423 interpinfo(itp, GC_LAZY_MARK_RUNS));
3424 Parrot_io_eprintf(itdeb, "GC collect runs = %ld\n",
3425 interpinfo(itp, GC_COLLECT_RUNS));
3426 Parrot_io_eprintf(itdeb, "Collect memory = %ld\n",
3427 interpinfo(itp, TOTAL_COPIED));
3428 Parrot_io_eprintf(itdeb, "Active PMCs = %ld\n",
3429 interpinfo(itp, ACTIVE_PMCS));
3430 Parrot_io_eprintf(itdeb, "Extended PMCs = %ld\n",
3431 interpinfo(itp, EXTENDED_PMCS));
3432 Parrot_io_eprintf(itdeb, "Timely GC PMCs = %ld\n",
3433 interpinfo(itp, IMPATIENT_PMCS));
3434 Parrot_io_eprintf(itdeb, "Total PMCs = %ld\n",
3435 interpinfo(itp, TOTAL_PMCS));
3436 Parrot_io_eprintf(itdeb, "Active buffers = %ld\n",
3437 interpinfo(itp, ACTIVE_BUFFERS));
3438 Parrot_io_eprintf(itdeb, "Total buffers = %ld\n",
3439 interpinfo(itp, TOTAL_BUFFERS));
3440 Parrot_io_eprintf(itdeb, "Header allocations since last collect = %ld\n",
3441 interpinfo(itp, HEADER_ALLOCS_SINCE_COLLECT));
3442 Parrot_io_eprintf(itdeb, "Memory allocations since last collect = %ld\n",
3443 interpinfo(itp, MEM_ALLOCS_SINCE_COLLECT));
3444 }
3445
3446 /*
3447
3448 =item C<void PDB_help(PARROT_INTERP, const char *command)>
3449
3450 Print the help text. "Help" with no arguments prints a list of commands.
3451 "Help xxx" prints information on command xxx.
3452
3453 =cut
3454
3455 */
3456
3457 void
3458 PDB_help(PARROT_INTERP, ARGIN(const char *command))
3459 {
3460 ASSERT_ARGS(PDB_help)
3461 const DebuggerCmd *cmd;
3462
3463 const char * cmdline = command;
3464 cmd = get_cmd(& cmdline);
3465
3466 if (cmd) {
3467 Parrot_io_eprintf(interp->pdb->debugger, "%s\n", cmd->help);
3468 }
3469 else {
3470 if (*cmdline == '\0') {
3471 unsigned int i;
3472 Parrot_io_eprintf(interp->pdb->debugger, "List of commands:\n");
3473 for (i= 0; i < sizeof (DebCmdList) / sizeof (DebuggerCmdList); ++i) {
3474 const DebuggerCmdList *cmdlist = DebCmdList + i;
3475 Parrot_io_eprintf(interp->pdb->debugger,
3476 " %-12s-- %s\n", cmdlist->name, cmdlist->cmd->shorthelp);
3477 }
3478 Parrot_io_eprintf(interp->pdb->debugger, "\n"
3479 "Type \"help\" followed by a command name for full documentation.\n\n");
3480
3481 }
3482 else {
3483 Parrot_io_eprintf(interp->pdb->debugger, "Unknown command: %s\n", command);
3484 }
3485 }
3486 }
3487
3488 /*
3489
3490 =item C<void PDB_backtrace(PARROT_INTERP)>
3491
3492 Prints a backtrace of the interp's call chain.
3493
3494 =cut
3495
3496 */
3497
3498 void
3499 PDB_backtrace(PARROT_INTERP)
3500 {
3501 ASSERT_ARGS(PDB_backtrace)
3502 STRING *str;
3503 PMC *old = PMCNULL;
3504 int rec_level = 0;
3505 int limit_count = 0;
3506
3507 /* information about the current sub */
3508 PMC *sub = interpinfo_p(interp, CURRENT_SUB);
3509 PMC *ctx = CURRENT_CONTEXT(interp);
3510
3511 if (!PMC_IS_NULL(sub)) {
3512 str = Parrot_Context_infostr(interp, ctx);
3513 if (str) {
3514 Parrot_io_eprintf(interp, "%Ss", str);
3515 if (interp->code->annotations) {
3516 PMC *annot = PackFile_Annotations_lookup(interp, interp->code->annotations,
3517 Parrot_pcc_get_pc(interp, ctx) - interp->code->base.data + 1, NULL);
3518 if (!PMC_IS_NULL(annot)) {
3519 PMC *pfile = VTABLE_get_pmc_keyed_str(interp, annot,
3520 Parrot_str_new_constant(interp, "file"));
3521 PMC *pline = VTABLE_get_pmc_keyed_str(interp, annot,
3522 Parrot_str_new_constant(interp, "line"));
3523 if ((!PMC_IS_NULL(pfile)) && (!PMC_IS_NULL(pline))) {
3524 STRING *file = VTABLE_get_string(interp, pfile);
3525 INTVAL line = VTABLE_get_integer(interp, pline);
3526 Parrot_io_eprintf(interp, " (%Ss:%li)", file, (long)line);
3527 }
3528 }
3529 }
3530 Parrot_io_eprintf(interp, "\n");
3531 }
3532 }
3533
3534 /* backtrace: follow the continuation chain */
3535 while (1) {
3536 Parrot_Continuation_attributes *sub_cont;
3537
3538 /* Limit the levels dumped, no segfault on infinite recursion */
3539 if (++limit_count > RECURSION_LIMIT)
3540 break;
3541
3542 sub = Parrot_pcc_get_continuation(interp, ctx);
3543
3544 if (PMC_IS_NULL(sub))
3545 break;
3546
3547
3548 sub_cont = PARROT_CONTINUATION(sub);
3549
3550 if (!sub_cont)
3551 break;
3552
3553
3554 str = Parrot_Context_infostr(interp, Parrot_pcc_get_caller_ctx(interp, ctx));
3555
3556
3557 if (!str)
3558 break;
3559
3560
3561 /* recursion detection */
3562 if (ctx == sub_cont->to_ctx) {
3563 ++rec_level;
3564 }
3565 else if (!PMC_IS_NULL(old) && PMC_cont(old) &&
3566 Parrot_pcc_get_pc(interp, PMC_cont(old)->to_ctx) ==
3567 Parrot_pcc_get_pc(interp, PMC_cont(sub)->to_ctx) &&
3568 Parrot_pcc_get_sub(interp, PMC_cont(old)->to_ctx) ==
3569 Parrot_pcc_get_sub(interp, PMC_cont(sub)->to_ctx)) {
3570 ++rec_level;
3571 }
3572 else if (rec_level != 0) {
3573 Parrot_io_eprintf(interp, "... call repeated %d times\n", rec_level);
3574 rec_level = 0;
3575 }
3576
3577 /* print the context description */
3578 if (rec_level == 0) {
3579 PackFile_ByteCode *seg = sub_cont->seg;
3580 Parrot_io_eprintf(interp, "%Ss", str);
3581 if (seg->annotations) {
3582 PMC *annot = PackFile_Annotations_lookup(interp, seg->annotations,
3583 Parrot_pcc_get_pc(interp, sub_cont->to_ctx) - seg->base.data,
3584 NULL);
3585
3586 if (!PMC_IS_NULL(annot)) {
3587 PMC *pfile = VTABLE_get_pmc_keyed_str(interp, annot,
3588 Parrot_str_new_constant(interp, "file"));
3589 PMC *pline = VTABLE_get_pmc_keyed_str(interp, annot,
3590 Parrot_str_new_constant(interp, "line"));
3591 if ((!PMC_IS_NULL(pfile)) && (!PMC_IS_NULL(pline))) {
3592 STRING *file = VTABLE_get_string(interp, pfile);
3593 INTVAL line = VTABLE_get_integer(interp, pline);
3594 Parrot_io_eprintf(interp, " (%Ss:%li)", file, (long)line);
3595 }
3596 }
3597 }
3598 Parrot_io_eprintf(interp, "\n");
3599 }
3600
3601 /* get the next Continuation */
3602 ctx = Parrot_pcc_get_caller_ctx(interp, ctx);
3603 old = sub;
3604
3605 if (!ctx)
3606 break;
3607 }
3608
3609 if (rec_level != 0)
3610 Parrot_io_eprintf(interp, "... call repeated %d times\n", rec_level);
3611 }
3612
3613 /*
3614 * GDB functions
3615 *
3616 * GDB_P gdb> pp $I0 print register I0 value
3617 *
3618 * RT46139 more, more
3619 */
3620
3621 /*
3622
3623 =item C<static STRING * GDB_print_reg(PARROT_INTERP, int t, int n)>
3624
3625 Used by GDB_P to convert register values for display. Takes register
3626 type and number as arguments.
3627
3628 Returns a pointer to the start of the string, (except for PMCs, which
3629 print directly and return "").
3630
3631 =cut
3632
3633 */
3634
3635 PARROT_WARN_UNUSED_RESULT
3636 PARROT_CANNOT_RETURN_NULL
3637 PARROT_OBSERVER
3638 static STRING *
3639 GDB_print_reg(PARROT_INTERP, int t, int n)
3640 {
3641 ASSERT_ARGS(GDB_print_reg)
3642 char * string;
3643
3644 if (n >= 0 && (UINTVAL)n < Parrot_pcc_get_regs_used(interp, CURRENT_CONTEXT(interp), t)) {
3645 switch (t) {
3646 case REGNO_INT:
3647 return Parrot_str_from_int(interp, IREG(n));
3648 case REGNO_NUM:
3649 return Parrot_str_from_num(interp, NREG(n));
3650 case REGNO_STR:
3651 /* This hack is needed because we occasionally are told
3652 that we have string registers when we actually don't */
3653 string = (char *) SREG(n);
3654
3655 if (string == '\0')
3656 return Parrot_str_new(interp, "", 0);
3657 else
3658 return SREG(n);
3659 case REGNO_PMC:
3660 /* prints directly */
3661 trace_pmc_dump(interp, PREG(n));
3662 return Parrot_str_new(interp, "", 0);
3663 default:
3664 break;
3665 }
3666 }
3667 return Parrot_str_new(interp, "no such register", 0);
3668 }
3669
3670 /*
3671
3672 =item C<static STRING * GDB_P(PARROT_INTERP, const char *s)>
3673
3674 Used by PDB_print to print register values. Takes a pointer to the
3675 register name(s).
3676
3677 Returns "" or error message.
3678
3679 =cut
3680
3681 */
3682
3683 PARROT_WARN_UNUSED_RESULT
3684 PARROT_CANNOT_RETURN_NULL
3685 PARROT_OBSERVER
3686 static STRING *
3687 GDB_P(PARROT_INTERP, ARGIN(const char *s))
3688 {
3689 ASSERT_ARGS(GDB_P)
3690 int t;
3691 char reg_type;
3692
3693 TRACEDEB_MSG("GDB_P");
3694 /* Skip leading whitespace. */
3695 while (isspace((unsigned char)*s))
3696 s++;
3697
3698 reg_type = (unsigned char) toupper((unsigned char)*s);
3699
3700 switch (reg_type) {
3701 case 'I': t = REGNO_INT; break;
3702 case 'N': t = REGNO_NUM; break;
3703 case 'S': t = REGNO_STR; break;
3704 case 'P': t = REGNO_PMC; break;
3705 default: return Parrot_str_new(interp, "Need a register.", 0);
3706 }
3707 if (! s[1]) {
3708 /* Print all registers of this type. */
3709 const int max_reg = Parrot_pcc_get_regs_used(interp, CURRENT_CONTEXT(interp), t);
3710 int n;
3711
3712 for (n = 0; n < max_reg; n++) {
3713 /* this must be done in two chunks because PMC's print directly. */
3714 Parrot_io_eprintf(interp, "\n %c%d = ", reg_type, n);
3715 Parrot_io_eprintf(interp, "%Ss", GDB_print_reg(interp, t, n));
3716 }
3717 return Parrot_str_new(interp, "", 0);
3718 }
3719 else if (s[1] && isdigit((unsigned char)s[1])) {
3720 const int n = atoi(s + 1);
3721 return GDB_print_reg(interp, t, n);
3722 }
3723 else
3724 return Parrot_str_new(interp, "no such register", 0);
3725
3726 }
3727
3728 /*
3729
3730 =back
3731
3732 =head1 SEE ALSO
3733
3734 F<include/parrot/debugger.h>, F<src/parrot_debugger.c> and F<ops/debug.ops>.
3735
3736 =head1 HISTORY
3737
3738 =over 4
3739
3740 =item Initial version by Daniel Grunblatt on 2002.5.19.
3741
3742 =item Start of rewrite - leo 2005.02.16
3743
3744 The debugger now uses its own interpreter. User code is run in
3745 Interp *debugee. We have:
3746
3747 debug_interp->pdb->debugee->debugger
3748 ^ |
3749 | v
3750 +------------- := -----------+
3751
3752 Debug commands are mostly run inside the C<debugger>. User code
3753 runs of course in the C<debugee>.
3754
3755 =back
3756
3757 =cut
3758
3759 */
3760
3761
3762 /*
3763 * Local variables:
3764 * c-file-style: "parrot"
3765 * End:
3766 * vim: expandtab shiftwidth=4:
3767 */
parrot vm git mirror