2 Copyright (C) 2001-2008, The Perl Foundation.
7 src/debug.c - Parrot debugging
11 This file implements Parrot debugging and is used by C<pdb>, the Parrot
12 debugger, and the C<debug> ops.
24 #include "parrot/parrot.h"
25 #include "interp_guts.h"
26 #include "parrot/oplib.h"
28 #include "parrot/debug.h"
29 #include "parrot/oplib/ops.h"
33 /* Not sure how we want to handle this sort of cross-project header */
36 IMCC_warning(PARROT_INTERP
, ARGIN(const char *fmt
), ...);
39 * These constants correspond to the debugger commands.
40 * To map command strings to their numeric values,
41 * use the algorithm from parse_command().
59 debug_cmd_int
= 175185,
60 debug_cmd_run
= 176460,
61 debug_cmd_num
= 174675,
62 debug_cmd_str
= 179265,
63 debug_cmd_pmc
= 163455,
64 debug_cmd_eval
= 277950,
65 debug_cmd_help
= 282540,
66 debug_cmd_info
= 281775,
67 debug_cmd_list
= 295035,
68 debug_cmd_load
= 268005,
69 debug_cmd_next
= 297330,
70 debug_cmd_quit
= 294780,
71 debug_cmd_break
= 409785,
72 debug_cmd_print
= 441150,
73 debug_cmd_stack
= 414120,
74 debug_cmd_trace
= 405705,
75 debug_cmd_watch
= 416160,
76 debug_cmd_enable
= 571455,
77 debug_cmd_delete
= 588285,
78 debug_cmd_script_file
= 617610,
79 debug_cmd_disable
= 772140,
80 debug_cmd_continue
= 1053405,
81 debug_cmd_disassemble
= 1903830
84 /* HEADERIZER HFILE: include/parrot/debug.h */
86 /* HEADERIZER BEGIN: static */
87 /* Don't modify between HEADERIZER BEGIN / HEADERIZER END. Your changes will be lost. */
89 static void dump_string(PARROT_INTERP
, ARGIN_NULLOK(const STRING
*s
))
90 __attribute__nonnull__(1);
92 PARROT_WARN_UNUSED_RESULT
93 PARROT_CANNOT_RETURN_NULL
94 static const char* GDB_P(PARROT_INTERP
, ARGIN(const char *s
))
95 __attribute__nonnull__(1)
96 __attribute__nonnull__(2);
98 PARROT_WARN_UNUSED_RESULT
99 PARROT_CANNOT_RETURN_NULL
100 static const char* GDB_print_reg(PARROT_INTERP
, int t
, int n
)
101 __attribute__nonnull__(1);
103 PARROT_CAN_RETURN_NULL
104 PARROT_WARN_UNUSED_RESULT
105 static const char * nextarg(ARGIN_NULLOK(const char *command
));
107 PARROT_CAN_RETURN_NULL
108 PARROT_IGNORABLE_RESULT
109 static const char * parse_command(
110 ARGIN(const char *command
),
111 ARGOUT(unsigned long *cmdP
))
112 __attribute__nonnull__(1)
113 __attribute__nonnull__(2)
114 FUNC_MODIFIES(*cmdP
);
116 PARROT_CANNOT_RETURN_NULL
117 PARROT_WARN_UNUSED_RESULT
118 static const char * parse_int(ARGIN(const char *str
), ARGOUT(int *intP
))
119 __attribute__nonnull__(1)
120 __attribute__nonnull__(2)
121 FUNC_MODIFIES(*intP
);
123 PARROT_CAN_RETURN_NULL
124 PARROT_WARN_UNUSED_RESULT
125 static const char* parse_key(PARROT_INTERP
,
126 ARGIN(const char *str
),
128 __attribute__nonnull__(1)
129 __attribute__nonnull__(2)
130 __attribute__nonnull__(3)
131 FUNC_MODIFIES(*keyP
);
133 PARROT_CAN_RETURN_NULL
134 PARROT_WARN_UNUSED_RESULT
135 static const char * parse_string(PARROT_INTERP
,
136 ARGIN(const char *str
),
137 ARGOUT(STRING
**strP
))
138 __attribute__nonnull__(1)
139 __attribute__nonnull__(2)
140 __attribute__nonnull__(3)
141 FUNC_MODIFIES(*strP
);
143 PARROT_CANNOT_RETURN_NULL
144 static const char * skip_command(ARGIN(const char *str
))
145 __attribute__nonnull__(1);
147 PARROT_CANNOT_RETURN_NULL
148 PARROT_WARN_UNUSED_RESULT
149 static const char * skip_ws(ARGIN(const char *str
))
150 __attribute__nonnull__(1);
152 /* Don't modify between HEADERIZER BEGIN / HEADERIZER END. Your changes will be lost. */
153 /* HEADERIZER END: static */
158 =item C<static const char * nextarg>
160 Returns the position just past the current argument in the PASM instruction
161 C<command>. This is not the same as C<skip_command()>, which is intended for
162 debugger commands. This function is used for C<eval>.
168 PARROT_CAN_RETURN_NULL
169 PARROT_WARN_UNUSED_RESULT
171 nextarg(ARGIN_NULLOK(const char *command
))
173 /* as long as the character pointed to by command is not NULL,
174 * and it is either alphanumeric, a comma or a closing bracket,
175 * continue looking for the next argument.
178 while (isalnum((unsigned char) *command
) || *command
== ',' || *command
== ']')
181 /* eat as much space as possible */
182 while (isspace((unsigned char) *command
))
191 =item C<static const char * skip_ws>
193 Returns the pointer past any whitespace.
199 PARROT_CANNOT_RETURN_NULL
200 PARROT_WARN_UNUSED_RESULT
202 skip_ws(ARGIN(const char *str
))
204 /* as long as str is not NULL and it contains space, skip it */
205 while (*str
&& isspace((unsigned char) *str
))
213 =item C<static const char * skip_command>
215 Returns the pointer past the current debugger command. (This is an
216 alternative to the C<skip_command()> macro above.)
222 PARROT_CANNOT_RETURN_NULL
224 skip_command(ARGIN(const char *str
))
226 /* while str is not null and it contains a command (no spaces),
229 while (*str
&& !isspace((unsigned char) *str
))
232 /* eat all space after that */
233 while (*str
&& isspace((unsigned char) *str
))
241 =item C<static const char * parse_int>
243 Parse an C<int> out of a string and return a pointer to just after the C<int>.
244 The output parameter C<intP> contains the parsed value.
250 PARROT_CANNOT_RETURN_NULL
251 PARROT_WARN_UNUSED_RESULT
253 parse_int(ARGIN(const char *str
), ARGOUT(int *intP
))
257 *intP
= strtol(str
, &end
, 0);
264 =item C<static const char * parse_string>
266 Parse a double-quoted string out of a C string and return a pointer to
267 just after the string. The parsed string is converted to a Parrot
268 C<STRING> and placed in the output parameter C<strP>.
274 PARROT_CAN_RETURN_NULL
275 PARROT_WARN_UNUSED_RESULT
277 parse_string(PARROT_INTERP
, ARGIN(const char *str
), ARGOUT(STRING
**strP
))
279 const char *string_start
;
281 /* if this is not a quoted string, there's nothing to parse */
290 /* parse while there's no closing quote */
291 while (*str
&& *str
!= '"') {
292 /* skip any potentially escaped quotes */
293 if (*str
== '\\' && str
[1])
299 /* create the output STRING */
300 *strP
= string_make(interp
, string_start
, str
- string_start
, NULL
, 0);
302 /* skip the closing quote */
311 =item C<static const char* parse_key>
313 Parse an aggregate key out of a string and return a pointer to just
314 after the key. Currently only string and integer keys are allowed.
320 PARROT_CAN_RETURN_NULL
321 PARROT_WARN_UNUSED_RESULT
323 parse_key(PARROT_INTERP
, ARGIN(const char *str
), ARGOUT(PMC
**keyP
))
325 /* clear output parameter */
328 /* make sure it's a key */
335 /* if this is a string key, create a Parrot STRING */
337 STRING
*parrot_string
;
338 str
= parse_string(interp
, str
, &parrot_string
);
339 *keyP
= key_new_string(interp
, parrot_string
);
341 /* if this is a numeric key */
342 else if (isdigit((unsigned char) *str
)) {
344 str
= parse_int(str
, &value
);
345 *keyP
= key_new_integer(interp
, (INTVAL
) value
);
347 /* unsupported case; neither a string nor a numeric key */
352 /* hm, but if this doesn't match, it's probably an error */
353 /* XXX str can be NULL from parse_string() */
357 /* skip the closing brace on the key */
363 =item C<static const char * parse_command>
365 Convert the command at the beginning of a string into a numeric value
366 that can be used as a switch key for fast lookup.
372 PARROT_CAN_RETURN_NULL
373 PARROT_IGNORABLE_RESULT
375 parse_command(ARGIN(const char *command
), ARGOUT(unsigned long *cmdP
))
380 /* Skip leading whitespace. */
381 while (isspace((unsigned char) *command
))
384 if (*command
== '\0') {
389 for (i
= 0; isalpha((unsigned char) *command
); command
++, i
++)
390 c
+= (tolower((unsigned char) *command
) + (i
+ 1)) * ((i
+ 1) * 255);
392 /* Nonempty and did not start with a letter */
394 c
= (unsigned long)-1;
403 =item C<void Parrot_debugger_init>
405 Initializes the Parrot debugger, if it's not already initialized.
407 =item C<void Parrot_debugger_load>
409 Loads a Parrot source file for the current program.
411 =item C<void Parrot_debugger_break>
413 Breaks execution and drops into the debugger. If we are already into the
414 debugger and it is the first call, set a breakpoint.
416 When you re run/continue the program being debugged it will pay no attention to
419 RT #42377: clone the interpreter to allow people to play into the
420 debugger and then continue the normal execution of the program.
427 Parrot_debugger_init(PARROT_INTERP
)
434 pdb
= mem_allocate_zeroed_typed(PDB_t
);
436 pdb
->cur_opcode
= interp
->code
->base
.data
;
437 pdb
->state
|= PDB_RUNNING
;
441 Parrot_debugger_load(PARROT_INTERP
, ARGIN_NULLOK(STRING
*filename
))
446 real_exception(interp
, NULL
, 0, "No debugger");
448 file
= string_to_cstring(interp
, filename
);
449 PDB_load_source(interp
, file
);
450 string_cstring_free(file
);
454 Parrot_debugger_break(PARROT_INTERP
, ARGIN(opcode_t
* cur_opcode
))
457 real_exception(interp
, NULL
, 0, "No debugger");
459 if (!interp
->pdb
->file
)
460 real_exception(interp
, NULL
, 0, "No file loaded to debug");
462 if (!(interp
->pdb
->state
& PDB_BREAK
)) {
463 const char * command
;
465 interp
->pdb
->state
|= PDB_BREAK
;
466 interp
->pdb
->state
|= PDB_STOPPED
;
467 interp
->pdb
->cur_opcode
= (opcode_t
*)cur_opcode
+ 1;
469 PDB_set_break(interp
, NULL
);
471 while (!(interp
->pdb
->state
& PDB_EXIT
)) {
472 PDB_get_command(interp
);
473 command
= interp
->pdb
->cur_command
;
474 PDB_run_command(interp
, command
);
477 /* RT #42378 this is not ok */
481 interp
->pdb
->cur_opcode
= (opcode_t
*)cur_opcode
+ 1;
482 PDB_set_break(interp
, NULL
);
487 =item C<void PDB_get_command>
489 Get a command from the user input to execute.
491 It saves the last command executed (in C<< pdb->last_command >>), so it
492 first frees the old one and updates it with the current one.
494 Also prints the next line to run if the program is still active.
496 The user input can't be longer than 255 characters.
498 The input is saved in C<< pdb->cur_command >>.
505 PDB_get_command(PARROT_INTERP
)
510 PDB_t
* const pdb
= interp
->pdb
;
512 /* flush the buffered data */
515 /* not used any more */
516 if (pdb
->last_command
&& *pdb
->cur_command
) {
517 mem_sys_free(pdb
->last_command
);
518 pdb
->last_command
= NULL
;
521 /* update the last command */
522 if (pdb
->cur_command
&& *pdb
->cur_command
)
523 pdb
->last_command
= pdb
->cur_command
;
525 /* if the program is stopped and running show the next line to run */
526 if ((pdb
->state
& PDB_STOPPED
) && (pdb
->state
& PDB_RUNNING
)) {
527 PDB_line_t
*line
= pdb
->file
->line
;
529 while (pdb
->cur_opcode
!= line
->opcode
)
532 PIO_eprintf(interp
, "%li ", line
->number
);
533 c
= pdb
->file
->source
+ line
->source_offset
;
535 while (c
&& (*c
!= '\n'))
536 PIO_eprintf(interp
, "%c", *(c
++));
541 /* RT #46109 who frees that */
542 /* need to allocate 256 chars as string is null-terminated i.e. 255 + 1*/
543 c
= (char *)mem_sys_allocate(256);
545 PIO_eprintf(interp
, "\n(pdb) ");
547 /* skip leading whitespace */
550 } while (isspace((unsigned char)ch
) && ch
!= '\n');
552 /* generate string (no more than 255 chars) */
553 while (ch
!= EOF
&& ch
!= '\n' && (i
< 255)) {
563 pdb
->cur_command
= c
;
568 =item C<void PDB_script_file>
570 Interprets the contents of a file as user input commands
577 PDB_script_file(PARROT_INTERP
, ARGIN(const char *command
))
580 const char *ptr
= (const char *)&buf
;
584 command
= nextarg(command
);
586 fd
= fopen(command
, "r");
588 IMCC_warning(interp
, "script_file: "
589 "Error reading script file %s.\n",
597 fgets(buf
, 1024, fd
);
600 for (ptr
= (char *)&buf
; *ptr
&& isspace((unsigned char)*ptr
); ptr
++);
602 /* avoid null blank and commented lines */
603 if (*buf
== '\0' || *buf
== '#')
606 buf
[strlen(buf
)-1]='\0';
607 /* RT #46117: handle command error and print out script line
608 * PDB_run_command should return non-void value?
609 * stop execution of script if fails
610 * RT #46115: avoid this verbose output? add -v flag? */
611 if (PDB_run_command(interp
, buf
)) {
612 IMCC_warning(interp
, "script_file: "
613 "Error interpreting command at line %d (%s).\n",
623 =item C<int PDB_run_command>
627 Hash the command to make a simple switch calling the correct handler.
633 PARROT_IGNORABLE_RESULT
635 PDB_run_command(PARROT_INTERP
, ARGIN(const char *command
))
638 PDB_t
* const pdb
= interp
->pdb
;
639 const char * const original_command
= command
;
641 /* keep a pointer to the command, in case we need to report an error */
643 /* get a number from what the user typed */
644 command
= parse_command(original_command
, &c
);
647 skip_command(command
);
651 switch ((enum DebugCmd
)c
) {
652 case debug_cmd_script_file
:
653 PDB_script_file(interp
, command
);
655 case debug_cmd_disassemble
:
656 PDB_disassemble(interp
, command
);
659 PDB_load_source(interp
, command
);
663 PDB_list(interp
, command
);
666 case debug_cmd_break
:
667 PDB_set_break(interp
, command
);
670 case debug_cmd_watch
:
671 PDB_watchpoint(interp
, command
);
674 case debug_cmd_delete
:
675 PDB_delete_breakpoint(interp
, command
);
677 case debug_cmd_disable
:
678 PDB_disable_breakpoint(interp
, command
);
680 case debug_cmd_enable
:
681 PDB_enable_breakpoint(interp
, command
);
685 PDB_init(interp
, command
);
686 PDB_continue(interp
, NULL
);
689 case debug_cmd_continue
:
690 PDB_continue(interp
, command
);
693 case debug_cmd_print
:
694 PDB_print(interp
, command
);
698 PDB_next(interp
, command
);
701 case debug_cmd_trace
:
702 PDB_trace(interp
, command
);
706 PDB_eval(interp
, command
);
713 PDB_help(interp
, command
);
717 pdb
->state
|= PDB_EXIT
;
719 case (enum DebugCmd
)0:
720 if (pdb
->last_command
)
721 PDB_run_command(interp
, pdb
->last_command
);
725 "Undefined command: \"%s\". Try \"help\".", original_command
);
733 =item C<void PDB_next>
735 Execute the next N operation(s).
737 Inits the program if needed, runs the next N >= 1 operations and stops.
744 PDB_next(PARROT_INTERP
, ARGIN_NULLOK(const char *command
))
747 PDB_t
* const pdb
= interp
->pdb
;
749 /* Init the program if it's not running */
750 if (!(pdb
->state
& PDB_RUNNING
))
751 PDB_init(interp
, command
);
753 command
= nextarg(command
);
754 /* Get the number of operations to execute if any */
755 if (command
&& isdigit((unsigned char) *command
))
758 /* Erase the stopped flag */
759 pdb
->state
&= ~PDB_STOPPED
;
762 for (; n
&& pdb
->cur_opcode
; n
--)
763 DO_OP(pdb
->cur_opcode
, pdb
->debugee
);
765 /* Set the stopped flag */
766 pdb
->state
|= PDB_STOPPED
;
768 /* If program ended */
771 * RT #46119 this doesn't handle resume opcodes
773 if (!pdb
->cur_opcode
)
774 (void)PDB_program_end(interp
);
779 =item C<void PDB_trace>
781 Execute the next N operations; if no number is specified, it defaults to 1.
788 PDB_trace(PARROT_INTERP
, ARGIN_NULLOK(const char *command
))
791 PDB_t
* const pdb
= interp
->pdb
;
794 /* if debugger is not running yet, initialize */
795 if (!(pdb
->state
& PDB_RUNNING
))
796 PDB_init(interp
, command
);
798 command
= nextarg(command
);
799 /* if the number of ops to run is specified, convert to a long */
800 if (command
&& isdigit((unsigned char) *command
))
803 /* clear the PDB_STOPPED flag, we'll be running n ops now */
804 pdb
->state
&= ~PDB_STOPPED
;
805 debugee
= pdb
->debugee
;
808 for (; n
&& pdb
->cur_opcode
; n
--) {
810 debugee
->code
->base
.data
,
811 debugee
->code
->base
.data
+
812 debugee
->code
->base
.size
,
813 debugee
->pdb
->cur_opcode
);
814 DO_OP(pdb
->cur_opcode
, debugee
);
817 /* we just stopped */
818 pdb
->state
|= PDB_STOPPED
;
820 /* If program ended */
821 if (!pdb
->cur_opcode
)
822 (void)PDB_program_end(interp
);
827 =item C<PDB_condition_t * PDB_cond>
829 Analyzes a condition from the user input.
835 PARROT_CAN_RETURN_NULL
837 PDB_cond(PARROT_INTERP
, ARGIN(const char *command
))
839 PDB_condition_t
*condition
;
843 /* Return if no more arguments */
844 if (!(command
&& *command
)) {
845 PIO_eprintf(interp
, "No condition specified\n");
849 /* Allocate new condition */
850 condition
= mem_allocate_typed(PDB_condition_t
);
855 condition
->type
= PDB_cond_int
;
859 condition
->type
= PDB_cond_num
;
863 condition
->type
= PDB_cond_str
;
867 condition
->type
= PDB_cond_pmc
;
870 PIO_eprintf(interp
, "First argument must be a register\n");
871 mem_sys_free(condition
);
875 /* get the register number */
876 condition
->reg
= (unsigned char)atoi(++command
);
878 /* the next argument might have no spaces between the register and the
882 /* RT #46121 Does /this/ have to do with the fact that PASM registers used to have
883 * maximum of 2 digits? If so, there should be a while loop, I think.
885 if (condition
->reg
> 9)
889 skip_command(command
);
891 /* Now the condition */
894 if (*(command
+ 1) == '=')
895 condition
->type
|= PDB_cond_ge
;
896 else if (*(command
+ 1) == ' ')
897 condition
->type
|= PDB_cond_gt
;
902 if (*(command
+ 1) == '=')
903 condition
->type
|= PDB_cond_le
;
904 else if (*(command
+ 1) == ' ')
905 condition
->type
|= PDB_cond_lt
;
910 if (*(command
+ 1) == '=')
911 condition
->type
|= PDB_cond_eq
;
916 if (*(command
+ 1) == '=')
917 condition
->type
|= PDB_cond_ne
;
922 INV_COND
: PIO_eprintf(interp
, "Invalid condition\n");
923 mem_sys_free(condition
);
927 /* if there's an '=', skip it */
928 if (*(command
+ 1) == '=')
934 skip_command(command
);
936 /* return if no more arguments */
937 if (!(command
&& *command
)) {
938 PIO_eprintf(interp
, "Can't compare a register with nothing\n");
939 mem_sys_free(condition
);
943 if (isalpha((unsigned char)*command
)) {
944 /* It's a register - we first check that it's the correct type */
948 if (!(condition
->type
& PDB_cond_int
))
953 if (!(condition
->type
& PDB_cond_num
))
958 if (!(condition
->type
& PDB_cond_str
))
963 if (!(condition
->type
& PDB_cond_pmc
))
967 WRONG_REG
: PIO_eprintf(interp
, "Register types don't agree\n");
968 mem_sys_free(condition
);
972 /* Now we check and store the register number */
973 reg_number
= (int)atoi(++command
);
975 if (reg_number
< 0) {
976 PIO_eprintf(interp
, "Out-of-bounds register\n");
977 mem_sys_free(condition
);
981 condition
->value
= mem_allocate_typed(int);
982 *(int *)condition
->value
= reg_number
;
984 /* If the first argument was an integer */
985 else if (condition
->type
& PDB_cond_int
) {
986 /* This must be either an integer constant or register */
987 condition
->value
= mem_allocate_typed(INTVAL
);
988 *(INTVAL
*)condition
->value
= (INTVAL
)atoi(command
);
989 condition
->type
|= PDB_cond_const
;
991 else if (condition
->type
& PDB_cond_num
) {
992 condition
->value
= mem_allocate_typed(FLOATVAL
);
993 *(FLOATVAL
*)condition
->value
= (FLOATVAL
)atof(command
);
994 condition
->type
|= PDB_cond_const
;
996 else if (condition
->type
& PDB_cond_str
) {
997 for (i
= 1; ((command
[i
] != '"') && (i
< 255)); i
++)
998 str
[i
- 1] = command
[i
];
1000 condition
->value
= string_make(interp
,
1001 str
, i
- 1, NULL
, PObj_external_FLAG
);
1002 condition
->type
|= PDB_cond_const
;
1004 else if (condition
->type
& PDB_cond_pmc
) {
1005 /* RT #46123 Need to figure out what to do in this case.
1006 * For the time being, we just bail. */
1007 PIO_eprintf(interp
, "Can't compare PMC with constant\n");
1008 mem_sys_free(condition
);
1012 /* We're not part of a list yet */
1013 condition
->next
= NULL
;
1020 =item C<void PDB_watchpoint>
1029 PDB_watchpoint(PARROT_INTERP
, ARGIN(const char *command
))
1031 PDB_t
* const pdb
= interp
->pdb
;
1032 PDB_condition_t
* const condition
= PDB_cond(interp
, command
);
1037 /* Add it to the head of the list */
1038 if (pdb
->watchpoint
)
1039 condition
->next
= pdb
->watchpoint
;
1041 pdb
->watchpoint
= condition
;
1046 =item C<void PDB_set_break>
1048 Set a break point, the source code file must be loaded.
1055 PDB_set_break(PARROT_INTERP
, ARGIN_NULLOK(const char *command
))
1057 PDB_t
* const pdb
= interp
->pdb
;
1058 PDB_breakpoint_t
*newbreak
;
1059 PDB_breakpoint_t
*sbreak
;
1060 PDB_condition_t
*condition
;
1064 command
= nextarg(command
);
1065 /* If no line number was specified, set it at the current line */
1066 if (command
&& *command
) {
1067 const long ln
= atol(command
);
1070 /* Move to the line where we will set the break point */
1071 line
= pdb
->file
->line
;
1073 for (i
= 1; ((i
< ln
) && (line
->next
)); i
++)
1076 /* Abort if the line number provided doesn't exist */
1079 "Can't set a breakpoint at line number %li\n", ln
);
1084 /* Get the line to set it */
1085 line
= pdb
->file
->line
;
1087 while (line
->opcode
!= pdb
->cur_opcode
) {
1091 "No current line found and no line number specified\n");
1097 /* Skip lines that are not related to an opcode */
1098 while (!line
->opcode
)
1101 /* Allocate the new break point */
1102 newbreak
= mem_allocate_typed(PDB_breakpoint_t
);
1105 skip_command(command
);
1108 real_exception(interp
, NULL
, 1, "NULL command passed to PDB_set_break");
1112 /* if there is another argument to break, besides the line number,
1113 * it should be an 'if', so we call another handler. */
1114 if (command
&& *command
) {
1115 skip_command(command
);
1116 if ((condition
= PDB_cond(interp
, command
)))
1117 newbreak
->condition
= condition
;
1120 /* If there are no other arguments, or if there isn't a valid condition,
1121 then condition will be NULL */
1123 newbreak
->condition
= NULL
;
1125 /* Set the address where to stop */
1126 newbreak
->pc
= line
->opcode
;
1128 /* No next breakpoint */
1129 newbreak
->next
= NULL
;
1131 /* Don't skip (at least initially) */
1134 /* Add the breakpoint to the end of the list */
1136 sbreak
= pdb
->breakpoint
;
1139 while (sbreak
->next
)
1140 sbreak
= sbreak
->next
;
1142 newbreak
->prev
= sbreak
;
1143 sbreak
->next
= newbreak
;
1144 i
= sbreak
->next
->id
= sbreak
->id
+ 1;
1147 newbreak
->prev
= NULL
;
1148 pdb
->breakpoint
= newbreak
;
1149 i
= pdb
->breakpoint
->id
= 0;
1152 PIO_eprintf(interp
, "Breakpoint %li at line %li\n", i
, line
->number
);
1157 =item C<void PDB_init>
1166 PDB_init(PARROT_INTERP
, SHIM(const char *command
))
1168 PDB_t
* const pdb
= interp
->pdb
;
1170 /* Restart if we are already running */
1171 if (pdb
->state
& PDB_RUNNING
)
1172 PIO_eprintf(interp
, "Restarting\n");
1174 /* Add the RUNNING state */
1175 pdb
->state
|= PDB_RUNNING
;
1180 =item C<void PDB_continue>
1182 Continue running the program. If a number is specified, skip that many
1190 PDB_continue(PARROT_INTERP
, ARGIN_NULLOK(const char *command
))
1192 PDB_t
* const pdb
= interp
->pdb
;
1194 /* Skip any breakpoint? */
1195 if (command
&& *command
) {
1197 if (!pdb
->breakpoint
) {
1198 PIO_eprintf(interp
, "No breakpoints to skip\n");
1202 command
= nextarg(command
);
1204 PDB_skip_breakpoint(interp
, ln
);
1207 /* Run while no break point is reached */
1208 while (!PDB_break(interp
))
1209 DO_OP(pdb
->cur_opcode
, pdb
->debugee
);
1214 =item C<PDB_breakpoint_t * PDB_find_breakpoint>
1216 Find breakpoint number N; returns C<NULL> if the breakpoint doesn't
1217 exist or if no breakpoint was specified.
1223 PARROT_CAN_RETURN_NULL
1224 PARROT_WARN_UNUSED_RESULT
1226 PDB_find_breakpoint(PARROT_INTERP
, ARGIN(const char *command
))
1228 command
= nextarg(command
);
1229 if (isdigit((unsigned char) *command
)) {
1230 const long n
= atol(command
);
1231 PDB_breakpoint_t
*breakpoint
= interp
->pdb
->breakpoint
;
1233 while (breakpoint
&& breakpoint
->id
!= n
)
1234 breakpoint
= breakpoint
->next
;
1237 PIO_eprintf(interp
, "No breakpoint number %ld", n
);
1244 /* Report an appropriate error */
1246 PIO_eprintf(interp
, "Not a valid breakpoint");
1248 PIO_eprintf(interp
, "No breakpoint specified");
1256 =item C<void PDB_disable_breakpoint>
1258 Disable a breakpoint; it can be reenabled with the enable command.
1265 PDB_disable_breakpoint(PARROT_INTERP
, ARGIN(const char *command
))
1267 PDB_breakpoint_t
* const breakpoint
= PDB_find_breakpoint(interp
, command
);
1269 /* if the breakpoint exists, disable it. */
1271 breakpoint
->skip
= -1;
1276 =item C<void PDB_enable_breakpoint>
1278 Reenable a disabled breakpoint; if the breakpoint was not disabled, has
1286 PDB_enable_breakpoint(PARROT_INTERP
, ARGIN(const char *command
))
1288 PDB_breakpoint_t
* const breakpoint
= PDB_find_breakpoint(interp
, command
);
1290 /* if the breakpoint exists, and it was disabled, enable it. */
1291 if (breakpoint
&& breakpoint
->skip
== -1)
1292 breakpoint
->skip
= 0;
1297 =item C<void PDB_delete_breakpoint>
1299 Delete a breakpoint.
1306 PDB_delete_breakpoint(PARROT_INTERP
, ARGIN(const char *command
))
1308 PDB_breakpoint_t
* const breakpoint
= PDB_find_breakpoint(interp
, command
);
1311 const PDB_line_t
*line
= interp
->pdb
->file
->line
;
1313 while (line
->opcode
!= breakpoint
->pc
)
1316 /* Delete the condition structure, if there is one */
1317 if (breakpoint
->condition
) {
1318 PDB_delete_condition(interp
, breakpoint
);
1319 breakpoint
->condition
= NULL
;
1322 /* Remove the breakpoint from the list */
1323 if (breakpoint
->prev
&& breakpoint
->next
) {
1324 breakpoint
->prev
->next
= breakpoint
->next
;
1325 breakpoint
->next
->prev
= breakpoint
->prev
;
1327 else if (breakpoint
->prev
&& !breakpoint
->next
) {
1328 breakpoint
->prev
->next
= NULL
;
1330 else if (!breakpoint
->prev
&& breakpoint
->next
) {
1331 breakpoint
->next
->prev
= NULL
;
1332 interp
->pdb
->breakpoint
= breakpoint
->next
;
1335 interp
->pdb
->breakpoint
= NULL
;
1338 /* Kill the breakpoint */
1339 mem_sys_free(breakpoint
);
1345 =item C<void PDB_delete_condition>
1347 Delete a condition associated with a breakpoint.
1354 PDB_delete_condition(SHIM_INTERP
, ARGMOD(PDB_breakpoint_t
*breakpoint
))
1356 if (breakpoint
->condition
->value
) {
1357 if (breakpoint
->condition
->type
& PDB_cond_str
) {
1358 /* 'value' is a string, so we need to be careful */
1359 PObj_external_CLEAR((STRING
*)breakpoint
->condition
->value
);
1360 PObj_on_free_list_SET((STRING
*)breakpoint
->condition
->value
);
1361 /* it should now be properly garbage collected after
1362 we destroy the condition */
1365 /* 'value' is a float or an int, so we can just free it */
1366 mem_sys_free(breakpoint
->condition
->value
);
1367 breakpoint
->condition
->value
= NULL
;
1371 mem_sys_free(breakpoint
->condition
);
1372 breakpoint
->condition
= NULL
;
1377 =item C<void PDB_skip_breakpoint>
1379 Skip C<i> times all breakpoints.
1386 PDB_skip_breakpoint(PARROT_INTERP
, long i
)
1388 interp
->pdb
->breakpoint_skip
= i
? i
-1 : i
;
1393 =item C<char PDB_program_end>
1402 PDB_program_end(PARROT_INTERP
)
1404 PDB_t
* const pdb
= interp
->pdb
;
1406 /* Remove the RUNNING state */
1407 pdb
->state
&= ~PDB_RUNNING
;
1409 PIO_eprintf(interp
, "Program exited.\n");
1415 =item C<char PDB_check_condition>
1417 Returns true if the condition was met.
1423 PARROT_WARN_UNUSED_RESULT
1425 PDB_check_condition(PARROT_INTERP
, ARGIN(const PDB_condition_t
*condition
))
1427 if (condition
->type
& PDB_cond_int
) {
1430 * RT #46125 verify register is in range
1432 i
= REG_INT(interp
, condition
->reg
);
1434 if (condition
->type
& PDB_cond_const
)
1435 j
= *(INTVAL
*)condition
->value
;
1437 j
= REG_INT(interp
, *(int *)condition
->value
);
1439 if (((condition
->type
& PDB_cond_gt
) && (i
> j
)) ||
1440 ((condition
->type
& PDB_cond_ge
) && (i
>= j
)) ||
1441 ((condition
->type
& PDB_cond_eq
) && (i
== j
)) ||
1442 ((condition
->type
& PDB_cond_ne
) && (i
!= j
)) ||
1443 ((condition
->type
& PDB_cond_le
) && (i
<= j
)) ||
1444 ((condition
->type
& PDB_cond_lt
) && (i
< j
)))
1449 else if (condition
->type
& PDB_cond_num
) {
1452 k
= REG_NUM(interp
, condition
->reg
);
1454 if (condition
->type
& PDB_cond_const
)
1455 l
= *(FLOATVAL
*)condition
->value
;
1457 l
= REG_NUM(interp
, *(int *)condition
->value
);
1459 if (((condition
->type
& PDB_cond_gt
) && (k
> l
)) ||
1460 ((condition
->type
& PDB_cond_ge
) && (k
>= l
)) ||
1461 ((condition
->type
& PDB_cond_eq
) && (k
== l
)) ||
1462 ((condition
->type
& PDB_cond_ne
) && (k
!= l
)) ||
1463 ((condition
->type
& PDB_cond_le
) && (k
<= l
)) ||
1464 ((condition
->type
& PDB_cond_lt
) && (k
< l
)))
1469 else if (condition
->type
& PDB_cond_str
) {
1472 m
= REG_STR(interp
, condition
->reg
);
1474 if (condition
->type
& PDB_cond_const
)
1475 n
= (STRING
*)condition
->value
;
1477 n
= REG_STR(interp
, *(int *)condition
->value
);
1479 if (((condition
->type
& PDB_cond_gt
) &&
1480 (string_compare(interp
, m
, n
) > 0)) ||
1481 ((condition
->type
& PDB_cond_ge
) &&
1482 (string_compare(interp
, m
, n
) >= 0)) ||
1483 ((condition
->type
& PDB_cond_eq
) &&
1484 (string_compare(interp
, m
, n
) == 0)) ||
1485 ((condition
->type
& PDB_cond_ne
) &&
1486 (string_compare(interp
, m
, n
) != 0)) ||
1487 ((condition
->type
& PDB_cond_le
) &&
1488 (string_compare(interp
, m
, n
) <= 0)) ||
1489 ((condition
->type
& PDB_cond_lt
) &&
1490 (string_compare(interp
, m
, n
) < 0)))
1501 =item C<char PDB_break>
1503 Returns true if we have to stop running.
1509 PARROT_WARN_UNUSED_RESULT
1511 PDB_break(PARROT_INTERP
)
1513 PDB_t
* const pdb
= interp
->pdb
;
1514 PDB_breakpoint_t
*breakpoint
= pdb
->breakpoint
;
1515 PDB_condition_t
*watchpoint
= pdb
->watchpoint
;
1517 /* Check the watchpoints first. */
1518 while (watchpoint
) {
1519 if (PDB_check_condition(interp
, watchpoint
)) {
1520 pdb
->state
|= PDB_STOPPED
;
1524 watchpoint
= watchpoint
->next
;
1527 /* If program ended */
1528 if (!pdb
->cur_opcode
)
1529 return PDB_program_end(interp
);
1531 /* If the program is STOPPED allow it to continue */
1532 if (pdb
->state
& PDB_STOPPED
) {
1533 pdb
->state
&= ~PDB_STOPPED
;
1537 /* If we have to skip breakpoints, do so. */
1538 if (pdb
->breakpoint_skip
) {
1539 pdb
->breakpoint_skip
--;
1543 while (breakpoint
) {
1544 /* if we are in a break point */
1545 if (pdb
->cur_opcode
== breakpoint
->pc
) {
1546 if (breakpoint
->skip
< 0)
1549 /* Check if there is a condition for this breakpoint */
1550 if ((breakpoint
->condition
) &&
1551 (!PDB_check_condition(interp
, breakpoint
->condition
)))
1554 /* Add the STOPPED state and stop */
1555 pdb
->state
|= PDB_STOPPED
;
1558 breakpoint
= breakpoint
->next
;
1566 =item C<char * PDB_escape>
1568 Escapes C<">, C<\r>, C<\n>, C<\t>, C<\a> and C<\\>.
1570 The returned string must be freed.
1576 PARROT_WARN_UNUSED_RESULT
1577 PARROT_CAN_RETURN_NULL
1580 PDB_escape(ARGIN(const char *string
), INTVAL length
)
1585 length
= length
> 20 ? 20 : length
;
1586 end
= string
+ length
;
1588 /* Return if there is no string to escape*/
1592 fill
= _new
= (char *)mem_sys_allocate(length
* 2 + 1);
1594 for (; string
< end
; string
++) {
1625 *(fill
++) = *string
;
1637 =item C<int PDB_unescape>
1639 Do inplace unescape of C<\r>, C<\n>, C<\t>, C<\a> and C<\\>.
1646 PDB_unescape(ARGMOD(char *string
))
1650 for (; *string
; string
++) {
1653 if (*string
== '\\') {
1657 switch (string
[1]) {
1679 for (i
= 1; fill
[i
+ 1]; i
++)
1680 fill
[i
] = fill
[i
+ 1];
1691 =item C<size_t PDB_disassemble_op>
1700 PDB_disassemble_op(PARROT_INTERP
, ARGOUT(char *dest
), int space
,
1701 ARGIN(const op_info_t
*info
), ARGIN(const opcode_t
*op
),
1702 ARGMOD_NULLOK(PDB_file_t
*file
), ARGIN_NULLOK(const opcode_t
*code_start
),
1708 /* Write the opcode name */
1709 const char * const p
= full_name
? info
->full_name
: info
->name
;
1715 /* Concat the arguments */
1716 for (j
= 1; j
< info
->op_count
; j
++) {
1720 PARROT_ASSERT(size
+ 2 < space
);
1722 switch (info
->types
[j
- 1]) {
1736 /* If the opcode jumps and this is the last argument,
1737 that means this is a label */
1738 if ((j
== info
->op_count
- 1) &&
1739 (info
->jump
& PARROT_JUMP_RELATIVE
)) {
1742 i
= PDB_add_label(file
, op
, op
[j
]);
1744 else if (code_start
) {
1747 i
= op
[j
] + (op
- code_start
);
1756 /* Convert the integer to a string */
1761 PARROT_ASSERT(size
+ 20 < space
);
1763 size
+= sprintf(&dest
[size
], INTVAL_FMT
, i
);
1765 /* If this is a constant dispatch arg to an "infix" op, then show
1766 the corresponding symbolic op name. */
1767 if (j
== 1 && info
->types
[j
- 1] == PARROT_ARG_IC
1768 && (STREQ(info
->name
, "infix") || STREQ(info
->name
, "n_infix"))) {
1769 PARROT_ASSERT(size
+ 20 < space
);
1771 size
+= sprintf(&dest
[size
], " [%s]",
1772 /* [kludge: the "2+" skips the leading underscores. --
1774 2 + Parrot_MMD_method_name(interp
, op
[j
]));
1779 /* Convert the float to a string */
1780 const FLOATVAL f
= interp
->code
->const_table
->constants
[op
[j
]]->u
.number
;
1781 Parrot_snprintf(interp
, buf
, sizeof (buf
), FLOATVAL_FMT
, f
);
1782 strcpy(&dest
[size
], buf
);
1783 size
+= strlen(buf
);
1788 if (interp
->code
->const_table
->constants
[op
[j
]]-> u
.string
->strlen
) {
1789 char * const escaped
=
1790 PDB_escape(interp
->code
->const_table
->
1791 constants
[op
[j
]]->u
.string
->strstart
,
1792 interp
->code
->const_table
->
1793 constants
[op
[j
]]->u
.string
->strlen
);
1795 strcpy(&dest
[size
], escaped
);
1796 size
+= strlen(escaped
);
1797 mem_sys_free(escaped
);
1803 Parrot_snprintf(interp
, buf
, sizeof (buf
), "PMC_CONST(%d)", op
[j
]);
1804 strcpy(&dest
[size
], buf
);
1805 size
+= strlen(buf
);
1808 dest
[size
- 1] = '[';
1809 Parrot_snprintf(interp
, buf
, sizeof (buf
), "P" INTVAL_FMT
, op
[j
]);
1810 strcpy(&dest
[size
], buf
);
1811 size
+= strlen(buf
);
1816 PMC
* k
= interp
->code
->const_table
->constants
[op
[j
]]->u
.key
;
1817 dest
[size
- 1] = '[';
1819 switch (PObj_get_FLAGS(k
)) {
1822 case KEY_integer_FLAG
:
1823 Parrot_snprintf(interp
, buf
, sizeof (buf
),
1824 INTVAL_FMT
, PMC_int_val(k
));
1825 strcpy(&dest
[size
], buf
);
1826 size
+= strlen(buf
);
1828 case KEY_number_FLAG
:
1829 Parrot_snprintf(interp
, buf
, sizeof (buf
),
1830 FLOATVAL_FMT
, PMC_num_val(k
));
1831 strcpy(&dest
[size
], buf
);
1832 size
+= strlen(buf
);
1834 case KEY_string_FLAG
:
1837 char * const temp
= string_to_cstring(interp
, PMC_str_val(k
));
1838 strcpy(&dest
[size
], temp
);
1839 string_cstring_free(temp
);
1841 size
+= string_length(interp
, PMC_str_val(k
));
1844 case KEY_integer_FLAG
|KEY_register_FLAG
:
1845 Parrot_snprintf(interp
, buf
, sizeof (buf
),
1846 "I" INTVAL_FMT
, PMC_int_val(k
));
1847 strcpy(&dest
[size
], buf
);
1848 size
+= strlen(buf
);
1850 case KEY_number_FLAG
|KEY_register_FLAG
:
1851 Parrot_snprintf(interp
, buf
, sizeof (buf
),
1852 "N" INTVAL_FMT
, PMC_int_val(k
));
1853 strcpy(&dest
[size
], buf
);
1854 size
+= strlen(buf
);
1856 case KEY_string_FLAG
|KEY_register_FLAG
:
1857 Parrot_snprintf(interp
, buf
, sizeof (buf
),
1858 "S" INTVAL_FMT
, PMC_int_val(k
));
1859 strcpy(&dest
[size
], buf
);
1860 size
+= strlen(buf
);
1862 case KEY_pmc_FLAG
|KEY_register_FLAG
:
1863 Parrot_snprintf(interp
, buf
, sizeof (buf
),
1864 "P" INTVAL_FMT
, PMC_int_val(k
));
1865 strcpy(&dest
[size
], buf
);
1866 size
+= strlen(buf
);
1872 k
= PMC_data_typed(k
, PMC
*);
1880 dest
[size
- 1] = '[';
1881 Parrot_snprintf(interp
, buf
, sizeof (buf
), "I" INTVAL_FMT
, op
[j
]);
1882 strcpy(&dest
[size
], buf
);
1883 size
+= strlen(buf
);
1886 case PARROT_ARG_KIC
:
1887 dest
[size
- 1] = '[';
1888 Parrot_snprintf(interp
, buf
, sizeof (buf
), INTVAL_FMT
, op
[j
]);
1889 strcpy(&dest
[size
], buf
);
1890 size
+= strlen(buf
);
1894 real_exception(interp
, NULL
, 1, "Unknown opcode type");
1897 if (j
!= info
->op_count
- 1)
1901 /* Special decoding for the signature used in args/returns. Such ops have
1902 one fixed parameter (the signature vector), plus a varying number of
1903 registers/constants. For each arg/return, we show the register and its
1904 flags using PIR syntax. */
1905 if (*(op
) == PARROT_OP_set_args_pc
||
1906 *(op
) == PARROT_OP_get_results_pc
||
1907 *(op
) == PARROT_OP_get_params_pc
||
1908 *(op
) == PARROT_OP_set_returns_pc
) {
1910 PMC
* const sig
= interp
->code
->const_table
->constants
[op
[1]]->u
.key
;
1911 int n_values
= SIG_ELEMS(sig
);
1912 /* The flag_names strings come from Call_bits_enum_t (with which it
1913 should probably be colocated); they name the bits from LSB to MSB.
1914 The two least significant bits are not flags; they are the register
1915 type, which is decoded elsewhere. We also want to show unused bits,
1916 which could indicate problems.
1918 const char * const flag_names
[] = {
1924 " :flat", /* should be :slurpy for args */
1932 /* Register decoding. It would be good to abstract this, too. */
1933 static const char regs
[] = "ISPN";
1935 for (j
= 0; j
< n_values
; j
++) {
1936 unsigned int idx
= 0;
1937 const int sig_value
= VTABLE_get_integer_keyed_int(interp
, sig
, j
);
1939 /* Print the register name, e.g. P37. */
1942 buf
[idx
++] = regs
[sig_value
& PARROT_ARG_TYPE_MASK
];
1943 Parrot_snprintf(interp
, &buf
[idx
], sizeof (buf
)-idx
,
1944 INTVAL_FMT
, op
[j
+2]);
1947 /* Add flags, if we have any. */
1950 int flags
= sig_value
;
1952 /* End when we run out of flags, off the end of flag_names, or
1953 * get too close to the end of buf.
1954 * 100 is just an estimate of all buf lengths added together.
1956 while (flags
&& idx
< sizeof (buf
) - 100) {
1957 const char * const flag_string
= flag_names
[flag_idx
];
1960 if (flags
& 1 && *flag_string
) {
1961 const size_t n
= strlen(flag_string
);
1962 strcpy(&buf
[idx
], flag_string
);
1970 /* Add it to dest. */
1972 strcpy(&dest
[size
], buf
);
1973 size
+= strlen(buf
);
1983 =item C<void PDB_disassemble>
1985 Disassemble the bytecode.
1992 PDB_disassemble(PARROT_INTERP
, SHIM(const char *command
))
1994 PDB_t
* const pdb
= interp
->pdb
;
1995 opcode_t
* pc
= interp
->code
->base
.data
;
1998 PDB_line_t
*pline
, *newline
;
2002 const unsigned int default_size
= 32768;
2003 size_t space
; /* How much space do we have? */
2004 size_t size
, alloced
, n
;
2006 pfile
= mem_allocate_typed(PDB_file_t
);
2007 pline
= mem_allocate_typed(PDB_line_t
);
2009 /* If we already got a source, free it */
2011 PDB_free_file(interp
);
2014 pline
->label
= NULL
;
2015 pfile
->line
= pline
;
2016 pfile
->label
= NULL
;
2018 pfile
->source
= (char *)mem_sys_allocate(default_size
);
2019 pline
->source_offset
= 0;
2021 alloced
= space
= default_size
;
2022 code_end
= pc
+ interp
->code
->base
.size
;
2024 while (pc
!= code_end
) {
2026 if (space
< default_size
) {
2027 alloced
+= default_size
;
2028 space
+= default_size
;
2029 pfile
->source
= (char *)mem_sys_realloc(pfile
->source
, alloced
);
2032 size
= PDB_disassemble_op(interp
, pfile
->source
+ pfile
->size
,
2033 space
, &interp
->op_info_table
[*pc
], pc
, pfile
, NULL
, 1);
2035 pfile
->size
+= size
;
2036 pfile
->source
[pfile
->size
- 1] = '\n';
2038 /* Store the opcode of this line */
2040 n
= interp
->op_info_table
[*pc
].op_count
;
2042 ADD_OP_VAR_PART(interp
, interp
->code
, pc
, n
);
2045 /* Prepare for next line */
2046 newline
= mem_allocate_typed(PDB_line_t
);
2047 newline
->label
= NULL
;
2048 newline
->next
= NULL
;
2049 newline
->number
= pline
->number
+ 1;
2050 pline
->next
= newline
;
2052 pline
->source_offset
= pfile
->size
;
2055 /* Add labels to the lines they belong to */
2056 label
= pfile
->label
;
2059 /* Get the line to apply the label */
2060 pline
= pfile
->line
;
2062 while (pline
&& pline
->opcode
!= label
->opcode
)
2063 pline
= pline
->next
;
2067 "Label number %li out of bounds.\n", label
->number
);
2068 /* RT #46127: free allocated memory */
2072 pline
->label
= label
;
2074 label
= label
->next
;
2077 pdb
->state
|= PDB_SRC_LOADED
;
2083 =item C<long PDB_add_label>
2085 Add a label to the label list.
2092 PDB_add_label(ARGMOD(PDB_file_t
*file
), ARGIN(const opcode_t
*cur_opcode
),
2096 PDB_label_t
*label
= file
->label
;
2098 /* See if there is already a label at this line */
2100 if (label
->opcode
== cur_opcode
+ offset
)
2101 return label
->number
;
2102 label
= label
->next
;
2105 /* Allocate a new label */
2106 label
= file
->label
;
2107 _new
= mem_allocate_typed(PDB_label_t
);
2108 _new
->opcode
= cur_opcode
+ offset
;
2113 label
= label
->next
;
2115 _new
->number
= label
->number
+ 1;
2123 return _new
->number
;
2128 =item C<void PDB_free_file>
2130 Frees any allocated source files.
2137 PDB_free_file(PARROT_INTERP
)
2139 PDB_file_t
*file
= interp
->pdb
->file
;
2142 /* Free all of the allocated line structures */
2143 PDB_line_t
*line
= file
->line
;
2148 PDB_line_t
* const nline
= line
->next
;
2153 /* Free all of the allocated label structures */
2154 label
= file
->label
;
2157 PDB_label_t
* const nlabel
= label
->next
;
2159 mem_sys_free(label
);
2163 /* Free the remaining allocated portions of the file structure */
2164 if (file
->sourcefilename
)
2165 mem_sys_free(file
->sourcefilename
);
2168 mem_sys_free(file
->source
);
2175 /* Make sure we don't end up pointing at garbage memory */
2176 interp
->pdb
->file
= NULL
;
2181 =item C<void PDB_load_source>
2183 Load a source code file.
2190 PDB_load_source(PARROT_INTERP
, ARGIN(const char *command
))
2197 PDB_t
* const pdb
= interp
->pdb
;
2198 opcode_t
*pc
= pdb
->cur_opcode
;
2199 unsigned long size
= 0;
2201 /* If there was a file already loaded or the bytecode was
2202 disassembled, free it */
2204 PDB_free_file(interp
);
2206 /* Get the name of the file */
2207 for (i
= 0; command
[i
]; i
++)
2213 file
= fopen(f
, "r");
2215 /* abort if fopen failed */
2217 PIO_eprintf(interp
, "Unable to load %s\n", f
);
2221 pfile
= mem_allocate_zeroed_typed(PDB_file_t
);
2222 pline
= mem_allocate_zeroed_typed(PDB_line_t
);
2224 pfile
->source
= (char *)mem_sys_allocate(1024);
2225 pfile
->line
= pline
;
2228 while ((c
= fgetc(file
)) != EOF
) {
2230 if (++size
== 1024) {
2231 pfile
->source
= (char *)mem_sys_realloc(pfile
->source
,
2232 (size_t)pfile
->size
+ 1024);
2235 pfile
->source
[pfile
->size
] = (char)c
;
2240 /* If the line has an opcode move to the next one,
2241 otherwise leave it with NULL to skip it. */
2242 PDB_line_t
*newline
;
2243 if (PDB_hasinstruction(pfile
->source
+ pline
->source_offset
)) {
2246 n
= interp
->op_info_table
[*pc
].op_count
;
2247 ADD_OP_VAR_PART(interp
, interp
->code
, pc
, n
);
2250 newline
= mem_allocate_zeroed_typed(PDB_line_t
);
2251 newline
->number
= pline
->number
+ 1;
2252 pline
->next
= newline
;
2254 pline
->source_offset
= pfile
->size
;
2255 pline
->opcode
= NULL
;
2256 pline
->label
= NULL
;
2260 pdb
->state
|= PDB_SRC_LOADED
;
2266 =item C<char PDB_hasinstruction>
2268 Return true if the line has an instruction.
2274 =item * This should take the line, get an instruction, get the opcode for
2275 that instruction and check that is the correct one.
2277 =item * Decide what to do with macros if anything.
2285 PARROT_WARN_UNUSED_RESULT
2286 PARROT_PURE_FUNCTION
2288 PDB_hasinstruction(ARGIN(const char *c
))
2292 /* as long as c is not NULL, we're not looking at a comment (#...) or a '\n'... */
2293 while (*c
&& *c
!= '#' && *c
!= '\n') {
2294 /* ... and c is alphanumeric or a quoted string then the line contains
2295 * an instruction. */
2296 if (isalnum((unsigned char) *c
) || *c
== '"') {
2299 else if (*c
== ':') {
2300 /* this is a label. RT #46137 right? */
2312 =item C<void PDB_list>
2314 Show lines from the source code file.
2321 PDB_list(PARROT_INTERP
, ARGIN(const char *command
))
2327 PDB_t
*pdb
= interp
->pdb
;
2328 unsigned long n
= 10;
2331 PIO_eprintf(interp
, "No source file loaded\n");
2335 command
= nextarg(command
);
2336 /* set the list line if provided */
2337 if (isdigit((unsigned char) *command
)) {
2338 line_number
= atol(command
) - 1;
2339 if (line_number
< 0)
2340 pdb
->file
->list_line
= 0;
2342 pdb
->file
->list_line
= (unsigned long) line_number
;
2344 skip_command(command
);
2347 pdb
->file
->list_line
= 0;
2350 /* set the number of lines to print */
2351 if (isdigit((unsigned char) *command
)) {
2353 skip_command(command
);
2356 /* if n is zero, we simply return, as we don't have to print anything */
2360 line
= pdb
->file
->line
;
2362 for (i
= 0; i
< pdb
->file
->list_line
&& line
->next
; i
++)
2366 while (line
->next
) {
2367 PIO_eprintf(interp
, "%li ", pdb
->file
->list_line
+ i
);
2368 /* If it has a label print it */
2370 PIO_eprintf(interp
, "L%li:\t", line
->label
->number
);
2372 c
= pdb
->file
->source
+ line
->source_offset
;
2375 PIO_eprintf(interp
, "%c", *(c
++));
2377 PIO_eprintf(interp
, "\n");
2386 pdb
->file
->list_line
= 0;
2388 pdb
->file
->list_line
+= n
;
2393 =item C<void PDB_eval>
2395 C<eval>s an instruction.
2402 PDB_eval(PARROT_INTERP
, ARGIN(const char *command
))
2404 /* This code is almost certainly wrong. The Parrot debugger needs love. */
2405 opcode_t
*run
= PDB_compile(interp
, command
);
2413 =item C<opcode_t * PDB_compile>
2415 Compiles instructions with the PASM compiler.
2417 Appends an C<end> op.
2419 This may be called from C<PDB_eval> above or from the compile opcode
2420 which generates a malloced string.
2426 PARROT_CAN_RETURN_NULL
2428 PDB_compile(PARROT_INTERP
, ARGIN(const char *command
))
2431 const char *end
= "\nend\n";
2432 STRING
*key
= CONST_STRING(interp
, "PASM");
2433 PMC
*compreg_hash
= VTABLE_get_pmc_keyed_int(interp
,
2434 interp
->iglobals
, IGLOBALS_COMPREG_HASH
);
2435 PMC
*compiler
= VTABLE_get_pmc_keyed_str(interp
, compreg_hash
, key
);
2437 if (!VTABLE_defined(interp
, compiler
)) {
2438 fprintf(stderr
, "Couldn't find PASM compiler");
2442 buf
= Parrot_sprintf_c(interp
, "%s%s", command
, end
);
2444 return VTABLE_invoke(interp
, compiler
, buf
);
2449 =item C<static void dump_string>
2451 Dumps the buflen, flags, bufused, strlen, and offset associated with a string
2452 and the string itself.
2459 dump_string(PARROT_INTERP
, ARGIN_NULLOK(const STRING
*s
))
2464 PIO_eprintf(interp
, "\tBuflen =\t%12ld\n", PObj_buflen(s
));
2465 PIO_eprintf(interp
, "\tFlags =\t%12ld\n", PObj_get_FLAGS(s
));
2466 PIO_eprintf(interp
, "\tBufused =\t%12ld\n", s
->bufused
);
2467 PIO_eprintf(interp
, "\tStrlen =\t%12ld\n", s
->strlen
);
2468 PIO_eprintf(interp
, "\tOffset =\t%12ld\n",
2469 (char*) s
->strstart
- (char*) PObj_bufstart(s
));
2470 PIO_eprintf(interp
, "\tString =\t%S\n", s
);
2475 =item C<void PDB_print>
2477 Print interp registers.
2484 PDB_print(PARROT_INTERP
, ARGIN(const char *command
))
2486 const char * const s
= GDB_P(interp
->pdb
->debugee
, command
);
2487 PIO_eprintf(interp
, "%s\n", s
);
2493 =item C<void PDB_info>
2495 Print the interpreter info.
2502 PDB_info(PARROT_INTERP
)
2504 PIO_eprintf(interp
, "Total memory allocated = %ld\n",
2505 interpinfo(interp
, TOTAL_MEM_ALLOC
));
2506 PIO_eprintf(interp
, "DOD runs = %ld\n",
2507 interpinfo(interp
, DOD_RUNS
));
2508 PIO_eprintf(interp
, "Lazy DOD runs = %ld\n",
2509 interpinfo(interp
, LAZY_DOD_RUNS
));
2510 PIO_eprintf(interp
, "Collect runs = %ld\n",
2511 interpinfo(interp
, COLLECT_RUNS
));
2512 PIO_eprintf(interp
, "Collect memory = %ld\n",
2513 interpinfo(interp
, TOTAL_COPIED
));
2514 PIO_eprintf(interp
, "Active PMCs = %ld\n",
2515 interpinfo(interp
, ACTIVE_PMCS
));
2516 PIO_eprintf(interp
, "Extended PMCs = %ld\n",
2517 interpinfo(interp
, EXTENDED_PMCS
));
2518 PIO_eprintf(interp
, "Timely DOD PMCs = %ld\n",
2519 interpinfo(interp
, IMPATIENT_PMCS
));
2520 PIO_eprintf(interp
, "Total PMCs = %ld\n",
2521 interpinfo(interp
, TOTAL_PMCS
));
2522 PIO_eprintf(interp
, "Active buffers = %ld\n",
2523 interpinfo(interp
, ACTIVE_BUFFERS
));
2524 PIO_eprintf(interp
, "Total buffers = %ld\n",
2525 interpinfo(interp
, TOTAL_BUFFERS
));
2526 PIO_eprintf(interp
, "Header allocations since last collect = %ld\n",
2527 interpinfo(interp
, HEADER_ALLOCS_SINCE_COLLECT
));
2528 PIO_eprintf(interp
, "Memory allocations since last collect = %ld\n",
2529 interpinfo(interp
, MEM_ALLOCS_SINCE_COLLECT
));
2534 =item C<void PDB_help>
2536 Print the help text. "Help" with no arguments prints a list of commands.
2537 "Help xxx" prints information on command xxx.
2544 PDB_help(PARROT_INTERP
, ARGIN(const char *command
))
2548 /* Extract the command after leading whitespace (for error messages). */
2549 while (*command
&& isspace((unsigned char)*command
))
2551 parse_command(command
, &c
);
2554 case debug_cmd_disassemble
:
2555 PIO_eprintf(interp
, "No documentation yet");
2557 case debug_cmd_load
:
2558 PIO_eprintf(interp
, "No documentation yet");
2560 case debug_cmd_list
:
2562 "List the source code.\n\n\
2563 Optionally specify the line number to begin the listing from and the number\n\
2564 of lines to display.\n");
2568 "Run (or restart) the program being debugged.\n\n\
2569 Arguments specified after \"run\" are passed as command line arguments to\n\
2572 case debug_cmd_break
:
2574 "Set a breakpoint at a given line number (which must be specified).\n\n\
2575 Optionally, specify a condition, in which case the breakpoint will only\n\
2576 activate if the condition is met. Conditions take the form:\n\n\
2577 if [REGISTER] [COMPARISON] [REGISTER or CONSTANT]\n\n\
2580 break 10 if I4 > I3\n\n\
2581 break 45 if S1 == \"foo\"\n\n\
2582 The command returns a number which is the breakpoint identifier.");
2584 case debug_cmd_script_file
:
2585 PIO_eprintf(interp
, "Interprets a file.\n\
2587 (pdb) script file.script\n");
2589 case debug_cmd_watch
:
2590 PIO_eprintf(interp
, "No documentation yet");
2592 case debug_cmd_delete
:
2594 "Delete a breakpoint.\n\n\
2595 The breakpoint to delete must be specified by its breakpoint number.\n\
2596 Deleted breakpoints are gone completely. If instead you want to\n\
2597 temporarily disable a breakpoint, use \"disable\".\n");
2599 case debug_cmd_disable
:
2601 "Disable a breakpoint.\n\n\
2602 The breakpoint to disable must be specified by its breakpoint number.\n\
2603 Disabled breakpoints are not forgotten, but have no effect until re-enabled\n\
2604 with the \"enable\" command.\n");
2606 case debug_cmd_enable
:
2607 PIO_eprintf(interp
, "Re-enable a disabled breakpoint.\n");
2609 case debug_cmd_continue
:
2611 "Continue the program execution.\n\n\
2612 Without arguments, the program runs until a breakpoint is found\n\
2613 (or until the program terminates for some other reason).\n\n\
2614 If a number is specified, then skip that many breakpoints.\n\n\
2615 If the program has terminated, then \"continue\" will do nothing;\n\
2616 use \"run\" to re-run the program.\n");
2618 case debug_cmd_next
:
2620 "Execute a specified number of instructions.\n\n\
2621 If a number is specified with the command (e.g. \"next 5\"), then\n\
2622 execute that number of instructions, unless the program reaches a\n\
2623 breakpoint, or stops for some other reason.\n\n\
2624 If no number is specified, it defaults to 1.\n");
2626 case debug_cmd_eval
:
2627 PIO_eprintf(interp
, "No documentation yet");
2629 case debug_cmd_trace
:
2631 "Similar to \"next\", but prints additional trace information.\n\
2632 This is the same as the information you get when running Parrot with\n\
2635 case debug_cmd_print
:
2636 PIO_eprintf(interp
, "Print register: e.g. \"p i2\"\n\
2637 Note that the register type is case-insensitive. If no digits appear\n\
2638 after the register type, all registers of that type are printed.\n");
2640 case debug_cmd_info
:
2642 "Print information about the current interpreter\n");
2644 case debug_cmd_quit
:
2645 PIO_eprintf(interp
, "Exit the debugger.\n");
2647 case debug_cmd_help
:
2648 PIO_eprintf(interp
, "Print a list of available commands.\n");
2651 /* C89: strings need to be 509 chars or less */
2652 PIO_eprintf(interp
, "\
2653 List of commands:\n\
2654 disassemble -- disassemble the bytecode\n\
2655 load -- load a source code file\n\
2656 list (l) -- list the source code file\n\
2657 run (r) -- run the program\n\
2658 break (b) -- add a breakpoint\n\
2659 script (f) -- interprets a file as user commands\n\
2660 watch (w) -- add a watchpoint\n\
2661 delete (d) -- delete a breakpoint\n\
2662 disable -- disable a breakpoint\n\
2663 enable -- reenable a disabled breakpoint\n\
2664 continue (c) -- continue the program execution\n");
2665 PIO_eprintf(interp
, "\
2666 next (n) -- run the next instruction\n\
2667 eval (e) -- run an instruction\n\
2668 trace (t) -- trace the next instruction\n\
2669 print (p) -- print the interpreter registers\n\
2670 stack (s) -- examine the stack\n\
2671 info -- print interpreter information\n\
2672 quit (q) -- exit the debugger\n\
2673 help (h) -- print this help\n\n\
2674 Type \"help\" followed by a command name for full documentation.\n\n");
2677 PIO_eprintf(interp
, "Unknown command: \"%s\".", command
);
2684 =item C<void PDB_backtrace>
2686 Prints a backtrace of the interp's call chain.
2693 PDB_backtrace(PARROT_INTERP
)
2699 /* information about the current sub */
2700 PMC
*sub
= interpinfo_p(interp
, CURRENT_SUB
);
2701 parrot_context_t
*ctx
= CONTEXT(interp
);
2703 if (!PMC_IS_NULL(sub
)) {
2704 str
= Parrot_Context_infostr(interp
, ctx
);
2706 PIO_eprintf(interp
, "%Ss\n", str
);
2709 /* backtrace: follow the continuation chain */
2711 Parrot_cont
*sub_cont
;
2712 sub
= ctx
->current_cont
;
2717 sub_cont
= PMC_cont(sub
);
2722 str
= Parrot_Context_infostr(interp
, sub_cont
->to_ctx
);
2727 /* recursion detection */
2728 if (!PMC_IS_NULL(old
) && PMC_cont(old
) &&
2729 PMC_cont(old
)->to_ctx
->current_pc
==
2730 PMC_cont(sub
)->to_ctx
->current_pc
&&
2731 PMC_cont(old
)->to_ctx
->current_sub
==
2732 PMC_cont(sub
)->to_ctx
->current_sub
) {
2735 else if (rec_level
!= 0) {
2736 PIO_eprintf(interp
, "... call repeated %d times\n", rec_level
);
2740 /* print the context description */
2742 PIO_eprintf(interp
, "%Ss\n", str
);
2744 /* get the next Continuation */
2745 ctx
= PMC_cont(sub
)->to_ctx
;
2753 PIO_eprintf(interp
, "... call repeated %d times\n", rec_level
);
2759 * GDB_P gdb> pp $I0 print register I0 value
2761 * RT46139 more, more
2766 =item C<static const char* GDB_print_reg>
2768 Used by GDB_P to convert register values for display. Takes register
2769 type and number as arguments.
2771 Returns a pointer to the start of the string, (except for PMCs, which
2772 print directly and return "").
2778 PARROT_WARN_UNUSED_RESULT
2779 PARROT_CANNOT_RETURN_NULL
2781 GDB_print_reg(PARROT_INTERP
, int t
, int n
)
2784 if (n
>= 0 && n
< CONTEXT(interp
)->n_regs_used
[t
]) {
2787 return string_from_int(interp
, REG_INT(interp
, n
))->strstart
;
2789 return string_from_num(interp
, REG_NUM(interp
, n
))->strstart
;
2791 return REG_STR(interp
, n
)->strstart
;
2793 /* prints directly */
2794 trace_pmc_dump(interp
, REG_PMC(interp
, n
));
2800 return "no such reg";
2805 =item C<static const char* GDB_P>
2807 Used by PDB_print to print register values. Takes a pointer to the
2810 Returns "" or error message.
2816 PARROT_WARN_UNUSED_RESULT
2817 PARROT_CANNOT_RETURN_NULL
2819 GDB_P(PARROT_INTERP
, ARGIN(const char *s
))
2824 /* Skip leading whitespace. */
2825 while (isspace((unsigned char)*s
))
2828 reg_type
= (unsigned char) toupper((unsigned char)*s
);
2830 case 'I': t
= REGNO_INT
; break;
2831 case 'N': t
= REGNO_NUM
; break;
2832 case 'S': t
= REGNO_STR
; break;
2833 case 'P': t
= REGNO_PMC
; break;
2834 default: return "Need a register.";
2837 /* Print all registers of this type. */
2838 const int max_reg
= CONTEXT(interp
)->n_regs_used
[t
];
2841 for (n
= 0; n
< max_reg
; n
++) {
2842 /* this must be done in two chunks because PMC's print directly. */
2843 PIO_eprintf(interp
, "\n %c%d = ", reg_type
, n
);
2844 PIO_eprintf(interp
, "%s", GDB_print_reg(interp
, t
, n
));
2848 else if (s
[1] && isdigit((unsigned char)s
[1])) {
2849 const int n
= atoi(s
+ 1);
2850 return GDB_print_reg(interp
, t
, n
);
2853 return "no such reg";
2857 /* RT #46141 move these to debugger interpreter
2859 static PDB_breakpoint_t
*gdb_bps
;
2862 * GDB_pb gdb> pb 244 # set breakpoint at opcode 244
2864 * RT #46143 We can't remove the breakpoint yet, executing the next ins
2865 * most likely fails, as the length of the debug-brk stmt doesn't
2866 * match the old opcode
2867 * Setting a breakpoint will also fail, if the bytecode os r/o
2872 =item C<static int GDB_B>
2874 Inserts a break-point into a table (which it creates if necessary).
2875 Takes an instruction counter (?).
2879 Returns break-point count, or -1 if point is out of bounds.
2886 GDB_B(PARROT_INTERP
, ARGIN(const char *s
)) {
2887 if ((unsigned long)s
< 0x10000) {
2888 /* HACK alarm pb 45 is passed as the integer not a string */
2889 /* RT #46145 check if in bounds */
2890 opcode_t
* const pc
= interp
->code
->base
.data
+ (unsigned long)s
;
2891 PDB_breakpoint_t
*bp
, *newbreak
;
2896 newbreak
= mem_allocate_typed(PDB_breakpoint_t
);
2897 newbreak
->prev
= NULL
;
2898 newbreak
->next
= NULL
;
2902 /* create new one */
2903 for (nr
= 0, bp
= gdb_bps
; ; bp
= bp
->next
, ++nr
) {
2912 newbreak
= mem_allocate_typed(PDB_breakpoint_t
);
2913 newbreak
->prev
= bp
;
2914 newbreak
->next
= NULL
;
2915 bp
->next
= newbreak
;
2920 *pc
= PARROT_OP_trap
;
2934 F<include/parrot/debug.h>, F<src/pdb.c> and F<ops/debug.ops>.
2940 =item Initial version by Daniel Grunblatt on 2002.5.19.
2942 =item Start of rewrite - leo 2005.02.16
2944 The debugger now uses its own interpreter. User code is run in
2945 Interp *debugee. We have:
2947 debug_interp->pdb->debugee->debugger
2950 +------------- := -----------+
2952 Debug commands are mostly run inside the C<debugger>. User code
2953 runs of course in the C<debugee>.
2964 * c-file-style: "parrot"
2966 * vim: expandtab shiftwidth=4: