src/debug.c

   1 /*
   2 Copyright (C) 2001-2007, The Perl Foundation.
   3 $Id$
   4
   5 =head1 NAME
   6
   7 src/debug.c - Parrot debugging
   8
   9 =head1 DESCRIPTION
  10
  11 This file implements Parrot debugging and is used by C<pdb>, the Parrot
  12 debugger, and the C<debug> ops.
  13
  14 =head2 Functions
  15
  16 =over 4
  17
  18 =cut
  19
  20 */
  21
  22 #include <stdio.h>
  23 #include <stdlib.h>
  24 #include "parrot/parrot.h"
  25 #include "interp_guts.h"
  26 #include "parrot/oplib.h"
  27 #include "trace.h"
  28 #include "parrot/debug.h"
  29 #include "parrot/oplib/ops.h"
  30
  31
  32 /* Not sure how we want to handle this sort of cross-project header */
  33 PARROT_API
  34 void
  35 IMCC_warning(PARROT_INTERP, ARGIN(const char *fmt), ...);
  36 extern void imcc_init(PARROT_INTERP);
  37
  38
  39
  40 /* HEADERIZER HFILE: include/parrot/debug.h */
  41
  42 /* HEADERIZER BEGIN: static */
  43
  44 static void dump_string(PARROT_INTERP, ARGIN_NULLOK(const STRING *s))
  45         __attribute__nonnull__(1);
  46
  47 static int GDB_B(PARROT_INTERP, NOTNULL(char *s))
  48         __attribute__nonnull__(1)
  49         __attribute__nonnull__(2);
  50
  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);
  56
  57 PARROT_CAN_RETURN_NULL
  58 PARROT_WARN_UNUSED_RESULT
  59 static char const * nextarg(NOTNULL(char const *command))
  60         __attribute__nonnull__(1);
  61
  62 PARROT_CAN_RETURN_NULL
  63 PARROT_WARN_UNUSED_RESULT
  64 static const char * parse_command(
  65     ARGIN(const char *command),
  66     NOTNULL(unsigned long *cmdP))
  67         __attribute__nonnull__(1)
  68         __attribute__nonnull__(2);
  69
  70 PARROT_CANNOT_RETURN_NULL
  71 PARROT_WARN_UNUSED_RESULT
  72 static const char * parse_int(ARGIN(const char *str), ARGOUT(int *intP))
  73         __attribute__nonnull__(1)
  74         __attribute__nonnull__(2);
  75
  76 PARROT_CAN_RETURN_NULL
  77 PARROT_WARN_UNUSED_RESULT
  78 static const char* parse_key(PARROT_INTERP,
  79     ARGIN(const char *str),
  80     ARGOUT(PMC **keyP))
  81         __attribute__nonnull__(1)
  82         __attribute__nonnull__(2)
  83         __attribute__nonnull__(3);
  84
  85 PARROT_CAN_RETURN_NULL
  86 PARROT_WARN_UNUSED_RESULT
  87 static const char * parse_string(PARROT_INTERP,
  88     ARGIN(const char *str),
  89     ARGOUT(STRING **strP))
  90         __attribute__nonnull__(1)
  91         __attribute__nonnull__(2)
  92         __attribute__nonnull__(3);
  93
  94 PARROT_CANNOT_RETURN_NULL
  95 static const char * skip_command(ARGIN(const char *str))
  96         __attribute__nonnull__(1);
  97
  98 PARROT_CANNOT_RETURN_NULL
  99 PARROT_WARN_UNUSED_RESULT
 100 static const char * skip_ws(ARGIN(const char *str))
 101         __attribute__nonnull__(1);
 102
 103 /* HEADERIZER END: static */
 104
 105
 106 /*
 107
 108 =item C<static char const * nextarg>
 109
 110 Returns the position just past the current argument in the PASM instruction
 111 C<command>. This is not the same as C<skip_command()>, which is intended for
 112 debugger commands. This function is used for C<eval>.
 113
 114 =cut
 115
 116 */
 117
 118 PARROT_CAN_RETURN_NULL
 119 PARROT_WARN_UNUSED_RESULT
 120 static char const *
 121 nextarg(NOTNULL(char const *command))
 122 {
 123     /* as long as the character pointed to by command is not NULL,
 124      * and it is either alphanumeric, a comma or a closing bracket,
 125      * continue looking for the next argument.
 126      */
 127     while (*command && (isalnum((unsigned char) *command) || *command == ',' ||
 128         *command == ']'))
 129             command++;
 130
 131     /* eat as much space as possible */
 132     while (*command && isspace((unsigned char) *command))
 133         command++;
 134
 135     return command;
 136 }
 137
 138 /*
 139
 140 =item C<static const char * skip_ws>
 141
 142 Returns the pointer past any whitespace.
 143
 144 =cut
 145
 146 */
 147
 148 PARROT_CANNOT_RETURN_NULL
 149 PARROT_WARN_UNUSED_RESULT
 150 static const char *
 151 skip_ws(ARGIN(const char *str))
 152 {
 153     /* as long as str is not NULL and it contains space, skip it */
 154     while (*str && isspace((unsigned char) *str))
 155         str++;
 156
 157     return str;
 158 }
 159
 160 /*
 161
 162 =item C<static const char * skip_command>
 163
 164 Returns the pointer past the current debugger command. (This is an
 165 alternative to the C<skip_command()> macro above.)
 166
 167 =cut
 168
 169 */
 170
 171 PARROT_CANNOT_RETURN_NULL
 172 static const char *
 173 skip_command(ARGIN(const char *str))
 174 {
 175     /* while str is not null and it contains a command (no spaces),
 176      * skip the character
 177      */
 178     while (*str && !isspace((unsigned char) *str))
 179         str++;
 180
 181     /* eat all space after that */
 182     while (*str && isspace((unsigned char) *str))
 183         str++;
 184
 185     return str;
 186 }
 187
 188 /*
 189
 190 =item C<static const char * parse_int>
 191
 192 Parse an C<int> out of a string and return a pointer to just after the C<int>.
 193 The output parameter C<intP> contains the parsed value.
 194
 195 =cut
 196
 197 */
 198
 199 PARROT_CANNOT_RETURN_NULL
 200 PARROT_WARN_UNUSED_RESULT
 201 static const char *
 202 parse_int(ARGIN(const char *str), ARGOUT(int *intP))
 203 {
 204     char *end;
 205
 206     *intP = strtol(str, &end, 0);
 207
 208     return end;
 209 }
 210
 211 /*
 212
 213 =item C<static const char * parse_string>
 214
 215 Parse a double-quoted string out of a C string and return a pointer to
 216 just after the string. The parsed string is converted to a Parrot
 217 C<STRING> and placed in the output parameter C<strP>.
 218
 219 =cut
 220
 221 */
 222
 223 PARROT_CAN_RETURN_NULL
 224 PARROT_WARN_UNUSED_RESULT
 225 static const char *
 226 parse_string(PARROT_INTERP, ARGIN(const char *str), ARGOUT(STRING **strP))
 227 {
 228     const char *string_start;
 229
 230     /* if this is not a quoted string, there's nothing to parse */
 231     if (*str != '"')
 232         return NULL;
 233
 234     /* skip the quote */
 235     str++;
 236
 237     string_start = str;
 238
 239     /* parse while there's no closing quote */
 240     while (*str && *str != '"') {
 241         /* skip any potentially escaped quotes */
 242         if (*str == '\\' && str[1])
 243             str += 2;
 244         else
 245             str++;
 246     }
 247
 248     /* create the output STRING */
 249     *strP = string_make(interp, string_start, str - string_start, NULL, 0);
 250
 251     /* skip the closing quote */
 252     if (*str)
 253         str++;
 254
 255     return str;
 256 }
 257
 258 /*
 259
 260 =item C<static const char* parse_key>
 261
 262 Parse an aggregate key out of a string and return a pointer to just
 263 after the key. Currently only string and integer keys are allowed.
 264
 265 =cut
 266
 267 */
 268
 269 PARROT_CAN_RETURN_NULL
 270 PARROT_WARN_UNUSED_RESULT
 271 static const char*
 272 parse_key(PARROT_INTERP, ARGIN(const char *str), ARGOUT(PMC **keyP))
 273 {
 274     /* clear output parameter */
 275     *keyP = NULL;
 276
 277     /* make sure it's a key */
 278     if (*str != '[')
 279         return NULL;
 280
 281     /* Skip [ */
 282     str++;
 283
 284     /* if this is a string key, create a Parrot STRING */
 285     if (*str == '"') {
 286         STRING *parrot_string;
 287         str   = parse_string(interp, str, &parrot_string);
 288         *keyP = key_new_string(interp, parrot_string);
 289     }
 290     /* if this is a numeric key */
 291     else if (isdigit((unsigned char) *str)) {
 292         int value;
 293         str   = parse_int(str, &value);
 294         *keyP = key_new_integer(interp, (INTVAL) value);
 295     }
 296     /* unsupported case; neither a string nor a numeric key */
 297     else {
 298         return NULL;
 299     }
 300
 301     /* hm, but if this doesn't match, it's probably an error */
 302     /* XXX str can be NULL from parse_string() */
 303     if (*str != ']')
 304         return NULL;
 305
 306     /* skip the closing brace on the key */
 307     return ++str;
 308 }
 309
 310 /*
 311
 312 =item C<static const char * parse_command>
 313
 314 Convert the command at the beginning of a string into a numeric value
 315 that can be used as a switch key for fast lookup.
 316
 317 =cut
 318
 319 */
 320
 321 PARROT_CAN_RETURN_NULL
 322 PARROT_WARN_UNUSED_RESULT
 323 static const char *
 324 parse_command(ARGIN(const char *command), NOTNULL(unsigned long *cmdP))
 325 {
 326     int           i;
 327     unsigned long c = 0;
 328
 329     if (*command == '\0') {
 330         *cmdP = c;
 331         return NULL;
 332     }
 333
 334     for (i = 0; *command && isalpha((unsigned char) *command); command++, i++)
 335         c += (tolower((unsigned char) *command) + (i + 1)) * ((i + 1) * 255);
 336
 337     /* Nonempty and did not start with a letter */
 338     if (c == 0)
 339         c = (unsigned long)-1;
 340
 341     *cmdP = c;
 342
 343     return command;
 344 }
 345
 346 /*
 347
 348 =item C<void PDB_get_command>
 349
 350 Get a command from the user input to execute.
 351
 352 It saves the last command executed (in C<< pdb->last_command >>), so it
 353 first frees the old one and updates it with the current one.
 354
 355 Also prints the next line to run if the program is still active.
 356
 357 The user input can't be longer than 255 characters.
 358
 359 The input is saved in C<< pdb->cur_command >>.
 360
 361 =cut
 362
 363 */
 364
 365 void
 366 PDB_get_command(PARROT_INTERP)
 367 {
 368     unsigned int  i;
 369     int           ch;
 370     char         *c;
 371     PDB_t        * const pdb = interp->pdb;
 372
 373     /* flush the buffered data */
 374     fflush(stdout);
 375
 376     /* not used any more */
 377     if (pdb->last_command && *pdb->cur_command) {
 378         mem_sys_free(pdb->last_command);
 379         pdb->last_command = NULL;
 380     }
 381
 382     /* update the last command */
 383     if (pdb->cur_command && *pdb->cur_command)
 384         pdb->last_command = pdb->cur_command;
 385
 386     /* if the program is stopped and running show the next line to run */
 387     if ((pdb->state & PDB_STOPPED) && (pdb->state & PDB_RUNNING)) {
 388         PDB_line_t *line = pdb->file->line;
 389
 390         while (pdb->cur_opcode != line->opcode)
 391             line = line->next;
 392
 393         PIO_eprintf(interp, "%li  ", line->number);
 394         c = pdb->file->source + line->source_offset;
 395
 396         while (c && (*c != '\n'))
 397             PIO_eprintf(interp, "%c", *(c++));
 398     }
 399
 400     i = 0;
 401
 402     /* RT#46109 who frees that */
 403     /* need to allocate 256 chars as string is null-terminated i.e. 255 + 1*/
 404     c = (char *)mem_sys_allocate(256);
 405
 406     PIO_eprintf(interp, "\n(pdb) ");
 407
 408     /* skip leading whitespace */
 409     do {
 410         ch = fgetc(stdin);
 411     } while (isspace((unsigned char)ch) && ch != '\n');
 412
 413     /* generate string (no more than 255 chars) */
 414     while (ch != EOF && ch != '\n' && (i < 255)) {
 415         c[i++] = (char)ch;
 416         ch     = fgetc(stdin);
 417     }
 418
 419     c[i] = '\0';
 420
 421     if (ch == -1)
 422         strcpy(c, "quit");
 423
 424     pdb->cur_command = c;
 425 }
 426
 427 /*
 428
 429 =item C<void PDB_script_file>
 430
 431 Interprets the contents of a file as user input commands
 432
 433 =cut
 434
 435 */
 436
 437 void
 438 PDB_script_file(PARROT_INTERP, ARGIN(const char *command))
 439 {
 440     char buf[1024];
 441     const char *ptr = (const char *)&buf;
 442     int line = 0;
 443     FILE *fd;
 444
 445     command = nextarg(command);
 446
 447     fd = fopen(command, "r");
 448     if (!fd) {
 449         IMCC_warning(interp, "script_file: "
 450             "Error reading script file %s.\n",
 451             command);
 452         return;
 453     }
 454
 455     while (!feof(fd)) {
 456         line++;
 457         buf[0]='\0';
 458         fgets(buf, 1024, fd);
 459
 460         /* skip spaces */
 461         for (ptr=(char *)&buf;*ptr&&isspace((unsigned char)*ptr);ptr=ptr+1);
 462
 463         /* avoid null blank and commented lines */
 464         if (*buf == '\0' || *buf == '#')
 465             continue;
 466
 467         buf[strlen(buf)-1]='\0';
 468         /* RT#46117: handle command error and print out script line
 469          *       PDB_run_command should return non-void value?
 470          *       stop execution of script if fails
 471          * RT#46115: avoid this verbose output? add -v flag? */
 472         if (PDB_run_command(interp, buf)) {
 473             IMCC_warning(interp, "script_file: "
 474                 "Error interpreting command at line %d (%s).\n",
 475                 line, command);
 476                 break;
 477         }
 478     }
 479     fclose(fd);
 480 }
 481
 482 /*
 483
 484 =item C<int PDB_run_command>
 485
 486 Run a command.
 487
 488 Hash the command to make a simple switch calling the correct handler.
 489
 490 =cut
 491
 492 */
 493
 494 PARROT_IGNORABLE_RESULT
 495 int
 496 PDB_run_command(PARROT_INTERP, ARGIN(const char *command))
 497 {
 498     unsigned long c;
 499     PDB_t        * const pdb = interp->pdb;
 500     const char   * const original_command = command;
 501
 502     /* keep a pointer to the command, in case we need to report an error */
 503
 504     /* get a number from what the user typed */
 505     command = parse_command(original_command, &c);
 506
 507     if (command)
 508         skip_command(command);
 509     else
 510         return 0;
 511
 512     switch (c) {
 513         case c_script_file:
 514             PDB_script_file(interp, command);
 515             break;
 516         case c_disassemble:
 517             PDB_disassemble(interp, command);
 518             break;
 519         case c_load:
 520             PDB_load_source(interp, command);
 521             break;
 522         case c_l:
 523         case c_list:
 524             PDB_list(interp, command);
 525             break;
 526         case c_b:
 527         case c_break:
 528             PDB_set_break(interp, command);
 529             break;
 530         case c_w:
 531         case c_watch:
 532             PDB_watchpoint(interp, command);
 533             break;
 534         case c_d:
 535         case c_delete:
 536             PDB_delete_breakpoint(interp, command);
 537             break;
 538         case c_disable:
 539             PDB_disable_breakpoint(interp, command);
 540             break;
 541         case c_enable:
 542             PDB_enable_breakpoint(interp, command);
 543             break;
 544         case c_r:
 545         case c_run:
 546             PDB_init(interp, command);
 547             PDB_continue(interp, NULL);
 548             break;
 549         case c_c:
 550         case c_continue:
 551             PDB_continue(interp, command);
 552             break;
 553         case c_p:
 554         case c_print:
 555             PDB_print(interp, command);
 556             break;
 557         case c_n:
 558         case c_next:
 559             PDB_next(interp, command);
 560             break;
 561         case c_t:
 562         case c_trace:
 563             PDB_trace(interp, command);
 564             break;
 565         case c_e:
 566         case c_eval:
 567             PDB_eval(interp, command);
 568             break;
 569         case c_info:
 570             PDB_info(interp);
 571             break;
 572         case c_h:
 573         case c_help:
 574             PDB_help(interp, command);
 575             break;
 576         case c_q:
 577         case c_quit:
 578             pdb->state |= PDB_EXIT;
 579             break;
 580         case 0:
 581             if (pdb->last_command)
 582                 PDB_run_command(interp, pdb->last_command);
 583             break;
 584         default:
 585             PIO_eprintf(interp,
 586                         "Undefined command: \"%s\".  Try \"help\".", original_command);
 587             return 1;
 588     }
 589     return 0;
 590 }
 591
 592 /*
 593
 594 =item C<void PDB_next>
 595
 596 Execute the next N operation(s).
 597
 598 Inits the program if needed, runs the next N >= 1 operations and stops.
 599
 600 =cut
 601
 602 */
 603
 604 void
 605 PDB_next(PARROT_INTERP, ARGIN_NULLOK(const char *command))
 606 {
 607     unsigned long  n   = 1;
 608     PDB_t  * const pdb = interp->pdb;
 609
 610     /* Init the program if it's not running */
 611     if (!(pdb->state & PDB_RUNNING))
 612         PDB_init(interp, command);
 613
 614     command = nextarg(command);
 615     /* Get the number of operations to execute if any */
 616     if (command && isdigit((unsigned char) *command))
 617         n = atol(command);
 618
 619     /* Erase the stopped flag */
 620     pdb->state &= ~PDB_STOPPED;
 621
 622     /* Execute */
 623     for (; n && pdb->cur_opcode; n--)
 624         DO_OP(pdb->cur_opcode, pdb->debugee);
 625
 626     /* Set the stopped flag */
 627     pdb->state |= PDB_STOPPED;
 628
 629     /* If program ended */
 630
 631     /*
 632      * RT#46119 this doesn't handle resume opcodes
 633      */
 634     if (!pdb->cur_opcode)
 635         (void)PDB_program_end(interp);
 636 }
 637
 638 /*
 639
 640 =item C<void PDB_trace>
 641
 642 Execute the next N operations; if no number is specified, it defaults to 1.
 643
 644 =cut
 645
 646 */
 647
 648 void
 649 PDB_trace(PARROT_INTERP, ARGIN_NULLOK(const char *command))
 650 {
 651     unsigned long  n   = 1;
 652     PDB_t *  const pdb = interp->pdb;
 653     Interp        *debugee;
 654
 655     /* if debugger is not running yet, initialize */
 656     if (!(pdb->state & PDB_RUNNING))
 657         PDB_init(interp, command);
 658
 659     command = nextarg(command);
 660     /* if the number of ops to run is specified, convert to a long */
 661     if (command && isdigit((unsigned char) *command))
 662         n = atol(command);
 663
 664     /* clear the PDB_STOPPED flag, we'll be running n ops now */
 665     pdb->state &= ~PDB_STOPPED;
 666     debugee     = pdb->debugee;
 667
 668     /* execute n ops */
 669     for (; n && pdb->cur_opcode; n--) {
 670         trace_op(debugee,
 671                 debugee->code->base.data,
 672                 debugee->code->base.data +
 673                 debugee->code->base.size,
 674                 debugee->pdb->cur_opcode);
 675         DO_OP(pdb->cur_opcode, debugee);
 676     }
 677
 678     /* we just stopped */
 679     pdb->state |= PDB_STOPPED;
 680
 681     /* If program ended */
 682     if (!pdb->cur_opcode)
 683         (void)PDB_program_end(interp);
 684 }
 685
 686 /*
 687
 688 =item C<PDB_condition_t * PDB_cond>
 689
 690 Analyzes a condition from the user input.
 691
 692 =cut
 693
 694 */
 695
 696 PARROT_CAN_RETURN_NULL
 697 PDB_condition_t *
 698 PDB_cond(PARROT_INTERP, ARGIN(const char *command))
 699 {
 700     PDB_condition_t *condition;
 701     int              i, reg_number;
 702     char             str[255];
 703
 704     /* Return if no more arguments */
 705     if (!(command && *command)) {
 706         PIO_eprintf(interp, "No condition specified\n");
 707         return NULL;
 708     }
 709
 710     /* Allocate new condition */
 711     condition = mem_allocate_typed(PDB_condition_t);
 712
 713     switch (*command) {
 714         case 'i':
 715         case 'I':
 716             condition->type = PDB_cond_int;
 717             break;
 718         case 'n':
 719         case 'N':
 720             condition->type = PDB_cond_num;
 721             break;
 722         case 's':
 723         case 'S':
 724             condition->type = PDB_cond_str;
 725             break;
 726         case 'p':
 727         case 'P':
 728             condition->type = PDB_cond_pmc;
 729             break;
 730         default:
 731             PIO_eprintf(interp, "First argument must be a register\n");
 732             mem_sys_free(condition);
 733             return NULL;
 734     }
 735
 736     /* get the register number */
 737     condition->reg = (unsigned char)atoi(++command);
 738
 739     /* the next argument might have no spaces between the register and the
 740      * condition. */
 741     command++;
 742
 743     /* RT#46121 Does /this/ have to do with the fact that PASM registers used to have
 744      * maximum of 2 digits? If so, there should be a while loop, I think.
 745      */
 746     if (condition->reg > 9)
 747         command++;
 748
 749     if (*command == ' ')
 750         skip_command(command);
 751
 752     /* Now the condition */
 753     switch (*command) {
 754         case '>':
 755             if (*(command + 1) == '=')
 756                 condition->type |= PDB_cond_ge;
 757             else if (*(command + 1) == ' ')
 758                 condition->type |= PDB_cond_gt;
 759             else
 760                 goto INV_COND;
 761             break;
 762         case '<':
 763             if (*(command + 1) == '=')
 764                 condition->type |= PDB_cond_le;
 765             else if (*(command + 1) == ' ')
 766                 condition->type |= PDB_cond_lt;
 767             else
 768                 goto INV_COND;
 769             break;
 770         case '=':
 771             if (*(command + 1) == '=')
 772                 condition->type |= PDB_cond_eq;
 773             else
 774                 goto INV_COND;
 775             break;
 776         case '!':
 777             if (*(command + 1) == '=')
 778                 condition->type |= PDB_cond_ne;
 779             else
 780                 goto INV_COND;
 781             break;
 782         default:
 783 INV_COND:   PIO_eprintf(interp, "Invalid condition\n");
 784             mem_sys_free(condition);
 785             return NULL;
 786     }
 787
 788     /* if there's an '=', skip it */
 789     if (*(command + 1) == '=')
 790         command += 2;
 791     else
 792         command++;
 793
 794     if (*command == ' ')
 795         skip_command(command);
 796
 797     /* return if no more arguments */
 798     if (!(command && *command)) {
 799         PIO_eprintf(interp, "Can't compare a register with nothing\n");
 800         mem_sys_free(condition);
 801         return NULL;
 802     }
 803
 804     if (isalpha((unsigned char)*command)) {
 805         /* It's a register - we first check that it's the correct type */
 806         switch (*command) {
 807             case 'i':
 808             case 'I':
 809                 if (!(condition->type & PDB_cond_int))
 810                     goto WRONG_REG;
 811                 break;
 812             case 'n':
 813             case 'N':
 814                 if (!(condition->type & PDB_cond_num))
 815                     goto WRONG_REG;
 816                 break;
 817             case 's':
 818             case 'S':
 819                 if (!(condition->type & PDB_cond_str))
 820                     goto WRONG_REG;
 821                 break;
 822             case 'p':
 823             case 'P':
 824                 if (!(condition->type & PDB_cond_pmc))
 825                     goto WRONG_REG;
 826                 break;
 827             default:
 828 WRONG_REG:      PIO_eprintf(interp, "Register types don't agree\n");
 829                 mem_sys_free(condition);
 830                 return NULL;
 831         }
 832
 833         /* Now we check and store the register number */
 834         reg_number = (int)atoi(++command);
 835
 836         if (reg_number < 0) {
 837             PIO_eprintf(interp, "Out-of-bounds register\n");
 838             mem_sys_free(condition);
 839             return NULL;
 840         }
 841
 842         condition->value         = mem_allocate_typed(int);
 843         *(int *)condition->value = reg_number;
 844     }
 845     /* If the first argument was an integer */
 846     else if (condition->type & PDB_cond_int) {
 847         /* This must be either an integer constant or register */
 848         condition->value             = mem_allocate_typed(INTVAL);
 849         *(INTVAL *)condition->value  = (INTVAL)atoi(command);
 850         condition->type             |= PDB_cond_const;
 851     }
 852     else if (condition->type & PDB_cond_num) {
 853         condition->value               = mem_allocate_typed(FLOATVAL);
 854         *(FLOATVAL *)condition->value  = (FLOATVAL)atof(command);
 855         condition->type               |= PDB_cond_const;
 856     }
 857     else if (condition->type & PDB_cond_str) {
 858         for (i = 1; ((command[i] != '"') && (i < 255)); i++)
 859             str[i - 1] = command[i];
 860         str[i - 1] = '\0';
 861         condition->value = string_make(interp,
 862             str, i - 1, NULL, PObj_external_FLAG);
 863         condition->type |= PDB_cond_const;
 864     }
 865     else if (condition->type & PDB_cond_pmc) {
 866         /* RT#46123 Need to figure out what to do in this case.
 867          * For the time being, we just bail. */
 868         PIO_eprintf(interp, "Can't compare PMC with constant\n");
 869         mem_sys_free(condition);
 870         return NULL;
 871     }
 872
 873     /* We're not part of a list yet */
 874     condition->next = NULL;
 875
 876     return condition;
 877 }
 878
 879 /*
 880
 881 =item C<void PDB_watchpoint>
 882
 883 Set a watchpoint.
 884
 885 =cut
 886
 887 */
 888
 889 void
 890 PDB_watchpoint(PARROT_INTERP, ARGIN(const char *command))
 891 {
 892     PDB_t           * const pdb = interp->pdb;
 893     PDB_condition_t * const condition = PDB_cond(interp, command);
 894
 895     if (!condition)
 896         return;
 897
 898     /* Add it to the head of the list */
 899     if (pdb->watchpoint)
 900         condition->next = pdb->watchpoint;
 901
 902     pdb->watchpoint = condition;
 903 }
 904
 905 /*
 906
 907 =item C<void PDB_set_break>
 908
 909 Set a break point, the source code file must be loaded.
 910
 911 =cut
 912
 913 */
 914
 915 void
 916 PDB_set_break(PARROT_INTERP, ARGIN(const char *command))
 917 {
 918     PDB_t            * const pdb      = interp->pdb;
 919     PDB_breakpoint_t *newbreak = NULL;
 920     PDB_breakpoint_t *sbreak;
 921     PDB_condition_t  *condition;
 922     PDB_line_t       *line;
 923     long              i;
 924
 925     command = nextarg(command);
 926     /* If no line number was specified, set it at the current line */
 927     if (command && *command) {
 928         const long ln = atol(command);
 929
 930         /* Move to the line where we will set the break point */
 931         line = pdb->file->line;
 932
 933         for (i = 1; ((i < ln) && (line->next)); i++)
 934             line = line->next;
 935
 936         /* Abort if the line number provided doesn't exist */
 937         if (!line->next) {
 938             PIO_eprintf(interp,
 939                 "Can't set a breakpoint at line number %li\n", ln);
 940             return;
 941         }
 942     }
 943     else {
 944         /* Get the line to set it */
 945         line = pdb->file->line;
 946
 947         while (line->opcode != pdb->cur_opcode) {
 948             line = line->next;
 949             if (!line) {
 950                 PIO_eprintf(interp,
 951                    "No current line found and no line number specified\n");
 952                 return;
 953             }
 954         }
 955     }
 956
 957     /* Skip lines that are not related to an opcode */
 958     while (!line->opcode)
 959         line = line->next;
 960
 961     /* Allocate the new break point */
 962     newbreak = mem_allocate_typed(PDB_breakpoint_t);
 963
 964     if (command) {
 965         skip_command(command);
 966     }
 967     else {
 968         real_exception(interp, NULL, 1, "NULL command passed to PDB_set_break");
 969     }
 970     condition = NULL;
 971
 972     /* if there is another argument to break, besides the line number,
 973      * it should be an 'if', so we call another handler. */
 974     if (command && *command) {
 975         skip_command(command);
 976         if ((condition = PDB_cond(interp, command)))
 977             newbreak->condition = condition;
 978     }
 979
 980     /* If there are no other arguments, or if there isn't a valid condition,
 981        then condition will be NULL */
 982     if (!condition)
 983         newbreak->condition = NULL;
 984
 985     /* Set the address where to stop */
 986     newbreak->pc   = line->opcode;
 987
 988     /* No next breakpoint */
 989     newbreak->next = NULL;
 990
 991     /* Don't skip (at least initially) */
 992     newbreak->skip = 0;
 993
 994     /* Add the breakpoint to the end of the list */
 995     i      = 0;
 996     sbreak = pdb->breakpoint;
 997
 998     if (sbreak) {
 999         while (sbreak->next)
1000             sbreak = sbreak->next;
1001
1002         newbreak->prev = sbreak;
1003         sbreak->next   = newbreak;
1004         i              = sbreak->next->id = sbreak->id + 1;
1005     }
1006     else {
1007         newbreak->prev  = NULL;
1008         pdb->breakpoint = newbreak;
1009         i               = pdb->breakpoint->id = 0;
1010     }
1011
1012     PIO_eprintf(interp, "Breakpoint %li at line %li\n", i, line->number);
1013 }
1014
1015 /*
1016
1017 =item C<void PDB_init>
1018
1019 Init the program.
1020
1021 =cut
1022
1023 */
1024
1025 void
1026 PDB_init(PARROT_INTERP, SHIM(const char *command))
1027 {
1028     PDB_t * const pdb = interp->pdb;
1029
1030     /* Restart if we are already running */
1031     if (pdb->state & PDB_RUNNING)
1032         PIO_eprintf(interp, "Restarting\n");
1033
1034     /* Add the RUNNING state */
1035     pdb->state |= PDB_RUNNING;
1036 }
1037
1038 /*
1039
1040 =item C<void PDB_continue>
1041
1042 Continue running the program. If a number is specified, skip that many
1043 breakpoints.
1044
1045 =cut
1046
1047 */
1048
1049 void
1050 PDB_continue(PARROT_INTERP, ARGIN_NULLOK(const char *command))
1051 {
1052     PDB_t *pdb = interp->pdb;
1053
1054     /* Skip any breakpoint? */
1055     if (command && *command) {
1056         long ln;
1057         if (!pdb->breakpoint) {
1058             PIO_eprintf(interp, "No breakpoints to skip\n");
1059             return;
1060         }
1061
1062         command = nextarg(command);
1063         ln = atol(command);
1064         PDB_skip_breakpoint(interp, ln);
1065     }
1066
1067     /* Run while no break point is reached */
1068     while (!PDB_break(interp))
1069         DO_OP(pdb->cur_opcode, pdb->debugee);
1070 }
1071
1072 /*
1073
1074 =item C<PDB_breakpoint_t * PDB_find_breakpoint>
1075
1076 Find breakpoint number N; returns C<NULL> if the breakpoint doesn't
1077 exist or if no breakpoint was specified.
1078
1079 =cut
1080
1081 */
1082
1083 PARROT_CAN_RETURN_NULL
1084 PARROT_WARN_UNUSED_RESULT
1085 PDB_breakpoint_t *
1086 PDB_find_breakpoint(PARROT_INTERP, ARGIN(const char *command))
1087 {
1088     command = nextarg(command);
1089     if (isdigit((unsigned char) *command)) {
1090         const long n = atol(command);
1091         PDB_breakpoint_t *breakpoint = interp->pdb->breakpoint;
1092
1093         while (breakpoint && breakpoint->id != n)
1094             breakpoint = breakpoint->next;
1095
1096         if (!breakpoint) {
1097             PIO_eprintf(interp, "No breakpoint number %ld", n);
1098             return NULL;
1099         }
1100
1101         return breakpoint;
1102     }
1103     else {
1104         /* Report an appropriate error */
1105         if (*command)
1106             PIO_eprintf(interp, "Not a valid breakpoint");
1107         else
1108             PIO_eprintf(interp, "No breakpoint specified");
1109
1110         return NULL;
1111     }
1112 }
1113
1114 /*
1115
1116 =item C<void PDB_disable_breakpoint>
1117
1118 Disable a breakpoint; it can be reenabled with the enable command.
1119
1120 =cut
1121
1122 */
1123
1124 void
1125 PDB_disable_breakpoint(PARROT_INTERP, ARGIN(const char *command))
1126 {
1127     PDB_breakpoint_t * const breakpoint = PDB_find_breakpoint(interp, command);
1128
1129     /* if the breakpoint exists, disable it. */
1130     if (breakpoint)
1131         breakpoint->skip = -1;
1132 }
1133
1134 /*
1135
1136 =item C<void PDB_enable_breakpoint>
1137
1138 Reenable a disabled breakpoint; if the breakpoint was not disabled, has
1139 no effect.
1140
1141 =cut
1142
1143 */
1144
1145 void
1146 PDB_enable_breakpoint(PARROT_INTERP, ARGIN(const char *command))
1147 {
1148     PDB_breakpoint_t * const breakpoint = PDB_find_breakpoint(interp, command);
1149
1150     /* if the breakpoint exists, and it was disabled, enable it. */
1151     if (breakpoint && breakpoint->skip == -1)
1152         breakpoint->skip = 0;
1153 }
1154
1155 /*
1156
1157 =item C<void PDB_delete_breakpoint>
1158
1159 Delete a breakpoint.
1160
1161 =cut
1162
1163 */
1164
1165 void
1166 PDB_delete_breakpoint(PARROT_INTERP, ARGIN(const char *command))
1167 {
1168     PDB_breakpoint_t * const breakpoint = PDB_find_breakpoint(interp, command);
1169
1170     if (breakpoint) {
1171         PDB_line_t *line = interp->pdb->file->line;
1172
1173         while (line->opcode != breakpoint->pc)
1174             line = line->next;
1175
1176         /* Delete the condition structure, if there is one */
1177         if (breakpoint->condition) {
1178             PDB_delete_condition(interp, breakpoint);
1179             breakpoint->condition = NULL;
1180         }
1181
1182         /* Remove the breakpoint from the list */
1183         if (breakpoint->prev && breakpoint->next) {
1184             breakpoint->prev->next = breakpoint->next;
1185             breakpoint->next->prev = breakpoint->prev;
1186         }
1187         else if (breakpoint->prev && !breakpoint->next) {
1188             breakpoint->prev->next = NULL;
1189         }
1190         else if (!breakpoint->prev && breakpoint->next) {
1191             breakpoint->next->prev  = NULL;
1192             interp->pdb->breakpoint = breakpoint->next;
1193         }
1194         else {
1195             interp->pdb->breakpoint = NULL;
1196         }
1197
1198         /* Kill the breakpoint */
1199         mem_sys_free(breakpoint);
1200     }
1201 }
1202
1203 /*
1204
1205 =item C<void PDB_delete_condition>
1206
1207 Delete a condition associated with a breakpoint.
1208
1209 =cut
1210
1211 */
1212
1213 void
1214 PDB_delete_condition(SHIM_INTERP, NOTNULL(PDB_breakpoint_t *breakpoint))
1215 {
1216     if (breakpoint->condition->value) {
1217         if (breakpoint->condition->type & PDB_cond_str) {
1218             /* 'value' is a string, so we need to be careful */
1219             PObj_external_CLEAR((STRING*)breakpoint->condition->value);
1220             PObj_on_free_list_SET((STRING*)breakpoint->condition->value);
1221             /* it should now be properly garbage collected after
1222                we destroy the condition */
1223         }
1224         else {
1225             /* 'value' is a float or an int, so we can just free it */
1226             mem_sys_free(breakpoint->condition->value);
1227             breakpoint->condition->value = NULL;
1228         }
1229     }
1230
1231     mem_sys_free(breakpoint->condition);
1232     breakpoint->condition = NULL;
1233 }
1234
1235 /*
1236
1237 =item C<void PDB_skip_breakpoint>
1238
1239 Skip C<i> times all breakpoints.
1240
1241 =cut
1242
1243 */
1244
1245 void
1246 PDB_skip_breakpoint(PARROT_INTERP, long i)
1247 {
1248     interp->pdb->breakpoint_skip = i ? i-1 : i;
1249 }
1250
1251 /*
1252
1253 =item C<char PDB_program_end>
1254
1255 End the program.
1256
1257 =cut
1258
1259 */
1260
1261 char
1262 PDB_program_end(PARROT_INTERP)
1263 {
1264     PDB_t * const pdb = interp->pdb;
1265
1266     /* Remove the RUNNING state */
1267     pdb->state &= ~PDB_RUNNING;
1268
1269     PIO_eprintf(interp, "Program exited.\n");
1270     return 1;
1271 }
1272
1273 /*
1274
1275 =item C<char PDB_check_condition>
1276
1277 Returns true if the condition was met.
1278
1279 =cut
1280
1281 */
1282
1283 PARROT_WARN_UNUSED_RESULT
1284 char
1285 PDB_check_condition(PARROT_INTERP, NOTNULL(PDB_condition_t *condition))
1286 {
1287     if (condition->type & PDB_cond_int) {
1288         INTVAL   i,  j;
1289         /*
1290          * RT#46125 verify register is in range
1291          */
1292         i = REG_INT(interp, condition->reg);
1293
1294         if (condition->type & PDB_cond_const)
1295             j = *(INTVAL *)condition->value;
1296         else
1297             j = REG_INT(interp, *(int *)condition->value);
1298
1299         if (((condition->type & PDB_cond_gt) && (i >  j)) ||
1300             ((condition->type & PDB_cond_ge) && (i >= j)) ||
1301             ((condition->type & PDB_cond_eq) && (i == j)) ||
1302             ((condition->type & PDB_cond_ne) && (i != j)) ||
1303             ((condition->type & PDB_cond_le) && (i <= j)) ||
1304             ((condition->type & PDB_cond_lt) && (i <  j)))
1305                 return 1;
1306
1307         return 0;
1308     }
1309     else if (condition->type & PDB_cond_num) {
1310         FLOATVAL k,  l;
1311
1312         k = REG_NUM(interp, condition->reg);
1313
1314         if (condition->type & PDB_cond_const)
1315             l = *(FLOATVAL *)condition->value;
1316         else
1317             l = REG_NUM(interp, *(int *)condition->value);
1318
1319         if (((condition->type & PDB_cond_gt) && (k >  l)) ||
1320             ((condition->type & PDB_cond_ge) && (k >= l)) ||
1321             ((condition->type & PDB_cond_eq) && (k == l)) ||
1322             ((condition->type & PDB_cond_ne) && (k != l)) ||
1323             ((condition->type & PDB_cond_le) && (k <= l)) ||
1324             ((condition->type & PDB_cond_lt) && (k <  l)))
1325                 return 1;
1326
1327         return 0;
1328     }
1329     else if (condition->type & PDB_cond_str) {
1330         STRING  *m, *n;
1331
1332         m = REG_STR(interp, condition->reg);
1333
1334         if (condition->type & PDB_cond_const)
1335             n = (STRING *)condition->value;
1336         else
1337             n = REG_STR(interp, *(int *)condition->value);
1338
1339         if (((condition->type & PDB_cond_gt) &&
1340                 (string_compare(interp, m, n) >  0)) ||
1341             ((condition->type & PDB_cond_ge) &&
1342                 (string_compare(interp, m, n) >= 0)) ||
1343             ((condition->type & PDB_cond_eq) &&
1344                 (string_compare(interp, m, n) == 0)) ||
1345             ((condition->type & PDB_cond_ne) &&
1346                 (string_compare(interp, m, n) != 0)) ||
1347             ((condition->type & PDB_cond_le) &&
1348                 (string_compare(interp, m, n) <= 0)) ||
1349             ((condition->type & PDB_cond_lt) &&
1350                 (string_compare(interp, m, n) <  0)))
1351                     return 1;
1352
1353         return 0;
1354     }
1355
1356     return 0;
1357 }
1358
1359 /*
1360
1361 =item C<char PDB_break>
1362
1363 Returns true if we have to stop running.
1364
1365 =cut
1366
1367 */
1368
1369 PARROT_WARN_UNUSED_RESULT
1370 char
1371 PDB_break(PARROT_INTERP)
1372 {
1373     PDB_t            * const pdb = interp->pdb;
1374     PDB_breakpoint_t *breakpoint = pdb->breakpoint;
1375     PDB_condition_t  *watchpoint = pdb->watchpoint;
1376
1377     /* Check the watchpoints first. */
1378     while (watchpoint) {
1379         if (PDB_check_condition(interp, watchpoint)) {
1380             pdb->state |= PDB_STOPPED;
1381             return 1;
1382         }
1383
1384         watchpoint = watchpoint->next;
1385     }
1386
1387     /* If program ended */
1388     if (!pdb->cur_opcode)
1389         return PDB_program_end(interp);
1390
1391     /* If the program is STOPPED allow it to continue */
1392     if (pdb->state & PDB_STOPPED) {
1393         pdb->state &= ~PDB_STOPPED;
1394         return 0;
1395     }
1396
1397     /* If we have to skip breakpoints, do so. */
1398     if (pdb->breakpoint_skip) {
1399         pdb->breakpoint_skip--;
1400         return 0;
1401     }
1402
1403     while (breakpoint) {
1404         /* if we are in a break point */
1405         if (pdb->cur_opcode == breakpoint->pc) {
1406             if (breakpoint->skip < 0)
1407                 return 0;
1408
1409             /* Check if there is a condition for this breakpoint */
1410             if ((breakpoint->condition) &&
1411                 (!PDB_check_condition(interp, breakpoint->condition)))
1412                     return 0;
1413
1414             /* Add the STOPPED state and stop */
1415             pdb->state |= PDB_STOPPED;
1416             return 1;
1417         }
1418         breakpoint = breakpoint->next;
1419     }
1420
1421     return 0;
1422 }
1423
1424 /*
1425
1426 =item C<char * PDB_escape>
1427
1428 Escapes C<">, C<\r>, C<\n>, C<\t>, C<\a> and C<\\>.
1429
1430 =cut
1431
1432 */
1433
1434 PARROT_WARN_UNUSED_RESULT
1435 PARROT_CAN_RETURN_NULL
1436 char *
1437 PDB_escape(ARGIN(const char *string), INTVAL length)
1438 {
1439     const char *end;
1440     char       *_new, *fill;
1441
1442     length = length > 20 ? 20 : length;
1443     end    = string + length;
1444
1445     /* Return if there is no string to escape*/
1446     if (!string)
1447         return NULL;
1448
1449     fill = _new = (char *)mem_sys_allocate(length * 2 + 1);
1450
1451     for (; string < end; string++) {
1452         switch (*string) {
1453             case '\0':
1454                 *(fill++) = '\\';
1455                 *(fill++) = '0';
1456                 break;
1457             case '\n':
1458                 *(fill++) = '\\';
1459                 *(fill++) = 'n';
1460                 break;
1461             case '\r':
1462                 *(fill++) = '\\';
1463                 *(fill++) = 'r';
1464                 break;
1465             case '\t':
1466                 *(fill++) = '\\';
1467                 *(fill++) = 't';
1468                 break;
1469             case '\a':
1470                 *(fill++) = '\\';
1471                 *(fill++) = 'a';
1472                 break;
1473             case '\\':
1474                 *(fill++) = '\\';
1475                 *(fill++) = '\\';
1476                 break;
1477             case '"':
1478                 *(fill++) = '\\';
1479                 *(fill++) = '"';
1480                 break;
1481             default:
1482                 *(fill++) = *string;
1483                 break;
1484         }
1485     }
1486
1487     *fill = '\0';
1488
1489     return _new;
1490 }
1491
1492 /*
1493
1494 =item C<int PDB_unescape>
1495
1496 Do inplace unescape of C<\r>, C<\n>, C<\t>, C<\a> and C<\\>.
1497
1498 =cut
1499
1500 */
1501
1502 int
1503 PDB_unescape(NOTNULL(char *string))
1504 {
1505     int l = 0;
1506
1507     for (; *string; string++) {
1508         l++;
1509
1510         if (*string == '\\') {
1511             char *fill;
1512             int i;
1513
1514             switch (string[1]) {
1515                 case 'n':
1516                     *string = '\n';
1517                     break;
1518                 case 'r':
1519                     *string = '\r';
1520                     break;
1521                 case 't':
1522                     *string = '\t';
1523                     break;
1524                 case 'a':
1525                     *string = '\a';
1526                     break;
1527                 case '\\':
1528                     *string = '\\';
1529                     break;
1530                 default:
1531                     continue;
1532             }
1533
1534             fill = string;
1535
1536             for (i = 1; fill[i + 1]; i++)
1537                 fill[i] = fill[i + 1];
1538
1539             fill[i] = '\0';
1540         }
1541     }
1542
1543     return l;
1544 }
1545
1546 /*
1547
1548 =item C<size_t PDB_disassemble_op>
1549
1550 Disassembles C<op>.
1551
1552 =cut
1553
1554 */
1555
1556 size_t
1557 PDB_disassemble_op(PARROT_INTERP, ARGOUT(char *dest), int space,
1558                    NOTNULL(op_info_t *info), NOTNULL(opcode_t *op),
1559                    NULLOK(PDB_file_t *file), NULLOK(opcode_t *code_start), int full_name)
1560 {
1561     int         j;
1562     int         size = 0;
1563
1564     /* Write the opcode name */
1565     const char * const p = full_name ? info->full_name : info->name;
1566     strcpy(dest, p);
1567     size += strlen(p);
1568
1569     dest[size++] = ' ';
1570
1571     /* Concat the arguments */
1572     for (j = 1; j < info->op_count; j++) {
1573         char      buf[256];
1574         INTVAL    i = 0;
1575         FLOATVAL  f;
1576         PMC      *k;
1577
1578         PARROT_ASSERT(size + 2 < space);
1579
1580         switch (info->types[j-1]) {
1581         case PARROT_ARG_I:
1582             dest[size++] = 'I';
1583             goto INTEGER;
1584         case PARROT_ARG_N:
1585             dest[size++] = 'N';
1586             goto INTEGER;
1587         case PARROT_ARG_S:
1588             dest[size++] = 'S';
1589             goto INTEGER;
1590         case PARROT_ARG_P:
1591             dest[size++] = 'P';
1592             goto INTEGER;
1593         case PARROT_ARG_IC:
1594             /* If the opcode jumps and this is the last argument,
1595                that means this is a label */
1596             if ((j == info->op_count - 1) &&
1597                 (info->jump & PARROT_JUMP_RELATIVE)) {
1598                 if (file) {
1599                     dest[size++] = 'L';
1600                     i            = PDB_add_label(file, op, op[j]);
1601                 }
1602                 else if (code_start) {
1603                     dest[size++] = 'O';
1604                     dest[size++] = 'P';
1605                     i            = op[j] + (op - code_start);
1606                 }
1607                 else {
1608                     if (op[j] > 0)
1609                         dest[size++] = '+';
1610                     i = op[j];
1611                 }
1612             }
1613
1614             /* Convert the integer to a string */
1615             INTEGER:
1616             if (i == 0)
1617                 i = (INTVAL) op[j];
1618
1619             PARROT_ASSERT(size + 20 < space);
1620
1621             size += sprintf(&dest[size], INTVAL_FMT, i);
1622
1623             /* If this is a constant dispatch arg to an "infix" op, then show
1624                the corresponding symbolic op name. */
1625             if (j == 1 && info->types[j-1] == PARROT_ARG_IC
1626                 && (strcmp(info->name, "infix") == 0
1627                     || strcmp(info->name, "n_infix") == 0)) {
1628                 PARROT_ASSERT(size + 20 < space);
1629
1630                 size += sprintf(&dest[size], " [%s]",
1631                         /* [kludge: the "2+" skips the leading underscores.  --
1632                            rgr, 6-May-07.] */
1633                         2 + Parrot_MMD_method_name(interp, op[j]));
1634             }
1635             break;
1636         case PARROT_ARG_NC:
1637             /* Convert the float to a string */
1638             f = interp->code->const_table->constants[op[j]]->u.number;
1639             Parrot_snprintf(interp, buf, sizeof (buf), FLOATVAL_FMT, f);
1640             strcpy(&dest[size], buf);
1641             size += strlen(buf);
1642             break;
1643         case PARROT_ARG_SC:
1644             dest[size++] = '"';
1645             if (interp->code->const_table->constants[op[j]]->
1646                     u.string->strlen)
1647             {
1648                 char * const escaped =
1649                     PDB_escape(interp->code->const_table->
1650                            constants[op[j]]->u.string->strstart,
1651                            interp->code->const_table->
1652                            constants[op[j]]->u.string->strlen);
1653                 if (escaped) {
1654                     strcpy(&dest[size], escaped);
1655                     size += strlen(escaped);
1656                     mem_sys_free(escaped);
1657                 }
1658             }
1659             dest[size++] = '"';
1660             break;
1661         case PARROT_ARG_PC:
1662             Parrot_snprintf(interp, buf, sizeof (buf), "PMC_CONST(%d)", op[j]);
1663             strcpy(&dest[size], buf);
1664             size += strlen(buf);
1665             break;
1666         case PARROT_ARG_K:
1667             dest[size-1] = '['; Parrot_snprintf(interp, buf, sizeof (buf),
1668                             "P" INTVAL_FMT, op[j]);
1669             strcpy(&dest[size], buf);
1670             size += strlen(buf);
1671             dest[size++] = ']';
1672             break;
1673         case PARROT_ARG_KC:
1674             dest[size-1] = '[';
1675             k            = interp->code->const_table->constants[op[j]]->u.key;
1676             while (k) {
1677                 switch (PObj_get_FLAGS(k)) {
1678                 case 0:
1679                     break;
1680                 case KEY_integer_FLAG:
1681                     Parrot_snprintf(interp, buf, sizeof (buf),
1682                                     INTVAL_FMT, PMC_int_val(k));
1683                     strcpy(&dest[size], buf);
1684                     size += strlen(buf);
1685                     break;
1686                 case KEY_number_FLAG:
1687                     Parrot_snprintf(interp, buf, sizeof (buf),
1688                                     FLOATVAL_FMT, PMC_num_val(k));
1689                     strcpy(&dest[size], buf);
1690                     size += strlen(buf);
1691                     break;
1692                 case KEY_string_FLAG:
1693                     dest[size++] = '"';
1694                     {
1695                         char *temp;
1696                         temp = string_to_cstring(interp, PMC_str_val(k));
1697                         strcpy(&dest[size], temp);
1698                         string_cstring_free(temp);
1699                     }
1700                     size += string_length(interp, PMC_str_val(k));
1701                     dest[size++] = '"';
1702                     break;
1703                 case KEY_integer_FLAG|KEY_register_FLAG:
1704                     Parrot_snprintf(interp, buf, sizeof (buf),
1705                                     "I" INTVAL_FMT, PMC_int_val(k));
1706                     strcpy(&dest[size], buf);
1707                     size += strlen(buf);
1708                     break;
1709                 case KEY_number_FLAG|KEY_register_FLAG:
1710                     Parrot_snprintf(interp, buf, sizeof (buf),
1711                                     "N" INTVAL_FMT, PMC_int_val(k));
1712                     strcpy(&dest[size], buf);
1713                     size += strlen(buf);
1714                     break;
1715                 case KEY_string_FLAG|KEY_register_FLAG:
1716                     Parrot_snprintf(interp, buf, sizeof (buf),
1717                                     "S" INTVAL_FMT, PMC_int_val(k));
1718                     strcpy(&dest[size], buf);
1719                     size += strlen(buf);
1720                     break;
1721                 case KEY_pmc_FLAG|KEY_register_FLAG:
1722                     Parrot_snprintf(interp, buf, sizeof (buf),
1723                                     "P" INTVAL_FMT, PMC_int_val(k));
1724                     strcpy(&dest[size], buf);
1725                     size += strlen(buf);
1726                     break;
1727                 default:
1728                     dest[size++] = '?';
1729                     break;
1730                 }
1731                 k = PMC_data_typed(k, PMC *);
1732                 if (k)
1733                     dest[size++] = ';';
1734             }
1735             dest[size++] = ']';
1736             break;
1737         case PARROT_ARG_KI:
1738             dest[size - 1] = '[';
1739             Parrot_snprintf(interp, buf, sizeof (buf), "I" INTVAL_FMT, op[j]);
1740             strcpy(&dest[size], buf);
1741             size += strlen(buf);
1742             dest[size++] = ']';
1743             break;
1744         case PARROT_ARG_KIC:
1745             dest[size - 1] = '[';
1746             Parrot_snprintf(interp, buf, sizeof (buf), INTVAL_FMT, op[j]);
1747             strcpy(&dest[size], buf);
1748             size += strlen(buf);
1749             dest[size++] = ']';
1750             break;
1751         default:
1752             real_exception(interp, NULL, 1, "Unknown opcode type");
1753         }
1754
1755         if (j != info->op_count - 1)
1756             dest[size++] = ',';
1757     }
1758
1759     /* Special decoding for the signature used in args/returns.  Such ops have
1760        one fixed parameter (the signature vector), plus a varying number of
1761        registers/constants.  For each arg/return, we show the register and its
1762        flags using PIR syntax. */
1763     if (*(op) == PARROT_OP_set_args_pc ||
1764             *(op) == PARROT_OP_get_results_pc ||
1765             *(op) == PARROT_OP_get_params_pc ||
1766             *(op) == PARROT_OP_set_returns_pc) {
1767         char buf[1000];
1768         PMC * const sig = interp->code->const_table->constants[op[1]]->u.key;
1769         int n_values = SIG_ELEMS(sig);
1770         /* The flag_names strings come from Call_bits_enum_t (with which it
1771            should probably be colocated); they name the bits from LSB to MSB.
1772            The two least significant bits are not flags; they are the register
1773            type, which is decoded elsewhere.  We also want to show unused bits,
1774            which could indicate problems.
1775         */
1776         const char *flag_names[] = { "",
1777                                      "",
1778                                      " :unused004",
1779                                      " :unused008",
1780                                      " :const",
1781                                      " :flat",  /* should be :slurpy for args */
1782                                      " :unused040",
1783                                      " :optional",
1784                                      " :opt_flag",
1785                                      " :named",
1786                                      NULL
1787         };
1788         /* Register decoding.  It would be good to abstract this, too. */
1789         const char *regs = "ISPN";
1790
1791         for (j = 0; j < n_values; j++) {
1792             unsigned int idx = 0;
1793             int sig_value = VTABLE_get_integer_keyed_int(interp, sig, j);
1794
1795             /* Print the register name, e.g. P37. */
1796             buf[idx++] = ',';
1797             buf[idx++] = ' ';
1798             buf[idx++] = regs[sig_value & PARROT_ARG_TYPE_MASK];
1799             Parrot_snprintf(interp, &buf[idx], sizeof(buf)-idx,
1800                             INTVAL_FMT, op[j+2]);
1801             idx = strlen(buf);
1802
1803             /* Add flags, if we have any. */
1804             {
1805                 int flag_idx = 0;
1806                 int flag_p = 0;
1807                 int flags = sig_value;
1808
1809                 /* End when we run out of flags, off the end of flag_names, or
1810                    get too close to the end of buf. */
1811                 while (flags && idx < sizeof(buf)-100) {
1812                     const char *flag_string = flag_names[flag_idx];
1813                     if (! flag_string)
1814                         break;
1815                     if (flags & 1 && *flag_string) {
1816                         int n = strlen(flag_string);
1817                         strcpy(&buf[idx], flag_string);
1818                         idx += n;
1819                     }
1820                     flags >>= 1;
1821                     flag_idx++;
1822                 }
1823             }
1824
1825             /* Add it to dest. */
1826             buf[idx++] = '\0';
1827             strcpy(&dest[size], buf);
1828             size += strlen(buf);
1829         }
1830     }
1831
1832     dest[size] = '\0';
1833     return ++size;
1834 }
1835
1836 /*
1837
1838 =item C<void PDB_disassemble>
1839
1840 Disassemble the bytecode.
1841
1842 =cut
1843
1844 */
1845
1846 void
1847 PDB_disassemble(PARROT_INTERP, SHIM(const char *command))
1848 {
1849     PDB_t       *pdb = interp->pdb;
1850     PDB_file_t  *pfile;
1851     PDB_line_t  *pline, *newline;
1852     PDB_label_t *label;
1853     opcode_t    *code_end;
1854     opcode_t    *pc = interp->code->base.data;
1855
1856     const unsigned int default_size = 32768;
1857     size_t space;  /* How much space do we have? */
1858     size_t size, alloced, n;
1859
1860     pfile = mem_allocate_typed(PDB_file_t);
1861     pline = mem_allocate_typed(PDB_line_t);
1862
1863     /* If we already got a source, free it */
1864     if (pdb->file)
1865         PDB_free_file(interp);
1866
1867     pline->number        = 1;
1868     pline->label         = NULL;
1869     pfile->line          = pline;
1870     pfile->label         = NULL;
1871     pfile->size          = 0;
1872     pfile->source        = (char *)mem_sys_allocate(default_size);
1873     pline->source_offset = 0;
1874
1875     alloced              = space = default_size;
1876     code_end             = pc + interp->code->base.size;
1877
1878     while (pc != code_end) {
1879         /* Grow it early */
1880         if (space < default_size) {
1881             alloced += default_size;
1882             space   += default_size;
1883             pfile->source = (char *)mem_sys_realloc(pfile->source, alloced);
1884         }
1885
1886         size = PDB_disassemble_op(interp, pfile->source + pfile->size,
1887                 space, &interp->op_info_table[*pc], pc, pfile, NULL, 1);
1888         space       -= size;
1889         pfile->size += size;
1890         pfile->source[pfile->size - 1] = '\n';
1891
1892         /* Store the opcode of this line */
1893         pline->opcode = pc;
1894         n             = interp->op_info_table[*pc].op_count;
1895
1896         ADD_OP_VAR_PART(interp, interp->code, pc, n);
1897         pc += n;
1898
1899         /* Prepare for next line */
1900         newline              = mem_allocate_typed(PDB_line_t);
1901         newline->label       = NULL;
1902         newline->next        = NULL;
1903         newline->number      = pline->number + 1;
1904         pline->next          = newline;
1905         pline                = newline;
1906         pline->source_offset = pfile->size;
1907     }
1908
1909     /* Add labels to the lines they belong to */
1910     label = pfile->label;
1911
1912     while (label) {
1913         /* Get the line to apply the label */
1914         pline = pfile->line;
1915
1916         while (pline && pline->opcode != label->opcode)
1917             pline = pline->next;
1918
1919         if (!(pline)) {
1920             PIO_eprintf(interp,
1921                         "Label number %li out of bounds.\n", label->number);
1922             /* RT#46127: free allocated memory */
1923             return;
1924         }
1925
1926         pline->label = label;
1927
1928         label        = label->next;
1929     }
1930
1931     pdb->state |= PDB_SRC_LOADED;
1932     pdb->file   = pfile;
1933 }
1934
1935 /*
1936
1937 =item C<long PDB_add_label>
1938
1939 Add a label to the label list.
1940
1941 =cut
1942
1943 */
1944
1945 long
1946 PDB_add_label(NOTNULL(PDB_file_t *file), NOTNULL(opcode_t *cur_opcode), opcode_t offset)
1947 {
1948     PDB_label_t *_new;
1949     PDB_label_t *label = file->label;
1950
1951     /* See if there is already a label at this line */
1952     while (label) {
1953         if (label->opcode == cur_opcode + offset)
1954             return label->number;
1955         label = label->next;
1956     }
1957
1958     /* Allocate a new label */
1959     label        = file->label;
1960     _new         = mem_allocate_typed(PDB_label_t);
1961     _new->opcode = cur_opcode + offset;
1962     _new->next   = NULL;
1963
1964     if (label) {
1965         while (label->next)
1966             label = label->next;
1967
1968         _new->number = label->number + 1;
1969         label->next  = _new;
1970     }
1971     else {
1972         file->label  = _new;
1973         _new->number = 1;
1974     }
1975
1976     return _new->number;
1977 }
1978
1979 /*
1980
1981 =item C<void PDB_free_file>
1982
1983 Frees any allocated source files.
1984
1985 =cut
1986
1987 */
1988
1989 void
1990 PDB_free_file(PARROT_INTERP)
1991 {
1992     PDB_file_t *file = interp->pdb->file;
1993
1994     while (file) {
1995         /* Free all of the allocated line structures */
1996         PDB_line_t *line = file->line;
1997         PDB_label_t *label;
1998         PDB_file_t  *nfile;
1999
2000         while (line) {
2001             PDB_line_t * const nline = line->next;
2002             mem_sys_free(line);
2003             line  = nline;
2004         }
2005
2006         /* Free all of the allocated label structures */
2007         label = file->label;
2008
2009         while (label) {
2010             PDB_label_t * const nlabel = label->next;
2011
2012             mem_sys_free(label);
2013             label  = nlabel;
2014         }
2015
2016         /* Free the remaining allocated portions of the file structure */
2017         if (file->sourcefilename)
2018             mem_sys_free(file->sourcefilename);
2019
2020         if (file->source)
2021             mem_sys_free(file->source);
2022
2023         nfile = file->next;
2024         mem_sys_free(file);
2025         file  = nfile;
2026     }
2027
2028     /* Make sure we don't end up pointing at garbage memory */
2029     interp->pdb->file = NULL;
2030 }
2031
2032 /*
2033
2034 =item C<void PDB_load_source>
2035
2036 Load a source code file.
2037
2038 =cut
2039
2040 */
2041
2042 void
2043 PDB_load_source(PARROT_INTERP, ARGIN(const char *command))
2044 {
2045     FILE          *file;
2046     char           f[255];
2047     int            i, c;
2048     PDB_file_t    *pfile;
2049     PDB_line_t    *pline, *newline;
2050     PDB_t         *pdb  = interp->pdb;
2051     opcode_t      *pc   = pdb->cur_opcode;
2052     unsigned long  size = 0;
2053
2054     /* If there was a file already loaded or the bytecode was
2055        disassembled, free it */
2056     if (pdb->file)
2057         PDB_free_file(interp);
2058
2059     /* Get the name of the file */
2060     for (i = 0; command[i]; i++)
2061         f[i] = command[i];
2062
2063     f[i] = '\0';
2064
2065     /* open the file */
2066     file = fopen(f, "r");
2067
2068     /* abort if fopen failed */
2069     if (!file) {
2070         PIO_eprintf(interp, "Unable to load %s\n", f);
2071         return;
2072     }
2073
2074     pfile = mem_allocate_zeroed_typed(PDB_file_t);
2075     pline = mem_allocate_zeroed_typed(PDB_line_t);
2076
2077     pfile->source = (char *)mem_sys_allocate(1024);
2078     pfile->line   = pline;
2079     pline->number = 1;
2080
2081     while ((c = fgetc(file)) != EOF) {
2082         /* Grow it */
2083         if (++size == 1024) {
2084             pfile->source = (char *)mem_sys_realloc(pfile->source,
2085                                             (size_t)pfile->size + 1024);
2086             size = 0;
2087         }
2088         pfile->source[pfile->size] = (char)c;
2089
2090         pfile->size++;
2091
2092         if (c == '\n') {
2093             /* If the line has an opcode move to the next one,
2094                otherwise leave it with NULL to skip it. */
2095             if (PDB_hasinstruction(pfile->source + pline->source_offset)) {
2096                 size_t n;
2097                 pline->opcode = pc;
2098                 n             = interp->op_info_table[*pc].op_count;
2099                 ADD_OP_VAR_PART(interp, interp->code, pc, n);
2100                 pc += n;
2101             }
2102             newline              = mem_allocate_zeroed_typed(PDB_line_t);
2103             newline->number      = pline->number + 1;
2104             pline->next          = newline;
2105             pline                = newline;
2106             pline->source_offset = pfile->size;
2107             pline->opcode        = NULL;
2108             pline->label         = NULL;
2109         }
2110     }
2111
2112     pdb->state |= PDB_SRC_LOADED;
2113     pdb->file   = pfile;
2114 }
2115
2116 /*
2117
2118 =item C<char PDB_hasinstruction>
2119
2120 Return true if the line has an instruction.
2121
2122 RT#46129:
2123
2124 =over 4
2125
2126 =item * This should take the line, get an instruction, get the opcode for
2127 that instruction and check that is the correct one.
2128
2129 =item * Decide what to do with macros if anything.
2130
2131 =back
2132
2133 =cut
2134
2135 */
2136
2137 PARROT_WARN_UNUSED_RESULT
2138 PARROT_PURE_FUNCTION
2139 char
2140 PDB_hasinstruction(ARGIN(const char *c))
2141 {
2142     char h = 0;
2143
2144     /* as long as c is not NULL, we're not looking at a comment (#...) or a '\n'... */
2145     while (*c && *c != '#' && *c != '\n') {
2146         /* ... and c is alphanumeric or a quoted string then the line contains
2147          * an instruction. */
2148         if (isalnum((unsigned char) *c) || *c == '"') {
2149             h = 1;
2150         }
2151         else if (*c == ':') {
2152             /* this is a label. RT#46137 right? */
2153             h = 0;
2154         }
2155
2156         c++;
2157     }
2158
2159     return h;
2160 }
2161
2162 /*
2163
2164 =item C<void PDB_list>
2165
2166 Show lines from the source code file.
2167
2168 =cut
2169
2170 */
2171
2172 void
2173 PDB_list(PARROT_INTERP, ARGIN(const char *command))
2174 {
2175     char          *c;
2176     long           line_number;
2177     unsigned long  i;
2178     PDB_line_t    *line;
2179     PDB_t         *pdb = interp->pdb;
2180     unsigned long  n   = 10;
2181
2182     if (!pdb->file) {
2183         PIO_eprintf(interp, "No source file loaded\n");
2184         return;
2185     }
2186
2187     command = nextarg(command);
2188     /* set the list line if provided */
2189     if (isdigit((unsigned char) *command)) {
2190         line_number = atol(command) - 1;
2191         if (line_number < 0)
2192             pdb->file->list_line = 0;
2193         else
2194             pdb->file->list_line = (unsigned long) line_number;
2195
2196         skip_command(command);
2197     }
2198     else {
2199         pdb->file->list_line = 0;
2200     }
2201
2202     /* set the number of lines to print */
2203     if (isdigit((unsigned char) *command)) {
2204         n = atol(command);
2205         skip_command(command);
2206     }
2207
2208     /* if n is zero, we simply return, as we don't have to print anything */
2209     if (n == 0)
2210         return;
2211
2212     line = pdb->file->line;
2213
2214     for (i = 0; i < pdb->file->list_line && line->next; i++)
2215         line = line->next;
2216
2217     i = 1;
2218     while (line->next) {
2219         PIO_eprintf(interp, "%li  ", pdb->file->list_line + i);
2220         /* If it has a label print it */
2221         if (line->label)
2222             PIO_eprintf(interp, "L%li:\t", line->label->number);
2223
2224         c = pdb->file->source + line->source_offset;
2225
2226         while (*c != '\n')
2227             PIO_eprintf(interp, "%c", *(c++));
2228
2229         PIO_eprintf(interp, "\n");
2230
2231         line = line->next;
2232
2233         if (i++ == n)
2234             break;
2235     }
2236
2237     if (--i != n)
2238         pdb->file->list_line = 0;
2239     else
2240         pdb->file->list_line += n;
2241 }
2242
2243 /*
2244
2245 =item C<void PDB_eval>
2246
2247 C<eval>s an instruction.
2248
2249 =cut
2250
2251 */
2252
2253 void
2254 PDB_eval(PARROT_INTERP, ARGIN(const char *command))
2255 {
2256     /* This code is almost certainly wrong. The Parrot debugger needs love. */
2257     opcode_t *run = PDB_compile(interp, command);
2258
2259     if (run)
2260         DO_OP(run, interp);
2261 }
2262
2263 /*
2264
2265 =item C<opcode_t * PDB_compile>
2266
2267 Compiles instructions with the PASM compiler.
2268
2269 Appends an C<end> op.
2270
2271 This may be called from C<PDB_eval> above or from the compile opcode
2272 which generates a malloced string.
2273
2274 =cut
2275
2276 */
2277
2278 PARROT_CAN_RETURN_NULL
2279 opcode_t *
2280 PDB_compile(PARROT_INTERP, ARGIN(const char *command))
2281 {
2282     STRING     *buf;
2283     const char *end      = "\nend\n";
2284     STRING     *key      = const_string(interp, "PASM");
2285     PMC *compreg_hash    = VTABLE_get_pmc_keyed_int(interp,
2286             interp->iglobals, IGLOBALS_COMPREG_HASH);
2287     PMC        *compiler = VTABLE_get_pmc_keyed_str(interp, compreg_hash, key);
2288
2289     if (!VTABLE_defined(interp, compiler)) {
2290         fprintf(stderr, "Couldn't find PASM compiler");
2291         return NULL;
2292     }
2293
2294     buf = Parrot_sprintf_c(interp, "%s%s", command, end);
2295
2296     return VTABLE_invoke(interp, compiler, buf);
2297 }
2298
2299 /*
2300
2301 =item C<int PDB_extend_const_table>
2302
2303 Extend the constant table.
2304
2305 =cut
2306
2307 */
2308
2309 int
2310 PDB_extend_const_table(PARROT_INTERP)
2311 {
2312     int k = ++interp->code->const_table->const_count;
2313
2314     /* Update the constant count and reallocate */
2315     if (interp->code->const_table->constants) {
2316         interp->code->const_table->constants =
2317             (PackFile_Constant **)mem_sys_realloc(interp->code->const_table->constants,
2318                             k * sizeof (PackFile_Constant *));
2319     }
2320     else {
2321         interp->code->const_table->constants =
2322             (PackFile_Constant **)mem_sys_allocate(k * sizeof (PackFile_Constant *));
2323     }
2324
2325     /* Allocate a new constant */
2326     interp->code->const_table->constants[--k] =
2327         PackFile_Constant_new(interp);
2328
2329     return k;
2330 }
2331
2332 /*
2333
2334 =item C<static void dump_string>
2335
2336 Dumps the buflen, flags, bufused, strlen, and offset associated with a string
2337 and the string itself.
2338
2339 =cut
2340
2341 */
2342
2343 static void
2344 dump_string(PARROT_INTERP, ARGIN_NULLOK(const STRING *s))
2345 {
2346     if (!s)
2347         return;
2348
2349     PIO_eprintf(interp, "\tBuflen  =\t%12ld\n", PObj_buflen(s));
2350     PIO_eprintf(interp, "\tFlags   =\t%12ld\n", PObj_get_FLAGS(s));
2351     PIO_eprintf(interp, "\tBufused =\t%12ld\n", s->bufused);
2352     PIO_eprintf(interp, "\tStrlen  =\t%12ld\n", s->strlen);
2353     PIO_eprintf(interp, "\tOffset  =\t%12ld\n",
2354                     (char*) s->strstart - (char*) PObj_bufstart(s));
2355     PIO_eprintf(interp, "\tString  =\t%S\n", s);
2356 }
2357
2358 /*
2359
2360 =item C<void PDB_print_user_stack>
2361
2362 Print an entry from the user stack.
2363
2364 =cut
2365
2366 */
2367
2368 void
2369 PDB_print_user_stack(PARROT_INTERP, ARGIN(const char *command))
2370 {
2371     Stack_Entry_t *entry;
2372     long           depth = 0;
2373     Stack_Chunk_t * const chunk = CONTEXT(interp->ctx)->user_stack;
2374
2375     command = nextarg(command);
2376     if (*command)
2377         depth = atol(command);
2378
2379     entry = stack_entry(interp, chunk, (INTVAL)depth);
2380
2381     if (!entry) {
2382         PIO_eprintf(interp, "No such entry on stack\n");
2383         return;
2384     }
2385
2386     switch (entry->entry_type) {
2387         case STACK_ENTRY_INT:
2388             PIO_eprintf(interp, "Integer\t=\t%8vi\n", UVal_int(entry->entry));
2389             break;
2390         case STACK_ENTRY_FLOAT:
2391             PIO_eprintf(interp, "Float\t=\t%8.4vf\n", UVal_num(entry->entry));
2392             break;
2393         case STACK_ENTRY_STRING:
2394             PIO_eprintf(interp, "String =\n");
2395             dump_string(interp, UVal_str(entry->entry));
2396             break;
2397         case STACK_ENTRY_PMC:
2398             PIO_eprintf(interp, "PMC =\n%PS\n", UVal_ptr(entry->entry));
2399             break;
2400         case STACK_ENTRY_POINTER:
2401             PIO_eprintf(interp, "POINTER\n");
2402             break;
2403         case STACK_ENTRY_DESTINATION:
2404             PIO_eprintf(interp, "DESTINATION\n");
2405             break;
2406         default:
2407             PIO_eprintf(interp, "Invalid stack_entry_type!\n");
2408             break;
2409     }
2410 }
2411
2412 /*
2413
2414 =item C<void PDB_print>
2415
2416 Print interp registers.
2417
2418 =cut
2419
2420 */
2421
2422 void
2423 PDB_print(PARROT_INTERP, ARGIN(const char *command))
2424 {
2425     const char * const s = GDB_P(interp->pdb->debugee, command);
2426     PIO_eprintf(interp, "%s\n", s);
2427 }
2428
2429
2430 /*
2431
2432 =item C<void PDB_info>
2433
2434 Print the interpreter info.
2435
2436 =cut
2437
2438 */
2439
2440 void
2441 PDB_info(PARROT_INTERP)
2442 {
2443     PIO_eprintf(interp, "Total memory allocated = %ld\n",
2444             interpinfo(interp, TOTAL_MEM_ALLOC));
2445     PIO_eprintf(interp, "DOD runs = %ld\n",
2446             interpinfo(interp, DOD_RUNS));
2447     PIO_eprintf(interp, "Lazy DOD runs = %ld\n",
2448             interpinfo(interp, LAZY_DOD_RUNS));
2449     PIO_eprintf(interp, "Collect runs = %ld\n",
2450             interpinfo(interp, COLLECT_RUNS));
2451     PIO_eprintf(interp, "Collect memory = %ld\n",
2452             interpinfo(interp, TOTAL_COPIED));
2453     PIO_eprintf(interp, "Active PMCs = %ld\n",
2454             interpinfo(interp, ACTIVE_PMCS));
2455     PIO_eprintf(interp, "Extended PMCs = %ld\n",
2456             interpinfo(interp, EXTENDED_PMCS));
2457     PIO_eprintf(interp, "Timely DOD PMCs = %ld\n",
2458             interpinfo(interp, IMPATIENT_PMCS));
2459     PIO_eprintf(interp, "Total PMCs = %ld\n",
2460             interpinfo(interp, TOTAL_PMCS));
2461     PIO_eprintf(interp, "Active buffers = %ld\n",
2462             interpinfo(interp, ACTIVE_BUFFERS));
2463     PIO_eprintf(interp, "Total buffers = %ld\n",
2464             interpinfo(interp, TOTAL_BUFFERS));
2465     PIO_eprintf(interp, "Header allocations since last collect = %ld\n",
2466             interpinfo(interp, HEADER_ALLOCS_SINCE_COLLECT));
2467     PIO_eprintf(interp, "Memory allocations since last collect = %ld\n",
2468             interpinfo(interp, MEM_ALLOCS_SINCE_COLLECT));
2469 }
2470
2471 /*
2472
2473 =item C<void PDB_help>
2474
2475 Print the help text. "Help" with no arguments prints a list of commands.
2476 "Help xxx" prints information on command xxx.
2477
2478 =cut
2479
2480 */
2481
2482 void
2483 PDB_help(PARROT_INTERP, ARGIN(const char *command))
2484 {
2485     unsigned long c;
2486     const char   *temp = command;
2487
2488     command = parse_command(command, &c);
2489
2490     switch (c) {
2491         case c_disassemble:
2492             PIO_eprintf(interp, "No documentation yet");
2493             break;
2494         case c_load:
2495             PIO_eprintf(interp, "No documentation yet");
2496             break;
2497         case c_list:
2498             PIO_eprintf(interp,
2499             "List the source code.\n\n\
2500 Optionally specify the line number to begin the listing from and the number\n\
2501 of lines to display.\n");
2502             break;
2503         case c_run:
2504             PIO_eprintf(interp,
2505             "Run (or restart) the program being debugged.\n\n\
2506 Arguments specified after \"run\" are passed as command line arguments to\n\
2507 the program.\n");
2508             break;
2509         case c_break:
2510             PIO_eprintf(interp,
2511 "Set a breakpoint at a given line number (which must be specified).\n\n\
2512 Optionally, specify a condition, in which case the breakpoint will only\n\
2513 activate if the condition is met. Conditions take the form:\n\n\
2514            if [REGISTER] [COMPARISON] [REGISTER or CONSTANT]\n\n\
2515 \
2516 For example:\n\n\
2517            break 10 if I4 > I3\n\n\
2518            break 45 if S1 == \"foo\"\n\n\
2519 The command returns a number which is the breakpoint identifier.");
2520             break;
2521         case c_script_file:
2522 PIO_eprintf(interp, "Interprets a file.\n\
2523 Usage:\n\
2524 (pdb) script file.script\n");
2525             break;
2526         case c_watch:
2527             PIO_eprintf(interp, "No documentation yet");
2528             break;
2529         case c_delete:
2530             PIO_eprintf(interp,
2531 "Delete a breakpoint.\n\n\
2532 The breakpoint to delete must be specified by its breakpoint number.\n\
2533 Deleted breakpoints are gone completely. If instead you want to\n\
2534 temporarily disable a breakpoint, use \"disable\".\n");
2535             break;
2536         case c_disable:
2537             PIO_eprintf(interp,
2538 "Disable a breakpoint.\n\n\
2539 The breakpoint to disable must be specified by its breakpoint number.\n\
2540 Disabled breakpoints are not forgotten, but have no effect until re-enabled\n\
2541 with the \"enable\" command.\n");
2542             break;
2543         case c_enable:
2544             PIO_eprintf(interp, "Re-enable a disabled breakpoint.\n");
2545             break;
2546         case c_continue:
2547             PIO_eprintf(interp,
2548 "Continue the program execution.\n\n\
2549 Without arguments, the program runs until a breakpoint is found\n\
2550 (or until the program terminates for some other reason).\n\n\
2551 If a number is specified, then skip that many breakpoints.\n\n\
2552 If the program has terminated, then \"continue\" will do nothing;\n\
2553 use \"run\" to re-run the program.\n");
2554             break;
2555         case c_next:
2556             PIO_eprintf(interp,
2557 "Execute a specified number of instructions.\n\n\
2558 If a number is specified with the command (e.g. \"next 5\"), then\n\
2559 execute that number of instructions, unless the program reaches a\n\
2560 breakpoint, or stops for some other reason.\n\n\
2561 If no number is specified, it defaults to 1.\n");
2562             break;
2563         case c_eval:
2564             PIO_eprintf(interp, "No documentation yet");
2565             break;
2566         case c_trace:
2567             PIO_eprintf(interp,
2568 "Similar to \"next\", but prints additional trace information.\n\
2569 This is the same as the information you get when running Parrot with\n\
2570 the -t option.\n");
2571             break;
2572         case c_print:
2573             PIO_eprintf(interp, "Print register: e.g. p I2\n");
2574             break;
2575         case c_info:
2576             PIO_eprintf(interp,
2577                     "Print information about the current interpreter\n");
2578             break;
2579         case c_quit:
2580             PIO_eprintf(interp, "Exit the debugger.\n");
2581             break;
2582         case c_help:
2583             PIO_eprintf(interp, "Print a list of available commands.\n");
2584             break;
2585         case 0:
2586             /* C89: strings need to be 509 chars or less */
2587             PIO_eprintf(interp, "\
2588 List of commands:\n\
2589     disassemble  -- disassemble the bytecode\n\
2590     load         -- load a source code file\n\
2591     list     (l) -- list the source code file\n\
2592     run      (r) -- run the program\n\
2593     break    (b) -- add a breakpoint\n\
2594     script   (f) -- interprets a file as user commands\n\
2595     watch    (w) -- add a watchpoint\n\
2596     delete   (d) -- delete a breakpoint\n\
2597     disable      -- disable a breakpoint\n\
2598     enable       -- reenable a disabled breakpoint\n\
2599     continue (c) -- continue the program execution\n");
2600             PIO_eprintf(interp, "\
2601     next     (n) -- run the next instruction\n\
2602     eval     (e) -- run an instruction\n\
2603     trace    (t) -- trace the next instruction\n\
2604     print    (p) -- print the interpreter registers\n\
2605     stack    (s) -- examine the stack\n\
2606     info         -- print interpreter information\n\
2607     quit     (q) -- exit the debugger\n\
2608     help     (h) -- print this help\n\n\
2609 Type \"help\" followed by a command name for full documentation.\n\n");
2610             break;
2611         default:
2612             PIO_eprintf(interp, "Unknown command: \"%s\".", temp);
2613             break;
2614     }
2615 }
2616
2617 /*
2618
2619 =item C<void PDB_backtrace>
2620
2621 Prints a backtrace of the interp's call chain.
2622
2623 =cut
2624
2625 */
2626
2627 void
2628 PDB_backtrace(PARROT_INTERP)
2629 {
2630     STRING           *str;
2631     PMC              *old       = PMCNULL;
2632     int               rec_level = 0;
2633
2634     /* information about the current sub */
2635     PMC              *sub = interpinfo_p(interp, CURRENT_SUB);
2636     parrot_context_t *ctx = CONTEXT(interp->ctx);
2637
2638     if (!PMC_IS_NULL(sub)) {
2639         str = Parrot_Context_infostr(interp, ctx);
2640         if (str)
2641             PIO_eprintf(interp, "%Ss\n", str);
2642     }
2643
2644     /* backtrace: follow the continuation chain */
2645     while (1) {
2646         Parrot_cont *sub_cont;
2647         sub = ctx->current_cont;
2648
2649         if (!sub)
2650             break;
2651
2652         sub_cont = PMC_cont(sub);
2653
2654         if (!sub_cont)
2655             break;
2656
2657         str = Parrot_Context_infostr(interp, sub_cont->to_ctx);
2658
2659         if (!str)
2660             break;
2661
2662         /* recursion detection */
2663         if (!PMC_IS_NULL(old) && PMC_cont(old) &&
2664             PMC_cont(old)->to_ctx->current_pc ==
2665             PMC_cont(sub)->to_ctx->current_pc &&
2666             PMC_cont(old)->to_ctx->current_sub ==
2667             PMC_cont(sub)->to_ctx->current_sub) {
2668                 ++rec_level;
2669         }
2670         else if (rec_level != 0) {
2671             PIO_eprintf(interp, "... call repeated %d times\n", rec_level);
2672             rec_level = 0;
2673         }
2674
2675         /* print the context description */
2676         if (rec_level == 0)
2677             PIO_eprintf(interp, "%Ss\n", str);
2678
2679         /* get the next Continuation */
2680         ctx = PMC_cont(sub)->to_ctx;
2681         old = sub;
2682
2683         if (!ctx)
2684             break;
2685     }
2686
2687     if (rec_level != 0)
2688         PIO_eprintf(interp, "... call repeated %d times\n", rec_level);
2689 }
2690
2691 /*
2692  * GDB functions
2693  *
2694  * GDB_P  gdb> pp $I0   print register I0 value
2695  *
2696  * RT46139 more, more
2697  */
2698
2699 /*
2700
2701 =item C<static const char* GDB_P>
2702
2703 RT#48260: Not yet documented!!!
2704
2705 =cut
2706
2707 */
2708
2709 PARROT_WARN_UNUSED_RESULT
2710 PARROT_CANNOT_RETURN_NULL
2711 static const char*
2712 GDB_P(PARROT_INTERP, ARGIN(const char *s))
2713 {
2714     int t, n;
2715     switch (*s) {
2716         case 'I': t = REGNO_INT; break;
2717         case 'N': t = REGNO_NUM; break;
2718         case 'S': t = REGNO_STR; break;
2719         case 'P': t = REGNO_PMC; break;
2720         default: return "no such reg";
2721     }
2722     if (s[1] && isdigit((unsigned char)s[1]))
2723         n = atoi(s + 1);
2724     else
2725         return "no such reg";
2726
2727     if (n >= 0 && n < CONTEXT(interp->ctx)->n_regs_used[t]) {
2728         switch (t) {
2729             case REGNO_INT:
2730                 return string_from_int(interp, REG_INT(interp, n))->strstart;
2731             case REGNO_NUM:
2732                 return string_from_num(interp, REG_NUM(interp, n))->strstart;
2733             case REGNO_STR:
2734                 return REG_STR(interp, n)->strstart;
2735             case REGNO_PMC:
2736                 /* prints directly */
2737                 trace_pmc_dump(interp, REG_PMC(interp, n));
2738                 return "";
2739             default:
2740                 break;
2741         }
2742     }
2743     return "no such reg";
2744 }
2745
2746 /* RT#46141 move these to debugger interpreter
2747  */
2748 static PDB_breakpoint_t *gdb_bps;
2749
2750 /*
2751  * GDB_pb   gdb> pb 244     # set breakpoint at opcode 244
2752  *
2753  * RT#46143 We can't remove the breakpoint yet, executing the next ins
2754  * most likely fails, as the length of the debug-brk stmt doesn't
2755  * match the old opcode
2756  * Setting a breakpoint will also fail, if the bytecode os r/o
2757  *
2758  */
2759 /*
2760
2761 =item C<static int GDB_B>
2762
2763 RT#48260: Not yet documented!!!
2764
2765 =cut
2766
2767 */
2768
2769 static int
2770 GDB_B(PARROT_INTERP, NOTNULL(char *s)) {
2771     int               nr;
2772     opcode_t         *pc;
2773     PDB_breakpoint_t *bp, *newbreak;
2774
2775     if ((unsigned long)s < 0x10000) {
2776         /* HACK alarm  pb 45 is passed as the integer not a string */
2777         /* RT#46145 check if in bounds */
2778         pc = interp->code->base.data + (unsigned long)s;
2779
2780         if (!gdb_bps) {
2781             nr             = 0;
2782             newbreak       = mem_allocate_typed(PDB_breakpoint_t);
2783             newbreak->prev = NULL;
2784             newbreak->next = NULL;
2785             gdb_bps        = newbreak;
2786         }
2787         else {
2788             /* create new one */
2789             for (nr = 0, bp = gdb_bps; ; bp = bp->next, ++nr) {
2790                 if (bp->pc == pc)
2791                     return nr;
2792
2793                 if (!bp->next)
2794                     break;
2795             }
2796
2797             ++nr;
2798             newbreak       = mem_allocate_typed(PDB_breakpoint_t);
2799             newbreak->prev = bp;
2800             newbreak->next = NULL;
2801             bp->next       = newbreak;
2802         }
2803
2804         newbreak->pc = pc;
2805         newbreak->id = *pc;
2806         *pc          = PARROT_OP_trap;
2807
2808         return nr;
2809     }
2810
2811     return -1;
2812 }
2813
2814 /*
2815
2816 =back
2817
2818 =head1 SEE ALSO
2819
2820 F<include/parrot/debug.h>, F<src/pdb.c> and F<ops/debug.ops>.
2821
2822 =head1 HISTORY
2823
2824 =over 4
2825
2826 =item Initial version by Daniel Grunblatt on 2002.5.19.
2827
2828 =item Start of rewrite - leo 2005.02.16
2829
2830 The debugger now uses its own interpreter. User code is run in
2831 Interp *debugee. We have:
2832
2833   debug_interp->pdb->debugee->debugger
2834     ^                            |
2835     |                            v
2836     +------------- := -----------+
2837
2838 Debug commands are mostly run inside the C<debugger>. User code
2839 runs of course in the C<debugee>.
2840
2841 =back
2842
2843 =cut
2844
2845 */
2846
2847
2848 /*
2849  * Local variables:
2850  *   c-file-style: "parrot"
2851  * End:
2852  * vim: expandtab shiftwidth=4:
2853  */