--- /dev/null
+AMAKELIB = { . , /usr/local/lib/amake } ;
+
+%include ack-defs.amk ;
+%include common.amk ;
+%include cc_hh_tools.amk ;
+%include tok_tools.amk ;
+%include op_tools.amk ;
+%include char_tools.amk ;
+%include LLgen.amk ;
+%include cc-c.amk ;
+%include loader.amk ;
+%include lint.amk ;
+
+%default grind ;
+
+TOKENNAMES = tokenname.c [
+ gen_tokens,
+ cc-dest = symbol2str.c,
+ LL-dest = tokenfile.g
+];
+
+DBS_LLTARGETS = {
+ dbx_string.c[type=C-src],
+ DBSpars.c[type=C-src],
+ DBSpars.h[type=C-incl]
+} ;
+
+DBS_LLSRC = {
+ dbx_string.g
+} ;
+
+CMD_LLTARGETS = {
+ tokenfile.c[type=C-src],
+ commands.c[type=C-src],
+ Lpars.c[type=C-src],
+ Lpars.h[type=C-incl]
+} ;
+
+CMD_LLSRC = {
+ tokenname.c,
+ commands.g
+} ;
+
+GENNEXTSRC = {
+ file.h[type=C-incl],
+ next.c[type=C-src]
+} ;
+
+CSRC = {
+ dbxread.c,
+ main.c,
+ list.c,
+ tree.c,
+ expr.c,
+ position.c,
+ idf.c,
+ run.c,
+ dump.c,
+ symbol.c,
+ print.c,
+ value.c,
+ type.c,
+ rd.c,
+ modula-2.c
+} ;
+
+HSRC = {
+ tokenname.h,
+ operator.h,
+ class.h,
+ position.h,
+ idf.h,
+ message.h,
+ avl.h,
+ scope.h,
+ langdep.h,
+ sizes.h,
+ rd.h
+} ;
+
+HHSRC = {
+ file.hh,
+ type.hh,
+ symbol.hh,
+ tree.hh,
+ avl.cc,
+ scope.cc,
+ itemlist.cc,
+ langdep.cc
+} ;
+
+LIBRARIES = {
+ $EMHOME/modules/lib/libassert.a,
+ $EMHOME/modules/lib/liballoc.a,
+ $EMHOME/modules/lib/malloc.o,
+ $EMHOME/modules/lib/libstring.a,
+ $EMHOME/modules/lib/libobject.a,
+ $EMHOME/modules/lib/libsystem.a
+} ;
+
+DBFLAGS = { -g, -DDEBUG } ;
+PROFFLAGS = { } ;
+
+LDFLAGS = {
+ -Bstatic,
+ $PROFFLAGS,
+ $DBFLAGS
+} ;
+
+INCLUDES = {
+ -I$EMHOME/modules/h,
+ -I$EMHOME/modules/pkg,
+ -I$EMHOME/h
+} ;
+
+CFLAGS = {
+ $INCLUDES,
+ $PROFFLAGS,
+ $DBFLAGS
+} ;
+
+LINTFLAGS = {
+ $INCLUDES
+} ;
+
+%cluster {
+ %targets $DBS_LLTARGETS ;
+ %sources $DBS_LLSRC ;
+ %use LLgen(prefix => DBS) ;
+} ;
+
+%cluster {
+ %targets lint.out[type = lint-output];
+ %sources $CMD_LLSRC + $CSRC + $DBS_LLTARGETS + $HHSRC + char.ct + operators.ot ;
+ %use lint(realdest => lint.out) ;
+} ;
+
+%cluster {
+ %targets grind[type = program];
+ %sources $CMD_LLSRC + $CSRC + $DBS_LLTARGETS + $HHSRC + char.ct + operators.ot ;
+} ;
--- /dev/null
+# LLgen: LL(1) parser generator
+# variables: LLGEN, LLFLAGS
+
+# tool definition for the new version of LLgen that allows for more than
+# one parser in one program. Unfortunately, for historical reasons there
+# is no proper default prefix for LLgen-generated files (LL.output versus
+# Lpars.[ch]). If LLgen would generate LLpars.[ch] instead of Lpars.[ch],
+# we could have a default value for prefix of 'LL', which would make
+# things a bit more simple.
+
+%instance deftypesuffix(LLgen-src, '%.g') ;
+
+%include ack-defs.amk;
+
+%if (%not defined(LLGEN), {
+ LLGEN = $EMHOME/bin/LLgen;
+});
+
+%if (%not defined(LLFLAGS), {
+ LLFLAGS = {};
+});
+
+%tool LLgen (
+ verbose: %boolean => %false;
+ flags: %string %list => $LLFLAGS;
+ prefix: %string => '';
+ src: %in %list [type = LLgen-src];
+ parser: %out %list [type = C-src]
+ => match($src) + if($prefix == '', Lpars.c, $prefix'pars.c');
+ tokens: %out [type = C-incl, compare]
+ => if($prefix == '', Lpars.h, $prefix'pars.h');
+ diagn: %out [type = text]
+ => if($prefix == '', LL.output, $prefix.output) %conform $verbose;
+ cmd: %in [type = command] => $LLGEN;
+)
+{
+ exec($cmd, args => if($verbose, {'-vvv'}, {}) + $flags + $src);
+ echo({'LLgen ', $src, ' done'});
+};
+
--- /dev/null
+- front-end cannot generate DBX symbol table information for bit-fields,
+ because it does not know about byte-order.
+- single stepping on a line by line basis is difficult if you use breakpoints.
+ The problem is where to set the next breakpoint. One solution is to use
+ single-stepping until we are at a different line, but this is probably
+ extremely slow. Another solution is to adapt edb's method.
--- /dev/null
+This is GRIND (GRind Is Not Dbx). This program is still being developed,
+so behaviour may change without notice.
+
--- /dev/null
+# definition of EMHOME
+
+%if (%not defined(EMHOME), {
+ EMHOME = /usr/proj/em/Work;
+});
--- /dev/null
+/* $Header$ */
+
+#include <alloc.h>
+
+/* Implementation of AVL-trees: trees in which the difference in depth
+ of the left branch and the right branch is at most one.
+ The difference in depth is indicated by a "balance" flag in each node:
+ this flag has one of three values:
+ . indicating that the left branch has the same depth as the right branch,
+ + indicating that the right branch is deeper,
+ - indicating that the left branch is deeper.
+ So, a node has the following structure:
+*/
+
+struct avl_node {
+ struct avl_node
+ *left,
+ *right; /* the left and right branches */
+ char *info; /* pointer to information in this node */
+ char balance; /* balance information described above */
+};
+
+/* create definitions for new_avl_node() and free_avl_node() */
+/* STATICALLOCDEF "avl_node" 10 */
+
+/* There is also a tree header, which contains the root of the tree and
+ the address of a user-supplied comparison routine:
+*/
+
+struct avl_tree {
+ struct avl_node
+ *root; /* root of the avl tree */
+ int (*cmp)(); /* address of comparison routine */
+};
+/* create definitions for new_avl_tree() and free_avl_tree() */
+/* STATICALLOCDEF "avl_tree" 2 */
+
+/* The next routine adds a node to an avl tree. It returns 1 if the
+ tree got deeper.
+*/
+static int
+balance_add(ppsc, n, cmp)
+ struct avl_node **ppsc; /* address of root */
+ register char *n; /* user-supplied information */
+ int (*cmp)(); /* user-supplied comparison routine */
+{
+ register struct avl_node *psc = *ppsc, *qsc, *ssc;
+
+ if (! psc) {
+ *ppsc = new_avl_node();
+ (*ppsc)->balance = '.';
+ (*ppsc)->info = n;
+ return 1;
+ }
+ if ((*cmp)(n, psc->info) < 0) {
+ if (balance_add(&(psc->left), n, cmp)) {
+ /* left hand side got deeper */
+ if (psc->balance == '+') {
+ /* but the right hand side was deeper */
+ psc->balance = '.';
+ return 0;
+ }
+ if (psc->balance == '.') {
+ /* but the right hand side was as deep */
+ psc->balance = '-';
+ return 1;
+ }
+ /* left hand side already was one deeper; re-organize */
+ qsc = psc->left;
+ if (qsc->balance == '-') {
+ /* if left-hand side of left node was deeper,
+ this node becomes the new root
+ */
+ psc->balance = '.';
+ qsc->balance = '.';
+ psc->left = qsc->right;
+ qsc->right = psc;
+ *ppsc = qsc;
+ return 0;
+ }
+ /* else the right node of the left node becomes the new root */
+ ssc = qsc->right;
+ psc->left = ssc->right;
+ qsc->right = ssc->left;
+ ssc->left = qsc;
+ ssc->right = psc;
+ *ppsc = ssc;
+ if (ssc->balance == '.') {
+ psc->balance = '.';
+ qsc->balance = '.';
+ return 0;
+ }
+ if (ssc->balance == '-') {
+ psc->balance = '+';
+ qsc->balance = '.';
+ ssc->balance = '.';
+ return 0;
+ }
+ psc->balance = '.';
+ qsc->balance = '-';
+ }
+ return 0;
+ }
+ if (balance_add(&(psc->right), n, cmp)) {
+ /* right hand side got deeper */
+ if (psc->balance == '-') {
+ /* but the left hand side was deeper */
+ psc->balance = '.';
+ return 0;
+ }
+ if (psc->balance == '.') {
+ /* but the left hand side as deep */
+ psc->balance = '+';
+ return 1;
+ }
+ /* right hand side already was one deeper; re-organize */
+ qsc = psc->right;
+ if (qsc->balance == '+') {
+ /* if right-hand side of left node was deeper,
+ this node becomes the new root
+ */
+ psc->balance = '.';
+ qsc->balance = '.';
+ psc->right = qsc->left;
+ qsc->left = psc;
+ *ppsc = qsc;
+ return 0;
+ }
+ /* else the left node of the right node becomes the new root */
+ ssc = qsc->left;
+ psc->right = ssc->left;
+ qsc->left = ssc->right;
+ ssc->right = qsc;
+ ssc->left = psc;
+ *ppsc = ssc;
+ if (ssc->balance == '.') {
+ psc->balance = '.';
+ qsc->balance = '.';
+ return 0;
+ }
+ if (ssc->balance == '+') {
+ psc->balance = '-';
+ qsc->balance = '.';
+ ssc->balance = '.';
+ return 0;
+ }
+ psc->balance = '.';
+ qsc->balance = '+';
+ }
+ return 0;
+}
+
+/* extern struct avl_tree *create_avl_tree(int (*cmp)());
+ Returns a fresh avl_tree structure.
+*/
+struct avl_tree *
+create_avl_tree(cmp)
+ int (*cmp)(); /* comparison routine */
+{
+ register struct avl_tree *p = new_avl_tree();
+
+ p->cmp = cmp;
+ return p;
+}
+
+/* extern add_to_avl_tree(struct avl_tree *tree, char *n);
+ Adds the information indicated by 'n' to the avl_tree indicated by 'tree'
+*/
+add_to_avl_tree(tree, n)
+ struct avl_tree *tree; /* tree to be added to */
+ char *n; /* information */
+{
+ balance_add(&(tree->root), n, tree->cmp);
+}
+
+/* extern char *find_ngt(struct avl_tree *tree, char *n);
+ Returns the information in the largest node that still compares <= to 'n',
+ or 0 if not present.
+*/
+char *
+find_ngt(tree, n)
+ struct avl_tree *tree; /* tree to be searched in */
+ char *n; /* information to be compared with */
+{
+ register struct avl_node *nd = tree->root, *lastnd = 0;
+
+ for (;;) {
+ while (nd && (*tree->cmp)(nd->info, n) > 0) {
+ nd = nd->left;
+ }
+ while (nd && (*tree->cmp)(nd->info, n) <= 0) {
+ lastnd = nd;
+ nd = nd->right;
+ }
+ if (! nd) break;
+ }
+ return lastnd ? lastnd->info : (char *) 0;
+}
+
+/* extern char *find_nlt(struct avl_tree *tree, char *n);
+ Returns the information in the largest node that still compares >= to 'n',
+ or 0 if not present.
+*/
+char *
+find_nlt(tree, n)
+ struct avl_tree *tree; /* tree to be searched in */
+ char *n; /* information to be compared with */
+{
+ register struct avl_node *nd = tree->root, *lastnd = 0;
+
+ for (;;) {
+ while (nd && (*tree->cmp)(nd->info, n) < 0) {
+ nd = nd->right;
+ }
+ while (nd && (*tree->cmp)(nd->info, n) >= 0) {
+ lastnd = nd;
+ nd = nd->left;
+ }
+ if (! nd) break;
+ }
+ return lastnd ? lastnd->info : (char *) 0;
+}
+
+/* extern char *find_eq(struct avl_tree *tree, char *n);
+ Returns the information in the node that compares equal to 'n',
+ or 0 if not present.
+*/
+char *
+find_eq(tree, n)
+ struct avl_tree *tree; /* tree to be searched in */
+ char *n; /* information to be compared with */
+{
+ register struct avl_node *nd = tree->root;
+
+ for (;;) {
+ while (nd && (*tree->cmp)(nd->info, n) < 0) {
+ nd = nd->right;
+ }
+ while (nd && (*tree->cmp)(nd->info, n) > 0) {
+ nd = nd->left;
+ }
+ if (! nd) break;
+ }
+ return nd ? nd->info : (char *) 0;
+}
--- /dev/null
+/* $Header$ */
+
+/* AVL-trees: trees in which the difference in depth
+ of the left branch and the right branch is at most one.
+ Information in the nodes is represented by a pointer, which is to
+ be supplied by the user. The user is also expected to supply a
+ comparison routine for each AVL tree. This routine is offered two
+ parameters, both pointers, and is expected to return:
+ a negative number if the comparison result is <
+ 0 if the comparison result is =
+ a positive number if the comparison result is >
+*/
+
+typedef struct avl_tree *AVL_tree;
+
+/* extern AVL_tree create_avl_tree(int (*cmp)());
+ Returns a fresh avl_tree structure. 'cmp' will be used as comparison
+ routine for this tree.
+*/
+extern AVL_tree create_avl_tree();
+
+/* extern add_to_avl_tree(AVL_tree tree, char *n);
+ Adds the information indicated by 'n' to the avl_tree indicated by 'tree'.
+*/
+extern add_to_avl_tree();
+
+/* extern char *find_ngt(AVL_tree tree, char *n);
+ Returns the information in the largest node that still compares <= to 'n',
+ or 0 if not present.
+*/
+extern char *find_ngt();
+
+/* extern char *find_nlt(AVL_tree tree, char *n);
+ Returns the information in the largest node that still compares >= to 'n',
+ or 0 if not present.
+*/
+extern char *find_nlt();
+
+/* extern char *find_eq(AVL_tree tree, char *n);
+ Returns the information in the node that compares equal to 'n',
+ or 0 if not present.
+*/
+extern char *find_eq();
--- /dev/null
+%instance deftypesuffix(hh-src, '%.hh') ;
+%instance deftypesuffix(cc-src, '%.cc') ;
+
+ALLOCD = make.allocd;
+NEXT = make.next;
+
+%tool allochd (
+ hhsrc: %in [type = hh-src, persistent];
+ hsrc: %out [type = C-incl] => match($hhsrc);
+ prog: %in [type = command] => $ALLOCD;
+)
+{
+ exec($prog, stdin => $hhsrc, stdout => $hsrc);
+ echo({$hsrc ,'created'});
+};
+
+
+%tool alloccd (
+ ccsrc: %in [type = cc-src, persistent];
+ csrc: %out [type = C-src] => match($ccsrc);
+ prog: %in [type = command] => $ALLOCD;
+)
+{
+ exec($prog, stdin => $ccsrc, stdout => $csrc);
+ echo({$csrc ,'created'});
+};
+
+
+# Possibly there's only one type of { cc-src, hh-src } available,
+# so introduce a new attribute.
+
+%derive f[cc-or-hh-src] %when get($f, type) == cc-src
+ %or get($f, type) == hh-src;
+
+%tool mknext (
+ cchhsrc: %in %list [cc-or-hh-src];
+ next: %out [type = C-src] => next.c;
+ prog: %in [type = command] => $NEXT;
+)
+{
+ exec($prog, args => $cchhsrc, stdout => $next);
+ echo({$next ,'created'});
+};
--- /dev/null
+% character tables for debugger
+% $Header$
+%S257
+%F %s,
+%
+% CHARACTER CLASSES
+%
+%iSTGARB
+STSKIP: \t\013\014\015
+STNL:;\012
+STIDF:a-zA-Z_$
+STSTR:"'
+STDOT:.
+STNUM:0-9
+STSIMP:,<>{}:`
+%T#include "class.h"
+%Tchar tkclass[] = {
+%p
+%T};
+%
+% INIDF
+%
+%S129
+%C
+1:a-zA-Z0-9_$
+%Tchar inidf[] = {
+%F %s,
+%p
+%T};
+%
+% INEXT
+%
+%S129
+%C
+1:-#+{}~`@%^=|\\;:?/,a-zA-Z0-9_$.
+%Tchar inext[] = {
+%F %s,
+%p
+%T};
+%
+% ISDIG
+%
+%C
+1:0-9
+%Tchar isdig[] = {
+%p
+%T};
+%
+% ISHEX
+%
+%C
+1:A-F0-9
+%Tchar ishex[] = {
+%p
+%T};
+%
+% ISOCT
+%
+%C
+1:0-7
+%Tchar isoct[] = {
+%p
+%T};
+%
+% ISTOKEN
+%
+%C
+1:-abcefiprstuvxAEFGLMPQSTVX,;:+=()*
+%T char istoken[] = {
+%p
+%T};
--- /dev/null
+# tabgen: tool definition for character table generator
+# variables: TABGEN, CHTAB
+
+%include ack-defs.amk;
+
+%if (%not defined(TABGEN), {
+ TABGEN = $EMHOME/bin/tabgen;
+});
+
+%if (%not defined(CHTAB), {
+ CHTAB = chtab.c;
+});
+
+%instance deftypesuffix(char_tab, '%.ct');
+
+%tool gen_tab (
+ chtab: %in [type = char_tab];
+ cfile: %out [type = C-src] => $CHTAB;
+ mktab: %in [type = command] => $TABGEN;
+)
+{
+ exec($mktab, args => '-f' $chtab, stdout => $cfile);
+ echo({$cfile, 'created'});
+};
--- /dev/null
+/*
+ * (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 */
+#define STDOT 3 /* '.' can start a number, or be a separate token */
+#define STCOMP 4 /* this one can start a compound token */
+#define STIDF 5 /* being the initial character of an identifier */
+#define STCHAR 6 /* the starter of a character constant */
+#define STSTR 7 /* the starter of a string */
+#define STNUM 8 /* the starter of a numeric constant */
+#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
+ the decision whether a character has a special meaning.
+*/
+#define in_idf(ch) ((unsigned)ch < 0177 && inidf[ch])
+#define in_ext(ch) ((unsigned)ch < 0177 && inext[ch])
+#define is_oct(ch) ((unsigned)ch < 0177 && isoct[ch])
+#define is_dig(ch) ((unsigned)ch < 0177 && isdig[ch])
+#define is_hex(ch) ((unsigned)ch < 0177 && ishex[ch])
+#define is_token(ch) ((unsigned)ch < 0177 && istoken[ch])
+
+extern char tkclass[];
+extern char inidf[], isoct[], isdig[], ishex[], inext[], istoken[];
--- /dev/null
+/* $Header$ */
+
+/* Command grammar */
+{
+#include <stdio.h>
+#include <alloc.h>
+#include <setjmp.h>
+#include <signal.h>
+
+#include "ops.h"
+#include "class.h"
+#include "position.h"
+#include "file.h"
+#include "idf.h"
+#include "symbol.h"
+#include "tree.h"
+
+extern char *Salloc();
+extern t_lineno currline;
+extern FILE *db_in;
+
+int errorgiven;
+int extended_charset = 0;
+jmp_buf jmpbuf;
+
+static int init_del();
+static int skip_to_eol();
+
+static struct token {
+ int tokno;
+ long ival;
+ char *str;
+ double fval;
+ struct idf *idf;
+} tok, aside;
+
+#define TOK tok.tokno
+#define ASIDE aside.tokno
+}
+%start Commands, commands;
+
+%lexical LLlex;
+
+commands
+ { p_tree com, lastcom = 0;
+ }
+:
+ { if (! setjmp(jmpbuf)) {
+ init_del();
+ }
+ else {
+ skip_to_eol();
+ goto prmpt;
+ }
+ }
+ [ %persistent command_line(&com)
+ { if (com) {
+ if (errorgiven) {
+ freenode(com);
+ com = 0;
+ }
+ if (lastcom && !in_status(lastcom) &&
+ lastcom != run_command) {
+ freenode(lastcom);
+ lastcom = 0;
+ }
+
+ if (com) {
+ if (repeatable(com)) {
+ lastcom = com;
+ }
+ eval(com);
+ if (! repeatable(com) &&
+ ! in_status(com) &&
+ com != run_command) {
+ freenode(com);
+ }
+ }
+ } else if (lastcom && ! errorgiven) eval(lastcom);
+ }
+ [ '\n' { prmpt: prompt(); }
+ | ';'
+ ] { errorgiven = 0; }
+ ]*
+ { signal_child(SIGKILL); }
+;
+
+command_line(p_tree *p;)
+:
+ list_command(p)
+| file_command(p)
+| run_command(p)
+| stop_command(p)
+| when_command(p)
+| continue_command(p)
+| step_command(p)
+| next_command(p)
+| regs_command(p)
+| WHERE { *p = mknode(OP_WHERE); }
+| STATUS { *p = mknode(OP_STATUS); }
+| DUMP { *p = mknode(OP_DUMP); }
+| RESTORE INTEGER { *p = mknode(OP_RESTORE, tok.ival); }
+| delete_command(p)
+| print_command(p)
+| trace_command(p)
+| { *p = 0; }
+;
+
+list_command(p_tree *p;)
+ { p_tree t1 = 0, t2 = 0; }
+:
+ LIST
+ [
+ | lin_num(&t1)
+ [ ',' lin_num(&t2)
+ | { t2 = mknode(OP_INTEGER, t1->t_ival); }
+ ]
+ ] { *p = mknode(OP_LIST, t1, t2); }
+;
+
+file_command(p_tree *p;)
+:
+ XFILE { extended_charset = 1; }
+ [ { *p = 0; }
+ | name(p) { (*p)->t_idf = str2idf((*p)->t_str, 0); }
+ ] { *p = mknode(OP_FILE, *p);
+ extended_charset = 0;
+ }
+;
+
+run_command(p_tree *p;)
+:
+ RUN { extended_charset = 1; *p = 0; }
+ args(p) { *p = mknode(OP_RUN, *p);
+ extended_charset = 0;
+ freenode(run_command);
+ run_command = *p;
+ }
+| RERUN { if (! run_command) {
+ error("no run command given yet");
+ }
+ else *p = run_command;
+ }
+;
+
+stop_command(p_tree *p;)
+ { p_tree whr = 0, cond = 0; }
+:
+ STOP
+ where(&whr)?
+ condition(&cond)? { if (! whr && ! cond) {
+ error("no position or condition");
+ *p = 0;
+ }
+ else *p = mknode(OP_STOP, whr, cond);
+ }
+;
+
+trace_command(p_tree *p;)
+ { p_tree whr = 0, cond = 0, exp = 0; }
+:
+ TRACE
+ [ ON expression(&exp) ]?
+ where(&whr)?
+ condition(&cond)? { *p = mknode(OP_TRACE, whr, cond, exp); }
+;
+
+continue_command(p_tree *p;)
+ { long l; p_tree pos = 0; }
+:
+ CONT
+ [ INTEGER { l = tok.ival; }
+ | { l = 1; }
+ ]
+ position(&pos)?
+ { *p = mknode(OP_CONT, mknode(OP_INTEGER, l), pos); }
+;
+
+when_command(p_tree *p;)
+ { p_tree whr = 0, cond = 0; }
+:
+ WHEN
+ where(&whr)?
+ condition(&cond)?
+ '{'
+ command_line(p)
+ [ ';' { *p = mknode(OP_LINK, *p, (p_tree) 0);
+ p = &((*p)->t_args[1]);
+ }
+ command_line(p)
+ ]*
+ '}'
+ { if (! whr && ! cond) {
+ error("no position or condition");
+ freenode(*p);
+ *p = 0;
+ }
+ else *p = mknode(OP_WHEN, whr, cond, *p);
+ }
+;
+
+step_command(p_tree *p;)
+ { long l; }
+:
+ STEP
+ [ INTEGER { l = tok.ival; }
+ | { l = 1; }
+ ] { *p = mknode(OP_STEP, l); }
+;
+
+next_command(p_tree *p;)
+ { long l; }
+:
+ NEXT
+ [ INTEGER { l = tok.ival; }
+ | { l = 1; }
+ ] { *p = mknode(OP_NEXT, l); }
+;
+
+regs_command(p_tree *p;)
+ { long l; }
+:
+ REGS
+ [ INTEGER { l = tok.ival; }
+ | { l = 0; }
+ ] { *p = mknode(OP_REGS, l); }
+;
+
+delete_command(p_tree *p;)
+:
+ DELETE
+ INTEGER { *p = mknode(OP_DELETE, tok.ival); }
+;
+
+print_command(p_tree *p;)
+:
+ PRINT expression(p) { *p = mknode(OP_PRINT, *p);
+ p = &((*p)->t_args[0]);
+ }
+ [ ',' { *p = mknode(OP_LINK, *p, (p_tree) 0);
+ p = &((*p)->t_args[1]);
+ }
+ expression(p)
+ ]*
+;
+
+condition(p_tree *p;)
+:
+ IF expression(p)
+;
+
+where(p_tree *p;)
+:
+ IN qualified_name(p) { *p = mknode(OP_IN, *p); }
+|
+ position(p)
+;
+
+expression(p_tree *p;)
+:
+ qualified_name(p)
+;
+
+position(p_tree *p;)
+ { p_tree lin;
+ char *str;
+ }
+:
+ AT
+ [ STRING { str = tok.str; }
+ ':'
+ | { if (! currfile) str = 0;
+ else str = currfile->sy_idf->id_text;
+ }
+ ]
+ lin_num(&lin) { *p = mknode(OP_AT, lin->t_ival, str);
+ freenode(lin);
+ }
+;
+
+args(p_tree *p;)
+ { int first_time = 1; }
+:
+ [ { if (! first_time) {
+ *p = mknode(OP_LINK, *p, (p_tree) 0);
+ p = &((*p)->t_args[1]);
+ }
+ first_time = 0;
+ }
+ arg(p)
+ ]*
+;
+
+arg(p_tree *p;)
+:
+ name(p)
+|
+ '>' name(p) { (*p)->t_oper = OP_OUTPUT; }
+|
+ '<' name(p) { (*p)->t_oper = OP_INPUT; }
+;
+
+lin_num(p_tree *p;)
+:
+ INTEGER { *p = mknode(OP_INTEGER, tok.ival); }
+;
+
+qualified_name(p_tree *p;)
+:
+ name(p)
+ [ '`' { *p = mknode(OP_SELECT, *p, (p_tree) 0); }
+ name(&((*p)->t_args[1]))
+ ]*
+;
+
+name(p_tree *p;)
+:
+ [ XFILE
+ | LIST
+ | RUN
+ | RERUN
+ | STOP
+ | WHEN
+ | AT
+ | IN
+ | IF
+ | NAME
+ | CONT
+ | STEP
+ | NEXT
+ | REGS
+ | WHERE
+ | STATUS
+ | PRINT
+ | DELETE
+ | DUMP
+ | RESTORE
+ | TRACE
+ | ON
+ ] { *p = mknode(OP_NAME, tok.idf, tok.str); }
+;
+
+{
+int
+LLlex()
+{
+ register int c;
+
+ if (ASIDE) {
+ tok = aside;
+ ASIDE = 0;
+ return TOK;
+ }
+ do {
+ c = getc(db_in);
+ } while (c != EOF && class(c) == STSKIP);
+ if (c == EOF) return c;
+ switch(class(c)) {
+ case STSTR:
+ TOK = get_string(c);
+ break;
+ case STIDF:
+ TOK = get_name(c);
+ break;
+ case STDOT:
+ c = getc(db_in);
+ if (c == EOF || class(c) != STNUM) {
+ ungetc(c,db_in);
+ TOK = '.';
+ break;
+ }
+ /* Fall through */
+ case STNUM:
+ TOK = get_number(c);
+ break;
+ case STNL:
+ case STSIMP:
+ TOK = c;
+ break;
+ default:
+ error("illegal character '\\0%o'", c);
+ return LLlex();
+ }
+ return TOK;
+}
+
+int
+get_name(c)
+ register int c;
+{
+ char buf[512+1];
+ register char *p = &buf[0];
+ register struct idf *id;
+
+ do {
+ if (p - buf < 512) *p++ = c;
+ c = getc(db_in);
+ } while ((extended_charset && in_ext(c)) || in_idf(c));
+ ungetc(c, db_in);
+ *p = 0;
+ if (extended_charset) {
+ tok.idf = 0;
+ tok.str = Salloc(buf, (unsigned) (p - buf));
+ return NAME;
+ }
+ id = str2idf(buf, 1);
+ tok.idf = id;
+ tok.str = id->id_text;
+ return id->id_reserved ? id->id_reserved : NAME;
+}
+
+static int
+quoted(ch)
+ int ch;
+{
+ /* quoted() replaces an escaped character sequence by the
+ character meant.
+ */
+ /* first char after backslash already in ch */
+ if (!is_oct(ch)) { /* a quoted char */
+ switch (ch) {
+ case 'n':
+ ch = '\n';
+ break;
+ case 't':
+ ch = '\t';
+ break;
+ case 'b':
+ ch = '\b';
+ break;
+ case 'r':
+ ch = '\r';
+ break;
+ case 'f':
+ ch = '\f';
+ break;
+ }
+ }
+ else { /* a quoted octal */
+ register int oct = 0, cnt = 0;
+
+ do {
+ oct = oct*8 + (ch-'0');
+ ch = getc(db_in);
+ } while (is_oct(ch) && ++cnt < 3);
+ ungetc(ch, db_in);
+ ch = oct;
+ }
+ return ch&0377;
+
+}
+
+int get_string(c)
+ int c;
+{
+ register int ch;
+ char buf[512];
+ register int len = 0;
+
+ while (ch = getc(db_in), ch != c) {
+ if (ch == '\n') {
+ error("newline in string");
+ break;
+ }
+ if (ch == '\\') {
+ ch = getc(db_in);
+ ch = quoted(ch);
+ }
+ buf[len++] = ch;
+ }
+ buf[len++] = 0;
+ tok.str = Salloc(buf, (unsigned) len);
+ return STRING;
+}
+
+static int
+val_in_base(c, base)
+ register int c;
+{
+ return is_dig(c)
+ ? c - '0'
+ : base != 16
+ ? -1
+ : is_hex(c)
+ ? (c - 'a' + 10) & 017
+ : -1;
+}
+
+int
+get_number(c)
+ register int c;
+{
+ char buf[512+1];
+ register int base = 10;
+ register char *p = &buf[0];
+ register long val = 0;
+ register int val_c;
+
+ if (c == '0') {
+ /* check if next char is an 'x' or an 'X' */
+ c = getc(db_in);
+ if (c == 'x' || c == 'X') {
+ base = 16;
+ c = getc(db_in);
+ }
+ else base = 8;
+ }
+ while (val_c = val_in_base(c, base), val_c >= 0) {
+ val = val * base + val_c;
+ if (p - buf < 512) *p++ = c;
+ c = getc(db_in);
+ }
+ if (base == 16 || !((c == '.' || c == 'e' || c == 'E'))) {
+ ungetc(c, db_in);
+ tok.ival = val;
+ return INTEGER;
+ }
+ if (c == '.') {
+ if (p - buf < 512) *p++ = c;
+ c = getc(db_in);
+ }
+ while (is_dig(c)) {
+ if (p - buf < 512) *p++ = c;
+ c = getc(db_in);
+ }
+ if (c == 'e' || c == 'E') {
+ if (p - buf < 512) *p++ = c;
+ c = getc(db_in);
+ if (c == '+' || c == '-') {
+ if (p - buf < 512) *p++ = c;
+ c = getc(db_in);
+ }
+ if (! is_dig(c)) {
+ error("malformed floating constant");
+ }
+ while (is_dig(c)) {
+ if (p - buf < 512) *p++ = c;
+ c = getc(db_in);
+ }
+ }
+ ungetc(c, db_in);
+ *p++ = 0;
+ if (p == &buf[512+1]) {
+ error("floating point constant too long");
+ }
+ return REAL;
+}
+
+extern char * symbol2str();
+
+LLmessage(t)
+{
+ if (t > 0) {
+ if (! errorgiven) {
+ error("%s missing before %s", symbol2str(t), symbol2str(TOK));
+ }
+ aside = tok;
+ }
+ else if (t == 0) {
+ if (! errorgiven) {
+ error("%s unexpected", symbol2str(TOK));
+ }
+ }
+ else if (! errorgiven) {
+ error("EOF expected");
+ }
+ errorgiven = 1;
+}
+
+static int
+catch_del()
+{
+ signal(SIGINT, catch_del);
+ signal_child(SIGEMT);
+ longjmp(jmpbuf, 1);
+}
+
+static int
+init_del()
+{
+ signal(SIGINT, catch_del);
+}
+
+static int
+skip_to_eol()
+{
+ while (TOK != '\n' && TOK > 0) LLlex();
+ wait_for_child("interrupted");
+}
+}
--- /dev/null
+/* $Header$
+ Grammar of a string of a debugger symbol table entry.
+*/
+
+{
+#include <out.h>
+#include <alloc.h>
+
+#include "type.h"
+#include "symbol.h"
+#include "scope.h"
+#include "class.h"
+#include "idf.h"
+
+extern char *strindex();
+extern long str2long();
+extern double atof();
+extern int saw_code;
+extern long pointer_size;
+
+static char *DbxPtr; /* 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 struct literal *get_literal_space();
+static struct fields *get_field_space();
+static end_field();
+static char *string_val();
+}
+
+%start DbxParser, 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))
+
+ | /* tag name (only C?) */
+ { s = NewSymbol(str, CurrentScope, TAG, currnam); }
+ 'T' tag_name(s)
+
+ | /* 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, PervasiveScope, PROC, currnam); }
+ 'P' routine(s)
+
+ | /* private procedure */
+ { s = NewSymbol(str, CurrentScope, PROC, currnam); }
+ 'Q' routine(s)
+
+ | /* external function */
+ { s = NewSymbol(str, PervasiveScope, 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), PervasiveScope, VAR);
+ if (s) {
+ tmp = s->sy_type;
+ } else s = NewSymbol(str, PervasiveScope, VAR, currnam);
+ }
+ 'G' type(&(s->sy_type), (int *) 0)
+ { if (tmp) s->sy_type = tmp; }
+
+ | /* static variable */
+ { s = NewSymbol(str, CurrentScope, VAR, currnam); }
+ 'S' type(&(s->sy_type), (int *) 0)
+
+ | /* static variable, local scope */
+ { s = NewSymbol(str, CurrentScope, VAR, currnam); }
+ 'V' type(&(s->sy_type), (int *) 0)
+
+ | /* register variable */
+ { s = NewSymbol(str, CurrentScope, REGVAR, currnam); }
+ 'r' type(&(s->sy_type), (int *) 0)
+
+ | /* value parameter */
+ { s = NewSymbol(str, CurrentScope, LOCVAR, currnam); }
+ 'p' type(&(s->sy_type), (int *) 0)
+ { add_param_type('p', s); }
+
+ | /* value parameter but address passed */
+ { s = NewSymbol(str, CurrentScope, VARPAR, currnam); }
+ 'i' type(&(s->sy_type), (int *) 0)
+ { add_param_type('i', s); }
+
+ | /* variable parameter */
+ { s = NewSymbol(str, CurrentScope, VARPAR, currnam); }
+ 'v' type(&(s->sy_type), (int *) 0)
+ { add_param_type('v', s); }
+
+ | /* local variable */
+ { s = NewSymbol(str, CurrentScope, LOCVAR, currnam); }
+ type_name(&(s->sy_type))
+
+ | /* function result in Pascal; ignore ??? */
+ { s = NewSymbol(str, CurrentScope, LOCVAR, currnam); }
+ 'X' type_name(&(s->sy_type))
+ ]
+ ';'?
+;
+
+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;)
+ { int type_index[2]; p_type *p; }
+:
+ type_index(type_index)
+ [
+ '='
+ type(t, type_index)
+ { p = tp_lookup(type_index);
+ if (*p && *p != incomplete_type) {
+ if (!((*p)->ty_flags & T_CROSS))
+ error("Redefining (%d,%d) %d",
+ type_index[0],
+ type_index[1],
+ (*p)->ty_class);
+ if (*t && *p != *t) free_type(*p);
+ }
+ if (*t) *p = *t;
+ }
+ |
+ { p = tp_lookup(type_index); }
+ ]
+ { if (*p == 0) *p = incomplete_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];
+ }
+;
+
+tag_name(p_symbol t;)
+ { int type_index[2]; p_type *p; }
+:
+ type_index(type_index)
+ '='
+ type(&(t->sy_type), type_index)
+ { p = tp_lookup(type_index);
+ if (*p && *p != incomplete_type) {
+ if (!((*p)->ty_flags & T_CROSS))
+ error("Redefining (%d,%d) %d",
+ type_index[0],
+ type_index[1],
+ (*p)->ty_class);
+ if (t->sy_type && *p != t->sy_type) {
+ free_type(*p);
+ }
+ }
+ if (t->sy_type) *p = t->sy_type;
+ if (*p == 0) *p = incomplete_type;
+ }
+;
+
+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)
+ { 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)
+;
+
+type(p_type *ptp; int *type_index;)
+ { register p_type tp = 0;
+ p_type t1, t2;
+ long ic1, ic2;
+ int A_used = 0;
+ }
+: { *ptp = 0; }
+ [
+ /* type cross reference */
+ /* these are used in C for references to a struct, union or
+ * enum that has not been declared (yet)
+ */
+ 'x' { tp = new_type(); tp->ty_flags = T_CROSS; }
+ [ 's' /* struct */
+ { tp->ty_class = T_STRUCT; }
+ | 'u' /* union */
+ { tp->ty_class = T_UNION; }
+ | 'e' /* enum */
+ { tp->ty_class = T_ENUM; }
+ ]
+ { AllowName = 1; }
+ name(&(tp->ty_tag))
+ |
+ /* 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_name(&t1) ';'
+ [ 'A' integer_const(&ic1) { A_used = 1; }
+ | integer_const(&ic1)
+ ]
+ ';'
+ [ 'A' integer_const(&ic2) { A_used |= 2; }
+ | integer_const(&ic2)
+ ]
+ { *ptp = subrange_type(A_used,
+ last_index,
+ ic1,
+ ic2,
+ type_index);
+ }
+ |
+ /* array; first type is bound type, next type
+ * is element type
+ */
+ 'a' type(&t1, (int *) 0) ';' type(&t2, (int *) 0)
+ { *ptp = array_type(t1, t2); }
+ |
+ /* structure type */
+ 's' { tp = new_type(); tp->ty_class = T_STRUCT; }
+ structure_type(tp)
+ |
+ /* union type */
+ 'u' { tp = new_type(); tp->ty_class = T_UNION; }
+ structure_type(tp)
+ |
+ /* enumeration type */
+ 'e' { tp = new_type(); tp->ty_class = T_ENUM; }
+ enum_type(tp)
+ |
+ /* pointer type */
+ '*' { tp = new_type(); tp->ty_class =T_POINTER;
+ tp->ty_size = pointer_size;
+ }
+ type(&(tp->ty_ptrto), (int *) 0)
+ |
+ /* function type */
+ 'f' { tp = new_type(); tp->ty_class = T_PROCEDURE;
+ tp->ty_size = pointer_size;
+ }
+ type(&(tp->ty_retval), (int *) 0)
+/*
+ [ %prefer
+ ',' param_list(tp)
+ |
+ ]
+*/
+ |
+ /* procedure type */
+ 'Q' { tp = new_type(); tp->ty_class = T_PROCEDURE;
+ tp->ty_size = pointer_size;
+ }
+ type(&(tp->ty_retval), (int *) 0)
+ ',' param_list(tp)
+ |
+ /* another procedure type */
+ 'p' { tp = new_type(); 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 = new_type(); tp->ty_class = T_SET; }
+ type(&(tp->ty_setbase), (int *) 0) ';'
+ [
+ integer_const(&(tp->ty_size)) ';'
+ integer_const(&(tp->ty_setlow)) ';'
+ |
+ { set_bounds(tp); }
+ ]
+ |
+ /* file type of Pascal */
+ 'L' { tp = new_type(); tp->ty_class = T_FILE; }
+ type(&(tp->ty_fileof), (int *) 0)
+ |
+ type_name(ptp)
+ { if (type_index &&
+ *ptp == incomplete_type &&
+ type_index[0] == last_index[0] &&
+ type_index[1] == last_index[1]) {
+ *ptp = void_type;
+ }
+ }
+ ]
+ { if (! *ptp) *ptp = tp; }
+;
+
+structure_type(register p_type tp;)
+ { register struct fields *fldp; }
+:
+ integer_const(&(tp->ty_size)) /* size in bytes */
+ [ { fldp = get_field_space(tp); }
+ name(&(fldp->fld_name))
+ type(&(fldp->fld_type), (int *) 0) ','
+ integer_const(&(fldp->fld_pos)) ',' /* offset in bits */
+ integer_const(&(fldp->fld_bitsize)) ';' /* size in bits */
+ ]*
+ ';' { end_field(tp); }
+;
+
+enum_type(register p_type tp;)
+ { register struct literal *litp;
+ long maxval = 0;
+ }
+:
+ [ { 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;
+ }
+ ]*
+ ';' { 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) ';'
+ { t->ty_nbparams +=
+ param_size(p->par_type, p->par_kind);
+ p++;
+ }
+ ]*
+;
+
+{
+static char *dbx_string;
+static char *DbxOldPtr;
+
+struct outname *
+DbxString(n)
+ struct outname *n;
+{
+ currnam = n;
+ DbxPtr = n->on_mptr;
+ dbx_string = DbxPtr;
+ AllowName = 1;
+ DbxParser();
+ return currnam;
+}
+
+/*ARGSUSED*/
+DBSmessage(n)
+{
+ fatal("error in Dbx string \"%s\", DbxPtr = \"%s\", DbxOldPtr = \"%s\"",
+ dbx_string,
+ DbxPtr,
+ DbxOldPtr);
+
+}
+
+DBSonerror(tk, p)
+ int *p;
+{
+ DbxPtr = DbxOldPtr;
+/* ??? if (DBSsymb < 0) {
+ while (*p && *p != ';') p++;
+ if (*p) DbxPtr = ";";
+ return;
+ }
+*/
+ if (! tk) {
+ while (*p && *p != NAME) p++;
+ if (*p) {
+ AllowName = 1;
+ }
+ }
+ else if (tk == NAME) AllowName = 1;
+}
+
+DBSlex()
+{
+ register char *cp = DbxPtr;
+ int allow_name = AllowName;
+ register int c;
+
+ AllowName = 0;
+ DbxOldPtr = cp;
+ c = *cp;
+ if (c == '\\' && *(cp+1) == '\0') {
+ currnam++;
+ cp = currnam->on_mptr;
+ DbxOldPtr = cp;
+ c = *cp;
+ }
+ if (! c) {
+ DbxPtr = cp;
+ return -1;
+ }
+ if ((! allow_name && is_token(c)) || c == ';') {
+ DbxPtr = 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(DbxOldPtr, 10);
+ }
+ else {
+ fval = atof(DbxOldPtr);
+ }
+ *cp = c;
+ DbxPtr = 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;
+ DbxPtr = cp + 1;
+ return STRING;
+ }
+ strval = cp;
+ while ((c = *cp) && c != ':' && c != ',') cp++;
+ DbxPtr = *cp ? cp+1 : cp;
+ *cp = 0;
+ return NAME;
+}
+
+static struct fields *
+get_field_space(tp)
+ register p_type tp;
+{
+ if (! (tp->ty_nfields & 07)) {
+ tp->ty_fields = (struct fields *)
+ Realloc((char *) tp->ty_fields,
+ (tp->ty_nfields+8)*sizeof(struct fields));
+ }
+ return &tp->ty_fields[tp->ty_nfields++];
+}
+
+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);
+}
+
+}
--- /dev/null
+/* $Header$
+ Read the symbol table from an ACK a.out format file.
+*/
+
+#include <stb.h>
+#include <alloc.h>
+#include <assert.h>
+
+#include "position.h"
+#include "file.h"
+#include "symbol.h"
+#include "idf.h"
+#include "scope.h"
+#include "rd.h"
+
+extern char *Malloc();
+extern char *strindex();
+extern struct outname *DbxString();
+
+int saw_code = 0;
+
+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
+DbxRead(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: not an ACK object file", f);
+ }
+ rd_ohead(&h);
+ if (BADMAGIC(h) && h.oh_magic != O_CONVERTED) {
+ fatal("%s: not an ACK 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 (! currfile) 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 = DbxString(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 = DbxString(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);
+ rd_close();
+ return (h.oh_magic == O_CONVERTED);
+}
--- /dev/null
+/* $Header$ */
+
+#include <assert.h>
+#include <alloc.h>
+
+#include "operator.h"
+#include "position.h"
+#include "tree.h"
+#include "message.h"
+
+extern long pointer_size;
+extern p_tree get_from_item_list();
+
+struct dump {
+ char *globals, *stack;
+ struct message_hdr mglobal, mstack;
+};
+
+/* dumping and restoring of child process.
+*/
+do_dump(p)
+ p_tree p;
+{
+ struct dump *d = (struct dump *) Malloc(sizeof(struct dump));
+
+ if (! get_dump(&d->mglobal, &d->globals, &d->mstack, &d->stack)) {
+ error("no debuggee");
+ free((char *) d);
+ return;
+ }
+ p->t_args[0] = (struct tree *) d;
+ p->t_address = (t_addr) BUFTOA(d->mglobal.m_buf+PC_OFF*pointer_size);
+ add_to_item_list(p);
+}
+
+/* dumping and restoring of child process.
+*/
+do_restore(p)
+ p_tree p;
+{
+ struct dump *d;
+
+ p = get_from_item_list((int) p->t_ival);
+ if (!p || p->t_oper != OP_DUMP) {
+ error("no such dump");
+ return;
+ }
+
+ d = (struct dump *) p->t_args[0];
+
+ if (! put_dump(&d->mglobal, d->globals, &d->mstack, d->stack)) {
+ error("no debuggee");
+ }
+ do_items();
+}
+
+free_dump(p)
+ p_tree p;
+{
+ struct dump *d = (struct dump *) p->t_args[0];
+
+ free(d->globals);
+ free(d->stack);
+ free((char *) d);
+}
--- /dev/null
+/* $Header$ */
+
+#include "position.h"
+#include "operator.h"
+#include "tree.h"
+
+int
+eval_cond(p)
+ p_tree p;
+{
+ /* to be written !!! */
+ return 1;
+}
--- /dev/null
+/* $Header$ */
+
+/* Structure for information about files. This information consists of three
+ parts:
+ - file name and directory
+ - mapping of line numbers to offsets in file
+ - mapping of object adresses to lines in file and vice versa
+*/
+
+#define LOGHSIZ 6 /* make sure HSIZ is a power of 2 */
+#define HSIZ (1 << LOGHSIZ)
+#define HASH(line) ((line) & (HSIZ-1))
+
+typedef struct file {
+ struct symbol *f_sym;
+ char *f_fullname; /* name including directory */
+ struct scope *f_scope; /* reference to scope of this file */
+ t_lineno f_nlines; /* number of lines in file */
+ union {
+ long *ff_linepos; /* positions of lines in file */
+ struct file *ff_next; /* only for BINCL, EINCL */
+ } f_x;
+#define f_linepos f_x.ff_linepos
+#define f_next f_x.ff_next
+ struct outname *f_start;
+ struct outname *f_end;
+ struct outname *f_line_addr[HSIZ];
+ /* hash table, mapping line numbers to
+ outname structures. Collisions are
+ resolved by chaining:
+ */
+#define next_outname(n) ((struct outname *) ((n)->on_mptr))
+#define setnext_outname(n,m) ((n)->on_mptr = (char *) (m))
+
+ struct file *f_nextmap; /* next file in mapping */
+} t_file, *p_file;
+
+/* ALLOCDEF "file" 10 */
--- /dev/null
+/*
+ * (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$ */
+
+#include "position.h"
+#include "file.h"
+#include "idf.h"
+#include <idf_pkg.body>
--- /dev/null
+/*
+ * (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$ */
+
+struct id_u {
+ int id_res;
+ struct symbol *id_df;
+};
+
+#define IDF_TYPE struct id_u
+#define id_reserved id_user.id_res
+#define id_def id_user.id_df
+
+#include <idf_pkg.spec>
--- /dev/null
+/* $Header$ */
+
+#include <alloc.h>
+#include <stdio.h>
+#include <assert.h>
+
+#include "position.h"
+#include "tree.h"
+#include "operator.h"
+
+extern FILE *db_out;
+extern int db_ss;
+
+typedef struct item {
+ struct item *i_next;
+ struct tree *i_node;
+} t_item, *p_item;
+
+/* STATICALLOCDEF "item" 10 */
+
+struct itemlist {
+ p_item il_first, il_last;
+ int il_count;
+};
+
+static struct itemlist item_list;
+
+int
+in_item_list(p)
+ p_tree p;
+{
+ register p_item i = item_list.il_first;
+
+ while (i) {
+ if (i->i_node == p) return 1;
+ i = i->i_next;
+ }
+ return 0;
+}
+
+int
+item_addr_actions(a)
+ t_addr a;
+{
+ /* Perform actions associated with position 'a', and return 1 if we must stop
+ there, and 0 if not.
+ */
+ register p_item i = item_list.il_first;
+ int stopping = 0;
+
+ while (i) {
+ register p_tree p = i->i_node;
+
+ if (p->t_address == a || p->t_address == NO_ADDR) {
+ switch(p->t_oper) {
+ case OP_TRACE:
+ case OP_WHEN:
+ if (! p->t_args[1] ||
+ eval_cond(p->t_args[1])) {
+ perform(p, a);
+ }
+ break;
+ case OP_STOP:
+ if (! p->t_args[1] ||
+ eval_cond(p->t_args[1])) stopping = 1;
+ break;
+ case OP_DUMP:
+ break;
+ default:
+ assert(0);
+ }
+ }
+ i = i->i_next;
+ }
+ return stopping;
+}
+
+add_to_item_list(p)
+ p_tree p;
+{
+ p_item i;
+
+ if (in_item_list(p)) return 1;
+
+ i = new_item();
+ i->i_node = p;
+ if (p->t_address == NO_ADDR &&
+ (p->t_oper != OP_TRACE || ! p->t_args[0])) db_ss++;
+ if (item_list.il_first == 0) {
+ item_list.il_first = i;
+ }
+ else {
+ item_list.il_last->i_next = i;
+ }
+ p->t_itemno = ++item_list.il_count;
+ item_list.il_last = i;
+ pr_item(p);
+ return 1;
+}
+
+p_tree
+remove_from_item_list(n)
+ int n;
+{
+ register p_item i = item_list.il_first, prev = 0;
+ p_tree p = 0;
+
+ while (i) {
+ if (i->i_node->t_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);
+ }
+ return p;
+}
+
+p_tree
+get_from_item_list(n)
+ int n;
+{
+ register p_item i = item_list.il_first;
+
+ while (i) {
+ if (i->i_node->t_itemno == n) return i->i_node;
+ i = i->i_next;
+ }
+ return 0;
+}
+
+print_items()
+{
+ register p_item i = item_list.il_first;
+
+ for (; i; i = i->i_next) {
+ pr_item(i->i_node);
+ }
+}
+
+pr_item(p)
+ p_tree p;
+{
+ fprintf(db_out, "(%d)\t", p->t_itemno);
+ print_node(p, 1);
+}
+
+do_items()
+{
+ register p_item i = item_list.il_first;
+
+ for (; i; i = i->i_next) {
+ if (i->i_node->t_oper != OP_DUMP) eval(i->i_node);
+ }
+}
--- /dev/null
+/* $Header$ */
+
+#include "langdep.h"
+
+struct langlist {
+ struct langlist *l_next;
+ struct langdep *l_lang;
+ char *l_suff;
+};
+
+/* STATICALLOCDEF "langlist" 5 */
+
+static struct langlist *list;
+
+struct langdep *currlang;
+
+static int
+add_language(suff, lang)
+ char *suff;
+ struct langdep *lang;
+{
+ struct langlist *p = new_langlist();
+
+ p->l_next = list;
+ p->l_suff = suff;
+ p->l_lang = lang;
+ list = p;
+}
+
+int
+init_languages()
+{
+ add_language(".mod", m2_dep);
+}
+
+int
+find_language(suff)
+ char *suff;
+{
+ register struct langlist *p = list;
+
+ while (p) {
+ currlang = p->l_lang;
+ if (! strcmp(p->l_suff, suff)) break;
+ p = p->l_next;
+ }
+}
--- /dev/null
+/* $Header$ */
+
+/* language-dependent routines and formats, together in one structure: */
+
+struct langdep {
+ /* formats (for fprintf): */
+ char *decint_fmt; /* decimal ints (format for long) */
+ char *octint_fmt; /* octal ints (format for long) */
+ char *hexint_fmt; /* hexadecimal ints (format for long) */
+ char *uns_fmt; /* unsigneds (format for long) */
+ char *addr_fmt; /* address (format for long) */
+ char *real_fmt; /* real (format for double) */
+ char *char_fmt; /* character (format for int) */
+
+ /* display openers and closers: */
+ char *open_array_display;
+ char *close_array_display;
+ char *open_struct_display;
+ char *close_struct_display;
+ char *open_set_display;
+ char *close_set_display;
+
+ /* language dependant routines: */
+ int (*printstring)();
+ long (*arrayelsize)();
+};
+
+extern struct langdep *m2_dep, *currlang;
+
+extern int find_language();
+
+extern int init_languages();
--- /dev/null
+/* $Header$ */
+
+#include <stdio.h>
+#include <alloc.h>
+
+#include "position.h"
+#include "idf.h"
+#include "file.h"
+#include "symbol.h"
+
+static line_positions();
+extern char *dirs[];
+extern FILE *fopen();
+extern FILE *db_out;
+#define window_size 21
+
+static int
+mk_filnm(dir, file, newname)
+ char *dir;
+ char *file;
+ char **newname;
+{
+ register char *dst = Malloc((unsigned) (strlen(dir) + strlen(file) + 2));
+
+ *newname = dst;
+ if (*dir) {
+ while (*dst++ = *dir++) /* nothing */;
+ *(dst - 1) = '/';
+ }
+ while (*dst++ = *file++) /* nothing */;
+}
+
+static FILE *
+open_file(fn, mode, ffn)
+ char *fn;
+ char *mode;
+ char **ffn;
+{
+ FILE *f;
+ char **p;
+
+ if (fn[0] == '/') {
+ *ffn = fn;
+ return fopen(fn, mode);
+ }
+ p = dirs;
+ while (*p) {
+ mk_filnm(*p++, fn, ffn);
+ if ((f = fopen(*ffn, mode)) != NULL) {
+ return f;
+ }
+ free(*ffn);
+ }
+ return NULL;
+}
+
+/* Print a window of window_size lines around line "line" of
+ file "file".
+*/
+window(file, line)
+ p_file file;
+ int line;
+{
+ lines(file,
+ line + ((window_size >> 1) - window_size), line + (window_size >> 1));
+}
+
+lines(file, l1, l2)
+ register p_file file;
+ int l1, l2;
+{
+ static p_file last_file;
+ static FILE *last_f;
+ register FILE *f;
+ register int n;
+
+ if (last_file != file) {
+ if (last_f) fclose(last_f);
+ last_f = 0;
+ if (!(f = open_file(file->f_sym->sy_idf->id_text,
+ "r",
+ &file->f_fullname))) {
+ error("could not open %s", file->f_sym->sy_idf->id_text);
+ return;
+ }
+ printf("filedesc = %d\n", fileno(f));
+ last_file = file;
+ last_f = f;
+ if (! file->f_linepos) {
+ line_positions(file, f);
+ }
+ }
+ else f = last_f;
+
+ if (l1 < 1) l1 = 1;
+ if (l2 > file->f_nlines) l2 = file->f_nlines;
+ if (l1 > l2) {
+ error("%s has only %d lines", file->f_sym->sy_idf->id_text, file->f_nlines);
+ return;
+ }
+
+ fseek(f, *(file->f_linepos+(l1-1)), 0);
+ for (n = l1; n <= l2; n++) {
+ register int c;
+
+ fprintf(db_out, "%6d ", n);
+ do {
+ c = getc(f);
+ if (c != EOF) putc(c, db_out);
+ } while (c != '\n' && c != EOF);
+ if (c == EOF) break;
+ }
+ clearerr(f);
+}
+
+static
+line_positions(file, f)
+ p_file file;
+ register FILE *f;
+{
+ int nl;
+ unsigned int n_alloc = 256;
+ register long cnt = 0;
+ register int c;
+
+ file->f_linepos = (long *) Malloc(n_alloc * sizeof(long));
+ file->f_linepos[0] = 0;
+ nl = 1;
+ while ((c = getc(f)) != EOF) {
+ cnt++;
+ if (c == '\n') {
+ if (nl == n_alloc) {
+ n_alloc <<= 1;
+ file->f_linepos =
+ (long *) Realloc((char *)(file->f_linepos),
+ n_alloc * sizeof(long));
+ }
+ file->f_linepos[nl++] = cnt;
+ }
+ }
+ if (cnt == file->f_linepos[nl-1]) nl--;
+ file->f_linepos = (long *) Realloc((char *)(file->f_linepos),
+ (unsigned)nl * sizeof(long));
+ file->f_nlines = nl;
+ clearerr(f);
+}
--- /dev/null
+#include <stdio.h>
+#include <varargs.h>
+
+#include "tokenname.h"
+#include "position.h"
+#include "file.h"
+#include "symbol.h"
+#include "scope.h"
+
+static char *usage = "Usage: %s [-d] [<ack.out>] [<a.out>]";
+static char *progname;
+char *AckObj;
+char *AObj;
+char *dirs[] = { "", 0 };
+FILE *db_out;
+FILE *db_in;
+t_lineno currline;
+int debug;
+extern struct tokenname tkidf[];
+extern char *strindex();
+
+main(argc, argv)
+ char *argv[];
+{
+ char *p;
+
+ db_out = stdout;
+ db_in = stdin;
+ progname = argv[0];
+ while (p = strindex(progname, '/')) {
+ progname = p + 1;
+ }
+ if (argv[1][0] == '-') {
+ switch(argv[1][1]) {
+ case 'd':
+ debug++;
+ break;
+ default:
+ fatal(usage, progname);
+ }
+ argv++;
+ argc--;
+ }
+ if (argc > 3) {
+ fatal(usage, progname);
+ }
+ AckObj = argv[1] ? argv[1] : "a.out";
+ if (argc == 3) AObj = argv[2];
+ init_idf();
+ init_types();
+ init_scope();
+ init_languages();
+ if (DbxRead(AckObj) && AObj == 0) AObj = AckObj;
+ else if (AObj == 0) AObj = "a.out";
+ reserve(tkidf);
+ if (currfile) CurrentScope = currfile->sy_file->f_scope;
+ if (! init_run()) {
+ fatal("something wrong with file descriptors");
+ }
+ prompt();
+ Commands();
+ fputc( '\n', db_out);
+ exit(0);
+}
+
+prompt()
+{
+ if (isatty(fileno(db_in))) {
+ fprintf(db_out, "%s -> ", progname);
+ fflush(db_out);
+ }
+}
+
+/*VARARGS1*/
+fatal(va_alist)
+ va_dcl
+{
+ va_list ap;
+ char *fmt;
+
+ va_start(ap);
+ {
+ fmt = va_arg(ap, char *);
+ fprintf(stderr, "%s: ", progname);
+ vfprintf(stderr, fmt, ap);
+ fprintf(stderr, "\n");
+ }
+ va_end(ap);
+ abort();
+ exit(1);
+}
+
+extern int errorgiven;
+
+/*VARARGS1*/
+error(va_alist)
+ va_dcl
+{
+ va_list ap;
+ char *fmt;
+
+ va_start(ap);
+ {
+ fmt = va_arg(ap, char *);
+ fprintf(stderr, "%s: ", progname);
+ vfprintf(stderr, fmt, ap);
+ fprintf(stderr, "\n");
+ }
+ va_end(ap);
+ errorgiven = 1;
+}
+
+rd_fatal()
+{
+ fatal("read error in %s", AckObj);
+}
+
+No_Mem()
+{
+ fatal("out of memory");
+}
--- /dev/null
+sed -e '
+s:^.*[ ]ALLOCDEF[ ].*"\(.*\)"[ ]*\([0-9][0-9]*\).*$:\
+/* allocation definitions of struct \1 */\
+extern char *st_alloc();\
+extern struct \1 *h_\1;\
+#ifdef DEBUG\
+extern int cnt_\1;\
+extern char *std_alloc();\
+#define new_\1() ((struct \1 *) std_alloc((char **)\&h_\1, sizeof(struct \1), \2, \&cnt_\1))\
+#else\
+#define new_\1() ((struct \1 *) st_alloc((char **)\&h_\1, sizeof(struct \1), \2))\
+#endif\
+#define free_\1(p) st_free(p, \&h_\1, sizeof(struct \1))\
+:' -e '
+s:^.*[ ]STATICALLOCDEF[ ].*"\(.*\)"[ ]*\([0-9][0-9]*\).*$:\
+/* allocation definitions of struct \1 */\
+extern char *st_alloc();\
+struct \1 *h_\1;\
+#ifdef DEBUG\
+int cnt_\1;\
+#define new_\1() ((struct \1 *) std_alloc((char **)\&h_\1, sizeof(struct \1), \2, \&cnt_\1))\
+#else\
+#define new_\1() ((struct \1 *) st_alloc((char **)\&h_\1, sizeof(struct \1), \2))\
+#endif\
+#define free_\1(p) st_free(p, \&h_\1, sizeof(struct \1))\
+:'
--- /dev/null
+sed -n '
+s:^.*[ ]ALLOCDEF[ ].*"\(.*\)".*$:struct \1 *h_\1 = 0;\
+#ifdef DEBUG\
+int cnt_\1 = 0;\
+#endif:p
+' $*
--- /dev/null
+awk '
+BEGIN { n = 0 }
+ { print "#define " $1 " " n; n++
+ if ($3 !~ /0/) print "extern int " $3 "();" ;
+ }
+' < $1 > ops.h
+
+cat > ops.c <<'EOF'
+#include "operator.h"
+#include "ops.h"
+
+t_operator operators[] = {
+EOF
+awk ' { print "{ " $2 ", " $3 "}, /* " $1 " */" }' < $1 >> ops.c
+cat >> ops.c <<'EOF'
+{ 0, 0 }
+};
+EOF
--- /dev/null
+cat <<'--EOT--'
+/* Generated by make.tokcase */
+/* $Header$ */
+#include "Lpars.h"
+
+char *
+symbol2str(tok)
+ int tok;
+{
+#define SIZBUF 8
+ /* allow for a few invocations in f.i. an argument list */
+ static char buf[SIZBUF] = { '\'', 0, '\'', 0, '\'', 0, '\'', 0};
+ static int index = 1;
+
+ switch (tok) {
+--EOT--
+
+sed '
+/{[A-Z]/!d
+s/.*{\(.*\),.*\(".*"\).*$/ case \1 :\
+ return \2;/
+'
+
+cat <<'--EOT--'
+ default:
+ if (tok <= 0) return "end of file";
+ if (tok == '\n') return "<newline>";
+ if (tok < 040 || tok >= 0177) {
+ return "bad token";
+ }
+ index = (index+4) & (SIZBUF-1);
+ buf[index] = tok;
+ return &buf[index-1];
+ }
+}
+--EOT--
--- /dev/null
+sed '
+/{[A-Z]/!d
+s/.*{//
+s/,.*//
+s/.*/%token &;/
+'
--- /dev/null
+/* $Header$ */
+
+#define BUFLEN 24 /* size of buffer in message header */
+
+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;
+ 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
+ Actually, only the program counter is set.
+ */
+#define 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 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 */
+ long m_size; /* size */
+ char m_buf[BUFLEN]; /* some of the data required included in message */
+};
+
+#define LB_OFF 0
+#define AB_OFF 1
+#define PC_OFF 2
+#define HP_OFF 3
+#define SP_OFF 4
+
+#define IN_FD 3
+#define OUT_FD 6
+
+#define BUFTOL(c) (*((long *) (c)))
+#define LTOBUF(c,l) (*((long *) (c)) = (l))
+#define BUFTOA(c) (*((char **) (c)))
+#define ATOBUF(c,p) (*((char **) (c)) = (p))
+#define BUFTOS(c) (*((short *) (c)))
+#define BUFTOI(c) (*((int *) (c)))
+#define BUFTOF(c) (*((float *) (c)))
+#define BUFTOD(c) (*((double *) (c)))
--- /dev/null
+/* $Header$ */
+
+/* Language dependant support; this one is for Modula-2 */
+
+#include <stdio.h>
+
+#include "langdep.h"
+
+extern FILE *db_out;
+
+static int
+ print_string();
+
+static long
+ array_elsize();
+
+static struct langdep m2 = {
+ "%ld",
+ "%loB",
+ "%lXH",
+ "%lu",
+ "%lXH",
+ "%g",
+ "%oC",
+
+ "[",
+ "]",
+ "(",
+ ")",
+ "{",
+ "}",
+
+ print_string,
+ array_elsize
+};
+
+struct langdep *m2_dep = &m2;
+
+static int
+print_string(s)
+ char *s;
+{
+ register char *str = s;
+ int delim = '\'';
+
+ while (*str) {
+ if (*str++ == '\'') delim = '"';
+ }
+ fprintf(db_out, "%c%s%c", delim, s, delim);
+}
+
+extern long int_size;
+
+static long
+array_elsize(size)
+ long size;
+{
+ if (! (int_size % size)) return size;
+ if (! (size % int_size)) return size;
+ return ((size + int_size - 1) / int_size) * int_size;
+}
--- /dev/null
+MAKE_OPS = make.ops;
+
+%instance deftypesuffix(op_tab, '%.ot');
+
+%tool gen_ops (
+ ops: %in [type = op_tab];
+ cfile: %out [type = C-src] => ops.c;
+ hfile: %out [type = C-incl] => ops.h;
+ mkops: %in [type = command] => $MAKE_OPS;
+)
+{
+ exec($mkops, args => $ops);
+ echo({$cfile, 'and', $hfile, 'created'});
+};
--- /dev/null
+/* $Header$ */
+
+#include "ops.h"
+
+typedef struct operator {
+ int op_nargs;
+ int (*op_fun)();
+} t_operator, *p_operator;
+
+extern t_operator operators[];
+
+#define nargs(n) (operators[(n)].op_nargs)
--- /dev/null
+OP_LIST 2 do_list
+OP_FILE 1 do_file
+OP_LINK 2 0
+OP_RUN 1 start_child
+OP_INPUT 1 0
+OP_OUTPUT 1 0
+OP_INTEGER 0 0
+OP_NAME 0 0
+OP_AT 0 0
+OP_IN 1 0
+OP_STOP 2 do_stop
+OP_WHEN 3 do_stop
+OP_CONT 2 do_continue
+OP_STEP 0 do_step
+OP_NEXT 0 do_next
+OP_REGS 0 do_regs
+OP_WHERE 0 do_where
+OP_STATUS 0 do_status
+OP_DELETE 0 do_delete
+OP_SELECT 2 0
+OP_PRINT 1 do_print
+OP_DUMP 0 do_dump
+OP_RESTORE 0 do_restore
+OP_TRACE 3 do_trace
--- /dev/null
+/* $Header$ */
+
+#include <stdio.h>
+#include <assert.h>
+#include <alloc.h>
+#include <out.h>
+#include <stb.h>
+
+#include "position.h"
+#include "scope.h"
+#include "file.h"
+#include "idf.h"
+#include "symbol.h"
+
+extern FILE *db_out;
+
+static p_file mapping;
+static int nfiles = 0;
+
+/* static p_file get_map_from_addr(t_addr t);
+ Returns the file entry that contains the code at the address 't',
+ or 0 if there is no information available, or 't' represents an address
+ below the start address of the first file.
+*/
+static p_file
+get_map_from_addr(t)
+ t_addr t;
+{
+ register p_file p = mapping, oldp = 0;
+
+ /* linear search is probably acceptable here */
+ while (p && p->f_start->on_valu <= t) {
+ oldp = p;
+ p = p->f_nextmap;
+ }
+ return oldp ? oldp : p->f_start->on_valu <= t ? p : 0;
+}
+
+/* extern char *get_filename_from_addr(t_addr t);
+ Returns the source filename that contains the code at the address 't',
+ or 0 if there is no information available, or 't' represents an address
+ below the start address of the first file.
+*/
+char *
+get_filename_from_addr(t)
+ t_addr t;
+{
+ register p_file map = get_map_from_addr(t);
+
+ if (! map) return 0;
+ return map->f_sym->sy_idf->id_text;
+}
+
+/* extern t_lineno get_lineno_from_addr(t_addr t);
+ Returns the source line number of the line that contains the code at address
+ 't'. 0 is returned if no source line number could be found.
+*/
+t_lineno
+get_lineno_from_addr(t)
+ t_addr t;
+{
+ p_position p;
+
+ p = get_position_from_addr(t);
+ return p == 0 ? 0 : p->lineno;
+}
+
+/* extern p_position get_position_from_addr(t_addr t);
+ Returns a pointer to a structure containing the source position of the code
+ at address 't'. 0 is returned if no source position could be found.
+*/
+p_position
+get_position_from_addr(t)
+ t_addr t;
+{
+ register p_file map = get_map_from_addr(t);
+ static t_position retval;
+ register int i,j,m;
+
+ if (! map) return 0;
+ i = 0;
+ j = map->f_end - map->f_start;
+ do {
+ m = ((i + j) >> 1) + ((i + j) & 1);
+ while ((map->f_start[m].on_type >> 8) != N_SLINE) m++;
+ assert(m <= j);
+ if (map->f_start[m].on_valu > t) {
+ j = m - 1;
+ while (j > i && (map->f_start[j].on_type >> 8) != N_SLINE) j--;
+ }
+ else i = m;
+ } while (i < j);
+ retval.filename = map->f_sym->sy_idf->id_text;
+ retval.lineno = map->f_start[j].on_desc;
+ return &retval;
+}
+
+/* extern t_addr get_addr_from_position(p_position p);
+ Returns the address of the code at position 'p', or ILL_ADDR if it could
+ not be found. If there is no symbolic information for the filename in
+ position 'p', an error message will be given.
+*/
+t_addr
+get_addr_from_position(p)
+ p_position p;
+{
+ register p_symbol sym = Lookup(findidf(p->filename), PervasiveScope, FILESYM);
+
+ if (sym) {
+ register unsigned int i;
+ register p_file map = sym->sy_file;
+
+ for (i = p->lineno; i > 0; i--) {
+ register struct outname *n = map->f_line_addr[HASH(i)];
+
+ while (n) {
+ if (n->on_desc == i) return (t_addr) n->on_valu;
+ n = next_outname(n);
+ }
+ }
+ return ILL_ADDR;
+ }
+ error("no symbolic information for file %s", p->filename);
+ return ILL_ADDR;
+}
+
+/* extern add_position_addr(char *filename, struct outname *n);
+ Adds the ('filename','lineno'),'t' pair to the mapping information.
+*/
+add_position_addr(filename, n)
+ char *filename;
+ register struct outname *n;
+{
+ static char *lastfile = 0;
+ static p_file lastmap = 0;
+ register p_file map = lastmap;
+
+ if (filename != lastfile) { /* new file ... */
+ register p_symbol sym;
+
+ nfiles++;
+ lastfile = filename;
+ if (! filename) { /* last call */
+ return;
+ }
+ sym = Lookup(findidf(filename), PervasiveScope, FILESYM);
+ if (sym) map = sym->sy_file;
+ else {
+ sym = add_file(filename);
+ map = sym->sy_file;
+ map->f_scope = FileScope;
+ }
+ if (! mapping) mapping = map;
+ else lastmap->f_nextmap = map;
+ lastmap = map;
+ map->f_start = n;
+ }
+ else map = lastmap;
+ map->f_end = n;
+ setnext_outname(n, map->f_line_addr[HASH(n->on_desc)]);
+ map->f_line_addr[HASH(n->on_desc)] = n;
+}
+
+/* extern struct scope *get_scope_from_position(p_position p);
+ Returns the scope of the code at position 'p', or 0 if it could not be found.
+*/
+struct scope *
+get_scope_from_position(p)
+ p_position p;
+{
+ t_addr a = get_addr_from_position(p);
+
+ if (a != ILL_ADDR) {
+ return get_scope_from_addr(a);
+ }
+ return 0;
+}
+
+/* extern p_position print_position(t_addr a, int print_function);
+ Prints position 'a' and returns it. If 'print_function' is set,
+ an attempt is made to print the function name as well.
+*/
+p_position
+print_position(a, print_function)
+ t_addr a;
+ int print_function;
+{
+ register p_scope sc = base_scope(get_scope_from_addr(a));
+ register p_position pos = get_position_from_addr(a);
+
+ if (sc && print_function) {
+ fprintf(db_out, "in %s ", sc->sc_definedby->sy_idf->id_text);
+ }
+ if (pos) fprintf(db_out, "at \"%s\":%u", pos->filename, pos->lineno);
+ return pos;
+}
--- /dev/null
+/* $Header$ */
+
+/* maps from address to filename-lineno pair and reverse,
+ maps from filename-lineno pair or address to scope.
+*/
+
+typedef unsigned int t_lineno;
+typedef long t_addr;
+#define ILL_ADDR ((t_addr) -1)
+#define NO_ADDR ((t_addr) -3)
+
+typedef struct pos {
+ t_lineno lineno;
+ char *filename;
+} t_position, *p_position;
+
+/* extern char *get_filename_from_addr(t_addr t);
+ Returns the source filename that contains the code at the address 't',
+ or 0 if there is no information available, or 't' represents an address
+ below the start address of the first file.
+*/
+extern char *get_filename_from_addr();
+
+/* extern t_lineno get_lineno_from_addr(t_addr t);
+ Returns the source line number of the line that contains the code at address
+ 't'. 0 is returned if no source line number could be found.
+*/
+extern t_lineno get_lineno_from_addr();
+
+/* extern p_position get_position_from_addr(t_addr t);
+ Returns a pointer to a structure containing the source position of the code
+ at address 't'. 0 is returned if no source position could be found.
+*/
+extern p_position get_position_from_addr();
+
+/* extern t_addr get_addr_from_position(p_position p);
+ Returns the address of the code at position 'p', or ILL_ADDR if it could
+ not be found. If there is no symbolic information for the filename in
+ position 'p', an error message will be given.
+*/
+extern t_addr get_addr_from_position();
+
+/* extern add_position_addr(char *filename, struct outname *n);
+ Adds the ('filename','n'->on_desc),'n'->on_valu pair to the mapping information.
+*/
+extern add_position_addr();
+
+/* extern struct scope *get_scope_from_position(p_position p);
+ Returns the scope of the code at position 'p', or 0 if it could not be found.
+*/
+extern struct scope *get_scope_from_position();
+
+/* extern p_position print_position(t_addr a, int print_function);
+ Prints position 'a' and returns it. If 'print_function' is set,
+ an attempt is made to print the function name as well.
+*/
+extern p_position print_position();
--- /dev/null
+/* $Header$ */
+
+#include <alloc.h>
+#include <assert.h>
+#include <stdio.h>
+
+#include "type.h"
+#include "message.h"
+#include "langdep.h"
+#include "scope.h"
+#include "symbol.h"
+#include "position.h"
+#include "idf.h"
+
+extern FILE *db_out;
+extern long float_size, pointer_size, int_size;
+
+static
+print_literal(tp, v)
+ p_type tp;
+ int v;
+{
+ register struct literal *lit = tp->ty_literals;
+ register int i;
+
+ for (i = tp->ty_nenums; i; i--, lit++) {
+ if (lit->lit_val == v) {
+ fprintf(db_out, lit->lit_name);
+ break;
+ }
+ }
+ if (! i) {
+ fprintf(db_out, "unknown enumeration value %d", v);
+ }
+}
+
+static
+print_unsigned(tp, v)
+ p_type tp;
+ long v;
+{
+ if (tp == uchar_type) {
+ fprintf(db_out, currlang->char_fmt, (int) v);
+ }
+ else fprintf(db_out, currlang->uns_fmt, v);
+}
+
+static
+print_integer(tp, v)
+ p_type tp;
+ long v;
+{
+ if (tp == char_type) {
+ fprintf(db_out, currlang->char_fmt, (int) v);
+ }
+ else fprintf(db_out, currlang->decint_fmt, v);
+}
+
+print_params(tp, AB, static_link)
+ p_type tp;
+ t_addr AB;
+{
+ char *param_bytes;
+ register char *p;
+ register int i;
+ register struct param *par;
+ long size;
+
+ if (! tp) return;
+ assert(tp->ty_class == T_PROCEDURE);
+
+ if ((i = tp->ty_nparams) == 0) return;
+
+ /* get parameter bytes */
+ par = tp->ty_params;
+ size = tp->ty_nbparams;
+ if (static_link) size += pointer_size;
+ param_bytes = p = Malloc((unsigned)size);
+ if (static_link) p += pointer_size;
+ if (! get_bytes(size, AB, param_bytes)) {
+ error("no debuggee");
+ free(param_bytes);
+ return;
+ }
+
+ while (i--) {
+ if (par->par_kind == 'v' || par->par_kind == 'i') {
+ /* call by reference parameter, or
+ call by value parameter, but address is passed;
+ try and get value.
+ */
+ char *q;
+
+ if ((size = par->par_type->ty_size) == 0) {
+ size = compute_size(par->par_type, param_bytes);
+ }
+ q = Malloc((unsigned) size);
+ if (! get_bytes(size, (t_addr) BUFTOA(p), q)) {
+ fprintf(db_out, currlang->addr_fmt, BUFTOA(p));
+ }
+ else {
+ print_val(par->par_type, q, 1, 0, param_bytes);
+ }
+ free(q);
+ }
+ else print_val(par->par_type, p, 1, 0, param_bytes);
+ if (i) fputs(", ", db_out);
+ p += param_size(par->par_type, par->par_kind);
+ par++;
+ }
+ free(param_bytes);
+}
+
+print_val(tp, addr, compressed, indent, AB)
+ p_type tp; /* type of value to be printed */
+ char *addr; /* address to get value from */
+ int compressed; /* for parameter lists */
+ int indent; /* indentation */
+ char *AB; /* argument base for dynamic subranges */
+{
+ long sz;
+ register int i;
+ long elsize;
+
+ if (indent == 0) indent = 4;
+ switch(tp->ty_class) {
+ case T_SUBRANGE:
+ print_val(tp->ty_base, addr, compressed, indent, AB);
+ break;
+ case T_ARRAY:
+ if (tp->ty_elements == char_type ||
+ tp->ty_elements == uchar_type) {
+ print_val(string_type, addr, compressed, indent, AB);
+ break;
+ }
+ if ((sz = tp->ty_size) == 0) sz = compute_size(tp, AB);
+ if (compressed) {
+ fprintf(db_out, currlang->open_array_display);
+ }
+ else {
+ fprintf(db_out, "\n%*c%s%*c",
+ indent,
+ ' ',
+ currlang->open_array_display,
+ 4-strlen(currlang->open_array_display), ' ');
+ }
+ indent += 4;
+ elsize = (*currlang->arrayelsize)(tp->ty_elements->ty_size);
+ for (i = sz/elsize; i; i--) {
+ print_val(tp->ty_elements, addr, compressed, indent, AB);
+ addr += elsize;
+ if (compressed && i > 1) {
+ fprintf(db_out, ", ...");
+ break;
+ }
+ if (i > 1) {
+ fputc(',', db_out);
+ }
+ fprintf(db_out, "\n%*c", i > 1 ? indent : indent - 4, ' ');
+ }
+ fprintf(db_out, currlang->close_array_display);
+ indent -= 4;
+ break;
+ case T_STRUCT: {
+ register struct fields *fld = tp->ty_fields;
+
+ if (compressed) {
+ fprintf(db_out, currlang->open_struct_display);
+ }
+ else {
+ fprintf(db_out, "\n%*c%s%*c",
+ indent,
+ ' ',
+ currlang->open_struct_display,
+ 4-strlen(currlang->open_struct_display), ' ');
+ }
+ indent += 4;
+ for (i = tp->ty_nfields; i; i--, fld++) {
+ if (! compressed) fprintf(db_out, "%s = ", fld->fld_name);
+ if (fld->fld_bitsize != fld->fld_type->ty_size << 3) {
+ /* apparently a bit field */
+ /* ??? */
+ fprintf(db_out, "<bitfield, %d, %d>", fld->fld_bitsize, fld->fld_type->ty_size);
+ }
+ else print_val(fld->fld_type, addr+(fld->fld_pos>>3), compressed, indent, AB);
+ if (compressed && i > 1) {
+ fprintf(db_out, ", ...");
+ break;
+ }
+ if (i > 1) {
+ fputc(',', db_out);
+ }
+ fprintf(db_out, "\n%*c", i > 1 ? indent : indent - 4, ' ');
+ }
+ indent -= 4;
+ fprintf(db_out, currlang->close_struct_display);
+ break;
+ }
+ case T_UNION:
+ fprintf(db_out, "<union>");
+ break;
+ case T_ENUM:
+ print_literal(tp, tp->ty_size == 1
+ ? (*addr & 0xFF)
+ : tp->ty_size == 2
+ ? (BUFTOS(addr) & 0xFFFF)
+ : (int) BUFTOL(addr));
+ break;
+ case T_PROCEDURE: {
+ register p_scope sc = get_scope_from_addr((t_addr) BUFTOA(addr));
+
+ if (sc && sc->sc_definedby) {
+ fprintf(db_out, sc->sc_definedby->sy_idf->id_text);
+ break;
+ }
+ }
+ /* Fall through */
+ case T_POINTER:
+ fprintf(db_out, currlang->addr_fmt, (long) BUFTOA(addr));
+ break;
+ case T_FILE:
+ fprintf(db_out, "<file>");
+ break;
+ case T_SET: {
+ long val = tp->ty_setlow;
+ p_type base = tp->ty_setbase;
+ long nelements = tp->ty_size << 3;
+ int count = 0;
+ int rsft = 3 + (int_size == 2 ? 1 : 2);
+ long mask = int_size == 2 ? 0xFFFF : 0xFFFFFFFF;
+
+ if (base->ty_class == T_SUBRANGE) base = base->ty_base;
+ if (compressed) {
+ fprintf(db_out, currlang->open_set_display);
+ }
+ else {
+ fprintf(db_out, "\n%*c%s%*c",
+ indent,
+ ' ',
+ currlang->open_set_display,
+ 4-strlen(currlang->open_set_display), ' ');
+ }
+ indent += 4;
+ for (i = 0; i < nelements; i++) {
+ if (*((int *) addr + (i >> rsft)) & (1 << (i & mask))) {
+ count++;
+ if (count > 1) {
+ if (compressed) {
+ fprintf(db_out, ", ...");
+ break;
+ }
+ fprintf(db_out, ",\n%*c", indent , ' ');
+ }
+ switch(base->ty_class) {
+ case T_INTEGER:
+ print_integer(base, val+i);
+ break;
+ case T_UNSIGNED:
+ print_unsigned(base, val+i);
+ break;
+ case T_ENUM:
+ print_literal(base, (int)val+i);
+ break;
+ default:
+ assert(0);
+ }
+ }
+ }
+ if (! compressed) {
+ fprintf(db_out, "\n%*c", indent-4 , ' ');
+ }
+ indent -= 4;
+ fprintf(db_out, currlang->close_set_display);
+ }
+ break;
+ case T_REAL: {
+ double val = tp->ty_size == float_size
+ ? BUFTOF(addr)
+ : BUFTOD(addr);
+ fprintf(db_out, currlang->real_fmt, val);
+ break;
+ }
+ case T_UNSIGNED:
+ print_unsigned(tp, tp->ty_size == 1
+ ? (*addr & 0xFF)
+ : tp->ty_size == 2
+ ? (BUFTOS(addr) & 0xFFFF)
+ : BUFTOL(addr));
+ break;
+ case T_INTEGER:
+ print_integer(tp, tp->ty_size == 1
+ ? *addr
+ : tp->ty_size == 2
+ ? BUFTOS(addr)
+ : BUFTOL(addr));
+ break;
+ case T_STRING:
+ (*currlang->printstring)(addr);
+ break;
+ default:
+ assert(0);
+ break;
+ }
+}
+
+int
+print_sym(sym)
+ p_symbol sym;
+{
+ char *buf;
+ char *AB;
+
+ if (get_value(sym, &buf, &AB)) {
+ fputs(" = ", db_out);
+ print_val(sym->sy_type, buf, 0, 0, AB);
+ if (buf) free(buf);
+ if (AB) free(AB);
+ fputs("\n", db_out);
+ return 1;
+ }
+ return 0;
+}
--- /dev/null
+/* $Header$ */
+
+/* a.out file reading ... */
+
+#include "rd.h"
+
+#if defined(sun) && defined(mc68020)
+
+#include <a.out.h>
+#include <stdio.h>
+
+static FILE *inf;
+static struct exec bh;
+static long seg_strings;
+static struct outhead hh;
+
+#define readf(a, b, c) (fread((char *)(a), (b), (int)(c), inf))
+
+int
+rd_open(f)
+ char *f;
+{
+ if ((inf = fopen(f, "r")) == NULL) return 0;
+ return 1;
+}
+
+rd_ohead(h)
+ struct outhead *h;
+{
+ if (! readf(&bh, sizeof(struct exec), 1)) rd_fatal();
+ if (N_BADMAG(bh)) rd_fatal();
+
+ h->oh_magic = O_CONVERTED;
+ h->oh_stamp = 0;
+ h->oh_nsect = 4;
+ h->oh_nname = 3 + bh.a_syms / sizeof(struct nlist);
+ h->oh_nrelo = (bh.a_trsize + bh.a_drsize) / sizeof(struct reloc_info_68k);
+ h->oh_flags = h->oh_nrelo ? HF_LINK : 0;
+ if (bh.a_magic == ZMAGIC) bh.a_text -= sizeof(struct exec);
+ h->oh_nemit = bh.a_text + bh.a_data;
+ if (bh.a_magic == ZMAGIC) bh.a_text += sizeof(struct exec);
+ fseek(inf, N_STROFF(bh), 0);
+ h->oh_nchar = getw(inf) + 6 + 6 + 5 - 4; /* ".text", ".data", ".bss",
+ minus the size word */
+ seg_strings = h->oh_nchar - 17;
+ if (bh.a_magic == ZMAGIC) bh.a_text -= sizeof(struct exec);
+ fseek(inf, sizeof(struct exec) + bh.a_text + bh.a_data, 0);
+ hh = *h;
+}
+
+/*ARGSUSED1*/
+rd_name(names, count)
+ register struct outname *names;
+ unsigned int count; /* ignored; complete namelist is read */
+{
+ names->on_valu = 0; names->on_foff = seg_strings + OFF_CHAR(hh);
+ names->on_desc = 0; names->on_type = S_MIN | S_SCT;
+ names++;
+ names->on_valu = 0; names->on_foff = seg_strings + OFF_CHAR(hh) + 6;
+ names->on_desc = 0; names->on_type = (S_MIN+2) | S_SCT;
+ names++;
+ names->on_valu = 0; names->on_foff = seg_strings + OFF_CHAR(hh) + 12;
+ names->on_desc = 0; names->on_type = (S_MIN+3) | S_SCT;
+ names++;
+ count = bh.a_syms / sizeof(struct nlist);
+ while (count > 0) {
+ struct nlist n;
+
+ if (! readf(&n, sizeof(struct nlist), 1)) rd_fatal();
+ count--;
+ names->on_desc = n.n_desc;
+ if (n.n_un.n_strx - 4 < 0) names->on_foff = 0;
+ else names->on_foff = OFF_CHAR(hh) - 4 + n.n_un.n_strx;
+ names->on_valu = n.n_value;
+
+ if (n.n_type & N_STAB) {
+ names->on_type = n.n_type << 8;
+ names++;
+ continue;
+ }
+ switch(n.n_type & ~N_EXT) {
+ case N_ABS:
+ names->on_type = S_ABS;
+ break;
+ case N_TEXT:
+ names->on_type = S_MIN;
+ break;
+ case N_DATA:
+ names->on_type = S_MIN + 2;
+ names->on_valu -= bh.a_text;
+ break;
+ case N_BSS:
+ names->on_type = S_MIN + 3;
+ names->on_valu -= bh.a_text + bh.a_data;
+ break;
+ case N_UNDF:
+ if (! names->on_valu) {
+ names->on_type = S_UND;
+ break;
+ }
+ names->on_type = (S_MIN + 3) | S_COM;
+ break;
+ case N_FN:
+ names->on_type = S_FIL;
+ break;
+ default:
+ rd_fatal();
+ }
+ if (n.n_type & N_EXT) names->on_type |= S_EXT;
+ names++;
+ }
+}
+
+extern char *strcpy();
+
+rd_string(strings, count)
+ register char *strings;
+ long count;
+{
+ if (bh.a_magic == ZMAGIC) bh.a_text += sizeof(struct exec);
+ fseek(inf, N_STROFF(bh)+4, 0);
+ if (! readf(strings, (int)count-17, 1)) rd_fatal();
+ strings += count-17;
+ strcpy(strings, ".text"); strings += 6;
+ strcpy(strings, ".data"); strings += 6;
+ strcpy(strings, ".bss");
+}
+
+rd_close()
+{
+ fclose(inf);
+}
+
+#endif
--- /dev/null
+/* $Header$ */
+
+#include <out.h>
+
+#define O_CONVERTED 0x202
--- /dev/null
+/* $Header$ */
+
+/* Running a process and communication */
+
+#include <signal.h>
+#include <stdio.h>
+#include <assert.h>
+#include <alloc.h>
+
+#include "ops.h"
+#include "message.h"
+#include "position.h"
+#include "tree.h"
+#include "file.h"
+#include "symbol.h"
+#include "idf.h"
+#include "scope.h"
+
+#define MAXARG 128
+
+extern char *strncpy();
+extern char *AObj;
+extern t_lineno currline;
+extern FILE *db_out;
+extern int debug;
+extern struct idf *str2idf();
+extern long pointer_size;
+
+static int child_pid; /* process id of child */
+static int to_child, from_child; /* file descriptors for communication */
+static int child_status;
+static int restoring;
+
+int db_ss;
+
+static int catch_sigpipe();
+static int stopped();
+static int uputm(), ugetm();
+static int fild1[2], fild2[2]; /* pipe file descriptors */
+
+int
+init_run()
+{
+ /* take file descriptors so that listing cannot take them */
+ int i;
+
+ for (i = IN_FD; i <= OUT_FD; i++) close(i);
+ if (pipe(fild1) < 0 ||
+ pipe(fild2) < 0 ||
+ fild1[0] != IN_FD ||
+ fild2[1] != OUT_FD) {
+ return 0;
+ }
+ to_child = fild1[1];
+ from_child = fild2[0];
+ return 1;
+}
+
+int
+start_child(p)
+ p_tree p;
+{
+ /* start up the process to be debugged and set up communication */
+
+ char *argp[MAXARG]; /* argument list */
+ register p_tree pt = p->t_args[0], pt1;
+ unsigned int nargs = 1; /* #args */
+ char *in_redirect = 0; /* standard input redirected */
+ char *out_redirect = 0; /* standard output redirected */
+
+ signal_child(SIGKILL); /* like families in China, this debugger is only
+ allowed one child
+ */
+
+ /* first check arguments and redirections and build argument list */
+ while (pt) {
+ switch(pt->t_oper) {
+ case OP_LINK:
+ pt1 = pt->t_args[1];
+ pt = pt->t_args[0];
+ continue;
+ case OP_NAME:
+ if (nargs < (MAXARG-1)) {
+ argp[nargs++] = pt->t_str;
+ }
+ else {
+ error("too many arguments");
+ return 0;
+ }
+ break;
+ case OP_INPUT:
+ if (in_redirect) {
+ error("input redirected twice?");
+ return 0;
+ }
+ in_redirect = pt->t_str;
+ break;
+ case OP_OUTPUT:
+ if (out_redirect) {
+ error("output redirected twice?");
+ return 0;
+ }
+ out_redirect = pt->t_str;
+ break;
+ }
+ if (pt != pt1) pt = pt1;
+ else break;
+ }
+ argp[0] = AObj;
+ argp[nargs] = 0;
+
+ /* create child process */
+ child_pid = fork();
+ if (child_pid < 0) {
+ error("could not create child");
+ return 0;
+ }
+ if (child_pid == 0) {
+ /* this is the child process */
+ close(fild1[1]);
+ close(fild2[0]);
+
+ signal(SIGINT, SIG_IGN);
+
+ /* I/O redirection */
+ if (in_redirect) {
+ int fd;
+ close(0);
+ if ((fd = open(in_redirect, 0)) < 0) {
+ error("could not open input file");
+ exit(-1);
+ }
+ if (fd != 0) {
+ dup2(fd, 0);
+ close(fd);
+ }
+ }
+ if (out_redirect) {
+ int fd;
+ close(1);
+ if ((fd = creat(in_redirect, 0666)) < 0) {
+ error("could not open output file");
+ exit(-1);
+ }
+ if (fd != 1) {
+ dup2(fd, 1);
+ close(fd);
+ }
+ }
+
+ /* and run process to be debugged */
+ execv(AObj, argp);
+ error("could not exec %s", AObj);
+ exit(-1);
+ }
+
+ /* debugger */
+ close(fild1[0]);
+ close(fild2[1]);
+
+ pipe(fild1); /* to occupy file descriptors */
+ signal(SIGPIPE, catch_sigpipe);
+ if (! wait_for_child((char *) 0)) {
+ error("child not responding");
+ return 0;
+ }
+ do_items();
+ if (! restoring) send_cont(1);
+ return 1;
+}
+
+int
+wait_for_child(s)
+ char *s; /* to pass on to 'stopped' */
+{
+ struct message_hdr m;
+
+ if (child_pid) {
+ if (ugetm(&m)) {
+ return stopped(s, (t_addr) m.m_size);
+ }
+ return 0;
+ }
+ return 1;
+}
+
+signal_child(sig)
+{
+ if (child_pid) {
+ kill(child_pid, sig);
+ if (sig == SIGKILL) {
+ wait(&child_status);
+ init_run();
+ }
+ }
+}
+
+static int
+catch_sigpipe()
+{
+ child_pid = 0;
+}
+
+
+static int
+ureceive(p, c)
+ char *p;
+ long c;
+{
+ int i;
+
+ if (! child_pid) return 0;
+
+ while (c >= 0x1000) {
+ i = read(from_child, p, 0x1000);
+ if (i <= 0) {
+ if (i == 0) child_pid = 0;
+ return 0;
+ }
+ p += i;
+ c -= i;
+ }
+ while (c > 0) {
+ i = read(from_child, p, (int)c);
+ if (i <= 0) {
+ if (i == 0) child_pid = 0;
+ return 0;
+ }
+ p += i;
+ c -= i;
+ }
+ return c == 0;
+}
+
+static int
+usend(p, c)
+ char *p;
+ long c;
+{
+ int i;
+
+ while (c >= 0x1000) {
+ i = write(to_child, p, 0x1000);
+ if (i < 0) return 0;
+ p += i;
+ c -= i;
+ }
+ while (c > 0) {
+ i = write(to_child, p, (int)c);
+ if (i < 0) return 0;
+ p += i;
+ c -= i;
+ }
+ return 1;
+}
+
+static int
+ugetm(message)
+ struct message_hdr *message;
+{
+ if (! ureceive((char *) message, (long) sizeof(struct message_hdr))) {
+ return 0;
+ }
+ if (debug) printf("Got %d\n", message->m_type);
+ return 1;
+}
+
+static int
+uputm(message)
+ struct message_hdr *message;
+{
+ if (! usend((char *) message, (long) sizeof(struct message_hdr))) {
+ return 0;
+ }
+ if (debug) printf("Sent %d\n", message->m_type);
+ return 1;
+}
+
+static struct message_hdr answer;
+static int single_stepping;
+
+static int
+stopped(s, a)
+ char *s; /* stop message */
+ t_addr a; /* address where stopped */
+{
+ p_position pos;
+
+ if (s) {
+ fprintf(db_out, "%s ", s);
+ pos = print_position((t_addr) a, 1);
+ newfile(str2idf(pos->filename, 1));
+ currline = pos->lineno;
+ fputs("\n", db_out);
+ lines(currfile->sy_file, (int)currline, (int)currline);
+ }
+ return 1;
+}
+
+static int
+could_send(m, stop_message)
+ struct message_hdr *m;
+{
+ int type;
+ t_addr a;
+ for (;;) {
+ if (child_pid) {
+ if (! uputm(m) ||
+ ! ugetm(&answer)) {
+ if (child_pid) {
+ error("something wrong!");
+ return 1;
+ }
+ wait(&child_status);
+ init_run();
+ if (child_status & 0177) {
+ fprintf(db_out,
+ "Child died with signal %d\n",
+ child_status & 0177);
+ }
+ else {
+ fprintf(db_out,
+ "Child terminated, exit status %d\n",
+ child_status >> 8);
+ }
+ return 1;
+ }
+ a = answer.m_size;
+ type = answer.m_type;
+ if (m->m_type & DB_RUN) {
+ /* run command */
+ CurrentScope = get_scope_from_addr((t_addr) a);
+ if (! item_addr_actions(a) &&
+ ( type == DB_SS || type == 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);
+ }
+ continue;
+ }
+ if (type != END_SS && single_stepping) {
+ m->m_type = CLRSS;
+ uputm(m) && ugetm(&answer);
+ }
+ single_stepping = 0;
+ }
+ if (stop_message) stopped("stopped", a);
+ return 1;
+ }
+ return 0;
+ }
+ /*NOTREACHED*/
+}
+
+int
+get_bytes(size, from, to)
+ long size;
+ t_addr from;
+ char *to;
+{
+ struct message_hdr m;
+
+ m.m_type = GETBYTES;
+ m.m_size = size;
+ ATOBUF(m.m_buf, (char *) from);
+
+ if (! could_send(&m, 0)) {
+ return 0;
+ }
+
+ assert(answer.m_type == DATA && answer.m_size == m.m_size);
+
+ return ureceive(to, answer.m_size);
+}
+
+int
+get_dump(globmessage, globbuf, stackmessage, stackbuf)
+ struct message_hdr *globmessage, *stackmessage;
+ char **globbuf, **stackbuf;
+{
+ struct message_hdr m;
+
+ m.m_type = DUMP;
+ if (! could_send(&m, 0)) {
+ return 0;
+ }
+ assert(answer.m_type == DGLOB);
+ *globmessage = answer;
+ *globbuf = Malloc((unsigned) answer.m_size);
+ if (! ureceive(*globbuf, answer.m_size) || ! ugetm(stackmessage)) {
+ free(*globbuf);
+ return 0;
+ }
+ assert(stackmessage->m_type == DSTACK);
+ *stackbuf = Malloc((unsigned) stackmessage->m_size);
+ if (! ureceive(*stackbuf, stackmessage->m_size)) {
+ free(*globbuf);
+ free(*stackbuf);
+ return 0;
+ }
+ ATOBUF(globmessage->m_buf+SP_OFF*pointer_size,
+ BUFTOA(stackmessage->m_buf+SP_OFF*pointer_size));
+ return 1;
+}
+
+int
+put_dump(globmessage, globbuf, stackmessage, stackbuf)
+ struct message_hdr *globmessage, *stackmessage;
+ char *globbuf, *stackbuf;
+{
+ struct message_hdr m;
+
+ if (! child_pid) {
+ restoring = 1;
+ start_child(run_command);
+ restoring = 0;
+ }
+ return uputm(globmessage) &&
+ usend(globbuf, globmessage->m_size) &&
+ uputm(stackmessage) &&
+ usend(stackbuf, stackmessage->m_size) &&
+ ugetm(&m) && stopped("restored", m.m_size);
+}
+
+t_addr *
+get_EM_regs(level)
+ int level;
+{
+ struct message_hdr m;
+ static t_addr buf[5];
+ register t_addr *to = &buf[0];
+
+ m.m_type = GETEMREGS;
+ m.m_size = level;
+
+ if (! could_send(&m, 0)) {
+ return 0;
+ }
+ *to++ = (t_addr) BUFTOA(answer.m_buf);
+ *to++ = (t_addr) BUFTOA(answer.m_buf+pointer_size);
+ *to++ = (t_addr) BUFTOA(answer.m_buf+2*pointer_size);
+ *to++ = (t_addr) BUFTOA(answer.m_buf+3*pointer_size);
+ *to++ = (t_addr) BUFTOA(answer.m_buf+4*pointer_size);
+ return buf;
+}
+
+int
+set_pc(PC)
+ t_addr PC;
+{
+ struct message_hdr m;
+
+ m.m_type = SETEMREGS;
+ m.m_size = 0;
+ ATOBUF(m.m_buf+PC_OFF*pointer_size, (char *)PC);
+ return could_send(&m, 0);
+}
+
+int
+send_cont(stop_message)
+ int stop_message;
+{
+ struct message_hdr m;
+
+ m.m_type = (CONT | (db_ss ? DB_SS : 0));
+ m.m_size = 0;
+ return could_send(&m, stop_message);
+}
+
+int
+do_single_step(type, count)
+ int type;
+ long count;
+{
+ struct message_hdr m;
+
+ m.m_type = type | (db_ss ? DB_SS : 0);
+ m.m_size = count;
+ single_stepping = 1;
+ if (could_send(&m, 1)) {
+ return 1;
+ }
+ single_stepping = 0;
+ return 0;
+}
+
+int
+set_or_clear_breakpoint(a, type)
+ t_addr a;
+ int type;
+{
+ struct message_hdr m;
+
+ if (a == ILL_ADDR || a == NO_ADDR) return 0;
+
+ m.m_type = type;
+ m.m_size = a;
+ if (debug) printf("%s breakpoint at 0x%lx\n", type == SETBP ? "setting" : "clearing", (long) a);
+ if (! could_send(&m, 0)) { }
+
+ return 1;
+}
+
+int
+set_or_clear_trace(start, end, type)
+ t_addr start, end;
+ int type;
+{
+ struct message_hdr m;
+
+ m.m_type = type;
+ ATOBUF(m.m_buf, (char *) start);
+ ATOBUF(m.m_buf+pointer_size, (char *) end);
+ if (debug) printf("%s trace at [0x%lx,0x%lx]\n", type == SETTRACE ? "setting" : "clearing", (long) start, (long) end);
+ if (! could_send(&m, 0)) { }
+
+ return 1;
+}
--- /dev/null
+/* Scope mechanism */
+
+/* $Header$ */
+
+#include <assert.h>
+#include <alloc.h>
+#include <out.h>
+
+#include "position.h"
+#include "file.h"
+#include "idf.h"
+#include "type.h"
+#include "symbol.h"
+#include "scope.h"
+#include "avl.h"
+
+p_scope PervasiveScope, CurrentScope, FileScope;
+
+/* STATICALLOCDEF "scope" 10 */
+
+static AVL_tree ScopeTree;
+
+static int
+cmp_starts(s1, s2)
+ char *s1, *s2;
+{
+ register p_scope c1 = (p_scope)s1, c2 = (p_scope)s2;
+
+ return c1->sc_start < c2->sc_start
+ ? -1
+ : c1->sc_start == c2->sc_start
+ ? 0
+ : 1;
+}
+
+/*ARGSUSED*/
+open_scope(name, has_activation)
+ p_symbol name;
+ int has_activation;
+{
+ register p_scope sc = new_scope();
+
+ sc->sc_has_activation_record = has_activation;
+ sc->sc_static_encl = CurrentScope;
+ sc->sc_definedby = name;
+ sc->sc_proclevel = CurrentScope->sc_proclevel;
+ /* sc_proclevel possibly reset by caller */
+ CurrentScope = sc;
+}
+
+init_scope()
+{
+ register p_scope sc = new_scope();
+
+ PervasiveScope = sc;
+ CurrentScope = sc;
+ open_scope((p_symbol) 0, 0); /* this one will be closed at the
+ first N_SO
+ */
+ ScopeTree = create_avl_tree(cmp_starts);
+}
+
+close_scope()
+{
+ register p_scope sc = CurrentScope;
+
+ assert(sc != 0);
+ CurrentScope = sc->sc_static_encl;
+}
+
+add_scope_addr(scope)
+ p_scope scope;
+{
+ add_to_avl_tree(ScopeTree, (char *)scope);
+}
+
+/* extern p_scope get_scope_from_addr(t_addr a);
+ Returns the scope of the code at address 'a', or 0 if it could not be found.
+*/
+p_scope
+get_scope_from_addr(a)
+ t_addr a;
+{
+ t_scope sc;
+
+ sc.sc_start = a;
+ return (p_scope) find_ngt(ScopeTree, (char *) &sc);
+}
+
+/* extern p_scope get_next_scope_from_addr(t_addr a);
+ Returns the scope following the one of the code at address 'a',
+ and that has an activation record,
+ or 0 if it could not be found.
+*/
+p_scope
+get_next_scope_from_addr(a)
+ t_addr a;
+{
+ t_scope sc;
+
+ sc.sc_start = a;
+ for (;;) {
+ p_scope psc = (p_scope) find_nlt(ScopeTree, (char *) &sc);
+ if (! psc || psc->sc_has_activation_record) return psc;
+ sc.sc_start = psc->sc_start+1;
+ }
+ /*NOTREACHED*/
+}
+
+/* extern int has_static_link(p_scope sc);
+ Returns 1 if the procedure of this scope takes a static link.
+*/
+int
+has_static_link(sc)
+ register p_scope sc;
+{
+ return sc->sc_proclevel > 1;
+}
+
+/* extern p_scope base_scope(p_scope sc);
+ Returns the closest enclosing scope of 'sc' that has an activation record.
+*/
+p_scope
+base_scope(sc)
+ register p_scope sc;
+{
+ while (sc && ! sc->sc_has_activation_record) {
+ sc = sc->sc_static_encl;
+ }
+ return sc;
+}
--- /dev/null
+/* scope structure */
+
+/* $Header$ */
+
+typedef struct scope {
+ struct scope *sc_static_encl; /* linked list of enclosing scopes */
+ struct symbol *sc_symbs; /* symbols defined in this scope */
+ struct symbol *sc_definedby; /* symbol defining this scope */
+ long sc_start; /* start address of code of this scope */
+ long sc_bp_opp; /* first breakpoint opportunity */
+ short sc_proclevel; /* proc level of this scope */
+ char sc_has_activation_record;
+} t_scope, *p_scope;
+
+extern p_scope PervasiveScope, CurrentScope, FileScope;
+
+/* extern init_scope();
+ Initializes the scope routines.
+*/
+extern init_scope();
+
+/* extern open_scope(struct symbol *name, int has_activation);
+ Opens a new scope and assigns it to CurrentScope; The new scope is defined
+ by 'name' and if 'has_activation' is set, it has an activation record.
+*/
+extern open_scope();
+
+/* extern close_scope();
+ Closes the current scope; CurrentScope becomes the statically enclosing
+ scope.
+*/
+extern close_scope();
+
+/* extern add_scope_addr(p_scope sc);
+ Adds scope 'sc' to the list of scopes that have an address at runtime.
+*/
+extern add_scope_addr();
+
+/* extern p_scope get_scope_from_addr(t_addr a);
+ Returns the scope of the code at address 'a', or 0 if it could not be found.
+*/
+extern p_scope get_scope_from_addr();
+
+/* extern p_scope get_next_scope_from_addr(t_addr a);
+ Returns the scope following the one of the code at address 'a',
+ and that has an activation record,
+ or 0 if it could not be found.
+*/
+extern p_scope get_next_scope_from_addr();
+
+/* extern p_scope base_scope(p_scope sc);
+ Returns the closest enclosing scope of 'sc' that has an activation record.
+*/
+extern p_scope base_scope();
--- /dev/null
+/* For the time being ... */
+
+#define SZ_INT 4
+#define SZ_SHORT 2
+#define SZ_POINTER 4
+#define SZ_LONG 4
+#define SZ_FLOAT 4
+#define SZ_DOUBLE 8
--- /dev/null
+/* $Header$ */
+
+/* Symbol handling */
+
+#include <alloc.h>
+#include <out.h>
+#include <stb.h>
+#include <assert.h>
+
+#include "position.h"
+#include "file.h"
+#include "idf.h"
+#include "type.h"
+#include "symbol.h"
+#include "scope.h"
+#include "tree.h"
+#include "operator.h"
+
+p_symbol currfile;
+
+p_symbol
+NewSymbol(s, scope, class, nam)
+ char *s;
+ register p_scope scope;
+ struct outname *nam;
+{
+ register p_symbol sym;
+
+ sym = new_symbol();
+ sym->sy_idf = str2idf(s, 0);
+ sym->sy_scope = scope;
+ sym->sy_prev_sc = scope->sc_symbs;
+ scope->sc_symbs = sym;
+ sym->sy_next = sym->sy_idf->id_def;
+ sym->sy_idf->id_def = sym;
+ sym->sy_class = class;
+ switch(class) {
+ case MODULE:
+ case PROC:
+ case FUNCTION:
+ case VAR:
+ case REGVAR:
+ case LOCVAR:
+ case VARPAR:
+ sym->sy_name.nm_value = nam->on_valu;
+ break;
+ default:
+ break;
+ }
+ return sym;
+}
+
+/* Lookup a definition for 'id' in scope 'scope' with class in the 'class'
+ bitset.
+*/
+p_symbol
+Lookup(id, scope, class)
+ struct idf *id;
+ p_scope scope;
+ int class;
+{
+ register p_symbol p = id ? id->id_def : 0;
+
+ while (p) {
+ if (p->sy_scope == scope && (p->sy_class & class)) {
+ return p;
+ }
+ p = p->sy_next;
+ }
+ return (p_symbol) 0;
+}
+
+/* Lookup a definition for 'id' with class in the 'class' bitset,
+ starting in scope 'sc' and also looking in enclosing scopes.
+*/
+p_symbol
+Lookfromscope(id, class, sc)
+ register struct idf *id;
+ int class;
+ register p_scope sc;
+{
+ if (! id) return (p_symbol) 0;
+
+ while (sc) {
+ register p_symbol sym = id->id_def;
+ while (sym) {
+ if (sym->sy_scope == sc && (sym->sy_class & class)) {
+ return sym;
+ }
+ sym = sym->sy_next;
+ }
+ sc = sc->sc_static_encl;
+ }
+ return (p_symbol) 0;
+}
+
+/* Lookup a definition for 'id' with class in the 'class' bitset,
+ starting in scope 'CurrentScope' and also looking in enclosing scopes.
+*/
+p_symbol
+Lookfor(id, class)
+ register struct idf *id;
+ int class;
+{
+ return Lookfromscope(id, class, CurrentScope);
+}
+
+extern char *strrindex();
+
+p_symbol
+add_file(s)
+ char *s;
+{
+ register p_symbol sym = NewSymbol(s,
+ PervasiveScope,
+ FILESYM,
+ (struct outname *) 0);
+ register char *p;
+
+ sym->sy_file = new_file();
+ sym->sy_file->f_sym = sym;
+ p = strrindex(s, '.');
+ if (p) {
+ char c = *p;
+ p_symbol sym1;
+
+ *p = 0;
+ sym1 = NewSymbol(Salloc(s, (unsigned) strlen(s)+1),
+ PervasiveScope,
+ FILELINK,
+ (struct outname *) 0);
+ *p = c;
+ sym1->sy_filelink = sym;
+ }
+ return sym;
+}
+
+/* Determine if the OP_SELECT tree indicated by 'p' could lead to scope 'sc'.
+*/
+static int
+consistent(p, sc)
+ p_tree p;
+ p_scope sc;
+{
+ p_tree arg;
+ p_symbol sym;
+
+ assert(p->t_oper == OP_SELECT);
+ sc = sc->sc_static_encl;
+ if (!sc) return 0;
+
+ p = p->t_args[0];
+
+ switch(p->t_oper) {
+ case OP_NAME:
+ sym = Lookfromscope(p->t_idf, FILELINK|FILESYM|PROC|MODULE, sc);
+ return sym != 0;
+
+ case OP_SELECT:
+ arg = p->t_args[1];
+ sym = Lookfromscope(arg->t_idf, FILELINK|FILESYM|PROC|MODULE, sc);
+ if (sym == 0) return 0;
+ return consistent(p, sym->sy_scope);
+
+ default:
+ assert(0);
+ }
+ return 0; /* notreached? */
+}
+
+/* Try to find the name referred to in the node indicated by 'p', and
+ try to be just a little bit intelligent about it.
+*/
+p_symbol
+identify(p, class_set)
+ p_tree p;
+ int class_set;
+{
+ p_symbol sym = 0;
+ register p_symbol s;
+ p_tree arg;
+
+ switch(p->t_oper) {
+ case OP_NAME:
+ if (! p->t_sc) p->t_sc = CurrentScope;
+ sym = Lookfromscope(p->t_idf, class_set, p->t_sc);
+ if (sym) {
+ /* Found it. */
+ break;
+ }
+
+ /* We could not find it using scope p->t_sc; now we try to identify
+ it using class_set. If this results in only one definition, we
+ take this one.
+ */
+ s = p->t_idf->id_def;
+ while (s) {
+ if (s->sy_class & class_set) {
+ if (sym) {
+ error("could not identify \"%s\"", p->t_str);
+ sym = 0;
+ break;
+ }
+ sym = s;
+ }
+ s = s->sy_next;
+ }
+ if (!sym && !s) {
+ error("could not find \"%s\"", p->t_str);
+ }
+ break;
+
+ case OP_SELECT:
+ arg = p->t_args[1];
+ assert(arg->t_oper == OP_NAME);
+ s = arg->t_idf->id_def;
+ sym = 0;
+ while (s) {
+ if ((s->sy_class & class_set) && consistent(p, s->sy_scope)) {
+ if (sym) {
+ error("could not identify \"%s\"", arg->t_str);
+ sym = 0;
+ }
+ sym = s;
+ }
+ s = s->sy_next;
+ }
+ if (!sym && !s) {
+ error("could not find \"%s\"", arg->t_str);
+ }
+ break;
+
+ default:
+ assert(0);
+ }
+ return sym;
+}
--- /dev/null
+/* $Header$
+ Symbol table data structure.
+ Each identifier structure refers to a list of possible meanings of this
+ identifier. Each of these meanings is represented by a "symbol" structure.
+*/
+
+typedef union constant { /* depends on type */
+ long co_ival;
+ double co_rval;
+ char *co_sval;
+ char *co_setval;
+} t_const, *p_const;
+
+typedef struct name {
+ long nm_value; /* address or offset */
+ struct scope *nm_scope; /* for names that define a scope */
+} t_name, *p_name;
+
+typedef struct symbol {
+ struct symbol *sy_next; /* link to next meaning */
+ struct symbol *sy_prev_sc; /* link to previous decl in scope */
+ struct type *sy_type; /* type of symbol */
+ int sy_class;
+#define CONST 0x0001
+#define TYPE 0x0002
+#define TAG 0x0004
+#define MODULE 0x0008
+#define PROC 0x0010
+#define FUNCTION 0x0020
+#define VAR 0x0040
+#define REGVAR 0x0080
+#define LOCVAR 0x0100
+#define VARPAR 0x0200
+/* #define SYMENTRY 0x0400 /* a non-dbx entry */
+#define FILESYM 0x0800 /* a filename */
+#define FILELINK 0x1000 /* a filename without its suffix */
+ struct idf *sy_idf; /* reference back to its idf structure */
+ struct scope *sy_scope; /* scope in which this symbol resides */
+ union {
+ t_const syv_const; /* CONST */
+ t_name syv_name;
+/* struct outname syv_onam; /* for non-dbx entries */
+ struct file *syv_file; /* for FILESYM */
+ struct symbol *syv_fllink; /* for FILELINK */
+ } sy_v;
+#define sy_const sy_v.syv_const
+#define sy_name sy_v.syv_name
+#define sy_onam sy_v.syv_onam
+#define sy_file sy_v.syv_file
+#define sy_filelink sy_v.syv_fllink
+} t_symbol, *p_symbol;
+
+/* ALLOCDEF "symbol" 50 */
+
+extern p_symbol NewSymbol(), Lookup(), Lookfor(), Lookfromscope(), add_file();
+extern p_symbol identify();
+
+extern p_symbol currfile;
--- /dev/null
+MAKE_TOKFILE = make.tokfile;
+MAKE_TOKCASE = make.tokcase;
+
+%tool gen_tokens (
+ csrc: %in [type = C-src, gen_tokens, persistent];
+ tokfile: %out [type = LLgen-src] => get($csrc, LL-dest);
+ symbols: %out [type = C-src, b] => get($csrc, cc-dest);
+ mktok: %in [type = command] => $MAKE_TOKFILE;
+ mkcase: %in [type = command] => $MAKE_TOKCASE;
+)
+{
+ exec($mktok, stdin => $csrc, stdout => $tokfile);
+ exec($mkcase, stdin => $csrc, stdout => $symbols);
+ echo({$tokfile, 'and', $symbols, 'created'});
+};
--- /dev/null
+/*
+ * (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"
+#include "Lpars.h"
+#include "position.h"
+#include "file.h"
+#include "idf.h"
+
+/* To centralize the declaration of %tokens, their presence in this
+ file is taken as their declaration. The Makefile will produce
+ a grammar file (tokenfile.g) from this file. This scheme ensures
+ that all tokens have a printable name.
+ Also, the "token2str.c" file is produced from this file.
+*/
+
+#if 0
+struct tokenname tkspec[] = { /* the names of the special tokens */
+ {NAME, "name"},
+ {STRING, "string"},
+ {INTEGER, "number"},
+ {REAL, "real"},
+ {CHAR, "char"},
+ {0, ""}
+};
+#endif
+
+struct tokenname tkidf[] = { /* names of the identifier tokens */
+ {LIST, "list"},
+ {XFILE, "file"},
+ {RUN, "run"},
+ {RERUN, "rerun"},
+ {STOP, "stop"},
+ {WHEN, "when"},
+ {AT, "at"},
+ {IN, "in"},
+ {ON, "on"},
+ {IF, "if"},
+ {CONT, "cont"},
+ {STEP, "step"},
+ {NEXT, "next"},
+ {REGS, "regs"},
+ {WHERE, "where"},
+ {STATUS, "status"},
+ {DELETE, "delete"},
+ {PRINT, "print"},
+ {DUMP, "dump"},
+ {RESTORE, "restore"},
+ {TRACE, "trace"},
+ {-1, "quit"},
+ {0, ""}
+};
+
+#if 0
+struct tokenname tkinternal[] = { /* internal keywords */
+ {0, "0"}
+};
+
+struct tokenname tkstandard[] = { /* standard identifiers */
+ {0, ""}
+};
+#endif
+
+/* Some routines to handle tokennames */
+
+reserve(resv)
+ register struct tokenname *resv;
+{
+ /* The names of the tokens described in resv are entered
+ as reserved words.
+ */
+ register struct idf *p;
+
+ while (resv->tn_symbol) {
+ p = str2idf(resv->tn_name, 0);
+ if (!p) fatal("out of Memory");
+ p->id_reserved = resv->tn_symbol;
+ resv++;
+ }
+}
--- /dev/null
+/*
+ * (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
+ token as identified by its symbol
+ */
+ int tn_symbol;
+ char *tn_name;
+};
--- /dev/null
+/* $Header$ */
+
+#include <stdio.h>
+#include <varargs.h>
+#include <assert.h>
+#include <alloc.h>
+#include <out.h>
+
+#include "operator.h"
+#include "position.h"
+#include "file.h"
+#include "idf.h"
+#include "tree.h"
+#include "message.h"
+#include "scope.h"
+#include "symbol.h"
+#include "langdep.h"
+
+extern FILE *db_out;
+extern t_lineno currline;
+extern long pointer_size;
+extern char *strrindex();
+
+p_tree run_command;
+
+/*VARARGS1*/
+p_tree
+mknode(va_alist)
+ va_dcl
+{
+ va_list ap;
+ register p_tree p = new_tree();
+
+ va_start(ap);
+ {
+ register int i, na;
+
+ p->t_oper = va_arg(ap, int);
+ switch(p->t_oper) {
+ case OP_NAME:
+ p->t_idf = va_arg(ap, struct idf *);
+ p->t_str = va_arg(ap, char *);
+ break;
+ case OP_INTEGER:
+ p->t_ival = va_arg(ap, long);
+ break;
+ case OP_AT:
+ p->t_lino = va_arg(ap, long);
+ p->t_filename = va_arg(ap, char *);
+ break;
+ case OP_NEXT:
+ case OP_STEP:
+ case OP_REGS:
+ case OP_DELETE:
+ case OP_RESTORE:
+ p->t_ival = va_arg(ap, long);
+ break;
+ default:
+ na = nargs(p->t_oper);
+ assert(na <= MAXARGS);
+ for (i = 0; i < na; i++) {
+ p->t_args[i] = va_arg(ap, p_tree);
+ }
+ break;
+ }
+ }
+ va_end(ap);
+ return p;
+}
+
+freenode(p)
+ register p_tree p;
+{
+ register int na, i;
+
+ if (! p) return;
+ switch(p->t_oper) {
+ case OP_NAME:
+ case OP_INTEGER:
+ case OP_AT:
+ case OP_CONT:
+ case OP_NEXT:
+ case OP_STEP:
+ case OP_REGS:
+ case OP_DELETE:
+ break;
+ default:
+ na = nargs(p->t_oper);
+ assert(na <= MAXARGS);
+ for (i = 0; i < na; i++) {
+ freenode(p->t_args[i]);
+ }
+ break;
+ }
+ free_tree(p);
+}
+
+print_node(p, top_level)
+ register p_tree p;
+{
+ if (!p) return;
+ switch(p->t_oper) {
+ case OP_LIST:
+ fputs("list ", db_out);
+ if (p->t_args[0]) {
+ print_node(p->t_args[0], 0);
+ if (p->t_args[1]) {
+ fputs(", ", db_out);
+ print_node(p->t_args[1], 0);
+ }
+ }
+ break;
+ case OP_PRINT:
+ fputs("print ", db_out);
+ print_node(p->t_args[0], 0);
+ break;
+ case OP_FILE:
+ fputs("file ", db_out);
+ print_node(p->t_args[0], 0);
+ break;
+ case OP_DELETE:
+ fprintf(db_out, "delete %d", p->t_ival);
+ break;
+ case OP_REGS:
+ fprintf(db_out, "regs %d", p->t_ival);
+ break;
+ case OP_NEXT:
+ fprintf(db_out, "next %d", p->t_ival);
+ break;
+ case OP_STEP:
+ fprintf(db_out, "step %d", p->t_ival);
+ break;
+ case OP_STATUS:
+ fputs("status", db_out);
+ break;
+ case OP_DUMP:
+ fputs("dump ", db_out);
+ print_position(p->t_address, 1);
+ break;
+ case OP_RESTORE:
+ fprintf(db_out, "restore %d", p->t_ival);
+ break;
+ case OP_WHERE:
+ fputs("where", db_out);
+ break;
+ case OP_CONT:
+ fputs("cont", db_out);
+ if (p->t_args[0]) {
+ fprintf(db_out, " %d", p->t_args[0]->t_ival);
+ }
+ if (p->t_args[1]) {
+ fputs(" ", db_out);
+ print_node(p->t_args[1], 0);
+ }
+ break;
+
+ case OP_WHEN:
+ fputs("when ", db_out);
+ if (p->t_address != NO_ADDR) {
+ print_position(p->t_address, 1);
+ }
+ else print_node(p->t_args[0], 0);
+ if (p->t_args[1]) {
+ fputs(" if ", db_out);
+ print_node(p->t_args[1], 0);
+ }
+ p = p->t_args[2];
+ fputs(" { ", db_out);
+ while (p->t_oper == OP_LINK) {
+ print_node(p->t_args[0], 0);
+ fputs("; ", db_out);
+ p = p->t_args[1];
+ }
+ print_node(p, 0);
+ fputs(" }", db_out);
+ break;
+ case OP_STOP:
+ fputs("stop ", db_out);
+ if (p->t_address != NO_ADDR) {
+ print_position(p->t_address, 1);
+ }
+ else print_node(p->t_args[0], 0);
+ if (p->t_args[1]) {
+ fputs(" if ", db_out);
+ print_node(p->t_args[1], 0);
+ }
+ break;
+ case OP_TRACE:
+ fputs("trace ", db_out);
+ if (p->t_args[2]) {
+ fputs("on ", db_out);
+ print_node(p->t_args[2], 0);
+ fputs(" ", db_out);
+ }
+ if (p->t_address != NO_ADDR) {
+ print_position(p->t_address, 1);
+ }
+ else print_node(p->t_args[0], 0);
+ if (p->t_args[1]) {
+ fputs(" if ", db_out);
+ print_node(p->t_args[1], 0);
+ }
+ break;
+ case OP_AT:
+ fprintf(db_out, "at \"%s\":%ld", p->t_filename, p->t_lino);
+ break;
+ case OP_IN:
+ fputs("in ", db_out);
+ print_node(p->t_args[0], 0);
+ break;
+ case OP_SELECT:
+ print_node(p->t_args[0], 0);
+ fputs("`", db_out);
+ print_node(p->t_args[1], 0);
+ break;
+ case OP_NAME:
+ fputs(p->t_str, db_out);
+ break;
+ case OP_INTEGER:
+ fprintf(db_out, "%d", p->t_ival);
+ break;
+ }
+ if (top_level) fputs("\n", db_out);
+}
+
+int
+repeatable(com)
+ p_tree com;
+{
+ switch(com->t_oper) {
+ case OP_CONT:
+ case OP_NEXT:
+ case OP_STEP:
+ case OP_LIST:
+ case OP_STATUS:
+ case OP_PRINT:
+ return 1;
+ }
+ return 0;
+}
+
+int
+in_status(com)
+ p_tree com;
+{
+ switch(com->t_oper) {
+ case OP_STOP:
+ case OP_WHEN:
+ case OP_TRACE:
+ case OP_DUMP:
+ return 1;
+ }
+ return 0;
+}
+
+eval(p)
+ p_tree p;
+{
+ if (p) (*operators[p->t_oper].op_fun)(p);
+}
+
+do_list(p)
+ p_tree p;
+{
+ if (currfile) {
+ lines(currfile->sy_file,
+ p->t_args[0] ? (int) p->t_args[0]->t_ival : (int) currline,
+ p->t_args[1] ? (int) p->t_args[1]->t_ival : (int) currline+9);
+ currline = p->t_args[1] ? p->t_args[1]->t_ival + 1 : currline + 10;
+ }
+ else fprintf(db_out, "no current file\n");
+}
+
+do_file(p)
+ p_tree p;
+{
+ if (p->t_args[0]) {
+ newfile(p->t_args[0]->t_idf);
+ }
+ else if (currfile) fprintf(db_out, "%s\n", currfile->sy_idf->id_text);
+ else fprintf(db_out, "no current file\n");
+}
+
+newfile(id)
+ register struct idf *id;
+{
+ register p_symbol sym = Lookup(id, PervasiveScope, FILESYM);
+
+ if (currfile != sym) currline = 1;
+ currfile = sym;
+ if (! currfile) {
+ currline = 1;
+ currfile = add_file(id->id_text);
+ currfile->sy_file->f_scope = FileScope;
+ }
+ find_language(strrindex(id->id_text, '.'));
+}
+
+static t_addr
+get_pos(p)
+ p_tree p;
+{
+ t_addr a = ILL_ADDR;
+ register p_symbol sym;
+
+ if (! p) return NO_ADDR;
+ if (p->t_address != 0) return p->t_address;
+ switch(p->t_oper) {
+ case OP_AT:
+ if (! p->t_filename &&
+ (! currfile || ! (p->t_filename = currfile->sy_idf->id_text))) {
+ error("no current file");
+ break;
+ }
+ a = get_addr_from_position(&(p->t_pos));
+ if (a == ILL_ADDR) {
+ error("could not determine address of \"%s\":%d",
+ p->t_filename, p->t_lino);
+ break;
+ }
+ p->t_address = a;
+ break;
+
+ case OP_IN:
+ a = get_pos(p->t_args[0]);
+ p->t_address = a;
+ break;
+
+ case OP_NAME:
+ case OP_SELECT:
+ sym = identify(p, PROC|MODULE);
+ if (! sym) {
+ break;
+ }
+ if (! sym->sy_name.nm_scope || ! sym->sy_name.nm_scope->sc_bp_opp) {
+ error("could not determine address of \"%s\"", p->t_str);
+ break;
+ }
+ a = sym->sy_name.nm_scope->sc_bp_opp;
+ break;
+
+ default:
+ assert(0);
+ }
+ return a;
+}
+
+do_stop(p)
+ p_tree p;
+{
+ t_addr a = get_pos(p->t_args[0]);
+
+ if (a == ILL_ADDR) {
+ return;
+ }
+
+ p->t_address = a;
+ add_to_item_list(p);
+ if (a != NO_ADDR) {
+ if (! set_or_clear_breakpoint(a, SETBP)) {
+ error("could not set breakpoint");
+ }
+ }
+}
+
+do_trace(p)
+ p_tree p;
+{
+ t_addr a;
+ t_addr e;
+
+ p->t_address = NO_ADDR;
+ if (p->t_args[0]) {
+ a = get_pos(p->t_args[0]);
+ if (a == ILL_ADDR) return;
+ 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;
+ }
+ if (! set_or_clear_trace(a, e, SETTRACE)) {
+ error("could not set trace");
+ }
+ }
+ add_to_item_list(p);
+}
+
+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) ||
+ ! set_pc(a)) {
+ error("cannot continue at line %d",
+ p->t_args[1]->t_lino);
+ return;
+ }
+ }
+ }
+ else count = 1;
+ while (count--) {
+ if (! send_cont(count==0)) {
+ error("no debuggee");
+ break;
+ }
+ }
+}
+
+do_step(p)
+ p_tree p;
+{
+ if (! do_single_step(SETSS, p->t_ival)) {
+ error("no debuggee");
+ }
+}
+
+do_next(p)
+ p_tree p;
+{
+
+ if (! do_single_step(SETSSF, p->t_ival)) {
+ error("no debuggee");
+ }
+}
+
+extern t_addr *get_EM_regs();
+
+do_regs(p)
+ p_tree p;
+{
+ t_addr *buf;
+ int n = p->t_ival;
+
+ if (! (buf = get_EM_regs(n))) {
+ error("no debuggee");
+ 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;
+
+ for (;;) {
+ t_addr AB;
+ t_addr PC;
+ p_scope sc;
+ t_addr *buf;
+
+ if (! (buf = get_EM_regs(i++))) {
+ error("no debuggee");
+ return;
+ }
+ 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);
+ }
+}
+
+/*ARGSUSED*/
+do_status(p)
+ p_tree p;
+{
+ print_items();
+}
+
+extern p_tree remove_from_item_list();
+
+do_delete(p)
+ p_tree p;
+{
+ p = remove_from_item_list((int) p->t_ival);
+
+ if (p) switch(p->t_oper) {
+ case OP_WHEN:
+ case OP_STOP: {
+ t_addr a = get_pos(p->t_args[0]);
+
+ if (a != ILL_ADDR && a != NO_ADDR) {
+ set_or_clear_breakpoint(a, CLRBP);
+ }
+ break;
+ }
+ case OP_TRACE: {
+ t_addr a = get_pos(p->t_args[0]);
+
+ if (a != ILL_ADDR && a != NO_ADDR) {
+ t_addr e;
+ if (p->t_args[0]->t_oper == OP_AT) {
+ e = a;
+ }
+ else {
+ p_scope sc = get_next_scope_from_addr(a+1);
+
+ if (sc) e = sc->sc_start - 1;
+ else e = 0xffffffff;
+ }
+ set_or_clear_trace(a, e, CLRTRACE);
+ }
+ break;
+ }
+ case OP_DUMP:
+ free_dump(p);
+ }
+ freenode(p);
+}
+
+do_print(p)
+ p_tree p;
+{
+ p_symbol sym;
+
+ switch(p->t_oper) {
+ case OP_PRINT:
+ do_print(p->t_args[0]);
+ break;
+ case OP_LINK:
+ do_print(p->t_args[0]);
+ do_print(p->t_args[1]);
+ break;
+ case OP_NAME:
+ case OP_SELECT:
+ sym = identify(p, VAR|REGVAR|LOCVAR|VARPAR);
+ if (! sym) return;
+ print_node(p, 0);
+ if (! print_sym(sym)) {
+ fputs(" currently not available\n", db_out);
+ break;
+ }
+ }
+}
+
+perform(p, a)
+ register p_tree p;
+ t_addr a;
+{
+ switch(p->t_oper) {
+ case OP_WHEN:
+ p = p->t_args[2];
+ while (p->t_oper == OP_LINK) {
+ eval(p->t_args[0]);
+ p = p->t_args[1];
+ }
+ eval(p);
+ break;
+ case OP_TRACE:
+ if (p->t_args[0] && p->t_args[0]->t_oper == OP_IN) {
+ register p_scope sc = base_scope(CurrentScope);
+
+ if (sc != get_scope_from_addr(p->t_args[0]->t_address)) {
+ break;
+ }
+ }
+ {
+ p_position pos = get_position_from_addr(a);
+
+ newfile(str2idf(pos->filename, 1));
+ currline = pos->lineno;
+ lines(currfile->sy_file, (int)currline, (int)currline);
+ if (p->t_args[2]) do_print(p->t_args[2]);
+ }
+ break;
+ default:
+ assert(0);
+ }
+}
--- /dev/null
+/* $Header$ */
+
+#define MAXARGS 3
+
+typedef struct tree {
+ int t_oper; /* operator */
+ t_addr t_address; /* some operators use an address */
+ int t_itemno; /* item number in status list */
+ union {
+ long tt_ival;
+ struct {
+ struct idf *tt_idf;
+ char *tt_str;
+ struct scope *tt_scope;
+ } tt_x;
+ struct tree *tt_args[MAXARGS];
+ t_position tt_pos;
+ } t_xxxx;
+#define t_ival t_xxxx.tt_ival
+#define t_idf t_xxxx.tt_x.tt_idf
+#define t_str t_xxxx.tt_x.tt_str
+#define t_sc t_xxxx.tt_x.tt_scope
+#define t_args t_xxxx.tt_args
+#define t_lino t_xxxx.tt_pos.lineno
+#define t_filename t_xxxx.tt_pos.filename
+#define t_pos t_xxxx.tt_pos
+} t_tree, *p_tree;
+
+/* ALLOCDEF "tree" 100 */
+
+extern p_tree mknode();
+extern p_tree run_command;
--- /dev/null
+/* $Header$ */
+
+/* Routines to create type structures */
+
+#include <alloc.h>
+#include <assert.h>
+
+#include "type.h"
+#include "sizes.h"
+#include "symbol.h"
+#include "scope.h"
+#include "message.h"
+#include "langdep.h"
+
+p_type int_type, char_type, short_type, long_type;
+p_type uint_type, uchar_type, ushort_type, ulong_type;
+p_type void_type, incomplete_type;
+p_type float_type, double_type;
+p_type string_type;
+
+long int_size = SZ_INT,
+ char_size = 1,
+ short_size = SZ_SHORT,
+ long_size = SZ_LONG,
+ pointer_size = SZ_POINTER;
+
+long float_size = SZ_FLOAT,
+ double_size = SZ_DOUBLE;
+
+struct bounds {
+ long low, high;
+};
+
+static struct bounds ibounds[2] = {
+ { -128, 127 },
+ { -32768, 32767 }
+};
+
+static struct bounds ubounds[2] = {
+ { 0, 255 },
+ { 0, 65535 }
+};
+
+static long max_int[8], max_uns[8];
+
+struct integer_types {
+ long maxval;
+ p_type type;
+};
+
+static struct integer_types i_types[4];
+static struct integer_types u_types[5];
+
+#define ufit(n, nb) Xfit(n, nb, ubounds)
+#define ifit(n, nb) Xfit(n, nb, ibounds)
+#define Xfit(n, nb, b) ((n) >= (b)[(nb)-1].low && (n) <= (b)[(nb)-1].high)
+
+/* Create a subrange type, but is it really a subrange? */
+p_type
+subrange_type(A, base_index, c1, c2, result_index)
+ int *base_index, *result_index;
+ long c1, c2;
+{
+ int itself = 0;
+ register p_type p;
+ p_type base_type;
+
+ if (!A) {
+ /* Subrange of itself is a special case ... */
+ if (result_index &&
+ result_index[0] == base_index[0] &&
+ result_index[1] == base_index[1]) {
+
+ /* c1 = 0 and c2 = 0 -> void */
+ if (c1 == 0 && c2 == 0) {
+ return void_type;
+ }
+
+ /* c1 = 0 and c2 = 127 -> char ??? */
+ if (c1 == 0 && c2 == 127) {
+ return char_type;
+ }
+ itself = 1;
+ }
+ }
+
+ if (itself) base_type = int_type; else base_type = *(tp_lookup(base_index));
+
+ if (! A) {
+ /* c2 = 0 and c1 > 0 -> real */
+ if (c2 == 0 && c1 > 0) {
+ if (c1 == float_size) return float_type;
+ return double_type;
+ }
+
+ /* c1 = 0 and base_index indicates int_type or itself -> unsigned,
+ c1 = -c2 - 1 and base_index indicates int_type or itself -> integer
+ */
+ if (itself || base_type == int_type) {
+ register struct integer_types *ip = 0;
+ if (c1 == 0) {
+ ip = &u_types[0];
+ }
+ else if (c1 == -c2 - 1) {
+ ip = &i_types[0];
+ }
+ if (ip) {
+ while (ip->maxval != 0 && ip->maxval != c2) ip++;
+ if (ip->maxval) return ip->type;
+ }
+ }
+ }
+ /* if we get here, it actually is a subrange type */
+ p = new_type();
+ p->ty_class = T_SUBRANGE;
+ p->ty_low = c1;
+ p->ty_up = c2;
+ p->ty_base = base_type;
+ p->ty_A = A;
+
+ /* determine size of subrange type */
+ p->ty_size = base_type->ty_size;
+ if (!A && p->ty_base == uint_type) {
+ if (ufit(p->ty_up, 1)) {
+ p->ty_size = 1;
+ }
+ else if (ufit(p->ty_up, (int)short_size)) {
+ p->ty_size = short_size;
+ }
+ }
+ if (!A && p->ty_base == int_type) {
+ if (ifit(p->ty_up, 1) && ifit(p->ty_low, 1)) {
+ p->ty_size = 1;
+ }
+ else if (ifit(p->ty_up, (int)short_size) &&
+ ifit(p->ty_low, (int)short_size)) {
+ p->ty_size = short_size;
+ }
+ }
+
+ return p;
+}
+
+static long
+nel(tp)
+ register p_type tp;
+{
+ switch(tp->ty_class) {
+ case T_SUBRANGE:
+ if (tp->ty_A) return 0;
+ if (tp->ty_low <= tp->ty_up) return tp->ty_up - tp->ty_low + 1;
+ return tp->ty_low - tp->ty_up + 1;
+ case T_UNSIGNED:
+ case T_INTEGER:
+ if (tp->ty_size == 1) return 256;
+ if (tp->ty_size == 2) return 65536L;
+ assert(0);
+ break;
+ case T_ENUM:
+ return tp->ty_nenums;
+ default:
+ assert(0);
+ break;
+ }
+ return 0;
+}
+
+p_type
+array_type(bound_type, el_type)
+ p_type bound_type, el_type;
+{
+ register p_type tp = new_type();
+
+ tp->ty_class = T_ARRAY;
+ tp->ty_index = bound_type;
+ tp->ty_elements = el_type;
+ tp->ty_size = (*currlang->arrayelsize)(el_type->ty_size) * nel(bound_type);
+ return tp;
+}
+
+p_type
+basic_type(fund, size)
+ int fund;
+ long size;
+{
+ register p_type p = new_type();
+
+ p->ty_class = fund;
+ p->ty_size = size;
+ return p;
+}
+
+set_bounds(tp)
+ register p_type tp;
+{
+ /* Determine the size and low of a set type */
+ register p_type base = tp->ty_setbase;
+
+ if (base->ty_class == T_SUBRANGE) {
+ tp->ty_size = (base->ty_up - base->ty_low + 7) >> 3;
+ tp->ty_setlow = base->ty_low;
+ }
+ else if (base->ty_class == T_INTEGER) {
+ tp->ty_size = (max_int[(int)base->ty_size] + 1) >> 2;
+ tp->ty_setlow = -max_int[(int)base->ty_size] - 1;
+ }
+ else {
+ assert(base->ty_class == T_UNSIGNED);
+ tp->ty_size = (max_uns[(int)base->ty_size] + 1) >> 3;
+ tp->ty_setlow = 0;
+ }
+}
+
+init_types()
+{
+ register int i = 0;
+ register long x = 0;
+
+ while (x >= 0) {
+ i++;
+ x = (x << 8) + 0377;
+ max_uns[i] = x;
+ max_int[i] = x & ~(1L << (8*i - 1));
+ }
+ int_type = basic_type(T_INTEGER, int_size);
+ long_type = basic_type(T_INTEGER, long_size);
+ short_type = basic_type(T_INTEGER, short_size);
+ char_type = basic_type(T_INTEGER, char_size);
+ uint_type = basic_type(T_UNSIGNED, int_size);
+ ulong_type = basic_type(T_UNSIGNED, long_size);
+ ushort_type = basic_type(T_UNSIGNED, short_size);
+ uchar_type = basic_type(T_UNSIGNED, char_size);
+ string_type = basic_type(T_STRING, 0L);
+ void_type = basic_type(T_VOID, 0L);
+ incomplete_type = basic_type(T_INCOMPLETE, 0L);
+ float_type = basic_type(T_REAL, float_size);
+ double_type = basic_type(T_REAL, double_size);
+
+ i_types[0].maxval = max_int[(int)int_size]; i_types[0].type = int_type;
+ i_types[1].maxval = max_int[(int)short_size]; i_types[1].type = short_type;
+ i_types[2].maxval = max_int[(int)long_size]; i_types[2].type = long_type;
+ u_types[0].maxval = max_uns[(int)int_size]; u_types[0].type = uint_type;
+ u_types[1].maxval = max_uns[(int)short_size]; u_types[1].type = ushort_type;
+ u_types[2].maxval = max_uns[(int)long_size]; u_types[2].type = ulong_type;
+ u_types[3].maxval = max_uns[1]; u_types[3].type = uchar_type;
+}
+
+/*
+ * Some code to handle type indices, which are pairs of integers.
+ * What we need is a two-dimensional array, but we don't know how large
+ * it is going to be, so we use a list of rows instead.
+ */
+static struct tp_index {
+ unsigned len;
+ p_type *row;
+} *list_row;
+static unsigned list_len;
+
+#define NINCR 10
+
+p_type *
+tp_lookup(type_index)
+ int *type_index;
+{
+ register int i;
+ register struct tp_index *p;
+
+ while (type_index[0] >= list_len) {
+ if (list_len) {
+ list_row = (struct tp_index *) Realloc((char *) list_row,
+ (list_len += NINCR) * sizeof(struct tp_index));
+ }
+ else list_row = (struct tp_index *)
+ Malloc((list_len = NINCR) * sizeof(struct tp_index));
+ for (i = NINCR; i > 0; i--) {
+ list_row[list_len - i].len = 0;
+ }
+ }
+ p = &list_row[type_index[0]];
+ while (type_index[1] >= p->len) {
+ if (p->len) {
+ p->row = (p_type *) Realloc((char *) p->row,
+ (p->len += NINCR) * sizeof(p_type));
+ }
+ else p->row = (p_type *) Malloc((p->len = NINCR) * sizeof(p_type));
+ for (i = NINCR; i > 0; i--) {
+ p->row[p->len - i] = 0;
+ }
+ }
+ return &(p->row[type_index[1]]);
+}
+
+clean_tp_tab()
+{
+ if (list_len) {
+ register int i = list_len;
+
+ while (--i >= 0) {
+ register int j = list_row[i].len;
+ if (j) {
+ while (--j > 0) {
+ p_type p = list_row[i].row[j];
+ if (p == incomplete_type) {
+ error("incomplete type (%d,%d) 0x%x", i, j, &list_row[i].row[j]);
+ }
+ }
+ free((char *) list_row[i].row);
+ }
+ }
+ free((char *) list_row);
+ list_len = 0;
+ list_row = 0;
+ }
+}
+
+end_literal(tp, maxval)
+ register p_type tp;
+ long maxval;
+{
+ tp->ty_literals = (struct literal *)
+ Realloc((char *) tp->ty_literals,
+ tp->ty_nenums * sizeof(struct literal));
+ if (ufit(maxval, 1)) tp->ty_size = 1;
+ else if (ufit(maxval, (int)short_size)) tp->ty_size = short_size;
+ else tp->ty_size = int_size;
+}
+
+long
+param_size(t, v)
+ int v;
+ p_type t;
+{
+ if (v == 'i' || v == 'v') {
+ /* addresss; only exception is a conformant array, which also
+ takes a descriptor.
+ */
+ if (t->ty_class == T_ARRAY &&
+ t->ty_index->ty_class == T_SUBRANGE &&
+ t->ty_index->ty_A) {
+ return pointer_size + 3 * int_size;
+ }
+ return pointer_size;
+ }
+ return ((t->ty_size + int_size - 1) / int_size) * int_size;
+}
+
+add_param_type(v, s)
+ int v; /* 'v' or 'i' for address, 'p' for value */
+ p_symbol s; /* parameter itself */
+{
+ register p_scope sc = base_scope(s->sy_scope);
+ register p_type prc_type;
+
+ if (! sc) return;
+ prc_type = sc->sc_definedby->sy_type;
+ assert(prc_type->ty_class == T_PROCEDURE);
+
+ prc_type->ty_nparams++;
+ prc_type->ty_params = (struct param *) Realloc((char *) prc_type->ty_params,
+ (unsigned)prc_type->ty_nparams * sizeof(struct param));
+ prc_type->ty_params[prc_type->ty_nparams - 1].par_type = s->sy_type;
+ prc_type->ty_params[prc_type->ty_nparams - 1].par_kind = v;
+ prc_type->ty_nbparams += param_size(s->sy_type, v);
+}
+
+/* Compute the size of a parameter of dynamic size
+*/
+
+long
+compute_size(tp, AB)
+ p_type tp;
+ char *AB;
+{
+ long low, high;
+
+ assert(tp->ty_class == T_ARRAY);
+ assert(tp->ty_index->ty_class == T_SUBRANGE);
+ assert(tp->ty_index->ty_A != 0);
+
+ if (tp->ty_index->ty_A & 1) {
+ low = BUFTOI(AB+tp->ty_index->ty_low);
+ } else low = tp->ty_index->ty_low;
+ if (tp->ty_index->ty_A & 2) {
+ high = BUFTOI(AB+tp->ty_index->ty_up);
+ } else high = tp->ty_index->ty_up;
+ return (high - low + 1) * tp->ty_elements->ty_size;
+}
--- /dev/null
+/* $Header$ */
+
+/* internal type representation */
+
+/* structure for struct/union elements */
+struct fields {
+ long fld_pos; /* position of field */
+ long fld_bitsize; /* size in bits */
+ struct type *fld_type; /* type of field */
+ char *fld_name; /* name of field */
+};
+
+/* structure for enumeration literals */
+struct literal {
+ long lit_val; /* value of literal */
+ char *lit_name; /* name of literal */
+};
+
+/* structure for parameters */
+struct param {
+ struct type *par_type; /* type of parameter */
+ char par_kind; /* kind of parameter ('p', 'i', or 'v') */
+};
+
+typedef struct type {
+ short ty_class;
+#define T_SUBRANGE 1
+#define T_ARRAY 2
+#define T_STRUCT 3
+#define T_UNION 4
+#define T_ENUM 5
+#define T_POINTER 6
+#define T_FILE 7
+#define T_PROCEDURE 8
+#define T_SET 9
+#define T_REAL 10
+#define T_INTEGER 11
+#define T_VOID 12
+#define T_UNSIGNED 13
+#define T_STRING 14 /* only for string constants ... */
+#define T_INCOMPLETE 100
+ short ty_flags;
+#define T_CROSS 0x0001
+ long ty_size;
+ union {
+ /* cross references */
+ char *typ_tag;
+#define ty_tag ty_v.typ_tag
+ /* procedures/functions: */
+ struct {
+ int typ_nparams;
+ struct type *typ_retval;
+ struct param *typ_params;
+ long typ_nbparams;
+ } ty_proc;
+#define ty_nparams ty_v.ty_proc.typ_nparams
+#define ty_retval ty_v.ty_proc.typ_retval
+#define ty_params ty_v.ty_proc.typ_params
+#define ty_nbparams ty_v.ty_proc.typ_nbparams
+ /* pointers, files: */
+ struct type *typ_ptrto;
+#define ty_ptrto ty_v.typ_ptrto
+#define ty_fileof ty_v.typ_ptrto
+ /* arrays: */
+ struct {
+ struct type *typ_index;
+ struct type *typ_elements;
+ } ty_array;
+#define ty_index ty_v.ty_array.typ_index
+#define ty_elements ty_v.ty_array.typ_elements
+ /* subranges: */
+ struct {
+ long typ_low, typ_up;
+ int typ_A;
+ struct type *typ_base;
+ } ty_subrange;
+#define ty_A ty_v.ty_subrange.typ_A
+#define ty_low ty_v.ty_subrange.typ_low
+#define ty_up ty_v.ty_subrange.typ_up
+#define ty_base ty_v.ty_subrange.typ_base
+ /* structures/unions: */
+ struct {
+ unsigned typ_nfields; /* number of field structures */
+ struct fields *typ_fields;
+ } ty_struct;
+#define ty_nfields ty_v.ty_struct.typ_nfields
+#define ty_fields ty_v.ty_struct.typ_fields
+ /* enumerations: */
+ struct {
+ unsigned typ_nenums; /* number of enumeration literals */
+ struct literal *typ_literals;
+ } ty_enum;
+#define ty_nenums ty_v.ty_enum.typ_nenums
+#define ty_literals ty_v.ty_enum.typ_literals
+ /* bit sets: */
+ struct {
+ struct type *typ_setbase; /* base type of set elements */
+ long typ_setlow; /* low bound */
+ } ty_set;
+#define ty_setbase ty_v.ty_set.typ_setbase
+#define ty_setlow ty_v.ty_set.typ_setlow
+ } ty_v;
+} t_type, *p_type;
+
+/* ALLOCDEF "type" 50 */
+
+extern p_type
+ subrange_type(),
+ array_type(),
+ *tp_lookup();
+extern long
+ param_size(),
+ compute_size();
+
+extern p_type char_type, uchar_type,
+ long_type, double_type, string_type;
+extern p_type void_type, incomplete_type;
+
--- /dev/null
+/* $Header$ */
+
+#include <alloc.h>
+
+#include "position.h"
+#include "scope.h"
+#include "symbol.h"
+#include "type.h"
+#include "message.h"
+
+int stack_offset; /* for up and down commands */
+
+extern long pointer_size;
+extern t_addr *get_EM_regs();
+
+/* Get the value of the symbol indicated by sym.
+ Return 0 on failure,
+ 1 on success.
+ On success, 'buf' contains the value, and 'AB' may contain the parameters
+ of the procedure invocation containing sym.
+ For both of these, storage is allocated by Malloc; this storage must
+ be freed by caller (I don't like this any more than you do, but caller
+ does not know sizes).
+*/
+int
+get_value(sym, buf, AB)
+ register p_symbol sym;
+ char **buf, **AB;
+{
+ p_type tp = sym->sy_type;
+ long size = tp->ty_size;
+ int retval = 0;
+ t_addr *EM_regs;
+ int i;
+ p_scope sc, symsc;
+
+ *buf = 0;
+ *AB = 0;
+ switch(sym->sy_class) {
+ case VAR:
+ /* exists if child exists; nm_value contains addres */
+ *buf = Malloc((unsigned) size);
+ if (get_bytes(size, (t_addr) sym->sy_name.nm_value, *buf)) {
+ retval = 1;
+ }
+ break;
+
+ case VARPAR:
+ case LOCVAR:
+ /* first find the stack frame in which it resides */
+ symsc = base_scope(sym->sy_scope);
+
+ /* now symsc contains the scope where the storage for sym is
+ allocated. Now find it on the stack of child.
+ */
+ i = stack_offset;
+ for (;;) {
+ sc = 0;
+ if (! (EM_regs = get_EM_regs(i++))) {
+ /* no child? */
+ break;
+ }
+ if (! EM_regs[AB_OFF]) {
+ /* no more frames */
+ break;
+ }
+ sc = base_scope(get_scope_from_addr(EM_regs[PC_OFF]));
+ if (! sc || sc->sc_start > EM_regs[PC_OFF]) {
+ sc = 0;
+ break;
+ }
+ if (sc == symsc) break; /* found it */
+ }
+
+ if (! sc) break; /* not found */
+
+ if (sym->sy_class == LOCVAR) {
+ /* Either local variable or value parameter */
+ *buf = Malloc((unsigned) size);
+ if (get_bytes(size,
+ EM_regs[sym->sy_name.nm_value < 0
+ ? LB_OFF
+ : AB_OFF
+ ] +
+ (t_addr) sym->sy_name.nm_value,
+ *buf)) {
+ retval = 1;
+ }
+ break;
+ }
+
+ /* If we get here, we have a var parameter. Get the parameters
+ of the current procedure invocation.
+ */
+ {
+ p_type proctype = sc->sc_definedby->sy_type;
+
+ size = proctype->ty_nbparams;
+ if (has_static_link(sc)) size += pointer_size;
+ *AB = Malloc((unsigned) size);
+ if (! get_bytes(size, EM_regs[AB_OFF], *AB)) {
+ break;
+ }
+ if ((size = tp->ty_size) == 0) {
+ size = compute_size(tp, *AB);
+ }
+ }
+ *buf = Malloc((unsigned) size);
+ if (get_bytes(size,
+ (t_addr) BUFTOA(*AB+sym->sy_name.nm_value),
+ *buf)) {
+ retval = 1;
+ }
+ break;
+ }
+
+ if (retval == 0) {
+ if (*buf) free(*buf);
+ if (*AB) free(*AB);
+ *buf = 0;
+ *AB = 0;
+ }
+
+ return retval;
+}
public / ack.git / commitdiff