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
/
chkinv.c
< prev
next >
Wrap
C/C++ Source or Header
|
1996-03-22
|
16KB
|
546 lines
/*
* chkinv.c - routines to determine which global names are only
* used as immediate operand to invocation and to directly invoke
* the corresponding operations. In addition, simple assignments to
* names variables are recognized and it is determined whether
* procedures return, suspend, or fail.
*/
#include "::h:gsupport.h"
#include "ctrans.h"
#include "csym.h"
#include "ctree.h"
#include "ctoken.h"
#include "cglobals.h"
#include "ccode.h"
#include "cproto.h"
/*
* prototypes for static functions.
*/
hidden int chg_ret Params((int flag));
hidden novalue chksmpl Params((struct node *n, int smpl_invk));
hidden int seq_exec Params((int exec_flg1, int exec_flg2));
hidden int spcl_inv Params((struct node *n, struct node *asgn));
static ret_flag;
/*
* chkinv - check for invocation and assignment optimizations.
*/
novalue chkinv()
{
struct gentry *gp;
struct pentry *proc;
int exec_flg;
int i;
if (debug_info)
return; /* The following analysis is not valid */
/*
* start off assuming that global variables for procedure, etc. are
* only used as immediate operands to invocations then mark any
* which are not. Any variables retaining the property are never
* changed. Go through the code and change invocations to such
* variables to invocations directly to the operation.
*/
for (i = 0; i < GHSize; i++)
for (gp = ghash[i]; gp != NULL; gp = gp->blink) {
if (gp->flag & (F_Proc | F_Builtin | F_Record) &&
!(gp->flag & F_StrInv))
gp->flag |= F_SmplInv;
/*
* However, only optimize normal cases for main.
*/
if (strcmp(gp->name, "main") == 0 && (gp->flag & F_Proc) &&
(gp->val.proc->nargs < 0 || gp->val.proc->nargs > 1))
gp->flag &= ~(uword)F_SmplInv;
/*
* Work-around to problem that a co-expression block needs
* block for enclosing procedure: just keep procedure in
* a variable to force outputting the block. Note, this
* inhibits tailored calling conventions for the procedure.
*/
if ((gp->flag & F_Proc) && gp->val.proc->has_coexpr)
gp->flag &= ~(uword)F_SmplInv;
}
/*
* Analyze code in each procedure.
*/
for (proc = proc_lst; proc != NULL; proc = proc->next) {
chksmpl(Tree1(proc->tree), 0); /* initial expression */
chksmpl(Tree2(proc->tree), 0); /* procedure body */
}
/*
* Go through each procedure performing "naive" optimizations on
* invocations and assignments. Also determine whether the procedure
* returns, suspends, or fails (possibly by falling through to
* the end).
*/
for (proc = proc_lst; proc != NULL; proc = proc->next) {
ret_flag = 0;
spcl_inv(Tree1(proc->tree), NULL);
exec_flg = spcl_inv(Tree2(proc->tree), NULL);
if (exec_flg & DoesFThru)
ret_flag |= DoesFail;
proc->ret_flag = ret_flag;
}
}
/*
* smpl_invk - find any global variable uses that are not a simple
* invocation and mark the variables.
*/
static novalue chksmpl(n, smpl_invk)
struct node *n;
int smpl_invk;
{
struct node *cases;
struct node *clause;
struct lentry *var;
int i;
int lst_arg;
switch (n->n_type) {
case N_Alt:
case N_Apply:
case N_Limit:
case N_Slist:
chksmpl(Tree0(n), 0);
chksmpl(Tree1(n), 0);
break;
case N_Activat:
chksmpl(Tree1(n), 0);
chksmpl(Tree2(n), 0);
break;
case N_Augop:
chksmpl(Tree2(n), 0);
chksmpl(Tree3(n), 0);
break;
case N_Bar:
case N_Break:
case N_Create:
case N_Field:
case N_Not:
chksmpl(Tree0(n), 0);
break;
case N_Case:
chksmpl(Tree0(n), 0); /* control clause */
cases = Tree1(n);
while (cases != NULL) {
if (cases->n_type == N_Ccls) {
clause = cases;
cases = NULL;
}
else {
clause = Tree1(cases);
cases = Tree0(cases);
}
chksmpl(Tree0(clause), 0); /* value of clause */
chksmpl(Tree1(clause), 0); /* body of clause */
}
if (Tree2(n) != NULL)
chksmpl(Tree2(n), 0); /* default */
break;
case N_Cset:
case N_Int:
case N_Real:
case N_Str:
case N_Empty:
case N_Next:
break;
case N_Id:
if (!smpl_invk) {
/*
* The variable is being used somewhere other than in a simple
* invocation.
*/
var = LSym0(n);
if (var->flag & F_Global)
var->val.global->flag &= ~F_SmplInv;
}
break;
case N_If:
chksmpl(Tree0(n), 0);
chksmpl(Tree1(n), 0);
chksmpl(Tree2(n), 0);
break;
case N_Invok:
lst_arg = 1 + Val0(n);
/*
* Check the thing being invoked, noting that it is in fact being
* invoked.
*/
chksmpl(Tree1(n), 1);
for (i = 2; i <= lst_arg; ++i)
chksmpl(n->n_field[i].n_ptr, 0); /* arg i - 1 */
break;
case N_InvOp:
lst_arg = 1 + Val0(n);
for (i = 2; i <= lst_arg; ++i)
chksmpl(n->n_field[i].n_ptr, 0); /* arg i */
break;
case N_Loop: {
switch ((int)Val0(Tree0(n))) {
case EVERY:
case SUSPEND:
case WHILE:
case UNTIL:
chksmpl(Tree1(n), 0); /* control clause */
chksmpl(Tree2(n), 0); /* do clause */
break;
case REPEAT:
chksmpl(Tree1(n), 0); /* clause */
break;
}
}
case N_Ret:
if (Val0(Tree0(n)) == RETURN)
chksmpl(Tree1(n), 0);
break;
case N_Scan:
chksmpl(Tree1(n), 0);
chksmpl(Tree2(n), 0);
break;
case N_Sect:
chksmpl(Tree2(n), 0);
chksmpl(Tree3(n), 0);
chksmpl(Tree4(n), 0);
break;
default:
fprintf(stderr, "compiler error: node type %d unknown\n", n->n_type);
exit(ErrorExit);
}
}
/*
* spcl_inv - look for general invocations that can be replaced by
* special invocations. Simple assignment to a named variable is
* is a particularly special case. Also, determine whether execution
* might "fall through" this code and whether the code might fail.
*/
static int spcl_inv(n, asgn)
struct node *n;
struct node *asgn; /* the result goes into this special-cased assignment */
{
struct node *cases;
struct node *clause;
struct node *invokee;
struct gentry *gvar;
struct loop {
int exec_flg;
struct node *asgn;
struct loop *prev;
} loop_info;
struct loop *loop_sav;
int exec_flg;
int i;
int lst_arg;
static struct loop *cur_loop = NULL;
switch (n->n_type) {
case N_Activat:
if (asgn != NULL)
Val0(asgn) = AsgnDeref; /* assume worst case */
return seq_exec(spcl_inv(Tree1(n), NULL), spcl_inv(Tree2(n), NULL));
case N_Alt:
exec_flg = spcl_inv(Tree0(n), asgn) & DoesFThru;
return exec_flg | spcl_inv(Tree1(n), asgn);
case N_Apply:
if (asgn != NULL)
Val0(asgn) = AsgnCopy; /* assume worst case */
return seq_exec(spcl_inv(Tree0(n), NULL), spcl_inv(Tree1(n), NULL));
case N_Augop:
exec_flg = chg_ret(Impl1(n)->ret_flag);
if (Tree2(n)->n_type == N_Id) {
/*
* This is an augmented assignment to a named variable.
* An optimized version of assignment can be used.
*/
n->n_type = N_SmplAug;
if (Impl1(n)->use_rslt)
Val0(n) = AsgnCopy;
else
Val0(n) = AsgnDirect;
}
else {
if (asgn != NULL)
Val0(asgn) = AsgnDeref; /* this operation produces a variable */
exec_flg = seq_exec(exec_flg, spcl_inv(Tree2(n), NULL));
exec_flg = seq_exec(exec_flg, chg_ret(Impl0(n)->ret_flag));
}
return seq_exec(exec_flg, spcl_inv(Tree3(n), NULL));
case N_Bar:
return spcl_inv(Tree0(n), asgn);
case N_Break:
if (cur_loop == NULL) {
nfatal(n, "invalid context for break", NULL);
return 0;
}
loop_sav = cur_loop;
cur_loop = cur_loop->prev;
loop_sav->exec_flg |= spcl_inv(Tree0(n), loop_sav->asgn);
cur_loop = loop_sav;
return 0;
case N_Create:
spcl_inv(Tree0(n), NULL);
return DoesFThru;
case N_Case:
exec_flg = spcl_inv(Tree0(n), NULL) & DoesFail; /* control clause */
cases = Tree1(n);
while (cases != NULL) {
if (cases->n_type == N_Ccls) {
clause = cases;
cases = NULL;
}
else {
clause = Tree1(cases);
cases = Tree0(cases);
}
spcl_inv(Tree0(clause), NULL);
exec_flg |= spcl_inv(Tree1(clause), asgn);
}
if (Tree2(n) != NULL)
exec_flg |= spcl_inv(Tree2(n), asgn); /* default */
else
exec_flg |= DoesFail;
return exec_flg;
case N_Cset:
case N_Int:
case N_Real:
case N_Str:
case N_Empty:
return DoesFThru;
case N_Field:
if (asgn != NULL)
Val0(asgn) = AsgnDeref; /* operation produces variable */
return spcl_inv(Tree0(n), NULL);
case N_Id:
if (asgn != NULL)
Val0(asgn) = AsgnDeref; /* variable */
return DoesFThru;
case N_If:
spcl_inv(Tree0(n), NULL);
exec_flg = spcl_inv(Tree1(n), asgn);
if (Tree2(n)->n_type == N_Empty)
exec_flg |= DoesFail;
else
exec_flg |= spcl_inv(Tree2(n), asgn);
return exec_flg;
case N_Invok:
lst_arg = 1 + Val0(n);
invokee = Tree1(n);
exec_flg = DoesFThru;
for (i = 2; i <= lst_arg; ++i)
exec_flg = seq_exec(exec_flg, spcl_inv(n->n_field[i].n_ptr, NULL));
if (invokee->n_type == N_Id && LSym0(invokee)->flag & F_Global) {
/*
* This is an invocation of a global variable. If we can
* convert this to a direct invocation, determine whether
* it is an invocation of a procedure, built-in function,
* or record constructor; each has a difference kind of
* direct invocation node.
*/
gvar = LSym0(invokee)->val.global;
if (gvar->flag & F_SmplInv) {
switch (gvar->flag & (F_Proc | F_Builtin | F_Record)) {
case F_Proc:
n->n_type = N_InvProc;
Proc1(n) = gvar->val.proc;
return DoesFThru | DoesFail; /* assume worst case */
case F_Builtin:
n->n_type = N_InvOp;
Impl1(n) = gvar->val.builtin;
if (asgn != NULL && Impl1(n)->use_rslt)
Val0(asgn) = AsgnCopy;
return seq_exec(exec_flg, chg_ret(
gvar->val.builtin->ret_flag));
case F_Record:
n->n_type = N_InvRec;
Rec1(n) = gvar->val.rec;
return seq_exec(exec_flg, DoesFThru |
(err_conv ? DoesFail : 0));
}
}
}
if (asgn != NULL)
Val0(asgn) = AsgnCopy; /* assume worst case */
spcl_inv(invokee, NULL);
return DoesFThru | DoesFail; /* assume worst case */
case N_InvOp:
if (Impl1(n)->op != NULL && strcmp(Impl1(n)->op, ":=") == 0 &&
Tree2(n)->n_type == N_Id) {
/*
* This is a simple assignment to a named variable.
* An optimized version of assignment can be used.
*/
n->n_type = N_SmplAsgn;
/*
* For now, assume rhs of := can compute directly into a
* variable. This may be changed when the rhs is examined
* in the recursive call to spcl_inv().
*/
Val0(n) = AsgnDirect;
return spcl_inv(Tree3(n), n);
}
else {
/*
* No special cases.
*/
lst_arg = 1 + Val0(n);
exec_flg = chg_ret(Impl1(n)->ret_flag);
for (i = 2; i <= lst_arg; ++i)
exec_flg = seq_exec(exec_flg, spcl_inv(n->n_field[i].n_ptr,
NULL)); /* arg i */
if (asgn != NULL && Impl1(n)->use_rslt)
Val0(asgn) = AsgnCopy;
return exec_flg;
}
case N_Limit:
return seq_exec(spcl_inv(Tree0(n), asgn),
spcl_inv(Tree1(n), NULL)) | DoesFail;
case N_Loop: {
loop_info.prev = cur_loop;
loop_info.exec_flg = 0;
loop_info.asgn = asgn;
cur_loop = &loop_info;
switch ((int)Val0(Tree0(n))) {
case EVERY:
case WHILE:
case UNTIL:
spcl_inv(Tree1(n), NULL); /* control clause */
spcl_inv(Tree2(n), NULL); /* do clause */
exec_flg = DoesFail;
break;
case SUSPEND:
spcl_inv(Tree1(n), NULL); /* control clause */
spcl_inv(Tree2(n), NULL); /* do clause */
ret_flag |= DoesSusp;
exec_flg = DoesFail;
break;
case REPEAT:
spcl_inv(Tree1(n), NULL); /* clause */
exec_flg = 0;
break;
}
exec_flg |= cur_loop->exec_flg;
cur_loop = cur_loop->prev;
return exec_flg;
}
case N_Next:
return 0;
case N_Not:
exec_flg = spcl_inv(Tree0(n), NULL);
return ((exec_flg & DoesFail) ? DoesFThru : 0) |
((exec_flg & DoesFThru) ? DoesFail: 0);
case N_Ret:
if (Val0(Tree0(n)) == RETURN) {
exec_flg = spcl_inv(Tree1(n), NULL);
ret_flag |= DoesRet;
if (exec_flg & DoesFail)
ret_flag |= DoesFail;
}
else
ret_flag |= DoesFail;
return 0;
case N_Scan:
if (asgn != NULL)
Val0(asgn) = AsgnCopy; /* assume worst case */
return seq_exec(spcl_inv(Tree1(n), NULL),
spcl_inv(Tree2(n), NULL));
case N_Sect:
if (asgn != NULL && Impl0(n)->use_rslt)
Val0(asgn) = AsgnCopy;
exec_flg = spcl_inv(Tree2(n), NULL);
exec_flg = seq_exec(exec_flg, spcl_inv(Tree3(n), NULL));
exec_flg = seq_exec(exec_flg, spcl_inv(Tree4(n), NULL));
return seq_exec(exec_flg, chg_ret(Impl0(n)->ret_flag));
case N_Slist:
exec_flg = spcl_inv(Tree0(n), NULL);
if (exec_flg & (DoesFThru | DoesFail))
exec_flg = DoesFThru;
return seq_exec(exec_flg, spcl_inv(Tree1(n), asgn));
default:
fprintf(stderr, "compiler error: node type %d unknown\n", n->n_type);
exit(ErrorExit);
/* NOTREACHED */
}
}
/*
* seq_exec - take the execution flags for sequential pieces of code
* and compute the flags for the combined code.
*/
static int seq_exec(exec_flg1, exec_flg2)
int exec_flg1;
int exec_flg2;
{
return (exec_flg1 & exec_flg2 & DoesFThru) |
((exec_flg1 | exec_flg2) & DoesFail);
}
/*
* chg_ret - take a return flag and change suspend and return to
* "fall through". If error conversion is supported, change error
* failure to failure.
*
*/
static int chg_ret(flag)
int flag;
{
int flg1;
flg1 = flag & DoesFail;
if (flag & (DoesRet | DoesSusp))
flg1 |= DoesFThru;
if (err_conv && (flag & DoesEFail))
flg1 |= DoesFail;
return flg1;
}