src/debug.c

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