Dbg.c

   1 /* Dbg.c - Tcl Debugger - See cmdHelp() for commands
   2
   3 Written by: Don Libes, NIST, 3/23/93
   4
   5 Design and implementation of this program was paid for by U.S. tax
   6 dollars.  Therefore it is public domain.  However, the author and NIST
   7 would appreciate credit if this program or parts of it are used.
   8
   9 */
  10
  11 #include <stdio.h>
  12
  13 #ifndef HAVE_STRCHR
  14 #define strchr(s,c) index(s,c)
  15 #endif /* HAVE_STRCHR */
  16
  17 #if 0
  18 /* tclInt.h drags in stdlib.  By claiming no-stdlib, force it to drag in */
  19 /* Tcl's compat version.  This avoids having to test for its presence */
  20 /* which is too tricky - configure can't generate two cf files, so when */
  21 /* Expect (or any app) uses the debugger, there's no way to get the info */
  22 /* about whether stdlib exists or not, except pointing the debugger at */
  23 /* an app-dependent .h file and I don't want to do that. */
  24 #define NO_STDLIB_H
  25 #endif
  26
  27
  28 #include "tclInt.h"
  29 /*#include <varargs.h>          tclInt.h drags in varargs.h.  Since Pyramid */
  30 /*                              objects to including varargs.h twice, just */
  31 /*                              omit this one. */
  32 /*#include "string.h"           tclInt.h drags this in, too! */
  33 #include "tcldbg.h"
  34
  35 #ifndef TRUE
  36 #define TRUE 1
  37 #define FALSE 0
  38 #endif
  39
  40 static int simple_interactor (Tcl_Interp *interp, ClientData data);
  41 static int zero (Tcl_Interp *interp, char *string);
  42
  43 /* most of the static variables in this file may be */
  44 /* moved into Tcl_Interp */
  45
  46 static Dbg_InterProc *interactor = &simple_interactor;
  47 static ClientData interdata = 0;
  48 static Dbg_IgnoreFuncsProc *ignoreproc = &zero;
  49 static Dbg_OutputProc *printproc = 0;
  50 static ClientData printdata = 0;
  51 static int stdinmode;
  52
  53 static void print _ANSI_ARGS_(TCL_VARARGS(Tcl_Interp *,interp));
  54
  55 static int debugger_active = FALSE;
  56
  57 /* this is not externally documented anywhere as of yet */
  58 char *Dbg_VarName = "dbg";
  59
  60 #define DEFAULT_COMPRESS        0
  61 static int compress = DEFAULT_COMPRESS;
  62 #define DEFAULT_WIDTH           75      /* leave a little space for printing */
  63                                         /*  stack level */
  64 static int buf_width = DEFAULT_WIDTH;
  65
  66 static int main_argc = 1;
  67 static char *default_argv = "application";
  68 static char **main_argv = &default_argv;
  69
  70 static Tcl_Trace debug_handle;
  71 static int step_count = 1;      /* count next/step */
  72
  73 #define FRAMENAMELEN 10         /* enough to hold strings like "#4" */
  74 static char viewFrameName[FRAMENAMELEN];/* destination frame name for up/down */
  75
  76 static CallFrame *goalFramePtr; /* destination for next/return */
  77 static int goalNumLevel;        /* destination for Next */
  78
  79 static enum debug_cmd {
  80         none, step, next, ret, cont, up, down, where, Next
  81 } debug_cmd = step;
  82
  83 /* info about last action to use as a default */
  84 static enum debug_cmd last_action_cmd = next;
  85 static int last_step_count = 1;
  86
  87 /* this acts as a strobe (while testing breakpoints).  It is set to true */
  88 /* every time a new debugger command is issued that is an action */
  89 static int debug_new_action;
  90
  91 #define NO_LINE -1      /* if break point is not set by line number */
  92
  93 struct breakpoint {
  94         int id;
  95         Tcl_Obj *file;  /* file where breakpoint is */
  96         int line;       /* line where breakpoint is */
  97         int re;         /* 1 if this is regexp pattern */
  98         Tcl_Obj *pat;   /* pattern defining where breakpoint can be */
  99         Tcl_Obj *expr;  /* expr to trigger breakpoint */
 100         Tcl_Obj *cmd;   /* cmd to eval at breakpoint */
 101         struct breakpoint *next, *previous;
 102 };
 103
 104 static struct breakpoint *break_base = 0;
 105 static int breakpoint_max_id = 0;
 106
 107 static struct breakpoint *
 108 breakpoint_new()
 109 {
 110         struct breakpoint *b = (struct breakpoint *)ckalloc(sizeof(struct breakpoint));
 111         if (break_base) break_base->previous = b;
 112         b->next = break_base;
 113         b->previous = 0;
 114         b->id = breakpoint_max_id++;
 115         b->file = 0;
 116         b->line = NO_LINE;
 117         b->pat = 0;
 118         b->re = 0;
 119         b->expr = 0;
 120         b->cmd = 0;
 121         break_base = b;
 122         return(b);
 123 }
 124
 125 static
 126 void
 127 breakpoint_print(interp,b)
 128 Tcl_Interp *interp;
 129 struct breakpoint *b;
 130 {
 131     print(interp,"breakpoint %d: ",b->id);
 132
 133     if (b->re) {
 134         print(interp,"-re \"%s\" ",Tcl_GetString(b->pat));
 135     } else if (b->pat) {
 136         print(interp,"-glob \"%s\" ",Tcl_GetString(b->pat));
 137     } else if (b->line != NO_LINE) {
 138         if (b->file) {
 139             print(interp,"%s:",Tcl_GetString(b->file));
 140         }
 141         print(interp,"%d ",b->line);
 142     }
 143
 144     if (b->expr)
 145         print(interp,"if {%s} ",Tcl_GetString(b->expr));
 146
 147     if (b->cmd)
 148         print(interp,"then {%s}",Tcl_GetString(b->cmd));
 149
 150     print(interp,"\n");
 151 }
 152
 153 static void
 154 save_re_matches(interp, re, objPtr)
 155 Tcl_Interp *interp;
 156 Tcl_RegExp re;
 157 Tcl_Obj *objPtr;
 158 {
 159     Tcl_RegExpInfo info;
 160     int i, start;
 161     char name[20];
 162
 163     Tcl_RegExpGetInfo(re, &info);
 164     for (i=0;i<=info.nsubs;i++) {
 165         start = info.matches[i].start;
 166         /* end = info.matches[i].end-1;*/
 167
 168         if (start == -1) continue;
 169
 170         sprintf(name,"%d",i);
 171         Tcl_SetVar2Ex(interp, Dbg_VarName, name, Tcl_GetRange(objPtr,
 172                 info.matches[i].start, info.matches[i].end-1), 0);
 173     }
 174 }
 175
 176 /* return 1 to break, 0 to continue */
 177 static int
 178 breakpoint_test(interp,cmd,bp)
 179 Tcl_Interp *interp;
 180 char *cmd;              /* command about to be executed */
 181 struct breakpoint *bp;  /* breakpoint to test */
 182 {
 183     if (bp->re) {
 184         int found = 0;
 185         Tcl_Obj *cmdObj;
 186         Tcl_RegExp re = Tcl_GetRegExpFromObj(NULL, bp->pat,
 187                 TCL_REG_ADVANCED);
 188         cmdObj = Tcl_NewStringObj(cmd,-1);
 189         Tcl_IncrRefCount(cmdObj);
 190         if (Tcl_RegExpExecObj(NULL, re, cmdObj, 0 /* offset */,
 191                 -1 /* nmatches */, 0 /* eflags */) > 0) {
 192             save_re_matches(interp, re, cmdObj);
 193             found = 1;
 194         }
 195         Tcl_DecrRefCount(cmdObj);
 196         if (!found) return 0;
 197     } else if (bp->pat) {
 198         if (0 == Tcl_StringMatch(cmd,
 199                 Tcl_GetString(bp->pat))) return 0;
 200     } else if (bp->line != NO_LINE) {
 201         /* not yet implemented - awaiting support from Tcl */
 202         return 0;
 203     }
 204
 205     if (bp->expr) {
 206         int value;
 207
 208         /* ignore errors, since they are likely due to */
 209         /* simply being out of scope a lot */
 210         if (TCL_OK != Tcl_ExprBooleanObj(interp,bp->expr,&value)
 211                 || (value == 0)) return 0;
 212     }
 213
 214     if (bp->cmd) {
 215         Tcl_EvalObjEx(interp, bp->cmd, 0);
 216     } else {
 217         breakpoint_print(interp,bp);
 218     }
 219
 220     return 1;
 221 }
 222
 223 static char *already_at_top_level = "already at top level";
 224
 225 /* similar to TclGetFrame but takes two frame ptrs and a direction.
 226 If direction is up,   search up stack from curFrame
 227 If direction is down, simulate searching down stack by
 228                       seaching up stack from origFrame
 229 */
 230 static
 231 int
 232 TclGetFrame2(interp, origFramePtr, string, framePtrPtr, dir)
 233     Tcl_Interp *interp;
 234     CallFrame *origFramePtr;    /* frame that is true top-of-stack */
 235     char *string;               /* String describing frame. */
 236     CallFrame **framePtrPtr;    /* Store pointer to frame here (or NULL
 237                                  * if global frame indicated). */
 238     enum debug_cmd dir; /* look up or down the stack */
 239 {
 240     Interp *iPtr = (Interp *) interp;
 241     int level, result;
 242     CallFrame *framePtr;        /* frame currently being searched */
 243
 244     CallFrame *curFramePtr = iPtr->varFramePtr;
 245
 246     /*
 247      * Parse string to figure out which level number to go to.
 248      */
 249
 250     result = 1;
 251     if (*string == '#') {
 252         if (Tcl_GetInt(interp, string+1, &level) != TCL_OK) {
 253             return TCL_ERROR;
 254         }
 255         if (level < 0) {
 256             levelError:
 257             Tcl_AppendResult(interp, "bad level \"", string, "\"",
 258                     (char *) NULL);
 259             return TCL_ERROR;
 260         }
 261         framePtr = origFramePtr; /* start search here */
 262
 263     } else if (isdigit(*string)) {
 264         if (Tcl_GetInt(interp, string, &level) != TCL_OK) {
 265             return TCL_ERROR;
 266         }
 267         if (dir == up) {
 268                 if (curFramePtr == 0) {
 269                         Tcl_SetResult(interp,already_at_top_level,TCL_STATIC);
 270                         return TCL_ERROR;
 271                 }
 272                 level = curFramePtr->level - level;
 273                 framePtr = curFramePtr; /* start search here */
 274         } else {
 275                 if (curFramePtr != 0) {
 276                         level = curFramePtr->level + level;
 277                 }
 278                 framePtr = origFramePtr; /* start search here */
 279         }
 280     } else {
 281         level = curFramePtr->level - 1;
 282         result = 0;
 283     }
 284
 285     /*
 286      * Figure out which frame to use.
 287      */
 288
 289     if (level == 0) {
 290         framePtr = NULL;
 291     } else {
 292         for (;framePtr != NULL; framePtr = framePtr->callerVarPtr) {
 293             if (framePtr->level == level) {
 294                 break;
 295             }
 296         }
 297         if (framePtr == NULL) {
 298             goto levelError;
 299         }
 300     }
 301     *framePtrPtr = framePtr;
 302     return result;
 303 }
 304
 305
 306 static char *printify(s)
 307 char *s;
 308 {
 309     static int destlen = 0;
 310     char *d;            /* ptr into dest */
 311     unsigned int need;
 312     static char buf_basic[DEFAULT_WIDTH+1];
 313     static char *dest = buf_basic;
 314     Tcl_UniChar ch;
 315
 316     if (s == 0) return("<null>");
 317
 318     /* worst case is every character takes 4 to printify */
 319     need = strlen(s)*6;
 320     if (need > destlen) {
 321         if (dest && (dest != buf_basic)) ckfree(dest);
 322         dest = (char *)ckalloc(need+1);
 323         destlen = need;
 324     }
 325
 326     for (d = dest;*s;) {
 327         s += Tcl_UtfToUniChar(s, &ch);
 328         if (ch == '\b') {
 329             strcpy(d,"\\b");            d += 2;
 330         } else if (ch == '\f') {
 331             strcpy(d,"\\f");            d += 2;
 332         } else if (ch == '\v') {
 333             strcpy(d,"\\v");            d += 2;
 334         } else if (ch == '\r') {
 335             strcpy(d,"\\r");            d += 2;
 336         } else if (ch == '\n') {
 337             strcpy(d,"\\n");            d += 2;
 338         } else if (ch == '\t') {
 339             strcpy(d,"\\t");            d += 2;
 340         } else if ((unsigned)ch < 0x20) { /* unsigned strips parity */
 341             sprintf(d,"\\%03o",ch);             d += 4;
 342         } else if (ch == 0177) {
 343             strcpy(d,"\\177");          d += 4;
 344         } else if ((ch < 0x80) && isprint(UCHAR(ch))) {
 345             *d = (char)ch;              d += 1;
 346         } else {
 347             sprintf(d,"\\u%04x",ch);    d += 6;
 348         }
 349     }
 350     *d = '\0';
 351     return(dest);
 352 }
 353
 354 static
 355 char *
 356 print_argv(interp,argc,argv)
 357 Tcl_Interp *interp;
 358 int argc;
 359 char *argv[];
 360 {
 361         static int buf_width_max = DEFAULT_WIDTH;
 362         static char buf_basic[DEFAULT_WIDTH+1]; /* basic buffer */
 363         static char *buf = buf_basic;
 364         int space;              /* space remaining in buf */
 365         int len;
 366         char *bufp;
 367         int proc;               /* if current command is "proc" */
 368         int arg_index;
 369
 370         if (buf_width > buf_width_max) {
 371                 if (buf && (buf != buf_basic)) ckfree(buf);
 372                 buf = (char *)ckalloc(buf_width + 1);
 373                 buf_width_max = buf_width;
 374         }
 375
 376         proc = (0 == strcmp("proc",argv[0]));
 377         sprintf(buf,"%.*s",buf_width,argv[0]);
 378         len = strlen(buf);
 379         space = buf_width - len;
 380         bufp = buf + len;
 381         argc--; argv++;
 382         arg_index = 1;
 383
 384         while (argc && (space > 0)) {
 385                 CONST char *elementPtr;
 386                 CONST char *nextPtr;
 387                 int wrap;
 388
 389                 /* braces/quotes have been stripped off arguments */
 390                 /* so put them back.  We wrap everything except lists */
 391                 /* with one argument.  One exception is to always wrap */
 392                 /* proc's 2nd arg (the arg list), since people are */
 393                 /* used to always seeing it this way. */
 394
 395                 if (proc && (arg_index > 1)) wrap = TRUE;
 396                 else {
 397                         (void) TclFindElement(interp,*argv,
 398 #if TCL_MAJOR_VERSION >= 8
 399                                               -1,
 400 #endif
 401                                 &elementPtr,&nextPtr,(int *)0,(int *)0);
 402                         if (*elementPtr == '\0') wrap = TRUE;
 403                         else if (*nextPtr == '\0') wrap = FALSE;
 404                         else wrap = TRUE;
 405                 }
 406
 407                 /* wrap lists (or null) in braces */
 408                 if (wrap) {
 409                         sprintf(bufp," {%.*s}",space-3,*argv);
 410                 } else {
 411                         sprintf(bufp," %.*s",space-1,*argv);
 412                 }
 413                 len = strlen(buf);
 414                 space = buf_width - len;
 415                 bufp = buf + len;
 416                 argc--; argv++;
 417                 arg_index++;
 418         }
 419
 420         if (compress) {
 421                 /* this copies from our static buf to printify's static buf */
 422                 /* and back to our static buf */
 423                 strncpy(buf,printify(buf),buf_width);
 424         }
 425
 426         /* usually but not always right, but assume truncation if buffer is */
 427         /* full.  this avoids tiny but odd-looking problem of appending "}" */
 428         /* to truncated lists during {}-wrapping earlier */
 429         if (strlen(buf) == buf_width) {
 430                 buf[buf_width-1] = buf[buf_width-2] = buf[buf_width-3] = '.';
 431         }
 432
 433         return(buf);
 434 }
 435
 436 #if TCL_MAJOR_VERSION >= 8
 437 static
 438 char *
 439 print_objv(interp,objc,objv)
 440 Tcl_Interp *interp;
 441 int objc;
 442 Tcl_Obj *objv[];
 443 {
 444     char **argv;
 445     int argc;
 446     int len;
 447     argv = (char **)ckalloc(objc+1 * sizeof(char *));
 448     for (argc=0 ; argc<objc ; argc++) {
 449         argv[argc] = Tcl_GetStringFromObj(objv[argc],&len);
 450     }
 451     argv[argc] = NULL;
 452     return(print_argv(interp,argc,argv));
 453 }
 454 #endif
 455
 456 static
 457 void
 458 PrintStackBelow(interp,curf,viewf)
 459 Tcl_Interp *interp;
 460 CallFrame *curf;        /* current FramePtr */
 461 CallFrame *viewf;       /* view FramePtr */
 462 {
 463         char ptr;       /* graphically indicate where we are in the stack */
 464
 465         /* indicate where we are in the stack */
 466         ptr = ((curf == viewf)?'*':' ');
 467
 468         if (curf == 0) {
 469                 print(interp,"%c0: %s\n",
 470                                 ptr,print_argv(interp,main_argc,main_argv));
 471         } else {
 472                 PrintStackBelow(interp,curf->callerVarPtr,viewf);
 473                 print(interp,"%c%d: %s\n",ptr,curf->level,
 474 #if TCL_MAJOR_VERSION >= 8
 475               print_objv(interp,curf->objc,curf->objv)
 476 #else
 477               print_argv(interp,curf->argc,curf->argv)
 478 #endif
 479               );
 480         }
 481 }
 482
 483 static
 484 void
 485 PrintStack(interp,curf,viewf,objc,objv,level)
 486 Tcl_Interp *interp;
 487 CallFrame *curf;        /* current FramePtr */
 488 CallFrame *viewf;       /* view FramePtr */
 489      int objc;
 490      Tcl_Obj *CONST objv[];             /* Argument objects. */
 491 char *level;
 492 {
 493         PrintStackBelow(interp,curf,viewf);
 494     print(interp," %s: %s\n",level,print_objv(interp,objc,objv));
 495 }
 496
 497 /* return 0 if goal matches current frame or goal can't be found */
 498 /*      anywere in frame stack */
 499 /* else return 1 */
 500 /* This catches things like a proc called from a Tcl_Eval which in */
 501 /* turn was not called from a proc but some builtin such as source */
 502 /* or Tcl_Eval.  These builtin calls to Tcl_Eval lose any knowledge */
 503 /* the FramePtr from the proc, so we have to search the entire */
 504 /* stack frame to see if it's still there. */
 505 static int
 506 GoalFrame(goal,iptr)
 507 CallFrame *goal;
 508 Interp *iptr;
 509 {
 510         CallFrame *cf = iptr->varFramePtr;
 511
 512         /* if at current level, return success immediately */
 513         if (goal == cf) return 0;
 514
 515         while (cf) {
 516                 cf = cf->callerVarPtr;
 517                 if (goal == cf) {
 518                         /* found, but since it's above us, fail */
 519                         return 1;
 520                 }
 521         }
 522         return 0;
 523 }
 524
 525 #if 0
 526 static char *cmd_print(cmdtype)
 527 enum debug_cmd cmdtype;
 528 {
 529         switch (cmdtype) {
 530         case none:  return "cmd: none";
 531         case step:  return "cmd: step";
 532         case next:  return "cmd: next";
 533         case ret:   return "cmd: ret";
 534         case cont:  return "cmd: cont";
 535         case up:    return "cmd: up";
 536         case down:  return "cmd: down";
 537         case where: return "cmd: where";
 538         case Next:  return "cmd: Next";
 539         }
 540         return "cmd: Unknown";
 541 }
 542 #endif
 543
 544 /* debugger's trace handler */
 545
 546 static int
 547 debugger_trap _ANSI_ARGS_ ((
 548      ClientData clientData,
 549      Tcl_Interp *interp,
 550      int level,
 551      CONST char *command,
 552      Tcl_Command commandInfo,
 553      int objc,
 554      struct Tcl_Obj * CONST * objv));
 555
 556
 557 /*ARGSUSED*/
 558 static int
 559 debugger_trap(clientData,interp,level,command,commandInfo,objc,objv)
 560      ClientData clientData;             /* not used */
 561      Tcl_Interp *interp;
 562      int level;                 /* positive number if called by Tcl, -1 if */
 563                                 /* called by Dbg_On in which case we don't */
 564                                 /* know the level */
 565      CONST char *command;
 566      Tcl_Command commandInfo; /* Unused */
 567      int objc;
 568      struct Tcl_Obj * CONST * objv;
 569 {
 570         char level_text[6];     /* textual representation of level */
 571
 572         int break_status;
 573         Interp *iPtr = (Interp *)interp;
 574
 575         CallFrame *trueFramePtr;        /* where the pc is */
 576         CallFrame *viewFramePtr;        /* where up/down are */
 577
 578         int print_command_first_time = TRUE;
 579         static int debug_suspended = FALSE;
 580
 581         struct breakpoint *b;
 582
 583     char* thecmd;
 584
 585         /* skip commands that are invoked interactively */
 586     if (debug_suspended) return TCL_OK;
 587
 588     thecmd = Tcl_GetString (objv[0]);
 589         /* skip debugger commands */
 590     if (thecmd[1] == '\0') {
 591         switch (thecmd[0]) {
 592                 case 'n':
 593                 case 's':
 594                 case 'c':
 595                 case 'r':
 596                 case 'w':
 597                 case 'b':
 598                 case 'u':
 599         case 'd': return TCL_OK;
 600                 }
 601         }
 602
 603     if ((*ignoreproc)(interp,thecmd)) return TCL_OK;
 604
 605         /* if level is unknown, use "?" */
 606         sprintf(level_text,(level == -1)?"?":"%d",level);
 607
 608         /* save so we can restore later */
 609         trueFramePtr = iPtr->varFramePtr;
 610
 611         /* do not allow breaking while testing breakpoints */
 612         debug_suspended = TRUE;
 613
 614         /* test all breakpoints to see if we should break */
 615         /* if any successful breakpoints, start interactor */
 616         debug_new_action = FALSE;       /* reset strobe */
 617         break_status = FALSE;           /* no successful breakpoints yet */
 618         for (b = break_base;b;b=b->next) {
 619                 break_status |= breakpoint_test(interp,command,b);
 620         }
 621         if (break_status) {
 622                 if (!debug_new_action) {
 623                         goto start_interact;
 624                 }
 625
 626                 /* if s or n triggered by breakpoint, make "s 1" */
 627                 /* (and so on) refer to next command, not this one */
 628                 /* step_count++;*/
 629                 goto end_interact;
 630         }
 631
 632         switch (debug_cmd) {
 633         case cont:
 634                 goto finish;
 635         case step:
 636                 step_count--;
 637                 if (step_count > 0) goto finish;
 638                 goto start_interact;
 639         case next:
 640                 /* check if we are back at the same level where the next */
 641                 /* command was issued.  Also test */
 642                 /* against all FramePtrs and if no match, assume that */
 643                 /* we've missed a return, and so we should break  */
 644 /*              if (goalFramePtr != iPtr->varFramePtr) goto finish;*/
 645                 if (GoalFrame(goalFramePtr,iPtr)) goto finish;
 646                 step_count--;
 647                 if (step_count > 0) goto finish;
 648                 goto start_interact;
 649         case Next:
 650                 /* check if we are back at the same level where the next */
 651                 /* command was issued.  */
 652                 if (goalNumLevel < iPtr->numLevels) goto finish;
 653                 step_count--;
 654                 if (step_count > 0) goto finish;
 655                 goto start_interact;
 656         case ret:
 657                 /* same comment as in "case next" */
 658                 if (goalFramePtr != iPtr->varFramePtr) goto finish;
 659                 goto start_interact;
 660     /* DANGER: unhandled cases! none, up, down, where */
 661         }
 662
 663 start_interact:
 664         if (print_command_first_time) {
 665                 print(interp,"%s: %s\n",
 666                                 level_text,print_argv(interp,1,&command));
 667                 print_command_first_time = FALSE;
 668         }
 669         /* since user is typing a command, don't interrupt it immediately */
 670         debug_cmd = cont;
 671         debug_suspended = TRUE;
 672
 673         /* interactor won't return until user gives a debugger cmd */
 674         (*interactor)(interp,interdata);
 675 end_interact:
 676
 677         /* save this so it can be restored after "w" command */
 678         viewFramePtr = iPtr->varFramePtr;
 679
 680         if (debug_cmd == up || debug_cmd == down) {
 681                 /* calculate new frame */
 682                 if (-1 == TclGetFrame2(interp,trueFramePtr,viewFrameName,
 683                                         &iPtr->varFramePtr,debug_cmd)) {
 684             print(interp,"%s\n",Tcl_GetStringResult (interp));
 685                         Tcl_ResetResult(interp);
 686                 }
 687                 goto start_interact;
 688         }
 689
 690         /* reset view back to normal */
 691         iPtr->varFramePtr = trueFramePtr;
 692
 693 #if 0
 694         /* allow trapping */
 695         debug_suspended = FALSE;
 696 #endif
 697
 698         switch (debug_cmd) {
 699         case cont:
 700         case step:
 701                 goto finish;
 702         case next:
 703                 goalFramePtr = iPtr->varFramePtr;
 704                 goto finish;
 705         case Next:
 706                 goalNumLevel = iPtr->numLevels;
 707                 goto finish;
 708         case ret:
 709                 goalFramePtr = iPtr->varFramePtr;
 710                 if (goalFramePtr == 0) {
 711                         print(interp,"nowhere to return to\n");
 712                         break;
 713                 }
 714                 goalFramePtr = goalFramePtr->callerVarPtr;
 715                 goto finish;
 716         case where:
 717         PrintStack(interp,iPtr->varFramePtr,viewFramePtr,objc,objv,level_text);
 718                 break;
 719         }
 720
 721         /* restore view and restart interactor */
 722         iPtr->varFramePtr = viewFramePtr;
 723         goto start_interact;
 724
 725  finish:
 726         debug_suspended = FALSE;
 727         return TCL_OK;
 728 }
 729
 730 /*ARGSUSED*/
 731 static
 732 int
 733 cmdNext(clientData, interp, objc, objv)
 734 ClientData clientData;
 735 Tcl_Interp *interp;
 736      int objc;
 737      Tcl_Obj *CONST objv[];             /* Argument objects. */
 738 {
 739         debug_new_action = TRUE;
 740         debug_cmd = *(enum debug_cmd *)clientData;
 741
 742         last_action_cmd = debug_cmd;
 743
 744     if (objc == 1) {
 745         step_count = 1;
 746     } else if (TCL_OK != Tcl_GetIntFromObj (interp, objv[1], &step_count)) {
 747         return TCL_ERROR;
 748     }
 749
 750         last_step_count = step_count;
 751         return(TCL_RETURN);
 752 }
 753
 754 /*ARGSUSED*/
 755 static
 756 int
 757 cmdDir(clientData, interp, objc, objv)
 758 ClientData clientData;
 759 Tcl_Interp *interp;
 760      int objc;
 761      Tcl_Obj *CONST objv[];             /* Argument objects. */
 762 {
 763     char* frame;
 764     debug_cmd = *(enum debug_cmd *)clientData;
 765
 766     if (objc == 1) {
 767         frame = "1";
 768     } else {
 769         frame = Tcl_GetString (objv[1]);
 770     }
 771
 772     strncpy(viewFrameName,frame,FRAMENAMELEN);
 773         return TCL_RETURN;
 774 }
 775
 776 /*ARGSUSED*/
 777 static
 778 int
 779 cmdSimple(clientData, interp, objc, objv)
 780 ClientData clientData;
 781 Tcl_Interp *interp;
 782      int objc;
 783      Tcl_Obj *CONST objv[];             /* Argument objects. */
 784 {
 785         debug_new_action = TRUE;
 786         debug_cmd = *(enum debug_cmd *)clientData;
 787         last_action_cmd = debug_cmd;
 788
 789         return TCL_RETURN;
 790 }
 791
 792 static
 793 void
 794 breakpoint_destroy(b)
 795 struct breakpoint *b;
 796 {
 797         if (b->file) Tcl_DecrRefCount(b->file);
 798         if (b->pat) Tcl_DecrRefCount(b->pat);
 799         if (b->cmd) Tcl_DecrRefCount(b->cmd);
 800         if (b->expr) Tcl_DecrRefCount(b->expr);
 801
 802         /* unlink from chain */
 803         if ((b->previous == 0) && (b->next == 0)) {
 804                 break_base = 0;
 805         } else if (b->previous == 0) {
 806                 break_base = b->next;
 807                 b->next->previous = 0;
 808         } else if (b->next == 0) {
 809                 b->previous->next = 0;
 810         } else {
 811                 b->previous->next = b->next;
 812                 b->next->previous = b->previous;
 813         }
 814
 815         ckfree((char *)b);
 816 }
 817
 818 static void
 819 savestr(objPtr,str)
 820 Tcl_Obj **objPtr;
 821 char *str;
 822 {
 823     *objPtr = Tcl_NewStringObj(str, -1);
 824     Tcl_IncrRefCount(*objPtr);
 825 }
 826
 827 /*ARGSUSED*/
 828 static
 829 int
 830 cmdWhere(clientData, interp, objc, objv)
 831 ClientData clientData;
 832 Tcl_Interp *interp;
 833      int objc;
 834      Tcl_Obj *CONST objv[];             /* Argument objects. */
 835 {
 836     static char* options [] = {
 837         "-compress",
 838         "-width",
 839         NULL
 840     };
 841     enum options {
 842         WHERE_COMPRESS,
 843         WHERE_WIDTH
 844     };
 845     int i;
 846
 847     if (objc == 1) {
 848                 debug_cmd = where;
 849                 return TCL_RETURN;
 850         }
 851
 852     /* Check and process switches */
 853
 854     for (i=1; i<objc; i++) {
 855         char *name;
 856         int index;
 857
 858         name = Tcl_GetString(objv[i]);
 859         if (name[0] != '-') {
 860             break;
 861                 }
 862         if (Tcl_GetIndexFromObj(interp, objv[i], options, "flag", 0,
 863                                 &index) != TCL_OK) {
 864             goto usage;
 865         }
 866         switch ((enum options) index) {
 867         case WHERE_COMPRESS:
 868             i++;
 869             if (i >= objc) {
 870                 print(interp,"%d\n",compress);
 871                 break;
 872             }
 873             if (TCL_OK != Tcl_GetBooleanFromObj (interp, objv[i], &buf_width))
 874                 goto usage;
 875             break;
 876         case WHERE_WIDTH:
 877             i++;
 878             if (i >= objc) {
 879                 print(interp,"%d\n",buf_width);
 880                 break;
 881         }
 882             if (TCL_OK != Tcl_GetIntFromObj (interp, objv[i], &buf_width))
 883                 goto usage;
 884             break;
 885         }
 886     }
 887
 888     if (i < objc) goto usage;
 889
 890         return TCL_OK;
 891
 892  usage:
 893     print(interp,"usage: w [-width #] [-compress 0|1]\n");
 894     return TCL_ERROR;
 895 }
 896
 897 #define breakpoint_fail(msg) {error_msg = msg; goto break_fail;}
 898
 899 /*ARGSUSED*/
 900 static
 901 int
 902 cmdBreak(clientData, interp, objc, objv)
 903 ClientData clientData;
 904 Tcl_Interp *interp;
 905      int objc;
 906      Tcl_Obj *CONST objv[];             /* Argument objects. */
 907 {
 908         struct breakpoint *b;
 909         char *error_msg;
 910
 911     static char* options [] = {
 912         "-glob",
 913         "-regexp",
 914         "if",
 915         "then",
 916         NULL
 917     };
 918     enum options {
 919         BREAK_GLOB,
 920         BREAK_RE,
 921         BREAK_IF,
 922         BREAK_THEN
 923     };
 924     int i;
 925     int index;
 926
 927
 928     /* No arguments, list breakpoints */
 929     if (objc == 1) {
 930                 for (b = break_base;b;b=b->next) breakpoint_print(interp,b);
 931                 return(TCL_OK);
 932         }
 933
 934     /* Process breakpoint deletion (-, -x) */
 935
 936     /* Copied from exp_prog.h */
 937 #define streq(x,y)      (0 == strcmp((x),(y)))
 938
 939     if (objc == 2) {
 940         int id;
 941
 942         if (streq (Tcl_GetString (objv[1]),"-")) {
 943                         while (break_base) {
 944                                 breakpoint_destroy(break_base);
 945                         }
 946                         breakpoint_max_id = 0;
 947                         return(TCL_OK);
 948         }
 949
 950         if ((Tcl_GetString (objv[1])[0] == '-') &&
 951             (TCL_OK == Tcl_GetIntFromObj (interp, objv[1], &id))) {
 952             id = -id;
 953
 954                         for (b = break_base;b;b=b->next) {
 955                                 if (b->id == id) {
 956                                         breakpoint_destroy(b);
 957                                         if (!break_base) breakpoint_max_id = 0;
 958                                         return(TCL_OK);
 959                                 }
 960                         }
 961                         Tcl_SetResult(interp,"no such breakpoint",TCL_STATIC);
 962                         return(TCL_ERROR);
 963                 }
 964         }
 965
 966         b = breakpoint_new();
 967
 968     /* Process switches */
 969
 970     i = 1;
 971     if (Tcl_GetIndexFromObj(interp, objv[i], options, "flag", 0,
 972                             &index) == TCL_OK) {
 973         switch ((enum options) index) {
 974         case BREAK_GLOB:
 975             i++;
 976             if (i == objc) breakpoint_fail("no pattern?");
 977             savestr(&b->pat,Tcl_GetString (objv[i]));
 978             i++;
 979             break;
 980         case BREAK_RE:
 981             i++;
 982             if (i == objc) breakpoint_fail("bad regular expression");
 983                     b->re = 1;
 984             savestr(&b->pat,Tcl_GetString (objv[i]));
 985             if (Tcl_GetRegExpFromObj(interp, b->pat, TCL_REG_ADVANCED) == NULL) {
 986                         breakpoint_destroy(b);
 987                         return TCL_ERROR;
 988                     }
 989             i++;
 990             break;
 991         case BREAK_IF:   break;
 992         case BREAK_THEN: break;
 993                 }
 994                 } else {
 995                 /* look for [file:]line */
 996                 char *colon;
 997                 char *linep;    /* pointer to beginning of line number */
 998         char* ref = Tcl_GetString (objv[i]);
 999         colon = strchr(ref,':');
1000                 if (colon) {
1001                         *colon = '\0';
1002             savestr(&b->file,ref);
1003                         *colon = ':';
1004                         linep = colon + 1;
1005                 } else {
1006             linep = ref;
1007                         /* get file from current scope */
1008                         /* savestr(&b->file, ?); */
1009                 }
1010
1011                 if (TCL_OK == Tcl_GetInt(interp,linep,&b->line)) {
1012             i++;
1013                         print(interp,"setting breakpoints by line number is currently unimplemented - use patterns or expressions\n");
1014                 } else {
1015                         /* not an int? - unwind & assume it is an expression */
1016
1017                         if (b->file) Tcl_DecrRefCount(b->file);
1018                 }
1019
1020         }
1021
1022     if (i < objc) {
1023                 int do_if = FALSE;
1024
1025         if (Tcl_GetIndexFromObj(interp, objv[i], options, "flag", 0,
1026                                 &index) == TCL_OK) {
1027             switch ((enum options) index) {
1028             case BREAK_IF:
1029                 i++;
1030                 do_if = TRUE;
1031                 /* Consider next word as expression */
1032                 break;
1033             case BREAK_THEN:
1034                 /* No 'if expression' guard here, do nothing */
1035                 break;
1036             case BREAK_GLOB:
1037             case BREAK_RE:
1038                         do_if = TRUE;
1039                 /* Consider current word as expression, without a preceding 'if' */
1040                 break;
1041             }
1042         } else {
1043             /* Consider current word as expression, without a preceding 'if' */
1044                         do_if = TRUE;
1045                 }
1046
1047                 if (do_if) {
1048             if (i == objc) breakpoint_fail("if what");
1049             savestr(&b->expr,Tcl_GetString (objv[i]));
1050             i++;
1051                 }
1052         }
1053
1054     if (i < objc) {
1055         /* Remainder is a command */
1056         if (Tcl_GetIndexFromObj(interp, objv[i], options, "flag", 0,
1057                                 &index) == TCL_OK) {
1058             switch ((enum options) index) {
1059             case BREAK_THEN:
1060                 i++;
1061                 break;
1062             case BREAK_IF:
1063             case BREAK_GLOB:
1064             case BREAK_RE:
1065                 break;
1066                 }
1067                 }
1068
1069         if (i == objc) breakpoint_fail("then what?");
1070
1071         savestr(&b->cmd,Tcl_GetString (objv[i]));
1072         }
1073
1074     Tcl_SetObjResult (interp, Tcl_NewIntObj (b->id));
1075         return(TCL_OK);
1076
1077  break_fail:
1078         breakpoint_destroy(b);
1079         Tcl_SetResult(interp,error_msg,TCL_STATIC);
1080         return(TCL_ERROR);
1081 }
1082
1083 static char *help[] = {
1084 "s [#]          step into procedure",
1085 "n [#]          step over procedure",
1086 "N [#]          step over procedures, commands, and arguments",
1087 "c              continue",
1088 "r              continue until return to caller",
1089 "u [#]          move scope up level",
1090 "d [#]          move scope down level",
1091 "               go to absolute frame if # is prefaced by \"#\"",
1092 "w              show stack (\"where\")",
1093 "w -w [#]       show/set width",
1094 "w -c [0|1]     show/set compress",
1095 "b              show breakpoints",
1096 "b [-r regexp-pattern] [if expr] [then command]",
1097 "b [-g glob-pattern]   [if expr] [then command]",
1098 "b [[file:]#]          [if expr] [then command]",
1099 "               if pattern given, break if command resembles pattern",
1100 "               if # given, break on line #",
1101 "               if expr given, break if expr true",
1102 "               if command given, execute command at breakpoint",
1103 "b -#           delete breakpoint",
1104 "b -            delete all breakpoints",
1105 0};
1106
1107 /*ARGSUSED*/
1108 static
1109 int
1110 cmdHelp(clientData, interp, objc, objv)
1111 ClientData clientData;
1112 Tcl_Interp *interp;
1113      int objc;
1114      Tcl_Obj *CONST objv[];             /* Argument objects. */
1115 {
1116         char **hp;
1117
1118         for (hp=help;*hp;hp++) {
1119                 print(interp,"%s\n",*hp);
1120         }
1121
1122         return(TCL_OK);
1123 }
1124
1125 /* occasionally, we print things larger buf_max but not by much */
1126 /* see print statements in PrintStack routines for examples */
1127 #define PAD 80
1128
1129 /*VARARGS*/
1130 static void
1131 print TCL_VARARGS_DEF(Tcl_Interp *,arg1)
1132 {
1133         Tcl_Interp *interp;
1134         char *fmt;
1135         va_list args;
1136
1137         interp = TCL_VARARGS_START(Tcl_Interp *,arg1,args);
1138         fmt = va_arg(args,char *);
1139         if (!printproc) vprintf(fmt,args);
1140         else {
1141                 static int buf_width_max = DEFAULT_WIDTH+PAD;
1142                 static char buf_basic[DEFAULT_WIDTH+PAD+1];
1143                 static char *buf = buf_basic;
1144
1145                 if (buf_width+PAD > buf_width_max) {
1146                         if (buf && (buf != buf_basic)) ckfree(buf);
1147                         buf = (char *)ckalloc(buf_width+PAD+1);
1148                         buf_width_max = buf_width+PAD;
1149                 }
1150
1151                 vsprintf(buf,fmt,args);
1152                 (*printproc)(interp,buf,printdata);
1153         }
1154         va_end(args);
1155 }
1156
1157 /*ARGSUSED*/
1158 Dbg_InterStruct
1159 Dbg_Interactor(interp,inter_proc,data)
1160 Tcl_Interp *interp;
1161 Dbg_InterProc *inter_proc;
1162 ClientData data;
1163 {
1164         Dbg_InterStruct tmp;
1165
1166         tmp.func = interactor;
1167         tmp.data = interdata;
1168         interactor = (inter_proc?inter_proc:simple_interactor);
1169         interdata = data;
1170         return tmp;
1171 }
1172
1173 /*ARGSUSED*/
1174 Dbg_IgnoreFuncsProc *
1175 Dbg_IgnoreFuncs(interp,proc)
1176 Tcl_Interp *interp;
1177 Dbg_IgnoreFuncsProc *proc;
1178 {
1179         Dbg_IgnoreFuncsProc *tmp = ignoreproc;
1180         ignoreproc = (proc?proc:zero);
1181         return tmp;
1182 }
1183
1184 /*ARGSUSED*/
1185 Dbg_OutputStruct
1186 Dbg_Output(interp,proc,data)
1187 Tcl_Interp *interp;
1188 Dbg_OutputProc *proc;
1189 ClientData data;
1190 {
1191         Dbg_OutputStruct tmp;
1192
1193         tmp.func = printproc;
1194         tmp.data = printdata;
1195         printproc = proc;
1196         printdata = data;
1197         return tmp;
1198 }
1199
1200 /*ARGSUSED*/
1201 int
1202 Dbg_Active(interp)
1203 Tcl_Interp *interp;
1204 {
1205         return debugger_active;
1206 }
1207
1208 char **
1209 Dbg_ArgcArgv(argc,argv,copy)
1210 int argc;
1211 char *argv[];
1212 int copy;
1213 {
1214         char **alloc;
1215
1216         main_argc = argc;
1217
1218         if (!copy) {
1219                 main_argv = argv;
1220                 alloc = 0;
1221         } else {
1222                 main_argv = alloc = (char **)ckalloc((argc+1)*sizeof(char *));
1223                 while (argc-- >= 0) {
1224                         *main_argv++ = *argv++;
1225                 }
1226                 main_argv = alloc;
1227         }
1228         return alloc;
1229 }
1230
1231 static struct cmd_list {
1232         char *cmdname;
1233     Tcl_ObjCmdProc *cmdproc;
1234         enum debug_cmd cmdtype;
1235 } cmd_list[]  = {
1236                 {"n", cmdNext,   next},
1237                 {"s", cmdNext,   step},
1238                 {"N", cmdNext,   Next},
1239                 {"c", cmdSimple, cont},
1240                 {"r", cmdSimple, ret},
1241                 {"w", cmdWhere,  none},
1242                 {"b", cmdBreak,  none},
1243                 {"u", cmdDir,    up},
1244                 {"d", cmdDir,    down},
1245                 {"h", cmdHelp,   none},
1246                 {0}
1247 };
1248
1249 /* this may seem excessive, but this avoids the explicit test for non-zero */
1250 /* in the caller, and chances are that that test will always be pointless */
1251 /*ARGSUSED*/
1252 static int
1253 zero (Tcl_Interp *interp, char *string)
1254 {
1255         return 0;
1256 }
1257
1258 extern int expSetBlockModeProc _ANSI_ARGS_((int fd, int mode));
1259
1260 static int
1261 simple_interactor(Tcl_Interp *interp, ClientData data)
1262 {
1263         int rc;
1264         char *ccmd;             /* pointer to complete command */
1265         char line[BUFSIZ+1];    /* space for partial command */
1266         int newcmd = TRUE;
1267         Interp *iPtr = (Interp *)interp;
1268
1269         Tcl_DString dstring;
1270         Tcl_DStringInit(&dstring);
1271
1272         /* Force blocking if necessary */
1273
1274         if (stdinmode == TCL_MODE_NONBLOCKING) {
1275           expSetBlockModeProc(0, TCL_MODE_BLOCKING);
1276         }
1277
1278         newcmd = TRUE;
1279         while (TRUE) {
1280                 struct cmd_list *c;
1281
1282                 if (newcmd) {
1283 #if TCL_MAJOR_VERSION < 8
1284                         print(interp,"dbg%d.%d> ",iPtr->numLevels,iPtr->curEventNum+1);
1285 #else
1286                         /* unncessarily tricky coding - if nextid
1287                            isn't defined, maintain our own static
1288                            version */
1289
1290                         static int nextid = 0;
1291                         CONST char *nextidstr = Tcl_GetVar2(interp,"tcl::history","nextid",0);
1292                         if (nextidstr) {
1293                                 sscanf(nextidstr,"%d",&nextid);
1294                         }
1295                         print(interp,"dbg%d.%d> ",iPtr->numLevels,nextid++);
1296 #endif
1297                 } else {
1298                         print(interp,"dbg+> ");
1299                 }
1300                 fflush(stdout);
1301
1302                 rc = read(0,line,BUFSIZ);
1303                 if (0 >= rc) {
1304                         if (!newcmd) line[0] = 0;
1305                         else exit(0);
1306                 } else line[rc] = '\0';
1307
1308                 ccmd = Tcl_DStringAppend(&dstring,line,rc);
1309                 if (!Tcl_CommandComplete(ccmd)) {
1310                         newcmd = FALSE;
1311                         continue;       /* continue collecting command */
1312                 }
1313                 newcmd = TRUE;
1314
1315                 /* if user pressed return with no cmd, use previous one */
1316                 if ((ccmd[0] == '\n' || ccmd[0] == '\r') && ccmd[1] == '\0') {
1317
1318                         /* this loop is guaranteed to exit through break */
1319                         for (c = cmd_list;c->cmdname;c++) {
1320                                 if (c->cmdtype == last_action_cmd) break;
1321                         }
1322
1323                         /* recreate textual version of command */
1324                         Tcl_DStringAppend(&dstring,c->cmdname,-1);
1325
1326                         if (c->cmdtype == step ||
1327                             c->cmdtype == next ||
1328                             c->cmdtype == Next) {
1329                                 char num[10];
1330
1331                                 sprintf(num," %d",last_step_count);
1332                                 Tcl_DStringAppend(&dstring,num,-1);
1333                         }
1334                 }
1335
1336 #if TCL_MAJOR_VERSION == 7 && TCL_MINOR_VERSION < 4
1337                 rc = Tcl_RecordAndEval(interp,ccmd,0);
1338 #else
1339                 rc = Tcl_RecordAndEval(interp,ccmd,TCL_NO_EVAL);
1340                 rc = Tcl_Eval(interp,ccmd);
1341 #endif
1342                 Tcl_DStringFree(&dstring);
1343
1344                 switch (rc) {
1345                 case TCL_OK:
1346             {
1347                 char* res = Tcl_GetStringResult (interp);
1348                 if (*res != 0)
1349                     print(interp,"%s\n",res);
1350             }
1351                         continue;
1352                 case TCL_ERROR:
1353                         print(interp,"%s\n",Tcl_GetVar(interp,"errorInfo",TCL_GLOBAL_ONLY));
1354                         /* since user is typing by hand, we expect lots
1355                            of errors, and want to give another chance */
1356                         continue;
1357                 case TCL_BREAK:
1358                 case TCL_CONTINUE:
1359 #define finish(x)       {rc = x; goto done;}
1360                         finish(rc);
1361                 case TCL_RETURN:
1362                         finish(TCL_OK);
1363                 default:
1364                         /* note that ccmd has trailing newline */
1365                         print(interp,"error %d: %s\n",rc,ccmd);
1366                         continue;
1367                 }
1368         }
1369         /* cannot fall thru here, must jump to label */
1370  done:
1371         Tcl_DStringFree(&dstring);
1372
1373         /* Restore old blocking mode */
1374         if (stdinmode == TCL_MODE_NONBLOCKING) {
1375           expSetBlockModeProc(0, TCL_MODE_NONBLOCKING);
1376         }
1377         return(rc);
1378 }
1379
1380 static char init_auto_path[] = "lappend auto_path $dbg_library";
1381
1382 static void
1383 init_debugger(interp)
1384 Tcl_Interp *interp;
1385 {
1386         struct cmd_list *c;
1387
1388         for (c = cmd_list;c->cmdname;c++) {
1389         Tcl_CreateObjCommand(interp,c->cmdname,c->cmdproc,
1390                         (ClientData)&c->cmdtype,(Tcl_CmdDeleteProc *)0);
1391         }
1392
1393     debug_handle = Tcl_CreateObjTrace(interp,10000,0,
1394                                       debugger_trap,(ClientData)0, NULL);
1395
1396         debugger_active = TRUE;
1397         Tcl_SetVar2(interp,Dbg_VarName,"active","1",0);
1398 #ifdef DBG_SCRIPTDIR
1399         Tcl_SetVar(interp,"dbg_library",DBG_SCRIPTDIR,0);
1400 #endif
1401         Tcl_Eval(interp,init_auto_path);
1402
1403 }
1404
1405 /* allows any other part of the application to jump to the debugger */
1406 /*ARGSUSED*/
1407 void
1408 Dbg_On(interp,immediate)
1409 Tcl_Interp *interp;
1410 int immediate;          /* if true, stop immediately */
1411                         /* should only be used in safe places */
1412                         /* i.e., when Tcl_Eval can be called */
1413 {
1414         if (!debugger_active) init_debugger(interp);
1415
1416         /* Initialize debugger in single-step mode.  Note: if the
1417           command reader is already active, it's too late which is why
1418           we also statically initialize debug_cmd to step. */
1419         debug_cmd = step;
1420         step_count = 1;
1421
1422 #define LITERAL(s) Tcl_NewStringObj ((s), sizeof(s)-1)
1423
1424         if (immediate) {
1425         Tcl_Obj* fake_cmd = LITERAL ( "--interrupted-- (command_unknown)");
1426
1427         Tcl_IncrRefCount (fake_cmd);
1428         debugger_trap((ClientData)0,interp,-1,Tcl_GetString (fake_cmd),0,1,&fake_cmd);
1429 /*              (*interactor)(interp);*/
1430         Tcl_DecrRefCount (fake_cmd);
1431         }
1432 }
1433
1434 void
1435 Dbg_Off(interp)
1436 Tcl_Interp *interp;
1437 {
1438         struct cmd_list *c;
1439
1440         if (!debugger_active) return;
1441
1442         for (c = cmd_list;c->cmdname;c++) {
1443                 Tcl_DeleteCommand(interp,c->cmdname);
1444         }
1445
1446         Tcl_DeleteTrace(interp,debug_handle);
1447         debugger_active = FALSE;
1448         Tcl_UnsetVar(interp,Dbg_VarName,TCL_GLOBAL_ONLY);
1449
1450         /* initialize for next use */
1451         debug_cmd = step;
1452         step_count = 1;
1453 }
1454
1455 /* allows any other part of the application to tell the debugger where the Tcl channel for stdin is. */
1456 /*ARGSUSED*/
1457 void
1458 Dbg_StdinMode(mode)
1459      int mode;
1460 {
1461   stdinmode = mode;
1462 }
1463 \f
1464 /*
1465  * Local Variables:
1466  * mode: c
1467  * c-basic-offset: 4
1468  * fill-column: 78
1469  * End:
1470  */