src/trace.c

   1 /*
   2 Copyright (C) 2001-2003, The Perl Foundation.
   3 $Id$
   4
   5 =head1 NAME
   6
   7 src/trace.c - Tracing
   8
   9 =head1 DESCRIPTION
  10
  11 Tracing support for the C<runops_slow_core()> function in F<src/runops_cores.c>.
  12
  13 This is turned on with Parrot's C<-t> option.
  14
  15 src/test_main.c
  16
  17
  18 =head2 Functions
  19
  20 =over 4
  21
  22 =cut
  23
  24 */
  25
  26 #include "trace.h"
  27 #include "parrot/oplib/ops.h"
  28
  29 /*
  30
  31 =item C<void
  32 trace_pmc_dump(Interp *interpreter, PMC* pmc)>
  33
  34 Prints a PMC to C<stderr>.
  35
  36 =cut
  37
  38 */
  39
  40 static STRING*
  41 trace_class_name(Interp *interpreter, PMC* pmc)
  42 {
  43     STRING *class_name;
  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,
  47                                                     PCD_CLASS_NAME);
  48         class_name = PMC_str_val(class_name_pmc);
  49     }
  50     else
  51         class_name = pmc->vtable->whoami;
  52     return class_name;
  53 }
  54
  55 void
  56 trace_pmc_dump(Interp *interpreter, PMC* pmc)
  57 {
  58     Interp * const debugger = interpreter->debugger;
  59
  60     if (!pmc) {
  61         PIO_eprintf(debugger, "(null)");
  62         return;
  63     }
  64     if (pmc == PMCNULL)  {
  65         PIO_eprintf(debugger, "PMCNULL");
  66         return;
  67     }
  68     if (!pmc->vtable) {
  69         PIO_eprintf(debugger, "<!!no vtable!!>");
  70         return;
  71     }
  72     if (PObj_on_free_list_TEST(pmc)) {
  73         PIO_eprintf(debugger, "**************** PMC is on free list *****\n");
  74     }
  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);
  78     }
  79     else if ( pmc->vtable->base_type == enum_class_String) {
  80         STRING * const s = VTABLE_get_string(interpreter, pmc);
  81         if (!s)
  82             PIO_eprintf(debugger, "%S=PMC(%#p Str:(NULL))",
  83                     VTABLE_name(interpreter, pmc), pmc);
  84         else {
  85             STRING* const escaped = string_escape_string_delimited(
  86                             interpreter, s, 20);
  87             if (escaped)
  88                 PIO_eprintf(debugger, "%S=PMC(%#p Str:\"%Ss\")",
  89                     VTABLE_name(interpreter, pmc), pmc,
  90                     escaped);
  91             else
  92                 PIO_eprintf(debugger, "%S=PMC(%#p Str:\"(null)\")",
  93                     VTABLE_name(interpreter, pmc), pmc);
  94         }
  95     }
  96     else if (pmc->vtable->base_type == enum_class_Boolean) {
  97         PIO_eprintf(debugger, "Boolean=PMC(%#p: %d)",
  98                 pmc, PMC_int_val(pmc));
  99     }
 100     else if (pmc->vtable->base_type == enum_class_Integer) {
 101         PIO_eprintf(debugger, "Integer=PMC(%#p: %d)",
 102                 pmc, PMC_int_val(pmc));
 103     }
 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)",
 107                 pmc, s);
 108     }
 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)",
 112                 pmc, s);
 113     }
 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);
 120     }
 121     else if (PObj_is_object_TEST(pmc)) {
 122         PIO_eprintf(debugger, "Object(%Ss)=PMC(%#p)",
 123                 VTABLE_name(interpreter, pmc), pmc);
 124     }
 125     else if (pmc->vtable->base_type == enum_class_delegate) {
 126         PIO_eprintf(debugger, "delegate=PMC(%#p)", pmc);
 127     }
 128     else {
 129         PIO_eprintf(debugger, "%S=PMC(%#p)",
 130                 VTABLE_name(interpreter, pmc), pmc);
 131     }
 132 }
 133
 134 /*
 135
 136 =item C<int
 137 trace_key_dump(Interp *interpreter, PMC *key)>
 138
 139 Prints a key to C<stderr>, returns the length of the output.
 140
 141 =cut
 142
 143 */
 144
 145 int
 146 trace_key_dump(Interp *interpreter, PMC *key)
 147 {
 148     Interp * const debugger = interpreter->debugger;
 149
 150     int len = PIO_eprintf(debugger, "[");
 151
 152     while (key) {
 153         switch (PObj_get_FLAGS(key) & KEY_type_FLAGS) {
 154         case KEY_integer_FLAG:
 155             len += PIO_eprintf(debugger, "%vi", PMC_int_val(key));
 156             break;
 157         case KEY_number_FLAG:
 158             len += PIO_eprintf(debugger, "%vg", PMC_num_val(key));
 159             break;
 160         case KEY_string_FLAG:
 161             {
 162             STRING * const s = PMC_str_val(key);
 163             STRING* const escaped = string_escape_string_delimited(
 164                             interpreter, s, 20);
 165             if (escaped)
 166                 len += PIO_eprintf(debugger, "\"%Ss\"", escaped);
 167             else
 168                 len += PIO_eprintf(debugger, "\"(null)\"");
 169             }
 170             break;
 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)));
 174             break;
 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)));
 178             break;
 179         case KEY_string_FLAG|KEY_register_FLAG:
 180             {
 181             STRING * const s = REG_STR(PMC_int_val(key));
 182             STRING* const escaped = string_escape_string_delimited(
 183                             interpreter, s, 20);
 184             if (escaped)
 185                 len += PIO_eprintf(debugger, "S%vd=\"%Ss\"", PMC_int_val(key),
 186                         escaped);
 187             else
 188                 len += PIO_eprintf(debugger, "S%vd=\"(null)\"",
 189                         PMC_int_val(key));
 190             }
 191             break;
 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)));
 195             break;
 196         default:
 197             len += PIO_eprintf(debugger, "??");
 198             key = NULL;
 199             break;
 200         }
 201
 202         if (key) {
 203             key = PMC_data(key);
 204             if (key)
 205                 len += PIO_eprintf(debugger, ";");
 206         }
 207     } /* while */
 208
 209     len += PIO_eprintf(debugger, "]");
 210     return len;
 211 }
 212
 213 /*
 214
 215 =item C<void
 216 trace_op_dump(Interp *interpreter, opcode_t *code_start,
 217               opcode_t *pc)>
 218
 219 TODO: This isn't really part of the API, but here's its documentation.
 220
 221 Prints the PC, OP and ARGS. Used by C<trace_op()>.
 222
 223 =cut
 224
 225 */
 226
 227 void
 228 trace_op_dump(Interp *interpreter, opcode_t *code_start,
 229               opcode_t *pc)
 230 {
 231     INTVAL i, s, n;
 232     int more = 0, var_args;
 233     Interp *debugger = interpreter->debugger;
 234     op_info_t *info = &interpreter->op_info_table[*pc];
 235     PMC *sig;
 236     int type;
 237     int len;
 238 #define ARGS_COLUMN 40
 239
 240     assert(debugger);
 241     sig = NULL; /* silence compiler uninit warning */
 242
 243     s = 1;
 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
 247          * exit yet
 248          */
 249         len += PIO_eprintf(debugger, "%s",
 250                 Parrot_MMD_method_name(interpreter, pc[1]) + 2);
 251         s = 2;
 252     }
 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);
 256         s = 2;
 257     }
 258     else
 259         len += PIO_eprintf(debugger, "%s", info->name);
 260
 261     n = info->op_count;
 262     var_args = 0;
 263
 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);
 270         n += var_args;
 271     }
 272
 273     if (n > 1) {
 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];
 280             else
 281                 type = SIG_ITEM(sig, i - 2) &
 282                     (PARROT_ARG_TYPE_MASK|PARROT_ARG_CONSTANT);
 283             if (i > s &&
 284                     type != PARROT_ARG_KC &&
 285                     type != PARROT_ARG_KIC &&
 286                     type != PARROT_ARG_KI &&
 287                     type != PARROT_ARG_K
 288                ) {
 289                 len += PIO_eprintf(debugger, ", ");
 290             }
 291             switch (type) {
 292                 case PARROT_ARG_IC:
 293                     len += PIO_eprintf(debugger, "%vd", o);
 294                     break;
 295                 case PARROT_ARG_NC:
 296                     len += PIO_eprintf(debugger, "%vg", PCONST(o)->u.number);
 297                     break;
 298                 case PARROT_ARG_PC:
 299                     if (var_args)
 300                         len += PIO_eprintf(debugger, "PC%d (%d)",
 301                                 (int)o, var_args);
 302                     else
 303                         len += PIO_eprintf(debugger, "PC%d", (int)o);
 304                     break;
 305                 case PARROT_ARG_SC:
 306                     {
 307                     STRING* const escaped = string_escape_string_delimited(
 308                             interpreter,
 309                             PCONST(o)->u.string, 20);
 310                     if (escaped)
 311                         len += PIO_eprintf(debugger, "\"%Ss\"", escaped);
 312                     else
 313                         len += PIO_eprintf(debugger, "\"(null)\"");
 314                     }
 315                     break;
 316                 case PARROT_ARG_KC:
 317                     len += trace_key_dump(interpreter, PCONST(o)->u.key);
 318                     break;
 319                 case PARROT_ARG_KIC:
 320                     len += PIO_eprintf(debugger, "[%vd]", o);
 321                     break;
 322                 case PARROT_ARG_KI:
 323                     len += PIO_eprintf(debugger, "[I%vd]", o);
 324                     more = 1;
 325                     break;
 326                 case PARROT_ARG_K:
 327                     len += PIO_eprintf(debugger, "[P%vd]",o);
 328                     more = 1;
 329                     break;
 330                 case PARROT_ARG_I:
 331                     len += PIO_eprintf(debugger, "I%vd", o);
 332                     more = 1;
 333                     break;
 334                 case PARROT_ARG_N:
 335                     len += PIO_eprintf(debugger, "N%vd", o);
 336                     more = 1;
 337                     break;
 338                 case PARROT_ARG_P:
 339                     len += PIO_eprintf(debugger, "P%vd", o);
 340                     more = 1;
 341                     break;
 342                 case PARROT_ARG_S:
 343                     len += PIO_eprintf(debugger, "S%vd", o);
 344                     more = 1;
 345                     break;
 346                 default:
 347                     internal_exception(1, "unhandled type in trace");
 348                     break;
 349             }
 350         }
 351         if (!more)
 352             goto done;
 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);
 358         }
 359         else {
 360             PIO_eprintf(debugger, "\t");
 361         }
 362
 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];
 368             else
 369                 type = SIG_ITEM(sig, i - 2) &
 370                     (PARROT_ARG_TYPE_MASK|PARROT_ARG_CONSTANT);
 371             if (i > s) {
 372                 PIO_eprintf(debugger, " ");
 373             }
 374             switch (type) {
 375                 case PARROT_ARG_I:
 376                     PIO_eprintf(debugger, "I%vd=%vd", o, REG_INT(o));
 377                     break;
 378                 case PARROT_ARG_N:
 379                     PIO_eprintf(debugger, "N%vd=%vf", o, REG_NUM(o));
 380                     break;
 381                 case PARROT_ARG_PC:
 382                     PIO_eprintf(debugger, "PC%vd=", o);
 383                     trace_pmc_dump(interpreter, PCONST(o)->u.key);
 384                     break;
 385                 case PARROT_ARG_P:
 386                     PIO_eprintf(debugger, "P%vd=", o);
 387                     trace_pmc_dump(interpreter, REG_PMC(o));
 388                     break;
 389                 case PARROT_ARG_S:
 390                     if (REG_STR(o)) {
 391                         STRING* const escaped = string_escape_string_delimited(
 392                                 interpreter, REG_STR(o), 20);
 393                         PIO_eprintf(debugger, "S%vd=\"%Ss\"", o,
 394                                 escaped);
 395                     }
 396                     else
 397                         PIO_eprintf(debugger, "S%vd=\"(null)\"", o);
 398                     break;
 399                 case PARROT_ARG_K:
 400                     PIO_eprintf(debugger, "P%vd=", o);
 401                     trace_key_dump(interpreter, REG_PMC(*(pc + i)));
 402                     break;
 403                 case PARROT_ARG_KI:
 404                     PIO_eprintf(debugger, "I%vd=[%vd]", o, REG_INT(o));
 405                     break;
 406                 default:
 407                     break;
 408             }
 409         }
 410     }
 411 done:
 412     PIO_eprintf(debugger, "\n");
 413 }
 414
 415 /*
 416
 417 =item C<void
 418 trace_op(Interp *interpreter, opcode_t *code_start,
 419          opcode_t *code_end, opcode_t *pc)>
 420
 421 TODO: This isn't really part of the API, but here's its documentation.
 422
 423 Prints the PC, OP and ARGS. Used by C<runops_trace()>. With bounds
 424 checking.
 425
 426 =cut
 427
 428 */
 429
 430 void
 431 trace_op(Interp *interpreter, opcode_t *code_start,
 432          opcode_t *code_end, opcode_t *pc)
 433 {
 434     if (!pc) {
 435         return;
 436     }
 437
 438     if (pc >= code_start && pc < code_end) {
 439         trace_op_dump(interpreter, code_start, pc);
 440     }
 441     else if (pc) {
 442         PIO_eprintf(interpreter, "PC=%ld; OP=<err>\n", (long)(pc - code_start));
 443     }
 444 }
 445
 446 /*
 447
 448 =back
 449
 450 =head1 SEE ALSO
 451
 452 F<src/trace.h>
 453
 454 =cut
 455
 456 */
 457
 458
 459 /*
 460  * Local variables:
 461  *   c-file-style: "parrot"
 462  * End:
 463  * vim: expandtab shiftwidth=4:
 464  */