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"
32 /* Not sure how we want to handle this sort of cross-project header */
35 IMCC_warning(PARROT_INTERP
, ARGIN(const char *fmt
), ...);
36 extern void imcc_init(PARROT_INTERP
);
40 /* HEADERIZER HFILE: include/parrot/debug.h */
42 /* HEADERIZER BEGIN: static */
44 static void dump_string(PARROT_INTERP
, ARGIN_NULLOK(const STRING
*s
))
45 __attribute__nonnull__(1);
47 static int GDB_B(PARROT_INTERP
, ARGIN(const char *s
))
48 __attribute__nonnull__(1)
49 __attribute__nonnull__(2);
51 PARROT_WARN_UNUSED_RESULT
52 PARROT_CANNOT_RETURN_NULL
53 static const char* GDB_P(PARROT_INTERP
, ARGIN(const char *s
))
54 __attribute__nonnull__(1)
55 __attribute__nonnull__(2);
57 PARROT_WARN_UNUSED_RESULT
58 PARROT_CANNOT_RETURN_NULL
59 static const char* GDB_print_reg(PARROT_INTERP
, int t
, int n
)
60 __attribute__nonnull__(1);
62 PARROT_CAN_RETURN_NULL
63 PARROT_WARN_UNUSED_RESULT
64 static const char * nextarg(ARGIN_NULLOK(const char *command
));
66 PARROT_CAN_RETURN_NULL
67 PARROT_IGNORABLE_RESULT
68 static const char * parse_command(
69 ARGIN(const char *command
),
70 ARGOUT(unsigned long *cmdP
))
71 __attribute__nonnull__(1)
72 __attribute__nonnull__(2)
75 PARROT_CANNOT_RETURN_NULL
76 PARROT_WARN_UNUSED_RESULT
77 static const char * parse_int(ARGIN(const char *str
), ARGOUT(int *intP
))
78 __attribute__nonnull__(1)
79 __attribute__nonnull__(2)
82 PARROT_CAN_RETURN_NULL
83 PARROT_WARN_UNUSED_RESULT
84 static const char* parse_key(PARROT_INTERP
,
85 ARGIN(const char *str
),
87 __attribute__nonnull__(1)
88 __attribute__nonnull__(2)
89 __attribute__nonnull__(3)
92 PARROT_CAN_RETURN_NULL
93 PARROT_WARN_UNUSED_RESULT
94 static const char * parse_string(PARROT_INTERP
,
95 ARGIN(const char *str
),
96 ARGOUT(STRING
**strP
))
97 __attribute__nonnull__(1)
98 __attribute__nonnull__(2)
99 __attribute__nonnull__(3)
100 FUNC_MODIFIES(*strP
);
102 PARROT_CANNOT_RETURN_NULL
103 static const char * skip_command(ARGIN(const char *str
))
104 __attribute__nonnull__(1);
106 PARROT_CANNOT_RETURN_NULL
107 PARROT_WARN_UNUSED_RESULT
108 static const char * skip_ws(ARGIN(const char *str
))
109 __attribute__nonnull__(1);
111 /* HEADERIZER END: static */
116 =item C<static const char * nextarg>
118 Returns the position just past the current argument in the PASM instruction
119 C<command>. This is not the same as C<skip_command()>, which is intended for
120 debugger commands. This function is used for C<eval>.
126 PARROT_CAN_RETURN_NULL
127 PARROT_WARN_UNUSED_RESULT
129 nextarg(ARGIN_NULLOK(const char *command
))
131 /* as long as the character pointed to by command is not NULL,
132 * and it is either alphanumeric, a comma or a closing bracket,
133 * continue looking for the next argument.
136 while (isalnum((unsigned char) *command
) || *command
== ',' || *command
== ']')
139 /* eat as much space as possible */
140 while (isspace((unsigned char) *command
))
149 =item C<static const char * skip_ws>
151 Returns the pointer past any whitespace.
157 PARROT_CANNOT_RETURN_NULL
158 PARROT_WARN_UNUSED_RESULT
160 skip_ws(ARGIN(const char *str
))
162 /* as long as str is not NULL and it contains space, skip it */
163 while (*str
&& isspace((unsigned char) *str
))
171 =item C<static const char * skip_command>
173 Returns the pointer past the current debugger command. (This is an
174 alternative to the C<skip_command()> macro above.)
180 PARROT_CANNOT_RETURN_NULL
182 skip_command(ARGIN(const char *str
))
184 /* while str is not null and it contains a command (no spaces),
187 while (*str
&& !isspace((unsigned char) *str
))
190 /* eat all space after that */
191 while (*str
&& isspace((unsigned char) *str
))
199 =item C<static const char * parse_int>
201 Parse an C<int> out of a string and return a pointer to just after the C<int>.
202 The output parameter C<intP> contains the parsed value.
208 PARROT_CANNOT_RETURN_NULL
209 PARROT_WARN_UNUSED_RESULT
211 parse_int(ARGIN(const char *str
), ARGOUT(int *intP
))
215 *intP
= strtol(str
, &end
, 0);
222 =item C<static const char * parse_string>
224 Parse a double-quoted string out of a C string and return a pointer to
225 just after the string. The parsed string is converted to a Parrot
226 C<STRING> and placed in the output parameter C<strP>.
232 PARROT_CAN_RETURN_NULL
233 PARROT_WARN_UNUSED_RESULT
235 parse_string(PARROT_INTERP
, ARGIN(const char *str
), ARGOUT(STRING
**strP
))
237 const char *string_start
;
239 /* if this is not a quoted string, there's nothing to parse */
248 /* parse while there's no closing quote */
249 while (*str
&& *str
!= '"') {
250 /* skip any potentially escaped quotes */
251 if (*str
== '\\' && str
[1])
257 /* create the output STRING */
258 *strP
= string_make(interp
, string_start
, str
- string_start
, NULL
, 0);
260 /* skip the closing quote */
269 =item C<static const char* parse_key>
271 Parse an aggregate key out of a string and return a pointer to just
272 after the key. Currently only string and integer keys are allowed.
278 PARROT_CAN_RETURN_NULL
279 PARROT_WARN_UNUSED_RESULT
281 parse_key(PARROT_INTERP
, ARGIN(const char *str
), ARGOUT(PMC
**keyP
))
283 /* clear output parameter */
286 /* make sure it's a key */
293 /* if this is a string key, create a Parrot STRING */
295 STRING
*parrot_string
;
296 str
= parse_string(interp
, str
, &parrot_string
);
297 *keyP
= key_new_string(interp
, parrot_string
);
299 /* if this is a numeric key */
300 else if (isdigit((unsigned char) *str
)) {
302 str
= parse_int(str
, &value
);
303 *keyP
= key_new_integer(interp
, (INTVAL
) value
);
305 /* unsupported case; neither a string nor a numeric key */
310 /* hm, but if this doesn't match, it's probably an error */
311 /* XXX str can be NULL from parse_string() */
315 /* skip the closing brace on the key */
321 =item C<static const char * parse_command>
323 Convert the command at the beginning of a string into a numeric value
324 that can be used as a switch key for fast lookup.
330 PARROT_CAN_RETURN_NULL
331 PARROT_IGNORABLE_RESULT
333 parse_command(ARGIN(const char *command
), ARGOUT(unsigned long *cmdP
))
338 /* Skip leading whitespace. */
339 while (isspace(*command
))
342 if (*command
== '\0') {
347 for (i
= 0; isalpha((unsigned char) *command
); command
++, i
++)
348 c
+= (tolower((unsigned char) *command
) + (i
+ 1)) * ((i
+ 1) * 255);
350 /* Nonempty and did not start with a letter */
352 c
= (unsigned long)-1;
361 =item C<void PDB_get_command>
363 Get a command from the user input to execute.
365 It saves the last command executed (in C<< pdb->last_command >>), so it
366 first frees the old one and updates it with the current one.
368 Also prints the next line to run if the program is still active.
370 The user input can't be longer than 255 characters.
372 The input is saved in C<< pdb->cur_command >>.
379 PDB_get_command(PARROT_INTERP
)
384 PDB_t
* const pdb
= interp
->pdb
;
386 /* flush the buffered data */
389 /* not used any more */
390 if (pdb
->last_command
&& *pdb
->cur_command
) {
391 mem_sys_free(pdb
->last_command
);
392 pdb
->last_command
= NULL
;
395 /* update the last command */
396 if (pdb
->cur_command
&& *pdb
->cur_command
)
397 pdb
->last_command
= pdb
->cur_command
;
399 /* if the program is stopped and running show the next line to run */
400 if ((pdb
->state
& PDB_STOPPED
) && (pdb
->state
& PDB_RUNNING
)) {
401 PDB_line_t
*line
= pdb
->file
->line
;
403 while (pdb
->cur_opcode
!= line
->opcode
)
406 PIO_eprintf(interp
, "%li ", line
->number
);
407 c
= pdb
->file
->source
+ line
->source_offset
;
409 while (c
&& (*c
!= '\n'))
410 PIO_eprintf(interp
, "%c", *(c
++));
415 /* RT#46109 who frees that */
416 /* need to allocate 256 chars as string is null-terminated i.e. 255 + 1*/
417 c
= (char *)mem_sys_allocate(256);
419 PIO_eprintf(interp
, "\n(pdb) ");
421 /* skip leading whitespace */
424 } while (isspace((unsigned char)ch
) && ch
!= '\n');
426 /* generate string (no more than 255 chars) */
427 while (ch
!= EOF
&& ch
!= '\n' && (i
< 255)) {
437 pdb
->cur_command
= c
;
442 =item C<void PDB_script_file>
444 Interprets the contents of a file as user input commands
451 PDB_script_file(PARROT_INTERP
, ARGIN(const char *command
))
454 const char *ptr
= (const char *)&buf
;
458 command
= nextarg(command
);
460 fd
= fopen(command
, "r");
462 IMCC_warning(interp
, "script_file: "
463 "Error reading script file %s.\n",
471 fgets(buf
, 1024, fd
);
474 for (ptr
=(char *)&buf
;*ptr
&&isspace((unsigned char)*ptr
);ptr
=ptr
+1);
476 /* avoid null blank and commented lines */
477 if (*buf
== '\0' || *buf
== '#')
480 buf
[strlen(buf
)-1]='\0';
481 /* RT#46117: handle command error and print out script line
482 * PDB_run_command should return non-void value?
483 * stop execution of script if fails
484 * RT#46115: avoid this verbose output? add -v flag? */
485 if (PDB_run_command(interp
, buf
)) {
486 IMCC_warning(interp
, "script_file: "
487 "Error interpreting command at line %d (%s).\n",
497 =item C<int PDB_run_command>
501 Hash the command to make a simple switch calling the correct handler.
507 PARROT_IGNORABLE_RESULT
509 PDB_run_command(PARROT_INTERP
, ARGIN(const char *command
))
512 PDB_t
* const pdb
= interp
->pdb
;
513 const char * const original_command
= command
;
515 /* keep a pointer to the command, in case we need to report an error */
517 /* get a number from what the user typed */
518 command
= parse_command(original_command
, &c
);
521 skip_command(command
);
527 PDB_script_file(interp
, command
);
530 PDB_disassemble(interp
, command
);
533 PDB_load_source(interp
, command
);
537 PDB_list(interp
, command
);
541 PDB_set_break(interp
, command
);
545 PDB_watchpoint(interp
, command
);
549 PDB_delete_breakpoint(interp
, command
);
552 PDB_disable_breakpoint(interp
, command
);
555 PDB_enable_breakpoint(interp
, command
);
559 PDB_init(interp
, command
);
560 PDB_continue(interp
, NULL
);
564 PDB_continue(interp
, command
);
568 PDB_print(interp
, command
);
572 PDB_next(interp
, command
);
576 PDB_trace(interp
, command
);
580 PDB_eval(interp
, command
);
587 PDB_help(interp
, command
);
591 pdb
->state
|= PDB_EXIT
;
594 if (pdb
->last_command
)
595 PDB_run_command(interp
, pdb
->last_command
);
599 "Undefined command: \"%s\". Try \"help\".", original_command
);
607 =item C<void PDB_next>
609 Execute the next N operation(s).
611 Inits the program if needed, runs the next N >= 1 operations and stops.
618 PDB_next(PARROT_INTERP
, ARGIN_NULLOK(const char *command
))
621 PDB_t
* const pdb
= interp
->pdb
;
623 /* Init the program if it's not running */
624 if (!(pdb
->state
& PDB_RUNNING
))
625 PDB_init(interp
, command
);
627 command
= nextarg(command
);
628 /* Get the number of operations to execute if any */
629 if (command
&& isdigit((unsigned char) *command
))
632 /* Erase the stopped flag */
633 pdb
->state
&= ~PDB_STOPPED
;
636 for (; n
&& pdb
->cur_opcode
; n
--)
637 DO_OP(pdb
->cur_opcode
, pdb
->debugee
);
639 /* Set the stopped flag */
640 pdb
->state
|= PDB_STOPPED
;
642 /* If program ended */
645 * RT#46119 this doesn't handle resume opcodes
647 if (!pdb
->cur_opcode
)
648 (void)PDB_program_end(interp
);
653 =item C<void PDB_trace>
655 Execute the next N operations; if no number is specified, it defaults to 1.
662 PDB_trace(PARROT_INTERP
, ARGIN_NULLOK(const char *command
))
665 PDB_t
* const pdb
= interp
->pdb
;
668 /* if debugger is not running yet, initialize */
669 if (!(pdb
->state
& PDB_RUNNING
))
670 PDB_init(interp
, command
);
672 command
= nextarg(command
);
673 /* if the number of ops to run is specified, convert to a long */
674 if (command
&& isdigit((unsigned char) *command
))
677 /* clear the PDB_STOPPED flag, we'll be running n ops now */
678 pdb
->state
&= ~PDB_STOPPED
;
679 debugee
= pdb
->debugee
;
682 for (; n
&& pdb
->cur_opcode
; n
--) {
684 debugee
->code
->base
.data
,
685 debugee
->code
->base
.data
+
686 debugee
->code
->base
.size
,
687 debugee
->pdb
->cur_opcode
);
688 DO_OP(pdb
->cur_opcode
, debugee
);
691 /* we just stopped */
692 pdb
->state
|= PDB_STOPPED
;
694 /* If program ended */
695 if (!pdb
->cur_opcode
)
696 (void)PDB_program_end(interp
);
701 =item C<PDB_condition_t * PDB_cond>
703 Analyzes a condition from the user input.
709 PARROT_CAN_RETURN_NULL
711 PDB_cond(PARROT_INTERP
, ARGIN(const char *command
))
713 PDB_condition_t
*condition
;
717 /* Return if no more arguments */
718 if (!(command
&& *command
)) {
719 PIO_eprintf(interp
, "No condition specified\n");
723 /* Allocate new condition */
724 condition
= mem_allocate_typed(PDB_condition_t
);
729 condition
->type
= PDB_cond_int
;
733 condition
->type
= PDB_cond_num
;
737 condition
->type
= PDB_cond_str
;
741 condition
->type
= PDB_cond_pmc
;
744 PIO_eprintf(interp
, "First argument must be a register\n");
745 mem_sys_free(condition
);
749 /* get the register number */
750 condition
->reg
= (unsigned char)atoi(++command
);
752 /* the next argument might have no spaces between the register and the
756 /* RT#46121 Does /this/ have to do with the fact that PASM registers used to have
757 * maximum of 2 digits? If so, there should be a while loop, I think.
759 if (condition
->reg
> 9)
763 skip_command(command
);
765 /* Now the condition */
768 if (*(command
+ 1) == '=')
769 condition
->type
|= PDB_cond_ge
;
770 else if (*(command
+ 1) == ' ')
771 condition
->type
|= PDB_cond_gt
;
776 if (*(command
+ 1) == '=')
777 condition
->type
|= PDB_cond_le
;
778 else if (*(command
+ 1) == ' ')
779 condition
->type
|= PDB_cond_lt
;
784 if (*(command
+ 1) == '=')
785 condition
->type
|= PDB_cond_eq
;
790 if (*(command
+ 1) == '=')
791 condition
->type
|= PDB_cond_ne
;
796 INV_COND
: PIO_eprintf(interp
, "Invalid condition\n");
797 mem_sys_free(condition
);
801 /* if there's an '=', skip it */
802 if (*(command
+ 1) == '=')
808 skip_command(command
);
810 /* return if no more arguments */
811 if (!(command
&& *command
)) {
812 PIO_eprintf(interp
, "Can't compare a register with nothing\n");
813 mem_sys_free(condition
);
817 if (isalpha((unsigned char)*command
)) {
818 /* It's a register - we first check that it's the correct type */
822 if (!(condition
->type
& PDB_cond_int
))
827 if (!(condition
->type
& PDB_cond_num
))
832 if (!(condition
->type
& PDB_cond_str
))
837 if (!(condition
->type
& PDB_cond_pmc
))
841 WRONG_REG
: PIO_eprintf(interp
, "Register types don't agree\n");
842 mem_sys_free(condition
);
846 /* Now we check and store the register number */
847 reg_number
= (int)atoi(++command
);
849 if (reg_number
< 0) {
850 PIO_eprintf(interp
, "Out-of-bounds register\n");
851 mem_sys_free(condition
);
855 condition
->value
= mem_allocate_typed(int);
856 *(int *)condition
->value
= reg_number
;
858 /* If the first argument was an integer */
859 else if (condition
->type
& PDB_cond_int
) {
860 /* This must be either an integer constant or register */
861 condition
->value
= mem_allocate_typed(INTVAL
);
862 *(INTVAL
*)condition
->value
= (INTVAL
)atoi(command
);
863 condition
->type
|= PDB_cond_const
;
865 else if (condition
->type
& PDB_cond_num
) {
866 condition
->value
= mem_allocate_typed(FLOATVAL
);
867 *(FLOATVAL
*)condition
->value
= (FLOATVAL
)atof(command
);
868 condition
->type
|= PDB_cond_const
;
870 else if (condition
->type
& PDB_cond_str
) {
871 for (i
= 1; ((command
[i
] != '"') && (i
< 255)); i
++)
872 str
[i
- 1] = command
[i
];
874 condition
->value
= string_make(interp
,
875 str
, i
- 1, NULL
, PObj_external_FLAG
);
876 condition
->type
|= PDB_cond_const
;
878 else if (condition
->type
& PDB_cond_pmc
) {
879 /* RT#46123 Need to figure out what to do in this case.
880 * For the time being, we just bail. */
881 PIO_eprintf(interp
, "Can't compare PMC with constant\n");
882 mem_sys_free(condition
);
886 /* We're not part of a list yet */
887 condition
->next
= NULL
;
894 =item C<void PDB_watchpoint>
903 PDB_watchpoint(PARROT_INTERP
, ARGIN(const char *command
))
905 PDB_t
* const pdb
= interp
->pdb
;
906 PDB_condition_t
* const condition
= PDB_cond(interp
, command
);
911 /* Add it to the head of the list */
913 condition
->next
= pdb
->watchpoint
;
915 pdb
->watchpoint
= condition
;
920 =item C<void PDB_set_break>
922 Set a break point, the source code file must be loaded.
929 PDB_set_break(PARROT_INTERP
, ARGIN_NULLOK(const char *command
))
931 PDB_t
* const pdb
= interp
->pdb
;
932 PDB_breakpoint_t
*newbreak
;
933 PDB_breakpoint_t
*sbreak
;
934 PDB_condition_t
*condition
;
938 command
= nextarg(command
);
939 /* If no line number was specified, set it at the current line */
940 if (command
&& *command
) {
941 const long ln
= atol(command
);
944 /* Move to the line where we will set the break point */
945 line
= pdb
->file
->line
;
947 for (i
= 1; ((i
< ln
) && (line
->next
)); i
++)
950 /* Abort if the line number provided doesn't exist */
953 "Can't set a breakpoint at line number %li\n", ln
);
958 /* Get the line to set it */
959 line
= pdb
->file
->line
;
961 while (line
->opcode
!= pdb
->cur_opcode
) {
965 "No current line found and no line number specified\n");
971 /* Skip lines that are not related to an opcode */
972 while (!line
->opcode
)
975 /* Allocate the new break point */
976 newbreak
= mem_allocate_typed(PDB_breakpoint_t
);
979 skip_command(command
);
982 real_exception(interp
, NULL
, 1, "NULL command passed to PDB_set_break");
986 /* if there is another argument to break, besides the line number,
987 * it should be an 'if', so we call another handler. */
988 if (command
&& *command
) {
989 skip_command(command
);
990 if ((condition
= PDB_cond(interp
, command
)))
991 newbreak
->condition
= condition
;
994 /* If there are no other arguments, or if there isn't a valid condition,
995 then condition will be NULL */
997 newbreak
->condition
= NULL
;
999 /* Set the address where to stop */
1000 newbreak
->pc
= line
->opcode
;
1002 /* No next breakpoint */
1003 newbreak
->next
= NULL
;
1005 /* Don't skip (at least initially) */
1008 /* Add the breakpoint to the end of the list */
1010 sbreak
= pdb
->breakpoint
;
1013 while (sbreak
->next
)
1014 sbreak
= sbreak
->next
;
1016 newbreak
->prev
= sbreak
;
1017 sbreak
->next
= newbreak
;
1018 i
= sbreak
->next
->id
= sbreak
->id
+ 1;
1021 newbreak
->prev
= NULL
;
1022 pdb
->breakpoint
= newbreak
;
1023 i
= pdb
->breakpoint
->id
= 0;
1026 PIO_eprintf(interp
, "Breakpoint %li at line %li\n", i
, line
->number
);
1031 =item C<void PDB_init>
1040 PDB_init(PARROT_INTERP
, SHIM(const char *command
))
1042 PDB_t
* const pdb
= interp
->pdb
;
1044 /* Restart if we are already running */
1045 if (pdb
->state
& PDB_RUNNING
)
1046 PIO_eprintf(interp
, "Restarting\n");
1048 /* Add the RUNNING state */
1049 pdb
->state
|= PDB_RUNNING
;
1054 =item C<void PDB_continue>
1056 Continue running the program. If a number is specified, skip that many
1064 PDB_continue(PARROT_INTERP
, ARGIN_NULLOK(const char *command
))
1066 PDB_t
* const pdb
= interp
->pdb
;
1068 /* Skip any breakpoint? */
1069 if (command
&& *command
) {
1071 if (!pdb
->breakpoint
) {
1072 PIO_eprintf(interp
, "No breakpoints to skip\n");
1076 command
= nextarg(command
);
1078 PDB_skip_breakpoint(interp
, ln
);
1081 /* Run while no break point is reached */
1082 while (!PDB_break(interp
))
1083 DO_OP(pdb
->cur_opcode
, pdb
->debugee
);
1088 =item C<PDB_breakpoint_t * PDB_find_breakpoint>
1090 Find breakpoint number N; returns C<NULL> if the breakpoint doesn't
1091 exist or if no breakpoint was specified.
1097 PARROT_CAN_RETURN_NULL
1098 PARROT_WARN_UNUSED_RESULT
1100 PDB_find_breakpoint(PARROT_INTERP
, ARGIN(const char *command
))
1102 command
= nextarg(command
);
1103 if (isdigit((unsigned char) *command
)) {
1104 const long n
= atol(command
);
1105 PDB_breakpoint_t
*breakpoint
= interp
->pdb
->breakpoint
;
1107 while (breakpoint
&& breakpoint
->id
!= n
)
1108 breakpoint
= breakpoint
->next
;
1111 PIO_eprintf(interp
, "No breakpoint number %ld", n
);
1118 /* Report an appropriate error */
1120 PIO_eprintf(interp
, "Not a valid breakpoint");
1122 PIO_eprintf(interp
, "No breakpoint specified");
1130 =item C<void PDB_disable_breakpoint>
1132 Disable a breakpoint; it can be reenabled with the enable command.
1139 PDB_disable_breakpoint(PARROT_INTERP
, ARGIN(const char *command
))
1141 PDB_breakpoint_t
* const breakpoint
= PDB_find_breakpoint(interp
, command
);
1143 /* if the breakpoint exists, disable it. */
1145 breakpoint
->skip
= -1;
1150 =item C<void PDB_enable_breakpoint>
1152 Reenable a disabled breakpoint; if the breakpoint was not disabled, has
1160 PDB_enable_breakpoint(PARROT_INTERP
, ARGIN(const char *command
))
1162 PDB_breakpoint_t
* const breakpoint
= PDB_find_breakpoint(interp
, command
);
1164 /* if the breakpoint exists, and it was disabled, enable it. */
1165 if (breakpoint
&& breakpoint
->skip
== -1)
1166 breakpoint
->skip
= 0;
1171 =item C<void PDB_delete_breakpoint>
1173 Delete a breakpoint.
1180 PDB_delete_breakpoint(PARROT_INTERP
, ARGIN(const char *command
))
1182 PDB_breakpoint_t
* const breakpoint
= PDB_find_breakpoint(interp
, command
);
1185 const PDB_line_t
*line
= interp
->pdb
->file
->line
;
1187 while (line
->opcode
!= breakpoint
->pc
)
1190 /* Delete the condition structure, if there is one */
1191 if (breakpoint
->condition
) {
1192 PDB_delete_condition(interp
, breakpoint
);
1193 breakpoint
->condition
= NULL
;
1196 /* Remove the breakpoint from the list */
1197 if (breakpoint
->prev
&& breakpoint
->next
) {
1198 breakpoint
->prev
->next
= breakpoint
->next
;
1199 breakpoint
->next
->prev
= breakpoint
->prev
;
1201 else if (breakpoint
->prev
&& !breakpoint
->next
) {
1202 breakpoint
->prev
->next
= NULL
;
1204 else if (!breakpoint
->prev
&& breakpoint
->next
) {
1205 breakpoint
->next
->prev
= NULL
;
1206 interp
->pdb
->breakpoint
= breakpoint
->next
;
1209 interp
->pdb
->breakpoint
= NULL
;
1212 /* Kill the breakpoint */
1213 mem_sys_free(breakpoint
);
1219 =item C<void PDB_delete_condition>
1221 Delete a condition associated with a breakpoint.
1228 PDB_delete_condition(SHIM_INTERP
, ARGMOD(PDB_breakpoint_t
*breakpoint
))
1230 if (breakpoint
->condition
->value
) {
1231 if (breakpoint
->condition
->type
& PDB_cond_str
) {
1232 /* 'value' is a string, so we need to be careful */
1233 PObj_external_CLEAR((STRING
*)breakpoint
->condition
->value
);
1234 PObj_on_free_list_SET((STRING
*)breakpoint
->condition
->value
);
1235 /* it should now be properly garbage collected after
1236 we destroy the condition */
1239 /* 'value' is a float or an int, so we can just free it */
1240 mem_sys_free(breakpoint
->condition
->value
);
1241 breakpoint
->condition
->value
= NULL
;
1245 mem_sys_free(breakpoint
->condition
);
1246 breakpoint
->condition
= NULL
;
1251 =item C<void PDB_skip_breakpoint>
1253 Skip C<i> times all breakpoints.
1260 PDB_skip_breakpoint(PARROT_INTERP
, long i
)
1262 interp
->pdb
->breakpoint_skip
= i
? i
-1 : i
;
1267 =item C<char PDB_program_end>
1276 PDB_program_end(PARROT_INTERP
)
1278 PDB_t
* const pdb
= interp
->pdb
;
1280 /* Remove the RUNNING state */
1281 pdb
->state
&= ~PDB_RUNNING
;
1283 PIO_eprintf(interp
, "Program exited.\n");
1289 =item C<char PDB_check_condition>
1291 Returns true if the condition was met.
1297 PARROT_WARN_UNUSED_RESULT
1299 PDB_check_condition(PARROT_INTERP
, ARGIN(const PDB_condition_t
*condition
))
1301 if (condition
->type
& PDB_cond_int
) {
1304 * RT#46125 verify register is in range
1306 i
= REG_INT(interp
, condition
->reg
);
1308 if (condition
->type
& PDB_cond_const
)
1309 j
= *(INTVAL
*)condition
->value
;
1311 j
= REG_INT(interp
, *(int *)condition
->value
);
1313 if (((condition
->type
& PDB_cond_gt
) && (i
> j
)) ||
1314 ((condition
->type
& PDB_cond_ge
) && (i
>= j
)) ||
1315 ((condition
->type
& PDB_cond_eq
) && (i
== j
)) ||
1316 ((condition
->type
& PDB_cond_ne
) && (i
!= j
)) ||
1317 ((condition
->type
& PDB_cond_le
) && (i
<= j
)) ||
1318 ((condition
->type
& PDB_cond_lt
) && (i
< j
)))
1323 else if (condition
->type
& PDB_cond_num
) {
1326 k
= REG_NUM(interp
, condition
->reg
);
1328 if (condition
->type
& PDB_cond_const
)
1329 l
= *(FLOATVAL
*)condition
->value
;
1331 l
= REG_NUM(interp
, *(int *)condition
->value
);
1333 if (((condition
->type
& PDB_cond_gt
) && (k
> l
)) ||
1334 ((condition
->type
& PDB_cond_ge
) && (k
>= l
)) ||
1335 ((condition
->type
& PDB_cond_eq
) && (k
== l
)) ||
1336 ((condition
->type
& PDB_cond_ne
) && (k
!= l
)) ||
1337 ((condition
->type
& PDB_cond_le
) && (k
<= l
)) ||
1338 ((condition
->type
& PDB_cond_lt
) && (k
< l
)))
1343 else if (condition
->type
& PDB_cond_str
) {
1346 m
= REG_STR(interp
, condition
->reg
);
1348 if (condition
->type
& PDB_cond_const
)
1349 n
= (STRING
*)condition
->value
;
1351 n
= REG_STR(interp
, *(int *)condition
->value
);
1353 if (((condition
->type
& PDB_cond_gt
) &&
1354 (string_compare(interp
, m
, n
) > 0)) ||
1355 ((condition
->type
& PDB_cond_ge
) &&
1356 (string_compare(interp
, m
, n
) >= 0)) ||
1357 ((condition
->type
& PDB_cond_eq
) &&
1358 (string_compare(interp
, m
, n
) == 0)) ||
1359 ((condition
->type
& PDB_cond_ne
) &&
1360 (string_compare(interp
, m
, n
) != 0)) ||
1361 ((condition
->type
& PDB_cond_le
) &&
1362 (string_compare(interp
, m
, n
) <= 0)) ||
1363 ((condition
->type
& PDB_cond_lt
) &&
1364 (string_compare(interp
, m
, n
) < 0)))
1375 =item C<char PDB_break>
1377 Returns true if we have to stop running.
1383 PARROT_WARN_UNUSED_RESULT
1385 PDB_break(PARROT_INTERP
)
1387 PDB_t
* const pdb
= interp
->pdb
;
1388 PDB_breakpoint_t
*breakpoint
= pdb
->breakpoint
;
1389 PDB_condition_t
*watchpoint
= pdb
->watchpoint
;
1391 /* Check the watchpoints first. */
1392 while (watchpoint
) {
1393 if (PDB_check_condition(interp
, watchpoint
)) {
1394 pdb
->state
|= PDB_STOPPED
;
1398 watchpoint
= watchpoint
->next
;
1401 /* If program ended */
1402 if (!pdb
->cur_opcode
)
1403 return PDB_program_end(interp
);
1405 /* If the program is STOPPED allow it to continue */
1406 if (pdb
->state
& PDB_STOPPED
) {
1407 pdb
->state
&= ~PDB_STOPPED
;
1411 /* If we have to skip breakpoints, do so. */
1412 if (pdb
->breakpoint_skip
) {
1413 pdb
->breakpoint_skip
--;
1417 while (breakpoint
) {
1418 /* if we are in a break point */
1419 if (pdb
->cur_opcode
== breakpoint
->pc
) {
1420 if (breakpoint
->skip
< 0)
1423 /* Check if there is a condition for this breakpoint */
1424 if ((breakpoint
->condition
) &&
1425 (!PDB_check_condition(interp
, breakpoint
->condition
)))
1428 /* Add the STOPPED state and stop */
1429 pdb
->state
|= PDB_STOPPED
;
1432 breakpoint
= breakpoint
->next
;
1440 =item C<char * PDB_escape>
1442 Escapes C<">, C<\r>, C<\n>, C<\t>, C<\a> and C<\\>.
1448 PARROT_WARN_UNUSED_RESULT
1449 PARROT_CAN_RETURN_NULL
1452 PDB_escape(ARGIN(const char *string
), INTVAL length
)
1457 length
= length
> 20 ? 20 : length
;
1458 end
= string
+ length
;
1460 /* Return if there is no string to escape*/
1464 fill
= _new
= (char *)mem_sys_allocate(length
* 2 + 1);
1466 for (; string
< end
; string
++) {
1497 *(fill
++) = *string
;
1509 =item C<int PDB_unescape>
1511 Do inplace unescape of C<\r>, C<\n>, C<\t>, C<\a> and C<\\>.
1518 PDB_unescape(ARGMOD(char *string
))
1522 for (; *string
; string
++) {
1525 if (*string
== '\\') {
1529 switch (string
[1]) {
1551 for (i
= 1; fill
[i
+ 1]; i
++)
1552 fill
[i
] = fill
[i
+ 1];
1563 =item C<size_t PDB_disassemble_op>
1572 PDB_disassemble_op(PARROT_INTERP
, ARGOUT(char *dest
), int space
,
1573 ARGIN(const op_info_t
*info
), ARGIN(const opcode_t
*op
),
1574 ARGMOD_NULLOK(PDB_file_t
*file
), ARGIN_NULLOK(const opcode_t
*code_start
),
1580 /* Write the opcode name */
1581 const char * const p
= full_name
? info
->full_name
: info
->name
;
1587 /* Concat the arguments */
1588 for (j
= 1; j
< info
->op_count
; j
++) {
1592 PARROT_ASSERT(size
+ 2 < space
);
1594 switch (info
->types
[j
-1]) {
1608 /* If the opcode jumps and this is the last argument,
1609 that means this is a label */
1610 if ((j
== info
->op_count
- 1) &&
1611 (info
->jump
& PARROT_JUMP_RELATIVE
)) {
1614 i
= PDB_add_label(file
, op
, op
[j
]);
1616 else if (code_start
) {
1619 i
= op
[j
] + (op
- code_start
);
1628 /* Convert the integer to a string */
1633 PARROT_ASSERT(size
+ 20 < space
);
1635 size
+= sprintf(&dest
[size
], INTVAL_FMT
, i
);
1637 /* If this is a constant dispatch arg to an "infix" op, then show
1638 the corresponding symbolic op name. */
1639 if (j
== 1 && info
->types
[j
-1] == PARROT_ARG_IC
1640 && (STREQ(info
->name
, "infix") || STREQ(info
->name
, "n_infix"))) {
1641 PARROT_ASSERT(size
+ 20 < space
);
1643 size
+= sprintf(&dest
[size
], " [%s]",
1644 /* [kludge: the "2+" skips the leading underscores. --
1646 2 + Parrot_MMD_method_name(interp
, op
[j
]));
1651 /* Convert the float to a string */
1652 const FLOATVAL f
= interp
->code
->const_table
->constants
[op
[j
]]->u
.number
;
1653 Parrot_snprintf(interp
, buf
, sizeof (buf
), FLOATVAL_FMT
, f
);
1654 strcpy(&dest
[size
], buf
);
1655 size
+= strlen(buf
);
1660 if (interp
->code
->const_table
->constants
[op
[j
]]-> u
.string
->strlen
) {
1661 char * const escaped
=
1662 PDB_escape(interp
->code
->const_table
->
1663 constants
[op
[j
]]->u
.string
->strstart
,
1664 interp
->code
->const_table
->
1665 constants
[op
[j
]]->u
.string
->strlen
);
1667 strcpy(&dest
[size
], escaped
);
1668 size
+= strlen(escaped
);
1669 mem_sys_free(escaped
);
1675 Parrot_snprintf(interp
, buf
, sizeof (buf
), "PMC_CONST(%d)", op
[j
]);
1676 strcpy(&dest
[size
], buf
);
1677 size
+= strlen(buf
);
1681 Parrot_snprintf(interp
, buf
, sizeof (buf
), "P" INTVAL_FMT
, op
[j
]);
1682 strcpy(&dest
[size
], buf
);
1683 size
+= strlen(buf
);
1688 PMC
* k
= interp
->code
->const_table
->constants
[op
[j
]]->u
.key
;
1691 switch (PObj_get_FLAGS(k
)) {
1694 case KEY_integer_FLAG
:
1695 Parrot_snprintf(interp
, buf
, sizeof (buf
),
1696 INTVAL_FMT
, PMC_int_val(k
));
1697 strcpy(&dest
[size
], buf
);
1698 size
+= strlen(buf
);
1700 case KEY_number_FLAG
:
1701 Parrot_snprintf(interp
, buf
, sizeof (buf
),
1702 FLOATVAL_FMT
, PMC_num_val(k
));
1703 strcpy(&dest
[size
], buf
);
1704 size
+= strlen(buf
);
1706 case KEY_string_FLAG
:
1709 char * const temp
= string_to_cstring(interp
, PMC_str_val(k
));
1710 strcpy(&dest
[size
], temp
);
1711 string_cstring_free(temp
);
1713 size
+= string_length(interp
, PMC_str_val(k
));
1716 case KEY_integer_FLAG
|KEY_register_FLAG
:
1717 Parrot_snprintf(interp
, buf
, sizeof (buf
),
1718 "I" INTVAL_FMT
, PMC_int_val(k
));
1719 strcpy(&dest
[size
], buf
);
1720 size
+= strlen(buf
);
1722 case KEY_number_FLAG
|KEY_register_FLAG
:
1723 Parrot_snprintf(interp
, buf
, sizeof (buf
),
1724 "N" INTVAL_FMT
, PMC_int_val(k
));
1725 strcpy(&dest
[size
], buf
);
1726 size
+= strlen(buf
);
1728 case KEY_string_FLAG
|KEY_register_FLAG
:
1729 Parrot_snprintf(interp
, buf
, sizeof (buf
),
1730 "S" INTVAL_FMT
, PMC_int_val(k
));
1731 strcpy(&dest
[size
], buf
);
1732 size
+= strlen(buf
);
1734 case KEY_pmc_FLAG
|KEY_register_FLAG
:
1735 Parrot_snprintf(interp
, buf
, sizeof (buf
),
1736 "P" INTVAL_FMT
, PMC_int_val(k
));
1737 strcpy(&dest
[size
], buf
);
1738 size
+= strlen(buf
);
1744 k
= PMC_data_typed(k
, PMC
*);
1752 dest
[size
- 1] = '[';
1753 Parrot_snprintf(interp
, buf
, sizeof (buf
), "I" INTVAL_FMT
, op
[j
]);
1754 strcpy(&dest
[size
], buf
);
1755 size
+= strlen(buf
);
1758 case PARROT_ARG_KIC
:
1759 dest
[size
- 1] = '[';
1760 Parrot_snprintf(interp
, buf
, sizeof (buf
), INTVAL_FMT
, op
[j
]);
1761 strcpy(&dest
[size
], buf
);
1762 size
+= strlen(buf
);
1766 real_exception(interp
, NULL
, 1, "Unknown opcode type");
1769 if (j
!= info
->op_count
- 1)
1773 /* Special decoding for the signature used in args/returns. Such ops have
1774 one fixed parameter (the signature vector), plus a varying number of
1775 registers/constants. For each arg/return, we show the register and its
1776 flags using PIR syntax. */
1777 if (*(op
) == PARROT_OP_set_args_pc
||
1778 *(op
) == PARROT_OP_get_results_pc
||
1779 *(op
) == PARROT_OP_get_params_pc
||
1780 *(op
) == PARROT_OP_set_returns_pc
) {
1782 PMC
* const sig
= interp
->code
->const_table
->constants
[op
[1]]->u
.key
;
1783 int n_values
= SIG_ELEMS(sig
);
1784 /* The flag_names strings come from Call_bits_enum_t (with which it
1785 should probably be colocated); they name the bits from LSB to MSB.
1786 The two least significant bits are not flags; they are the register
1787 type, which is decoded elsewhere. We also want to show unused bits,
1788 which could indicate problems.
1790 const char * const flag_names
[] = {
1796 " :flat", /* should be :slurpy for args */
1804 /* Register decoding. It would be good to abstract this, too. */
1805 static const char regs
[] = "ISPN";
1807 for (j
= 0; j
< n_values
; j
++) {
1808 unsigned int idx
= 0;
1809 const int sig_value
= VTABLE_get_integer_keyed_int(interp
, sig
, j
);
1811 /* Print the register name, e.g. P37. */
1814 buf
[idx
++] = regs
[sig_value
& PARROT_ARG_TYPE_MASK
];
1815 Parrot_snprintf(interp
, &buf
[idx
], sizeof (buf
)-idx
,
1816 INTVAL_FMT
, op
[j
+2]);
1819 /* Add flags, if we have any. */
1822 int flags
= sig_value
;
1824 /* End when we run out of flags, off the end of flag_names, or
1825 * get too close to the end of buf.
1826 * 100 is just an estimate of all buf lengths added together.
1828 while (flags
&& idx
< sizeof (buf
) - 100) {
1829 const char * const flag_string
= flag_names
[flag_idx
];
1832 if (flags
& 1 && *flag_string
) {
1833 const size_t n
= strlen(flag_string
);
1834 strcpy(&buf
[idx
], flag_string
);
1842 /* Add it to dest. */
1844 strcpy(&dest
[size
], buf
);
1845 size
+= strlen(buf
);
1855 =item C<void PDB_disassemble>
1857 Disassemble the bytecode.
1864 PDB_disassemble(PARROT_INTERP
, SHIM(const char *command
))
1866 PDB_t
* const pdb
= interp
->pdb
;
1867 opcode_t
* pc
= interp
->code
->base
.data
;
1870 PDB_line_t
*pline
, *newline
;
1874 const unsigned int default_size
= 32768;
1875 size_t space
; /* How much space do we have? */
1876 size_t size
, alloced
, n
;
1878 pfile
= mem_allocate_typed(PDB_file_t
);
1879 pline
= mem_allocate_typed(PDB_line_t
);
1881 /* If we already got a source, free it */
1883 PDB_free_file(interp
);
1886 pline
->label
= NULL
;
1887 pfile
->line
= pline
;
1888 pfile
->label
= NULL
;
1890 pfile
->source
= (char *)mem_sys_allocate(default_size
);
1891 pline
->source_offset
= 0;
1893 alloced
= space
= default_size
;
1894 code_end
= pc
+ interp
->code
->base
.size
;
1896 while (pc
!= code_end
) {
1898 if (space
< default_size
) {
1899 alloced
+= default_size
;
1900 space
+= default_size
;
1901 pfile
->source
= (char *)mem_sys_realloc(pfile
->source
, alloced
);
1904 size
= PDB_disassemble_op(interp
, pfile
->source
+ pfile
->size
,
1905 space
, &interp
->op_info_table
[*pc
], pc
, pfile
, NULL
, 1);
1907 pfile
->size
+= size
;
1908 pfile
->source
[pfile
->size
- 1] = '\n';
1910 /* Store the opcode of this line */
1912 n
= interp
->op_info_table
[*pc
].op_count
;
1914 ADD_OP_VAR_PART(interp
, interp
->code
, pc
, n
);
1917 /* Prepare for next line */
1918 newline
= mem_allocate_typed(PDB_line_t
);
1919 newline
->label
= NULL
;
1920 newline
->next
= NULL
;
1921 newline
->number
= pline
->number
+ 1;
1922 pline
->next
= newline
;
1924 pline
->source_offset
= pfile
->size
;
1927 /* Add labels to the lines they belong to */
1928 label
= pfile
->label
;
1931 /* Get the line to apply the label */
1932 pline
= pfile
->line
;
1934 while (pline
&& pline
->opcode
!= label
->opcode
)
1935 pline
= pline
->next
;
1939 "Label number %li out of bounds.\n", label
->number
);
1940 /* RT#46127: free allocated memory */
1944 pline
->label
= label
;
1946 label
= label
->next
;
1949 pdb
->state
|= PDB_SRC_LOADED
;
1955 =item C<long PDB_add_label>
1957 Add a label to the label list.
1964 PDB_add_label(ARGMOD(PDB_file_t
*file
), ARGIN(const opcode_t
*cur_opcode
),
1968 PDB_label_t
*label
= file
->label
;
1970 /* See if there is already a label at this line */
1972 if (label
->opcode
== cur_opcode
+ offset
)
1973 return label
->number
;
1974 label
= label
->next
;
1977 /* Allocate a new label */
1978 label
= file
->label
;
1979 _new
= mem_allocate_typed(PDB_label_t
);
1980 _new
->opcode
= cur_opcode
+ offset
;
1985 label
= label
->next
;
1987 _new
->number
= label
->number
+ 1;
1995 return _new
->number
;
2000 =item C<void PDB_free_file>
2002 Frees any allocated source files.
2009 PDB_free_file(PARROT_INTERP
)
2011 PDB_file_t
*file
= interp
->pdb
->file
;
2014 /* Free all of the allocated line structures */
2015 PDB_line_t
*line
= file
->line
;
2020 PDB_line_t
* const nline
= line
->next
;
2025 /* Free all of the allocated label structures */
2026 label
= file
->label
;
2029 PDB_label_t
* const nlabel
= label
->next
;
2031 mem_sys_free(label
);
2035 /* Free the remaining allocated portions of the file structure */
2036 if (file
->sourcefilename
)
2037 mem_sys_free(file
->sourcefilename
);
2040 mem_sys_free(file
->source
);
2047 /* Make sure we don't end up pointing at garbage memory */
2048 interp
->pdb
->file
= NULL
;
2053 =item C<void PDB_load_source>
2055 Load a source code file.
2062 PDB_load_source(PARROT_INTERP
, ARGIN(const char *command
))
2069 PDB_t
* const pdb
= interp
->pdb
;
2070 opcode_t
*pc
= pdb
->cur_opcode
;
2071 unsigned long size
= 0;
2073 /* If there was a file already loaded or the bytecode was
2074 disassembled, free it */
2076 PDB_free_file(interp
);
2078 /* Get the name of the file */
2079 for (i
= 0; command
[i
]; i
++)
2085 file
= fopen(f
, "r");
2087 /* abort if fopen failed */
2089 PIO_eprintf(interp
, "Unable to load %s\n", f
);
2093 pfile
= mem_allocate_zeroed_typed(PDB_file_t
);
2094 pline
= mem_allocate_zeroed_typed(PDB_line_t
);
2096 pfile
->source
= (char *)mem_sys_allocate(1024);
2097 pfile
->line
= pline
;
2100 while ((c
= fgetc(file
)) != EOF
) {
2102 if (++size
== 1024) {
2103 pfile
->source
= (char *)mem_sys_realloc(pfile
->source
,
2104 (size_t)pfile
->size
+ 1024);
2107 pfile
->source
[pfile
->size
] = (char)c
;
2112 /* If the line has an opcode move to the next one,
2113 otherwise leave it with NULL to skip it. */
2114 PDB_line_t
*newline
;
2115 if (PDB_hasinstruction(pfile
->source
+ pline
->source_offset
)) {
2118 n
= interp
->op_info_table
[*pc
].op_count
;
2119 ADD_OP_VAR_PART(interp
, interp
->code
, pc
, n
);
2122 newline
= mem_allocate_zeroed_typed(PDB_line_t
);
2123 newline
->number
= pline
->number
+ 1;
2124 pline
->next
= newline
;
2126 pline
->source_offset
= pfile
->size
;
2127 pline
->opcode
= NULL
;
2128 pline
->label
= NULL
;
2132 pdb
->state
|= PDB_SRC_LOADED
;
2138 =item C<char PDB_hasinstruction>
2140 Return true if the line has an instruction.
2146 =item * This should take the line, get an instruction, get the opcode for
2147 that instruction and check that is the correct one.
2149 =item * Decide what to do with macros if anything.
2157 PARROT_WARN_UNUSED_RESULT
2158 PARROT_PURE_FUNCTION
2160 PDB_hasinstruction(ARGIN(const char *c
))
2164 /* as long as c is not NULL, we're not looking at a comment (#...) or a '\n'... */
2165 while (*c
&& *c
!= '#' && *c
!= '\n') {
2166 /* ... and c is alphanumeric or a quoted string then the line contains
2167 * an instruction. */
2168 if (isalnum((unsigned char) *c
) || *c
== '"') {
2171 else if (*c
== ':') {
2172 /* this is a label. RT#46137 right? */
2184 =item C<void PDB_list>
2186 Show lines from the source code file.
2193 PDB_list(PARROT_INTERP
, ARGIN(const char *command
))
2199 PDB_t
*pdb
= interp
->pdb
;
2200 unsigned long n
= 10;
2203 PIO_eprintf(interp
, "No source file loaded\n");
2207 command
= nextarg(command
);
2208 /* set the list line if provided */
2209 if (isdigit((unsigned char) *command
)) {
2210 line_number
= atol(command
) - 1;
2211 if (line_number
< 0)
2212 pdb
->file
->list_line
= 0;
2214 pdb
->file
->list_line
= (unsigned long) line_number
;
2216 skip_command(command
);
2219 pdb
->file
->list_line
= 0;
2222 /* set the number of lines to print */
2223 if (isdigit((unsigned char) *command
)) {
2225 skip_command(command
);
2228 /* if n is zero, we simply return, as we don't have to print anything */
2232 line
= pdb
->file
->line
;
2234 for (i
= 0; i
< pdb
->file
->list_line
&& line
->next
; i
++)
2238 while (line
->next
) {
2239 PIO_eprintf(interp
, "%li ", pdb
->file
->list_line
+ i
);
2240 /* If it has a label print it */
2242 PIO_eprintf(interp
, "L%li:\t", line
->label
->number
);
2244 c
= pdb
->file
->source
+ line
->source_offset
;
2247 PIO_eprintf(interp
, "%c", *(c
++));
2249 PIO_eprintf(interp
, "\n");
2258 pdb
->file
->list_line
= 0;
2260 pdb
->file
->list_line
+= n
;
2265 =item C<void PDB_eval>
2267 C<eval>s an instruction.
2274 PDB_eval(PARROT_INTERP
, ARGIN(const char *command
))
2276 /* This code is almost certainly wrong. The Parrot debugger needs love. */
2277 opcode_t
*run
= PDB_compile(interp
, command
);
2285 =item C<opcode_t * PDB_compile>
2287 Compiles instructions with the PASM compiler.
2289 Appends an C<end> op.
2291 This may be called from C<PDB_eval> above or from the compile opcode
2292 which generates a malloced string.
2298 PARROT_CAN_RETURN_NULL
2300 PDB_compile(PARROT_INTERP
, ARGIN(const char *command
))
2303 const char *end
= "\nend\n";
2304 STRING
*key
= const_string(interp
, "PASM");
2305 PMC
*compreg_hash
= VTABLE_get_pmc_keyed_int(interp
,
2306 interp
->iglobals
, IGLOBALS_COMPREG_HASH
);
2307 PMC
*compiler
= VTABLE_get_pmc_keyed_str(interp
, compreg_hash
, key
);
2309 if (!VTABLE_defined(interp
, compiler
)) {
2310 fprintf(stderr
, "Couldn't find PASM compiler");
2314 buf
= Parrot_sprintf_c(interp
, "%s%s", command
, end
);
2316 return VTABLE_invoke(interp
, compiler
, buf
);
2321 =item C<int PDB_extend_const_table>
2323 Extend the constant table.
2330 PDB_extend_const_table(PARROT_INTERP
)
2332 int k
= ++interp
->code
->const_table
->const_count
;
2334 /* Update the constant count and reallocate */
2335 if (interp
->code
->const_table
->constants
) {
2336 interp
->code
->const_table
->constants
=
2337 (PackFile_Constant
**)mem_sys_realloc(interp
->code
->const_table
->constants
,
2338 k
* sizeof (PackFile_Constant
*));
2341 interp
->code
->const_table
->constants
=
2342 (PackFile_Constant
**)mem_sys_allocate(k
* sizeof (PackFile_Constant
*));
2345 /* Allocate a new constant */
2346 interp
->code
->const_table
->constants
[--k
] =
2347 PackFile_Constant_new(interp
);
2354 =item C<static void dump_string>
2356 Dumps the buflen, flags, bufused, strlen, and offset associated with a string
2357 and the string itself.
2364 dump_string(PARROT_INTERP
, ARGIN_NULLOK(const STRING
*s
))
2369 PIO_eprintf(interp
, "\tBuflen =\t%12ld\n", PObj_buflen(s
));
2370 PIO_eprintf(interp
, "\tFlags =\t%12ld\n", PObj_get_FLAGS(s
));
2371 PIO_eprintf(interp
, "\tBufused =\t%12ld\n", s
->bufused
);
2372 PIO_eprintf(interp
, "\tStrlen =\t%12ld\n", s
->strlen
);
2373 PIO_eprintf(interp
, "\tOffset =\t%12ld\n",
2374 (char*) s
->strstart
- (char*) PObj_bufstart(s
));
2375 PIO_eprintf(interp
, "\tString =\t%S\n", s
);
2380 =item C<void PDB_print_user_stack>
2382 Print an entry from the user stack.
2389 PDB_print_user_stack(PARROT_INTERP
, ARGIN(const char *command
))
2391 Stack_Entry_t
*entry
;
2393 Stack_Chunk_t
* const chunk
= CONTEXT(interp
->ctx
)->user_stack
;
2395 command
= nextarg(command
);
2397 depth
= atol(command
);
2399 entry
= stack_entry(interp
, chunk
, (INTVAL
)depth
);
2402 PIO_eprintf(interp
, "No such entry on stack\n");
2406 switch (entry
->entry_type
) {
2407 case STACK_ENTRY_INT
:
2408 PIO_eprintf(interp
, "Integer\t=\t%8vi\n", UVal_int(entry
->entry
));
2410 case STACK_ENTRY_FLOAT
:
2411 PIO_eprintf(interp
, "Float\t=\t%8.4vf\n", UVal_num(entry
->entry
));
2413 case STACK_ENTRY_STRING
:
2414 PIO_eprintf(interp
, "String =\n");
2415 dump_string(interp
, UVal_str(entry
->entry
));
2417 case STACK_ENTRY_PMC
:
2418 PIO_eprintf(interp
, "PMC =\n%PS\n", UVal_ptr(entry
->entry
));
2420 case STACK_ENTRY_POINTER
:
2421 PIO_eprintf(interp
, "POINTER\n");
2423 case STACK_ENTRY_DESTINATION
:
2424 PIO_eprintf(interp
, "DESTINATION\n");
2427 PIO_eprintf(interp
, "Invalid stack_entry_type!\n");
2434 =item C<void PDB_print>
2436 Print interp registers.
2443 PDB_print(PARROT_INTERP
, ARGIN(const char *command
))
2445 const char * const s
= GDB_P(interp
->pdb
->debugee
, command
);
2446 PIO_eprintf(interp
, "%s\n", s
);
2452 =item C<void PDB_info>
2454 Print the interpreter info.
2461 PDB_info(PARROT_INTERP
)
2463 PIO_eprintf(interp
, "Total memory allocated = %ld\n",
2464 interpinfo(interp
, TOTAL_MEM_ALLOC
));
2465 PIO_eprintf(interp
, "DOD runs = %ld\n",
2466 interpinfo(interp
, DOD_RUNS
));
2467 PIO_eprintf(interp
, "Lazy DOD runs = %ld\n",
2468 interpinfo(interp
, LAZY_DOD_RUNS
));
2469 PIO_eprintf(interp
, "Collect runs = %ld\n",
2470 interpinfo(interp
, COLLECT_RUNS
));
2471 PIO_eprintf(interp
, "Collect memory = %ld\n",
2472 interpinfo(interp
, TOTAL_COPIED
));
2473 PIO_eprintf(interp
, "Active PMCs = %ld\n",
2474 interpinfo(interp
, ACTIVE_PMCS
));
2475 PIO_eprintf(interp
, "Extended PMCs = %ld\n",
2476 interpinfo(interp
, EXTENDED_PMCS
));
2477 PIO_eprintf(interp
, "Timely DOD PMCs = %ld\n",
2478 interpinfo(interp
, IMPATIENT_PMCS
));
2479 PIO_eprintf(interp
, "Total PMCs = %ld\n",
2480 interpinfo(interp
, TOTAL_PMCS
));
2481 PIO_eprintf(interp
, "Active buffers = %ld\n",
2482 interpinfo(interp
, ACTIVE_BUFFERS
));
2483 PIO_eprintf(interp
, "Total buffers = %ld\n",
2484 interpinfo(interp
, TOTAL_BUFFERS
));
2485 PIO_eprintf(interp
, "Header allocations since last collect = %ld\n",
2486 interpinfo(interp
, HEADER_ALLOCS_SINCE_COLLECT
));
2487 PIO_eprintf(interp
, "Memory allocations since last collect = %ld\n",
2488 interpinfo(interp
, MEM_ALLOCS_SINCE_COLLECT
));
2493 =item C<void PDB_help>
2495 Print the help text. "Help" with no arguments prints a list of commands.
2496 "Help xxx" prints information on command xxx.
2503 PDB_help(PARROT_INTERP
, ARGIN(const char *command
))
2507 /* Extract the command after leading whitespace (for error messages). */
2508 while (*command
&& isspace(*command
))
2510 parse_command(command
, &c
);
2514 PIO_eprintf(interp
, "No documentation yet");
2517 PIO_eprintf(interp
, "No documentation yet");
2521 "List the source code.\n\n\
2522 Optionally specify the line number to begin the listing from and the number\n\
2523 of lines to display.\n");
2527 "Run (or restart) the program being debugged.\n\n\
2528 Arguments specified after \"run\" are passed as command line arguments to\n\
2533 "Set a breakpoint at a given line number (which must be specified).\n\n\
2534 Optionally, specify a condition, in which case the breakpoint will only\n\
2535 activate if the condition is met. Conditions take the form:\n\n\
2536 if [REGISTER] [COMPARISON] [REGISTER or CONSTANT]\n\n\
2539 break 10 if I4 > I3\n\n\
2540 break 45 if S1 == \"foo\"\n\n\
2541 The command returns a number which is the breakpoint identifier.");
2544 PIO_eprintf(interp
, "Interprets a file.\n\
2546 (pdb) script file.script\n");
2549 PIO_eprintf(interp
, "No documentation yet");
2553 "Delete a breakpoint.\n\n\
2554 The breakpoint to delete must be specified by its breakpoint number.\n\
2555 Deleted breakpoints are gone completely. If instead you want to\n\
2556 temporarily disable a breakpoint, use \"disable\".\n");
2560 "Disable a breakpoint.\n\n\
2561 The breakpoint to disable must be specified by its breakpoint number.\n\
2562 Disabled breakpoints are not forgotten, but have no effect until re-enabled\n\
2563 with the \"enable\" command.\n");
2566 PIO_eprintf(interp
, "Re-enable a disabled breakpoint.\n");
2570 "Continue the program execution.\n\n\
2571 Without arguments, the program runs until a breakpoint is found\n\
2572 (or until the program terminates for some other reason).\n\n\
2573 If a number is specified, then skip that many breakpoints.\n\n\
2574 If the program has terminated, then \"continue\" will do nothing;\n\
2575 use \"run\" to re-run the program.\n");
2579 "Execute a specified number of instructions.\n\n\
2580 If a number is specified with the command (e.g. \"next 5\"), then\n\
2581 execute that number of instructions, unless the program reaches a\n\
2582 breakpoint, or stops for some other reason.\n\n\
2583 If no number is specified, it defaults to 1.\n");
2586 PIO_eprintf(interp
, "No documentation yet");
2590 "Similar to \"next\", but prints additional trace information.\n\
2591 This is the same as the information you get when running Parrot with\n\
2595 PIO_eprintf(interp
, "Print register: e.g. \"p i2\"\n\
2596 Note that the register type is case-insensitive. If no digits appear\n\
2597 after the register type, all registers of that type are printed.\n");
2601 "Print information about the current interpreter\n");
2604 PIO_eprintf(interp
, "Exit the debugger.\n");
2607 PIO_eprintf(interp
, "Print a list of available commands.\n");
2610 /* C89: strings need to be 509 chars or less */
2611 PIO_eprintf(interp
, "\
2612 List of commands:\n\
2613 disassemble -- disassemble the bytecode\n\
2614 load -- load a source code file\n\
2615 list (l) -- list the source code file\n\
2616 run (r) -- run the program\n\
2617 break (b) -- add a breakpoint\n\
2618 script (f) -- interprets a file as user commands\n\
2619 watch (w) -- add a watchpoint\n\
2620 delete (d) -- delete a breakpoint\n\
2621 disable -- disable a breakpoint\n\
2622 enable -- reenable a disabled breakpoint\n\
2623 continue (c) -- continue the program execution\n");
2624 PIO_eprintf(interp
, "\
2625 next (n) -- run the next instruction\n\
2626 eval (e) -- run an instruction\n\
2627 trace (t) -- trace the next instruction\n\
2628 print (p) -- print the interpreter registers\n\
2629 stack (s) -- examine the stack\n\
2630 info -- print interpreter information\n\
2631 quit (q) -- exit the debugger\n\
2632 help (h) -- print this help\n\n\
2633 Type \"help\" followed by a command name for full documentation.\n\n");
2636 PIO_eprintf(interp
, "Unknown command: \"%s\".", command
);
2643 =item C<void PDB_backtrace>
2645 Prints a backtrace of the interp's call chain.
2652 PDB_backtrace(PARROT_INTERP
)
2658 /* information about the current sub */
2659 PMC
*sub
= interpinfo_p(interp
, CURRENT_SUB
);
2660 parrot_context_t
*ctx
= CONTEXT(interp
->ctx
);
2662 if (!PMC_IS_NULL(sub
)) {
2663 str
= Parrot_Context_infostr(interp
, ctx
);
2665 PIO_eprintf(interp
, "%Ss\n", str
);
2668 /* backtrace: follow the continuation chain */
2670 Parrot_cont
*sub_cont
;
2671 sub
= ctx
->current_cont
;
2676 sub_cont
= PMC_cont(sub
);
2681 str
= Parrot_Context_infostr(interp
, sub_cont
->to_ctx
);
2686 /* recursion detection */
2687 if (!PMC_IS_NULL(old
) && PMC_cont(old
) &&
2688 PMC_cont(old
)->to_ctx
->current_pc
==
2689 PMC_cont(sub
)->to_ctx
->current_pc
&&
2690 PMC_cont(old
)->to_ctx
->current_sub
==
2691 PMC_cont(sub
)->to_ctx
->current_sub
) {
2694 else if (rec_level
!= 0) {
2695 PIO_eprintf(interp
, "... call repeated %d times\n", rec_level
);
2699 /* print the context description */
2701 PIO_eprintf(interp
, "%Ss\n", str
);
2703 /* get the next Continuation */
2704 ctx
= PMC_cont(sub
)->to_ctx
;
2712 PIO_eprintf(interp
, "... call repeated %d times\n", rec_level
);
2718 * GDB_P gdb> pp $I0 print register I0 value
2720 * RT46139 more, more
2725 =item C<static const char* GDB_print_reg>
2727 RT#48260: Not yet documented!!!
2733 PARROT_WARN_UNUSED_RESULT
2734 PARROT_CANNOT_RETURN_NULL
2736 GDB_print_reg(PARROT_INTERP
, int t
, int n
)
2739 if (n
>= 0 && n
< CONTEXT(interp
->ctx
)->n_regs_used
[t
]) {
2742 return string_from_int(interp
, REG_INT(interp
, n
))->strstart
;
2744 return string_from_num(interp
, REG_NUM(interp
, n
))->strstart
;
2746 return REG_STR(interp
, n
)->strstart
;
2748 /* prints directly */
2749 trace_pmc_dump(interp
, REG_PMC(interp
, n
));
2755 return "no such reg";
2760 =item C<static const char* GDB_P>
2762 RT#48260: Not yet documented!!!
2768 PARROT_WARN_UNUSED_RESULT
2769 PARROT_CANNOT_RETURN_NULL
2771 GDB_P(PARROT_INTERP
, ARGIN(const char *s
))
2776 /* Skip leading whitespace. */
2780 reg_type
= (unsigned char) toupper((unsigned char)*s
);
2782 case 'I': t
= REGNO_INT
; break;
2783 case 'N': t
= REGNO_NUM
; break;
2784 case 'S': t
= REGNO_STR
; break;
2785 case 'P': t
= REGNO_PMC
; break;
2786 default: return "Need a register.";
2789 /* Print all registers of this type. */
2790 const int max_reg
= CONTEXT(interp
->ctx
)->n_regs_used
[t
];
2793 for (n
= 0; n
< max_reg
; n
++) {
2794 /* this must be done in two chunks because PMC's print directly. */
2795 PIO_eprintf(interp
, "\n %c%d = ", reg_type
, n
);
2796 PIO_eprintf(interp
, "%s", GDB_print_reg(interp
, t
, n
));
2800 else if (s
[1] && isdigit((unsigned char)s
[1])) {
2801 const int n
= atoi(s
+ 1);
2802 return GDB_print_reg(interp
, t
, n
);
2805 return "no such reg";
2809 /* RT#46141 move these to debugger interpreter
2811 static PDB_breakpoint_t
*gdb_bps
;
2814 * GDB_pb gdb> pb 244 # set breakpoint at opcode 244
2816 * RT#46143 We can't remove the breakpoint yet, executing the next ins
2817 * most likely fails, as the length of the debug-brk stmt doesn't
2818 * match the old opcode
2819 * Setting a breakpoint will also fail, if the bytecode os r/o
2824 =item C<static int GDB_B>
2826 RT#48260: Not yet documented!!!
2833 GDB_B(PARROT_INTERP
, ARGIN(const char *s
)) {
2836 PDB_breakpoint_t
*bp
, *newbreak
;
2838 if ((unsigned long)s
< 0x10000) {
2839 /* HACK alarm pb 45 is passed as the integer not a string */
2840 /* RT#46145 check if in bounds */
2841 pc
= interp
->code
->base
.data
+ (unsigned long)s
;
2845 newbreak
= mem_allocate_typed(PDB_breakpoint_t
);
2846 newbreak
->prev
= NULL
;
2847 newbreak
->next
= NULL
;
2851 /* create new one */
2852 for (nr
= 0, bp
= gdb_bps
; ; bp
= bp
->next
, ++nr
) {
2861 newbreak
= mem_allocate_typed(PDB_breakpoint_t
);
2862 newbreak
->prev
= bp
;
2863 newbreak
->next
= NULL
;
2864 bp
->next
= newbreak
;
2869 *pc
= PARROT_OP_trap
;
2883 F<include/parrot/debug.h>, F<src/pdb.c> and F<ops/debug.ops>.
2889 =item Initial version by Daniel Grunblatt on 2002.5.19.
2891 =item Start of rewrite - leo 2005.02.16
2893 The debugger now uses its own interpreter. User code is run in
2894 Interp *debugee. We have:
2896 debug_interp->pdb->debugee->debugger
2899 +------------- := -----------+
2901 Debug commands are mostly run inside the C<debugger>. User code
2902 runs of course in the C<debugee>.
2913 * c-file-style: "parrot"
2915 * vim: expandtab shiftwidth=4: