util/grind/do_comm.c

   1 /* $Id: do_comm.c,v 1.6 1994/06/24 10:59:41 ceriel Exp $ */
   2
   3 /* Implementation of the do_ routines */
   4
   5 #include <stdio.h>
   6 #include <assert.h>
   7 #include <alloc.h>
   8
   9 #include "operator.h"
  10 #include "position.h"
  11 #include "tree.h"
  12 #include "idf.h"
  13 #include "Lpars.h"
  14 #include "type.h"
  15 #include "expr.h"
  16 #include "symbol.h"
  17 #include "scope.h"
  18 #include "file.h"
  19 #include "misc.h"
  20
  21 extern FILE     *db_out;
  22 extern t_lineno listline, currline;
  23 extern int      interrupted;
  24 extern int      stack_offset;
  25
  26 p_tree          print_command;
  27
  28 extern void     set_bytes();
  29
  30 /*ARGSUSED*/
  31 do_noop(p)
  32   p_tree        p;
  33 {
  34 }
  35
  36 /* ------------------------------------------------------------- */
  37
  38 /* implementation of the help command */
  39
  40 do_help(p)
  41   p_tree        p;
  42 {
  43   p = p->t_args[0];
  44   if (p && p->t_idf) switch(p->t_idf->id_reserved) {
  45   case HELP:
  46         fputs("help [ <commandname> ]\n", db_out);
  47         fputs("? [ <commandname> ]\n", db_out);
  48         fputs("  Print a command summary, or some more help on <commandname>.\n", db_out);
  49         return;
  50   case LIST:
  51         fputs("list [ <start> | <func> ] [ , <cnt> | - [ <end> ] ]\n", db_out);
  52         fputs("l [ <start> | <func> ] [ , <cnt> | - [ <end> ] ]\n", db_out);
  53         fputs("  List lines from the current source file, starting with either\n", db_out);
  54         fputs("  line <start> or some lines before the first statement of <func> or\n", db_out);
  55         fputs("  the current line. Either list <cnt> lines or <wsize> lines,\n", db_out);
  56         fputs("  except when a range is given.\n", db_out);
  57         fputs("  <wsize> is the last <cnt> given, or 10.\n", db_out);
  58         return;
  59   case XFILE:
  60         fputs("file [ <name> | ? ]\n", db_out);
  61         fputs("  Print the name of the current source file, or change the\n", db_out);
  62         fputs("  current source file to <name>, or print the files that\n", db_out);
  63         fputs("  the debugger knows about.\n", db_out);
  64         return;
  65   case SOURCE:
  66         fputs("source <filename>\n", db_out);
  67         fputs("  Read commands from the file <filename>\n", db_out);
  68         return;
  69   case FRAME:
  70         fputs("frame [ [ + | - ] <num> ]\n", db_out);
  71         fputs("  Sets the 'current' frame to frame <num>. The currently active\n", db_out);
  72         fputs("  procedure has frame 0. If <num> is not given, print the 'current' frame.\n", db_out);
  73         fputs("  If <num> is given with a + or -, go up or down <num> frames relative\n", db_out);
  74         fputs("  to the current one.\n", db_out);
  75         return;
  76   case LOG:
  77         fputs("log [ <name> | off ]\n", db_out);
  78         fputs("  Creates a logfile <name> of the commands given.\n", db_out);
  79         fputs("  When no argument is given, the current logfile is printed.\n", db_out);
  80         fputs("  If the argument is 'off', logging is turned off.\n", db_out);
  81         return;
  82   case RUN:
  83         fputs("run [ <args> ] [ < <infile> ] [ > <outfile> ]\n", db_out);
  84         fputs("  Start executing debuggee with command line arguments <args> and\n", db_out);
  85         fputs("  possible redirection of standard input and/or standard output.\n", db_out);
  86         return;
  87   case RERUN:
  88         fputs("rerun [ ? ]\n", db_out);
  89         fputs("  If the ? is given, prints the last run command;\n", db_out);
  90         fputs("  otherwise repeats the last run command.\n", db_out);
  91         return;
  92   case STOP:
  93         fputs("stop [ <pos> ] [ if <cond> ]\n", db_out);
  94         fputs("  Stop execution when position <pos> is reached, and then when\n", db_out);
  95         fputs("  <cond> becomes true. If no <pos> is given, stop when <cond>\n", db_out);
  96         fputs("  becomes true.  If no <cond> is given, stop when <pos> is reached.\n", db_out);
  97         fputs("  Either a position or a condition (or both) must be given.\n", db_out);
  98         return;
  99   case WHEN:
 100         fputs("when [ <pos> ] [ if <cond> ] { <command> [ ; <command> ] ... } \n", db_out);
 101         fputs("  Execute the <command>s when position <pos> is reached, and then when\n", db_out);
 102         fputs("  <cond> becomes true. If no <pos> is given, do this when <cond>\n", db_out);
 103         fputs("  becomes true.  If no <cond> is given, do this when <pos> is reached.\n", db_out);
 104         fputs("  Either a position or a condition (or both) must be given.\n", db_out);
 105         return;
 106   case CONT:
 107         fputs("cont [ <cnt> ] [ at <line> ]\n", db_out);
 108         fputs("c [ <cnt> ] [ at <line> ]\n", db_out);
 109         fputs("  Continue execution, skipping <cnt> or 1 breakpoints;a\n", db_out);
 110         fputs("  if <line> is given, continue at <line>.\n", db_out);
 111         return;
 112   case STEP:
 113   case NEXT:
 114         fputs("step [ <cnt> ]\n", db_out);
 115         fputs("s [ <cnt> ]\n", db_out);
 116         fputs("next [ <cnt> ]\n", db_out);
 117         fputs("n [ <cnt> ]\n", db_out);
 118         fputs("  Execute the next <cnt> or 1 source line(s).\n", db_out);
 119         fputs("  Step (s) steps into function-calls.\n", db_out);
 120         fputs("  Next (n) steps past function-calls.\n", db_out);
 121         return;
 122   case WHERE:
 123         fputs("where [ <cnt> ]\n", db_out);
 124         fputs("w [ <cnt> ]\n", db_out);
 125         fputs("  List all, or the top <cnt> or the bottom -<cnt> active functions.\n", db_out);
 126         return;
 127   case STATUS:
 128         fputs("status\n", db_out);
 129         fputs("  display active traces, stops, whens, displays, and dumps.\n", db_out);
 130         return;
 131   case DELETE:
 132         fputs("delete [ <num> [ , <num> ] ... ]\n", db_out);
 133         fputs("d [ <num> [ , <num> ] ...] \n", db_out);
 134         fputs("  Remove the command(s) corresponding to <num> (as displayed by 'status').\n", db_out);
 135         fputs("  If no <num> is given, remove the current stopping point.\n", db_out);
 136         return;
 137   case SET:
 138         fputs("set <desig> to <exp>\n", db_out);
 139         fputs("  Assign the value of <exp> to <desig>.\n", db_out);
 140         return;
 141   case PRINT:
 142         fputs("print [ <exp> [ , <exp> ] ...]\n", db_out);
 143         fputs("p [ <exp> [ , <exp> ] ...]\n", db_out);
 144         fputs("  Print the value of each <exp>, or repeat the last print command\n", db_out);
 145         return;
 146   case DISPLAY:
 147         fputs("display <exp> [ , <exp> ] ...\n", db_out);
 148         fputs("  Print the value of each <exp> whenever the debuggee stops.\n", db_out);
 149         return;
 150   case DUMP:
 151         fputs("dump\n", db_out);
 152         fputs("  Saves the state of the debuggee; it can be restored with the restore command.\n", db_out);
 153         return;
 154   case RESTORE:
 155         fputs("restore [ <num> ]\n", db_out);
 156         fputs("r [ <num> ]\n", db_out);
 157         fputs("  Restore the state of the dump associated with <num>,\n", db_out);
 158         fputs("  or restore the state of the last dump.\n", db_out);
 159         return;
 160   case TRACE:
 161         fputs("trace [ on <exp> ] [ <pos> ] [ if <cond> ]\n", db_out);
 162         fputs("t [ on <exp> ] [ <pos> ] [ if <cond> ]\n", db_out);
 163         fputs("  Without args, display each source line before execution.\n", db_out);
 164         fputs("  In addition, display <exp> in the on-clause.\n", db_out);
 165         fputs("  If <pos> is given and indicates a function, only display\n", db_out);
 166         fputs("  tracing information while executing this function.\n", db_out);
 167         fputs("  If it indicates a line number, only display tracing information\n", db_out);
 168         fputs("  whenever the source line is reached.\n", db_out);
 169         fputs("  If <cond> is given, only display tracing info when it evaluates to non-zero.\n", db_out);
 170         return;
 171   case FIND:
 172         fputs("find <name>\n", db_out);
 173         fputs("  Prints the fully qualified name of all symbols matching <name>.\n", db_out);
 174         return;
 175   case WHICH:
 176         fputs("which <name>\n", db_out);
 177         fputs("  Prints the fully qualified name of <name>.\n", db_out);
 178         return;
 179   case DISABLE:
 180         fputs("disable [ <num> [ , <num> ] ... ]\n", db_out);
 181         fputs("  Disable the command(s) corresponding to <num> (as displayed by 'status').\n", db_out);
 182         fputs("  If no <num> is given, disable the current stopping point.\n", db_out);
 183         return;
 184   case ENABLE:
 185         fputs("enable [ <num> [ , <num> ] ... ]\n", db_out);
 186         fputs("  Enable the command(s) corresponding to <num> (as displayed by 'status'.)\n", db_out);
 187         fputs("  If no <num> is given, enable the current stopping point (not effective).\n", db_out);
 188         return;
 189   }
 190   else if (p && p->t_str) {
 191         if (! strcmp(p->t_str, "!")) {
 192                 fputs("! <shell command>\n", db_out);
 193                 fputs("  Execute the given shell command.\n", db_out);
 194                 return;
 195         }
 196   }
 197   fputs("cont [ <cnt> ] [ at <line> ]\n", db_out);
 198   fputs("delete [ <num> [ , <num> ] ... ]\n", db_out);
 199   fputs("disable [ <num> [ , <num> ] ... ]\n", db_out);
 200   fputs("display <exp> [ , <exp> ] ...\n", db_out);
 201   fputs("dump\n", db_out);
 202   fputs("enable [ <num> [ , <num> ] ... ]\n", db_out);
 203   fputs("file [ <name> | ? ]\n", db_out);
 204   fputs("find <name>\n", db_out);
 205   fputs("frame [ [ + | - ] <num> ]\n", db_out);
 206   fputs("help [ <commandname> ]\n", db_out);
 207   fputs("list [ <start> | <func> ] [ , <cnt> | - [ <end> ] ]\n", db_out);
 208   fputs("log [ <name> | off ]\n", db_out);
 209   fputs("next [ <cnt> ]\n", db_out);
 210   fputs("print [ <exp> [ , <exp> ] ... ]\n", db_out);
 211   fputs("rerun [ ? ]\n", db_out);
 212   fputs("restore [ <num> ]\n", db_out);
 213   fputs("run [ <args> ] [ < <infile> ] [ > <outfile> ]\n", db_out);
 214   fputs("set <desig> to <exp>\n", db_out);
 215   fputs("source <filename>\n", db_out);
 216   fputs("status\n", db_out);
 217   fputs("step [ <cnt> ]\n", db_out);
 218   fputs("stop [ <pos> ] [ if <cond> ]\n", db_out);
 219   fputs("trace [ on <exp> ] [ <pos> ] [ if <cond> ]\n", db_out);
 220   fputs("when [ <pos> ] [ if <cond> ] { <command> [ ; <command> ] ... } \n", db_out);
 221   fputs("where [ <cnt> ]\n", db_out);
 222   fputs("which <name>\n", db_out);
 223   fputs("! <shell command>\n", db_out);
 224 }
 225
 226 /* ------------------------------------------------------------- */
 227
 228 /* implementation of dump/restore commands */
 229
 230 extern p_tree   get_from_item_list();
 231 extern t_addr   get_dump();
 232
 233 struct dump {
 234   char  *globals, *stack;
 235   struct dump *next;
 236 };
 237
 238 static struct dump      *last_dump;
 239
 240 do_dump(p)
 241   p_tree        p;
 242 {
 243   struct dump *d = (struct dump *) malloc(sizeof(struct dump));
 244
 245   if (! d) {
 246         error("could not allocate enough memory");
 247         return;
 248   }
 249   p->t_address = get_dump(&d->globals, &d->stack);
 250   if (! p->t_address) {
 251         free((char *) d);
 252         return;
 253   }
 254   p->t_args[0] = (struct tree *) d;
 255   add_to_item_list(p);
 256   d->next = last_dump;
 257   last_dump = d;
 258 }
 259
 260 do_restore(p)
 261   p_tree        p;
 262 {
 263   struct dump *d;
 264
 265   if (p->t_args[0]) {
 266         p = get_from_item_list((int) p->t_args[0]->t_ival);
 267         if (!p || p->t_oper != OP_DUMP) {
 268                 error("no such dump");
 269                 return;
 270         }
 271         d = (struct dump *) p->t_args[0];
 272   }
 273   else  d = last_dump;
 274
 275   if (! d) {
 276         error("no dumps");
 277         return;
 278   }
 279
 280   if (! put_dump(d->globals, d->stack)) {
 281         error("restoring failed");
 282   }
 283   perform_items();
 284 }
 285
 286 free_dump(p)
 287   p_tree        p;
 288 {
 289   struct dump *d = (struct dump *) p->t_args[0];
 290
 291   free(d->globals);
 292   free(d->stack);
 293   if (d == last_dump) last_dump = d->next;
 294   else {
 295         register struct dump *d1 = last_dump;
 296
 297         while (d1->next != d) d1 = d1->next;
 298         d1->next = d->next;
 299   }
 300   free((char *) d);
 301 }
 302
 303 /* ------------------------------------------------------------- */
 304
 305 /* implementation of the find command */
 306
 307 do_find(p)
 308   p_tree        p;
 309 {
 310   /* Print all identifications of p->t_args[0]. */
 311   register p_symbol s;
 312   p_tree        arg;
 313
 314   p = p->t_args[0];
 315   switch(p->t_oper) {
 316   case OP_NAME:
 317         s = p->t_idf->id_def;
 318         while (s) {
 319                 pr_sym(s);
 320                 s = s->sy_next;
 321         }
 322         break;
 323
 324   case OP_SELECT:
 325         arg = p->t_args[1];
 326         assert(arg->t_oper == OP_NAME);
 327         s = arg->t_idf->id_def;
 328         while (s) {
 329                 if (consistent(p, s->sy_scope)) {
 330                         pr_sym(s);
 331                 }
 332                 s = s->sy_next;
 333         }
 334         break;
 335
 336   default:
 337         assert(0);
 338   }
 339 }
 340
 341 /* ------------------------------------------------------------- */
 342
 343 /* implementation of the which command */
 344
 345 do_which(p)
 346   p_tree        p;
 347 {
 348   p_symbol      sym = identify(p->t_args[0], 0xffff);
 349
 350   if ( sym) pr_sym(sym);
 351 }
 352
 353 /* ------------------------------------------------------------- */
 354
 355 /* implementation of the list command */
 356
 357 extern t_addr   get_addr_from_node();
 358
 359 do_list(p)
 360   p_tree        p;
 361 {
 362   int   l1, l2;
 363   static int wsize = 10;
 364
 365   if (p->t_args[1]) {
 366         l2 = p->t_args[1]->t_ival;
 367         if (l2 >= 0) {
 368                 if (l2 == 0) l2 = 1;
 369                 wsize = l2;
 370         }
 371   }
 372   else l2 = wsize;
 373
 374   if (! p->t_args[0]) {
 375         l1 = listline;
 376         if (! l1) {
 377                 listline = currline - (wsize/2);
 378                 l1 = listline;
 379         }
 380   }
 381   else {
 382         if (p->t_args[0]->t_oper == OP_AT) {
 383                 l1 = p->t_args[0]->t_lino;
 384                 if (p->t_args[0]->t_filename) {
 385                         newfile(str2idf(p->t_args[0]->t_filename, 0));
 386                 }
 387         }
 388         else {
 389                 t_addr  a = get_addr_from_node(p->t_args[0]);
 390                 p_position pos;
 391                 p_symbol oldlistfile = listfile;
 392
 393                 if (a == ILL_ADDR) {
 394                         return;
 395                 }
 396                 pos = get_position_from_addr(a);
 397                 newfile(str2idf(pos->filename, 1));
 398                 if (listfile != oldlistfile) {
 399                         warning("switching to file %s", listfile->sy_idf->id_text);
 400                 }
 401                 l1 = pos->lineno - (l2 > 0 ? l2 : wsize)/2;
 402                 if (l1 < 1) l1 = 1;
 403         }
 404   }
 405   if (listfile) {
 406         if (l2 < 0) {
 407                 l2 = -l2;
 408                 if (l1 > l2) l2 = 1;
 409                 else l2 -= l1 - 1;
 410         }
 411         lines(listfile->sy_file, l1, l2);
 412         listline = l1 + l2;
 413   }
 414   else error("no current file");
 415 }
 416
 417 /* ------------------------------------------------------------- */
 418
 419 /* implementation of the file command */
 420
 421 do_file(p)
 422   p_tree        p;
 423 {
 424   FILE  *f;
 425
 426   if (p->t_args[0]) {
 427         if (! strcmp(p->t_args[0]->t_str, "?")) {
 428                 register p_symbol       sym = PervasiveScope->sc_symbs;
 429
 430                 while (sym) {
 431                         if (sym->sy_class == FILESYM) {
 432                                 fprintf(db_out, "%s\n", sym->sy_idf->id_text);
 433                         }
 434                         sym = sym->sy_prev_sc;
 435                 }
 436                 return;
 437         }
 438         if ((f = fopen(p->t_args[0]->t_str, "r")) == NULL) {
 439                 error("could not open %s", p->t_args[0]->t_str);
 440                 return;
 441         }
 442         fclose(f);
 443         newfile(p->t_args[0]->t_idf);
 444   }
 445   else if (listfile) fprintf(db_out, "%s\n", listfile->sy_idf->id_text);
 446   else error("no current file");
 447 }
 448
 449 /* ------------------------------------------------------------- */
 450
 451 /* implementation of stop/when command */
 452
 453 setstop(p, kind)
 454   p_tree        p;
 455   int           kind;
 456 {
 457   t_addr        a = get_addr_from_node(p->t_args[0]);
 458
 459   if (a == ILL_ADDR) return 0;
 460
 461   p->t_address = a;
 462   if (a != NO_ADDR) {
 463         if (! set_or_clear_breakpoint(a, kind)) {
 464                 return 0;
 465         }
 466   }
 467   return 1;
 468 }
 469
 470 do_stop(p)
 471   p_tree        p;
 472 {
 473   if (! setstop(p, 1)) {
 474         return;
 475   }
 476   add_to_item_list(p);
 477 }
 478
 479 /* ------------------------------------------------------------- */
 480
 481 /* implementation of the trace command */
 482
 483 settrace(p, kind)
 484   p_tree        p;
 485   int           kind;
 486 {
 487   t_addr        a, e;
 488
 489   a = get_addr_from_node(p->t_args[0]);
 490   if (a == NO_ADDR) return 1;
 491   if (a == ILL_ADDR) return 0;
 492   if (p->t_args[0]->t_oper == OP_AT) {
 493         e = a;
 494         p->t_address = a;
 495   }
 496   else {
 497         p_scope sc = get_next_scope_from_addr(a+1);
 498
 499         if (sc) e = sc->sc_start - 1;
 500         else e = 0xffffffff;
 501   }
 502   return set_or_clear_trace(a, e, kind);
 503 }
 504
 505 do_trace(p)
 506   p_tree        p;
 507 {
 508   p->t_address = NO_ADDR;
 509   if (! settrace(p, 1)) {
 510         return;
 511   }
 512   add_to_item_list(p);
 513 }
 514
 515 /* ------------------------------------------------------------- */
 516
 517 /* implementation of the enable/disable commands */
 518
 519 static
 520 able(p, kind)
 521   p_tree        p;
 522   int           kind;
 523 {
 524   if (!p) {
 525         able_item(0, kind);
 526         return;
 527   }
 528   switch(p->t_oper) {
 529   case OP_LINK:
 530         able(p->t_args[0], kind);
 531         able(p->t_args[1], kind);
 532         break;
 533   case OP_INTEGER:
 534         able_item((int)p->t_ival, kind);
 535         break;
 536   default:
 537         assert(0);
 538   }
 539 }
 540
 541 do_enable(p)
 542   p_tree        p;
 543 {
 544   able(p->t_args[0], 0);
 545 }
 546
 547 do_disable(p)
 548   p_tree        p;
 549 {
 550   able(p->t_args[0], 1);
 551 }
 552
 553 /* ------------------------------------------------------------- */
 554
 555 /* implementation of the cont command */
 556
 557 do_continue(p)
 558   p_tree        p;
 559 {
 560   int count;
 561
 562   if (p) {
 563         count = p->t_args[0]->t_ival;
 564         if (p->t_args[1]) {
 565                 t_addr  a = get_addr_from_position(&(p->t_args[1]->t_pos));
 566                 p_scope sc = get_scope_from_addr(a);
 567
 568                 if (a == ILL_ADDR || base_scope(sc) != base_scope(CurrentScope)) {
 569                         error("cannot continue at line %d",
 570                               p->t_args[1]->t_lino);
 571                         return;
 572                 }
 573                 if (! set_pc(a)) {
 574                         return;
 575                 }
 576         }
 577   }
 578   else count = 1;
 579   while (count--) {
 580         if (! send_cont(count==0)) {
 581                 break;
 582         }
 583   }
 584   if (count > 0) {
 585         fprintf(db_out, "Only %ld breakpoints skipped\n",
 586                 p->t_args[0]->t_ival - count);
 587   }
 588 }
 589
 590 /* ------------------------------------------------------------- */
 591
 592 /* implementation of the step command */
 593
 594 do_step(p)
 595   p_tree        p;
 596 {
 597   p = p->t_args[0];
 598   if (! singlestep(0, p ? p->t_ival : 1L)) {
 599   }
 600 }
 601
 602 /* ------------------------------------------------------------- */
 603
 604 /* implementation of the next command */
 605
 606 do_next(p)
 607   p_tree        p;
 608 {
 609   p = p->t_args[0];
 610   if (! singlestep(1, p? p->t_ival : 1L)) {
 611   }
 612 }
 613
 614 extern t_addr   *get_EM_regs();
 615
 616 /* ------------------------------------------------------------- */
 617
 618 /* implementation of the regs command (temporarily) */
 619
 620 do_regs(p)
 621   p_tree        p;
 622 {
 623   t_addr        *buf;
 624   int           n = 0;
 625
 626   p = p->t_args[0];
 627   if (p) n = p->t_ival;
 628   if (! (buf = get_EM_regs(n))) {
 629         return;
 630   }
 631   fprintf(db_out, "EM registers %d levels back:\n", n);
 632   fprintf(db_out, "\tLocalBase =\t0x%lx\n\tArgumentBase =\t0x%lx\n",
 633                 (long) buf[0], (long) buf[1]);
 634   fprintf(db_out, "\tProgramCounter=\t0x%lx\n\tHeapPointer = \t0x%lx\n",
 635                 (long) buf[2],
 636                 (long) buf[3]);
 637   fprintf(db_out, "\tStackPointer =\t0x%lx\n", (long) buf[4]);
 638 }
 639
 640 /* ------------------------------------------------------------- */
 641
 642 /* implementation of the where command */
 643
 644 static t_addr   where_PC;
 645
 646 static int
 647 where_entry(num)
 648   int   num;
 649 {
 650   t_addr *buf;
 651   t_addr AB;
 652   p_scope sc;
 653
 654   if (! (buf = get_EM_regs(num))) return 0;
 655   AB = buf[1];
 656   where_PC = buf[2];
 657   if (! AB) return 0;
 658   sc = base_scope(get_scope_from_addr(where_PC));
 659   if (! sc || sc->sc_start > where_PC) return 0;
 660   fprintf(db_out, "%s(", sc->sc_definedby->sy_idf->id_text);
 661   print_params(sc->sc_definedby->sy_type, AB, has_static_link(sc));
 662   fputs(") ", db_out);
 663   (void) print_position(where_PC, 0);
 664   fputs("\n", db_out);
 665   return 1;
 666 }
 667
 668 /*ARGSUSED*/
 669 do_where(p)
 670   p_tree        p;
 671 {
 672   int i = 0;
 673   unsigned int cnt;
 674   unsigned int maxcnt = 0xffff;
 675   p_scope sc;
 676   t_addr *buf;
 677   t_addr PC;
 678
 679   p = p->t_args[0];
 680   if (p && p->t_ival < 0) {
 681         for (;;) {
 682                 buf = get_EM_regs(i++);
 683                 if (! buf || ! buf[1]) break;
 684                 PC = buf[2];
 685                 sc = base_scope(get_scope_from_addr(PC));
 686                 if (! sc || sc->sc_start > PC) break;
 687                 if (interrupted) return;
 688         }
 689         i--;
 690         maxcnt = - p->t_ival;
 691         i -= maxcnt;
 692         if (i < 0) i = 0;
 693   }
 694   else if (p) maxcnt = p->t_ival;
 695   for (cnt = maxcnt; cnt != 0; cnt--) {
 696         if (interrupted) return;
 697         if (! where_entry(i++)) return;
 698   }
 699 }
 700
 701 /* ------------------------------------------------------------- */
 702
 703 /* implementation of the delete command */
 704
 705 do_delete(p)
 706   p_tree        p;
 707 {
 708   switch(p->t_oper) {
 709   case OP_DELETE:
 710         if (! p->t_args[0]) {
 711                 remove_from_item_list(0);
 712         }
 713         else do_delete(p->t_args[0]);
 714         break;
 715   case OP_LINK:
 716         do_delete(p->t_args[0]);
 717         do_delete(p->t_args[1]);
 718         break;
 719   case OP_INTEGER:
 720         remove_from_item_list((int) p->t_ival);
 721         break;
 722   default:
 723         assert(0);
 724   }
 725 }
 726
 727 /* ------------------------------------------------------------- */
 728
 729 /* implementation of the print command */
 730
 731 do_print(p)
 732   p_tree        p;
 733 {
 734   char  *buf = 0;
 735   char *format = 0;
 736   long  size;
 737   p_type tp;
 738
 739   switch(p->t_oper) {
 740   case OP_PRINT:
 741         if (p->t_args[0] == 0) {
 742                 p = print_command;
 743                 if (p == 0) {
 744                         error("no previous print command");
 745                         break;
 746                 }
 747         }
 748         else if (p != print_command) {
 749                 /* freenode(print_command); No, could be in when-list */
 750                 print_command = p;
 751         }
 752         /* fall through */
 753   case OP_DISPLAY:
 754         do_print(p->t_args[0]);
 755         break;
 756   case OP_LINK:
 757         do_print(p->t_args[0]);
 758         do_print(p->t_args[1]);
 759         break;
 760   default:
 761         if (interrupted || ! eval_expr(p, &buf, &size, &tp)) return;
 762         print_node(db_out, p, 0);
 763         fputs(" = ", db_out);
 764         if (p->t_oper == OP_FORMAT) {
 765                 format = p->t_args[1]->t_str;
 766         }
 767         print_val(tp, size, buf, 0, 0, format);
 768         if (buf) free(buf);
 769         fputs("\n", db_out);
 770         break;
 771   }
 772 }
 773
 774 /* ------------------------------------------------------------- */
 775
 776 /* implementation of the set command */
 777
 778 do_set(p)
 779   p_tree        p;
 780 {
 781   char  *buf = 0;
 782   long  size, size2;
 783   p_type tp, tp2;
 784   t_addr a;
 785
 786   if (interrupted || ! eval_desig(p->t_args[0], &a, &size, &tp) ||
 787       ! eval_expr(p->t_args[1], &buf, &size2, &tp2) ||
 788       ! convert(&buf, &size2, &tp2, tp, size)) {
 789         if (buf) free(buf);
 790         return;
 791   }
 792
 793   if (interrupted) {
 794         free(buf);
 795         return;
 796   }
 797   set_bytes(size, buf, a);
 798   free(buf);
 799 }
 800
 801 /* ------------------------------------------------------------- */
 802
 803 /* implementation of the source command */
 804
 805 extern FILE     *db_in;
 806
 807 do_source(p)
 808   p_tree        p;
 809 {
 810   FILE          *old_db_in = db_in;
 811
 812   p = p->t_args[0];
 813   if ((db_in = fopen(p->t_str, "r")) == NULL) {
 814         db_in = old_db_in;
 815         error("could not open %s", p->t_str);
 816         return;
 817   }
 818   Commands();
 819   fclose(db_in);
 820   db_in = old_db_in;
 821 }
 822
 823 /* ------------------------------------------------------------- */
 824
 825 do_prcomm(p)
 826   p_tree        p;
 827 {
 828   print_node(db_out, p->t_args[0], 1);
 829 }
 830
 831 /* ------------------------------------------------------------- */
 832
 833 /* stack frame commands: frame, down, up */
 834
 835 extern int      stack_offset;
 836
 837 static
 838 frame_pos(diff)
 839   int   diff;
 840 {
 841   if (stack_offset+diff < 0) diff = - stack_offset;
 842   if (! where_entry(stack_offset+diff)) {
 843         error("no frame %d", stack_offset+diff);
 844         return;
 845   }
 846   stack_offset += diff;
 847   list_position(get_position_from_addr(where_PC));
 848   CurrentScope = get_scope_from_addr(where_PC);
 849 }
 850
 851 do_frame(p)
 852   p_tree        p;
 853 {
 854   if (p->t_args[0]) {
 855         frame_pos((int) p->t_args[0]->t_ival - stack_offset);
 856   }
 857   else frame_pos(0);
 858 }
 859
 860 do_up(p)
 861   p_tree        p;
 862 {
 863   if (p->t_args[0]) {
 864         frame_pos((int) p->t_args[0]->t_ival);
 865   }
 866   else frame_pos(1);
 867 }
 868
 869 do_down(p)
 870   p_tree        p;
 871 {
 872   if (p->t_args[0]) {
 873         frame_pos(-(int) p->t_args[0]->t_ival);
 874   }
 875   else frame_pos(-1);
 876 }
 877
 878 /* ------------------------------------------------------------- */
 879
 880 /* log command */
 881
 882 static char     *logfile;
 883 static FILE     *logfd;
 884
 885 do_log(p)
 886   p_tree        p;
 887 {
 888   p = p->t_args[0];
 889   if (p) {
 890         if (logfd && ! strcmp(p->t_str, "off")) {
 891                 fprintf(db_out, "stopped logging on %s\n", logfile);
 892                 fclose(logfd);
 893                 logfd = NULL;
 894                 return;
 895         }
 896         if (logfd) {
 897                 error("already logging on %s", logfile);
 898                 return;
 899         }
 900         logfile = p->t_str;
 901         if ((logfd = fopen(logfile, "w")) == NULL) {
 902                 error("could not open %s", logfile);
 903                 return;
 904         }
 905         fprintf(db_out, "started logging on %s\n", logfile);
 906   }
 907   else if (logfd) {
 908         fprintf(db_out, "the current logfile is %s\n", logfile);
 909   }
 910   else {
 911         error("no current logfile");
 912   }
 913 }
 914
 915 extern int      item_count;
 916 extern int      in_wheninvoked;
 917
 918 enterlog(p)
 919   p_tree        p;
 920 {
 921   register p_tree       p1;
 922
 923   if (logfd && ! in_wheninvoked) {
 924         switch(p->t_oper) {
 925         case OP_SOURCE:
 926         case OP_LOG:
 927                 break;
 928         case OP_DELETE:
 929         case OP_ENABLE:
 930         case OP_DISABLE:
 931         case OP_RESTORE:
 932                 /* Change absolute item numbers into relative ones
 933                    for safer replay
 934                 */
 935                 p1 = p->t_args[0];
 936                 while (p1 && p1->t_oper == OP_LINK) {
 937                         register p_tree p2 = p1->t_args[0];
 938                         if (p2->t_ival > 0 && p2->t_ival <= item_count) {
 939                                 p2->t_ival = p2->t_ival - item_count - 1;
 940                         }
 941                         p1 = p1->t_args[1];
 942                 }
 943                 if (p1 && p1->t_ival > 0 && p1->t_ival <= item_count) {
 944                         p1->t_ival = p1->t_ival - item_count - 1;
 945                 }
 946                 /* Fall through */
 947         default:
 948                 print_node(logfd, p, 1);
 949                 fflush(logfd);
 950                 break;
 951         }
 952   }
 953 }