home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
OS/2 Shareware BBS: 10 Tools
/
10-Tools.zip
/
adaptor.zip
/
adapt.zip
/
adaptor
/
src
/
adaptfor.c
< prev
next >
Wrap
Text File
|
1994-01-03
|
16KB
|
666 lines
# include "Forall.h"
# include "yyAForal.w"
# include <stdio.h>
# if defined __STDC__ | defined __cplusplus
# include <stdlib.h>
# else
extern void exit ();
# endif
# include "Tree.h"
# include "Definiti.h"
# ifndef NULL
# define NULL 0L
# endif
# ifndef false
# define false 0
# endif
# ifndef true
# define true 1
# endif
# ifdef yyInline
# define yyALLOC(tree, free, max, alloc, nodesize, make, ptr, kind) \
if ((ptr = (tree) free) >= (tree) max) ptr = alloc (); \
free += nodesize [kind]; \
ptr->yyHead.yyMark = 0; \
ptr->Kind = kind;
# else
# define yyALLOC(tree, free, max, alloc, nodesize, make, ptr, kind) ptr = make (kind);
# endif
# define yyWrite(s) (void) fputs (s, yyf)
# define yyWriteNl (void) fputc ('\n', yyf)
# line 23 "AdaptForall.puma"
# include <stdio.h>
# include "Idents.h"
# include "StringMe.h"
# include "protocol.h"
# include "Types.h"
# include "Dependen.h"
# include "Transfor.h" /* CombineACF, ReplaceACF */
# include "F90.h" /* MakeArrayAssignment */
# define MAXForall 10
/*********************************************************************
* *
* Nest[0] FORALL I1 = ... *
* Nest[1] FORALL I2 = ... *
* ... *
* Nest[Nesting-1] FORALL Ik = ... *
* *
* stmt : A(I1,I2,...,Ik) = .... *
* *
* proves that no dataflow dependences will exist *
* *
* *
* kind1 : var = exp (can be a movement) *
* *
* can become array expressionn *
* *
* kind2 : if (...) ...... end if *
* from where statement *
* *
* will not be transformed at all *
* *
*********************************************************************/
static int Nesting; /* nesting depth */
static tTree Nest[MAXForall]; /* DOLOCAL loops for maximal nesting */
static tTree forallstmt; /* FORALL : innermost stmt */
static tTree forallvar; /* only set for single assignment */
static tTree forallexp; /* forallvar = forallexp */
static bool dataflow, movement;
static FILE * yyf = stdout;
static void yyAbort
# ifdef __cplusplus
(char * yyFunction)
# else
(yyFunction) char * yyFunction;
# endif
{
(void) fprintf (stderr, "Error: module AdaptForall, routine %s failed\n", yyFunction);
exit (1);
}
tTree TransformFORALL ARGS((tTree t));
static void SetUpForall ARGS((tTree body));
static void CheckDataFlowExp ARGS((tTree var, tTree exp));
static void CheckDataFlow1 ARGS((tTree var, tTree stmt));
static void CheckDataFlow ARGS((tTree stmt, tTree body));
tTree TransformFORALL
# if defined __STDC__ | defined __cplusplus
(register tTree t)
# else
(t)
register tTree t;
# endif
{
# line 80 "AdaptForall.puma"
int i;
tTree pl, newa;
if (t->Kind == kACF_FORALL) {
# line 85 "AdaptForall.puma"
{
# line 87 "AdaptForall.puma"
Nesting = 0;
forallvar = NoTree;
forallexp = NoTree;
SetUpForall (t);
dataflow = false;
CheckDataFlow (forallstmt, forallstmt);
if (!dataflow)
{
}
movement = (forallvar != NoTree);
if (movement)
movement = (CountMovements (forallvar, forallexp) > 0);
if (movement)
{
stmt_protocol ("forall will be transformed to array movement:\n");
newa = MakeArrayAssignment (t);
tree_protocol ("array movement is : \n", newa);
for (i=0; i<Nesting; i++)
{ pl = Nest[i];
pl->Kind = kACF_DO;
}
}
else
{
for (i=0; i<Nesting; i++)
{ pl = Nest[i];
pl->Kind = kACF_DOLOCAL;
}
newa = t;
}
}
return newa;
}
# line 141 "AdaptForall.puma"
{
# line 142 "AdaptForall.puma"
printf ("Illegal call of TransformFORALL\n");
# line 143 "AdaptForall.puma"
WriteTree (stdout, t);
# line 144 "AdaptForall.puma"
FileUnparse (stdout, t);
# line 145 "AdaptForall.puma"
kill_in_protocol ();
}
return t;
}
static void SetUpForall
# if defined __STDC__ | defined __cplusplus
(register tTree body)
# else
(body)
register tTree body;
# endif
{
if (body == NoTree) return;
if (body->Kind == kACF_LIST) {
if (body->ACF_LIST.Elem->Kind == kACF_BASIC) {
if (body->ACF_LIST.Elem->ACF_BASIC.BASIC_STMT->Kind == kASSIGN_STMT) {
if (body->ACF_LIST.Next->Kind == kACF_EMPTY) {
# line 159 "AdaptForall.puma"
{
# line 161 "AdaptForall.puma"
forallstmt = body->ACF_LIST.Elem;
# line 162 "AdaptForall.puma"
forallvar = body->ACF_LIST.Elem->ACF_BASIC.BASIC_STMT->ASSIGN_STMT.ASSIGN_VAR;
# line 163 "AdaptForall.puma"
forallexp = body->ACF_LIST.Elem->ACF_BASIC.BASIC_STMT->ASSIGN_STMT.ASSIGN_EXP;
}
return;
}
}
}
if (body->ACF_LIST.Next->Kind == kACF_EMPTY) {
# line 166 "AdaptForall.puma"
{
# line 168 "AdaptForall.puma"
SetUpForall (body->ACF_LIST.Elem);
}
return;
}
# line 171 "AdaptForall.puma"
{
# line 174 "AdaptForall.puma"
if (! (forallstmt = body)) goto yyL3;
}
return;
yyL3:;
}
if (body->Kind == kACF_IF) {
# line 179 "AdaptForall.puma"
{
# line 180 "AdaptForall.puma"
forallstmt = body;
}
return;
}
if (body->Kind == kACF_FORALL) {
# line 183 "AdaptForall.puma"
{
# line 184 "AdaptForall.puma"
if (Nesting >= MAXForall)
simple_error_protocol ("to deep forall nesting");
else
{ Nest [Nesting] = body;
Nesting += 1;
SetUpForall (body->ACF_FORALL.FORALL_BODY);
}
}
return;
}
# line 194 "AdaptForall.puma"
{
# line 195 "AdaptForall.puma"
printf ("SetUpForall failed for \n");
# line 196 "AdaptForall.puma"
FileUnparse (stdout, body);
# line 197 "AdaptForall.puma"
WriteTree (stdout, body);
# line 198 "AdaptForall.puma"
exit (- 1);
}
return;
;
}
static void CheckDataFlowExp
# if defined __STDC__ | defined __cplusplus
(register tTree var, register tTree exp)
# else
(var, exp)
register tTree var;
register tTree exp;
# endif
{
# line 216 "AdaptForall.puma"
char PString [100];
if (var == NoTree) return;
if (exp == NoTree) return;
if (exp->Kind == kOP_EXP) {
# line 220 "AdaptForall.puma"
{
# line 221 "AdaptForall.puma"
CheckDataFlowExp (var, exp->OP_EXP.OPND1);
# line 222 "AdaptForall.puma"
CheckDataFlowExp (var, exp->OP_EXP.OPND2);
}
return;
}
if (exp->Kind == kOP1_EXP) {
# line 225 "AdaptForall.puma"
{
# line 226 "AdaptForall.puma"
CheckDataFlowExp (var, exp->OP1_EXP.OPND);
}
return;
}
if (exp->Kind == kCONST_EXP) {
# line 229 "AdaptForall.puma"
return;
}
if (exp->Kind == kUSED_VAR) {
# line 232 "AdaptForall.puma"
return;
}
if (exp->Kind == kLOOP_VAR) {
# line 236 "AdaptForall.puma"
return;
}
if (exp->Kind == kVAR_EXP) {
# line 240 "AdaptForall.puma"
{
# line 241 "AdaptForall.puma"
CheckDataFlowExp (var, exp->VAR_EXP.V);
}
return;
}
if (var->Kind == kINDEXED_VAR) {
if (var->INDEXED_VAR.IND_VAR->Kind == kUSED_VAR) {
if (exp->Kind == kINDEXED_VAR) {
if (exp->INDEXED_VAR.IND_VAR->Kind == kUSED_VAR) {
# line 244 "AdaptForall.puma"
{
Predicate P;
PredVector PV;
int ConstLoops;
int CommonLoops;
{
# line 246 "AdaptForall.puma"
if (! (var->INDEXED_VAR.IND_VAR->USED_VAR.VARNAME->VAR_OBJ.Ident == exp->INDEXED_VAR.IND_VAR->USED_VAR.VARNAME->VAR_OBJ.Ident)) goto yyL7;
{
# line 250 "AdaptForall.puma"
# line 251 "AdaptForall.puma"
# line 253 "AdaptForall.puma"
# line 254 "AdaptForall.puma"
# line 256 "AdaptForall.puma"
CommonLoops = Nesting;
PMakeFalse (&P);
for (ConstLoops = 0; ConstLoops < Nesting; ConstLoops++)
{
PVMakeForLoopNest (Nesting, CommonLoops, ConstLoops, &PV);
Dependences (var, Nest, Nesting, exp, Nest, Nesting,
CommonLoops, ConstLoops, &PV);
POrVector (&P, &PV);
}
if (!PIsFalse (&P))
{ dataflow = true;
error_protocol ("Cannot sequentialize FORALL -> true dep");
tree_protocol ("Variable = ", var);
tree_protocol ("Expression = ", exp);
strcpy (PString, "Dependences : ");
POut (PString, &P);
print_protocol (PString);
}
}
}
return;
}
yyL7:;
# line 277 "AdaptForall.puma"
{
# line 279 "AdaptForall.puma"
if (! (var->INDEXED_VAR.IND_VAR->USED_VAR.VARNAME->VAR_OBJ.Ident != exp->INDEXED_VAR.IND_VAR->USED_VAR.VARNAME->VAR_OBJ.Ident)) goto yyL8;
}
return;
yyL8:;
}
}
}
}
if (exp->Kind == kFUNC_CALL_EXP) {
# line 282 "AdaptForall.puma"
{
# line 283 "AdaptForall.puma"
CheckDataFlowExp (var, exp->FUNC_CALL_EXP.FUNC_PARAMS);
}
return;
}
if (exp->Kind == kADDR) {
# line 286 "AdaptForall.puma"
{
# line 287 "AdaptForall.puma"
CheckDataFlowExp (var, exp->ADDR.E);
}
return;
}
if (exp->Kind == kBTP_LIST) {
if (exp->BTP_LIST.Elem->Kind == kVAR_PARAM) {
# line 290 "AdaptForall.puma"
{
# line 291 "AdaptForall.puma"
CheckDataFlowExp (var, exp->BTP_LIST.Elem->VAR_PARAM.V);
# line 292 "AdaptForall.puma"
CheckDataFlowExp (var, exp->BTP_LIST.Next);
}
return;
}
}
if (exp->Kind == kBTP_EMPTY) {
# line 295 "AdaptForall.puma"
return;
}
# line 298 "AdaptForall.puma"
{
# line 299 "AdaptForall.puma"
printf ("CheckDataFlowExp failed\n");
# line 300 "AdaptForall.puma"
FileUnparse (stdout, var);
# line 300 "AdaptForall.puma"
printf (" is variable\n");
# line 301 "AdaptForall.puma"
WriteTree (stdout, var);
# line 302 "AdaptForall.puma"
FileUnparse (stdout, exp);
# line 302 "AdaptForall.puma"
printf (" is expression\n");
# line 303 "AdaptForall.puma"
WriteTree (stdout, exp);
}
return;
;
}
static void CheckDataFlow1
# if defined __STDC__ | defined __cplusplus
(register tTree var, register tTree stmt)
# else
(var, stmt)
register tTree var;
register tTree stmt;
# endif
{
if (var == NoTree) return;
if (stmt == NoTree) return;
switch (stmt->Kind) {
case kACF_LIST:
# line 318 "AdaptForall.puma"
{
# line 319 "AdaptForall.puma"
CheckDataFlow1 (var, stmt->ACF_LIST.Elem);
# line 320 "AdaptForall.puma"
CheckDataFlow1 (var, stmt->ACF_LIST.Next);
}
return;
case kACF_EMPTY:
# line 323 "AdaptForall.puma"
return;
case kACF_IF:
# line 326 "AdaptForall.puma"
{
# line 327 "AdaptForall.puma"
CheckDataFlowExp (var, stmt->ACF_IF.IF_EXP);
# line 328 "AdaptForall.puma"
CheckDataFlow1 (var, stmt->ACF_IF.THEN_PART);
# line 329 "AdaptForall.puma"
CheckDataFlow1 (var, stmt->ACF_IF.ELSE_PART);
}
return;
case kACF_DOLOCAL:
# line 332 "AdaptForall.puma"
{
# line 333 "AdaptForall.puma"
CheckDataFlow1 (var, stmt->ACF_DOLOCAL.DOLOCAL_BODY);
}
return;
case kACF_BASIC:
# line 336 "AdaptForall.puma"
{
# line 337 "AdaptForall.puma"
CheckDataFlow1 (var, stmt->ACF_BASIC.BASIC_STMT);
}
return;
case kASSIGN_STMT:
# line 340 "AdaptForall.puma"
{
# line 341 "AdaptForall.puma"
if (var != stmt->ASSIGN_STMT.ASSIGN_VAR)
CheckDataFlowExp (var, stmt->ASSIGN_STMT.ASSIGN_VAR);
# line 344 "AdaptForall.puma"
CheckDataFlowExp (var, stmt->ASSIGN_STMT.ASSIGN_EXP);
}
return;
case kREDUCE_STMT:
if (stmt->REDUCE_STMT.RED_PARAMS->Kind == kBTP_LIST) {
if (stmt->REDUCE_STMT.RED_PARAMS->BTP_LIST.Elem->Kind == kVAR_PARAM) {
# line 347 "AdaptForall.puma"
{
# line 348 "AdaptForall.puma"
if (var != stmt->REDUCE_STMT.RED_PARAMS->BTP_LIST.Elem->VAR_PARAM.V)
CheckDataFlowExp (var, stmt->REDUCE_STMT.RED_PARAMS->BTP_LIST.Elem->VAR_PARAM.V);
# line 351 "AdaptForall.puma"
CheckDataFlowExp (var, stmt->REDUCE_STMT.RED_PARAMS->BTP_LIST.Next);
}
return;
}
}
break;
}
# line 354 "AdaptForall.puma"
{
# line 355 "AdaptForall.puma"
printf ("CheckDataFlow1 failed\n");
# line 356 "AdaptForall.puma"
FileUnparse (stdout, var);
# line 356 "AdaptForall.puma"
printf (" is variable\n");
# line 357 "AdaptForall.puma"
WriteTree (stdout, var);
# line 358 "AdaptForall.puma"
FileUnparse (stdout, stmt);
# line 358 "AdaptForall.puma"
printf (" is statement\n");
# line 359 "AdaptForall.puma"
WriteTree (stdout, stmt);
}
return;
;
}
static void CheckDataFlow
# if defined __STDC__ | defined __cplusplus
(register tTree stmt, register tTree body)
# else
(stmt, body)
register tTree stmt;
register tTree body;
# endif
{
if (stmt == NoTree) return;
if (body == NoTree) return;
switch (stmt->Kind) {
case kACF_LIST:
# line 373 "AdaptForall.puma"
{
# line 374 "AdaptForall.puma"
CheckDataFlow (stmt->ACF_LIST.Elem, body);
# line 375 "AdaptForall.puma"
CheckDataFlow (stmt->ACF_LIST.Next, body);
}
return;
case kACF_EMPTY:
# line 378 "AdaptForall.puma"
return;
case kACF_IF:
# line 381 "AdaptForall.puma"
{
# line 382 "AdaptForall.puma"
CheckDataFlow (stmt->ACF_IF.THEN_PART, body);
# line 383 "AdaptForall.puma"
CheckDataFlow (stmt->ACF_IF.ELSE_PART, body);
}
return;
case kACF_BASIC:
# line 386 "AdaptForall.puma"
{
# line 387 "AdaptForall.puma"
CheckDataFlow (stmt->ACF_BASIC.BASIC_STMT, body);
}
return;
case kASSIGN_STMT:
# line 390 "AdaptForall.puma"
{
# line 391 "AdaptForall.puma"
CheckDataFlow1 (stmt->ASSIGN_STMT.ASSIGN_VAR, body);
}
return;
case kREDUCE_STMT:
if (stmt->REDUCE_STMT.RED_PARAMS->Kind == kBTP_LIST) {
if (stmt->REDUCE_STMT.RED_PARAMS->BTP_LIST.Elem->Kind == kVAR_PARAM) {
# line 394 "AdaptForall.puma"
{
# line 395 "AdaptForall.puma"
CheckDataFlow1 (stmt->REDUCE_STMT.RED_PARAMS->BTP_LIST.Elem->VAR_PARAM.V, body);
}
return;
}
}
break;
case kACF_DOLOCAL:
# line 398 "AdaptForall.puma"
{
# line 399 "AdaptForall.puma"
CheckDataFlow (stmt->ACF_DOLOCAL.DOLOCAL_BODY, body);
}
return;
}
# line 402 "AdaptForall.puma"
{
# line 403 "AdaptForall.puma"
printf ("CheckDataFlow failed\n");
# line 404 "AdaptForall.puma"
FileUnparse (stdout, stmt);
# line 404 "AdaptForall.puma"
printf (" is stmt\n");
# line 405 "AdaptForall.puma"
WriteTree (stdout, stmt);
# line 406 "AdaptForall.puma"
FileUnparse (stdout, body);
# line 406 "AdaptForall.puma"
printf (" is body\n");
# line 407 "AdaptForall.puma"
WriteTree (stdout, body);
}
return;
;
}
void BeginAdaptForall ()
{
}
void CloseAdaptForall ()
{
}