home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
OS/2 Shareware BBS: 10 Tools
/
10-Tools.zip
/
adaptor.zip
/
adapt.zip
/
adaptor
/
src
/
adaptdol.c
< prev
next >
Wrap
Text File
|
1994-01-03
|
20KB
|
837 lines
# include "DoLocal.h"
# include "yyADoLoc.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 19 "AdaptDoLocal.puma"
# include <stdio.h>
# include "Idents.h"
# include "StringMe.h"
# include "protocol.h"
# include "Types.h"
# include "Transfor.h" /* CombineACF, ReplaceACF, ExpToVarParam */
# include "Local.h" /* MakeMask, LocalDOLOCAL */
# include "Reductio.h" /* GlobalReductionStmt, ResolveReduce */
# include "Dalib.h" /* MakeSizeExp */
# include "NormalLo.h" /* NormalLoop */
# define MAXForall 10
/*********************************************************************
* *
* Nest[0] DOLOCAL I1 = ... *
* Nest[1] DOLOCAL I2 = ... *
* ... *
* Nest[Nesting-1] DOLOCAL Ik = ... *
* *
* parvar : A(I1,I2,...,Ik) *
* *
*********************************************************************/
static int Nesting; /* current nesting */
static int MaxNesting; /* maximal nesting */
static tTree Nest[MAXForall]; /* DOLOCAL loops for maximal nesting */
static bool found; /* true if parallel variable found */
static tTree parvar; /* is parallel variable if found */
static FILE * yyf = stdout;
static void yyAbort
# ifdef __cplusplus
(char * yyFunction)
# else
(yyFunction) char * yyFunction;
# endif
{
(void) fprintf (stderr, "Error: module AdaptDoLocal, routine %s failed\n", yyFunction);
exit (1);
}
tTree TransformDoLocal ARGS((tTree t));
static tTree DOLOCAL_do_it ARGS((tTree t, tTree parvar, int dist));
static bool IsExpLoopId ARGS((tTree exp, tTree id));
static bool LoopInvariant ARGS((tTree exp));
static void FindParVariable ARGS((tTree body));
static void FindReduceVariable ARGS((tTree body));
static tTree CollectREDUCE ARGS((tTree t));
static tTree GlobalLocExchange ARGS((tTree params));
static tTree TransformSerialBody ARGS((tTree t));
tTree TransformDoLocal
# if defined __STDC__ | defined __cplusplus
(register tTree t)
# else
(t)
register tTree t;
# endif
{
# line 63 "AdaptDoLocal.puma"
tTree newacf;
char msg[100], n[100];
if (t->Kind == kACF_DOLOCAL) {
# line 68 "AdaptDoLocal.puma"
{
# line 70 "AdaptDoLocal.puma"
Nesting = 0;
MaxNesting = 0;
found = false;
FindParVariable (t);
if (!found)
{ error_protocol ("No indexed Variable in DOLOCAL");
printf ("DOLOCAL (line=%d), no indexed variable\n", t->ACF_DOLOCAL.Line);
newacf = t;
}
else
{ GetString (TreeVarName(t->ACF_DOLOCAL.DOLOCAL_ID), n);
sprintf (msg, "DOLOCAL %s (line=%d) is scheduled on ", n, t->ACF_DOLOCAL.Line);
tree_protocol (msg, parvar);
newacf = DOLOCAL_do_it (t, parvar, TreeDistribution (parvar));
}
}
return newacf;
}
yyAbort ("TransformDoLocal");
}
static tTree DOLOCAL_do_it
# if defined __STDC__ | defined __cplusplus
(register tTree t, register tTree parvar, register int dist)
# else
(t, parvar, dist)
register tTree t;
register tTree parvar;
register int dist;
# endif
{
# line 102 "AdaptDoLocal.puma"
int i;
tTree pl;
if (t->Kind == kACF_DOLOCAL) {
if (equalint (dist, 0)) {
# line 117 "AdaptDoLocal.puma"
{
# line 121 "AdaptDoLocal.puma"
t->ACF_DOLOCAL.DOLOCAL_BODY = TransformSerialBody (t->ACF_DOLOCAL.DOLOCAL_BODY);
t->Kind = kACF_DOVEC;
}
return t;
}
{
tTree new;
if (equalint (dist, - 1)) {
# line 138 "AdaptDoLocal.puma"
{
# line 142 "AdaptDoLocal.puma"
# line 144 "AdaptDoLocal.puma"
for (i=0;i<MaxNesting;i++)
{ pl = Nest[i];
pl->Kind = kACF_DOVEC;
}
new = mACF_ON (parvar, t);
new->ACF_NODE.Label = t->ACF_DOLOCAL.Label;
new->ACF_NODE.Line = t->ACF_DOLOCAL.Line;
}
{
return new;
}
}
}
if (parvar->Kind == kINDEXED_VAR) {
{
tTree new;
if (equalint (dist, 1)) {
# line 168 "AdaptDoLocal.puma"
{
# line 172 "AdaptDoLocal.puma"
if (! (IsExpLoopId (LastIndex (parvar->INDEXED_VAR.IND_EXPS), t->ACF_DOLOCAL.DOLOCAL_ID))) goto yyL3;
{
# line 176 "AdaptDoLocal.puma"
# line 178 "AdaptDoLocal.puma"
for (i=1;i<MaxNesting;i++)
{ pl = Nest[i];
pl->Kind = kACF_DOVEC;
}
new = mACF_ON (parvar, t);
new->ACF_NODE.Label = t->ACF_DOLOCAL.Label;
new->ACF_NODE.Line = t->ACF_DOLOCAL.Line;
}
}
{
return new;
}
yyL3:;
}
}
{
bool found;
bool error;
int a;
int b;
tTree var;
tTree new;
if (equalint (dist, 1)) {
# line 203 "AdaptDoLocal.puma"
{
# line 205 "AdaptDoLocal.puma"
if (! (IsVarInExp (TreeVarName (t->ACF_DOLOCAL.DOLOCAL_ID), LastIndex (parvar->INDEXED_VAR.IND_EXPS)) == true)) goto yyL4;
{
# line 207 "AdaptDoLocal.puma"
# line 208 "AdaptDoLocal.puma"
# line 209 "AdaptDoLocal.puma"
# line 210 "AdaptDoLocal.puma"
# line 211 "AdaptDoLocal.puma"
# line 212 "AdaptDoLocal.puma"
# line 214 "AdaptDoLocal.puma"
new = t;
ResolveExpression (LastIndex(parvar->INDEXED_VAR.IND_EXPS), &found, &a, &b, &var);
error = ( (!found)
|| (a != 1)
|| (TreeVarName (var) != TreeVarName(t->ACF_DOLOCAL.DOLOCAL_ID))
);
if (!error)
{
stmt_protocol ("loop will be shifted");
tree_protocol ("variable for normalizatin : ", parvar);
NormalLoop (new, b);
stmt_protocol ("loop after shifting");
for (i=1;i<MaxNesting;i++)
{ pl = Nest[i];
pl->Kind = kACF_DOVEC;
}
new = mACF_ON (parvar, t);
new->ACF_NODE.Label = t->ACF_DOLOCAL.Label;
new->ACF_NODE.Line = t->ACF_DOLOCAL.Line;
}
else
{ error_protocol ("parallel do loop has not normal index");
tree_protocol ("lastindex = ", LastIndex (parvar->INDEXED_VAR.IND_EXPS));
tree_protocol ("depends on this loop variable : ", t->ACF_DOLOCAL.DOLOCAL_ID);
}
}
}
{
return new;
}
yyL4:;
}
}
{
tTree new;
if (equalint (dist, 1)) {
# line 264 "AdaptDoLocal.puma"
{
# line 266 "AdaptDoLocal.puma"
if (! (LoopInvariant (LastIndex (parvar->INDEXED_VAR.IND_EXPS)) == true)) goto yyL5;
{
# line 268 "AdaptDoLocal.puma"
# line 270 "AdaptDoLocal.puma"
for (i=0;i<MaxNesting;i++)
{ pl = Nest[i];
pl->Kind = kACF_DOVEC;
}
new = mACF_ON (parvar, t);
new->ACF_NODE.Label = t->ACF_DOLOCAL.Label;
new->ACF_NODE.Line = t->ACF_DOLOCAL.Line;
}
}
{
return new;
}
yyL5:;
}
}
if (equalint (dist, 1)) {
# line 296 "AdaptDoLocal.puma"
{
# line 298 "AdaptDoLocal.puma"
t->ACF_DOLOCAL.DOLOCAL_BODY = TransformSerialBody (t->ACF_DOLOCAL.DOLOCAL_BODY);
t->Kind = kACF_DOVEC;
}
return t;
}
}
}
yyAbort ("DOLOCAL_do_it");
}
static bool IsExpLoopId
# if defined __STDC__ | defined __cplusplus
(register tTree exp, register tTree id)
# else
(exp, id)
register tTree exp;
register tTree id;
# endif
{
if (exp == NoTree) return false;
if (id == NoTree) return false;
if (exp->Kind == kVAR_EXP) {
# line 307 "AdaptDoLocal.puma"
{
# line 308 "AdaptDoLocal.puma"
if (! (TreeVarName (id) == TreeVarName (exp->VAR_EXP.V))) goto yyL1;
}
return true;
yyL1:;
}
return false;
}
static bool LoopInvariant
# if defined __STDC__ | defined __cplusplus
(register tTree exp)
# else
(exp)
register tTree exp;
# endif
{
# line 321 "AdaptDoLocal.puma"
{
tIdent name;
bool it_is;
tTree pl;
int i;
{
# line 323 "AdaptDoLocal.puma"
# line 324 "AdaptDoLocal.puma"
# line 325 "AdaptDoLocal.puma"
# line 326 "AdaptDoLocal.puma"
# line 328 "AdaptDoLocal.puma"
it_is = true;
for (i=0; i<MaxNesting; i++)
{ name = TreeVarName ((Nest[i])->ACF_DOLOCAL.DOLOCAL_ID);
it_is = it_is && (!IsVarInExp (name, exp));
}
}
{
return it_is;
}
}
}
static void FindParVariable
# if defined __STDC__ | defined __cplusplus
(register tTree body)
# else
(body)
register tTree body;
# endif
{
if (body == NoTree) return;
switch (body->Kind) {
case kACF_LIST:
# line 352 "AdaptDoLocal.puma"
{
# line 353 "AdaptDoLocal.puma"
FindParVariable (body->ACF_LIST.Elem);
# line 354 "AdaptDoLocal.puma"
FindParVariable (body->ACF_LIST.Next);
}
return;
case kACF_EMPTY:
# line 357 "AdaptDoLocal.puma"
return;
case kACF_DOLOCAL:
# line 360 "AdaptDoLocal.puma"
{
# line 361 "AdaptDoLocal.puma"
if (Nesting < MaxNesting)
simple_error_protocol ("unstructured parfor nesting");
else
MaxNesting += 1;
Nest [Nesting] = body;
Nesting += 1;
FindParVariable (body->ACF_DOLOCAL.DOLOCAL_BODY);
}
return;
case kACF_IF:
# line 371 "AdaptDoLocal.puma"
{
# line 372 "AdaptDoLocal.puma"
FindParVariable (body->ACF_IF.THEN_PART);
# line 373 "AdaptDoLocal.puma"
FindParVariable (body->ACF_IF.ELSE_PART);
}
return;
case kACF_WHILE:
# line 376 "AdaptDoLocal.puma"
{
# line 377 "AdaptDoLocal.puma"
FindParVariable (body->ACF_WHILE.WHILE_BODY);
}
return;
case kACF_DO:
# line 380 "AdaptDoLocal.puma"
{
# line 381 "AdaptDoLocal.puma"
FindParVariable (body->ACF_DO.DO_BODY);
}
return;
case kACF_BASIC:
if (body->ACF_BASIC.BASIC_STMT->Kind == kREDUCE_STMT) {
if (body->ACF_BASIC.BASIC_STMT->REDUCE_STMT.RED_PARAMS->Kind == kBTP_LIST) {
if (body->ACF_BASIC.BASIC_STMT->REDUCE_STMT.RED_PARAMS->BTP_LIST.Next->Kind == kBTP_LIST) {
# line 384 "AdaptDoLocal.puma"
{
# line 386 "AdaptDoLocal.puma"
FindReduceVariable (body->ACF_BASIC.BASIC_STMT->REDUCE_STMT.RED_PARAMS->BTP_LIST.Next->BTP_LIST.Elem);
}
return;
}
}
}
if (body->ACF_BASIC.BASIC_STMT->Kind == kASSIGN_STMT) {
# line 389 "AdaptDoLocal.puma"
{
# line 390 "AdaptDoLocal.puma"
FindParVariable (body->ACF_BASIC.BASIC_STMT->ASSIGN_STMT.ASSIGN_VAR);
}
return;
}
# line 393 "AdaptDoLocal.puma"
return;
case kACF_DUMMY:
# line 397 "AdaptDoLocal.puma"
return;
case kACF_FORALL:
# line 400 "AdaptDoLocal.puma"
{
# line 401 "AdaptDoLocal.puma"
error_protocol ("FORALL in DO !parallel, should not happen");
}
return;
case kUSED_VAR:
# line 404 "AdaptDoLocal.puma"
return;
case kINDEXED_VAR:
# line 407 "AdaptDoLocal.puma"
{
# line 408 "AdaptDoLocal.puma"
if (found)
{
if ( (TreeDistribution (parvar) != 0)
&& (CountMovements (parvar, body) > 0) )
{ error_protocol ("moving conflict in parallel do loop");
tree_protocol ("parallel (on) variable is : ", parvar);
tree_protocol ("this variable is not conform : ", body);
}
}
else
{ found = true;
parvar = body;
}
}
return;
}
# line 424 "AdaptDoLocal.puma"
{
# line 425 "AdaptDoLocal.puma"
printf ("FindParVariable failed for \n");
# line 426 "AdaptDoLocal.puma"
FileUnparse (stdout, body);
# line 427 "AdaptDoLocal.puma"
WriteTree (stdout, body);
# line 428 "AdaptDoLocal.puma"
exit (- 1);
}
return;
;
}
static void FindReduceVariable
# if defined __STDC__ | defined __cplusplus
(register tTree body)
# else
(body)
register tTree body;
# endif
{
# line 435 "AdaptDoLocal.puma"
tTree reducevar;
if (body == NoTree) return;
if (body->Kind == kVAR_PARAM) {
if (body->VAR_PARAM.V->Kind == kADDR) {
# line 441 "AdaptDoLocal.puma"
{
# line 442 "AdaptDoLocal.puma"
FindReduceVariable (body->VAR_PARAM.V->ADDR.E);
}
return;
}
# line 445 "AdaptDoLocal.puma"
{
# line 446 "AdaptDoLocal.puma"
FindParVariable (body->VAR_PARAM.V);
}
return;
}
if (body->Kind == kVAR_EXP) {
# line 449 "AdaptDoLocal.puma"
{
# line 450 "AdaptDoLocal.puma"
FindParVariable (body->VAR_EXP.V);
}
return;
}
if (body->Kind == kOP_EXP) {
# line 453 "AdaptDoLocal.puma"
{
# line 454 "AdaptDoLocal.puma"
FindReduceVariable (body->OP_EXP.OPND1);
# line 455 "AdaptDoLocal.puma"
FindReduceVariable (body->OP_EXP.OPND2);
}
return;
}
if (body->Kind == kOP1_EXP) {
# line 458 "AdaptDoLocal.puma"
{
# line 459 "AdaptDoLocal.puma"
FindReduceVariable (body->OP1_EXP.OPND);
}
return;
}
if (body->Kind == kCONST_EXP) {
# line 462 "AdaptDoLocal.puma"
return;
}
if (body->Kind == kFUNC_CALL_EXP) {
if (body->FUNC_CALL_EXP.FUNC_PARAMS->Kind == kBTP_LIST) {
if (body->FUNC_CALL_EXP.FUNC_PARAMS->BTP_LIST.Elem->Kind == kVAR_PARAM) {
# line 465 "AdaptDoLocal.puma"
{
# line 466 "AdaptDoLocal.puma"
if (IsIntrFunc (body))
{ if (IntrFuncKind1 (body->FUNC_CALL_EXP.FUNC_ID->PROC_OBJ.Ident))
{
FindReduceVariable (body->FUNC_CALL_EXP.FUNC_PARAMS->BTP_LIST.Elem);
}
else
error_protocol ("no reduce variable found in intr func call");
}
else
error_protocol ("no reduce variable found in func call");
}
return;
}
}
}
# line 480 "AdaptDoLocal.puma"
{
# line 481 "AdaptDoLocal.puma"
printf ("Find Reduce Variable failed for \n");
# line 482 "AdaptDoLocal.puma"
FileUnparse (stdout, body);
# line 483 "AdaptDoLocal.puma"
WriteTree (stdout, body);
}
return;
;
}
static tTree CollectREDUCE
# if defined __STDC__ | defined __cplusplus
(register tTree t)
# else
(t)
register tTree t;
# endif
{
# line 501 "AdaptDoLocal.puma"
tTree newacf;
switch (t->Kind) {
case kACF_DOLOCAL:
# line 505 "AdaptDoLocal.puma"
return CollectREDUCE (t->ACF_DOLOCAL.DOLOCAL_BODY);
case kACF_LIST:
# line 509 "AdaptDoLocal.puma"
return (CombineACF (CollectREDUCE (t->ACF_LIST.Elem), CollectREDUCE (t->ACF_LIST.Next)));
case kACF_EMPTY:
# line 513 "AdaptDoLocal.puma"
return NoTree;
case kACF_IF:
# line 517 "AdaptDoLocal.puma"
return (CombineACF (CollectREDUCE (t->ACF_IF.THEN_PART), CollectREDUCE (t->ACF_IF.ELSE_PART)));
case kACF_WHILE:
# line 521 "AdaptDoLocal.puma"
return CollectREDUCE (t->ACF_WHILE.WHILE_BODY);
case kACF_DO:
# line 525 "AdaptDoLocal.puma"
return CollectREDUCE (t->ACF_DO.DO_BODY);
case kACF_BASIC:
if (t->ACF_BASIC.BASIC_STMT->Kind == kREDUCE_STMT) {
if (t->ACF_BASIC.BASIC_STMT->REDUCE_STMT.RED_PARAMS->Kind == kBTP_LIST) {
if (t->ACF_BASIC.BASIC_STMT->REDUCE_STMT.RED_PARAMS->BTP_LIST.Elem->Kind == kVAR_PARAM) {
if (t->ACF_BASIC.BASIC_STMT->REDUCE_STMT.RED_PARAMS->BTP_LIST.Next->Kind == kBTP_LIST) {
if (t->ACF_BASIC.BASIC_STMT->REDUCE_STMT.RED_PARAMS->BTP_LIST.Next->BTP_LIST.Next->Kind == kBTP_EMPTY) {
# line 529 "AdaptDoLocal.puma"
return GlobalReductionStmt (t->ACF_BASIC.BASIC_STMT->REDUCE_STMT.RED_PARAMS->BTP_LIST.Elem->VAR_PARAM.V, TreeType (t->ACF_BASIC.BASIC_STMT->REDUCE_STMT.RED_PARAMS->BTP_LIST.Elem->VAR_PARAM.V), t->ACF_BASIC.BASIC_STMT->REDUCE_STMT.RED_FUNC);
}
# line 537 "AdaptDoLocal.puma"
return CombineACF (GlobalLocReductionStmt (t->ACF_BASIC.BASIC_STMT->REDUCE_STMT.RED_PARAMS->BTP_LIST.Elem->VAR_PARAM.V, TreeType (t->ACF_BASIC.BASIC_STMT->REDUCE_STMT.RED_PARAMS->BTP_LIST.Elem->VAR_PARAM.V), t->ACF_BASIC.BASIC_STMT->
REDUCE_STMT.RED_FUNC), GlobalLocExchange (t->ACF_BASIC.BASIC_STMT->REDUCE_STMT.RED_PARAMS->BTP_LIST.Next->BTP_LIST.Next));
}
}
}
}
# line 546 "AdaptDoLocal.puma"
return NoTree;
}
yyAbort ("CollectREDUCE");
}
static tTree GlobalLocExchange
# if defined __STDC__ | defined __cplusplus
(register tTree params)
# else
(params)
register tTree params;
# endif
{
# line 554 "AdaptDoLocal.puma"
tTree newparams, stmt;
if (params->Kind == kBTP_EMPTY) {
# line 558 "AdaptDoLocal.puma"
return NoTree;
}
if (params->Kind == kBTP_LIST) {
if (params->BTP_LIST.Elem->Kind == kVAR_PARAM) {
if (params->BTP_LIST.Next->Kind == kBTP_LIST) {
# line 562 "AdaptDoLocal.puma"
{
# line 564 "AdaptDoLocal.puma"
newparams = mBTP_EMPTY () ;
newparams = mBTP_LIST (ExpToVarParam (MakeSizeExp(params->BTP_LIST.Elem->VAR_PARAM.V)), newparams);
newparams = mBTP_LIST (mVAR_PARAM (params->BTP_LIST.Elem->VAR_PARAM.V), newparams);
stmt = mPROC_OBJ (MakeDalibId ("loc_exchange"));
stmt = mACF_BASIC (mCALL_STMT (stmt, newparams));
}
return CombineACF (stmt, GlobalLocExchange (params->BTP_LIST.Next->BTP_LIST.Next));
}
}
}
yyAbort ("GlobalLocExchange");
}
static tTree TransformSerialBody
# if defined __STDC__ | defined __cplusplus
(register tTree t)
# else
(t)
register tTree t;
# endif
{
switch (t->Kind) {
case kACF_LIST:
# line 590 "AdaptDoLocal.puma"
{
tTree newacf;
{
# line 592 "AdaptDoLocal.puma"
# line 594 "AdaptDoLocal.puma"
newacf = TransformSerialBody (t->ACF_LIST.Elem);
t->ACF_LIST.Next = TransformSerialBody (t->ACF_LIST.Next);
newacf = ReplaceACF (t, newacf, t->ACF_LIST.Next);
}
{
return newacf;
}
}
case kACF_EMPTY:
# line 601 "AdaptDoLocal.puma"
return t;
case kACF_IF:
# line 605 "AdaptDoLocal.puma"
{
# line 606 "AdaptDoLocal.puma"
t->ACF_IF.THEN_PART = TransformSerialBody (t->ACF_IF.THEN_PART);
t->ACF_IF.ELSE_PART = TransformSerialBody (t->ACF_IF.ELSE_PART);
}
return t;
case kACF_WHILE:
# line 612 "AdaptDoLocal.puma"
{
# line 613 "AdaptDoLocal.puma"
t->ACF_WHILE.WHILE_BODY = TransformSerialBody (t->ACF_WHILE.WHILE_BODY);
}
return t;
case kACF_DO:
# line 617 "AdaptDoLocal.puma"
{
# line 618 "AdaptDoLocal.puma"
t->ACF_DO.DO_BODY = TransformSerialBody (t->ACF_DO.DO_BODY);
}
return t;
case kACF_DOLOCAL:
# line 622 "AdaptDoLocal.puma"
return TransformDoLocal (t);
case kACF_BASIC:
if (t->ACF_BASIC.BASIC_STMT->Kind == kREDUCE_STMT) {
# line 626 "AdaptDoLocal.puma"
return ResolveReduce (t);
}
# line 630 "AdaptDoLocal.puma"
return t;
case kACF_DUMMY:
# line 634 "AdaptDoLocal.puma"
return t;
}
# line 638 "AdaptDoLocal.puma"
{
# line 639 "AdaptDoLocal.puma"
failure_protocol ("AdaptDoLocal", "TransformSerialBody", t);
}
return NoTree;
}
void BeginAdaptDoLocal ()
{
}
void CloseAdaptDoLocal ()
{
}