home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
ftp.cs.arizona.edu
/
ftp.cs.arizona.edu.tar
/
ftp.cs.arizona.edu
/
icon
/
historic
/
v92.tgz
/
v92.tar
/
v92
/
src
/
iconc
/
ctree.c
< prev
next >
Wrap
C/C++ Source or Header
|
1996-03-22
|
18KB
|
778 lines
/*
* ctree.c -- functions for constructing parse trees.
*/
#include "::h:gsupport.h"
#include "::h:lexdef.h"
#include "ctrans.h"
#include "ctree.h"
#include "csym.h"
#include "ctoken.h"
#include "ccode.h"
#include "cproto.h"
/*
* prototypes for static functions.
*/
hidden nodeptr chk_empty Params((nodeptr n));
hidden novalue put_elms Params((nodeptr t, nodeptr args, int slot));
hidden nodeptr subsc_nd Params((nodeptr op, nodeptr arg1, nodeptr arg2));
/*
* tree[1-6] construct parse tree nodes with specified values.
* loc_model is a node containing the same line and column information
* as is needed in this node, while parameters a through d are values to
* be assigned to n_field[0-3]. Note that this could be done with a
* single routine; a separate routine for each node size is used for
* speed and simplicity.
*/
nodeptr tree1(type)
int type;
{
register nodeptr t;
t = NewNode(0);
t->n_type = type;
t->n_file = NULL;
t->n_line = 0;
t->n_col = 0;
t->freetmp = NULL;
return t;
}
nodeptr tree2(type, loc_model)
int type;
nodeptr loc_model;
{
register nodeptr t;
t = NewNode(0);
t->n_type = type;
t->n_file = loc_model->n_file;
t->n_line = loc_model->n_line;
t->n_col = loc_model->n_col;
t->freetmp = NULL;
return t;
}
nodeptr tree3(type, loc_model, a)
int type;
nodeptr loc_model;
nodeptr a;
{
register nodeptr t;
t = NewNode(1);
t->n_type = type;
t->n_file = loc_model->n_file;
t->n_line = loc_model->n_line;
t->n_col = loc_model->n_col;
t->freetmp = NULL;
t->n_field[0].n_ptr = a;
return t;
}
nodeptr tree4(type, loc_model, a, b)
int type;
nodeptr loc_model;
nodeptr a, b;
{
register nodeptr t;
t = NewNode(2);
t->n_type = type;
t->n_file = loc_model->n_file;
t->n_line = loc_model->n_line;
t->n_col = loc_model->n_col;
t->freetmp = NULL;
t->n_field[0].n_ptr = a;
t->n_field[1].n_ptr = b;
return t;
}
nodeptr tree5(type, loc_model, a, b, c)
int type;
nodeptr loc_model;
nodeptr a, b, c;
{
register nodeptr t;
t = NewNode(3);
t->n_type = type;
t->n_file = loc_model->n_file;
t->n_line = loc_model->n_line;
t->n_col = loc_model->n_col;
t->freetmp = NULL;
t->n_field[0].n_ptr = a;
t->n_field[1].n_ptr = b;
t->n_field[2].n_ptr = c;
return t;
}
nodeptr tree6(type, loc_model, a, b, c, d)
int type;
nodeptr loc_model;
nodeptr a, b, c, d;
{
register nodeptr t;
t = NewNode(4);
t->n_type = type;
t->n_file = loc_model->n_file;
t->n_line = loc_model->n_line;
t->n_col = loc_model->n_col;
t->freetmp = NULL;
t->n_field[0].n_ptr = a;
t->n_field[1].n_ptr = b;
t->n_field[2].n_ptr = c;
t->n_field[3].n_ptr = d;
return t;
}
nodeptr int_leaf(type, loc_model, a)
int type;
nodeptr loc_model;
int a;
{
register nodeptr t;
t = NewNode(1);
t->n_type = type;
t->n_file = loc_model->n_file;
t->n_line = loc_model->n_line;
t->n_col = loc_model->n_col;
t->freetmp = NULL;
t->n_field[0].n_val = a;
return t;
}
nodeptr c_str_leaf(type, loc_model, a)
int type;
nodeptr loc_model;
char *a;
{
register nodeptr t;
t = NewNode(1);
t->n_type = type;
t->n_file = loc_model->n_file;
t->n_line = loc_model->n_line;
t->n_col = loc_model->n_col;
t->freetmp = NULL;
t->n_field[0].n_str = a;
return t;
}
/*
* i_str_leaf - create a leaf node containing a string and length.
*/
nodeptr i_str_leaf(type, loc_model, a, b)
int type;
nodeptr loc_model;
char *a;
int b;
{
register nodeptr t;
t = NewNode(2);
t->n_type = type;
t->n_file = loc_model->n_file;
t->n_line = loc_model->n_line;
t->n_col = loc_model->n_col;
t->freetmp = NULL;
t->n_field[0].n_str = a;
t->n_field[1].n_val = b;
return t;
}
/*
* key_leaf - create a leaf node for a keyword.
*/
nodeptr key_leaf(loc_model, keyname)
nodeptr loc_model;
char *keyname;
{
register nodeptr t;
struct implement *ip;
struct il_code *il;
char *s;
int typcd;
/*
* Find the data base entry for the keyword, if it exists.
*/
ip = db_ilkup(keyname, khash);
if (ip == NULL)
tfatal("invalid keyword", keyname);
else if (ip->in_line == NULL)
tfatal("keyword not installed", keyname);
else {
il = ip->in_line;
s = il->u[1].s;
if (il->il_type == IL_Const) {
/*
* This is a constant keyword, treat it as a literal.
*/
t = NewNode(1);
t->n_file = loc_model->n_file;
t->n_line = loc_model->n_line;
t->n_col = loc_model->n_col;
t->freetmp = NULL;
typcd = il->u[0].n;
if (typcd == cset_typ) {
t->n_type = N_Cset;
CSym0(t) = putlit(&s[1], F_CsetLit, strlen(s) - 2);
}
else if (typcd == int_typ) {
t->n_type = N_Int;
CSym0(t) = putlit(s, F_IntLit, 0);
}
else if (typcd == real_typ) {
t->n_type = N_Real;
CSym0(t) = putlit(s, F_RealLit, 0);
}
else if (typcd == str_typ) {
t->n_type = N_Str;
CSym0(t) = putlit(&s[1], F_StrLit, strlen(s) - 2);
}
return t;
}
}
t = NewNode(2);
t->n_type = N_InvOp;
t->n_file = loc_model->n_file;
t->n_line = loc_model->n_line;
t->n_col = loc_model->n_col;
t->freetmp = NULL;
t->n_field[0].n_val = 0; /* number of arguments */
t->n_field[1].ip = ip;
return t;
}
/*
* list_nd - create a list creation node.
*/
nodeptr list_nd(loc_model, args)
nodeptr loc_model;
nodeptr args;
{
register nodeptr t;
struct implement *impl;
int nargs;
/*
* Determine the number of arguments.
*/
if (args->n_type == N_Empty)
nargs = 0;
else {
nargs = 1;
for (t = args; t->n_type == N_Elist; t = t->n_field[0].n_ptr)
++nargs;
if (nargs > max_prm)
max_prm = nargs;
}
impl = spec_op[ListOp];
if (impl == NULL)
nfatal(loc_model, "list creation not implemented", NULL);
else if (impl->in_line == NULL)
nfatal(loc_model, "list creation not installed", NULL);
t = NewNode(nargs + 2);
t->n_type = N_InvOp;
t->n_file = loc_model->n_file;
t->n_line = loc_model->n_line;
t->n_col = loc_model->n_col;
t->freetmp = NULL;
t->n_field[0].n_val = nargs;
t->n_field[1].ip = impl;
if (nargs > 0)
put_elms(t, args, nargs + 1);
return t;
}
/*
* invk_nd - create a node for invocation.
*/
nodeptr invk_nd(loc_model, proc, args)
nodeptr loc_model;
nodeptr proc;
nodeptr args;
{
register nodeptr t;
int nargs;
/*
* Determine the number of arguments.
*/
if (args->n_type == N_Empty)
nargs = 0;
else {
nargs = 1;
for (t = args; t->n_type == N_Elist; t = t->n_field[0].n_ptr)
++nargs;
if (nargs > max_prm)
max_prm = nargs;
}
t = NewNode(nargs + 2);
t->n_type = N_Invok;
t->n_file = loc_model->n_file;
t->n_line = loc_model->n_line;
t->n_col = loc_model->n_col;
t->freetmp = NULL;
t->n_field[0].n_val = nargs;
t->n_field[1].n_ptr = proc;
if (nargs > 0)
put_elms(t, args, nargs + 1);
return t;
}
/*
* put_elms - convert a linked list of arguments into an array of arguments
* in a node.
*/
static novalue put_elms(t, args, slot)
nodeptr t;
nodeptr args;
int slot;
{
if (args->n_type == N_Elist) {
/*
* The linked list is in reverse argument order.
*/
t->n_field[slot].n_ptr = chk_empty(args->n_field[1].n_ptr);
put_elms(t, args->n_field[0].n_ptr, slot - 1);
free(args);
}
else
t->n_field[slot].n_ptr = chk_empty(args);
}
/*
* chk_empty - if an argument is empty, replace it with &null.
*/
static nodeptr chk_empty(n)
nodeptr n;
{
if (n->n_type == N_Empty)
n = key_leaf(n, spec_str("null"));
return n;
}
/*
* case_nd - create a node for a case statement.
*/
nodeptr case_nd(loc_model, expr, cases)
nodeptr loc_model;
nodeptr expr;
nodeptr cases;
{
register nodeptr t;
nodeptr reverse;
nodeptr nxt_cases;
nodeptr ccls;
t = NewNode(3);
t->n_type = N_Case;
t->n_file = loc_model->n_file;
t->n_line = loc_model->n_line;
t->n_col = loc_model->n_col;
t->freetmp = NULL;
t->n_field[0].n_ptr = expr;
t->n_field[2].n_ptr = NULL;
/*
* The list of cases is in reverse order. Walk the list reversing it,
* and extract the default clause if one exists.
*/
reverse = NULL;
while (cases->n_type != N_Ccls) {
nxt_cases = cases->n_field[0].n_ptr;
ccls = cases->n_field[1].n_ptr;
if (ccls->n_field[0].n_ptr->n_type == N_Res) {
/*
* default clause.
*/
if (t->n_field[2].n_ptr == NULL)
t->n_field[2].n_ptr = ccls->n_field[1].n_ptr;
else
nfatal(ccls, "duplicate default clause", NULL);
}
else {
if (reverse == NULL) {
reverse = cases;
reverse->n_field[0].n_ptr = ccls;
}
else {
reverse->n_field[1].n_ptr = ccls;
cases->n_field[0].n_ptr = reverse;
reverse = cases;
}
}
cases = nxt_cases;
}
/*
* Last element in list.
*/
if (cases->n_field[0].n_ptr->n_type == N_Res) {
/*
* default clause.
*/
if (t->n_field[2].n_ptr == NULL)
t->n_field[2].n_ptr = cases->n_field[1].n_ptr;
else
nfatal(ccls, "duplicate default clause", NULL);
if (reverse != NULL)
reverse = reverse->n_field[0].n_ptr;
}
else {
if (reverse == NULL)
reverse = cases;
else
reverse->n_field[1].n_ptr = cases;
}
t->n_field[1].n_ptr = reverse;
return t;
}
/*
* multiunary - construct nodes to implement a sequence of unary operators
* that have been lexically analyzed as one operator.
*/
nodeptr multiunary(op, loc_model, oprnd)
nodeptr loc_model;
char *op;
nodeptr oprnd;
{
int n;
nodeptr nd;
if (*op == '\0')
return oprnd;
for (n = 0; optab[n].tok.t_word != NULL; ++n)
if ((optab[n].expected & Unary) & (*(optab[n].tok.t_word) == *op)) {
nd = OpNode(n);
nd->n_file = loc_model->n_file;
nd->n_line = loc_model->n_line;
nd->n_col = loc_model->n_col;
return unary_nd(nd,multiunary(++op,loc_model,oprnd));
}
fprintf(stderr, "compiler error: inconsistent parsing of unary operators");
exit(ErrorExit);
}
/*
* binary_nd - construct a node for a binary operator.
*/
nodeptr binary_nd(op, arg1, arg2)
nodeptr op;
nodeptr arg1;
nodeptr arg2;
{
register nodeptr t;
struct implement *impl;
/*
* Find the data base entry for the operator.
*/
impl = optab[Val0(op)].binary;
if (impl == NULL)
nfatal(op, "binary operator not implemented", optab[Val0(op)].tok.t_word);
else if (impl->in_line == NULL)
nfatal(op, "binary operator not installed", optab[Val0(op)].tok.t_word);
t = NewNode(4);
t->n_type = N_InvOp;
t->n_file = op->n_file;
t->n_line = op->n_line;
t->n_col = op->n_col;
t->freetmp = NULL;
t->n_field[0].n_val = 2; /* number of arguments */
t->n_field[1].ip = impl;
t->n_field[2].n_ptr = arg1;
t->n_field[3].n_ptr = arg2;
return t;
}
/*
* unary_nd - construct a node for a unary operator.
*/
nodeptr unary_nd(op, arg)
nodeptr op;
nodeptr arg;
{
register nodeptr t;
struct implement *impl;
/*
* Find the data base entry for the operator.
*/
impl = optab[Val0(op)].unary;
if (impl == NULL)
nfatal(op, "unary operator not implemented", optab[Val0(op)].tok.t_word);
else if (impl->in_line == NULL)
nfatal(op, "unary operator not installed", optab[Val0(op)].tok.t_word);
t = NewNode(3);
t->n_type = N_InvOp;
t->n_file = op->n_file;
t->n_line = op->n_line;
t->n_col = op->n_col;
t->freetmp = NULL;
t->n_field[0].n_val = 1; /* number of arguments */
t->n_field[1].ip = impl;
t->n_field[2].n_ptr = arg;
return t;
}
/*
* buildarray - convert "multi-dimensional" subscripting into a sequence
* of subsripting operations.
*/
nodeptr buildarray(a,lb,e)
nodeptr a, lb, e;
{
register nodeptr t, t2;
if (e->n_type == N_Elist) {
t2 = int_leaf(lb->n_type, lb, lb->n_field[0].n_val);
t = subsc_nd(t2, buildarray(a,lb,e->n_field[0].n_ptr),
e->n_field[1].n_ptr);
free(e);
}
else
t = subsc_nd(lb, a, e);
return t;
}
/*
* subsc_nd - construct a node for subscripting.
*/
static nodeptr subsc_nd(op, arg1, arg2)
nodeptr op;
nodeptr arg1;
nodeptr arg2;
{
register nodeptr t;
struct implement *impl;
/*
* Find the data base entry for subscripting.
*/
impl = spec_op[SubscOp];
if (impl == NULL)
nfatal(op, "subscripting not implemented", NULL);
else if (impl->in_line == NULL)
nfatal(op, "subscripting not installed", NULL);
t = NewNode(4);
t->n_type = N_InvOp;
t->n_file = op->n_file;
t->n_line = op->n_line;
t->n_col = op->n_col;
t->freetmp = NULL;
t->n_field[0].n_val = 2; /* number of arguments */
t->n_field[1].ip = impl;
t->n_field[2].n_ptr = arg1;
t->n_field[3].n_ptr = arg2;
return t;
}
/*
* to_nd - construct a node for binary to.
*/
nodeptr to_nd(op, arg1, arg2)
nodeptr op;
nodeptr arg1;
nodeptr arg2;
{
register nodeptr t;
struct implement *impl;
/*
* Find the data base entry for to.
*/
impl = spec_op[ToOp];
if (impl == NULL)
nfatal(op, "'i to j' not implemented", NULL);
else if (impl->in_line == NULL)
nfatal(op, "'i to j' not installed", NULL);
t = NewNode(4);
t->n_type = N_InvOp;
t->n_file = op->n_file;
t->n_line = op->n_line;
t->n_col = op->n_col;
t->freetmp = NULL;
t->n_field[0].n_val = 2; /* number of arguments */
t->n_field[1].ip = impl;
t->n_field[2].n_ptr = arg1;
t->n_field[3].n_ptr = arg2;
return t;
}
/*
* toby_nd - construct a node for binary to-by.
*/
nodeptr toby_nd(op, arg1, arg2, arg3)
nodeptr op;
nodeptr arg1;
nodeptr arg2;
nodeptr arg3;
{
register nodeptr t;
struct implement *impl;
/*
* Find the data base entry for to-by.
*/
impl = spec_op[ToByOp];
if (impl == NULL)
nfatal(op, "'i to j by k' not implemented", NULL);
else if (impl->in_line == NULL)
nfatal(op, "'i to j by k' not installed", NULL);
t = NewNode(5);
t->n_type = N_InvOp;
t->n_file = op->n_file;
t->n_line = op->n_line;
t->n_col = op->n_col;
t->freetmp = NULL;
t->n_field[0].n_val = 3; /* number of arguments */
t->n_field[1].ip = impl;
t->n_field[2].n_ptr = arg1;
t->n_field[3].n_ptr = arg2;
t->n_field[4].n_ptr = arg3;
return t;
}
/*
* aug_nd - create a node for an augmented assignment.
*/
nodeptr aug_nd(op, arg1, arg2)
nodeptr op;
nodeptr arg1;
nodeptr arg2;
{
register nodeptr t;
struct implement *impl;
t = NewNode(5);
t->n_type = N_Augop;
t->n_file = op->n_file;
t->n_line = op->n_line;
t->n_col = op->n_col;
t->freetmp = NULL;
/*
* Find the data base entry for assignment.
*/
impl = optab[asgn_loc].binary;
if (impl == NULL)
nfatal(op, "assignment not implemented", NULL);
t->n_field[0].ip = impl;
/*
* The operator table entry for the augmented assignment is
* immediately after the entry for the operation.
*/
impl = optab[Val0(op) - 1].binary;
if (impl == NULL)
nfatal(op, "binary operator not implemented",
optab[Val0(op) - 1].tok.t_word);
t->n_field[1].ip = impl;
t->n_field[2].n_ptr = arg1;
t->n_field[3].n_ptr = arg2;
/* t->n_field[4].typ - type of intermediate result */
return t;
}
/*
* sect_nd - create a node for sectioning.
*/
nodeptr sect_nd(op, arg1, arg2, arg3)
nodeptr op;
nodeptr arg1;
nodeptr arg2;
nodeptr arg3;
{
register nodeptr t;
int tok;
struct implement *impl;
struct implement *impl1;
t = NewNode(5);
t->n_file = op->n_file;
t->n_line = op->n_line;
t->n_col = op->n_col;
t->freetmp = NULL;
/*
* Find the data base entry for sectioning.
*/
impl = spec_op[SectOp];
if (impl == NULL)
nfatal(op, "sectioning not implemented", NULL);
tok = optab[Val0(op)].tok.t_type;
if (tok == COLON) {
/*
* Simple sectioning, treat as a ternary operator.
*/
t->n_type = N_InvOp;
t->n_field[0].n_val = 3; /* number of arguments */
t->n_field[1].ip = impl;
}
else {
/*
* Find the data base entry for addition or subtraction.
*/
if (tok == PCOLON) {
impl1 = optab[plus_loc].binary;
if (impl1 == NULL)
nfatal(op, "addition not implemented", NULL);
}
else { /* MCOLON */
impl1 = optab[minus_loc].binary;
if (impl1 == NULL)
nfatal(op, "subtraction not implemented", NULL);
}
t->n_type = N_Sect;
t->n_field[0].ip = impl;
t->n_field[1].ip = impl1;
}
t->n_field[2].n_ptr = arg1;
t->n_field[3].n_ptr = arg2;
t->n_field[4].n_ptr = arg3;
return t;
}
/*
* invk_main - produce an procedure invocation node with one argument for
* use in the initial invocation to main() during type inference.
*/
nodeptr invk_main(main_proc)
struct pentry *main_proc;
{
register nodeptr t;
t = NewNode(3);
t->n_type = N_InvProc;
t->n_file = NULL;
t->n_line = 0;
t->n_col = 0;
t->freetmp = NULL;
t->n_field[0].n_val = 1; /* 1 argument */
t->n_field[1].proc = main_proc;
t->n_field[2].n_ptr = tree1(N_Empty);
if (max_prm < 1)
max_prm = 1;
return t;
}