home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
OS/2 Shareware BBS: 10 Tools
/
10-Tools.zip
/
adaptor.zip
/
adapt.zip
/
adaptor
/
src
/
adaptvar.c
< prev
next >
Wrap
Text File
|
1994-01-03
|
30KB
|
1,335 lines
# include "Vars.h"
# include "yyAVars.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 43 "AdaptVars.puma"
# include <stdio.h>
# include "Idents.h"
# include "StringMe.h"
# include "protocol.h"
# include "Types.h" /* VarSize, VarRank, ... */
# include "Transfor.h" /* IsHost, CombineACF, .... */
# include "Dalib.h" /* MakeVarDecl, ... */
# include "Expressi.h" /* AddConstant, MakeConstant */
# include "MakeStAa.h" /* InsertStaticDecls, MakeInitialStatic */
tIdent GlobalId; /* used to generate name_low, name_high */
tTree NewDefines; /* stmts for a_low, a_high, a_os */
static FILE * yyf = stdout;
static void yyAbort
# ifdef __cplusplus
(char * yyFunction)
# else
(yyFunction) char * yyFunction;
# endif
{
(void) fprintf (stderr, "Error: module AdaptVars, routine %s failed\n", yyFunction);
exit (1);
}
tTree AdaptVarDecl ARGS((tTree t, int dist, bool IsMain));
tTree AdaptParamDecl ARGS((tTree t, int dist));
static void SetUpOverlap ARGS((tTree t));
static void ChangeArraySpecification ARGS((tTree v, tDefinitions Obj, bool IsMain));
static void MakeStaticDistributedStmts ARGS((tTree var, tDefinitions obj, bool IsMain));
static void StaticDistributedVarStmts ARGS((tTree v, tTree dist_index));
static tTree MakeNewDummyRange ARGS((tTree val, tIdent name));
static tTree MakeNewLocalRange ARGS((tTree val));
static int GetMaxSize ARGS((tTree index));
tTree AdaptCommonVarDecl ARGS((tTree t, int dist));
static tTree InsertRangeDecls ARGS((tTree decls, tIdent A));
static tTree InsertSpecDecls ARGS((tTree decls, tIdent A, tTree type));
tTree AdaptAllocate ARGS((tTree t, bool IsMain));
static void OverlapAllocate ARGS((tTree t));
static void OverlapAllocateBounds ARGS((tTree actuals, tTree formals));
static tTree OverlapSlice ARGS((tTree slice, int left_ovlp, int right_ovlp));
tTree AdaptDeallocate ARGS((tTree t, bool IsMain));
static tTree GenAllocExtensions ARGS((tIdent id));
static tTree GenAllocStmt ARGS((tTree t));
static tTree GenDeallocStmt ARGS((tTree t));
static tTree MakeRangeParameters ARGS((tTree range_list, tTree end_params));
tTree AdaptVarDecl
# if defined __STDC__ | defined __cplusplus
(register tTree t, register int dist, register bool IsMain)
# else
(t, dist, IsMain)
register tTree t;
register int dist;
register bool IsMain;
# endif
{
# line 72 "AdaptVars.puma"
tTree newdecl, int4;
tObject Obj;
if (t->Kind == kVAR_DECL) {
if (equalint (dist, 0)) {
# line 77 "AdaptVars.puma"
{
# line 78 "AdaptVars.puma"
SetUpOverlap (t->VAR_DECL.VAL);
}
return t;
}
if (equalint (dist, - 1)) {
# line 92 "AdaptVars.puma"
{
# line 94 "AdaptVars.puma"
if (! ((IsHost == true))) goto yyL2;
{
# line 96 "AdaptVars.puma"
SetUpOverlap (t->VAR_DECL.VAL);
}
}
return t;
yyL2:;
}
if (equalint (dist, - 1)) {
# line 110 "AdaptVars.puma"
return NoTree;
}
if (equalint (dist, 1)) {
# line 125 "AdaptVars.puma"
{
# line 127 "AdaptVars.puma"
if (! ((IsHost == true))) goto yyL4;
}
return NoTree;
yyL4:;
}
{
bool is_static;
if (equalint (dist, 1)) {
# line 143 "AdaptVars.puma"
{
# line 147 "AdaptVars.puma"
# line 149 "AdaptVars.puma"
Obj = GetLocalDecl (t->VAR_DECL.Name);
int4 = mINTEGER_TYPE (4);
newdecl = mDECL_LIST (t, NoTree);
is_static = ((!IsVarAllocatable(Obj)) && (!IsVarDummy(Obj)));
if (is_static)
newdecl = InsertStaticDecls (t->VAR_DECL.Name, 1, int4, newdecl);
newdecl = InsertRangeDecls (newdecl, t->VAR_DECL.Name);
newdecl = InsertSpecDecls (newdecl, t->VAR_DECL.Name, int4);
MakeStaticDistributedStmts (t, Obj, IsMain);
ChangeArraySpecification (t, Obj, IsMain);
}
{
return newdecl;
}
}
}
}
# line 179 "AdaptVars.puma"
{
# line 180 "AdaptVars.puma"
printf ("Can not adapt Variable Declaration\n");
# line 181 "AdaptVars.puma"
FileUnparse (stdout, t);
# line 182 "AdaptVars.puma"
WriteTree (stdout, t);
}
return t;
}
tTree AdaptParamDecl
# if defined __STDC__ | defined __cplusplus
(register tTree t, register int dist)
# else
(t, dist)
register tTree t;
register int dist;
# endif
{
if (t->Kind == kVAR_PARAM_DECL) {
if (equalint (dist, 0)) {
# line 194 "AdaptVars.puma"
return t;
}
if (equalint (dist, - 1)) {
# line 198 "AdaptVars.puma"
{
# line 199 "AdaptVars.puma"
if (! ((IsHost == true))) goto yyL2;
}
return t;
yyL2:;
}
if (equalint (dist, - 1)) {
# line 203 "AdaptVars.puma"
return NoTree;
}
if (equalint (dist, 1)) {
# line 216 "AdaptVars.puma"
{
# line 219 "AdaptVars.puma"
if (! ((IsHost == true))) goto yyL4;
}
return NoTree;
yyL4:;
}
{
tTree newdecl;
if (equalint (dist, 1)) {
# line 235 "AdaptVars.puma"
{
# line 237 "AdaptVars.puma"
# line 240 "AdaptVars.puma"
newdecl = NoTree;
newdecl = mDECL_LIST (MakeVarParamDeclA (t->VAR_PARAM_DECL.Name, "_HIGH"), newdecl);
newdecl = mDECL_LIST (MakeVarParamDeclA (t->VAR_PARAM_DECL.Name, "_LOW"), newdecl);
newdecl = mDECL_LIST (t, newdecl);
}
{
return newdecl;
}
}
}
}
# line 248 "AdaptVars.puma"
{
# line 249 "AdaptVars.puma"
printf ("AdaptParamDecl fails, Distribution = %d\n", dist);
# line 250 "AdaptVars.puma"
FileUnparse (stdout, t);
# line 251 "AdaptVars.puma"
WriteTree (stdout, t);
# line 252 "AdaptVars.puma"
exit (- 1);
}
return t;
}
static void SetUpOverlap
# if defined __STDC__ | defined __cplusplus
(register tTree t)
# else
(t)
register tTree t;
# endif
{
if (t == NoTree) return;
if (t->Kind == kARRAY_TYPE) {
# line 267 "AdaptVars.puma"
{
# line 268 "AdaptVars.puma"
SetUpOverlap (t->ARRAY_TYPE.ARRAY_INDEX_TYPES);
}
return;
}
if (t->Kind == kTYPE_LIST) {
# line 271 "AdaptVars.puma"
{
# line 272 "AdaptVars.puma"
SetUpOverlap (t->TYPE_LIST.Elem);
# line 273 "AdaptVars.puma"
SetUpOverlap (t->TYPE_LIST.Next);
}
return;
}
if (t->Kind == kTYPE_EMPTY) {
# line 276 "AdaptVars.puma"
return;
}
if (t->Kind == kDYNAMIC) {
# line 279 "AdaptVars.puma"
return;
}
if (t->Kind == kINDEX_TYPE) {
# line 282 "AdaptVars.puma"
{
# line 284 "AdaptVars.puma"
t->INDEX_TYPE.LOWER = AddConstant (t->INDEX_TYPE.LOWER, -t->INDEX_TYPE.left_overlap);
t->INDEX_TYPE.UPPER = AddConstant (t->INDEX_TYPE.UPPER, t->INDEX_TYPE.right_overlap);
}
return;
}
;
}
static void ChangeArraySpecification
# if defined __STDC__ | defined __cplusplus
(register tTree v, register tDefinitions Obj, register bool IsMain)
# else
(v, Obj, IsMain)
register tTree v;
register tDefinitions Obj;
register bool IsMain;
# endif
{
if (v == NoTree) return;
if (Obj == NoDefinitions) return;
if (v->Kind == kVAR_DECL) {
if (Obj->Kind == kVarObject) {
if (Obj->VarObject.decl->Kind == kVAR_PARAM_DECL) {
# line 314 "AdaptVars.puma"
{
# line 317 "AdaptVars.puma"
v->VAR_DECL.VAL = MakeNewDummyRange (v->VAR_DECL.VAL, v->VAR_DECL.Name);
}
return;
}
}
if (v->VAR_DECL.VAL->Kind == kARRAY_TYPE) {
if (Obj->Kind == kVarObject) {
if (Obj->VarObject.decl->Kind == kVAR_DECL) {
# line 329 "AdaptVars.puma"
{
# line 332 "AdaptVars.puma"
if (! ((IsVarAllocatable (Obj) != true))) goto yyL2;
{
# line 336 "AdaptVars.puma"
v->VAR_DECL.VAL = MakeNewLocalRange (v->VAR_DECL.VAL);
SetUpOverlap (v->VAR_DECL.VAL);
}
}
return;
yyL2:;
}
}
}
}
;
}
static void MakeStaticDistributedStmts
# if defined __STDC__ | defined __cplusplus
(register tTree var, register tDefinitions obj, register bool IsMain)
# else
(var, obj, IsMain)
register tTree var;
register tDefinitions obj;
register bool IsMain;
# endif
{
if (var == NoTree) return;
if (obj == NoDefinitions) return;
if (var->Kind == kVAR_DECL) {
if (var->VAR_DECL.VAL->Kind == kARRAY_TYPE) {
if (obj->Kind == kVarObject) {
if (obj->VarObject.decl->Kind == kVAR_DECL) {
# line 352 "AdaptVars.puma"
{
# line 357 "AdaptVars.puma"
if (! ((! IsVarAllocatable (obj)))) goto yyL1;
{
# line 358 "AdaptVars.puma"
if (! (((! IsVarCommon (obj)) || IsMain))) goto yyL1;
{
# line 360 "AdaptVars.puma"
StaticDistributedVarStmts (var, LastIndex (var->VAR_DECL.VAL->ARRAY_TYPE.ARRAY_INDEX_TYPES));
}
}
}
return;
yyL1:;
}
}
}
}
;
}
static void StaticDistributedVarStmts
# if defined __STDC__ | defined __cplusplus
(register tTree v, register tTree dist_index)
# else
(v, dist_index)
register tTree v;
register tTree dist_index;
# endif
{
if (v == NoTree) return;
if (dist_index == NoTree) return;
if (v->Kind == kVAR_DECL) {
# line 371 "AdaptVars.puma"
{
# line 372 "AdaptVars.puma"
if (! ((IsHost == true))) goto yyL1;
}
return;
yyL1:;
if (v->VAR_DECL.VAL->Kind == kARRAY_TYPE) {
if (dist_index->Kind == kINDEX_TYPE) {
# line 384 "AdaptVars.puma"
{
tTree stmts;
tTree lb;
tTree ub;
{
# line 387 "AdaptVars.puma"
# line 388 "AdaptVars.puma"
# line 389 "AdaptVars.puma"
# line 391 "AdaptVars.puma"
lb = mVAR_EXP (MakeUsedVarA (v->VAR_DECL.Name, "_LOW"));
ub = mVAR_EXP (MakeUsedVarA (v->VAR_DECL.Name, "_HIGH"));
stmts = MakeInitialStatic (v->VAR_DECL.Name, lb, ub, dist_index->INDEX_TYPE.left_overlap + dist_index->INDEX_TYPE.right_overlap);
stmts = mACF_LIST (GenAllocExtensions (v->VAR_DECL.Name), stmts);
NewDefines = CombineACF (NewDefines, stmts);
}
return;
}
}
}
}
;
}
static tTree MakeNewDummyRange
# if defined __STDC__ | defined __cplusplus
(register tTree val, register tIdent name)
# else
(val, name)
register tTree val;
register tIdent name;
# endif
{
if (val->Kind == kARRAY_TYPE) {
# line 410 "AdaptVars.puma"
return mARRAY_TYPE (MakeNewDummyRange (val->ARRAY_TYPE.ARRAY_INDEX_TYPES, name), val->ARRAY_TYPE.ARRAY_COMP_TYPE);
}
if (val->Kind == kTYPE_LIST) {
if (val->TYPE_LIST.Elem->Kind == kINDEX_TYPE) {
if (val->TYPE_LIST.Next->Kind == kTYPE_EMPTY) {
# line 414 "AdaptVars.puma"
{
tTree new;
{
# line 420 "AdaptVars.puma"
# line 422 "AdaptVars.puma"
new = mINDEX_TYPE (mVAR_EXP (MakeUsedVarA (name,"_LOW")),
mVAR_EXP (MakeUsedVarA (name,"_HIGH")));
}
{
return mTYPE_LIST (new, mTYPE_EMPTY ());
}
}
}
}
# line 428 "AdaptVars.puma"
return mTYPE_LIST (val->TYPE_LIST.Elem, MakeNewDummyRange (val->TYPE_LIST.Next, name));
}
# line 432 "AdaptVars.puma"
{
# line 433 "AdaptVars.puma"
printf ("Error in MakeNewDummyRange\n");
# line 434 "AdaptVars.puma"
FileUnparse (stdout, val);
# line 435 "AdaptVars.puma"
WriteTree (stdout, val);
}
return NoTree;
}
static tTree MakeNewLocalRange
# if defined __STDC__ | defined __cplusplus
(register tTree val)
# else
(val)
register tTree val;
# endif
{
if (val->Kind == kARRAY_TYPE) {
# line 447 "AdaptVars.puma"
return mARRAY_TYPE (MakeNewLocalRange (val->ARRAY_TYPE.ARRAY_INDEX_TYPES), val->ARRAY_TYPE.ARRAY_COMP_TYPE);
}
if (val->Kind == kTYPE_LIST) {
if (val->TYPE_LIST.Elem->Kind == kINDEX_TYPE) {
if (val->TYPE_LIST.Next->Kind == kTYPE_EMPTY) {
# line 451 "AdaptVars.puma"
{
tTree new;
{
# line 459 "AdaptVars.puma"
# line 461 "AdaptVars.puma"
new = mINDEX_TYPE (MakeConstant (1),
MakeConstant (GetMaxSize (val->TYPE_LIST.Elem)));
new->INDEX_TYPE.left_overlap = val->TYPE_LIST.Elem->INDEX_TYPE.left_overlap;
new->INDEX_TYPE.right_overlap = val->TYPE_LIST.Elem->INDEX_TYPE.right_overlap;
}
{
return mTYPE_LIST (new, mTYPE_EMPTY ());
}
}
}
}
# line 470 "AdaptVars.puma"
return mTYPE_LIST (val->TYPE_LIST.Elem, MakeNewLocalRange (val->TYPE_LIST.Next));
}
# line 474 "AdaptVars.puma"
{
# line 475 "AdaptVars.puma"
printf ("Error in MakeNewLocalRange\n");
# line 476 "AdaptVars.puma"
FileUnparse (stdout, val);
# line 477 "AdaptVars.puma"
WriteTree (stdout, val);
}
return NoTree;
}
static int GetMaxSize
# if defined __STDC__ | defined __cplusplus
(register tTree index)
# else
(index)
register tTree index;
# endif
{
if (index->Kind == kINDEX_TYPE) {
# line 489 "AdaptVars.puma"
{
int val;
int val1;
bool found;
{
# line 491 "AdaptVars.puma"
# line 492 "AdaptVars.puma"
# line 493 "AdaptVars.puma"
# line 495 "AdaptVars.puma"
GetIntConstValue (index->INDEX_TYPE.LOWER, &found, &val);
if (!found)
{ printf ("AdaptVars: GetMaxSize has not found lower bound\n");
WriteTree (stdout, index);
exit (-1);
}
GetIntConstValue (index->INDEX_TYPE.UPPER, &found, &val1);
if (!found)
{ printf ("AdaptVars: GetMaxSize has not found upper bound\n");
WriteTree (stdout, index);
exit (-1);
}
val = val1 - val + 1;
val = (val + MinProc - 1) / MinProc;
}
{
return val;
}
}
}
yyAbort ("GetMaxSize");
}
tTree AdaptCommonVarDecl
# if defined __STDC__ | defined __cplusplus
(register tTree t, register int dist)
# else
(t, dist)
register tTree t;
register int dist;
# endif
{
if (t->Kind == kVAR_DECL) {
if (equalint (dist, 0)) {
# line 532 "AdaptVars.puma"
return t;
}
if (equalint (dist, 1)) {
# line 550 "AdaptVars.puma"
{
# line 552 "AdaptVars.puma"
if (! ((IsHost == true))) goto yyL4;
}
return NoTree;
yyL4:;
}
{
tTree newdecl;
tTree dummy;
if (equalint (dist, 1)) {
# line 556 "AdaptVars.puma"
{
# line 558 "AdaptVars.puma"
# line 559 "AdaptVars.puma"
# line 561 "AdaptVars.puma"
dummy = mDUMMY_TYPE ();
# line 563 "AdaptVars.puma"
newdecl = InsertStaticDecls (t->VAR_DECL.Name, 1, dummy, NoTree);
newdecl = InsertSpecDecls (newdecl, t->VAR_DECL.Name, dummy);
newdecl = mDECL_LIST (t, newdecl);
}
{
return newdecl;
}
}
}
}
if (t->Kind == kVAR_PARAM_DECL) {
if (equalint (dist, - 1)) {
# line 539 "AdaptVars.puma"
{
# line 541 "AdaptVars.puma"
if (! ((IsHost == true))) goto yyL2;
}
return t;
yyL2:;
}
if (equalint (dist, - 1)) {
# line 545 "AdaptVars.puma"
return NoTree;
}
}
yyAbort ("AdaptCommonVarDecl");
}
static tTree InsertRangeDecls
# if defined __STDC__ | defined __cplusplus
(register tTree decls, register tIdent A)
# else
(decls, A)
register tTree decls;
register tIdent A;
# endif
{
# line 585 "AdaptVars.puma"
{
tTree new;
tTree int4;
{
# line 587 "AdaptVars.puma"
# line 588 "AdaptVars.puma"
# line 590 "AdaptVars.puma"
int4 = mINTEGER_TYPE (4);
# line 591 "AdaptVars.puma"
new = mDECL_LIST (MakeVarDeclA (A, "_INC", int4), decls);
# line 592 "AdaptVars.puma"
new = mDECL_LIST (MakeVarDeclA (A, "_STOP", int4), new);
# line 593 "AdaptVars.puma"
new = mDECL_LIST (MakeVarDeclA (A, "_START", int4), new);
}
{
return new;
}
}
}
static tTree InsertSpecDecls
# if defined __STDC__ | defined __cplusplus
(register tTree decls, register tIdent A, register tTree type)
# else
(decls, A, type)
register tTree decls;
register tIdent A;
register tTree type;
# endif
{
# line 606 "AdaptVars.puma"
{
# line 607 "AdaptVars.puma"
if (! ((IsHost == true))) goto yyL1;
}
return decls;
yyL1:;
# line 617 "AdaptVars.puma"
{
tTree newdecl;
{
# line 619 "AdaptVars.puma"
# line 621 "AdaptVars.puma"
newdecl = mDECL_LIST (MakeVarDeclA (A, "_HIGH", type), decls);
newdecl = mDECL_LIST (MakeVarDeclA (A, "_LOW", type), newdecl);
}
{
return newdecl;
}
}
}
tTree AdaptAllocate
# if defined __STDC__ | defined __cplusplus
(register tTree t, register bool IsMain)
# else
(t, IsMain)
register tTree t;
register bool IsMain;
# endif
{
# line 635 "AdaptVars.puma"
tTree hdef, defines;
int dist;
if (t->Kind == kBTP_LIST) {
if (t->BTP_LIST.Elem->Kind == kVAR_PARAM) {
# line 642 "AdaptVars.puma"
{
# line 643 "AdaptVars.puma"
dist = TreeDistribution (t->BTP_LIST.Elem->VAR_PARAM.V);
if (dist == 0)
{
hdef = mBTP_LIST (t->BTP_LIST.Elem, mBTP_EMPTY());
defines = mACF_BASIC (mALLOCATE_STMT (hdef, mDUMMY_VAR()));
OverlapAllocate (defines);
}
else if (dist == -1)
{ if (IsHost)
{
hdef = mBTP_LIST (t->BTP_LIST.Elem, mBTP_EMPTY());
defines = mACF_BASIC (mALLOCATE_STMT (hdef, mDUMMY_VAR()));
OverlapAllocate (defines);
}
else defines = NoTree;
}
else if (dist == 1)
{ defines = AdaptAllocate (t->BTP_LIST.Elem->VAR_PARAM.V, IsMain); }
else { printf ("Illegal distribution in allocate statement\n");
defines = NoTree;
}
# line 665 "AdaptVars.puma"
defines = CombineACF (defines, AdaptAllocate (t->BTP_LIST.Next, IsMain));
}
return defines;
}
}
if (t->Kind == kBTP_EMPTY) {
# line 669 "AdaptVars.puma"
return NoTree;
}
if (t->Kind == kINDEXED_VAR) {
if (t->INDEXED_VAR.IND_VAR->Kind == kUSED_VAR) {
# line 673 "AdaptVars.puma"
{
# line 674 "AdaptVars.puma"
if (! ( t->INDEXED_VAR.IND_VAR->USED_VAR.VARNAME->VAR_OBJ.Object->VarObject.Kind->Kind == kVarCommon)) goto yyL3;
{
# line 675 "AdaptVars.puma"
if (! (IsMain == false)) goto yyL3;
}
}
return NoTree;
yyL3:;
if (Definitions_IsType (t->INDEXED_VAR.IND_VAR->USED_VAR.VARNAME->VAR_OBJ.Object, kObject)) {
# line 679 "AdaptVars.puma"
{
# line 680 "AdaptVars.puma"
if (!IsHost)
{
defines = mACF_LIST (GenAllocStmt (t), NoTree);
defines = mACF_LIST (GenAllocExtensions (t->INDEXED_VAR.IND_VAR->USED_VAR.VARNAME->VAR_OBJ.Ident), defines);
}
else defines = NoTree;
}
return defines;
}
}
}
# line 691 "AdaptVars.puma"
{
# line 692 "AdaptVars.puma"
printf ("Illegal Construct in GenAllocate\n");
# line 693 "AdaptVars.puma"
FileUnparse (stdout, t);
}
return t;
}
static void OverlapAllocate
# if defined __STDC__ | defined __cplusplus
(register tTree t)
# else
(t)
register tTree t;
# endif
{
if (t == NoTree) return;
if (t->Kind == kACF_BASIC) {
# line 707 "AdaptVars.puma"
{
# line 708 "AdaptVars.puma"
OverlapAllocate (t->ACF_BASIC.BASIC_STMT);
}
return;
}
if (t->Kind == kALLOCATE_STMT) {
# line 711 "AdaptVars.puma"
{
# line 712 "AdaptVars.puma"
OverlapAllocate (t->ALLOCATE_STMT.PARAMS);
}
return;
}
if (t->Kind == kBTP_LIST) {
if (t->BTP_LIST.Elem->Kind == kVAR_PARAM) {
# line 715 "AdaptVars.puma"
{
# line 716 "AdaptVars.puma"
OverlapAllocate (t->BTP_LIST.Elem->VAR_PARAM.V);
# line 717 "AdaptVars.puma"
OverlapAllocate (t->BTP_LIST.Next);
}
return;
}
}
if (t->Kind == kBTP_EMPTY) {
# line 720 "AdaptVars.puma"
return;
}
if (t->Kind == kINDEXED_VAR) {
if (t->INDEXED_VAR.IND_VAR->Kind == kUSED_VAR) {
# line 723 "AdaptVars.puma"
{
# line 724 "AdaptVars.puma"
OverlapAllocateBounds (t->INDEXED_VAR.IND_EXPS, ArrayFormals (t->INDEXED_VAR.IND_VAR->USED_VAR.VARNAME->VAR_OBJ.Object));
}
return;
}
}
;
}
static void OverlapAllocateBounds
# if defined __STDC__ | defined __cplusplus
(register tTree actuals, register tTree formals)
# else
(actuals, formals)
register tTree actuals;
register tTree formals;
# endif
{
if (actuals == NoTree) return;
if (formals == NoTree) return;
if (actuals->Kind == kBTE_LIST) {
if (formals->Kind == kTYPE_LIST) {
if (formals->TYPE_LIST.Elem->Kind == kDYNAMIC) {
# line 735 "AdaptVars.puma"
{
# line 737 "AdaptVars.puma"
actuals->BTE_LIST.Elem = OverlapSlice (actuals->BTE_LIST.Elem, formals->TYPE_LIST.Elem->DYNAMIC.left_overlap, formals->TYPE_LIST.Elem->DYNAMIC.right_overlap);
# line 738 "AdaptVars.puma"
OverlapAllocateBounds (actuals->BTE_LIST.Next, formals->TYPE_LIST.Next);
}
return;
}
}
}
if (actuals->Kind == kBTE_EMPTY) {
if (formals->Kind == kTYPE_EMPTY) {
# line 741 "AdaptVars.puma"
return;
}
}
# line 744 "AdaptVars.puma"
{
# line 745 "AdaptVars.puma"
printf ("OverlapAllocateBounds failed\n");
# line 746 "AdaptVars.puma"
WriteTree (stdout, actuals);
# line 747 "AdaptVars.puma"
WriteTree (stdout, formals);
# line 748 "AdaptVars.puma"
kill_in_protocol ();
}
return;
;
}
static tTree OverlapSlice
# if defined __STDC__ | defined __cplusplus
(register tTree slice, register int left_ovlp, register int right_ovlp)
# else
(slice, left_ovlp, right_ovlp)
register tTree slice;
register int left_ovlp;
register int right_ovlp;
# endif
{
if (slice->Kind == kSLICE_EXP) {
# line 761 "AdaptVars.puma"
return mSLICE_EXP (AddConstant (slice->SLICE_EXP.START, - left_ovlp), AddConstant (slice->SLICE_EXP.STOP, right_ovlp), slice->SLICE_EXP.INC);
}
yyAbort ("OverlapSlice");
}
tTree AdaptDeallocate
# if defined __STDC__ | defined __cplusplus
(register tTree t, register bool IsMain)
# else
(t, IsMain)
register tTree t;
register bool IsMain;
# endif
{
# line 775 "AdaptVars.puma"
tTree hdef, defines;
int dist;
if (t->Kind == kBTP_LIST) {
if (t->BTP_LIST.Elem->Kind == kVAR_PARAM) {
# line 782 "AdaptVars.puma"
{
# line 783 "AdaptVars.puma"
dist = TreeDistribution (t->BTP_LIST.Elem->VAR_PARAM.V);
if (dist == 0)
{
hdef = mBTP_LIST (t->BTP_LIST.Elem, mBTP_EMPTY());
defines = mACF_BASIC (mDEALLOCATE_STMT (hdef, mDUMMY_VAR()));
}
else if (dist == -1)
{ if (IsHost)
{
hdef = mBTP_LIST (t->BTP_LIST.Elem, mBTP_EMPTY());
defines = mACF_BASIC (mDEALLOCATE_STMT (hdef, mDUMMY_VAR()));
}
else defines = NoTree;
}
else if (dist == 1)
{ defines = AdaptDeallocate (t->BTP_LIST.Elem->VAR_PARAM.V, IsMain); }
else { printf ("Illegal distribution in deallocate statement\n");
defines = NoTree;
}
# line 803 "AdaptVars.puma"
defines = CombineACF (defines, AdaptDeallocate (t->BTP_LIST.Next, IsMain));
}
return defines;
}
}
if (t->Kind == kBTP_EMPTY) {
# line 807 "AdaptVars.puma"
return NoTree;
}
if (t->Kind == kUSED_VAR) {
# line 811 "AdaptVars.puma"
{
# line 812 "AdaptVars.puma"
if (! ( t->USED_VAR.VARNAME->VAR_OBJ.Object->VarObject.Kind->Kind == kVarCommon)) goto yyL3;
{
# line 813 "AdaptVars.puma"
if (! (IsMain == false)) goto yyL3;
}
}
return NoTree;
yyL3:;
if (Definitions_IsType (t->USED_VAR.VARNAME->VAR_OBJ.Object, kObject)) {
# line 817 "AdaptVars.puma"
{
# line 818 "AdaptVars.puma"
if (!IsHost)
defines = GenDeallocStmt (t);
else
defines = NoTree;
}
return defines;
}
}
# line 827 "AdaptVars.puma"
{
# line 828 "AdaptVars.puma"
printf ("Illegal Construct in AdaptDeallocate\n");
# line 829 "AdaptVars.puma"
FileUnparse (stdout, t);
}
return t;
}
static tTree GenAllocExtensions
# if defined __STDC__ | defined __cplusplus
(register tIdent id)
# else
(id)
register tIdent id;
# endif
{
# line 844 "AdaptVars.puma"
tTree param, paramlist, call;
tObject Obj;
# line 849 "AdaptVars.puma"
{
# line 850 "AdaptVars.puma"
Obj = GetLocalDecl (id);
paramlist = mBTP_EMPTY ();
param = mVAR_PARAM (MakeUsedVarA (id, "_HIGH"));
paramlist = mBTP_LIST (param, paramlist);
param = mVAR_PARAM (MakeUsedVarA (id, "_LOW"));
paramlist = mBTP_LIST (param, paramlist);
paramlist = DalibLastFormalParam (ArrayFormals (Obj), paramlist);
call = mPROC_OBJ (MakeDalibId ("array_pardim"));
call = mACF_BASIC (mCALL_STMT (call, paramlist));
}
return call;
}
static tTree GenAllocStmt
# if defined __STDC__ | defined __cplusplus
(register tTree t)
# else
(t)
register tTree t;
# endif
{
# line 873 "AdaptVars.puma"
tTree param, h;
if (t->Kind == kINDEXED_VAR) {
if (t->INDEXED_VAR.IND_VAR->Kind == kUSED_VAR) {
# line 877 "AdaptVars.puma"
{
# line 878 "AdaptVars.puma"
GlobalId = t->INDEXED_VAR.IND_VAR->USED_VAR.VARNAME->VAR_OBJ.Ident;
t->INDEXED_VAR.IND_EXPS = GenAllocStmt (t->INDEXED_VAR.IND_EXPS);
param = mBTP_LIST (mVAR_PARAM (t), mBTP_EMPTY());
h = mACF_BASIC (mALLOCATE_STMT (param, mDUMMY_VAR()));
OverlapAllocate (h);
}
return h;
}
}
if (t->Kind == kBTE_LIST) {
if (t->BTE_LIST.Elem->Kind == kSLICE_EXP) {
if (t->BTE_LIST.Next->Kind == kBTE_EMPTY) {
# line 887 "AdaptVars.puma"
{
tTree newstart;
tTree newstop;
{
# line 891 "AdaptVars.puma"
# line 892 "AdaptVars.puma"
# line 894 "AdaptVars.puma"
newstart = mVAR_EXP (MakeUsedVarA (GlobalId, "_LOW"));
# line 895 "AdaptVars.puma"
newstop = mVAR_EXP (MakeUsedVarA (GlobalId, "_HIGH"));
# line 896 "AdaptVars.puma"
t->BTE_LIST.Elem = mSLICE_EXP (newstart, newstop, t->BTE_LIST.Elem->SLICE_EXP.INC);
}
{
return t;
}
}
}
}
if (t->BTE_LIST.Next->Kind == kBTE_EMPTY) {
# line 903 "AdaptVars.puma"
{
tTree t1;
tTree t2;
{
# line 904 "AdaptVars.puma"
# line 905 "AdaptVars.puma"
# line 906 "AdaptVars.puma"
t1 = mVAR_EXP(MakeUsedVarA (GlobalId, "_LOW"));
t2 = mVAR_EXP(MakeUsedVarA (GlobalId, "_HIGH"));
t->BTE_LIST.Elem = mSLICE_EXP (t1, t2, mDUMMY_EXP ());
}
{
return t;
}
}
}
# line 914 "AdaptVars.puma"
{
# line 915 "AdaptVars.puma"
t->BTE_LIST.Next = GenAllocStmt (t->BTE_LIST.Next);
}
return t;
}
# line 919 "AdaptVars.puma"
{
# line 920 "AdaptVars.puma"
printf ("Illegal Construct in GenAllocStmt\n");
# line 921 "AdaptVars.puma"
FileUnparse (stdout, t);
}
return NoTree;
}
static tTree GenDeallocStmt
# if defined __STDC__ | defined __cplusplus
(register tTree t)
# else
(t)
register tTree t;
# endif
{
# line 935 "AdaptVars.puma"
tTree h, param, t1, t2;
if (t->Kind == kUSED_VAR) {
# line 947 "AdaptVars.puma"
{
# line 948 "AdaptVars.puma"
param = mBTP_LIST (mVAR_PARAM (t), mBTP_EMPTY());
h = mACF_BASIC (mDEALLOCATE_STMT (param, mDUMMY_VAR()));
}
return h;
}
# line 954 "AdaptVars.puma"
{
# line 955 "AdaptVars.puma"
printf ("Illegal Construct in GenDeallocStmt\n");
# line 956 "AdaptVars.puma"
FileUnparse (stdout, t);
}
return NoTree;
}
static tTree MakeRangeParameters
# if defined __STDC__ | defined __cplusplus
(register tTree range_list, register tTree end_params)
# else
(range_list, end_params)
register tTree range_list;
register tTree end_params;
# endif
{
if (range_list->Kind == kBTE_LIST) {
if (range_list->BTE_LIST.Elem->Kind == kSLICE_EXP) {
# line 970 "AdaptVars.puma"
{
tTree new_paramlist;
{
# line 971 "AdaptVars.puma"
# line 972 "AdaptVars.puma"
new_paramlist = MakeRangeParameters (range_list->BTE_LIST.Next, end_params);
new_paramlist = mBTP_LIST (ExpToVarParam (range_list->BTE_LIST.Elem->SLICE_EXP.STOP), new_paramlist);
new_paramlist = mBTP_LIST (ExpToVarParam (range_list->BTE_LIST.Elem->SLICE_EXP.START), new_paramlist);
}
{
return new_paramlist;
}
}
}
# line 979 "AdaptVars.puma"
{
tTree new_paramlist;
{
# line 980 "AdaptVars.puma"
# line 981 "AdaptVars.puma"
new_paramlist = MakeRangeParameters (range_list->BTE_LIST.Next, end_params);
new_paramlist = mBTP_LIST (ExpToVarParam (range_list->BTE_LIST.Elem), new_paramlist);
new_paramlist = mBTP_LIST (ExpToVarParam (MakeConstant(1)),
new_paramlist);
}
{
return new_paramlist;
}
}
}
if (range_list->Kind == kBTE_EMPTY) {
# line 989 "AdaptVars.puma"
return end_params;
}
if (range_list->Kind == kTYPE_LIST) {
if (range_list->TYPE_LIST.Elem->Kind == kINDEX_TYPE) {
# line 993 "AdaptVars.puma"
{
tTree new_paramlist;
{
# line 994 "AdaptVars.puma"
# line 995 "AdaptVars.puma"
new_paramlist = MakeRangeParameters (range_list->TYPE_LIST.Next, end_params);
new_paramlist = mBTP_LIST (ExpToVarParam (range_list->TYPE_LIST.Elem->INDEX_TYPE.UPPER), new_paramlist);
new_paramlist = mBTP_LIST (ExpToVarParam (range_list->TYPE_LIST.Elem->INDEX_TYPE.LOWER), new_paramlist);
}
{
return new_paramlist;
}
}
}
}
if (range_list->Kind == kTYPE_EMPTY) {
# line 1002 "AdaptVars.puma"
return end_params;
}
# line 1006 "AdaptVars.puma"
{
# line 1007 "AdaptVars.puma"
printf ("MakeRangeParameters fails\n");
# line 1008 "AdaptVars.puma"
FileUnparse (stdout, range_list);
# line 1009 "AdaptVars.puma"
WriteTree (stdout, range_list);
}
return mACF_EMPTY ();
}
void BeginAdaptVars ()
{
}
void CloseAdaptVars ()
{
}