Delete 689 undead files.
These files "magically reappeared" after the conversion from CVS to Mercurial. The old CVS repository deleted these files but did not record *when* it deleted these files. The conversion resurrected these files because they have no history of deletion. These files were probably deleted before year 1995. The CVS repository begins to record deletions around 1995. These files may still appear in older revisions of this Mercurial repository, when they should already be deleted. There is no way to fix this, because the CVS repository provides no dates of deletion. See http://sourceforge.net/mailarchive/message.php?msg_id=29823032
This commit is contained in:
George Koehler
@@ -1,127 +0,0 @@
|
||||
AMAKELIB = { . , /usr/local/lib/amake } ;
|
||||
|
||||
%include std-amake.amk ;
|
||||
%include ack-defs.amk ;
|
||||
%include cc_hh_tools.amk ;
|
||||
%include tok_tools.amk ;
|
||||
%include op_tools.amk ;
|
||||
%include char_tools.amk ;
|
||||
|
||||
%default grind ;
|
||||
|
||||
%declare tokenname.c [
|
||||
gen_tokens,
|
||||
cc-dest = symbol2str.c,
|
||||
LL-dest = tokenfile.g
|
||||
];
|
||||
|
||||
CMD_LLSRC = {
|
||||
tokenname.c,
|
||||
commands.g
|
||||
} ;
|
||||
|
||||
CSRC = {
|
||||
main.c,
|
||||
list.c,
|
||||
tree.c,
|
||||
expr.c,
|
||||
position.c,
|
||||
idf.c,
|
||||
run.c,
|
||||
symbol.c,
|
||||
print.c,
|
||||
type.c,
|
||||
rd.c,
|
||||
do_comm.c,
|
||||
modula-2.c,
|
||||
pascal.c,
|
||||
c.c
|
||||
} ;
|
||||
|
||||
HSRC = {
|
||||
tokenname.h,
|
||||
operator.h,
|
||||
class.h,
|
||||
position.h,
|
||||
idf.h,
|
||||
message.h,
|
||||
avl.h,
|
||||
scope.h,
|
||||
langdep.h,
|
||||
sizes.h,
|
||||
token.h,
|
||||
expr.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 = { -O, -DDEBUG } ;
|
||||
PROFFLAGS = { } ;
|
||||
|
||||
LDFLAGS = {
|
||||
-Bstatic,
|
||||
$PROFFLAGS,
|
||||
$DBFLAGS
|
||||
} ;
|
||||
|
||||
INCLUDES = {
|
||||
-I$EMHOME/modules/h,
|
||||
-I$EMHOME/modules/pkg,
|
||||
-I$EMHOME/h
|
||||
} ;
|
||||
|
||||
CFLAGS = {
|
||||
$INCLUDES,
|
||||
$PROFFLAGS,
|
||||
$DBFLAGS
|
||||
} ;
|
||||
|
||||
DBS_LLTARGETS = {
|
||||
db_symtab.c,
|
||||
DBSpars.c,
|
||||
DBSpars.h
|
||||
} ;
|
||||
|
||||
DBS_LLSRC = {
|
||||
db_symtab.g
|
||||
} ;
|
||||
|
||||
%cluster {
|
||||
%targets $DBS_LLTARGETS ;
|
||||
%sources $DBS_LLSRC ;
|
||||
%use LLgen(prefix => DBS) ;
|
||||
} ;
|
||||
|
||||
LINTFLAGS = {
|
||||
$INCLUDES
|
||||
} ;
|
||||
|
||||
%cluster {
|
||||
%targets lint.out[type = lint-output];
|
||||
%sources $CSRC + $CMD_LLSRC + $DBS_LLTARGETS + $HHSRC + char.ct + operators.ot ;
|
||||
%use lint(realdest => lint.out) ;
|
||||
} ;
|
||||
|
||||
%cluster {
|
||||
%targets grind[type = program];
|
||||
%sources $CSRC + $CMD_LLSRC + $DBS_LLTARGETS + $HHSRC + char.ct + operators.ot ;
|
||||
} ;
|
||||
@@ -1,39 +0,0 @@
|
||||
# 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'});
|
||||
};
|
||||
@@ -1,5 +0,0 @@
|
||||
# definition of EMHOME
|
||||
|
||||
%if (%not defined(EMHOME), {
|
||||
EMHOME = /usr/proj/em/Work;
|
||||
});
|
||||
@@ -1,43 +0,0 @@
|
||||
%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'});
|
||||
};
|
||||
@@ -1,24 +0,0 @@
|
||||
# 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'});
|
||||
};
|
||||
@@ -1,709 +0,0 @@
|
||||
/* $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), s)
|
||||
{ if (! s->sy_type->ty_sym) s->sy_type->ty_sym = s;
|
||||
if ((s->sy_type->ty_class == T_ENUM ||
|
||||
s->sy_type->ty_class == T_SUBRANGE) &&
|
||||
currnam->on_desc != 0) {
|
||||
s->sy_type->ty_size = currnam->on_desc;
|
||||
}
|
||||
}
|
||||
| /* tag name (only C?) */
|
||||
{ s = NewSymbol(str, CurrentScope, TAG, currnam); }
|
||||
'T' type_name(&(s->sy_type), s)
|
||||
{ if (! s->sy_type->ty_sym) s->sy_type->ty_sym = s;
|
||||
if (s->sy_type->ty_class != T_CROSS) {
|
||||
resolve_cross(s->sy_type);
|
||||
}
|
||||
}
|
||||
| /* end scope */
|
||||
'E' INTEGER
|
||||
{ close_scope(); }
|
||||
|
||||
| /* module begin */
|
||||
{ s = NewSymbol(str, CurrentScope, MODULE, currnam); }
|
||||
'M' INTEGER
|
||||
{ open_scope(s, 1);
|
||||
s->sy_name.nm_scope = CurrentScope;
|
||||
CurrentScope->sc_start = currnam->on_valu;
|
||||
CurrentScope->sc_proclevel = currnam->on_desc;
|
||||
add_scope_addr(CurrentScope);
|
||||
}
|
||||
|
||||
| /* external procedure */
|
||||
{ s = NewSymbol(str, FileScope, PROC, currnam); }
|
||||
'P' routine(s)
|
||||
|
||||
| /* private procedure */
|
||||
{ s = NewSymbol(str, CurrentScope, PROC, currnam); }
|
||||
'Q' routine(s)
|
||||
|
||||
| /* external function */
|
||||
{ s = NewSymbol(str, FileScope, FUNCTION, currnam); }
|
||||
'F' function(s)
|
||||
|
||||
| /* private function */
|
||||
{ s = NewSymbol(str, CurrentScope, FUNCTION, currnam); }
|
||||
'f' function(s)
|
||||
|
||||
| /* global variable, external */
|
||||
/* maybe we already know it; but we need
|
||||
the type information anyway for other
|
||||
types.
|
||||
*/
|
||||
{ s = Lookup(findidf(str), FileScope, VAR);
|
||||
if (s) {
|
||||
tmp = s->sy_type;
|
||||
s->sy_type = 0;
|
||||
} else s = NewSymbol(str, FileScope, VAR, currnam);
|
||||
}
|
||||
'G' type(&(s->sy_type), (int *) 0, s)
|
||||
{ if (tmp) s->sy_type = tmp; }
|
||||
|
||||
| /* static variable */
|
||||
{ s = NewSymbol(str, CurrentScope, VAR, currnam); }
|
||||
'S' type(&(s->sy_type), (int *) 0, s)
|
||||
|
||||
| /* static variable, local scope */
|
||||
{ s = NewSymbol(str, CurrentScope, VAR, currnam); }
|
||||
'V' type(&(s->sy_type), (int *) 0, s)
|
||||
|
||||
| /* register variable */
|
||||
{ s = NewSymbol(str, CurrentScope, REGVAR, currnam); }
|
||||
'r' type(&(s->sy_type), (int *) 0, s)
|
||||
|
||||
| /* value parameter */
|
||||
{ s = NewSymbol(str, CurrentScope, LOCVAR, currnam); }
|
||||
'p' type(&(s->sy_type), (int *) 0, s)
|
||||
{ add_param_type('p', s); }
|
||||
|
||||
| /* value parameter but address passed */
|
||||
{ s = NewSymbol(str, CurrentScope, VARPAR, currnam); }
|
||||
'i' type(&(s->sy_type), (int *) 0, s)
|
||||
{ add_param_type('i', s); }
|
||||
|
||||
| /* variable parameter */
|
||||
{ s = NewSymbol(str, CurrentScope, VARPAR, currnam); }
|
||||
'v' type(&(s->sy_type), (int *) 0, s)
|
||||
{ add_param_type('v', s); }
|
||||
|
||||
| /* local variable */
|
||||
{ s = NewSymbol(str, CurrentScope, LOCVAR, currnam); }
|
||||
type_name(&(s->sy_type), s)
|
||||
|
||||
| /* function result in Pascal; ignore ??? */
|
||||
{ s = NewSymbol(str, CurrentScope, LOCVAR, currnam); }
|
||||
'X' type_name(&(s->sy_type), s)
|
||||
]
|
||||
';'?
|
||||
;
|
||||
|
||||
name(char **s;)
|
||||
:
|
||||
/* anything up to a ':' */
|
||||
NAME { *s = strval; }
|
||||
;
|
||||
|
||||
const_name(p_symbol cst;)
|
||||
{ int type_index[2];
|
||||
long iconst;
|
||||
register char *p;
|
||||
}
|
||||
:
|
||||
'='
|
||||
[
|
||||
/*
|
||||
'b' integer_const(&(cst->sy_const.co_ival)) /* boolean */
|
||||
/* |
|
||||
*/
|
||||
'c' integer_const(&(cst->sy_const.co_ival)) /* character */
|
||||
{ cst->sy_type = char_type; }
|
||||
|
|
||||
'i' integer_const(&(cst->sy_const.co_ival)) /* integer */
|
||||
{ cst->sy_type = long_type; }
|
||||
|
|
||||
'r' real_const(&(cst->sy_const.co_rval)) /* real */
|
||||
{ cst->sy_type = double_type; }
|
||||
|
|
||||
's' string_const /* string */
|
||||
{ cst->sy_const.co_sval = string_val(strval);
|
||||
cst->sy_type = string_type;
|
||||
}
|
||||
|
|
||||
'e' type_index(type_index) ',' integer_const(&(cst->sy_const.co_ival))
|
||||
/* enumeration constant;
|
||||
* enumeration type, value
|
||||
*/
|
||||
{ cst->sy_type = *tp_lookup(type_index); }
|
||||
|
||||
|
|
||||
'S' type_index(type_index)
|
||||
{ cst->sy_type = *tp_lookup(type_index);
|
||||
cst->sy_const.co_setval = p =
|
||||
Malloc((unsigned) cst->sy_type->ty_size);
|
||||
}
|
||||
[ ',' integer_const(&iconst)
|
||||
{ *p++ = iconst; }
|
||||
]+
|
||||
/* set constant:
|
||||
* settype, values of the bytes
|
||||
* in the set.
|
||||
*/
|
||||
]
|
||||
;
|
||||
|
||||
integer_const(long *iconst;)
|
||||
{ int sign = 0; }
|
||||
:
|
||||
[ '+' | '-' { sign = 1; } ]?
|
||||
INTEGER { *iconst = sign ? -ival : ival; }
|
||||
;
|
||||
|
||||
real_const(double *f;)
|
||||
{ int sign = 0; }
|
||||
:
|
||||
[ '+' | '-' { sign = 1; } ]?
|
||||
REAL { *f = sign ? fval : -fval; }
|
||||
;
|
||||
|
||||
string_const
|
||||
:
|
||||
STRING /* has SINGLE quotes! */
|
||||
;
|
||||
|
||||
type_name(p_type *t; p_symbol sy;)
|
||||
{ int type_index[2]; p_type *p; }
|
||||
:
|
||||
type_index(type_index) { p = tp_lookup(type_index); }
|
||||
[
|
||||
{ if (*p && (*p)->ty_class != 0 &&
|
||||
(*p)->ty_class != T_CROSS) {
|
||||
error("Redefining (%d,%d) %d",
|
||||
type_index[0],
|
||||
type_index[1],
|
||||
(*p)->ty_class);
|
||||
}
|
||||
}
|
||||
'='
|
||||
type(p, type_index, sy)
|
||||
|
|
||||
]
|
||||
{ if (*p == 0) *p = new_type();
|
||||
*t = *p;
|
||||
}
|
||||
;
|
||||
|
||||
type_index(int *type_index;)
|
||||
:
|
||||
[
|
||||
INTEGER { type_index[0] = 0; type_index[1] = ival; }
|
||||
|
|
||||
'(' INTEGER { type_index[0] = ival; }
|
||||
',' INTEGER { type_index[1] = ival; }
|
||||
')'
|
||||
]
|
||||
{ last_index[0] = type_index[0];
|
||||
last_index[1] = type_index[1];
|
||||
}
|
||||
;
|
||||
|
||||
function(p_symbol p;)
|
||||
:
|
||||
{ p->sy_type = new_type();
|
||||
p->sy_type->ty_class = T_PROCEDURE;
|
||||
p->sy_type->ty_size = pointer_size;
|
||||
}
|
||||
type(&(p->sy_type->ty_retval), (int *) 0, (p_symbol) 0)
|
||||
{ if (CurrentScope != FileScope &&
|
||||
saw_code) {
|
||||
/* if saw_code is not set, it is a nested
|
||||
procedure
|
||||
*/
|
||||
close_scope();
|
||||
}
|
||||
saw_code = 0;
|
||||
open_scope(p, 1);
|
||||
p->sy_name.nm_scope = CurrentScope;
|
||||
CurrentScope->sc_start = currnam->on_valu;
|
||||
add_scope_addr(CurrentScope);
|
||||
CurrentScope->sc_proclevel = currnam->on_desc;
|
||||
}
|
||||
;
|
||||
|
||||
routine(p_symbol p;)
|
||||
:
|
||||
{ p->sy_type = new_type();
|
||||
p->sy_type->ty_class = T_PROCEDURE;
|
||||
p->sy_type->ty_size = pointer_size;
|
||||
if (CurrentScope != FileScope &&
|
||||
saw_code) {
|
||||
/* if saw_code is not set, it is a nested
|
||||
procedure
|
||||
*/
|
||||
close_scope();
|
||||
}
|
||||
saw_code = 0;
|
||||
open_scope(p, 1);
|
||||
p->sy_name.nm_scope = CurrentScope;
|
||||
CurrentScope->sc_start = currnam->on_valu;
|
||||
add_scope_addr(CurrentScope);
|
||||
CurrentScope->sc_proclevel = currnam->on_desc;
|
||||
}
|
||||
INTEGER ';'
|
||||
type(&(p->sy_type->ty_retval), (int *) 0, (p_symbol) 0)
|
||||
;
|
||||
|
||||
type(p_type *ptp; int *type_index; p_symbol sy;)
|
||||
{ register p_type tp = *ptp ? *ptp : new_type();
|
||||
p_type t1 = 0, t2 = 0;
|
||||
long ic1, ic2;
|
||||
int A_used = 0;
|
||||
int tclass;
|
||||
int tp_index[2];
|
||||
char *str;
|
||||
}
|
||||
:
|
||||
[
|
||||
/* type cross reference */
|
||||
/* these are used in C for references to a struct, union or
|
||||
* enum that has not been declared (yet)
|
||||
*/
|
||||
'x'
|
||||
[ 's' /* struct */
|
||||
{ tclass = T_STRUCT; }
|
||||
| 'u' /* union */
|
||||
{ tclass = T_UNION; }
|
||||
| 'e' /* enum */
|
||||
{ tclass = T_ENUM; }
|
||||
]
|
||||
{ AllowName = 1; }
|
||||
name(&str)
|
||||
{ sy = Lookfromscope(str2idf(str,0),TAG,CurrentScope);
|
||||
if (sy &&
|
||||
(sy->sy_type->ty_class == tclass ||
|
||||
sy->sy_type->ty_class == T_CROSS)) {
|
||||
if (tp != *ptp) free_type(tp);
|
||||
tp = sy->sy_type;
|
||||
}
|
||||
else {
|
||||
tp->ty_class = T_CROSS;
|
||||
tp->ty_size = tclass;
|
||||
sy = NewSymbol(str, CurrentScope, TAG, (struct outname *) 0);
|
||||
sy->sy_type = tp;
|
||||
}
|
||||
}
|
||||
|
|
||||
/* subrange */
|
||||
/* the integer_const's represent the lower and the upper bound.
|
||||
* A subrange type defined as subrange of itself is an integer type.
|
||||
* If the second integer_const == 0, but the first is not, we
|
||||
* have a floating point type with size equal to the first
|
||||
* integer_const.
|
||||
* Upperbound -1 means unsigned int or unsigned long.
|
||||
*/
|
||||
'r' type_index(tp_index) ';'
|
||||
[ 'A' integer_const(&ic1) { A_used = 1; }
|
||||
| integer_const(&ic1)
|
||||
]
|
||||
';'
|
||||
[ 'A' integer_const(&ic2) { A_used |= 2; }
|
||||
| integer_const(&ic2)
|
||||
]
|
||||
{ if (tp != *ptp) free_type(tp);
|
||||
tp = subrange_type(A_used,
|
||||
tp_index,
|
||||
ic1,
|
||||
ic2,
|
||||
type_index);
|
||||
}
|
||||
|
|
||||
/* array; first type is bound type, next type
|
||||
* is element type
|
||||
*/
|
||||
'a' type(&t1, (int *) 0, (p_symbol) 0) ';' type(&t2, (int *) 0, (p_symbol) 0)
|
||||
{ if (tp != *ptp) free_type(tp);
|
||||
tp = array_type(t1, t2);
|
||||
}
|
||||
|
|
||||
/* structure type */
|
||||
's' { tp->ty_class = T_STRUCT; }
|
||||
structure_type(tp, sy)
|
||||
|
|
||||
/* union type */
|
||||
'u' { tp->ty_class = T_UNION; }
|
||||
structure_type(tp, sy)
|
||||
|
|
||||
/* enumeration type */
|
||||
'e' { tp->ty_class = T_ENUM; }
|
||||
enum_type(tp)
|
||||
|
|
||||
/* pointer type */
|
||||
'*' { tp->ty_class = T_POINTER;
|
||||
tp->ty_size = pointer_size;
|
||||
}
|
||||
type(&(tp->ty_ptrto), (int *) 0, (p_symbol) 0)
|
||||
|
|
||||
/* function type */
|
||||
'f' { tp->ty_class = T_PROCEDURE;
|
||||
tp->ty_size = pointer_size;
|
||||
}
|
||||
type(&(tp->ty_retval), (int *) 0, (p_symbol) 0)
|
||||
/*
|
||||
[ %prefer
|
||||
',' param_list(tp)
|
||||
|
|
||||
]
|
||||
*/
|
||||
|
|
||||
/* procedure type */
|
||||
'Q' { tp->ty_class = T_PROCEDURE;
|
||||
tp->ty_size = pointer_size;
|
||||
}
|
||||
type(&(tp->ty_retval), (int *) 0, (p_symbol) 0)
|
||||
',' param_list(tp)
|
||||
|
|
||||
/* another procedure type */
|
||||
'p' { tp->ty_class = T_PROCEDURE;
|
||||
tp->ty_size = pointer_size;
|
||||
tp->ty_retval = void_type;
|
||||
}
|
||||
param_list(tp)
|
||||
|
|
||||
/* set type */
|
||||
/* the first integer_const represents the size in bytes,
|
||||
* the second one represents the low bound
|
||||
*/
|
||||
'S' { tp->ty_class = T_SET; }
|
||||
type(&(tp->ty_setbase), (int *) 0, (p_symbol) 0) ';'
|
||||
[
|
||||
integer_const(&(tp->ty_size)) ';'
|
||||
integer_const(&(tp->ty_setlow)) ';'
|
||||
|
|
||||
{ set_bounds(tp); }
|
||||
]
|
||||
|
|
||||
/* file type of Pascal */
|
||||
'L' { tp->ty_class = T_FILE; }
|
||||
type(&(tp->ty_fileof), (int *) 0, (p_symbol) 0)
|
||||
|
|
||||
type_name(ptp, (p_symbol) 0)
|
||||
{ if (type_index &&
|
||||
(*ptp)->ty_class == 0 &&
|
||||
type_index[0] == last_index[0] &&
|
||||
type_index[1] == last_index[1]) {
|
||||
**ptp = *void_type;
|
||||
if (*ptp != tp) free_type(tp);
|
||||
}
|
||||
tp = *ptp;
|
||||
}
|
||||
]
|
||||
{ if (*ptp && *ptp != tp) **ptp = *tp;
|
||||
else *ptp = tp;
|
||||
}
|
||||
;
|
||||
|
||||
structure_type(register p_type tp; p_symbol sy;)
|
||||
{ register struct fields *fldp;
|
||||
char *str;
|
||||
}
|
||||
:
|
||||
integer_const(&(tp->ty_size)) /* size in bytes */
|
||||
{ open_scope(sy, 0);
|
||||
if (sy) sy->sy_name.nm_scope = CurrentScope;
|
||||
}
|
||||
[
|
||||
name(&str) { fldp = get_field_space(tp, str); }
|
||||
type(&(fldp->fld_type), (int *) 0, (p_symbol) 0) ','
|
||||
integer_const(&(fldp->fld_pos)) ',' /* offset in bits */
|
||||
integer_const(&(fldp->fld_bitsize)) ';' /* size in bits */
|
||||
]*
|
||||
';' { end_field(tp);
|
||||
close_scope();
|
||||
}
|
||||
;
|
||||
|
||||
enum_type(register p_type tp;)
|
||||
{ register struct literal *litp;
|
||||
long maxval = 0;
|
||||
register p_symbol s;
|
||||
}
|
||||
:
|
||||
[ { litp = get_literal_space(tp); }
|
||||
name(&(litp->lit_name))
|
||||
integer_const(&(litp->lit_val)) ','
|
||||
{ if (maxval < litp->lit_val) maxval = litp->lit_val;
|
||||
AllowName = 1;
|
||||
s = NewSymbol(litp->lit_name, CurrentScope, CONST, (struct outname *) 0);
|
||||
s->sy_const.co_ival = litp->lit_val;
|
||||
s->sy_type = tp;
|
||||
}
|
||||
]*
|
||||
';' { end_literal(tp, maxval); }
|
||||
;
|
||||
|
||||
param_list(p_type t;)
|
||||
{ register struct param *p;
|
||||
long iconst;
|
||||
}
|
||||
:
|
||||
integer_const(&iconst) ';' /* number of parameters */
|
||||
{ t->ty_nparams = iconst;
|
||||
t->ty_params = p = (struct param *)
|
||||
Malloc((unsigned)(t->ty_nparams * sizeof(struct param)));
|
||||
}
|
||||
[
|
||||
[ 'p' { p->par_kind = 'p'; }
|
||||
| 'v' { p->par_kind = 'v'; }
|
||||
| 'i' { p->par_kind = 'i'; }
|
||||
]
|
||||
type(&(p->par_type), (int *) 0, (p_symbol) 0) ';'
|
||||
{ t->ty_nbparams +=
|
||||
param_size(p->par_type, p->par_kind);
|
||||
p++;
|
||||
}
|
||||
]*
|
||||
;
|
||||
|
||||
{
|
||||
static char *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, s)
|
||||
register p_type tp;
|
||||
char *s;
|
||||
{
|
||||
register struct fields *p;
|
||||
p_symbol sy;
|
||||
|
||||
if (! (tp->ty_nfields & 07)) {
|
||||
tp->ty_fields = (struct fields *)
|
||||
Realloc((char *) tp->ty_fields,
|
||||
(tp->ty_nfields+8)*sizeof(struct fields));
|
||||
}
|
||||
p = &tp->ty_fields[tp->ty_nfields++];
|
||||
p->fld_name = s;
|
||||
p->fld_type = 0;
|
||||
sy = NewSymbol(s, CurrentScope, FIELD, currnam);
|
||||
sy->sy_field = p;
|
||||
return p;
|
||||
}
|
||||
|
||||
static
|
||||
end_field(tp)
|
||||
register p_type tp;
|
||||
{
|
||||
tp->ty_fields = (struct fields *)
|
||||
Realloc((char *) tp->ty_fields,
|
||||
tp->ty_nfields * sizeof(struct fields));
|
||||
}
|
||||
|
||||
static struct literal *
|
||||
get_literal_space(tp)
|
||||
register p_type tp;
|
||||
{
|
||||
if (! (tp->ty_nenums & 07)) {
|
||||
tp->ty_literals = (struct literal *)
|
||||
Realloc((char *) tp->ty_literals,
|
||||
(tp->ty_nenums+8)*sizeof(struct literal));
|
||||
}
|
||||
return &tp->ty_literals[tp->ty_nenums++];
|
||||
}
|
||||
|
||||
static char *
|
||||
string_val(s)
|
||||
char *s;
|
||||
{
|
||||
register char *ns = s, *os = s;
|
||||
register unsigned int i = 1;
|
||||
|
||||
for (;;) {
|
||||
if (!*os) break;
|
||||
i++;
|
||||
if (*os == '\\') {
|
||||
os++;
|
||||
*ns++ = *os++;
|
||||
}
|
||||
else *ns++ = *os++;
|
||||
}
|
||||
*ns = '\0';
|
||||
return Salloc(s, i);
|
||||
}
|
||||
|
||||
}
|
||||
@@ -1,194 +0,0 @@
|
||||
/* $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 *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: could not open", f);
|
||||
}
|
||||
rd_ohead(&h);
|
||||
if (BADMAGIC(h) && h.oh_magic != O_CONVERTED) {
|
||||
fatal("%s: not an object file", f);
|
||||
}
|
||||
|
||||
/* Allocate space for name table and read it */
|
||||
AckNames = (struct outname *)
|
||||
Malloc((unsigned)(sizeof(struct outname) * h.oh_nname));
|
||||
AckStrings = Malloc((unsigned) h.oh_nchar);
|
||||
rd_name(AckNames, h.oh_nname);
|
||||
rd_string(AckStrings, h.oh_nchar);
|
||||
|
||||
/* Adjust file offsets in name table to point at strings */
|
||||
OffsetStrings = OFF_CHAR(h);
|
||||
NAckNames = h.oh_nname;
|
||||
EndAckNames = &AckNames[h.oh_nname];
|
||||
for (n = EndAckNames; --n >= AckNames;) {
|
||||
if (n->on_foff) {
|
||||
if ((unsigned)(n->on_foff - OffsetStrings) >= h.oh_nchar) {
|
||||
fatal("%s: error in object file", f);
|
||||
}
|
||||
n->on_mptr = AckStrings + (n->on_foff - OffsetStrings);
|
||||
}
|
||||
else n->on_mptr = 0;
|
||||
}
|
||||
|
||||
/* Offer strings to the DBX string parser if they contain a ':'.
|
||||
Also offer filename-line number information to add_position_addr().
|
||||
Here, the order may be important.
|
||||
*/
|
||||
for (n = &AckNames[0]; n < EndAckNames; n++) {
|
||||
int tp = n->on_type >> 8;
|
||||
register p_symbol sym;
|
||||
|
||||
if (tp & (S_STB >> 8)) {
|
||||
switch(tp) {
|
||||
#ifdef N_BINCL
|
||||
case N_BINCL:
|
||||
n->on_valu = (long) line_file;
|
||||
line_file = n;
|
||||
break;
|
||||
case N_EINCL:
|
||||
if (line_file) {
|
||||
line_file = (struct outname *) line_file->on_valu;
|
||||
}
|
||||
break;
|
||||
#endif
|
||||
case N_SO:
|
||||
if (n->on_mptr[strlen(n->on_mptr)-1] == '/') {
|
||||
/* another N_SO follows ... */
|
||||
break;
|
||||
}
|
||||
while (CurrentScope != PervasiveScope) {
|
||||
close_scope();
|
||||
}
|
||||
saw_code = 0;
|
||||
sym = add_file(n->on_mptr);
|
||||
|
||||
if (! listfile) newfile(sym->sy_idf);
|
||||
open_scope(sym, 0);
|
||||
sym->sy_file->f_scope = CurrentScope;
|
||||
FileScope = CurrentScope;
|
||||
clean_tp_tab();
|
||||
/* fall through */
|
||||
case N_SOL:
|
||||
if (! line_file) line_file = n;
|
||||
else line_file->on_mptr = n->on_mptr;
|
||||
break;
|
||||
case N_MAIN:
|
||||
newfile(FileScope->sc_definedby->sy_idf);
|
||||
break;
|
||||
case N_SLINE:
|
||||
assert(line_file);
|
||||
if (! saw_code && !CurrentScope->sc_bp_opp) {
|
||||
CurrentScope->sc_bp_opp = n->on_valu;
|
||||
if (! CurrentScope->sc_start) {
|
||||
CurrentScope->sc_start = n->on_valu;
|
||||
if (CurrentScope->sc_has_activation_record) {
|
||||
add_scope_addr(CurrentScope);
|
||||
}
|
||||
}
|
||||
}
|
||||
saw_code = 1;
|
||||
add_position_addr(line_file->on_mptr, n);
|
||||
break;
|
||||
case N_LBRAC: /* block, desc = nesting level */
|
||||
if (had_lbrac) {
|
||||
open_scope((p_symbol) 0, 0);
|
||||
saw_code = 0;
|
||||
}
|
||||
else {
|
||||
register p_scope sc =
|
||||
get_scope_from_addr(n->on_valu);
|
||||
|
||||
if (!sc || sc->sc_bp_opp) {
|
||||
had_lbrac = 1;
|
||||
}
|
||||
else CurrentScope = sc;
|
||||
}
|
||||
break;
|
||||
#ifdef N_SCOPE
|
||||
case N_SCOPE:
|
||||
if (n->on_mptr && strindex(n->on_mptr, ':')) {
|
||||
n = 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);
|
||||
clean_tp_tab();
|
||||
rd_close();
|
||||
return (h.oh_magic == O_CONVERTED);
|
||||
}
|
||||
@@ -1,341 +0,0 @@
|
||||
/* $Header$ */
|
||||
|
||||
/* Language dependant support; this one is default */
|
||||
|
||||
#include <stdio.h>
|
||||
#include <alloc.h>
|
||||
|
||||
#include "position.h"
|
||||
#include "class.h"
|
||||
#include "langdep.h"
|
||||
#include "Lpars.h"
|
||||
#include "idf.h"
|
||||
#include "token.h"
|
||||
#include "expr.h"
|
||||
#include "tree.h"
|
||||
#include "operator.h"
|
||||
|
||||
extern FILE *db_out, *db_in;
|
||||
|
||||
extern int
|
||||
get_name();
|
||||
|
||||
extern double
|
||||
atof();
|
||||
|
||||
static int
|
||||
print_string(),
|
||||
get_number(),
|
||||
get_string(),
|
||||
get_token(),
|
||||
print_op(),
|
||||
op_prio();
|
||||
|
||||
static long
|
||||
array_elsize();
|
||||
|
||||
static struct langdep def = {
|
||||
0,
|
||||
|
||||
"%ld",
|
||||
"0%lo",
|
||||
"0x%lX",
|
||||
"%lu",
|
||||
"0x%lX",
|
||||
"%g",
|
||||
"'\\%o'",
|
||||
|
||||
"[",
|
||||
"]",
|
||||
"(",
|
||||
")",
|
||||
"{",
|
||||
"}",
|
||||
|
||||
print_string,
|
||||
array_elsize,
|
||||
op_prio,
|
||||
get_string,
|
||||
get_name,
|
||||
get_number,
|
||||
get_token,
|
||||
print_op
|
||||
};
|
||||
|
||||
struct langdep *def_dep = &def;
|
||||
|
||||
static int
|
||||
print_string(s, len)
|
||||
char *s;
|
||||
int len;
|
||||
{
|
||||
register char *str = s;
|
||||
int delim = '\'';
|
||||
|
||||
while (*str) {
|
||||
if (*str++ == '\'') delim = '"';
|
||||
}
|
||||
fprintf(db_out, "%c%.*s%c", delim, len, 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;
|
||||
}
|
||||
|
||||
/*ARGSUSED*/
|
||||
static int
|
||||
op_prio(op)
|
||||
int op;
|
||||
{
|
||||
return 1;
|
||||
}
|
||||
|
||||
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;
|
||||
}
|
||||
|
||||
static 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");
|
||||
}
|
||||
tok.fval = atof(buf);
|
||||
return REAL;
|
||||
}
|
||||
|
||||
static int
|
||||
get_token(c)
|
||||
register int c;
|
||||
{
|
||||
switch(c) {
|
||||
case '`':
|
||||
case ':':
|
||||
case ',':
|
||||
return c;
|
||||
case '.':
|
||||
return get_number(c);
|
||||
default:
|
||||
error("illegal character 0%o", c);
|
||||
return LLlex();
|
||||
}
|
||||
}
|
||||
|
||||
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;
|
||||
|
||||
}
|
||||
|
||||
static 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
|
||||
print_op(p)
|
||||
p_tree p;
|
||||
{
|
||||
switch(p->t_oper) {
|
||||
case OP_UNOP:
|
||||
switch(p->t_whichoper) {
|
||||
case E_MIN:
|
||||
fputs("-", db_out);
|
||||
print_node(p->t_args[0], 0);
|
||||
break;
|
||||
case E_PLUS:
|
||||
fputs("+", db_out);
|
||||
print_node(p->t_args[0], 0);
|
||||
break;
|
||||
case E_NOT:
|
||||
fputs("~", db_out);
|
||||
print_node(p->t_args[0], 0);
|
||||
break;
|
||||
case E_DEREF:
|
||||
fputs("*", db_out);
|
||||
print_node(p->t_args[0], 0);
|
||||
break;
|
||||
}
|
||||
break;
|
||||
case OP_BINOP:
|
||||
fputs("(", db_out);
|
||||
print_node(p->t_args[0], 0);
|
||||
switch(p->t_whichoper) {
|
||||
case E_AND:
|
||||
fputs("&&", db_out);
|
||||
break;
|
||||
case E_OR:
|
||||
fputs("||", db_out);
|
||||
break;
|
||||
case E_ZDIV:
|
||||
fputs("/", db_out);
|
||||
break;
|
||||
case E_ZMOD:
|
||||
fputs("%", db_out);
|
||||
break;
|
||||
case E_DIV:
|
||||
fputs(" div ", db_out);
|
||||
break;
|
||||
case E_MOD:
|
||||
fputs(" mod ", db_out);
|
||||
break;
|
||||
case E_IN:
|
||||
fputs(" in ", db_out);
|
||||
break;
|
||||
case E_PLUS:
|
||||
fputs("+", db_out);
|
||||
break;
|
||||
case E_MIN:
|
||||
fputs("-", db_out);
|
||||
break;
|
||||
case E_MUL:
|
||||
fputs("*", db_out);
|
||||
break;
|
||||
case E_EQUAL:
|
||||
fputs("==", db_out);
|
||||
break;
|
||||
case E_NOTEQUAL:
|
||||
fputs("!=", db_out);
|
||||
break;
|
||||
case E_LTEQUAL:
|
||||
fputs("<=", db_out);
|
||||
break;
|
||||
case E_GTEQUAL:
|
||||
fputs(">=", db_out);
|
||||
break;
|
||||
case E_LT:
|
||||
fputs("<", db_out);
|
||||
break;
|
||||
case E_GT:
|
||||
fputs(">", db_out);
|
||||
break;
|
||||
case E_SELECT:
|
||||
fputs(".", db_out);
|
||||
break;
|
||||
}
|
||||
print_node(p->t_args[1], 0);
|
||||
fputs(")", db_out);
|
||||
break;
|
||||
}
|
||||
}
|
||||
@@ -1,88 +0,0 @@
|
||||
/* $Header$ */
|
||||
|
||||
#include <assert.h>
|
||||
#include <alloc.h>
|
||||
|
||||
#include "operator.h"
|
||||
#include "position.h"
|
||||
#include "tree.h"
|
||||
#include "message.h"
|
||||
#include "type.h"
|
||||
#include "expr.h"
|
||||
|
||||
extern long pointer_size;
|
||||
extern p_tree get_from_item_list();
|
||||
|
||||
struct dump {
|
||||
char *globals, *stack;
|
||||
struct message_hdr mglobal, mstack;
|
||||
struct dump *next;
|
||||
};
|
||||
|
||||
static struct dump *last_dump;
|
||||
|
||||
/* dumping and restoring of child process.
|
||||
*/
|
||||
do_dump(p)
|
||||
p_tree p;
|
||||
{
|
||||
struct dump *d = (struct dump *) malloc(sizeof(struct dump));
|
||||
|
||||
if (! d) {
|
||||
error("could not allocate enough memory");
|
||||
return;
|
||||
}
|
||||
if (! get_dump(&d->mglobal, &d->globals, &d->mstack, &d->stack)) {
|
||||
free((char *) d);
|
||||
return;
|
||||
}
|
||||
p->t_args[0] = (struct tree *) d;
|
||||
p->t_address = (t_addr) get_int(d->mglobal.m_buf+PC_OFF*pointer_size, pointer_size, T_UNSIGNED);
|
||||
add_to_item_list(p);
|
||||
d->next = last_dump;
|
||||
last_dump = d;
|
||||
}
|
||||
|
||||
/* dumping and restoring of child process.
|
||||
*/
|
||||
do_restore(p)
|
||||
p_tree p;
|
||||
{
|
||||
struct dump *d;
|
||||
|
||||
if (p->t_args[0]) {
|
||||
p = get_from_item_list((int) p->t_args[0]->t_ival);
|
||||
if (!p || p->t_oper != OP_DUMP) {
|
||||
error("no such dump");
|
||||
return;
|
||||
}
|
||||
d = (struct dump *) p->t_args[0];
|
||||
}
|
||||
else d = last_dump;
|
||||
|
||||
if (! d) {
|
||||
error("no dumps");
|
||||
return;
|
||||
}
|
||||
|
||||
if (! put_dump(&d->mglobal, d->globals, &d->mstack, d->stack)) {
|
||||
}
|
||||
do_items();
|
||||
}
|
||||
|
||||
free_dump(p)
|
||||
p_tree p;
|
||||
{
|
||||
struct dump *d = (struct dump *) p->t_args[0];
|
||||
|
||||
free(d->globals);
|
||||
free(d->stack);
|
||||
if (d == last_dump) last_dump = d->next;
|
||||
else {
|
||||
register struct dump *d1 = last_dump;
|
||||
|
||||
while (d1->next != d) d1 = d1->next;
|
||||
d1->next = d->next;
|
||||
}
|
||||
free((char *) d);
|
||||
}
|
||||
@@ -1,14 +0,0 @@
|
||||
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'});
|
||||
};
|
||||
@@ -1,10 +0,0 @@
|
||||
/* $Header$ */
|
||||
|
||||
/* 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
|
||||
@@ -1,15 +0,0 @@
|
||||
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] => 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'});
|
||||
};
|
||||
@@ -1,182 +0,0 @@
|
||||
/* $Header$ */
|
||||
|
||||
#include <alloc.h>
|
||||
#include <assert.h>
|
||||
|
||||
#include "position.h"
|
||||
#include "scope.h"
|
||||
#include "idf.h"
|
||||
#include "symbol.h"
|
||||
#include "type.h"
|
||||
#include "message.h"
|
||||
#include "langdep.h"
|
||||
#include "expr.h"
|
||||
|
||||
int stack_offset; /* for up and down commands */
|
||||
|
||||
extern long pointer_size;
|
||||
extern t_addr *get_EM_regs();
|
||||
extern char *memcpy();
|
||||
|
||||
/* Get the address of the object indicated by sym.
|
||||
Return 0 on failure,
|
||||
address on success.
|
||||
*psize will contain size of object.
|
||||
*/
|
||||
t_addr
|
||||
get_addr(sym, psize)
|
||||
register p_symbol sym;
|
||||
long *psize;
|
||||
{
|
||||
p_type tp = sym->sy_type;
|
||||
long size = tp->ty_size;
|
||||
t_addr *EM_regs;
|
||||
int i;
|
||||
p_scope sc, symsc;
|
||||
|
||||
*psize = size;
|
||||
switch(sym->sy_class) {
|
||||
case VAR:
|
||||
/* exists if child exists; nm_value contains addres */
|
||||
return (t_addr) sym->sy_name.nm_value;
|
||||
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++))) {
|
||||
return 0;
|
||||
}
|
||||
if (! EM_regs[1]) {
|
||||
error("%s not available", sym->sy_idf->id_text);
|
||||
return 0;
|
||||
}
|
||||
sc = base_scope(get_scope_from_addr(EM_regs[2]));
|
||||
if (! sc || sc->sc_start > EM_regs[2]) {
|
||||
error("%s not available", sym->sy_idf->id_text);
|
||||
sc = 0;
|
||||
return 0;
|
||||
}
|
||||
if (sc == symsc) break; /* found it */
|
||||
}
|
||||
|
||||
if (sym->sy_class == LOCVAR) {
|
||||
/* Either local variable or value parameter */
|
||||
return EM_regs[sym->sy_name.nm_value < 0 ? 0 : 1] +
|
||||
(t_addr) sym->sy_name.nm_value;
|
||||
}
|
||||
|
||||
/* 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;
|
||||
t_addr a;
|
||||
char *AB;
|
||||
|
||||
size = proctype->ty_nbparams;
|
||||
if (has_static_link(sc)) size += pointer_size;
|
||||
AB = malloc((unsigned) size);
|
||||
if (! AB) {
|
||||
error("could not allocate enough memory");
|
||||
break;
|
||||
}
|
||||
if (! get_bytes(size, EM_regs[1], AB)) {
|
||||
break;
|
||||
}
|
||||
if ((size = tp->ty_size) == 0) {
|
||||
size = compute_size(tp, AB);
|
||||
*psize = size;
|
||||
}
|
||||
a = (t_addr) get_int(AB+sym->sy_name.nm_value, pointer_size, T_UNSIGNED);
|
||||
free(AB);
|
||||
return a;
|
||||
}
|
||||
default:
|
||||
error("%s is not a variable", sym->sy_idf->id_text);
|
||||
break;
|
||||
}
|
||||
return 0;
|
||||
}
|
||||
|
||||
/* Get the value of the symbol indicated by sym.
|
||||
Return 0 on failure,
|
||||
1 on success.
|
||||
On success, 'buf' contains the value, and 'size' contains the size.
|
||||
For 'buf', 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, psize)
|
||||
register p_symbol sym;
|
||||
char **buf;
|
||||
long *psize;
|
||||
{
|
||||
p_type tp = sym->sy_type;
|
||||
int retval = 0;
|
||||
t_addr a;
|
||||
long size = tp->ty_size;
|
||||
|
||||
*buf = 0;
|
||||
switch(sym->sy_class) {
|
||||
case CONST:
|
||||
*buf = malloc((unsigned) size);
|
||||
if (! *buf) {
|
||||
error("could not allocate enough memory");
|
||||
break;
|
||||
}
|
||||
switch(tp->ty_class) {
|
||||
case T_REAL:
|
||||
put_real(*buf, size, sym->sy_const.co_rval);
|
||||
break;
|
||||
case T_INTEGER:
|
||||
case T_SUBRANGE:
|
||||
case T_UNSIGNED:
|
||||
case T_ENUM:
|
||||
put_int(*buf, size, sym->sy_const.co_ival);
|
||||
break;
|
||||
case T_SET:
|
||||
memcpy(*buf, sym->sy_const.co_setval, (int) size);
|
||||
break;
|
||||
case T_STRING:
|
||||
memcpy(*buf, sym->sy_const.co_sval, (int) size);
|
||||
break;
|
||||
default:
|
||||
fatal("strange constant");
|
||||
}
|
||||
retval = 1;
|
||||
break;
|
||||
case VAR:
|
||||
case VARPAR:
|
||||
case LOCVAR:
|
||||
a = get_addr(sym, psize);
|
||||
if (a) {
|
||||
size = *psize;
|
||||
*buf = malloc((unsigned) size);
|
||||
if (! *buf) {
|
||||
error("could not allocate enough memory");
|
||||
break;
|
||||
}
|
||||
if (get_bytes(size, a, *buf)) {
|
||||
retval = 1;
|
||||
}
|
||||
}
|
||||
break;
|
||||
}
|
||||
|
||||
if (retval == 0) {
|
||||
if (*buf) free(*buf);
|
||||
*buf = 0;
|
||||
*psize = 0;
|
||||
}
|
||||
else *psize = size;
|
||||
|
||||
return retval;
|
||||
}
|
||||
Reference in New Issue
Block a user