2 Copyright (C) 2001-2003, The Perl Foundation.
11 Tracing support for the C<runops_slow_core()> function in F<src/runops_cores.c>.
13 This is turned on with Parrot's C<-t> option.
27 #include "parrot/oplib/ops.h"
32 trace_pmc_dump(Interp *interpreter, PMC* pmc)>
34 Prints a PMC to C<stderr>.
41 trace_class_name(Interp
*interpreter
, PMC
* pmc
)
44 if (PObj_is_class_TEST(pmc
)) {
45 SLOTTYPE
* const class_array
= PMC_data(pmc
);
46 PMC
* const class_name_pmc
= get_attrib_num(class_array
,
48 class_name
= PMC_str_val(class_name_pmc
);
51 class_name
= pmc
->vtable
->whoami
;
56 trace_pmc_dump(Interp
*interpreter
, PMC
* pmc
)
58 Interp
* const debugger
= interpreter
->debugger
;
61 PIO_eprintf(debugger
, "(null)");
65 PIO_eprintf(debugger
, "PMCNULL");
69 PIO_eprintf(debugger
, "<!!no vtable!!>");
72 if (PObj_on_free_list_TEST(pmc
)) {
73 PIO_eprintf(debugger
, "**************** PMC is on free list *****\n");
75 if (pmc
->vtable
->class == pmc
) {
76 STRING
* const name
= trace_class_name(interpreter
, pmc
);
77 PIO_eprintf(debugger
, "Class=%Ss:PMC(%#p)", name
, pmc
);
79 else if ( pmc
->vtable
->base_type
== enum_class_String
) {
80 STRING
* const s
= VTABLE_get_string(interpreter
, pmc
);
82 PIO_eprintf(debugger
, "%S=PMC(%#p Str:(NULL))",
83 VTABLE_name(interpreter
, pmc
), pmc
);
85 STRING
* const escaped
= string_escape_string_delimited(
88 PIO_eprintf(debugger
, "%S=PMC(%#p Str:\"%Ss\")",
89 VTABLE_name(interpreter
, pmc
), pmc
,
92 PIO_eprintf(debugger
, "%S=PMC(%#p Str:\"(null)\")",
93 VTABLE_name(interpreter
, pmc
), pmc
);
96 else if (pmc
->vtable
->base_type
== enum_class_Boolean
) {
97 PIO_eprintf(debugger
, "Boolean=PMC(%#p: %d)",
98 pmc
, PMC_int_val(pmc
));
100 else if (pmc
->vtable
->base_type
== enum_class_Integer
) {
101 PIO_eprintf(debugger
, "Integer=PMC(%#p: %d)",
102 pmc
, PMC_int_val(pmc
));
104 else if (pmc
->vtable
->base_type
== enum_class_BigInt
) {
105 STRING
*s
= VTABLE_get_string(interpreter
, pmc
);
106 PIO_eprintf(debugger
, "BigInt=PMC(%#p: %Ss)",
109 else if (pmc
->vtable
->base_type
== enum_class_Complex
) {
110 STRING
*s
= VTABLE_get_string(interpreter
, pmc
);
111 PIO_eprintf(debugger
, "Complex=PMC(%#p: %Ss)",
114 else if (pmc
->vtable
->base_type
== enum_class_RetContinuation
115 || pmc
->vtable
->base_type
== enum_class_Continuation
116 || pmc
->vtable
->base_type
== enum_class_Sub
) {
117 PIO_eprintf(debugger
, "%S=PMC(%#p pc:%d)",
118 VTABLE_name(interpreter
, pmc
), pmc
,
119 PMC_sub(pmc
)->start_offs
);
121 else if (PObj_is_object_TEST(pmc
)) {
122 PIO_eprintf(debugger
, "Object(%Ss)=PMC(%#p)",
123 VTABLE_name(interpreter
, pmc
), pmc
);
125 else if (pmc
->vtable
->base_type
== enum_class_delegate
) {
126 PIO_eprintf(debugger
, "delegate=PMC(%#p)", pmc
);
129 PIO_eprintf(debugger
, "%S=PMC(%#p)",
130 VTABLE_name(interpreter
, pmc
), pmc
);
137 trace_key_dump(Interp *interpreter, PMC *key)>
139 Prints a key to C<stderr>, returns the length of the output.
146 trace_key_dump(Interp
*interpreter
, PMC
*key
)
148 Interp
* const debugger
= interpreter
->debugger
;
150 int len
= PIO_eprintf(debugger
, "[");
153 switch (PObj_get_FLAGS(key
) & KEY_type_FLAGS
) {
154 case KEY_integer_FLAG
:
155 len
+= PIO_eprintf(debugger
, "%vi", PMC_int_val(key
));
157 case KEY_number_FLAG
:
158 len
+= PIO_eprintf(debugger
, "%vg", PMC_num_val(key
));
160 case KEY_string_FLAG
:
162 STRING
* const s
= PMC_str_val(key
);
163 STRING
* const escaped
= string_escape_string_delimited(
166 len
+= PIO_eprintf(debugger
, "\"%Ss\"", escaped
);
168 len
+= PIO_eprintf(debugger
, "\"(null)\"");
171 case KEY_integer_FLAG
|KEY_register_FLAG
:
172 len
+= PIO_eprintf(debugger
, "I%vd=%vd", PMC_int_val(key
),
173 REG_INT(PMC_int_val(key
)));
175 case KEY_number_FLAG
|KEY_register_FLAG
:
176 len
+= PIO_eprintf(debugger
, "I%vd=%vd", PMC_int_val(key
),
177 REG_NUM(PMC_int_val(key
)));
179 case KEY_string_FLAG
|KEY_register_FLAG
:
181 STRING
* const s
= REG_STR(PMC_int_val(key
));
182 STRING
* const escaped
= string_escape_string_delimited(
185 len
+= PIO_eprintf(debugger
, "S%vd=\"%Ss\"", PMC_int_val(key
),
188 len
+= PIO_eprintf(debugger
, "S%vd=\"(null)\"",
192 case KEY_pmc_FLAG
|KEY_register_FLAG
:
193 len
+= PIO_eprintf(debugger
, "P%vd=", PMC_int_val(key
));
194 trace_pmc_dump(debugger
, REG_PMC(PMC_int_val(key
)));
197 len
+= PIO_eprintf(debugger
, "??");
205 len
+= PIO_eprintf(debugger
, ";");
209 len
+= PIO_eprintf(debugger
, "]");
216 trace_op_dump(Interp *interpreter, opcode_t *code_start,
219 TODO: This isn't really part of the API, but here's its documentation.
221 Prints the PC, OP and ARGS. Used by C<trace_op()>.
228 trace_op_dump(Interp
*interpreter
, opcode_t
*code_start
,
232 int more
= 0, var_args
;
233 Interp
*debugger
= interpreter
->debugger
;
234 op_info_t
*info
= &interpreter
->op_info_table
[*pc
];
238 #define ARGS_COLUMN 40
241 sig
= NULL
; /* silence compiler uninit warning */
244 len
= PIO_eprintf(debugger
, "%6vu ", (UINTVAL
)(pc
- code_start
));
245 if (strcmp(info
->name
, "infix") == 0) {
246 /* this should rather be MMD_opcode_name, which doesn't
249 len
+= PIO_eprintf(debugger
, "%s",
250 Parrot_MMD_method_name(interpreter
, pc
[1]) + 2);
253 else if (strcmp(info
->name
, "n_infix") == 0) {
254 len
+= PIO_eprintf(debugger
, "n_%s",
255 Parrot_MMD_method_name(interpreter
, pc
[1]) + 2);
259 len
+= PIO_eprintf(debugger
, "%s", info
->name
);
264 if (*pc
== PARROT_OP_set_args_pc
||
265 *pc
== PARROT_OP_get_results_pc
||
266 *pc
== PARROT_OP_get_params_pc
||
267 *pc
== PARROT_OP_set_returns_pc
) {
268 sig
= interpreter
->code
->const_table
->constants
[pc
[1]]->u
.key
;
269 var_args
= VTABLE_elements(interpreter
, sig
);
274 len
+= PIO_eprintf(debugger
, " ");
275 /* pass 1 print arguments */
276 for (i
= s
; i
< n
; i
++) {
277 const opcode_t o
= pc
[i
];
278 if (i
< info
->op_count
)
279 type
= info
->types
[i
- 1];
281 type
= SIG_ITEM(sig
, i
- 2) &
282 (PARROT_ARG_TYPE_MASK
|PARROT_ARG_CONSTANT
);
284 type
!= PARROT_ARG_KC
&&
285 type
!= PARROT_ARG_KIC
&&
286 type
!= PARROT_ARG_KI
&&
289 len
+= PIO_eprintf(debugger
, ", ");
293 len
+= PIO_eprintf(debugger
, "%vd", o
);
296 len
+= PIO_eprintf(debugger
, "%vg", PCONST(o
)->u
.number
);
300 len
+= PIO_eprintf(debugger
, "PC%d (%d)",
303 len
+= PIO_eprintf(debugger
, "PC%d", (int)o
);
307 STRING
* const escaped
= string_escape_string_delimited(
309 PCONST(o
)->u
.string
, 20);
311 len
+= PIO_eprintf(debugger
, "\"%Ss\"", escaped
);
313 len
+= PIO_eprintf(debugger
, "\"(null)\"");
317 len
+= trace_key_dump(interpreter
, PCONST(o
)->u
.key
);
320 len
+= PIO_eprintf(debugger
, "[%vd]", o
);
323 len
+= PIO_eprintf(debugger
, "[I%vd]", o
);
327 len
+= PIO_eprintf(debugger
, "[P%vd]",o
);
331 len
+= PIO_eprintf(debugger
, "I%vd", o
);
335 len
+= PIO_eprintf(debugger
, "N%vd", o
);
339 len
+= PIO_eprintf(debugger
, "P%vd", o
);
343 len
+= PIO_eprintf(debugger
, "S%vd", o
);
347 internal_exception(1, "unhandled type in trace");
353 if (len
< ARGS_COLUMN
) {
354 STRING
* const fill
= string_repeat(debugger
,
355 const_string(debugger
, " "),
356 ARGS_COLUMN
- len
, NULL
);
357 PIO_putps(debugger
, PIO_STDERR(debugger
), fill
);
360 PIO_eprintf(debugger
, "\t");
363 /* pass 2 print argument details if needed */
364 for (i
= 1; i
< n
; i
++) {
365 const opcode_t o
= pc
[i
];
366 if (i
< info
->op_count
)
367 type
= info
->types
[i
- 1];
369 type
= SIG_ITEM(sig
, i
- 2) &
370 (PARROT_ARG_TYPE_MASK
|PARROT_ARG_CONSTANT
);
372 PIO_eprintf(debugger
, " ");
376 PIO_eprintf(debugger
, "I%vd=%vd", o
, REG_INT(o
));
379 PIO_eprintf(debugger
, "N%vd=%vf", o
, REG_NUM(o
));
382 PIO_eprintf(debugger
, "PC%vd=", o
);
383 trace_pmc_dump(interpreter
, PCONST(o
)->u
.key
);
386 PIO_eprintf(debugger
, "P%vd=", o
);
387 trace_pmc_dump(interpreter
, REG_PMC(o
));
391 STRING
* const escaped
= string_escape_string_delimited(
392 interpreter
, REG_STR(o
), 20);
393 PIO_eprintf(debugger
, "S%vd=\"%Ss\"", o
,
397 PIO_eprintf(debugger
, "S%vd=\"(null)\"", o
);
400 PIO_eprintf(debugger
, "P%vd=", o
);
401 trace_key_dump(interpreter
, REG_PMC(*(pc
+ i
)));
404 PIO_eprintf(debugger
, "I%vd=[%vd]", o
, REG_INT(o
));
412 PIO_eprintf(debugger
, "\n");
418 trace_op(Interp *interpreter, opcode_t *code_start,
419 opcode_t *code_end, opcode_t *pc)>
421 TODO: This isn't really part of the API, but here's its documentation.
423 Prints the PC, OP and ARGS. Used by C<runops_trace()>. With bounds
431 trace_op(Interp
*interpreter
, opcode_t
*code_start
,
432 opcode_t
*code_end
, opcode_t
*pc
)
438 if (pc
>= code_start
&& pc
< code_end
) {
439 trace_op_dump(interpreter
, code_start
, pc
);
442 PIO_eprintf(interpreter
, "PC=%ld; OP=<err>\n", (long)(pc
- code_start
));
461 * c-file-style: "parrot"
463 * vim: expandtab shiftwidth=4: