Many more changes
authorceriel <none@none>
Tue, 6 Nov 1990 12:23:41 +0000 (12:23 +0000)
committerceriel <none@none>
Tue, 6 Nov 1990 12:23:41 +0000 (12:23 +0000)
14 files changed:
util/grind/c.c
util/grind/char.ct
util/grind/commands.g
util/grind/do_comm.c
util/grind/expr.c
util/grind/itemlist.cc
util/grind/main.c
util/grind/modula-2.c
util/grind/operators.ot
util/grind/position.h
util/grind/print.c
util/grind/run.c
util/grind/tokenname.c
util/grind/tree.c

index 3c63709..bdbc570 100644 (file)
@@ -70,35 +70,36 @@ static struct langdep c = {
 struct langdep *c_dep = &c;
 
 static int
-printchar(c, esc)
+printchar(f, c, esc)
+  FILE *f;
   int  c;
 {
   c &= 0377;
   switch(c) {
   case '\n':
-       fputs("\\n", db_out);
+       fputs("\\n", f);
        break;
   case '\t':
-       fputs("\\t", db_out);
+       fputs("\\t", f);
        break;
   case '\b':
-       fputs("\\b", db_out);
+       fputs("\\b", f);
        break;
   case '\r':
-       fputs("\\r", db_out);
+       fputs("\\r", f);
        break;
   case '\f':
-       fputs("\\f", db_out);
+       fputs("\\f", f);
        break;
   case '\\':
-       fputs("\\\\", db_out);
+       fputs("\\\\", f);
        break;
   case '\'':
   case '"':
-       fprintf(db_out, c == esc ? "\\%c" : "%c", c);
+       fprintf(f, c == esc ? "\\%c" : "%c", c);
        break;
   default:
-       fprintf(db_out, (c >= 040 && c < 0177) ? "%c" : "\\%03o", c);
+       fprintf(f, (c >= 040 && c < 0177) ? "%c" : "\\%03o", c);
        break;
   }
 }
@@ -108,20 +109,21 @@ print_char(c)
   int  c;
 {
   putc('\'', db_out);
-  printchar(c, '\'');
+  printchar(db_out, c, '\'');
   putc('\'', db_out);
 }
 
 static int
-print_string(s, len)
+print_string(f, s, len)
+  FILE *f;
   char *s;
   int  len;
 {
   register char        *str = s;
 
-  putc('"', db_out);
-  while (*str && len-- > 0) printchar(*str++, '"');
-  putc('"', db_out);
+  putc('"', f);
+  while (*str && len-- > 0) printchar(f, *str++, '"');
+  putc('"', f);
 }
 
 extern long    int_size;
@@ -463,124 +465,125 @@ get_string(c)
 }
 
 static int
-print_op(p)
+print_op(f, p)
+  FILE         *f;
   p_tree       p;
 {
   switch(p->t_oper) {
   case OP_UNOP:
        switch(p->t_whichoper) {
        case E_MIN:
-               fputs("-(", db_out);
-               print_node(p->t_args[0], 0);
-               putc(')', db_out);
+               fputs("-(", f);
+               print_node(f, p->t_args[0], 0);
+               putc(')', f);
                break;
        case E_PLUS:
-               fputs("+(", db_out);
-               print_node(p->t_args[0], 0);
-               putc(')', db_out);
+               fputs("+(", f);
+               print_node(f, p->t_args[0], 0);
+               putc(')', f);
                break;
        case E_NOT:
-               fputs("!(", db_out);
-               print_node(p->t_args[0], 0);
-               putc(')', db_out);
+               fputs("!(", f);
+               print_node(f, p->t_args[0], 0);
+               putc(')', f);
                break;
        case E_DEREF:
-               fputs("*(", db_out);
-               print_node(p->t_args[0], 0);
-               putc(')', db_out);
+               fputs("*(", f);
+               print_node(f, p->t_args[0], 0);
+               putc(')', f);
                break;
        case E_BNOT:
-               fputs("~(", db_out);
-               print_node(p->t_args[0], 0);
-               putc(')', db_out);
+               fputs("~(", f);
+               print_node(f, p->t_args[0], 0);
+               putc(')', f);
                break;
        case E_ADDR:
-               fputs("&(", db_out);
-               print_node(p->t_args[0], 0);
-               putc(')', db_out);
+               fputs("&(", f);
+               print_node(f, p->t_args[0], 0);
+               putc(')', f);
                break;
        }
        break;
   case OP_BINOP:
        if (p->t_whichoper == E_ARRAY) {
-               print_node(p->t_args[0], 0);
-               fputs("[", db_out);
-               print_node(p->t_args[1], 0);
-               fputs("]", db_out);
+               print_node(f, p->t_args[0], 0);
+               fputs("[", f);
+               print_node(f, p->t_args[1], 0);
+               fputs("]", f);
                break;
        }
        if (p->t_whichoper == E_DERSELECT) {
-               print_node(p->t_args[0], 0);
-               fputs("->", db_out);
-               print_node(p->t_args[1], 0);
+               print_node(f, p->t_args[0], 0);
+               fputs("->", f);
+               print_node(f, p->t_args[1], 0);
                break;
        }
        if (p->t_whichoper == E_SELECT) {
-               print_node(p->t_args[0], 0);
-               fputs(".", db_out);
-               print_node(p->t_args[1], 0);
+               print_node(f, p->t_args[0], 0);
+               fputs(".", f);
+               print_node(f, p->t_args[1], 0);
                break;
        }
-       fputs("(", db_out);
-       print_node(p->t_args[0], 0);
+       fputs("(", f);
+       print_node(f, p->t_args[0], 0);
        switch(p->t_whichoper) {
        case E_LSFT:
-               fputs("<<", db_out);
+               fputs("<<", f);
                break;
        case E_RSFT:
-               fputs(">>", db_out);
+               fputs(">>", f);
                break;
        case E_AND:
-               fputs("&&", db_out);
+               fputs("&&", f);
                break;
        case E_BAND:
-               fputs("&", db_out);
+               fputs("&", f);
                break;
        case E_OR:
-               fputs("||", db_out);
+               fputs("||", f);
                break;
        case E_BOR:
-               fputs("|", db_out);
+               fputs("|", f);
                break;
        case E_BXOR:
-               fputs("^", db_out);
+               fputs("^", f);
                break;
        case E_ZDIV:
-               fputs("/", db_out);
+               fputs("/", f);
                break;
        case E_ZMOD:
-               fputs("%", db_out);
+               fputs("%", f);
                break;
        case E_PLUS:
-               fputs("+", db_out);
+               fputs("+", f);
                break;
        case E_MIN:
-               fputs("-", db_out);
+               fputs("-", f);
                break;
        case E_MUL:
-               fputs("*", db_out);
+               fputs("*", f);
                break;
        case E_EQUAL:
-               fputs("==", db_out);
+               fputs("==", f);
                break;
        case E_NOTEQUAL:
-               fputs("!=", db_out);
+               fputs("!=", f);
                break;
        case E_LTEQUAL:
-               fputs("<=", db_out);
+               fputs("<=", f);
                break;
        case E_GTEQUAL:
-               fputs(">=", db_out);
+               fputs(">=", f);
                break;
        case E_LT:
-               fputs("<", db_out);
+               fputs("<", f);
                break;
        case E_GT:
-               fputs(">", db_out);
+               fputs(">", f);
                break;
        }
-       print_node(p->t_args[1], 0);
-       fputs(")", db_out);
+       print_node(f, p->t_args[1], 0);
+       fputs(")", f);
        break;
   }
 }
index 41882de..26c7d82 100644 (file)
@@ -12,7 +12,7 @@ STIDF:a-zA-Z_
 STSTR:"'
 STDOT:.
 STNUM:0-9
-STSIMP:-,!<>{}:`?\\
+STSIMP:-+,!<>{}:`?\\
 %T#include "class.h"
 %Tchar tkclass[] = {
 %p
index dd0fffb..72bac4a 100644 (file)
@@ -56,10 +56,11 @@ commands
                                        lastcom = 0;
                                }
                                if (errorgiven) {
-                                       freenode(com);
+                                       if (com != run_command) freenode(com);
                                        com = 0;
                                }
                                else {
+                                       log(com);
                                        eval(com);
                                        if (repeatable(com)) {
                                                lastcom = com;
@@ -72,6 +73,7 @@ commands
                                        }
                                }
                          } else if (lastcom && ! errorgiven) {
+                               log(lastcom);
                                eval(lastcom);
                          }
                          if (give_prompt) {
@@ -81,7 +83,6 @@ commands
                          }
                        }
   ]*
-                       { signal_child(SIGKILL); }
 ;
 
 command_line(p_tree *p;)
@@ -111,20 +112,48 @@ command_line(p_tree *p;)
 | WHICH qualified_name(p){ *p = mknode(OP_WHICH, *p); }
 | able_command(p)
 | '!'                  { shellescape();
-                         errorgiven = 1; /* to prevent execution of lastcomm */
+                         *p = mknode(OP_SHELL);
                        }
+| source_command(p)
+| log_command(p)
+| frame_command(p)
 |
 ]
 ;
 
+frame_command(p_tree   *p;)
+:
+  FRAME 
+  [                    { *p = mknode(OP_FRAME, (p_tree) 0); }
+  | count(p)           { *p = mknode(OP_FRAME, *p); }
+  | '-' count(p)       { *p = mknode(OP_DOWN, *p); }
+  | '+' count(p)       { *p = mknode(OP_UP, *p); }
+  ]
+;
 
-where_command(p_tree *p;)
+source_command(p_tree *p;)
+:
+  SOURCE               { extended_charset = 1; }
+  name(p)              { (*p)->t_idf = str2idf((*p)->t_str, 0); }
+                       { *p = mknode(OP_SOURCE, *p);
+                         extended_charset = 0;
+                       }
+;
+
+log_command(p_tree *p;)
 :
-  WHERE                        { *p = mknode(OP_WHERE, (p_tree) 0); }
-  [ count(&(*p)->t_args[0])?
-  | '-' count(&(*p)->t_args[0])
-                       { (*p)->t_args[0]->t_ival = - (*p)->t_args[0]->t_ival; }
+  LOG                  { extended_charset = 1; }
+  [ name(p)            { (*p)->t_idf = str2idf((*p)->t_str, 0); }
+  |                    { *p = 0; }
   ]
+                       { *p = mknode(OP_LOG, *p);
+                         extended_charset = 0;
+                       }
+;
+
+where_command(p_tree *p;)
+:
+  WHERE opt_num(p)     { *p = mknode(OP_WHERE, *p); }
 ;
 
 list_command(p_tree *p;)
@@ -161,6 +190,7 @@ help_command(p_tree *p;)
                        { *p = mknode(OP_HELP, (p_tree) 0); }
   [ name(&(*p)->t_args[0])?
   | '?'                        { (*p)->t_args[0] = mknode(OP_NAME, str2idf("help",0), (char *) 0); }
+  | '!'                        { (*p)->t_args[0] = mknode(OP_NAME, (struct idf *) 0, "!"); }
   ]
 ;
 
@@ -175,6 +205,9 @@ run_command(p_tree *p;)
                          }
                          else *p = run_command;
                        }
+  [ '?'                        { *p = mknode(OP_PRCOMM, *p); }
+  |
+  ]
 ;
 
 stop_command(p_tree *p;)
@@ -447,6 +480,15 @@ count(p_tree *p;)
   INTEGER              { *p = mknode(OP_INTEGER, tok.ival); }
 ;
 
+opt_num(p_tree *p;)
+:
+  count(p)
+|
+  '-' count(p)         { (*p)->t_ival = - (*p)->t_ival; }
+|
+                       { *p = 0; }
+;
+
 qualified_name(p_tree *p;)
 :
   name(p)
@@ -487,6 +529,9 @@ name(p_tree *p;)
   | HELP
   | DISABLE
   | ENABLE
+  | SOURCE
+  | FRAME
+  | LOG
   ]                    { *p = mknode(OP_NAME, tok.idf, tok.str); }
 ;
 
index 1be86d1..41b394b 100644 (file)
@@ -25,6 +25,12 @@ extern int   interrupted;
 
 p_tree         print_command;
 
+/*ARGSUSED*/
+do_noop(p)
+  p_tree       p;
+{
+}
+
 /* ------------------------------------------------------------- */
 
 /* implementation of the help command */
@@ -49,9 +55,27 @@ do_help(p)
        fputs("  <wsize> is the last <cnt> given, or 10.\n", db_out);
        return;
   case XFILE:
-       fputs("file [ <name> ]\n", db_out);
+       fputs("file [ <name> | ? ]\n", db_out);
        fputs("  Print the name of the current source file, or change the\n", db_out);
-       fputs("  current source file to <name>.\n", db_out);
+       fputs("  current source file to <name>, or print the files that\n", db_out);
+       fputs("  the debugger knows about.\n", db_out);
+       return;
+  case SOURCE:
+       fputs("source <filename>\n", db_out);
+       fputs("  Read commands from the file <filename>\n", db_out);
+       return;
+  case FRAME:
+       fputs("frame [ [ + | - ] <num> ]\n", db_out);
+       fputs("  Sets the 'current' frame to frame <num>. The currently active\n", db_out);
+       fputs("  procedure has frame 0. If <num> is not given, print the 'current' frame.\n", db_out);
+       fputs("  If <num> is given with a + or -, go up or down <num> frames relative\n", db_out);
+       fputs("  to the current one.\n", db_out);
+       return;
+  case LOG:
+       fputs("log [ <name> | off ]\n", db_out);
+       fputs("  Creates a logfile <name> of the commands given.\n", db_out);
+       fputs("  When no argument is given, the current logfile is printed.\n", db_out);
+       fputs("  If the argument is 'off', logging is turned off.\n", db_out);
        return;
   case RUN:
        fputs("run [ <args> ] [ < <infile> ] [ > <outfile> ]\n", db_out);
@@ -59,8 +83,9 @@ do_help(p)
        fputs("  possible redirection of standard input and/or standard output.\n", db_out);
        return;
   case RERUN:
-       fputs("rerun\n", db_out);
-       fputs("  repeats the last run command.\n", db_out);
+       fputs("rerun [ ? ]\n", db_out);
+       fputs("  If the ? is given, prints the last run command;\n", db_out);
+       fputs("  otherwise repeats the last run command.\n", db_out);
        return;
   case STOP:
        fputs("stop [ <pos> ] [ if <cond> ]\n", db_out);
@@ -112,9 +137,9 @@ do_help(p)
        fputs("  Assign the value of <exp> to <desig>.\n", db_out);
        return;
   case PRINT:
-       fputs("print <exp> [ , <exp> ] ...\n", db_out);
-       fputs("p <exp> [ , <exp> ] ...\n", db_out);
-       fputs("  Print the value of each <exp>.\n", db_out);
+       fputs("print [ <exp> [ , <exp> ] ...]\n", db_out);
+       fputs("p [ <exp> [ , <exp> ] ...]\n", db_out);
+       fputs("  Print the value of each <exp>, or repeat the last print command\n", db_out);
        return;
   case DISPLAY:
        fputs("display <exp> [ , <exp> ] ...\n", db_out);
@@ -160,22 +185,32 @@ do_help(p)
        fputs("  If no <num> is given, enable the current stopping point (not effective).\n", db_out);
        return;
   }
+  else if (p && p->t_str) {
+       if (! strcmp(p->t_str, "!")) {
+               fputs("! <shell command>\n", db_out);
+               fputs("  Execute the given shell command.\n", db_out);
+               return;
+       }
+  }
   fputs("cont [ <cnt> ] [ at <line> ]\n", db_out);
   fputs("delete [ <num> [ , <num> ] ... ]\n", db_out);
   fputs("disable [ <num> [ , <num> ] ... ]\n", db_out);
   fputs("display <exp> [ , <exp> ] ...\n", db_out);
   fputs("dump\n", db_out);
   fputs("enable [ <num> [ , <num> ] ... ]\n", db_out);
-  fputs("file [ <name> ]\n", db_out);
+  fputs("file [ <name> | ? ]\n", db_out);
   fputs("find <name>\n", db_out);
+  fputs("frame [ [ + | - ] <num> ]\n", db_out);
   fputs("help [ <commandname> ]\n", db_out);
   fputs("list [ <start> | <func> ] [ , <cnt> | - [ <end> ] ]\n", db_out);
+  fputs("log [ <name> | off ]\n", db_out);
   fputs("next [ <cnt> ]\n", db_out);
-  fputs("print <exp> [ , <exp> ] ...\n", db_out);
-  fputs("rerun\n", db_out);
-  fputs("restore <num>\n", db_out);
+  fputs("print [ <exp> [ , <exp> ] ... ]\n", db_out);
+  fputs("rerun [ ? ]\n", db_out);
+  fputs("restore [ <num> ]\n", db_out);
   fputs("run [ <args> ] [ < <infile> ] [ > <outfile> ]\n", db_out);
   fputs("set <desig> to <exp>\n", db_out);
+  fputs("source <filename>\n", db_out);
   fputs("status\n", db_out);
   fputs("step [ <cnt> ]\n", db_out);
   fputs("stop [ <pos> ] [ if <cond> ]\n", db_out);
@@ -183,6 +218,7 @@ do_help(p)
   fputs("when [ <pos> ] [ if <cond> ] { <command> [ ; <command> ] ... } \n", db_out);
   fputs("where [ <cnt> ]\n", db_out);
   fputs("which <name>\n", db_out);
+  fputs("! <shell command>\n", db_out);
 }
 
 /* ------------------------------------------------------------- */
@@ -608,6 +644,30 @@ do_regs(p)
 
 /* implementation of the where command */
 
+static t_addr  where_PC;
+
+static int
+where_entry(num)
+  int  num;
+{
+  t_addr *buf;
+  t_addr AB;
+  p_scope sc;
+
+  if (! (buf = get_EM_regs(num))) return 0;
+  AB = buf[1];
+  where_PC = buf[2];
+  if (! AB) return 0;
+  sc = base_scope(get_scope_from_addr(where_PC));
+  if (! sc || sc->sc_start > where_PC) return 0;
+  fprintf(db_out, "%s(", sc->sc_definedby->sy_idf->id_text);
+  print_params(sc->sc_definedby->sy_type, AB, has_static_link(sc));
+  fputs(") ", db_out);
+  print_position(where_PC, 0);
+  fputs("\n", db_out);
+  return 1;
+}
+
 /*ARGSUSED*/
 do_where(p)
   p_tree       p;
@@ -636,20 +696,8 @@ do_where(p)
   }
   else if (p) maxcnt = p->t_ival;
   for (cnt = maxcnt; cnt != 0; cnt--) {
-       t_addr AB;
-
        if (interrupted) return;
-       if (! (buf = get_EM_regs(i++))) break;
-       AB = buf[1];
-       PC = buf[2];
-       if (! AB) break;
-       sc = base_scope(get_scope_from_addr(PC));
-       if (! sc || sc->sc_start > PC) break;
-       fprintf(db_out, "%s(", sc->sc_definedby->sy_idf->id_text);
-       print_params(sc->sc_definedby->sy_type, AB, has_static_link(sc));
-       fputs(") ", db_out);
-       print_position(PC, 0);
-       fputs("\n", db_out);
+       if (! where_entry(i++)) return;
   }
 }
 
@@ -735,7 +783,7 @@ do_print(p)
        break;
   default:
        if (interrupted || ! eval_expr(p, &buf, &size, &tp)) return;
-       print_node(p, 0);
+       print_node(db_out, p, 0);
        fputs(" = ", db_out);
        if (p->t_oper == OP_FORMAT) {
                format = p->t_args[1]->t_str;
@@ -774,3 +822,155 @@ do_set(p)
   free(buf);
 }
 
+/* ------------------------------------------------------------- */
+
+/* implementation of the source command */
+
+extern FILE    *db_in;
+
+do_source(p)
+  p_tree       p;
+{
+  FILE         *old_db_in = db_in;
+
+  p = p->t_args[0];
+  if ((db_in = fopen(p->t_str, "r")) == NULL) {
+       db_in = old_db_in;
+       error("could not open %s", p->t_str);
+       return;
+  }
+  Commands();
+  fclose(db_in);
+  db_in = old_db_in;
+}
+
+/* ------------------------------------------------------------- */
+
+do_prcomm(p)
+  p_tree       p;
+{
+  print_node(db_out, p->t_args[0], 1);
+}
+
+/* ------------------------------------------------------------- */
+
+/* stack frame commands: frame, down, up */
+
+extern int     stack_offset;
+
+static
+frame_pos(diff)
+  int  diff;
+{
+  if (stack_offset+diff < 0) diff = - stack_offset;
+  if (! where_entry(stack_offset+diff)) {
+       error("no frame %d", stack_offset+diff);
+       return;
+  }
+  stack_offset += diff;
+  list_position(get_position_from_addr(where_PC));
+  CurrentScope = get_scope_from_addr(where_PC);
+}
+
+do_frame(p)
+  p_tree       p;
+{
+  if (p->t_args[0]) {
+       frame_pos((int) p->t_args[0]->t_ival - stack_offset);
+  }
+  else frame_pos(0);
+}
+
+do_up(p)
+  p_tree       p;
+{
+  if (p->t_args[0]) {
+       frame_pos((int) p->t_args[0]->t_ival);
+  }
+  else frame_pos(1);
+}
+
+do_down(p)
+  p_tree       p;
+{
+  if (p->t_args[0]) {
+       frame_pos(-(int) p->t_args[0]->t_ival);
+  }
+  else frame_pos(-1);
+}
+
+/* ------------------------------------------------------------- */
+
+/* log command */
+
+static char    *logfile;
+static FILE    *logfd;
+
+do_log(p)
+  p_tree       p;
+{
+  p = p->t_args[0];
+  if (p) {
+       if (logfd && ! strcmp(p->t_str, "off")) {
+               fprintf(db_out, "stopped logging on %s\n", logfile);
+               fclose(logfd);
+               logfd = NULL;
+               return;
+       }
+       if (logfd) {
+               error("already logging on %s", logfile);
+               return;
+       }
+       logfile = p->t_str;
+       if ((logfd = fopen(logfile, "w")) == NULL) {
+               error("could not open %s", logfile);
+               return;
+       }
+       fprintf(db_out, "started logging on %s\n", logfile);
+  }
+  else if (logfd) {
+       fprintf(db_out, "the current logfile is %s\n", logfile);
+  }
+  else {
+       error("no current logfile");
+  }
+}
+
+extern int     item_count;
+extern int     in_wheninvoked;
+
+log(p)
+  p_tree       p;
+{
+  register p_tree      p1;
+
+  if (logfd && ! in_wheninvoked) {
+       switch(p->t_oper) {
+       case OP_SOURCE:
+       case OP_LOG:
+               break;
+       case OP_DELETE:
+       case OP_ENABLE:
+       case OP_DISABLE:
+               /* Change absolute item numbers into relative ones
+                  for safer replay
+               */
+               p1 = p->t_args[0];
+               while (p1 && p1->t_oper == OP_LINK) {
+                       register p_tree p2 = p1->t_args[0];
+                       if (p2->t_ival > 0) {
+                               p2->t_ival = item_count - p2->t_ival;
+                       }
+                       p1 = p1->t_args[1];
+               }
+               if (p1 && p1->t_ival > 0) {
+                       p1->t_ival = item_count - p1->t_ival;
+               }
+               /* Fall through */
+       default:
+               print_node(logfd, p, 1);
+               fflush(logfd);
+               break;
+       }
+  }
+}
index 40cf34c..92ae22e 100644 (file)
@@ -1197,7 +1197,7 @@ eval_desig(p, paddr, psize, ptp)
                }
                break;
        default:
-               print_node(p, 0);
+               print_node(db_out, p, 0);
                fputs(" not a designator\n", db_out);
                break;
        }
@@ -1216,7 +1216,7 @@ eval_desig(p, paddr, psize, ptp)
                }
                break;
        default:
-               print_node(p, 0);
+               print_node(db_out, p, 0);
                fputs(" not a designator\n", db_out);
                break;
        }
@@ -1233,7 +1233,7 @@ eval_desig(p, paddr, psize, ptp)
                *ptp = (*ptp)->ty_cross;
                if (! *ptp) {
                        *ptp = void_type;
-                       print_node(p, 0);
+                       print_node(db_out, p, 0);
                        fputs(" designator has unknown type\n", db_out);
                        retval = 0;
                        *psize = 0;
index d36410a..dd1959f 100644 (file)
@@ -24,10 +24,10 @@ typedef struct item {
 
 struct itemlist {
   p_item       il_first, il_last;
-  int          il_count;
 };
 
 static struct itemlist item_list;
+int            item_count;
 
 static int
 in_item_list(p)
@@ -47,7 +47,7 @@ pr_item(i)
   p_item       i;
 {
   fprintf(db_out, "(%d)\t", i->i_itemno);
-  print_node(i->i_node, 0);
+  print_node(db_out, i->i_node, 0);
   fputs(i->i_disabled ? " (disabled)\n": "\n", db_out);
 }
 
@@ -143,7 +143,7 @@ add_to_item_list(p)
   else {
        item_list.il_last->i_next = i;
   }
-  i->i_itemno = ++item_list.il_count;
+  i->i_itemno = ++item_count;
   item_list.il_last = i;
   pr_item(i);
   return 1;
@@ -156,6 +156,7 @@ remove_from_item_list(n)
   register p_item i = item_list.il_first, prev = 0;
   p_tree       p;
 
+  if (n <= 0) n = item_count - n;
   while (i) {
        if (i->i_itemno == n) break;
        prev = i;
@@ -184,6 +185,7 @@ get_from_item_list(n)
 {
   register p_item i = item_list.il_first;
 
+  if (n <= 0) n = item_count - n;
   while (i) {
        if (i->i_itemno == n) return i->i_node;
        i = i->i_next;
@@ -197,6 +199,7 @@ able_item(n, kind)
   register p_item i = item_list.il_first;
   register p_tree p;
 
+  if (n <= 0) n = item_count - n;
   while (i) {
        if (i->i_itemno == n) break;
        i = i->i_next;
index 665f5b8..4d097b7 100644 (file)
@@ -2,6 +2,7 @@
 
 #include <stdio.h>
 #include <varargs.h>
+#include <signal.h>
 
 #include "tokenname.h"
 #include "position.h"
@@ -77,6 +78,7 @@ main(argc, argv)
   }
   prompt();
   Commands();
+  signal_child(SIGKILL);
   if (eof_seen) putc('\n', db_out);
   exit(0);
 }
index ac55695..293aae4 100644 (file)
@@ -77,7 +77,8 @@ print_char(c)
 }
 
 static int
-print_string(s, len)
+print_string(f, s, len)
+  FILE *f;
   char *s;
   int  len;
 {
@@ -87,7 +88,7 @@ print_string(s, len)
   while (*str) {
        if (*str++ == '\'') delim = '"';
   }
-  fprintf(db_out, "%c%.*s%c", delim, len, s, delim);
+  fprintf(f, "%c%.*s%c", delim, len, s, delim);
 }
 
 extern long    int_size;
@@ -457,92 +458,93 @@ get_string(c)
 }
 
 static int
-print_op(p)
+print_op(f, p)
+  FILE         *f;
   p_tree       p;
 {
   switch(p->t_oper) {
   case OP_UNOP:
        switch(p->t_whichoper) {
        case E_MIN:
-               fputs("-", db_out);
-               print_node(p->t_args[0], 0);
+               fputs("-", f);
+               print_node(f, p->t_args[0], 0);
                break;
        case E_PLUS:
-               fputs("+", db_out);
-               print_node(p->t_args[0], 0);
+               fputs("+", f);
+               print_node(f, p->t_args[0], 0);
                break;
        case E_NOT:
-               fputs("~", db_out);
-               print_node(p->t_args[0], 0);
+               fputs("~", f);
+               print_node(f, p->t_args[0], 0);
                break;
        case E_DEREF:
-               print_node(p->t_args[0], 0);
-               fputs("^", db_out);
+               print_node(f, p->t_args[0], 0);
+               fputs("^", f);
                break;
        }
        break;
   case OP_BINOP:
        if (p->t_whichoper == E_ARRAY) {
-               print_node(p->t_args[0], 0);
-               fputs("[", db_out);
-               print_node(p->t_args[1], 0);
-               fputs("]", db_out);
+               print_node(f, p->t_args[0], 0);
+               fputs("[", f);
+               print_node(f, p->t_args[1], 0);
+               fputs("]", f);
                break;
        }
        if (p->t_whichoper == E_SELECT) {
-               print_node(p->t_args[0], 0);
-               fputs(".", db_out);
-               print_node(p->t_args[1], 0);
+               print_node(f, p->t_args[0], 0);
+               fputs(".", f);
+               print_node(f, p->t_args[1], 0);
                break;
        }
-       fputs("(", db_out);
-       print_node(p->t_args[0], 0);
+       fputs("(", f);
+       print_node(f, p->t_args[0], 0);
        switch(p->t_whichoper) {
        case E_AND:
-               fputs("&", db_out);
+               fputs("&", f);
                break;
        case E_OR:
-               fputs("|", db_out);
+               fputs("|", f);
                break;
        case E_DIV:
-               fputs("/", db_out);
+               fputs("/", f);
                break;
        case E_MOD:
-               fputs(" MOD ", db_out);
+               fputs(" MOD ", f);
                break;
        case E_IN:
-               fputs(" IN ", db_out);
+               fputs(" IN ", f);
                break;
        case E_PLUS:
-               fputs("+", db_out);
+               fputs("+", f);
                break;
        case E_MIN:
-               fputs("-", db_out);
+               fputs("-", f);
                break;
        case E_MUL:
-               fputs("*", db_out);
+               fputs("*", f);
                break;
        case E_EQUAL:
-               fputs("=", db_out);
+               fputs("=", f);
                break;
        case E_NOTEQUAL:
-               fputs("#", db_out);
+               fputs("#", f);
                break;
        case E_LTEQUAL:
-               fputs("<=", db_out);
+               fputs("<=", f);
                break;
        case E_GTEQUAL:
-               fputs(">=", db_out);
+               fputs(">=", f);
                break;
        case E_LT:
-               fputs("<", db_out);
+               fputs("<", f);
                break;
        case E_GT:
-               fputs(">", db_out);
+               fputs(">", f);
                break;
        }
-       print_node(p->t_args[1], 0);
-       fputs(")", db_out);
+       print_node(f, p->t_args[1], 0);
+       fputs(")", f);
        break;
   }
 }
index d28f1d7..d77334d 100644 (file)
@@ -34,3 +34,10 @@ OP_BINOP     2       0
 OP_FORMAT      2       0
 OP_DISABLE     1       do_disable
 OP_ENABLE      1       do_enable
+OP_SHELL       0       do_noop
+OP_SOURCE      1       do_source
+OP_PRCOMM      1       do_prcomm
+OP_UP          1       do_up
+OP_DOWN                1       do_down
+OP_FRAME       1       do_frame
+OP_LOG         1       do_log
index a2cb0bb..58cf0b6 100644 (file)
@@ -7,7 +7,7 @@
 typedef unsigned int   t_lineno;
 typedef long           t_addr;
 #define ILL_ADDR       ((t_addr) -1)
-#define NO_ADDR                ((t_addr) -3)
+#define NO_ADDR                ((t_addr) 0)
 
 typedef struct pos {
   t_lineno     lineno;
index 1440990..6e0e345 100644 (file)
@@ -283,21 +283,37 @@ print_val(tp, tp_sz, addr, compressed, indent, format)
        }
        fprintf(db_out, currlang->addr_fmt, get_int(addr, pointer_size, T_UNSIGNED));
        break;
-  case T_POINTER:
-       if (format && strindex(format,'s') &&
+  case T_POINTER: {
+       t_addr a = get_int(addr, tp_sz, T_UNSIGNED);
+
+       fprintf(db_out, currlang->addr_fmt, a);
+       if (format && strindex(format, 's') &&
            (tp->ty_ptrto == char_type || tp->ty_ptrto == uchar_type)) {
-               t_addr a = get_int(addr, tp_sz, T_UNSIGNED);
                char *naddr = malloc(512);
 
-               if (naddr && get_string(511L, a, naddr)) {
-                       print_val(string_type, 512L, naddr, 0, indent, format);
+               if (! naddr) {
+                       fputs(" (could not allocate memory)", db_out);
+                       break;
+               }
+               if (! get_string(511L, a, naddr)) {
+                       fputs(" (not a valid pointer)", db_out);
                        free(naddr);
                        break;
                }
-               if (naddr) free(naddr);
+               fputs(" (", db_out);
+               print_val(string_type, 512L, naddr, 0, indent, format);
+               fputs(")", db_out);
+               free(naddr);
+               break;
+       }
+       if (tp->ty_ptrto->ty_class == T_PROCEDURE) {
+               p_scope sc = get_scope_from_addr(a);
+               if (sc && sc->sc_definedby && a == sc->sc_start) {
+                       fprintf(db_out, " (%s)", sc->sc_definedby->sy_idf->id_text);
+               }
        }
-       fprintf(db_out, currlang->addr_fmt, get_int(addr, pointer_size, T_UNSIGNED));
        break;
+       }
   case T_FILE:
        fprintf(db_out, "<file>");
        break;
@@ -363,7 +379,7 @@ print_val(tp, tp_sz, addr, compressed, indent, format)
        print_integer(tp, get_int(addr, tp_sz, T_INTEGER), format);
        break;
   case T_STRING:
-       (*currlang->printstring)(addr, (int) tp_sz);
+       (*currlang->printstring)(db_out, addr, (int) tp_sz);
        break;
   default:
        assert(0);
index e5b1a0e..937aa6f 100644 (file)
@@ -31,6 +31,7 @@ extern char   *progname;
 extern int     child_interrupted;
 extern int     interrupted;
 extern int     stop_reason;
+extern int     stack_offset;
 extern t_lineno        currline;
 
 static int     child_pid;              /* process id of child */
@@ -386,6 +387,7 @@ could_send(m, stop_message)
        if (m->m_type & M_DB_RUN) {
                disable_intr = 0;
                stop_reason = 0;
+               stack_offset = 0;
        }
        if (!child_interrupted && (! uputm(m) || ! ugetm(&answer))) {
                child_dead = 1;
@@ -458,10 +460,12 @@ could_send(m, stop_message)
 }
 
 static int
-getbytes(size, from, to, kind)
+getbytes(size, from, to, kind, errmess)
   long size;
   t_addr from;
   char *to;
+  int kind;
+  int errmess;
 {
   struct message_hdr   m;
 
@@ -475,10 +479,10 @@ getbytes(size, from, to, kind)
 
   switch(answer.m_type) {
   case M_FAIL:
-       error("could not get value");
+       if (errmess) error("could not get value");
        return 0;
   case M_INTR:
-       error("interrupted");
+       if (errmess) error("interrupted");
        return 0;
   case M_DATA:
        return ureceive(to, BUFTOI(answer.m_buf+1, (int)LS));
@@ -494,7 +498,7 @@ get_bytes(size, from, to)
   t_addr from;
   char *to;
 {
-  return getbytes(size, from, to, M_GETBYTES);
+  return getbytes(size, from, to, M_GETBYTES, 1);
 }
 
 int
@@ -503,7 +507,7 @@ get_string(size, from, to)
   t_addr from;
   char *to;
 {
-  int retval = getbytes(size, from, to, M_GETSTR);
+  int retval = getbytes(size, from, to, M_GETSTR, 0);
 
   to[(int)BUFTOI(answer.m_buf+1, (int)LS)] = 0;
   return retval;
index c19b529..9d6fb7a 100644 (file)
@@ -60,6 +60,9 @@ struct tokenname tkidf[] =    {       /* names of the identifier tokens */
        {HELP, "help"},
        {DISABLE,"disable"},
        {ENABLE,"enable"},
+       {SOURCE, "source"},
+       {FRAME, "frame"},
+       {LOG, "log"},
        {-1, "quit"},
        {0, ""}
 };
index 6edc2b0..fb5e107 100644 (file)
@@ -151,200 +151,239 @@ get_addr_from_node(p)
   return a;
 }
 
-print_node(p, top_level)
+static int     ommit_commas = 0;
+
+print_node(f, p, top_level)
   register p_tree      p;
+  register FILE                *f;
 {
   if (!p) return;
   switch(p->t_oper) {
+  case OP_LOG:
+       fputs("log ", f);
+       print_node(f, p->t_args[0], 0);
+       break;
+  case OP_PRCOMM:
+       fputs("rerun ?", f);
+       break;
+  case OP_RUN:
+       fputs("run ", f);
+       ommit_commas = 1;
+       print_node(f, p->t_args[0], 0);
+       ommit_commas = 0;
+       break;
   case OP_LIST:
-       fputs("list ", db_out);
+       fputs("list ", f);
        if (p->t_args[0]) {
-               print_node(p->t_args[0], 0);
+               print_node(f, p->t_args[0], 0);
                if (p->t_args[1]) {
                        if (p->t_args[1]->t_ival >= 0) {
-                               fputs(", ", db_out);
-                               print_node(p->t_args[1], 0);
+                               fputs(", ", f);
+                               print_node(f, p->t_args[1], 0);
                        }
                        else  {
                                if (p->t_args[1]->t_ival < -100000000) {
-                                       fputs("-", db_out);
+                                       fputs("-", f);
                                }
-                               else print_node(p->t_args[1], 0);
+                               else print_node(f, p->t_args[1], 0);
                        }
                }
        }
        break;
   case OP_PRINT:
-       fputs("print ", db_out);
-       print_node(p->t_args[0], 0);
+       fputs("print ", f);
+       print_node(f, p->t_args[0], 0);
+       break;
+  case OP_SOURCE:
+       fputs("source ", f);
+       print_node(f, p->t_args[0], 0);
        break;
   case OP_ENABLE:
-       fputs("enable ", db_out);
-       print_node(p->t_args[0], 0);
+       fputs("enable ", f);
+       print_node(f, p->t_args[0], 0);
        break;
   case OP_DISABLE:
-       fputs("disable ", db_out);
-       print_node(p->t_args[0], 0);
+       fputs("disable ", f);
+       print_node(f, p->t_args[0], 0);
        break;
   case OP_DISPLAY:
-       fputs("display ", db_out);
-       print_node(p->t_args[0], 0);
+       fputs("display ", f);
+       print_node(f, p->t_args[0], 0);
        break;
   case OP_LINK:
-       print_node(p->t_args[0], 0);
-       fputs(", ", db_out);
-       print_node(p->t_args[1], 0);
+       print_node(f, p->t_args[0], 0);
+       if (! ommit_commas) fputs(", ", f);
+       else putc(' ', f);
+       print_node(f, p->t_args[1], 0);
        break;
   case OP_FILE:
-       fputs("file ", db_out);
-       print_node(p->t_args[0], 0);
+       fputs("file ", f);
+       print_node(f, p->t_args[0], 0);
+       break;
+  case OP_FRAME:
+       fputs("frame ", f);
+       print_node(f, p->t_args[0], 0);
+       break;
+  case OP_UP:
+       fputs("frame +", f);
+       print_node(f, p->t_args[0], 0);
+       break;
+  case OP_DOWN:
+       fputs("frame -", f);
+       print_node(f, p->t_args[0], 0);
        break;
   case OP_SET:
-       fputs("set ", db_out);
-       print_node(p->t_args[0], 0);
-       fputs(" to ", db_out);
-       print_node(p->t_args[1], 0);
+       fputs("set ", f);
+       print_node(f, p->t_args[0], 0);
+       fputs(" to ", f);
+       print_node(f, p->t_args[1], 0);
        break;
   case OP_FIND:
-       fputs("find ", db_out);
-       print_node(p->t_args[0], 0);
+       fputs("find ", f);
+       print_node(f, p->t_args[0], 0);
        break;
   case OP_WHICH:
-       fputs("which ", db_out);
-       print_node(p->t_args[0], 0);
+       fputs("which ", f);
+       print_node(f, p->t_args[0], 0);
        break;
   case OP_DELETE:
-       fputs("delete ", db_out);
-       print_node(p->t_args[0], 0);
+       fputs("delete ", f);
+       print_node(f, p->t_args[0], 0);
        break;
   case OP_REGS:
-       fputs("regs ", db_out);
-       print_node(p->t_args[0], 0);
+       fputs("regs ", f);
+       print_node(f, p->t_args[0], 0);
        break;
   case OP_NEXT:
-       fputs("next ", db_out);
-       print_node(p->t_args[0], 0);
+       fputs("next ", f);
+       print_node(f, p->t_args[0], 0);
        break;
   case OP_STEP:
-       fputs("step ", db_out);
-       print_node(p->t_args[0], 0);
+       fputs("step ", f);
+       print_node(f, p->t_args[0], 0);
        break;
   case OP_STATUS:
-       fputs("status", db_out);
+       fputs("status", f);
        break;
   case OP_DUMP:
-       fputs("dump ", db_out);
+       fputs("dump ", f);
        print_position(p->t_address, 1);
        break;
   case OP_RESTORE:
-       fputs("restore ", db_out);
-       print_node(p->t_args[0], 0);
+       fputs("restore ", f);
+       print_node(f, p->t_args[0], 0);
        break;
   case OP_WHERE:
-       fputs("where ", db_out);
-       print_node(p->t_args[0], 0);
+       fputs("where ", f);
+       print_node(f, p->t_args[0], 0);
        break;
   case OP_HELP:
-       fputs("help ", db_out);
-       print_node(p->t_args[0], 0);
+       fputs("help ", f);
+       print_node(f, p->t_args[0], 0);
        break;
   case OP_CONT:
-       fputs("cont", db_out);
+       fputs("cont", f);
        if (p->t_args[0]) {
-               fprintf(db_out, " %ld", p->t_args[0]->t_ival);
+               fprintf(f, " %ld", p->t_args[0]->t_ival);
        }
        if (p->t_args[1]) {
-               fputs(" ", db_out);
-               print_node(p->t_args[1], 0);
+               fputs(" ", f);
+               print_node(f, p->t_args[1], 0);
        }
        break;
 
   case OP_WHEN:
-       fputs("when ", db_out);
+       fputs("when ", f);
        if (p->t_address != NO_ADDR) {
                print_position(p->t_address, 1);
        }
-       else print_node(p->t_args[0], 0);
+       else print_node(f, p->t_args[0], 0);
        if (p->t_args[1]) {
-               fputs(" if ", db_out);
-               print_node(p->t_args[1], 0);
+               fputs(" if ", f);
+               print_node(f, p->t_args[1], 0);
        }
        p = p->t_args[2];
-       fputs(" { ", db_out);
+       fputs(" { ", f);
        while (p && p->t_oper == OP_LINK) {
-               print_node(p->t_args[0], 0);
-               fputs("; ", db_out);
+               print_node(f, p->t_args[0], 0);
+               fputs("; ", f);
                p = p->t_args[1];
        }
-       print_node(p, 0);
-       fputs(" }", db_out);
+       print_node(f, p, 0);
+       fputs(" }", f);
        break;
   case OP_STOP:
-       fputs("stop ", db_out);
+       fputs("stop ", f);
        if (p->t_address != NO_ADDR) {
                print_position(p->t_address, 1);
        }
-       else print_node(p->t_args[0], 0);
+       else print_node(f, p->t_args[0], 0);
        if (p->t_args[1]) {
-               fputs(" if ", db_out);
-               print_node(p->t_args[1], 0);
+               fputs(" if ", f);
+               print_node(f, p->t_args[1], 0);
        }
        break;
   case OP_TRACE:
-       fputs("trace ", db_out);
+       fputs("trace ", f);
        if (p->t_args[2]) {
-               fputs("on ", db_out);
-               print_node(p->t_args[2], 0);
-               fputs(" ", db_out);
+               fputs("on ", f);
+               print_node(f, p->t_args[2], 0);
+               fputs(" ", f);
        }
        if (p->t_address != NO_ADDR) {
                print_position(p->t_address, 1);
        }
-       else print_node(p->t_args[0], 0);
+       else print_node(f, p->t_args[0], 0);
        if (p->t_args[1]) {
-               fputs(" if ", db_out);
-               print_node(p->t_args[1], 0);
+               fputs(" if ", f);
+               print_node(f, p->t_args[1], 0);
        }
        break;
   case OP_AT:
-       fprintf(db_out, "at \"%s\":%ld", p->t_filename, p->t_lino);
+       fprintf(f, "at \"%s\":%ld", p->t_filename, p->t_lino);
        break;
   case OP_IN:
-       fputs("in ", db_out);
-       print_node(p->t_args[0], 0);
-       fputs(" ", db_out);
-       print_node(p->t_args[1], 0);
+       fputs("in ", f);
+       print_node(f, p->t_args[0], 0);
+       fputs(" ", f);
+       print_node(f, p->t_args[1], 0);
        break;
   case OP_SELECT:
-       print_node(p->t_args[0], 0);
-       fputs("`", db_out);
-       print_node(p->t_args[1], 0);
+       print_node(f, p->t_args[0], 0);
+       fputs("`", f);
+       print_node(f, p->t_args[1], 0);
+       break;
+  case OP_OUTPUT:
+       fprintf(f, "> %s ", p->t_str);
+       break;
+  case OP_INPUT:
+       fprintf(f, "< %s ", p->t_str);
        break;
   case OP_NAME:
-       fputs(p->t_str, db_out);
+       fputs(p->t_str, f);
        break;
   case OP_INTEGER:
-       fprintf(db_out, currlang->decint_fmt, p->t_ival);
+       fprintf(f, currlang->decint_fmt, p->t_ival);
        break;
   case OP_STRING:
-       (*currlang->printstring)(p->t_sval, strlen(p->t_sval));
+       (*currlang->printstring)(f, p->t_sval, strlen(p->t_sval));
        break;
   case OP_REAL:
-       fprintf(db_out, currlang->real_fmt, p->t_fval);
+       fprintf(f, currlang->real_fmt, p->t_fval);
        break;
   case OP_FORMAT:
-       print_node(p->t_args[0], 0);
-       fputs("\\", db_out);
-       print_node(p->t_args[1], 0);
+       print_node(f, p->t_args[0], 0);
+       fputs("\\", f);
+       print_node(f, p->t_args[1], 0);
        break;
   case OP_UNOP:
   case OP_BINOP:
-       (*currlang->printop)(p);
+       (*currlang->printop)(f, p);
        break;
   default:
        assert(0);
   }
-  if (top_level) fputs("\n", db_out);
+  if (top_level) fputs("\n", f);
 }
 
 int
@@ -377,6 +416,8 @@ in_status(com)
   p_tree       com;
 {
   switch(com->t_oper) {
+  case OP_PRCOMM:
+       /* not really in status but may not be removed */
   case OP_STOP:
   case OP_WHEN:
   case OP_TRACE:
@@ -408,6 +449,8 @@ newfile(id)
   find_language(strrindex(id->id_text, '.'));
 }
 
+int    in_wheninvoked;
+
 perform(p, a)
   register p_tree      p;
   t_addr               a;
@@ -416,6 +459,7 @@ perform(p, a)
   case OP_WHEN:
        if (p->t_args[1] && ! eval_cond(p->t_args[1])) break;
        p = p->t_args[2];
+       in_wheninvoked++;
        while (p && p->t_oper == OP_LINK) {
                if (interrupted) return;
                if (p->t_args[0]) eval(p->t_args[0]);
@@ -423,6 +467,7 @@ perform(p, a)
        }
        if (interrupted) return;
        if (p) eval(p);
+       in_wheninvoked--;
        break;
   case OP_TRACE:
        if (p->t_args[0] && p->t_args[0]->t_oper == OP_IN) {