Added 'file ?' and shell escape, and some re-organization
authorceriel <none@none>
Mon, 29 Oct 1990 11:38:35 +0000 (11:38 +0000)
committerceriel <none@none>
Mon, 29 Oct 1990 11:38:35 +0000 (11:38 +0000)
22 files changed:
util/grind/Amakefile
util/grind/c.c
util/grind/char.ct
util/grind/class.h
util/grind/commands.g
util/grind/db_symtab.g [new file with mode: 0644]
util/grind/do_comm.c [new file with mode: 0644]
util/grind/expr.c
util/grind/idf.c
util/grind/idf.h
util/grind/itemlist.cc
util/grind/main.c
util/grind/message.h
util/grind/print.c
util/grind/run.c
util/grind/scope.cc
util/grind/scope.h
util/grind/sizes.h
util/grind/symbol.c
util/grind/tokenname.c
util/grind/tokenname.h
util/grind/tree.c

index bd1efc4..aa11c2c 100644 (file)
@@ -20,13 +20,13 @@ TOKENNAMES = tokenname.c [
 ];
 
 DBS_LLTARGETS = {
-       dbx_string.c[type=C-src],
+       db_symtab.c[type=C-src],
        DBSpars.c[type=C-src],
        DBSpars.h[type=C-incl]
 } ;
 
 DBS_LLSRC = {
-       dbx_string.g
+       db_symtab.g
 } ;
 
 CMD_LLTARGETS = {
@@ -47,7 +47,6 @@ GENNEXTSRC = {
 } ;
 
 CSRC = {
-       dbxread.c,
        main.c,
        list.c,
        tree.c,
@@ -55,13 +54,12 @@ CSRC = {
        position.c,
        idf.c,
        run.c,
-       dump.c,
        symbol.c,
        print.c,
        value.c,
        type.c,
        rd.c,
-       help.c,
+       do_comm.c,
        modula-2.c,
        c.c
 } ;
index a131341..4f8e753 100644 (file)
@@ -106,9 +106,9 @@ static int
 print_char(c)
   int  c;
 {
-  fputc('\'', db_out);
+  putc('\'', db_out);
   printchar(c, '\'');
-  fputc('\'', db_out);
+  putc('\'', db_out);
 }
 
 static int
@@ -118,9 +118,9 @@ print_string(s, len)
 {
   register char        *str = s;
 
-  fputc('"', db_out);
+  putc('"', db_out);
   while (*str && len-- > 0) printchar(*str++, '"');
-  fputc('"', db_out);
+  putc('"', db_out);
 }
 
 extern long    int_size;
@@ -471,32 +471,32 @@ print_op(p)
        case E_MIN:
                fputs("-(", db_out);
                print_node(p->t_args[0], 0);
-               fputc(')', db_out);
+               putc(')', db_out);
                break;
        case E_PLUS:
                fputs("+(", db_out);
                print_node(p->t_args[0], 0);
-               fputc(')', db_out);
+               putc(')', db_out);
                break;
        case E_NOT:
                fputs("!(", db_out);
                print_node(p->t_args[0], 0);
-               fputc(')', db_out);
+               putc(')', db_out);
                break;
        case E_DEREF:
                fputs("*(", db_out);
                print_node(p->t_args[0], 0);
-               fputc(')', db_out);
+               putc(')', db_out);
                break;
        case E_BNOT:
                fputs("~(", db_out);
                print_node(p->t_args[0], 0);
-               fputc(')', db_out);
+               putc(')', db_out);
                break;
        case E_ADDR:
                fputs("&(", db_out);
                print_node(p->t_args[0], 0);
-               fputc(')', db_out);
+               putc(')', db_out);
                break;
        }
        break;
index e5363cf..41882de 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 06f407a..73da55a 100644 (file)
@@ -1,26 +1,11 @@
-/*
- * (c) copyright 1987 by the Vrije Universiteit, Amsterdam, The Netherlands.
- * See the copyright notice in the ACK home directory, in the file "Copyright".
- *
- * Author: Ceriel J.H. Jacobs
- */
-
-/* U S E   O F   C H A R A C T E R   C L A S S E S */
-
 /* $Header$ */
 
 /*     As a starter, chars are divided into classes, according to which
        token they can be the start of.
-       At present such a class number is supposed to fit in 4 bits.
 */
 
 #define        class(ch)       (tkclass[ch])
 
-/*     Being the start of a token is, fortunately, a mutual exclusive
-       property, so, as there are less than 16 classes they can be
-       packed in 4 bits.
-*/
-
 #define        STSKIP  0       /* spaces and so on: skipped characters         */
 #define        STNL    1       /* newline character(s): update linenumber etc. */
 #define        STGARB  2       /* garbage ascii character: not allowed         */
@@ -33,8 +18,9 @@
 #define        STEOI   9       /* End-Of-Information mark                      */
 #define STSIMP  10      /* this character can occur as token            */
 
-/*     But occurring inside a token is not, so we need 1 bit for each
-       class.  This is implemented as a collection of tables to speed up
+/*     But occurring inside a token is not an exclusive property,
+       so we need 1 bit for each class. 
+       This is implemented as a collection of tables to speed up
        the decision whether a character has a special meaning.
 */
 #define        in_idf(ch)      ((unsigned)ch < 0177 && inidf[ch])
index 630bbc6..cb4e7d5 100644 (file)
@@ -108,6 +108,7 @@ command_line(p_tree *p;)
 | FIND qualified_name(p){ *p = mknode(OP_FIND, *p); }
 | WHICH qualified_name(p){ *p = mknode(OP_WHICH, *p); }
 | able_command(p)
+| '!'                  { shellescape(); }
 |
 ]
 ;
@@ -127,7 +128,7 @@ list_command(p_tree *p;)
 :
   LIST
   [
-  | count(&t1)
+  | position(&t1)
   | qualified_name(&t1)
   ]
   [ ',' count(&t2)
@@ -201,7 +202,7 @@ continue_command(p_tree *p;)
   [ INTEGER            { l = tok.ival; }
   |                    { l = 1; }
   ]
-  position(&pos)?
+  [ AT position(&pos) ]?
                        { *p = mknode(OP_CONT, mknode(OP_INTEGER, l), pos); }
 ;
 
@@ -332,9 +333,9 @@ condition(p_tree *p;)
 where(p_tree *p;)
 :
   IN qualified_name(p) { *p = mknode(OP_IN, *p, (p_tree) 0); }
-  position(&((*p)->t_args[1]))?
+  [ AT position(&((*p)->t_args[1])) ]?
 |
-  position(p)
+  AT position(p)
 ;
 
 expression(p_tree *p; int level;)
@@ -404,7 +405,6 @@ position(p_tree *p;)
     char *str;
   }
 :
-  AT
   [ STRING             { str = tok.str; }
     ':'
   |                    { if (! listfile) str = 0;
@@ -597,4 +597,82 @@ init_del()
 {
   signal(SIGINT, catch_del);
 }
+
+static int
+ctch()
+{
+  /* Only for shell escapes ... */
+  signal(SIGINT, ctch);
+}
+
+#define SHBUFSIZ       512
+
+int
+shellescape()
+{
+  register char *p;                    /* walks through command */
+  static char previous[SHBUFSIZ];      /* previous command */
+  char comm[SHBUFSIZ];                 /* space for command */
+  register int cnt;                    /* prevent array bound errors */
+  register int c;                      /* current char */
+  register int lastc = 0;              /* will contain the previous char */
+
+  p = comm;
+  cnt = SHBUFSIZ-2;
+  while (c = getc(db_in), c != '\n') {
+       switch(c) {
+         case '!':
+               /*
+                * An unescaped ! expands to the previous
+                * command, but disappears if there is none
+                */
+               if (lastc != '\\') {
+                       if (*previous) {
+                               int len = strlen(previous);
+                               if ((cnt -= len) <= 0) break;
+                               strcpy(p,previous);
+                               p += len;
+                       }
+               }
+               else {
+                       *p++ = c;
+               }
+               continue;
+         case '%':
+               /*
+                * An unescaped % will expand to the current
+                * filename, but disappears is there is none
+                */
+               if (lastc != '\\') {
+                       if (listfile) {
+                               int len = strlen(listfile->sy_idf->id_text);
+                               if ((cnt -= len) <= 0) break;
+                               strcpy(p,listfile->sy_idf->id_text);
+                               p += len;
+                       }
+               }
+               else {
+                       *p++ = c;
+               }
+               continue;
+         default:
+               lastc = c;
+               if (cnt-- <= 0) break;
+               *p++ = c;
+               continue;
+       }
+       break;
+  }
+  *p = '\0';
+  if (c != '\n') {
+       warning("shell command too long");
+       while (c != '\n') c = getc(db_in);
+  }
+  ungetc(c, db_in);
+  strcpy(previous, comm);
+  signal(SIGINT, ctch);
+  cnt = system(comm);
+  signal(SIGINT, catch_del);
+  return cnt;
+}
 }
diff --git a/util/grind/db_symtab.g b/util/grind/db_symtab.g
new file mode 100644 (file)
index 0000000..fb3cc48
--- /dev/null
@@ -0,0 +1,889 @@
+/* $Header$ */
+
+/* Symbol table reader
+*/
+
+{
+#include       <alloc.h>
+#include       <stb.h>
+#include       <assert.h>
+
+#include       "position.h"
+#include       "file.h"
+#include       "type.h"
+#include       "symbol.h"
+#include       "scope.h"
+#include       "class.h"
+#include       "idf.h"
+#include       "rd.h"
+
+extern char    *strindex();
+extern long    str2long();
+extern double  atof();
+
+extern long    pointer_size;
+
+static char    *DbPtr;         /* current pointer in DBX string */
+static int     AllowName;              /* set if NAME legal at this point */
+static long    ival;
+static double  fval;
+static char    *strval;
+static int     last_index[2];
+static struct outname  *currnam;
+static int     saw_code;
+
+static struct literal *get_literal_space();
+static struct fields *get_field_space();
+static end_field();
+static char *string_val();
+}
+
+%start DbParser, debugger_string;
+
+%prefix DBS;
+
+%lexical DBSlex;
+
+%onerror DBSonerror;
+
+%token INTEGER, REAL, STRING, NAME;
+
+debugger_string
+  { register p_symbol s;
+    char *str;
+    p_type tmp = 0;
+  }
+:
+  name(&str)
+  [ /* constant name */
+                       { s = NewSymbol(str, CurrentScope, CONST, currnam); }
+       'c' const_name(s)
+
+  | /* type name */
+                       { s = NewSymbol(str, CurrentScope, TYPE, currnam); }
+       't' type_name(&(s->sy_type), s)
+                       { if (! s->sy_type->ty_sym) s->sy_type->ty_sym = s; 
+                         if ((s->sy_type->ty_class == T_ENUM ||
+                              s->sy_type->ty_class == T_SUBRANGE) &&
+                             currnam->on_desc != 0) {
+                               s->sy_type->ty_size = currnam->on_desc;
+                         }
+                       }
+  | /* tag name (only C?) */
+                       { s = NewSymbol(str, CurrentScope, TAG, currnam); }
+       'T' type_name(&(s->sy_type), s)
+                       { if (! s->sy_type->ty_sym) s->sy_type->ty_sym = s; 
+                         if (s->sy_type->ty_class != T_CROSS) {
+                               resolve_cross(s->sy_type);
+                         }
+                       }
+  | /* end scope */
+       'E' INTEGER
+                       { close_scope(); }
+
+  | /* module begin */
+                       { s = NewSymbol(str, CurrentScope, MODULE, currnam); }
+       'M' INTEGER
+                       { open_scope(s, 1);
+                         s->sy_name.nm_scope = CurrentScope;
+                         CurrentScope->sc_start = currnam->on_valu;
+                         CurrentScope->sc_proclevel = currnam->on_desc;
+                         add_scope_addr(CurrentScope);
+                       }
+
+  | /* external procedure */
+                       { s = NewSymbol(str, FileScope, PROC, currnam); }
+       'P' routine(s)
+
+  | /* private procedure */
+                       { s = NewSymbol(str, CurrentScope, PROC, currnam); }
+       'Q' routine(s)
+
+  | /* external function */
+                       { s = NewSymbol(str, FileScope, FUNCTION, currnam); }
+       'F' function(s)
+
+  | /* private function */
+                       { s = NewSymbol(str, CurrentScope, FUNCTION, currnam); }
+       'f' function(s)
+
+  | /* global variable, external */
+                               /* maybe we already know it; but we need
+                                  the type information anyway for other
+                                  types.
+                               */
+                       { s = Lookup(findidf(str), FileScope, VAR);
+                         if (s) {
+                               tmp = s->sy_type;
+                               s->sy_type = 0;
+                         } else s = NewSymbol(str, FileScope, VAR, currnam);
+                       }
+       'G' type(&(s->sy_type), (int *) 0, s)
+                       { if (tmp) s->sy_type = tmp; } 
+
+  | /* static variable */
+                       { s = NewSymbol(str, CurrentScope, VAR, currnam); }
+       'S' type(&(s->sy_type), (int *) 0, s)
+
+  | /* static variable, local scope */
+                       { s = NewSymbol(str, CurrentScope, VAR, currnam); }
+       'V' type(&(s->sy_type), (int *) 0, s)
+
+  | /* register variable */
+                       { s = NewSymbol(str, CurrentScope, REGVAR, currnam); }
+       'r' type(&(s->sy_type), (int *) 0, s)
+
+  | /* value parameter */
+                       { s = NewSymbol(str, CurrentScope, LOCVAR, currnam); }
+       'p' type(&(s->sy_type), (int *) 0, s)
+                       { add_param_type('p', s); }
+
+  | /* value parameter but address passed */
+                       { s = NewSymbol(str, CurrentScope, VARPAR, currnam); }
+       'i' type(&(s->sy_type), (int *) 0, s)
+                       { add_param_type('i', s); }
+
+  | /* variable parameter */
+                       { s = NewSymbol(str, CurrentScope, VARPAR, currnam); }
+       'v' type(&(s->sy_type), (int *) 0, s)
+                       { add_param_type('v', s); }
+
+  | /* local variable */
+                       { s = NewSymbol(str, CurrentScope, LOCVAR, currnam); }
+       type_name(&(s->sy_type), s)
+
+  | /* function result in Pascal; ignore ??? */
+                       { s = NewSymbol(str, CurrentScope, LOCVAR, currnam); }
+       'X' type_name(&(s->sy_type), s)
+  ]
+  ';'?
+;
+
+name(char **s;)
+:
+  /* anything up to a ':' */
+  NAME { *s = strval; }
+;
+
+const_name(p_symbol cst;)
+  { int type_index[2];
+    long iconst;
+    register char *p;
+  }
+:
+  '='
+  [
+/*
+       'b' integer_const(&(cst->sy_const.co_ival))     /* boolean */
+/*  |
+*/
+       'c' integer_const(&(cst->sy_const.co_ival))     /* character */
+                               { cst->sy_type = char_type; }
+  |
+       'i' integer_const(&(cst->sy_const.co_ival))     /* integer */
+                               { cst->sy_type = long_type; }
+  |
+       'r' real_const(&(cst->sy_const.co_rval))        /* real */
+                               { cst->sy_type = double_type; }
+  |
+       's' string_const                                /* string */
+                               { cst->sy_const.co_sval = string_val(strval);
+                                 cst->sy_type = string_type;
+                               }
+  |
+       'e' type_index(type_index) ',' integer_const(&(cst->sy_const.co_ival))
+                               /* enumeration constant;
+                                * enumeration type, value
+                                */
+                               { cst->sy_type = *tp_lookup(type_index); }
+                               
+  |
+       'S' type_index(type_index)
+                               { cst->sy_type = *tp_lookup(type_index);
+                                 cst->sy_const.co_setval = p =
+                                   Malloc((unsigned) cst->sy_type->ty_size);
+                               }
+       [ ',' integer_const(&iconst)
+                               { *p++ = iconst; }
+       ]+
+                               /* set constant:
+                                *  settype, values of the bytes
+                                *  in the set.
+                                */
+  ]
+;
+
+integer_const(long *iconst;)
+  { int sign = 0; }
+:
+  [ '+' | '-' { sign = 1; } ]?
+  INTEGER                      { *iconst = sign ? -ival : ival; }
+;
+
+real_const(double *f;)
+  { int sign = 0; }
+:
+  [ '+' | '-' { sign = 1; } ]?
+  REAL                         { *f = sign ? fval : -fval; }
+;
+
+string_const
+:
+  STRING                       /* has SINGLE quotes! */
+;
+
+type_name(p_type *t; p_symbol sy;)
+  { int type_index[2]; p_type *p; }
+:
+  type_index(type_index)       { p = tp_lookup(type_index); }
+  [
+                               { if (*p && (*p)->ty_class != 0 &&
+                                     (*p)->ty_class != T_CROSS) {
+                                       error("Redefining (%d,%d) %d",
+                                         type_index[0],
+                                         type_index[1],
+                                         (*p)->ty_class);
+                                 }
+                               }
+       '='                     
+       type(p, type_index, sy)
+  |
+  ]
+                               { if (*p == 0) *p = new_type();
+                                 *t = *p;
+                               }
+;
+
+type_index(int *type_index;)
+:
+[
+  INTEGER                      { type_index[0] = 0; type_index[1] = ival; }
+|
+  '(' INTEGER                  { type_index[0] = ival; }
+  ',' INTEGER                  { type_index[1] = ival; }
+  ')'
+]
+                               { last_index[0] = type_index[0];
+                                 last_index[1] = type_index[1];
+                               }
+;
+
+function(p_symbol p;)
+:
+                       { p->sy_type = new_type();
+                         p->sy_type->ty_class = T_PROCEDURE;
+                         p->sy_type->ty_size = pointer_size;
+                       }
+  type(&(p->sy_type->ty_retval), (int *) 0, (p_symbol) 0) 
+                       { if (CurrentScope != FileScope &&
+                             saw_code) {
+                               /* if saw_code is not set, it is a nested
+                                  procedure
+                               */
+                               close_scope();
+                         }
+                         saw_code = 0;
+                         open_scope(p, 1);
+                         p->sy_name.nm_scope = CurrentScope;
+                         CurrentScope->sc_start = currnam->on_valu;
+                         add_scope_addr(CurrentScope);
+                         CurrentScope->sc_proclevel = currnam->on_desc;
+                       }
+;
+
+routine(p_symbol p;)
+:
+                       { p->sy_type = new_type();
+                         p->sy_type->ty_class = T_PROCEDURE;
+                         p->sy_type->ty_size = pointer_size;
+                         if (CurrentScope != FileScope &&
+                             saw_code) {
+                               /* if saw_code is not set, it is a nested
+                                  procedure
+                               */
+                               close_scope();
+                         }
+                         saw_code = 0;
+                         open_scope(p, 1);
+                         p->sy_name.nm_scope = CurrentScope;
+                         CurrentScope->sc_start = currnam->on_valu;
+                         add_scope_addr(CurrentScope);
+                         CurrentScope->sc_proclevel = currnam->on_desc;
+                       }
+  INTEGER ';'
+  type(&(p->sy_type->ty_retval), (int *) 0, (p_symbol) 0) 
+;
+
+type(p_type *ptp; int *type_index; p_symbol sy;)
+  { register p_type tp = *ptp ? *ptp : new_type();
+    p_type t1 = 0, t2 = 0;
+    long ic1, ic2;
+    int A_used = 0;
+    int tclass;
+    int tp_index[2];
+    char *str;
+  }
+:
+  [
+       /* type cross reference */
+       /* these are used in C for references to a struct, union or
+        * enum that has not been declared (yet)
+        */
+       'x'
+       [ 's'   /* struct */
+                       { tclass = T_STRUCT; }
+       | 'u'   /* union */
+                       { tclass = T_UNION; }
+       | 'e'   /* enum */
+                       { tclass = T_ENUM; }
+       ]
+                       { AllowName = 1; }
+       name(&str)
+                       { sy = Lookfromscope(str2idf(str,0),TAG,CurrentScope);
+                         if (sy && 
+                             (sy->sy_type->ty_class == tclass ||
+                              sy->sy_type->ty_class == T_CROSS)) {
+                               if (tp != *ptp) free_type(tp);
+                               tp = sy->sy_type;
+                         }
+                         else {
+                               tp->ty_class = T_CROSS;
+                               tp->ty_size = tclass;
+                               sy = NewSymbol(str, CurrentScope, TAG, (struct outname *) 0);
+                               sy->sy_type = tp;
+                         }
+                       }
+  |
+       /* subrange */
+       /* the integer_const's represent the lower and the upper bound.
+        * A subrange type defined as subrange of itself is an integer type.
+        * If the second integer_const == 0, but the first is not, we
+        * have a floating point type with size equal to the first
+        * integer_const.
+        * Upperbound -1 means unsigned int or unsigned long.
+        */
+       'r' type_index(tp_index) ';'
+       [ 'A' integer_const(&ic1)       { A_used = 1; }
+       | integer_const(&ic1)
+       ]
+       ';'
+       [ 'A' integer_const(&ic2)       { A_used |= 2; }
+       | integer_const(&ic2)
+       ]
+                       { if (tp != *ptp) free_type(tp);
+                         tp = subrange_type(A_used,
+                                              tp_index,
+                                              ic1,
+                                              ic2,
+                                              type_index);
+                       }
+  |
+       /* array; first type is bound type, next type
+        * is element type
+        */
+       'a' type(&t1, (int *) 0, (p_symbol) 0) ';' type(&t2, (int *) 0, (p_symbol) 0)
+                       { if (tp != *ptp) free_type(tp);
+                         tp = array_type(t1, t2); 
+                       }
+  |
+       /* structure type */
+       's'             { tp->ty_class = T_STRUCT; }
+       structure_type(tp, sy)
+  |
+       /* union type */
+       'u'             { tp->ty_class = T_UNION; }
+       structure_type(tp, sy)
+  |
+       /* enumeration type */
+       'e'             { tp->ty_class = T_ENUM; }
+       enum_type(tp)
+  |
+       /* pointer type */
+       '*'             { tp->ty_class = T_POINTER;
+                         tp->ty_size = pointer_size;
+                       }
+       type(&(tp->ty_ptrto), (int *) 0, (p_symbol) 0)
+  |
+       /* function type */
+       'f'             { tp->ty_class = T_PROCEDURE;
+                         tp->ty_size = pointer_size;
+                       }
+       type(&(tp->ty_retval), (int *) 0, (p_symbol) 0) 
+/*
+       [ %prefer
+               ',' param_list(tp)
+       |
+       ]
+*/
+  |
+       /* procedure type */
+       'Q'             { tp->ty_class = T_PROCEDURE;
+                         tp->ty_size = pointer_size;
+                       }
+       type(&(tp->ty_retval), (int *) 0, (p_symbol) 0) 
+       ',' param_list(tp)
+  |
+       /* another procedure type */
+       'p'             { tp->ty_class = T_PROCEDURE;
+                         tp->ty_size = pointer_size;
+                         tp->ty_retval = void_type;
+                       }
+       param_list(tp)
+  |
+       /* set type */
+       /* the first integer_const represents the size in bytes,
+        * the second one represents the low bound
+        */
+       'S'             { tp->ty_class = T_SET; }
+       type(&(tp->ty_setbase), (int *) 0, (p_symbol) 0) ';'
+       [
+               integer_const(&(tp->ty_size)) ';'
+               integer_const(&(tp->ty_setlow)) ';'
+       |
+                       { set_bounds(tp); }
+       ]
+  |
+       /* file type of Pascal */
+       'L'             { tp->ty_class = T_FILE; }
+       type(&(tp->ty_fileof), (int *) 0, (p_symbol) 0)
+  |
+       type_name(ptp, (p_symbol) 0)
+                       { if (type_index &&
+                             (*ptp)->ty_class == 0 &&
+                             type_index[0] == last_index[0] &&
+                             type_index[1] == last_index[1]) {
+                               **ptp = *void_type;
+                               if (*ptp != tp) free_type(tp);
+                         }
+                         tp = *ptp;
+                       }
+  ]
+                       { if (*ptp && *ptp != tp) **ptp = *tp;
+                         else *ptp = tp;
+                       }
+;
+
+structure_type(register p_type tp; p_symbol sy;)
+  { register struct fields *fldp;
+    char *str;
+  }
+:
+  integer_const(&(tp->ty_size))                /* size in bytes */
+                       { open_scope(sy, 0);
+                         if (sy) sy->sy_name.nm_scope = CurrentScope;
+                       }
+  [
+       name(&str)      { fldp = get_field_space(tp, str); }
+       type(&(fldp->fld_type), (int *) 0, (p_symbol) 0) ','
+       integer_const(&(fldp->fld_pos)) ','     /* offset in bits */
+       integer_const(&(fldp->fld_bitsize)) ';' /* size in bits */
+  ]*
+  ';'                  { end_field(tp); 
+                         close_scope();
+                       }
+;
+
+enum_type(register p_type tp;)
+  { register struct literal *litp;
+    long maxval = 0;
+    register p_symbol s;
+  }
+:
+  [                    { litp = get_literal_space(tp); }
+       name(&(litp->lit_name))
+       integer_const(&(litp->lit_val)) ',' 
+                       { if (maxval < litp->lit_val) maxval = litp->lit_val;
+                         AllowName = 1;
+                         s = NewSymbol(litp->lit_name, CurrentScope, CONST, (struct outname *) 0);
+                         s->sy_const.co_ival = litp->lit_val;
+                         s->sy_type = tp;
+                       }
+  ]*
+  ';'                  { end_literal(tp, maxval); }
+;
+
+param_list(p_type t;)
+  { register struct param *p;
+    long iconst;
+  }
+:
+  integer_const(&iconst) ';'   /* number of parameters */
+                       { t->ty_nparams = iconst;
+                         t->ty_params = p = (struct param *)
+                           Malloc((unsigned)(t->ty_nparams * sizeof(struct param)));
+                       }
+  [
+       [       'p'     { p->par_kind = 'p'; }
+       |       'v'     { p->par_kind = 'v'; }
+       |       'i'     { p->par_kind = 'i'; }
+       ]
+       type(&(p->par_type), (int *) 0, (p_symbol) 0) ';'
+                       { t->ty_nbparams += 
+                               param_size(p->par_type, p->par_kind);
+                         p++;
+                       }
+  ]*
+;
+
+{
+static char *db_string;
+static char *DbOldPtr;
+
+static struct outname *
+DbString(n)
+  struct outname       *n;
+{
+  currnam = n;
+  DbPtr = n->on_mptr;
+  db_string = DbPtr;
+  AllowName = 1;
+  DbParser();
+  return currnam;
+}
+
+/*ARGSUSED*/
+DBSmessage(n)
+{
+  fatal("error in symbol table string \"%s\", DbPtr = \"%s\", DbOldPtr = \"%s\"",
+       db_string,
+       DbPtr,
+       DbOldPtr);
+
+}
+
+DBSonerror(tk, p)
+  int  *p;
+{
+  DbPtr = DbOldPtr;
+/* ???  if (DBSsymb < 0) {
+       while (*p && *p != ';') p++;
+       if (*p) DbPtr = ";";
+       return;
+  }
+*/
+  if (! tk) {
+       while (*p && *p != NAME) p++;
+       if (*p) {
+               AllowName = 1;
+       }
+  }
+  else if (tk == NAME) AllowName = 1;
+}
+
+DBSlex()
+{
+  register char *cp = DbPtr;
+  int allow_name = AllowName;
+  register int c;
+
+  AllowName = 0;
+  DbOldPtr = cp;
+  c = *cp;
+  if (c == '\\' && *(cp+1) == '\0') {
+       currnam++;
+       cp = currnam->on_mptr;
+       DbOldPtr = cp;
+       c = *cp;
+  }
+  if (! c) {
+       DbPtr = cp;
+       return -1;
+  }
+  if ((! allow_name && is_token(c)) || c == ';') {
+       DbPtr = cp+1;
+       return c;
+  }
+  if (is_dig(c)) {
+       int retval = INTEGER;
+
+       while (++cp, is_dig(*cp)) /* nothing */;
+       c = *cp;
+       if (c == '.') {
+               retval = REAL;
+               while (++cp, is_dig(*cp)) /* nothing */;
+               c = *cp;
+       }
+       if (c == 'e' || c == 'E') {
+               char *oldcp = cp;
+
+               cp++;
+               c = *cp;
+               if (c == '-' || c == '+') {
+                       cp++;
+                       c = *cp;
+               }
+               if (is_dig(c)) {
+                       retval = REAL;
+                       while (++cp, is_dig(*cp)) /* nothing */;
+               }
+               else cp = oldcp;
+       }
+       c = *cp;
+       *cp = 0;
+       if (retval == INTEGER) {
+               ival = str2long(DbOldPtr, 10);
+       }
+       else {
+               fval = atof(DbOldPtr);
+       }
+       *cp = c;
+       DbPtr = cp;
+       return retval;
+  }
+  if (c == '\'') {
+       cp++;
+       strval = cp;
+       while ((c = *cp) && c != '\'') {
+               if (c == '\\') cp++;    /* backslash escapes next character */
+               if (!(c =  *cp)) break; /* but not a null byte */
+               cp++;
+       }
+       if (! c) DBSmessage(0); /* no return */
+       *cp = 0;
+       DbPtr = cp + 1;
+       return STRING;
+  }
+  strval = cp;
+  while ((c = *cp) && c != ':' && c != ',') cp++;
+  DbPtr = *cp ? cp+1 : cp;
+  *cp = 0;
+  return NAME;
+}
+
+static struct fields *
+get_field_space(tp, s)
+  register p_type tp;
+  char *s;
+{
+  register struct fields *p;
+  p_symbol     sy;
+
+  if (! (tp->ty_nfields & 07)) {
+       tp->ty_fields = (struct fields *)
+                 Realloc((char *) tp->ty_fields,
+                           (tp->ty_nfields+8)*sizeof(struct fields));
+  }
+  p = &tp->ty_fields[tp->ty_nfields++];
+  p->fld_name = s;
+  p->fld_type = 0;
+  sy = NewSymbol(s, CurrentScope, FIELD, currnam);
+  sy->sy_field = p;
+  return p;
+}
+
+static
+end_field(tp)
+  register p_type tp;
+{
+  tp->ty_fields = (struct fields *)
+       Realloc((char *) tp->ty_fields,
+               tp->ty_nfields * sizeof(struct fields));
+}
+
+static struct literal *
+get_literal_space(tp)
+  register p_type tp;
+{
+  if (! (tp->ty_nenums & 07)) {
+       tp->ty_literals = (struct literal *)
+               Realloc((char *) tp->ty_literals,
+                       (tp->ty_nenums+8)*sizeof(struct literal));
+  }
+  return &tp->ty_literals[tp->ty_nenums++];
+}
+
+static char *
+string_val(s)
+  char *s;
+{
+  register char *ns = s, *os = s;
+  register unsigned int i = 1;
+
+  for (;;) {
+       if (!*os) break;
+       i++;
+       if (*os == '\\') {
+               os++;
+               *ns++ = *os++;
+       }
+       else *ns++ = *os++;
+  }
+  *ns = '\0';
+  return Salloc(s, i);
+}
+
+static char            *AckStrings;    /* ACK a.out string table */
+static struct outname  *AckNames;      /* ACK a.out symbol table entries */
+static unsigned int    NAckNames;      /* Number of ACK symbol table entries */
+static struct outname  *EndAckNames;   /* &AckNames[NAckNames] */
+
+/* Read the symbol table from file 'f', which is supposed to be an
+   ACK a.out format file. Offer DBX strings to the DBX string parser.
+*/
+int
+DbRead(f)
+  char *f;
+{
+  struct outhead h;
+  register struct outname *n;
+  register struct outname *line_file = 0;
+  long OffsetStrings;
+  int had_lbrac = 0;
+
+  /* Open file, read header, and check magic word */
+  if (! rd_open(f)) {
+       fatal("%s: could not open", f);
+  }
+  rd_ohead(&h);
+  if (BADMAGIC(h) && h.oh_magic != O_CONVERTED) {
+       fatal("%s: not an object file", f);
+  }
+
+  /* Allocate space for name table and read it */
+  AckNames = (struct outname *) 
+               Malloc((unsigned)(sizeof(struct outname) * h.oh_nname));
+  AckStrings = Malloc((unsigned) h.oh_nchar);
+  rd_name(AckNames, h.oh_nname);
+  rd_string(AckStrings, h.oh_nchar);
+
+  /* Adjust file offsets in name table to point at strings */
+  OffsetStrings = OFF_CHAR(h);
+  NAckNames = h.oh_nname;
+  EndAckNames = &AckNames[h.oh_nname];
+  for (n = EndAckNames; --n >= AckNames;) {
+       if (n->on_foff) {
+               if ((unsigned)(n->on_foff - OffsetStrings) >= h.oh_nchar) {
+                       fatal("%s: error in object file", f);
+               }
+               n->on_mptr = AckStrings + (n->on_foff - OffsetStrings);
+       }
+       else    n->on_mptr = 0;
+  }
+
+  /* Offer strings to the DBX string parser if they contain a ':'.
+     Also offer filename-line number information to add_position_addr().
+     Here, the order may be important.
+  */
+  for (n = &AckNames[0]; n < EndAckNames; n++) {
+       int tp = n->on_type >> 8;
+       register p_symbol sym;
+
+       if (tp & (S_STB >> 8)) {
+               switch(tp) {
+#ifdef N_BINCL
+               case N_BINCL:
+                       n->on_valu = (long) line_file;
+                       line_file = n;
+                       break;
+               case N_EINCL:
+                       if (line_file) {
+                               line_file = (struct outname *) line_file->on_valu;
+                       }
+                       break;
+#endif
+               case N_SO:
+                       if (n->on_mptr[strlen(n->on_mptr)-1] == '/') {
+                               /* another N_SO follows ... */
+                               break;
+                       }
+                       while (CurrentScope != PervasiveScope) {
+                               close_scope();
+                       }
+                       saw_code = 0;
+                       sym = add_file(n->on_mptr);
+
+                       if (! listfile) newfile(sym->sy_idf);
+                       open_scope(sym, 0);
+                       sym->sy_file->f_scope = CurrentScope;
+                       FileScope = CurrentScope;
+                       clean_tp_tab();
+                       /* fall through */
+               case N_SOL:
+                       if (! line_file) line_file = n;
+                       else line_file->on_mptr = n->on_mptr;
+                       break;
+               case N_MAIN:
+                       newfile(FileScope->sc_definedby->sy_idf);
+                       break;
+               case N_SLINE:
+                       assert(line_file);
+                       if (! saw_code && !CurrentScope->sc_bp_opp) {
+                           CurrentScope->sc_bp_opp = n->on_valu;
+                           if (! CurrentScope->sc_start) {
+                               CurrentScope->sc_start = n->on_valu;
+                               if (CurrentScope->sc_has_activation_record) {
+                                       add_scope_addr(CurrentScope);
+                               }
+                           }
+                       }
+                       saw_code = 1;
+                       add_position_addr(line_file->on_mptr, n);
+                       break;
+               case N_LBRAC:   /* block, desc = nesting level */
+                       if (had_lbrac) {
+                               open_scope((p_symbol) 0, 0);
+                               saw_code = 0;
+                       }
+                       else {
+                               register p_scope sc = 
+                                       get_scope_from_addr(n->on_valu);
+
+                               if (!sc || sc->sc_bp_opp) {
+                                       had_lbrac = 1;
+                               }
+                               else CurrentScope = sc;
+                       }
+                       break;
+#ifdef N_SCOPE
+               case N_SCOPE:
+                       if (n->on_mptr && strindex(n->on_mptr, ':')) {
+                               n = DbString(n);
+                       }
+                       break;
+#endif
+               case N_RBRAC:   /* end block, desc = nesting level */
+                       had_lbrac = 0;
+                       if (CurrentScope != FileScope) close_scope();
+                       saw_code = 0;
+                       break;
+               case N_FUN:     /* function, value = address */
+               case N_GSYM:    /* global variable */
+               case N_STSYM:   /* data, static, value = address */
+               case N_LCSYM:   /* bss, static, value = address */
+               case N_RSYM:    /* register var, value = reg number */
+               case N_SSYM:    /* struct/union el, value = offset */
+               case N_PSYM:    /* parameter, value = offset from AP */
+               case N_LSYM:    /* local sym, value = offset from FP */
+                       if (had_lbrac) {
+                               open_scope((p_symbol) 0, 0);
+                               saw_code = 0;
+                               had_lbrac = 0;
+                       }
+                       if (n->on_mptr && strindex(n->on_mptr, ':')) {
+                               n = DbString(n);
+                       }
+                       break;
+               default:
+/*
+                       if (n->on_mptr && (n->on_type&S_TYP) >= S_MIN) {
+                               struct idf *id = str2idf(n->on_mptr, 0);
+
+                               sym = new_symbol();
+                               sym->sy_next = id->id_def;
+                               id->id_def = sym;
+                               sym->sy_class = SYMENTRY;
+                               sym->sy_onam = *n;
+                               sym->sy_idf = id;
+                       }
+*/
+                       break;
+               }
+       }
+  }
+  close_scope();
+  add_position_addr((char *) 0, (struct outname *) 0);
+  clean_tp_tab();
+  rd_close();
+  return (h.oh_magic == O_CONVERTED);
+}
+}
diff --git a/util/grind/do_comm.c b/util/grind/do_comm.c
new file mode 100644 (file)
index 0000000..5c7d29c
--- /dev/null
@@ -0,0 +1,776 @@
+/* $Header$ */
+
+/* Implementation of the do_ routines */
+
+#include <stdio.h>
+#include <assert.h>
+#include <alloc.h>
+
+#include "operator.h"
+#include "position.h"
+#include "tree.h"
+#include "idf.h"
+#include "Lpars.h"
+#include "type.h"
+#include "expr.h"
+#include "symbol.h"
+#include "scope.h"
+#include "file.h"
+#include "message.h"
+
+extern FILE    *db_out;
+extern t_lineno        listline, currline;
+extern int     stop_reason;
+extern int     interrupted;
+
+p_tree         print_command;
+
+/* ------------------------------------------------------------- */
+
+/* implementation of the help command */
+
+do_help(p)
+  p_tree       p;
+{
+  p = p->t_args[0];
+  if (p && p->t_idf) switch(p->t_idf->id_reserved) {
+  case HELP:
+       fputs("help [ <commandname> ]\n", db_out);
+       fputs("? [ <commandname> ]\n", db_out);
+       fputs("  Print a command summary, or some more help on <commandname>.\n", db_out);
+       return;
+  case LIST:
+       fputs("list [ <start> | <func> ] [ , <cnt> | - [ <end> ] ]\n", db_out);
+       fputs("l [ <start> | <func> ] [ , <cnt> | - [ <end> ] ]\n", db_out);
+       fputs("  List lines from the current source file, starting with either\n", db_out);
+       fputs("  line <start> or some lines before the first statement of <func> or\n", db_out);
+       fputs("  the current line. Either list <cnt> lines or <wsize> lines,\n", db_out);
+       fputs("  except when a range is given.\n", db_out);
+       fputs("  <wsize> is the last <cnt> given, or 10.\n", db_out);
+       return;
+  case XFILE:
+       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);
+       return;
+  case RUN:
+       fputs("run [ <args> ] [ < <infile> ] [ > <outfile> ]\n", db_out);
+       fputs("  Start executing debuggee with command line arguments <args> and\n", db_out);
+       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);
+       return;
+  case STOP:
+       fputs("stop [ <pos> ] [ if <cond> ]\n", db_out);
+       fputs("  Stop execution when position <pos> is reached, and then when\n", db_out);
+       fputs("  <cond> becomes true. If no <pos> is given, stop when <cond>\n", db_out);
+       fputs("  becomes true.  If no <cond> is given, stop when <pos> is reached.\n", db_out);
+       fputs("  Either a position or a condition (or both) must be given.\n", db_out);
+       return;
+  case WHEN:
+       fputs("when [ <pos> ] [ if <cond> ] { <command> [ ; <command> ] ... } \n", db_out);
+       fputs("  Execute the <command>s when position <pos> is reached, and then when\n", db_out);
+       fputs("  <cond> becomes true. If no <pos> is given, do this when <cond>\n", db_out);
+       fputs("  becomes true.  If no <cond> is given, do this when <pos> is reached.\n", db_out);
+       fputs("  Either a position or a condition (or both) must be given.\n", db_out);
+       return;
+  case CONT:
+       fputs("cont [ <cnt> ] [ at <line> ]\n", db_out);
+       fputs("c [ <cnt> ] [ at <line> ]\n", db_out);
+       fputs("  Continue execution, skipping <cnt> or 1 breakpoints;a\n", db_out);
+       fputs("  if <line> is given, continue at <line>.\n", db_out);
+       return;
+  case STEP:
+  case NEXT:
+       fputs("step [ <cnt> ]\n", db_out);
+       fputs("s [ <cnt> ]\n", db_out);
+       fputs("next [ <cnt> ]\n", db_out);
+       fputs("n [ <cnt> ]\n", db_out);
+       fputs("  Execute the next <cnt> or 1 source line(s).\n", db_out);
+       fputs("  Step (s) steps into function-calls.\n", db_out);
+       fputs("  Next (n) steps past function-calls.\n", db_out);
+       return;
+  case WHERE:
+       fputs("where [ <cnt> ]\n", db_out);
+       fputs("w [ <cnt> ]\n", db_out);
+       fputs("  List all, or the top <cnt> or the bottom -<cnt> active functions.\n", db_out);
+       return;
+  case STATUS:
+       fputs("status\n", db_out);
+       fputs("  display active traces, stops, whens, displays, and dumps.\n", db_out);
+       return;
+  case DELETE:
+       fputs("delete [ <num> [ , <num> ] ... ]\n", db_out);
+       fputs("d [ <num> [ , <num> ] ...] \n", db_out);
+       fputs("  Remove the command(s) corresponding to <num> (as displayed by 'status').\n", db_out);
+       fputs("  If no <num> is given, remove the current stopping point.\n", db_out);
+       return;
+  case SET:
+       fputs("set <desig> to <exp>\n", db_out);
+       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);
+       return;
+  case DISPLAY:
+       fputs("display <exp> [ , <exp> ] ...\n", db_out);
+       fputs("  Print the value of each <exp> whenever the debuggee stops.\n", db_out);
+       return;
+  case DUMP:
+       fputs("dump\n", db_out);
+       fputs("  Saves the state of the debuggee; it can be restored with the restore command.\n", db_out);
+       return;
+  case RESTORE:
+       fputs("restore [ <num> ]\n", db_out);
+       fputs("r [ <num> ]\n", db_out);
+       fputs("  Restore the state of the dump associated with <num>,\n", db_out);
+       fputs("  or restore the state of the last dump.\n", db_out);
+       return;
+  case TRACE:
+       fputs("trace [ on <exp> ] [ <pos> ] [ if <cond> ]\n", db_out);
+       fputs("t [ on <exp> ] [ <pos> ] [ if <cond> ]\n", db_out);
+       fputs("  Without args, display each source line before execution.\n", db_out);
+       fputs("  In addition, display <exp> in the on-clause.\n", db_out);
+       fputs("  If <pos> is given and indicates a function, only display\n", db_out);
+       fputs("  tracing information while executing this function.\n", db_out);
+       fputs("  If it indicates a line number, only display tracing information\n", db_out);
+       fputs("  whenever the source line is reached.\n", db_out);
+       fputs("  If <cond> is given, only display tracing info when it evaluates to non-zero.\n", db_out);
+       return;
+  case FIND:
+       fputs("find <name>\n", db_out);
+       fputs("  Prints the fully qualified name of all symbols matching <name>.\n", db_out);
+       return;
+  case WHICH:
+       fputs("which <name>\n", db_out);
+       fputs("  Prints the fully qualified name of <name>.\n", db_out);
+       return;
+  case DISABLE:
+       fputs("disable [ <num> [ , <num> ] ... ]\n", db_out);
+       fputs("  Disable the command(s) corresponding to <num> (as displayed by 'status').\n", db_out);
+       fputs("  If no <num> is given, disable the current stopping point.\n", db_out);
+       return;
+  case ENABLE:
+       fputs("enable [ <num> [ , <num> ] ... ]\n", db_out);
+       fputs("  Enable the command(s) corresponding to <num> (as displayed by 'status'.)\n", db_out);
+       fputs("  If no <num> is given, enable the current stopping point (not effective).\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("find <name>\n", db_out);
+  fputs("help [ <commandname> ]\n", db_out);
+  fputs("list [ <start> | <func> ] [ , <cnt> | - [ <end> ] ]\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("run [ <args> ] [ < <infile> ] [ > <outfile> ]\n", db_out);
+  fputs("set <desig> to <exp>\n", db_out);
+  fputs("status\n", db_out);
+  fputs("step [ <cnt> ]\n", db_out);
+  fputs("stop [ <pos> ] [ if <cond> ]\n", db_out);
+  fputs("trace [ on <exp> ] [ <pos> ] [ if <cond> ]\n", db_out);
+  fputs("when [ <pos> ] [ if <cond> ] { <command> [ ; <command> ] ... } \n", db_out);
+  fputs("where [ <cnt> ]\n", db_out);
+  fputs("which <name>\n", db_out);
+}
+
+/* ------------------------------------------------------------- */
+
+/* implementation of dump/restore commands */
+
+extern long    pointer_size;
+extern p_tree  get_from_item_list();
+
+struct dump {
+  char *globals, *stack;
+  struct message_hdr mglobal, mstack;
+  struct dump *next;
+};
+
+static struct dump     *last_dump;
+
+do_dump(p)
+  p_tree       p;
+{
+  struct dump *d = (struct dump *) malloc(sizeof(struct dump));
+
+  if (! d) {
+       error("could not allocate enough memory");
+       return;
+  }
+  if (! get_dump(&d->mglobal, &d->globals, &d->mstack, &d->stack)) {
+       free((char *) d);
+       return;
+  }
+  p->t_args[0] = (struct tree *) d;
+  p->t_address = (t_addr) get_int(d->mglobal.m_buf+PC_OFF*pointer_size, pointer_size, T_UNSIGNED);
+  add_to_item_list(p);
+  d->next = last_dump;
+  last_dump = d;
+}
+
+do_restore(p)
+  p_tree       p;
+{
+  struct dump *d;
+  
+  if (p->t_args[0]) { 
+       p = get_from_item_list((int) p->t_args[0]->t_ival);
+       if (!p || p->t_oper != OP_DUMP) {
+               error("no such dump");
+               return;
+       }
+       d = (struct dump *) p->t_args[0];
+  }
+  else d = last_dump;
+
+  if (! d) {
+       error("no dumps");
+       return;
+  }
+
+  if (! put_dump(&d->mglobal, d->globals, &d->mstack, d->stack)) {
+  }
+  perform_items();
+}
+
+free_dump(p)
+  p_tree       p;
+{
+  struct dump *d = (struct dump *) p->t_args[0];
+
+  free(d->globals);
+  free(d->stack);
+  if (d == last_dump) last_dump = d->next;
+  else {
+       register struct dump *d1 = last_dump;
+
+       while (d1->next != d) d1 = d1->next;
+       d1->next = d->next;
+  }
+  free((char *) d);
+}
+
+/* ------------------------------------------------------------- */
+
+/* implementation of the find command */
+
+do_find(p)
+  p_tree       p;
+{
+  /* Print all identifications of p->t_args[0]. */
+  register p_symbol s;
+  p_tree       arg;
+
+  p = p->t_args[0];
+  switch(p->t_oper) {
+  case OP_NAME:
+       s = p->t_idf->id_def;
+       while (s) {
+               pr_sym(s);
+               s = s->sy_next;
+       }
+       break;
+
+  case OP_SELECT:
+       arg = p->t_args[1];
+       assert(arg->t_oper == OP_NAME);
+       s = arg->t_idf->id_def;
+       while (s) {
+               if (consistent(p, s->sy_scope)) {
+                       pr_sym(s);
+               }
+               s = s->sy_next;
+       }
+       break;
+
+  default:
+       assert(0);
+  }
+}
+
+/* ------------------------------------------------------------- */
+
+/* implementation of the which command */
+
+do_which(p)
+  p_tree       p;
+{
+  p_symbol     sym = identify(p->t_args[0], 0xffff);
+
+  if ( sym) pr_sym(sym);
+}
+
+/* ------------------------------------------------------------- */
+
+/* implementation of the list command */
+
+extern t_addr  get_addr_from_node();
+
+do_list(p)
+  p_tree       p;
+{
+  int  l1, l2;
+  static int wsize = 10;
+
+  if (p->t_args[1]) {
+       l2 = p->t_args[1]->t_ival;
+       if (l2 >= 0) {
+               if (l2 == 0) l2 = 1;
+               wsize = l2;
+       }
+  }
+  else l2 = wsize;
+
+  if (! p->t_args[0]) {
+       l1 = listline;
+       if (! l1) {
+               listline = currline - (wsize/2);
+               l1 = listline;
+       }
+  }
+  else {
+       if (p->t_args[0]->t_oper == OP_AT) {
+               l1 = p->t_args[0]->t_lino;
+               if (p->t_args[0]->t_filename) {
+                       newfile(str2idf(p->t_args[0]->t_filename, 0));
+               }
+       }
+       else {
+               t_addr  a = get_addr_from_node(p->t_args[0]);
+               p_position pos;
+               p_symbol oldlistfile = listfile;
+
+               if (a == ILL_ADDR) {
+                       return;
+               }
+               pos = get_position_from_addr(a);
+               newfile(str2idf(pos->filename, 1));
+               if (listfile != oldlistfile) {
+                       warning("switching to file %s", listfile->sy_idf->id_text);
+               }
+               l1 = pos->lineno - (l2 > 0 ? l2 : wsize)/2;
+               if (l1 < 1) l1 = 1;
+       }
+  }
+  if (listfile) {
+       if (l2 < 0) {
+               l2 = -l2;
+               if (l1 > l2) l2 = 1;
+               else l2 -= l1 - 1;
+       }
+       lines(listfile->sy_file, l1, l2);
+       listline = l1 + l2;
+  }
+  else error("no current file");
+}
+
+/* ------------------------------------------------------------- */
+
+/* implementation of the file command */
+
+do_file(p)
+  p_tree       p;
+{
+  FILE *f;
+
+  if (p->t_args[0]) {
+       if (! strcmp(p->t_args[0]->t_str, "?")) {
+               register p_symbol       sym = PervasiveScope->sc_symbs;
+
+               while (sym) {
+                       if (sym->sy_class == FILESYM) {
+                               fprintf(db_out, "%s\n", sym->sy_idf->id_text);
+                       }
+                       sym = sym->sy_prev_sc;
+               }
+               return;
+       }
+       if ((f = fopen(p->t_args[0]->t_str, "r")) == NULL) {
+               error("could not open %s", p->t_args[0]->t_str);
+               return;
+       }
+       fclose(f);
+       newfile(p->t_args[0]->t_idf);
+  }
+  else if (listfile) fprintf(db_out, "%s\n", listfile->sy_idf->id_text);
+  else error("no current file");
+}
+
+/* ------------------------------------------------------------- */
+
+/* implementation of stop/when command */
+
+setstop(p, kind)
+  p_tree       p;
+  int          kind;
+{
+  t_addr       a = get_addr_from_node(p->t_args[0]);
+
+  if (a == ILL_ADDR) return 0;
+
+  p->t_address = a;
+  if (a != NO_ADDR) {
+       if (! set_or_clear_breakpoint(a, kind)) {
+               return 0;
+       }
+  }
+  return 1;
+}
+
+do_stop(p)
+  p_tree       p;
+{
+  if (! setstop(p, M_SETBP)) {
+       return;
+  }
+  add_to_item_list(p);
+}
+
+/* ------------------------------------------------------------- */
+
+/* implementation of the trace command */
+
+settrace(p, kind)
+  p_tree       p;
+  int          kind;
+{
+  t_addr       a, e;
+
+  a = get_addr_from_node(p->t_args[0]);
+  if (a == NO_ADDR) return 1;
+  if (a == ILL_ADDR) return 0;
+  if (p->t_args[0]->t_oper == OP_AT) {
+       e = a;
+       p->t_address = a;
+  }
+  else {
+       p_scope sc = get_next_scope_from_addr(a+1);
+
+       if (sc) e = sc->sc_start - 1;
+       else e = 0xffffffff;
+  }
+  return set_or_clear_trace(a, e, kind);
+}
+
+do_trace(p)
+  p_tree       p;
+{
+  p->t_address = NO_ADDR;
+  if (! settrace(p, M_SETTRACE)) {
+       return;
+  }
+  add_to_item_list(p);
+}
+
+/* ------------------------------------------------------------- */
+
+/* implementation of the enable/disable commands */
+
+static
+able(p, kind)
+  p_tree       p;
+  int          kind;
+{
+  if (!p) {
+       if (stop_reason) {
+               able_item(stop_reason, kind);
+       }
+       else {
+               error("no current stopping point");
+       }
+       return;
+  }
+  switch(p->t_oper) {
+  case OP_LINK:
+       able(p->t_args[0], kind);
+       able(p->t_args[1], kind);
+       break;
+  case OP_INTEGER:
+       able_item((int)p->t_ival, kind);
+       break;
+  default:
+       assert(0);
+  }
+}
+
+do_enable(p)
+  p_tree       p;
+{
+  able(p->t_args[0], 0);
+}
+
+do_disable(p)
+  p_tree       p;
+{
+  able(p->t_args[0], 1);
+}
+
+/* ------------------------------------------------------------- */
+
+/* implementation of the cont command */
+
+do_continue(p)
+  p_tree       p;
+{
+  int count;
+
+  if (p) {
+       count = p->t_args[0]->t_ival;
+       if (p->t_args[1]) {
+               t_addr  a = get_addr_from_position(&(p->t_args[1]->t_pos));
+               p_scope sc = get_scope_from_addr(a);
+
+               if (a == ILL_ADDR || base_scope(sc) != base_scope(CurrentScope)) {
+                       error("cannot continue at line %d",
+                             p->t_args[1]->t_lino);
+                       return;
+               }
+               if (! set_pc(a)) {
+                       return;
+               }
+       }
+  }
+  else count = 1;
+  while (count--) {
+       if (! send_cont(count==0)) {
+               break;
+       }
+  }
+  if (count > 0) {
+       fprintf(db_out, "Only %d breakpoints skipped\n",
+               p->t_args[0]->t_ival - count);
+  }
+}
+
+/* ------------------------------------------------------------- */
+
+/* implementation of the step command */
+
+do_step(p)
+  p_tree       p;
+{
+  p = p->t_args[0];
+  if (! singlestep(M_SETSS, p ? p->t_ival : 1L)) {
+  }
+}
+
+/* ------------------------------------------------------------- */
+
+/* implementation of the next command */
+
+do_next(p)
+  p_tree       p;
+{
+  p = p->t_args[0];
+  if (! singlestep(M_SETSSF, p? p->t_ival : 1L)) {
+  }
+}
+
+extern t_addr  *get_EM_regs();
+
+/* ------------------------------------------------------------- */
+
+/* implementation of the regs command (temporarily) */
+
+do_regs(p)
+  p_tree       p;
+{
+  t_addr       *buf;
+  int          n = 0;
+
+  p = p->t_args[0];
+  if (p) n = p->t_ival;
+  if (! (buf = get_EM_regs(n))) {
+       return;
+  }
+  fprintf(db_out, "EM registers %d levels back:\n", n);
+  fprintf(db_out, "\tLocalBase =\t0x%lx\n\tArgumentBase =\t0x%lx\n", 
+               (long) buf[LB_OFF], (long) buf[AB_OFF]);
+  fprintf(db_out, "\tProgramCounter=\t0x%lx\n\tHeapPointer = \t0x%lx\n",
+               (long) buf[PC_OFF],
+               (long) buf[HP_OFF]);
+  fprintf(db_out, "\tStackPointer =\t0x%lx\n", (long) buf[SP_OFF]);
+}
+
+/* ------------------------------------------------------------- */
+
+/* implementation of the where command */
+
+/*ARGSUSED*/
+do_where(p)
+  p_tree       p;
+{
+  int i = 0;
+  unsigned int cnt;
+  unsigned int maxcnt = 0xffff;
+  p_scope sc;
+  t_addr *buf;
+  t_addr PC;
+
+  p = p->t_args[0];
+  if (p && p->t_ival < 0) {
+       for (;;) {
+               buf = get_EM_regs(i++);
+               if (! buf || ! buf[AB_OFF]) break;
+               PC = buf[PC_OFF];
+               sc = base_scope(get_scope_from_addr(PC));
+               if (! sc || sc->sc_start > PC) break;
+               if (interrupted) return;
+       }
+       i--;
+       maxcnt = - p->t_ival;
+       i -= maxcnt;
+       if (i < 0) i = 0;
+  }
+  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[AB_OFF];
+       PC = buf[PC_OFF];
+       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);
+  }
+}
+
+/* ------------------------------------------------------------- */
+
+/* implementation of the delete command */
+
+extern p_tree  remove_from_item_list();
+
+do_delete(p)
+  p_tree       p;
+{
+  switch(p->t_oper) {
+  case OP_DELETE:
+       if (! p->t_args[0]) {
+               if (stop_reason) {
+                       remove_from_item_list(stop_reason);
+                       stop_reason = 0;
+               }
+               else {
+                       error("no current stopping point");
+               }
+       }
+       else do_delete(p->t_args[0]);
+       break;
+  case OP_LINK:
+       do_delete(p->t_args[0]);
+       do_delete(p->t_args[1]);
+       break;
+  case OP_INTEGER:
+       p = remove_from_item_list((int) p->t_ival);
+
+       if (p) switch(p->t_oper) {
+       case OP_WHEN:
+       case OP_STOP:
+               setstop(p, M_CLRBP);
+               break;
+       case OP_TRACE:
+               settrace(p, M_CLRTRACE);
+               break;
+       case OP_DUMP:
+               free_dump(p);
+       }
+       freenode(p);
+       break;
+  default:
+       assert(0);
+  }
+}
+
+/* ------------------------------------------------------------- */
+
+/* implementation of the print command */
+
+do_print(p)
+  p_tree       p;
+{
+  char *buf = 0;
+  char *format = 0;
+  long size;
+  p_type tp;
+
+  switch(p->t_oper) {
+  case OP_PRINT:
+       if (p->t_args[0] == 0) {
+               p = print_command;
+               if (p == 0) {
+                       error("no previous print command");
+                       break;
+               }
+       }
+       else if (p != print_command) {
+               /* freenode(print_command); No, could be in when-list */
+               print_command = p;
+       }
+       /* fall through */
+  case OP_DISPLAY:
+       do_print(p->t_args[0]);
+       break;
+  case OP_LINK:
+       do_print(p->t_args[0]);
+       do_print(p->t_args[1]);
+       break;
+  default:
+       if (interrupted || ! eval_expr(p, &buf, &size, &tp)) return;
+       print_node(p, 0);
+       fputs(" = ", db_out);
+       if (p->t_oper == OP_FORMAT) {
+               format = p->t_args[1]->t_str;
+       }
+       print_val(tp, size, buf, 0, 0, format);
+       if (buf) free(buf);
+       fputs("\n", db_out);
+       break;
+  }
+}
+
+/* ------------------------------------------------------------- */
+
+/* implementation of the set command */
+
+do_set(p)
+  p_tree       p;
+{
+  char *buf = 0;
+  long size, size2;
+  p_type tp, tp2;
+  t_addr a;
+
+  if (interrupted || ! eval_desig(p->t_args[0], &a, &size, &tp) ||
+      ! eval_expr(p->t_args[1], &buf, &size2, &tp2) ||
+      ! convert(&buf, &size2, &tp2, tp, size)) {
+       if (buf) free(buf);
+       return;
+  }
+
+  if (interrupted) {
+       free(buf);
+       return;
+  }
+  set_bytes(size, buf, a);
+  free(buf);
+}
+
index af6b9b4..6410ef7 100644 (file)
@@ -241,7 +241,7 @@ eval_cond(p)
 /* one routine for each unary operator */
 
 static int
-do_not(p, pbuf, psize, ptp)
+not_op(p, pbuf, psize, ptp)
   p_tree       p;
   char         **pbuf;
   long         *psize;
@@ -258,7 +258,7 @@ do_not(p, pbuf, psize, ptp)
 }
 
 static int
-do_bnot(p, pbuf, psize, ptp)
+bnot_op(p, pbuf, psize, ptp)
   p_tree       p;
   char         **pbuf;
   long         *psize;
@@ -307,7 +307,7 @@ ptr_addr(p, paddr, psize, ptp)
 }
 
 static int
-do_deref(p, pbuf, psize, ptp)
+deref_op(p, pbuf, psize, ptp)
   p_tree       p;
   char         **pbuf;
   long         *psize;
@@ -329,7 +329,7 @@ do_deref(p, pbuf, psize, ptp)
 }
 
 static int
-do_addr(p, pbuf, psize, ptp)
+addr_op(p, pbuf, psize, ptp)
   p_tree       p;
   char         **pbuf;
   long         *psize;
@@ -349,7 +349,7 @@ do_addr(p, pbuf, psize, ptp)
 }
 
 static int
-do_unmin(p, pbuf, psize, ptp)
+unmin_op(p, pbuf, psize, ptp)
   p_tree       p;
   char         **pbuf;
   long         *psize;
@@ -375,7 +375,7 @@ do_unmin(p, pbuf, psize, ptp)
 }
 
 static int
-do_unplus(p, pbuf, psize, ptp)
+unplus_op(p, pbuf, psize, ptp)
   p_tree       p;
   char         **pbuf;
   long         *psize;
@@ -399,8 +399,8 @@ do_unplus(p, pbuf, psize, ptp)
 
 static int (*un_op[])() = {
   0,
-  do_not,
-  do_deref,
+  not_op,
+  deref_op,
   0,
   0,
   0,
@@ -409,8 +409,8 @@ static int (*un_op[])() = {
   0,
   0,
   0,
-  do_unplus,
-  do_unmin,
+  unplus_op,
+  unmin_op,
   0,
   0,
   0,
@@ -422,11 +422,11 @@ static int (*un_op[])() = {
   0,
   0,
   0,
-  do_bnot,
+  bnot_op,
   0,
   0,
   0,
-  do_addr
+  addr_op
 };
 
 static p_type
@@ -504,7 +504,7 @@ balance(tp1, tp2)
 }
 
 static int
-do_andor(p, pbuf, psize, ptp)
+andor_op(p, pbuf, psize, ptp)
   p_tree       p;
   char         **pbuf;
   long         *psize;
@@ -535,7 +535,7 @@ do_andor(p, pbuf, psize, ptp)
 }
 
 static int
-do_arith(p, pbuf, psize, ptp)
+arith_op(p, pbuf, psize, ptp)
   p_tree       p;
   char         **pbuf;
   long         *psize;
@@ -699,7 +699,7 @@ do_arith(p, pbuf, psize, ptp)
 }
 
 static int
-do_sft(p, pbuf, psize, ptp)
+sft_op(p, pbuf, psize, ptp)
   p_tree       p;
   char         **pbuf;
   long         *psize;
@@ -747,7 +747,7 @@ do_sft(p, pbuf, psize, ptp)
 }
 
 static int
-do_cmp(p, pbuf, psize, ptp)
+cmp_op(p, pbuf, psize, ptp)
   p_tree       p;
   char         **pbuf;
   long         *psize;
@@ -859,7 +859,7 @@ do_cmp(p, pbuf, psize, ptp)
 }
 
 static int
-do_in(p, pbuf, psize, ptp)
+in_op(p, pbuf, psize, ptp)
   p_tree       p;
   char         **pbuf;
   long         *psize;
@@ -951,7 +951,7 @@ array_addr(p, paddr, psize, ptp)
 }
 
 static int
-do_array(p, pbuf, psize, ptp)
+array_op(p, pbuf, psize, ptp)
   p_tree       p;
   char         **pbuf;
   long         *psize;
@@ -1009,7 +1009,7 @@ select_addr(p, paddr, psize, ptp)
 }
 
 static int
-do_select(p, pbuf, psize, ptp)
+select_op(p, pbuf, psize, ptp)
   p_tree       p;
   char         **pbuf;
   long         *psize;
@@ -1030,7 +1030,7 @@ do_select(p, pbuf, psize, ptp)
 }
 
 static int
-do_derselect(p, pbuf, psize, ptp)
+derselect_op(p, pbuf, psize, ptp)
   p_tree       p;
   char         **pbuf;
   long         *psize;
@@ -1054,31 +1054,31 @@ static int (*bin_op[])() = {
   0,
   0,
   0,
-  do_andor,
-  do_andor,
-  do_arith,
-  do_arith,
-  do_arith,
-  do_arith,
-  do_in,
-  do_array,
-  do_arith,
-  do_arith,
-  do_arith,
-  do_cmp,
-  do_cmp,
-  do_cmp,
-  do_cmp,
-  do_cmp,
-  do_cmp,
-  do_select,
-  do_arith,
-  do_arith,
-  do_arith,
+  andor_op,
+  andor_op,
+  arith_op,
+  arith_op,
+  arith_op,
+  arith_op,
+  in_op,
+  array_op,
+  arith_op,
+  arith_op,
+  arith_op,
+  cmp_op,
+  cmp_op,
+  cmp_op,
+  cmp_op,
+  cmp_op,
+  cmp_op,
+  select_op,
+  arith_op,
+  arith_op,
+  arith_op,
   0,
-  do_derselect,
-  do_sft,
-  do_sft,
+  derselect_op,
+  sft_op,
+  sft_op,
   0
 };
 
index 304de3b..2c91248 100644 (file)
@@ -1,14 +1,7 @@
-/*
- * (c) copyright 1987 by the Vrije Universiteit, Amsterdam, The Netherlands.
- * See the copyright notice in the ACK home directory, in the file "Copyright".
- *
- * Author: Ceriel J.H. Jacobs
- */
-
-/* I N S T A N T I A T I O N   O F   I D F   P A C K A G E */
-
 /* $Header$ */
 
+/* Instantiation of idf package */
+
 #include       "position.h"
 #include       "file.h"
 #include       "idf.h"
index 71eff3a..4f3f8de 100644 (file)
@@ -1,14 +1,7 @@
-/*
- * (c) copyright 1987 by the Vrije Universiteit, Amsterdam, The Netherlands.
- * See the copyright notice in the ACK home directory, in the file "Copyright".
- *
- * Author: Ceriel J.H. Jacobs
- */
-
-/* U S E R   D E C L A R E D   P A R T   O F   I D F */
-
 /* $Header$ */
 
+/* User-declared part of idf structure */
+
 struct id_u {
        int id_res;
        struct symbol *id_df;
index 83e170a..d36410a 100644 (file)
@@ -71,7 +71,7 @@ item_addr_actions(a, mess_type, may_stop)
            && (p->t_address == a || p->t_address == NO_ADDR)) {
                switch(p->t_oper) {
                case OP_STOP:
-                       if (mess_type != DB_SS && mess_type != OK) break;
+                       if (mess_type != M_DB_SS && mess_type != M_OK) break;
                        if (! p->t_args[1] || eval_cond(p->t_args[1])) {
                                if (! stop_reason) stop_reason = i->i_itemno;
                                stopping = 1;
@@ -94,7 +94,7 @@ item_addr_actions(a, mess_type, may_stop)
            && (p->t_address == a || p->t_address == NO_ADDR)) {
                switch(p->t_oper) {
                case OP_TRACE:
-                       if ((! stopping && mess_type != END_SS)
+                       if ((! stopping && mess_type != M_END_SS)
                            || p->t_args[2] || ! may_stop) {
                                perform(p, a);
                        }
@@ -154,24 +154,27 @@ remove_from_item_list(n)
   int  n;
 {
   register p_item i = item_list.il_first, prev = 0;
-  p_tree       p = 0;
+  p_tree       p;
 
   while (i) {
        if (i->i_itemno == n) break;
        prev = i;
        i = i->i_next;
   }
-  if (i) {
-       if (prev) {
-               prev->i_next = i->i_next;
-       }
-       else item_list.il_first = i->i_next;
-       if (i == item_list.il_last) item_list.il_last = prev;
-       p = i->i_node;
-       if (p->t_address == NO_ADDR
-           && (p->t_oper != OP_TRACE || ! p->t_args[0])) db_ss--;
-       free_item(i);
+  if (! i) {
+       error("no item %d in current status", n);
+       return 0;
   }
+  if (i->i_itemno == stop_reason) stop_reason = 0;
+  if (prev) {
+       prev->i_next = i->i_next;
+  }
+  else item_list.il_first = i->i_next;
+  if (i == item_list.il_last) item_list.il_last = prev;
+  p = i->i_node;
+  if (p->t_address == NO_ADDR
+      && (p->t_oper != OP_TRACE || ! p->t_args[0])) db_ss--;
+  free_item(i);
   return p;
 }
 
@@ -215,10 +218,10 @@ able_item(n, kind)
   switch(p->t_oper) {
   case OP_STOP:
   case OP_WHEN:
-       setstop(p, kind ? CLRBP : SETBP);
+       setstop(p, kind ? M_CLRBP : M_SETBP);
        break;
   case OP_TRACE:
-       settrace(p, kind ? CLRTRACE : SETTRACE);
+       settrace(p, kind ? M_CLRTRACE : M_SETTRACE);
        break;
   }
 }
@@ -232,7 +235,7 @@ print_items()
   }
 }
 
-do_items()
+perform_items()
 {
   register p_item i = item_list.il_first;
 
index 41f8c8a..665f5b8 100644 (file)
@@ -1,3 +1,5 @@
+/* $Header$ */
+
 #include <stdio.h>
 #include <varargs.h>
 
@@ -66,7 +68,7 @@ main(argc, argv)
   init_types();
   init_scope();
   init_languages();
-  if (DbxRead(AckObj) && AObj == 0) AObj = AckObj;
+  if (DbRead(AckObj) && AObj == 0) AObj = AckObj;
   else if (AObj == 0) AObj = "a.out";
   reserve(tkidf);
   reserve(shorts);
@@ -75,7 +77,7 @@ main(argc, argv)
   }
   prompt();
   Commands();
-  if (eof_seen) fputc('\n', db_out);
+  if (eof_seen) putc('\n', db_out);
   exit(0);
 }
 
@@ -87,7 +89,7 @@ prompt()
   }
 }
 
-/*VARARGS1*/
+/*VARARGS*/
 fatal(va_alist)
   va_dcl
 {
@@ -107,7 +109,7 @@ fatal(va_alist)
 
 extern int errorgiven;
 
-/*VARARGS1*/
+/*VARARGS*/
 error(va_alist)
   va_dcl
 {
@@ -127,7 +129,7 @@ error(va_alist)
   errorgiven = 1;
 }
 
-/*VARARGS1*/
+/*VARARGS*/
 warning(va_alist)
   va_dcl
 {
index 719c899..1466f86 100644 (file)
@@ -5,38 +5,38 @@
 struct message_hdr {
   int  m_type;
 /* Possible values of m_type: */
-#define DB_RUN 020000  /* set for commands that cause child to run */
-#define        SETBP    0      /* set breakpoint at address in m_size */
-#define        CLRBP    1      /* clear breakpoint at address in m_size */
-#define        SETSS    (2|DB_RUN)     /* set single stepping, # of steps in m_size */
-#define SETSSF  (3|DB_RUN)     /* set single stepping, counting calls as one step */
-#define        GETEMREGS 4     /* get EM registers, m_size contains level */
-#define        GETBYTES 5      /* get data; m_size contains size, m_buf contains address */
-#define GETSTR  6      /* get string; m_buf contains address */
-#define SETBYTES 7     /* set data; m_buf contains address, m_size contains size */
-#define CALL    8      /* call function; 
+#define M_DB_RUN       020000  /* set for commands that cause child to run */
+#define        M_SETBP  0      /* set breakpoint at address in m_size */
+#define        M_CLRBP  1      /* clear breakpoint at address in m_size */
+#define        M_SETSS  (2|M_DB_RUN)   /* set single stepping, # of steps in m_size */
+#define M_SETSSF (3|M_DB_RUN)  /* set single stepping, counting calls as one step */
+#define        M_GETEMREGS 4   /* get EM registers, m_size contains level */
+#define        M_GETBYTES 5    /* get data; m_size contains size, m_buf contains address */
+#define M_GETSTR        6      /* get string; m_buf contains address */
+#define M_SETBYTES 7   /* set data; m_buf contains address, m_size contains size */
+#define M_CALL  8      /* call function; 
                           m_size contains size of parameter buffer,
                           m_buf contains address + size of function result
                        */
-#define CONT    (9|DB_RUN)     /* continue */
-#define        SETEMREGS 10    /* set EM registers, m_size contains level
+#define M_CONT  (9|M_DB_RUN)   /* continue */
+#define        M_SETEMREGS 10  /* set EM registers, m_size contains level
                           Actually, only the program counter is set.
                        */
-#define DB_SS  040000  /* debugger wants single stepping (to be orred with
+#define M_DB_SS        040000  /* debugger wants single stepping (to be orred with
                           SETSS(F) or CONT
                        */
-#define CLRSS  12      /* clear single stepping */
-#define DUMP   13      /* dump command */
-#define DGLOB  14      /* data area */
-#define DSTACK 15      /* stack area */
-#define SETTRACE 16    /* start tracing; range in m_mes */
-#define CLRTRACE 17    /* end tracing */
+#define M_CLRSS        12      /* clear single stepping */
+#define M_DUMP 13      /* dump command */
+#define M_DGLOB        14      /* data area */
+#define M_DSTACK       15      /* stack area */
+#define M_SETTRACE 16  /* start tracing; range in m_mes */
+#define M_CLRTRACE 17  /* end tracing */
 
-#define        OK      50      /* answer of child to most messages */
-#define FAIL   51      /* answer of child when something goes wrong */
-#define DATA   52      /* answer of child when data requested */
-#define END_SS 53      /* when stopped because of user single stepping */
-#define INTR   54      /* sent on interrupt */
+#define        M_OK    50      /* answer of child to most messages */
+#define M_FAIL 51      /* answer of child when something goes wrong */
+#define M_DATA 52      /* answer of child when data requested */
+#define M_END_SS       53      /* when stopped because of user single stepping */
+#define M_INTR 54      /* sent on interrupt */
   long m_size;         /* size */
   char m_buf[BUFLEN];  /* some of the data required included in message */
 };
index cfb3725..1440990 100644 (file)
@@ -224,7 +224,7 @@ print_val(tp, tp_sz, addr, compressed, indent, format)
                        break;
                } 
                if (i > 1) {
-                       fputc(',', db_out);
+                       putc(',', db_out);
                }
                fprintf(db_out, "\n%*c", i > 1 ? indent : indent - 4, ' ');
        }
@@ -259,7 +259,7 @@ print_val(tp, tp_sz, addr, compressed, indent, format)
                        break;
                } 
                if (i > 1) {
-                       fputc(',', db_out);
+                       putc(',', db_out);
                }
                fprintf(db_out, "\n%*c", i > 1 ? indent : indent - 4, ' ');
        }
index e2fd02b..9ffb506 100644 (file)
@@ -192,8 +192,8 @@ start_child(p)
        curr_stop = m.m_size;
        CurrentScope = get_scope_from_addr(curr_stop);
   }
-  do_items();
-  if (! restoring && ! item_addr_actions(curr_stop, OK, 1)) {
+  perform_items();
+  if (! restoring && ! item_addr_actions(curr_stop, M_OK, 1)) {
        send_cont(1);
   }
   else if (! restoring) {
@@ -354,7 +354,7 @@ could_send(m, stop_message)
                error("no process");
                return 0;
        }
-       if (m->m_type & DB_RUN) {
+       if (m->m_type & M_DB_RUN) {
                disable_intr = 0;
                stop_reason = 0;
        }
@@ -363,7 +363,7 @@ could_send(m, stop_message)
        }
        disable_intr = 1;
        if ((interrupted || child_interrupted) && ! child_dead) {
-               while (child_interrupted && answer.m_type != INTR) {
+               while (child_interrupted && answer.m_type != M_INTR) {
                        if (! ugetm(&answer)) {
                                child_dead = 1;
                                break;
@@ -397,24 +397,24 @@ could_send(m, stop_message)
        }
        a = answer.m_size;
        type = answer.m_type;
-       if (m->m_type & DB_RUN) {
+       if (m->m_type & M_DB_RUN) {
                /* run command */
                CurrentScope = get_scope_from_addr((t_addr) a);
                if (! item_addr_actions(a, type, stop_message) &&
-                   ( type == DB_SS || type == OK)) {
+                   ( type == M_DB_SS || type == M_OK)) {
                        /* no explicit breakpoints at this position.
                           Also, child did not stop because of
                           SETSS or SETSSF, otherwise we would
                           have gotten END_SS.
                           So, continue.
                        */
-                       if ((m->m_type & ~ DB_SS) != CONT) {
-                               m->m_type = CONT | (m->m_type & DB_SS);
+                       if ((m->m_type & ~ M_DB_SS) != M_CONT) {
+                               m->m_type = M_CONT | (m->m_type & M_DB_SS);
                        }
                        continue;
                }
-               if (type != END_SS && single_stepping) {
-                       m->m_type = CLRSS;
+               if (type != M_END_SS && single_stepping) {
+                       m->m_type = M_CLRSS;
                        if (! uputm(m) || ! ugetm(&answer)) return 0;
                }
                single_stepping = 0;
@@ -445,13 +445,13 @@ getbytes(size, from, to, kind)
   }
 
   switch(answer.m_type) {
-  case FAIL:
+  case M_FAIL:
        error("could not get value");
        return 0;
-  case INTR:
+  case M_INTR:
        error("interrupted");
        return 0;
-  case DATA:
+  case M_DATA:
        return ureceive(to, answer.m_size);
   default:
        assert(0);
@@ -465,7 +465,7 @@ get_bytes(size, from, to)
   t_addr from;
   char *to;
 {
-  return getbytes(size, from, to, GETBYTES);
+  return getbytes(size, from, to, M_GETBYTES);
 }
 
 int
@@ -474,7 +474,7 @@ get_string(size, from, to)
   t_addr from;
   char *to;
 {
-  int retval = getbytes(size, from, to, GETSTR);
+  int retval = getbytes(size, from, to, M_GETSTR);
 
   to[(int)answer.m_size] = 0;
   return retval;
@@ -487,7 +487,7 @@ set_bytes(size, from, to)
 {
   struct message_hdr   m;
 
-  m.m_type = SETBYTES;
+  m.m_type = M_SETBYTES;
   m.m_size = size;
   put_int(m.m_buf, pointer_size, (long) to);
 
@@ -495,13 +495,13 @@ set_bytes(size, from, to)
        return;
   }
   switch(answer.m_type) {
-  case FAIL:
+  case M_FAIL:
        error("could not handle this SET request");
        break;
-  case INTR:
+  case M_INTR:
        error("interrupted");
        break;
-  case OK:
+  case M_OK:
        break;
   default:
        assert(0);
@@ -515,18 +515,18 @@ get_dump(globmessage, globbuf, stackmessage, stackbuf)
 {
   struct message_hdr   m;
 
-  m.m_type = DUMP;
+  m.m_type = M_DUMP;
   if (! could_send(&m, 0)) {
        return 0;
   }
   switch(answer.m_type) {
-  case FAIL:
+  case M_FAIL:
        error("request for DUMP failed");
        return 0;
-  case INTR:
+  case M_INTR:
        error("interrupted");
        return 0;
-  case DGLOB:
+  case M_DGLOB:
        break;
   default:
        assert(0);
@@ -538,7 +538,7 @@ get_dump(globmessage, globbuf, stackmessage, stackbuf)
        if (*globbuf) free(*globbuf);
        return 0;
   }
-  assert(stackmessage->m_type == DSTACK);
+  assert(stackmessage->m_type == M_DSTACK);
   *stackbuf = malloc((unsigned) stackmessage->m_size);
   if (! ureceive(*stackbuf, stackmessage->m_size)) {
        if (*globbuf) free(*globbuf);
@@ -583,20 +583,20 @@ get_EM_regs(level)
   static t_addr buf[5];
   register t_addr *to = &buf[0];
 
-  m.m_type = GETEMREGS;
+  m.m_type = M_GETEMREGS;
   m.m_size = level;
 
   if (! could_send(&m, 0)) {
        return 0;
   }
   switch(answer.m_type) {
-  case FAIL:
+  case M_FAIL:
        error("request for registers failed");
        return 0;
-  case INTR:
+  case M_INTR:
        error("interrupted");
        return 0;
-  case GETEMREGS:
+  case M_GETEMREGS:
        break;
   default:
        assert(0);
@@ -615,18 +615,18 @@ set_pc(PC)
 {
   struct message_hdr   m;
 
-  m.m_type = SETEMREGS;
+  m.m_type = M_SETEMREGS;
   m.m_size = 0;
   put_int(m.m_buf+PC_OFF*pointer_size, pointer_size, (long)PC);
   if (! could_send(&m, 0)) return 0;
   switch(answer.m_type) {
-  case FAIL:
+  case M_FAIL:
        error("could not set PC to %lx", (long) PC);
        return 0;
-  case INTR:
+  case M_INTR:
        error("interrupted");
        return 0;
-  case OK:
+  case M_OK:
        return 1;
   default:
        assert(0);
@@ -640,19 +640,19 @@ send_cont(stop_message)
 {
   struct message_hdr   m;
 
-  m.m_type = (CONT | (db_ss ? DB_SS : 0));
+  m.m_type = (M_CONT | (db_ss ? M_DB_SS : 0));
   m.m_size = 0;
   return could_send(&m, stop_message) && child_pid;
 }
 
 int
-do_single_step(type, count)
+singlestep(type, count)
   int  type;
   long count;
 {
   struct message_hdr   m;
 
-  m.m_type = type | (db_ss ? DB_SS : 0);
+  m.m_type = type | (db_ss ? M_DB_SS : 0);
   m.m_size = count;
   single_stepping = 1;
   if (could_send(&m, 1) && child_pid) return 1;
@@ -669,7 +669,7 @@ set_or_clear_breakpoint(a, type)
 
   m.m_type = type;
   m.m_size = a;
-  if (debug) printf("%s breakpoint at 0x%lx\n", type == SETBP ? "setting" : "clearing", (long) a);
+  if (debug) printf("%s breakpoint at 0x%lx\n", type == M_SETBP ? "setting" : "clearing", (long) a);
   if (child_pid && ! could_send(&m, 0)) {
   }
 
@@ -686,7 +686,7 @@ set_or_clear_trace(start, end, type)
   m.m_type = type;
   put_int(m.m_buf, pointer_size, (long)start);
   put_int(m.m_buf+pointer_size, pointer_size, (long)end);
-  if (debug) printf("%s trace at [0x%lx,0x%lx]\n", type == SETTRACE ? "setting" : "clearing", (long) start, (long) end);
+  if (debug) printf("%s trace at [0x%lx,0x%lx]\n", type == M_SETTRACE ? "setting" : "clearing", (long) start, (long) end);
   if (child_pid && ! could_send(&m, 0)) {
        return 0;
   }
index 2ff629a..b901a66 100644 (file)
@@ -1,7 +1,7 @@
-/* Scope mechanism */
-
 /* $Header$ */
 
+/* Scope mechanism */
+
 #include       <assert.h>
 #include       <alloc.h>
 #include       <out.h>
index 1916282..5a661d2 100644 (file)
@@ -1,7 +1,7 @@
-/* scope structure */
-
 /* $Header$ */
 
+/* scope structure */
+
 typedef struct scope {
   struct scope *sc_static_encl;        /* linked list of enclosing scopes */
   struct symbol *sc_symbs;             /* symbols defined in this scope */
index 90cd6ae..93a16a1 100644 (file)
@@ -1,3 +1,5 @@
+/* $Header$ */
+
 /* For the time being ... */
 
 #define SZ_INT         4
index 139c947..afd85fa 100644 (file)
@@ -154,7 +154,7 @@ def_scope(s)
 
 /* Determine if the OP_SELECT tree indicated by 'p' could lead to scope 'sc'.
 */
-static int
+int
 consistent(p, sc)
   p_tree       p;
   p_scope      sc;
@@ -298,7 +298,6 @@ pr_scopes(sc)
   }
 }
 
-static
 pr_sym(s)
   p_symbol     s;
 {
@@ -339,49 +338,6 @@ pr_sym(s)
   fprintf(db_out, "%s\n", s->sy_idf->id_text);
 }
 
-/* Print all identifications of p->t_args[0].
-*/
-do_find(p)
-  p_tree       p;
-{
-  register p_symbol s;
-  p_tree       arg;
-
-  p = p->t_args[0];
-  switch(p->t_oper) {
-  case OP_NAME:
-       s = p->t_idf->id_def;
-       while (s) {
-               pr_sym(s);
-               s = s->sy_next;
-       }
-       break;
-
-  case OP_SELECT:
-       arg = p->t_args[1];
-       assert(arg->t_oper == OP_NAME);
-       s = arg->t_idf->id_def;
-       while (s) {
-               if (consistent(p, s->sy_scope)) {
-                       pr_sym(s);
-               }
-               s = s->sy_next;
-       }
-       break;
-
-  default:
-       assert(0);
-  }
-}
-
-do_which(p)
-  p_tree       p;
-{
-  p_symbol     sym = identify(p->t_args[0], 0xffff);
-
-  if ( sym) pr_sym(sym);
-}
-
 resolve_cross(tp)
   p_type       tp;
 {
index e3d7099..c19b529 100644 (file)
@@ -1,12 +1,3 @@
-/*
- * (c) copyright 1987 by the Vrije Universiteit, Amsterdam, The Netherlands.
- * See the copyright notice in the ACK home directory, in the file "Copyright".
- *
- * Author: Ceriel J.H. Jacobs
- */
-
-/* T O K E N   D E F I N I T I O N S */
-
 /* $Header$ */
 
 #include       "tokenname.h"
index b3a4720..94b5899 100644 (file)
@@ -1,12 +1,3 @@
-/*
- * (c) copyright 1987 by the Vrije Universiteit, Amsterdam, The Netherlands.
- * See the copyright notice in the ACK home directory, in the file "Copyright".
- *
- * Author: Ceriel J.H. Jacobs
- */
-
-/* T O K E N N A M E   S T R U C T U R E */
-
 /* $Header$ */
 
 struct tokenname       {       /*      Used for defining the name of a
index 8619641..6edc2b0 100644 (file)
 
 extern FILE    *db_out;
 t_lineno       currline;
-static t_lineno        listline;
-extern long    pointer_size;
+t_lineno       listline;
 extern char    *strrindex();
 extern int     interrupted;
-extern int     stop_reason;
-
-p_tree         print_command;
-
-static int     wsize = 10;
 
 /*VARARGS1*/
 p_tree
@@ -89,7 +83,7 @@ freenode(p)
   free_tree(p);
 }
 
-static t_addr
+t_addr
 get_addr_from_node(p)
   p_tree       p;
 {
@@ -399,73 +393,6 @@ eval(p)
   if (p && operators[p->t_oper].op_fun) (*operators[p->t_oper].op_fun)(p);
 }
 
-do_list(p)
-  p_tree       p;
-{
-  int  l1, l2;
-
-  if (p->t_args[1]) {
-       l2 = p->t_args[1]->t_ival;
-       if (l2 >= 0) {
-               if (l2 == 0) l2 = 1;
-               wsize = l2;
-       }
-  }
-  else l2 = wsize;
-
-  if (! p->t_args[0]) {
-       l1 = listline;
-       if (! l1) {
-               listline = currline - (wsize/2);
-               l1 = listline;
-       }
-  }
-  else {
-       if (p->t_args[0]->t_oper == OP_INTEGER) {
-               l1 = p->t_args[0]->t_ival;
-       }
-       else {
-               t_addr  a = get_addr_from_node(p->t_args[0]);
-               p_position pos;
-
-               if (a == ILL_ADDR) {
-                       return;
-               }
-               pos = get_position_from_addr(a);
-               newfile(str2idf(pos->filename, 1));
-               l1 = pos->lineno - (l2 > 0 ? l2 : wsize)/2;
-               if (l1 < 1) l1 = 1;
-       }
-  }
-  if (listfile) {
-       if (l2 < 0) {
-               l2 = -l2;
-               if (l1 > l2) l2 = 1;
-               else l2 -= l1 - 1;
-       }
-       lines(listfile->sy_file, l1, l2);
-       listline = l1 + l2;
-  }
-  else error("no current file");
-}
-
-do_file(p)
-  p_tree       p;
-{
-  FILE *f;
-
-  if (p->t_args[0]) {
-       if ((f = fopen(p->t_args[0]->t_str, "r")) == NULL) {
-               error("could not open %s", p->t_args[0]->t_str);
-               return;
-       }
-       fclose(f);
-       newfile(p->t_args[0]->t_idf);
-  }
-  else if (listfile) fprintf(db_out, "%s\n", listfile->sy_idf->id_text);
-  else error("no current file");
-}
-
 newfile(id)
   register struct idf  *id;
 {
@@ -481,328 +408,6 @@ newfile(id)
   find_language(strrindex(id->id_text, '.'));
 }
 
-setstop(p, kind)
-  p_tree       p;
-  int          kind;
-{
-  t_addr       a = get_addr_from_node(p->t_args[0]);
-
-  if (a == ILL_ADDR) return 0;
-
-  p->t_address = a;
-  if (a != NO_ADDR) {
-       if (! set_or_clear_breakpoint(a, kind)) {
-               return 0;
-       }
-  }
-  return 1;
-}
-
-do_stop(p)
-  p_tree       p;
-{
-  if (! setstop(p, SETBP)) {
-       return;
-  }
-  add_to_item_list(p);
-}
-
-settrace(p, kind)
-  p_tree       p;
-  int          kind;
-{
-  t_addr       a, e;
-
-  a = get_addr_from_node(p->t_args[0]);
-  if (a == NO_ADDR) return 1;
-  if (a == ILL_ADDR) return 0;
-  if (p->t_args[0]->t_oper == OP_AT) {
-       e = a;
-       p->t_address = a;
-  }
-  else {
-       p_scope sc = get_next_scope_from_addr(a+1);
-
-       if (sc) e = sc->sc_start - 1;
-       else e = 0xffffffff;
-  }
-  return set_or_clear_trace(a, e, kind);
-}
-
-do_trace(p)
-  p_tree       p;
-{
-  p->t_address = NO_ADDR;
-  if (! settrace(p, SETTRACE)) {
-       return;
-  }
-  add_to_item_list(p);
-}
-
-static
-able(p, kind)
-  p_tree       p;
-  int          kind;
-{
-  if (!p) {
-       if (stop_reason) {
-               able_item(stop_reason, kind);
-       }
-       else {
-               error("no current stopping point");
-       }
-       return;
-  }
-  switch(p->t_oper) {
-  case OP_LINK:
-       able(p->t_args[0], kind);
-       able(p->t_args[1], kind);
-       break;
-  case OP_INTEGER:
-       able_item((int)p->t_ival, kind);
-       break;
-  default:
-       assert(0);
-  }
-}
-
-do_enable(p)
-  p_tree       p;
-{
-  able(p->t_args[0], 0);
-}
-
-do_disable(p)
-  p_tree       p;
-{
-  able(p->t_args[0], 1);
-}
-
-do_continue(p)
-  p_tree       p;
-{
-  int count;
-
-  if (p) {
-       count = p->t_args[0]->t_ival;
-       if (p->t_args[1]) {
-               t_addr  a = get_addr_from_position(&(p->t_args[1]->t_pos));
-               p_scope sc = get_scope_from_addr(a);
-
-               if (a == ILL_ADDR || base_scope(sc) != base_scope(CurrentScope)) {
-                       error("cannot continue at line %d",
-                             p->t_args[1]->t_lino);
-                       return;
-               }
-               if (! set_pc(a)) {
-                       return;
-               }
-       }
-  }
-  else count = 1;
-  while (count--) {
-       if (! send_cont(count==0)) {
-               break;
-       }
-  }
-  if (count > 0) {
-       fprintf(db_out, "Only %d breakpoints skipped\n",
-               p->t_args[0]->t_ival - count);
-  }
-}
-
-do_step(p)
-  p_tree       p;
-{
-  p = p->t_args[0];
-  if (! do_single_step(SETSS, p ? p->t_ival : 1L)) {
-  }
-}
-
-do_next(p)
-  p_tree       p;
-{
-  p = p->t_args[0];
-  if (! do_single_step(SETSSF, p? p->t_ival : 1L)) {
-  }
-}
-
-extern t_addr  *get_EM_regs();
-
-do_regs(p)
-  p_tree       p;
-{
-  t_addr       *buf;
-  int          n = 0;
-
-  p = p->t_args[0];
-  if (p) n = p->t_ival;
-  if (! (buf = get_EM_regs(n))) {
-       return;
-  }
-  fprintf(db_out, "EM registers %d levels back:\n", n);
-  fprintf(db_out, "\tLocalBase =\t0x%lx\n\tArgumentBase =\t0x%lx\n", 
-               (long) buf[LB_OFF], (long) buf[AB_OFF]);
-  fprintf(db_out, "\tProgramCounter=\t0x%lx\n\tHeapPointer = \t0x%lx\n",
-               (long) buf[PC_OFF],
-               (long) buf[HP_OFF]);
-  fprintf(db_out, "\tStackPointer =\t0x%lx\n", (long) buf[SP_OFF]);
-}
-
-/*ARGSUSED*/
-do_where(p)
-  p_tree       p;
-{
-  int i = 0;
-  unsigned int cnt;
-  unsigned int maxcnt = 0xffff;
-  p_scope sc;
-  t_addr *buf;
-  t_addr PC;
-
-  p = p->t_args[0];
-  if (p && p->t_ival < 0) {
-       for (;;) {
-               buf = get_EM_regs(i++);
-               if (! buf || ! buf[AB_OFF]) break;
-               PC = buf[PC_OFF];
-               sc = base_scope(get_scope_from_addr(PC));
-               if (! sc || sc->sc_start > PC) break;
-               if (interrupted) return;
-       }
-       i--;
-       maxcnt = - p->t_ival;
-       i -= maxcnt;
-       if (i < 0) i = 0;
-  }
-  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[AB_OFF];
-       PC = buf[PC_OFF];
-       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);
-  }
-}
-
-extern p_tree  remove_from_item_list();
-
-do_delete(p)
-  p_tree       p;
-{
-  switch(p->t_oper) {
-  case OP_DELETE:
-       if (! p->t_args[0]) {
-               if (stop_reason) {
-                       remove_from_item_list(stop_reason);
-                       stop_reason = 0;
-               }
-               else {
-                       error("no current stopping point");
-               }
-       }
-       else do_delete(p->t_args[0]);
-       break;
-  case OP_LINK:
-       do_delete(p->t_args[0]);
-       do_delete(p->t_args[1]);
-       break;
-  case OP_INTEGER:
-       p = remove_from_item_list((int) p->t_ival);
-
-       if (p) switch(p->t_oper) {
-       case OP_WHEN:
-       case OP_STOP:
-               setstop(p, CLRBP);
-               break;
-       case OP_TRACE:
-               settrace(p, CLRTRACE);
-               break;
-       case OP_DUMP:
-               free_dump(p);
-       }
-       freenode(p);
-       break;
-  default:
-       assert(0);
-  }
-}
-
-do_print(p)
-  p_tree       p;
-{
-  char *buf = 0;
-  char *format = 0;
-  long size;
-  p_type tp;
-
-  switch(p->t_oper) {
-  case OP_PRINT:
-       if (p->t_args[0] == 0) {
-               p = print_command;
-               if (p == 0) {
-                       error("no previous print command");
-                       break;
-               }
-       }
-       else if (p != print_command) {
-               /* freenode(print_command); No, could be in when-list */
-               print_command = p;
-       }
-       /* fall through */
-  case OP_DISPLAY:
-       do_print(p->t_args[0]);
-       break;
-  case OP_LINK:
-       do_print(p->t_args[0]);
-       do_print(p->t_args[1]);
-       break;
-  default:
-       if (interrupted || ! eval_expr(p, &buf, &size, &tp)) return;
-       print_node(p, 0);
-       fputs(" = ", db_out);
-       if (p->t_oper == OP_FORMAT) {
-               format = p->t_args[1]->t_str;
-       }
-       print_val(tp, size, buf, 0, 0, format);
-       if (buf) free(buf);
-       fputs("\n", db_out);
-       break;
-  }
-}
-
-do_set(p)
-  p_tree       p;
-{
-  char *buf = 0;
-  long size, size2;
-  p_type tp, tp2;
-  t_addr a;
-
-  if (interrupted || ! eval_desig(p->t_args[0], &a, &size, &tp) ||
-      ! eval_expr(p->t_args[1], &buf, &size2, &tp2) ||
-      ! convert(&buf, &size2, &tp2, tp, size)) {
-       if (buf) free(buf);
-       return;
-  }
-
-  if (interrupted) {
-       free(buf);
-       return;
-  }
-  set_bytes(size, buf, a);
-  free(buf);
-}
-
 perform(p, a)
   register p_tree      p;
   t_addr               a;