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