ack/lang/cem/cemcom.ansi/dumpidf.c

490 lines
10 KiB
C
Raw Normal View History

1989-02-07 11:04:05 +00:00
/*
* (c) copyright 1987 by the Vrije Universiteit, Amsterdam, The Netherlands.
* See the copyright notice in the ACK home directory, in the file "Copyright".
*/
1994-06-27 08:03:14 +00:00
/* $Id$ */
1989-02-07 11:04:05 +00:00
/* DUMP ROUTINES */
#include "parameters.h"
Add long long literals like 123LL to ACK C. For now, a long long literal must have the 'LL' or 'll' suffix. A literal without 'LL' or 'll' acts as before: it may become unsigned long but not long long. (For targets where int and long have the same size, some literals change from unsigned int to unsigned long.) Type `arith` may be too narrow for long long values. Add a second type `writh` for wide arithmetic, and change some variables from arith to writh. This may cause bugs if I forget to use writh, or if a conversion from writh to arith overflows. I mark some conversions with (arith) or (writh) casts. - BigPars, SmallPars: Remove SPECIAL_ARITHMETICS. This feature would change arith to a different type, but can't work, because it would conflict with definitions of arith in both <em_arith.h> and <flt_arith.h>. - LLlex.c: Understand 'LL' or 'll' suffix. Cut size of constant when it overflows writh, not only when it overflows the target machine's types. (This cut might not be necessary, because we might cut it again later.) When picking signed long or unsigned long, check the target's long type, not the compiler's arith type; the old check for `val >= 0` was broken where sizeof(arith) > 4. - LLlex.h: Change struct token's tok_ival to writh, so it can hold a long long literal. - arith.c: Adjust to VL_VALUE being writh. Don't convert between float and integer at compile-time if the integer might be too wide for <flt_arith.h>. Add writh2str(), because writh might be too wide for long2str(). - arith.h: Remove SPECIAL_ARITHMETICS. Declare full_mask[] here, not in several *.c files. Declare writh2str(). - ch3.c, ch3bin.c, ch3mon.c, declarator.c, statement.g: Remove obsolete casts. Adjust to VL_VALUE being writh. - conversion.c, stab.c: Don't declare full_mask[]. - cstoper.c: Use writh for constant operations on VL_VALUE, and for full_mask[]. - declar., field.c, ival.g: Add casts. - dumpidf.c: Need to #include "parameters.h" before checking DEBUG. Use writh2str, because "%ld" might not work. - eval.c, eval.h: Add casts. Use writh when writing a wide constant in EM. - expr.c: Add and remove casts. In fill_int_expr(), make expression from long long literal. In chk_cst_expr(), allow long long as constant expression, so the compiler may accept `case 123LL:` in a switch statement. - expr.str: Change struct value's vl_value and struct expr's VL_VALUE to writh, so an expression may have a long long value at compile time. - statement.g: Remove obsolete casts. - switch.c, switch.str: Use writh in case entries for switch statements, so `switch (ll) {...}` with long long ll works. - tokenname.c: Add ULNGLNG so LLlex.c can use it for literals.
2019-09-05 02:14:38 +00:00
#ifdef DEBUG
#include <ack_string.h>
#include <alloc.h>
#include <flt_arith.h>
1989-02-07 11:04:05 +00:00
#include "arith.h"
#include "stack.h"
#include "def.h"
2019-03-17 14:24:54 +00:00
#include "idf.h"
1989-02-07 11:04:05 +00:00
#include "type.h"
#include "proto.h"
#include "struct.h"
#include "field.h"
2019-03-17 14:24:54 +00:00
#include "print.h"
1989-02-07 11:04:05 +00:00
#include "Lpars.h"
#include "label.h"
#include "expr.h"
2019-03-17 14:24:54 +00:00
/*#include "static.h"*/
1989-02-07 11:04:05 +00:00
#include "declar.h"
/* Some routines (symbol2str, type2str, qual2str) which should have
1989-02-07 11:04:05 +00:00
* yielded strings are written to yield a pointer to a transient piece
* of memory, containing the string, since this is the only reasonable
* thing to do in C. `Transient' means that the result may soon
* disappear, which is generally not a problem, since normally it is
* consumed immediately. Sometimes we need more than one of them, and
* MAXTRANS is the maximum number we will need simultaneously.
*/
#define MAXTRANS 6
extern char options[];
extern struct idf *idf_hashtable[];
2019-03-17 14:24:54 +00:00
extern char *symbol2str();
1989-02-07 11:04:05 +00:00
enum sdef_kind {selector, field}; /* parameter for dumpsdefs */
static int dumplevel;
2019-03-17 14:24:54 +00:00
/* Forward declarations */
static void dumpstack(void);
static char *next_transient(void);
static char *qual2str(int);
static char *type2str(register struct type *);
static void p1_indent(register int);
static void dumpdefs(register struct def *, int);
void dumpidf(register struct idf *, int);
void dumptags(register struct tag *);
void dumptype(register struct type *);
void dumpsdefs(register struct sdef *, enum sdef_kind);
static void p1_expr(int, register struct expr *);
void newline(void)
{
1989-02-07 11:04:05 +00:00
register int dl = dumplevel;
print("\n");
while (dl >= 2) {
print("\t");
dl -= 2;
}
if (dl)
print(" ");
}
2019-03-17 14:24:54 +00:00
void dumpidftab(char msg[], int opt)
1989-02-07 11:04:05 +00:00
{
/* Dumps the identifier table in readable form (but in
arbitrary order).
Unless opt & 1, macros are not dumped.
Unless opt & 2, reserved identifiers are not dumped.
Unless opt & 4, universal identifiers are not dumped.
*/
print(">>> DUMPIDF, %s (start)", msg);
dumpstack();
idfappfun(dumpidf, opt);
1989-02-07 11:04:05 +00:00
newline();
print(">>> DUMPIDF, %s (end)\n", msg);
}
2019-03-17 14:24:54 +00:00
static void dumpstack(void)
1989-02-07 11:04:05 +00:00
{
/* Dumps the identifier stack, starting at the top.
*/
register struct stack_level *stl = local_level;
while (stl) {
register struct stack_entry *se = stl->sl_entry;
newline();
print("%3d: ", stl->sl_level);
while (se) {
print("%s ", se->se_idf->id_text);
se = se->next;
}
stl = stl->sl_previous;
}
print("\n");
}
2019-03-17 14:24:54 +00:00
void dumpidf(register struct idf *idf, int opt)
1989-02-07 11:04:05 +00:00
{
/* All information about the identifier idf is divulged in a
hopefully readable format.
*/
int started = 0;
if (!idf)
return;
if ((opt&2) && idf->id_reserved) {
if (!started++) {
newline();
print("%s:", idf->id_text);
}
print(" reserved: %d;", idf->id_reserved);
}
if (idf->id_def && ((opt&4) || idf->id_def->df_level)) {
if (!started++) {
newline();
print("%s:", idf->id_text);
}
dumpdefs(idf->id_def, opt);
}
if (idf->id_sdef) {
if (!started++) {
newline();
print("%s:", idf->id_text);
}
dumpsdefs(idf->id_sdef, selector);
}
if (idf->id_tag) {
1989-02-07 11:04:05 +00:00
if (!started++) {
newline();
print("%s:", idf->id_text);
}
dumptags(idf->id_tag);
1991-07-05 11:55:17 +00:00
}
1989-02-07 11:04:05 +00:00
}
2019-03-17 14:24:54 +00:00
void dumpdefs(register struct def *def, int opt)
1989-02-07 11:04:05 +00:00
{
dumplevel++;
while (def && ((opt&4) || def->df_level)) {
newline();
print("L%d: %s %s%stype%s %lo; ",
def->df_level,
symbol2str(def->df_sc),
def->df_initialized ? "init'd " : "",
def->df_used ? "used " : "",
def->df_sc == ENUM ? ", =" : " at",
def->df_address
);
print("%s, line %u",
def->df_file ? def->df_file : "NO_FILE", def->df_line);
1991-07-05 11:55:17 +00:00
dumptype(def->df_type);
1989-02-07 11:04:05 +00:00
def = def->next;
}
dumplevel--;
}
2019-03-17 14:24:54 +00:00
void dumptags(register struct tag *tag)
1989-02-07 11:04:05 +00:00
{
dumplevel++;
while (tag) {
register struct type *tp = tag->tg_type;
register int fund = tp->tp_fund;
newline();
print("L%d: %s %s",
tag->tg_level,
fund == STRUCT ? "struct" :
fund == UNION ? "union" :
fund == ENUM ? "enum" : "<UNKNOWN>",
tp->tp_idf->id_text
);
if (is_struct_or_union(fund)) {
print(" {");
dumpsdefs(tp->tp_sdef, field);
newline();
print("}");
}
print(";");
tag = tag->next;
}
dumplevel--;
}
2019-03-17 14:24:54 +00:00
void dumpsdefs(register struct sdef *sdef, enum sdef_kind sdk)
1989-02-07 11:04:05 +00:00
{
/* Since sdef's are members of two chains, there are actually
two dumpsdefs's, one following the chain of all selectors
belonging to the same idf, starting at idf->id_sdef;
and the other following the chain of all selectors belonging
to the same struct, starting at stp->tp_sdef.
*/
dumplevel++;
while (sdef) {
newline();
print("L%d: ", sdef->sd_level);
#ifndef NOBITFIELD
if (sdk == selector)
#endif /* NOBITFIELD */
1989-02-07 11:04:05 +00:00
print("selector %s at offset %lu in %s;",
type2str(sdef->sd_type),
sdef->sd_offset, type2str(sdef->sd_stype)
);
#ifndef NOBITFIELD
else print("field %s at offset %lu;",
type2str(sdef->sd_type), sdef->sd_offset
);
#endif /* NOBITFIELD */
1989-02-07 11:04:05 +00:00
sdef = (sdk == selector ? sdef->next : sdef->sd_sdef);
}
dumplevel--;
}
2019-03-17 14:24:54 +00:00
void dumpproto(register struct proto *pl)
1989-02-07 11:04:05 +00:00
{
register struct type *type;
register int argcnt = 0;
newline();
print("dump proto type list (start)");
newline();
while (pl) {
print("%d: %s", argcnt++,
pl->pl_flag & PL_FORMAL ?
(pl->pl_flag & PL_VOID ? "void" : "formal")
1990-04-06 15:37:16 +00:00
: (pl->pl_flag & PL_ELLIPSIS
? "ellipsis" : "unknown" ));
1989-02-07 11:04:05 +00:00
newline();
2019-03-17 14:24:54 +00:00
if ( (type = pl->pl_type) ){
1991-07-05 11:55:17 +00:00
dumptype(type);
1989-02-07 11:04:05 +00:00
newline();
}
if (pl->pl_idf) {
dumplevel++;
print("idf:");
dumpidf(pl->pl_idf, 7);
dumplevel--;
}
newline();
pl = pl->next;
}
print("dump proto type list (end)\n");
}
2019-03-17 14:24:54 +00:00
void dumptype(register struct type *tp)
1989-02-07 11:04:05 +00:00
{
int ops = 1;
dumplevel++;
newline();
if (!tp) {
print("<NILTYPE>");
newline();
1991-07-05 11:55:17 +00:00
dumplevel--;
1989-02-07 11:04:05 +00:00
return;
}
print("(@%lx, #%ld, &%d) ", tp, (long)tp->tp_size, tp->tp_align);
while (ops) {
print("%s", qual2str(tp->tp_typequal));
switch (tp->tp_fund) {
case POINTER:
print("pointer to ");
break;
case ARRAY:
print("array [%ld] of ", tp->tp_size);
break;
case FUNCTION:
print("function ");
if (tp->tp_proto) {
print("with prototype");
dumplevel++;
1991-07-05 11:55:17 +00:00
dumpproto(tp->tp_proto);
1989-02-07 11:04:05 +00:00
dumplevel--;
newline();
}
print("yielding ");
break;
default:
print("%s%s ", tp->tp_unsigned ? "unsigned " : "",
symbol2str(tp->tp_fund));
if (tp->tp_idf)
print("%s ", tp->tp_idf->id_text);
#ifndef NOBITFIELD
1991-07-05 11:55:17 +00:00
if (tp->tp_fund == FIELD && tp->tp_field) {
1989-02-07 11:04:05 +00:00
struct field *fd = tp->tp_field;
print("[s=%ld,w=%ld] of ",
fd->fd_shift, fd->fd_width);
}
else
#endif /* NOBITFIELD */
1989-02-07 11:04:05 +00:00
ops = 0;
break;
}
if (ops) tp = tp->tp_up;
1989-02-07 11:04:05 +00:00
}
dumplevel--;
}
2019-03-17 14:24:54 +00:00
static char *type2str(register struct type *tp)
1989-02-07 11:04:05 +00:00
{
/* Yields a pointer to a one-line description of the type tp.
*/
char *buf = next_transient();
int ops = 1;
buf[0] = '\0';
if (!tp) {
sprint(buf, "<NILTYPE>");
return buf;
}
sprint(buf, "%s(@%lx, #%ld, &%d) ",
buf, tp, (long)tp->tp_size, tp->tp_align);
while (ops) {
sprint(buf, "%s%s", buf, qual2str(tp->tp_typequal));
switch (tp->tp_fund) {
case POINTER:
sprint(buf, "%spointer to ", buf);
break;
case ARRAY:
sprint(buf, "%sarray [%ld] of ", buf, tp->tp_size);
break;
case FUNCTION:
sprint(buf, "%sfunction yielding ", buf);
break;
default:
sprint(buf, "%s%s%s ", buf,
tp->tp_unsigned ? "unsigned " : "",
symbol2str(tp->tp_fund)
);
if (tp->tp_idf)
sprint(buf, "%s %s ", buf,
tp->tp_idf->id_text);
#ifndef NOBITFIELD
1991-07-05 11:55:17 +00:00
if (tp->tp_fund == FIELD && tp->tp_field) {
1989-02-07 11:04:05 +00:00
struct field *fd = tp->tp_field;
sprint(buf, "%s [s=%ld,w=%ld] of ", buf,
fd->fd_shift, fd->fd_width);
}
else
#endif /* NOBITFIELD */
1989-02-07 11:04:05 +00:00
ops = 0;
break;
}
if (ops) tp = tp->tp_up;
1989-02-07 11:04:05 +00:00
}
return buf;
}
2019-03-17 14:24:54 +00:00
static char *qual2str(int qual)
1989-02-07 11:04:05 +00:00
{
char *buf = next_transient();
*buf = '\0';
if (qual == 0)
sprint(buf, "(none)");
if (qual & TQ_CONST)
sprint(buf, "%sconst ", buf);
if (qual & TQ_VOLATILE)
sprint(buf, "%svolatile ", buf);
return qual == 0 ? "" : buf;
}
GSTATIC char trans_buf[MAXTRANS][300];
2019-03-17 14:24:54 +00:00
static char * /* the ultimate transient buffer supplier */
next_transient(void)
1989-02-07 11:04:05 +00:00
{
static int bnum;
if (++bnum == MAXTRANS)
bnum = 0;
return trans_buf[bnum];
}
2019-03-17 14:24:54 +00:00
void print_expr(char msg[], struct expr *expr)
1989-02-07 11:04:05 +00:00
{
/* Provisional routine to print an expression preceded by a
message msg.
*/
if (options['x']) {
print("\n%s: ", msg);
print("(L=line, T=type, r/lV=r/lvalue, F=flags, D=depth)\n");
p1_expr(0, expr);
}
}
2019-03-17 14:24:54 +00:00
static void p1_expr(int lvl, register struct expr *expr)
1989-02-07 11:04:05 +00:00
{
p1_indent(lvl);
if (!expr) {
print("NILEXPR\n");
return;
}
print("expr: L=%u, T=%s, %cV, F=%03o, D=%d, %s: ",
expr->ex_line,
type2str(expr->ex_type),
expr->ex_lvalue ? 'l' : 'r',
expr->ex_flags & 0xFF,
expr->ex_depth,
expr->ex_class == Value ? "Value" :
expr->ex_class == String ? "String" :
expr->ex_class == Float ? "Float" :
expr->ex_class == Oper ? "Oper" :
expr->ex_class == Type ? "Type" : "UNKNOWN CLASS"
);
switch (expr->ex_class) {
struct oper *o;
case Value:
switch (expr->VL_CLASS) {
case Const:
print("(Const) ");
break;
case Name:
print("(Name) %s + ", expr->VL_IDF->id_text);
break;
case Label:
print("(Label) .%lu + ", expr->VL_LBL);
break;
default:
print("(Unknown) ");
break;
}
Add long long literals like 123LL to ACK C. For now, a long long literal must have the 'LL' or 'll' suffix. A literal without 'LL' or 'll' acts as before: it may become unsigned long but not long long. (For targets where int and long have the same size, some literals change from unsigned int to unsigned long.) Type `arith` may be too narrow for long long values. Add a second type `writh` for wide arithmetic, and change some variables from arith to writh. This may cause bugs if I forget to use writh, or if a conversion from writh to arith overflows. I mark some conversions with (arith) or (writh) casts. - BigPars, SmallPars: Remove SPECIAL_ARITHMETICS. This feature would change arith to a different type, but can't work, because it would conflict with definitions of arith in both <em_arith.h> and <flt_arith.h>. - LLlex.c: Understand 'LL' or 'll' suffix. Cut size of constant when it overflows writh, not only when it overflows the target machine's types. (This cut might not be necessary, because we might cut it again later.) When picking signed long or unsigned long, check the target's long type, not the compiler's arith type; the old check for `val >= 0` was broken where sizeof(arith) > 4. - LLlex.h: Change struct token's tok_ival to writh, so it can hold a long long literal. - arith.c: Adjust to VL_VALUE being writh. Don't convert between float and integer at compile-time if the integer might be too wide for <flt_arith.h>. Add writh2str(), because writh might be too wide for long2str(). - arith.h: Remove SPECIAL_ARITHMETICS. Declare full_mask[] here, not in several *.c files. Declare writh2str(). - ch3.c, ch3bin.c, ch3mon.c, declarator.c, statement.g: Remove obsolete casts. Adjust to VL_VALUE being writh. - conversion.c, stab.c: Don't declare full_mask[]. - cstoper.c: Use writh for constant operations on VL_VALUE, and for full_mask[]. - declar., field.c, ival.g: Add casts. - dumpidf.c: Need to #include "parameters.h" before checking DEBUG. Use writh2str, because "%ld" might not work. - eval.c, eval.h: Add casts. Use writh when writing a wide constant in EM. - expr.c: Add and remove casts. In fill_int_expr(), make expression from long long literal. In chk_cst_expr(), allow long long as constant expression, so the compiler may accept `case 123LL:` in a switch statement. - expr.str: Change struct value's vl_value and struct expr's VL_VALUE to writh, so an expression may have a long long value at compile time. - statement.g: Remove obsolete casts. - switch.c, switch.str: Use writh in case entries for switch statements, so `switch (ll) {...}` with long long ll works. - tokenname.c: Add ULNGLNG so LLlex.c can use it for literals.
2019-09-05 02:14:38 +00:00
print("%s\n", writh2str(expr->VL_VALUE,
expr->ex_type->tp_unsigned));
1989-02-07 11:04:05 +00:00
break;
case String:
{
print(
"\"%s\"\n",
bts2str(expr->SG_VALUE, expr->SG_LEN-1,
next_transient())
);
break;
}
case Float:
{
char buf[FLT_STRLEN];
flt_flt2str(&(expr->FL_ARITH), buf, FLT_STRLEN);
print("%s\n", buf);
1989-02-07 11:04:05 +00:00
break;
}
1989-02-07 11:04:05 +00:00
case Oper:
o = &expr->ex_object.ex_oper;
print("\n");
p1_expr(lvl+1, o->op_left);
p1_indent(lvl);
print("%s <%s>\n", symbol2str(o->op_oper),
type2str(o->op_type)
);
p1_expr(lvl+1, o->op_right);
break;
case Type:
print("\n");
break;
default:
print("UNKNOWN CLASS\n");
break;
}
}
2019-03-17 14:24:54 +00:00
static void p1_indent(register int lvl)
1989-02-07 11:04:05 +00:00
{
while (lvl--)
print(" ");
}
#endif /* DEBUG */