home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
OS/2 Shareware BBS: 10 Tools
/
10-Tools.zip
/
adaptor.zip
/
adapt.zip
/
adaptor
/
src
/
wdistrib.c
< prev
next >
Wrap
Text File
|
1994-01-03
|
41KB
|
1,675 lines
# include "Distribu.h"
# include "yyADistr.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 51 "AdaptDistributions.puma"
# include "Idents.h"
# include "StringMe.h"
# include "protocol.h" /* protocol the changes */
# include "permutat.h" /* data structure for permutations */
# include "NormalAr.h" /* normalization of arrays */
# include "ShowDefs.h" /* SemFile */
# include "Transfor.h" /* ExpToVarParam */
static int host_arrays, distributed_arrays;
static FILE * yyf = stdout;
static void yyAbort
# ifdef __cplusplus
(char * yyFunction)
# else
(yyFunction) char * yyFunction;
# endif
{
(void) fprintf (stderr, "Error: module AdaptDistributions, routine %s failed\n", yyFunction);
exit (1);
}
void AdaptDistributions ARGS((tTree t));
static void TransformDistributions ARGS((tTree t));
static void TransformDeclDistributions ARGS((tTree decls));
static void SwitchDistributedDimensions ARGS((tDefinitions Obj));
static void TransformACFDistributions ARGS((tTree t));
static void WherePermutation ARGS((tTree t, Permutation p));
static void TransformStmtDistributions ARGS((tTree t));
static void TransformParamDistributions ARGS((tTree t, bool allowed));
static void TransformIndexDistributions ARGS((tTree t));
static Permutation PermuteExpression ARGS((tTree t));
static Permutation GetObjectPermutation ARGS((tDefinitions obj));
static Permutation PermuteIntrinsicFunction ARGS((tTree f));
static Permutation PermuteIntrinsicParameters ARGS((tTree p));
static Permutation PermuteReductionParameters ARGS((tTree p));
static Permutation PermuteCShiftParameters ARGS((tTree p));
static Permutation PermuteTransposeParameters ARGS((tTree p));
static Permutation PermuteSpreadParameters ARGS((tTree p));
static tTree ChangeConstValue ARGS((tTree exp, int val));
static void PermuteIntrinsicSubroutine ARGS((tIdent name, tTree params));
static void PermuteGlobalGetParams ARGS((tTree param_list));
static void PermuteGlobalSendParams ARGS((tTree param_list));
static void SwitchGetSendIndexes ARGS((Permutation ap, tTree indexlist, int n));
static void SwitchGetSendIndex ARGS((Permutation ap, tTree index));
static void ResolveDistTranspose ARGS((tTree t, Permutation dist1, Permutation dist2));
void AdaptDistributions
# if defined __STDC__ | defined __cplusplus
(register tTree t)
# else
(t)
register tTree t;
# endif
{
if (t == NoTree) return;
if (t->Kind == kCOMP_UNIT) {
# line 75 "AdaptDistributions.puma"
{
# line 76 "AdaptDistributions.puma"
open_protocol ("adaptor.dis");
# line 77 "AdaptDistributions.puma"
TransformDistributions (t->COMP_UNIT.COMP_ELEMENTS);
# line 78 "AdaptDistributions.puma"
close_protocol ();
}
return;
}
;
}
static void TransformDistributions
# if defined __STDC__ | defined __cplusplus
(register tTree t)
# else
(t)
register tTree t;
# endif
{
if (t == NoTree) return;
switch (t->Kind) {
case kDECL_EMPTY:
# line 91 "AdaptDistributions.puma"
return;
case kDECL_LIST:
# line 94 "AdaptDistributions.puma"
{
# line 95 "AdaptDistributions.puma"
TransformDistributions (t->DECL_LIST.Elem);
# line 96 "AdaptDistributions.puma"
TransformDistributions (t->DECL_LIST.Next);
}
return;
case kPROGRAM_DECL:
# line 107 "AdaptDistributions.puma"
{
tDefinitions Obj;
{
# line 108 "AdaptDistributions.puma"
set_protocol_unit (t);
# line 109 "AdaptDistributions.puma"
# line 110 "AdaptDistributions.puma"
Obj = GetDeclEntry (t->PROGRAM_DECL.Name, GetUnitEntries ());
# line 111 "AdaptDistributions.puma"
OpenScope (Obj->ProcObject.Declarations);
# line 112 "AdaptDistributions.puma"
TransformDistributions (t->PROGRAM_DECL.PROGRAM_BODY);
# line 113 "AdaptDistributions.puma"
CloseScope ();
}
return;
}
case kPROC_DECL:
# line 116 "AdaptDistributions.puma"
{
tDefinitions Obj;
{
# line 117 "AdaptDistributions.puma"
set_protocol_unit (t);
# line 118 "AdaptDistributions.puma"
# line 119 "AdaptDistributions.puma"
Obj = GetDeclEntry (t->PROC_DECL.Name, GetUnitEntries ());
# line 120 "AdaptDistributions.puma"
OpenScope (Obj->ProcObject.Declarations);
# line 121 "AdaptDistributions.puma"
TransformDistributions (t->PROC_DECL.PROC_BODY);
# line 122 "AdaptDistributions.puma"
CloseScope ();
}
return;
}
case kFUNC_DECL:
# line 125 "AdaptDistributions.puma"
{
tDefinitions Obj;
{
# line 126 "AdaptDistributions.puma"
set_protocol_unit (t);
# line 127 "AdaptDistributions.puma"
# line 128 "AdaptDistributions.puma"
Obj = GetDeclEntry (t->FUNC_DECL.Name, GetUnitEntries ());
# line 129 "AdaptDistributions.puma"
OpenScope (Obj->FuncObject.Declarations);
# line 130 "AdaptDistributions.puma"
TransformDistributions (t->FUNC_DECL.FUNC_BODY);
# line 131 "AdaptDistributions.puma"
CloseScope ();
}
return;
}
case kMODULE_DECL:
# line 134 "AdaptDistributions.puma"
{
# line 135 "AdaptDistributions.puma"
tree_error_protocol ("MODULE not supported", t);
}
return;
case kBLOCK_DATA_DECL:
# line 138 "AdaptDistributions.puma"
{
tDefinitions Obj;
{
# line 139 "AdaptDistributions.puma"
set_protocol_unit (t);
# line 140 "AdaptDistributions.puma"
# line 141 "AdaptDistributions.puma"
Obj = GetDeclEntry (t->BLOCK_DATA_DECL.Name, GetUnitEntries ());
# line 142 "AdaptDistributions.puma"
OpenScope (Obj->BlockObject.Declarations);
# line 143 "AdaptDistributions.puma"
TransformDistributions (t->BLOCK_DATA_DECL.DATA_BODY);
# line 144 "AdaptDistributions.puma"
CloseScope ();
}
return;
}
case kBODY_NODE:
if (t->BODY_NODE.INTERNALS->Kind == kDECL_EMPTY) {
# line 147 "AdaptDistributions.puma"
{
# line 148 "AdaptDistributions.puma"
TransformDeclDistributions (t->BODY_NODE.DECLS);
# line 149 "AdaptDistributions.puma"
TransformACFDistributions (t->BODY_NODE.STATS);
# line 150 "AdaptDistributions.puma"
NormalArrays (t);
}
return;
}
break;
}
;
}
static void TransformDeclDistributions
# if defined __STDC__ | defined __cplusplus
(register tTree decls)
# else
(decls)
register tTree decls;
# endif
{
if (decls == NoTree) return;
if (decls->Kind == kDECL_EMPTY) {
# line 161 "AdaptDistributions.puma"
return;
}
if (decls->Kind == kDECL_LIST) {
# line 164 "AdaptDistributions.puma"
{
# line 165 "AdaptDistributions.puma"
TransformDeclDistributions (decls->DECL_LIST.Elem);
# line 166 "AdaptDistributions.puma"
TransformDeclDistributions (decls->DECL_LIST.Next);
}
return;
}
if (decls->Kind == kVAR_DECL) {
# line 169 "AdaptDistributions.puma"
{
tDefinitions Obj;
{
# line 171 "AdaptDistributions.puma"
# line 172 "AdaptDistributions.puma"
Obj = GetLocalDecl (decls->VAR_DECL.Name);
# line 174 "AdaptDistributions.puma"
if (! (VarDistribution (Obj) == 1)) goto yyL3;
{
# line 175 "AdaptDistributions.puma"
SwitchDistributedDimensions (Obj);
}
}
return;
}
yyL3:;
}
;
}
static void SwitchDistributedDimensions
# if defined __STDC__ | defined __cplusplus
(register tDefinitions Obj)
# else
(Obj)
register tDefinitions Obj;
# endif
{
# line 180 "AdaptDistributions.puma"
Permutation perm;
if (Obj == NoDefinitions) return;
if (Obj->Kind == kVarObject) {
if (Obj->VarObject.decl->Kind == kVAR_DECL) {
if (Obj->VarObject.decl->VAR_DECL.VAL->Kind == kARRAY_TYPE) {
if (Obj->VarObject.Dist->Kind == kNodeDistribution) {
# line 184 "AdaptDistributions.puma"
{
# line 187 "AdaptDistributions.puma"
perm = implied_distribution_permutation (Obj->VarObject.Dist->NodeDistribution.dims);
if (!is_id_permutation (perm))
{ obj_protocol ("This variable has switched dimensions:\n", Obj);
switch_index_types (Obj->VarObject.decl->VAR_DECL.VAL->ARRAY_TYPE.ARRAY_INDEX_TYPES, perm);
obj_protocol ("this is the object with new dimensions:\n", Obj);
}
else
switch_index_types (Obj->VarObject.decl->VAR_DECL.VAL->ARRAY_TYPE.ARRAY_INDEX_TYPES, perm);
}
return;
}
}
}
if (Obj->VarObject.decl->Kind == kVAR_PARAM_DECL) {
if (Obj->VarObject.decl->VAR_PARAM_DECL.VAL->Kind == kARRAY_TYPE) {
if (Obj->VarObject.Dist->Kind == kNodeDistribution) {
# line 198 "AdaptDistributions.puma"
{
# line 200 "AdaptDistributions.puma"
perm = implied_distribution_permutation (Obj->VarObject.Dist->NodeDistribution.dims);
if (!is_id_permutation (perm))
{ obj_protocol ("this variable has switched dimensions", Obj);
switch_index_types (Obj->VarObject.decl->VAR_PARAM_DECL.VAL->ARRAY_TYPE.ARRAY_INDEX_TYPES, perm);
obj_protocol ("this is the object with new dimensions", Obj);
}
else
switch_index_types (Obj->VarObject.decl->VAR_PARAM_DECL.VAL->ARRAY_TYPE.ARRAY_INDEX_TYPES, perm);
}
return;
}
}
}
}
# line 211 "AdaptDistributions.puma"
{
# line 212 "AdaptDistributions.puma"
obj_error_protocol ("did not switch dimensions", Obj);
}
return;
;
}
static void TransformACFDistributions
# if defined __STDC__ | defined __cplusplus
(register tTree t)
# else
(t)
register tTree t;
# endif
{
# line 223 "AdaptDistributions.puma"
Permutation perm;
if (t == NoTree) return;
switch (t->Kind) {
case kACF_LIST:
# line 227 "AdaptDistributions.puma"
{
# line 228 "AdaptDistributions.puma"
set_protocol_stmt (t->ACF_LIST.Elem);
# line 229 "AdaptDistributions.puma"
TransformACFDistributions (t->ACF_LIST.Elem);
# line 230 "AdaptDistributions.puma"
TransformACFDistributions (t->ACF_LIST.Next);
}
return;
case kACF_EMPTY:
# line 233 "AdaptDistributions.puma"
return;
case kACF_DUMMY:
# line 236 "AdaptDistributions.puma"
return;
case kACF_BASIC:
# line 239 "AdaptDistributions.puma"
{
# line 240 "AdaptDistributions.puma"
TransformStmtDistributions (t->ACF_BASIC.BASIC_STMT);
}
return;
case kACF_IF:
# line 243 "AdaptDistributions.puma"
{
# line 244 "AdaptDistributions.puma"
perm = PermuteExpression (t->ACF_IF.IF_EXP);
# line 245 "AdaptDistributions.puma"
TransformACFDistributions (t->ACF_IF.THEN_PART);
# line 246 "AdaptDistributions.puma"
TransformACFDistributions (t->ACF_IF.ELSE_PART);
}
return;
case kACF_WHERE:
# line 249 "AdaptDistributions.puma"
{
# line 251 "AdaptDistributions.puma"
perm = PermuteExpression (t->ACF_WHERE.WHERE_EXP);
# line 252 "AdaptDistributions.puma"
WherePermutation (t->ACF_WHERE.TRUE_PART, perm);
# line 253 "AdaptDistributions.puma"
WherePermutation (t->ACF_WHERE.FALSE_PART, perm);
}
return;
case kACF_CASE:
# line 256 "AdaptDistributions.puma"
{
# line 257 "AdaptDistributions.puma"
perm = PermuteExpression (t->ACF_CASE.CASE_EXP);
# line 258 "AdaptDistributions.puma"
TransformACFDistributions (t->ACF_CASE.CASE_ALTS);
# line 259 "AdaptDistributions.puma"
TransformACFDistributions (t->ACF_CASE.CASE_OTHERWISE);
}
return;
case kSELECTED_ACF_LIST:
# line 262 "AdaptDistributions.puma"
{
# line 263 "AdaptDistributions.puma"
TransformACFDistributions (t->SELECTED_ACF_LIST.Elem);
# line 264 "AdaptDistributions.puma"
TransformACFDistributions (t->SELECTED_ACF_LIST.Next);
}
return;
case kSELECTED_ACF_EMPTY:
# line 267 "AdaptDistributions.puma"
return;
case kSELECTED_ACF_NODE:
# line 270 "AdaptDistributions.puma"
{
# line 271 "AdaptDistributions.puma"
perm = PermuteExpression (t->SELECTED_ACF_NODE.SELECT_LIST);
# line 272 "AdaptDistributions.puma"
TransformACFDistributions (t->SELECTED_ACF_NODE.SELECT_ACFS);
}
return;
case kACF_WHILE:
# line 275 "AdaptDistributions.puma"
{
# line 276 "AdaptDistributions.puma"
perm = PermuteExpression (t->ACF_WHILE.WHILE_EXP);
# line 277 "AdaptDistributions.puma"
TransformACFDistributions (t->ACF_WHILE.WHILE_BODY);
}
return;
case kACF_FORALL:
# line 280 "AdaptDistributions.puma"
{
# line 281 "AdaptDistributions.puma"
perm = PermuteExpression (t->ACF_FORALL.FORALL_RANGE);
# line 282 "AdaptDistributions.puma"
TransformACFDistributions (t->ACF_FORALL.FORALL_BODY);
}
return;
case kACF_DOLOCAL:
# line 285 "AdaptDistributions.puma"
{
# line 286 "AdaptDistributions.puma"
perm = PermuteExpression (t->ACF_DOLOCAL.DOLOCAL_RANGE);
# line 287 "AdaptDistributions.puma"
TransformACFDistributions (t->ACF_DOLOCAL.DOLOCAL_BODY);
}
return;
case kACF_DO:
# line 290 "AdaptDistributions.puma"
{
# line 291 "AdaptDistributions.puma"
perm = PermuteExpression (t->ACF_DO.DO_RANGE);
# line 292 "AdaptDistributions.puma"
TransformACFDistributions (t->ACF_DO.DO_BODY);
}
return;
}
# line 295 "AdaptDistributions.puma"
{
# line 296 "AdaptDistributions.puma"
failure_protocol ("AdaptDistributions", "TransformACFDistriubtions", t);
}
return;
;
}
static void WherePermutation
# if defined __STDC__ | defined __cplusplus
(register tTree t, Permutation p)
# else
(t, p)
register tTree t;
Permutation p;
# endif
{
if (t == NoTree) return;
if (t->Kind == kACF_LIST) {
# line 309 "AdaptDistributions.puma"
{
# line 310 "AdaptDistributions.puma"
WherePermutation (t->ACF_LIST.Elem, p);
# line 311 "AdaptDistributions.puma"
WherePermutation (t->ACF_LIST.Next, p);
}
return;
}
if (t->Kind == kACF_EMPTY) {
# line 314 "AdaptDistributions.puma"
return;
}
if (t->Kind == kACF_BASIC) {
if (t->ACF_BASIC.BASIC_STMT->Kind == kASSIGN_STMT) {
# line 317 "AdaptDistributions.puma"
{
Permutation perm;
Permutation perm1;
{
# line 319 "AdaptDistributions.puma"
# line 320 "AdaptDistributions.puma"
# line 322 "AdaptDistributions.puma"
perm = PermuteExpression (t->ACF_BASIC.BASIC_STMT->ASSIGN_STMT.ASSIGN_VAR);
# line 323 "AdaptDistributions.puma"
perm1 = PermuteExpression (t->ACF_BASIC.BASIC_STMT->ASSIGN_STMT.ASSIGN_EXP);
# line 325 "AdaptDistributions.puma"
if (perm1.n > 0)
{ if (!equal_permutations (perm, perm1))
error_protocol ("implicit transpose in where-assignment");
}
if (!equal_permutations (p, perm))
error_protocol ("implicit transpose with where expression");
}
return;
}
}
}
# line 334 "AdaptDistributions.puma"
{
# line 335 "AdaptDistributions.puma"
failure_protocol ("AdaptDistributions", "WherePermutation", t);
}
return;
;
}
static void TransformStmtDistributions
# if defined __STDC__ | defined __cplusplus
(register tTree t)
# else
(t)
register tTree t;
# endif
{
# line 346 "AdaptDistributions.puma"
Permutation perm, perm1;
if (t == NoTree) return;
switch (t->Kind) {
case kASSIGN_STMT:
# line 350 "AdaptDistributions.puma"
{
# line 351 "AdaptDistributions.puma"
perm = PermuteExpression (t->ASSIGN_STMT.ASSIGN_VAR);
# line 352 "AdaptDistributions.puma"
perm1 = PermuteExpression (t->ASSIGN_STMT.ASSIGN_EXP);
# line 353 "AdaptDistributions.puma"
if (!conform_permutations (perm, perm1))
ResolveDistTranspose (t, perm, perm1);
}
return;
case kFORMAT_STMT:
# line 358 "AdaptDistributions.puma"
return;
case kIO_STMT:
# line 362 "AdaptDistributions.puma"
{
# line 364 "AdaptDistributions.puma"
TransformParamDistributions (t->IO_STMT.IO_ITEMS, false);
}
return;
case kCALL_STMT:
# line 367 "AdaptDistributions.puma"
{
# line 369 "AdaptDistributions.puma"
if (! (t->CALL_STMT.CALL_ID->PROC_OBJ.Object == GetDeclEntry (t->CALL_STMT.CALL_ID->PROC_OBJ.Ident, GetIntrinsicEntries ()))) goto yyL4;
{
# line 373 "AdaptDistributions.puma"
PermuteIntrinsicSubroutine (t->CALL_STMT.CALL_ID->PROC_OBJ.Ident, t->CALL_STMT.CALL_PARAMS);
}
}
return;
yyL4:;
# line 376 "AdaptDistributions.puma"
{
# line 378 "AdaptDistributions.puma"
if (! (t->CALL_STMT.CALL_ID->PROC_OBJ.Object == GetDeclEntry (t->CALL_STMT.CALL_ID->PROC_OBJ.Ident, GetExternalEntries ()))) goto yyL5;
{
# line 382 "AdaptDistributions.puma"
TransformParamDistributions (t->CALL_STMT.CALL_PARAMS, false);
}
}
return;
yyL5:;
# line 385 "AdaptDistributions.puma"
{
# line 386 "AdaptDistributions.puma"
TransformParamDistributions (t->CALL_STMT.CALL_PARAMS, true);
}
return;
case kREDUCE_STMT:
# line 389 "AdaptDistributions.puma"
{
# line 390 "AdaptDistributions.puma"
TransformParamDistributions (t->REDUCE_STMT.RED_PARAMS, false);
}
return;
case kALLOCATE_STMT:
# line 393 "AdaptDistributions.puma"
{
# line 394 "AdaptDistributions.puma"
TransformParamDistributions (t->ALLOCATE_STMT.PARAMS, true);
}
return;
case kDEALLOCATE_STMT:
# line 397 "AdaptDistributions.puma"
{
# line 398 "AdaptDistributions.puma"
TransformParamDistributions (t->DEALLOCATE_STMT.PARAMS, true);
}
return;
case kGOTO_STMT:
# line 401 "AdaptDistributions.puma"
return;
case kCOMP_GOTO_STMT:
# line 404 "AdaptDistributions.puma"
{
# line 405 "AdaptDistributions.puma"
perm = PermuteExpression (t->COMP_GOTO_STMT.GOTO_EXP);
}
return;
case kCOMP_IF_STMT:
# line 408 "AdaptDistributions.puma"
{
# line 409 "AdaptDistributions.puma"
perm = PermuteExpression (t->COMP_IF_STMT.IF_EXP);
}
return;
case kSTOP_STMT:
# line 412 "AdaptDistributions.puma"
{
# line 413 "AdaptDistributions.puma"
perm = PermuteExpression (t->STOP_STMT.STOP_CONST);
}
return;
case kRETURN_STMT:
# line 416 "AdaptDistributions.puma"
{
# line 417 "AdaptDistributions.puma"
perm = PermuteExpression (t->RETURN_STMT.RETURN_EXP);
}
return;
}
# line 420 "AdaptDistributions.puma"
{
# line 421 "AdaptDistributions.puma"
failure_protocol ("AdaptDistributions", "TransformStmtDistributions", t);
}
return;
;
}
static void TransformParamDistributions
# if defined __STDC__ | defined __cplusplus
(register tTree t, register bool allowed)
# else
(t, allowed)
register tTree t;
register bool allowed;
# endif
{
if (t == NoTree) return;
if (t->Kind == kBTP_LIST) {
# line 428 "AdaptDistributions.puma"
{
# line 429 "AdaptDistributions.puma"
TransformParamDistributions (t->BTP_LIST.Elem, allowed);
# line 430 "AdaptDistributions.puma"
TransformParamDistributions (t->BTP_LIST.Next, allowed);
}
return;
}
if (t->Kind == kBTP_EMPTY) {
# line 433 "AdaptDistributions.puma"
return;
}
if (t->Kind == kVAR_PARAM) {
# line 436 "AdaptDistributions.puma"
{
Permutation p;
{
# line 437 "AdaptDistributions.puma"
# line 438 "AdaptDistributions.puma"
p = PermuteExpression (t->VAR_PARAM.V);
# line 439 "AdaptDistributions.puma"
if (!allowed)
{
if (!equal_permutations (p, make_id_permutation (p.n)))
error_protocol ("implicit transformation in parameter");
}
}
return;
}
}
if (t->Kind == kFUNC_PARAM) {
# line 447 "AdaptDistributions.puma"
return;
}
if (t->Kind == kPROC_PARAM) {
# line 450 "AdaptDistributions.puma"
return;
}
# line 453 "AdaptDistributions.puma"
{
# line 454 "AdaptDistributions.puma"
failure_protocol ("AdaptDistributions", "TransformParamDistributions", t);
}
return;
;
}
static void TransformIndexDistributions
# if defined __STDC__ | defined __cplusplus
(register tTree t)
# else
(t)
register tTree t;
# endif
{
if (t == NoTree) return;
if (t->Kind == kBTE_LIST) {
# line 459 "AdaptDistributions.puma"
{
Permutation p;
{
# line 460 "AdaptDistributions.puma"
# line 461 "AdaptDistributions.puma"
p = PermuteExpression (t->BTE_LIST.Elem);
# line 462 "AdaptDistributions.puma"
TransformIndexDistributions (t->BTE_LIST.Next);
}
return;
}
}
if (t->Kind == kBTE_EMPTY) {
# line 465 "AdaptDistributions.puma"
return;
}
if (t->Kind == kBTV_LIST) {
# line 468 "AdaptDistributions.puma"
{
Permutation p;
{
# line 469 "AdaptDistributions.puma"
# line 470 "AdaptDistributions.puma"
p = PermuteExpression (t->BTV_LIST.Elem);
# line 471 "AdaptDistributions.puma"
TransformIndexDistributions (t->BTV_LIST.Next);
}
return;
}
}
if (t->Kind == kBTV_EMPTY) {
# line 474 "AdaptDistributions.puma"
return;
}
# line 477 "AdaptDistributions.puma"
{
# line 478 "AdaptDistributions.puma"
failure_protocol ("AdaptDistributions", "TransformIndexDistributions", t);
}
return;
;
}
static Permutation PermuteExpression
# if defined __STDC__ | defined __cplusplus
(register tTree t)
# else
(t)
register tTree t;
# endif
{
# line 492 "AdaptDistributions.puma"
Permutation perm, perm1;
switch (t->Kind) {
case kUSED_VAR:
# line 496 "AdaptDistributions.puma"
return GetObjectPermutation (t->USED_VAR.VARNAME->VAR_OBJ.Object);
case kSUBSTRING_VAR:
# line 500 "AdaptDistributions.puma"
return PermuteExpression (t->SUBSTRING_VAR.IND_VAR);
case kLOOP_VAR:
# line 504 "AdaptDistributions.puma"
return GetObjectPermutation (t->LOOP_VAR.LOOP_VARNAME->VAR_OBJ.Object);
case kINDEXED_VAR:
# line 508 "AdaptDistributions.puma"
{
# line 512 "AdaptDistributions.puma"
TransformIndexDistributions (t->INDEXED_VAR.IND_EXPS);
# line 514 "AdaptDistributions.puma"
perm = PermuteExpression (t->INDEXED_VAR.IND_VAR);
# line 516 "AdaptDistributions.puma"
perm1 = index_list (t->INDEXED_VAR.IND_EXPS);
# line 518 "AdaptDistributions.puma"
switch_indexes (t->INDEXED_VAR.IND_EXPS, perm);
# line 520 "AdaptDistributions.puma"
perm1 = get_rank_permutation (perm1, perm);
}
return perm1;
case kDO_VAR:
# line 525 "AdaptDistributions.puma"
{
# line 526 "AdaptDistributions.puma"
perm = PermuteExpression (t->DO_VAR.RANGE);
# line 527 "AdaptDistributions.puma"
TransformIndexDistributions (t->DO_VAR.BODY);
}
return PermuteExpression (t->DO_VAR.DO_ID);
case kADDR:
# line 531 "AdaptDistributions.puma"
return PermuteExpression (t->ADDR.E);
case kDUMMY_EXP:
# line 535 "AdaptDistributions.puma"
return make_id_permutation (0);
case kCONST_EXP:
# line 539 "AdaptDistributions.puma"
return make_id_permutation (0);
case kARRAY_EXP:
# line 543 "AdaptDistributions.puma"
return make_id_permutation (1);
case kSLICE_EXP:
# line 547 "AdaptDistributions.puma"
{
# line 548 "AdaptDistributions.puma"
perm = PermuteExpression (t->SLICE_EXP.START);
# line 549 "AdaptDistributions.puma"
perm = PermuteExpression (t->SLICE_EXP.STOP);
# line 550 "AdaptDistributions.puma"
perm = PermuteExpression (t->SLICE_EXP.INC);
}
return make_id_permutation (1);
case kOP_EXP:
# line 554 "AdaptDistributions.puma"
{
# line 556 "AdaptDistributions.puma"
perm = PermuteExpression (t->OP_EXP.OPND1);
# line 557 "AdaptDistributions.puma"
perm1 = PermuteExpression (t->OP_EXP.OPND2);
# line 559 "AdaptDistributions.puma"
if (!conform_permutations (perm, perm1))
{ error_protocol ("implicit transpose in expression");
tree_protocol ("expression is : ", t);
}
}
return merge_permutation (perm, perm1);
case kOP1_EXP:
# line 567 "AdaptDistributions.puma"
return PermuteExpression (t->OP1_EXP.OPND);
case kVAR_EXP:
# line 571 "AdaptDistributions.puma"
return PermuteExpression (t->VAR_EXP.V);
case kFUNC_CALL_EXP:
# line 575 "AdaptDistributions.puma"
{
# line 577 "AdaptDistributions.puma"
if (! (IsIntrFunc (t) == true)) goto yyL14;
}
return PermuteIntrinsicFunction (t);
yyL14:;
# line 581 "AdaptDistributions.puma"
{
# line 585 "AdaptDistributions.puma"
TransformParamDistributions (t->FUNC_CALL_EXP.FUNC_PARAMS, true);
}
return make_id_permutation (0);
case kDO_EXP:
# line 589 "AdaptDistributions.puma"
return make_id_permutation (1);
case kVAR_PARAM:
# line 593 "AdaptDistributions.puma"
return PermuteExpression (t->VAR_PARAM.V);
}
# line 597 "AdaptDistributions.puma"
{
# line 598 "AdaptDistributions.puma"
failure_protocol ("AdaptDistributions", "PermuteExpression", t);
}
return make_id_permutation (0);
}
static Permutation GetObjectPermutation
# if defined __STDC__ | defined __cplusplus
(register tDefinitions obj)
# else
(obj)
register tDefinitions obj;
# endif
{
if (obj->Kind == kVarObject) {
if (obj->VarObject.Dist->Kind == kNodeDistribution) {
# line 611 "AdaptDistributions.puma"
return implied_distribution_permutation (obj->VarObject.Dist->NodeDistribution.dims);
}
# line 615 "AdaptDistributions.puma"
return make_id_permutation (VarRank (obj));
}
if (obj->Kind == kFuncObject) {
if (obj->FuncObject.decl->Kind == kFUNC_DECL) {
# line 619 "AdaptDistributions.puma"
return make_id_permutation (0);
}
}
# line 624 "AdaptDistributions.puma"
{
# line 625 "AdaptDistributions.puma"
obj_error_protocol ("GetObjectPermutation failed", obj);
}
return make_id_permutation (0);
}
static Permutation PermuteIntrinsicFunction
# if defined __STDC__ | defined __cplusplus
(register tTree f)
# else
(f)
register tTree f;
# endif
{
if (f->Kind == kFUNC_CALL_EXP) {
# line 637 "AdaptDistributions.puma"
{
# line 638 "AdaptDistributions.puma"
if (! (IntrFuncKind1 (f->FUNC_CALL_EXP.FUNC_ID->PROC_OBJ.Ident) == true)) goto yyL1;
}
return PermuteIntrinsicParameters (f->FUNC_CALL_EXP.FUNC_PARAMS);
yyL1:;
# line 642 "AdaptDistributions.puma"
{
# line 643 "AdaptDistributions.puma"
if (! (IntrFuncKind2 (f->FUNC_CALL_EXP.FUNC_ID->PROC_OBJ.Ident) == true)) goto yyL2;
}
return PermuteIntrinsicParameters (f->FUNC_CALL_EXP.FUNC_PARAMS);
yyL2:;
# line 647 "AdaptDistributions.puma"
{
# line 648 "AdaptDistributions.puma"
if (! (IntrFuncKindn (f->FUNC_CALL_EXP.FUNC_ID->PROC_OBJ.Ident) == true)) goto yyL3;
}
return PermuteIntrinsicParameters (f->FUNC_CALL_EXP.FUNC_PARAMS);
yyL3:;
# line 652 "AdaptDistributions.puma"
{
# line 653 "AdaptDistributions.puma"
if (! (IntrFuncRed (f->FUNC_CALL_EXP.FUNC_ID->PROC_OBJ.Ident) == true)) goto yyL4;
}
return PermuteReductionParameters (f->FUNC_CALL_EXP.FUNC_PARAMS);
yyL4:;
# line 657 "AdaptDistributions.puma"
{
# line 658 "AdaptDistributions.puma"
if (! ((f->FUNC_CALL_EXP.FUNC_ID->PROC_OBJ.Ident == MakeIdent ("CSHIFT", 6)))) goto yyL5;
}
return PermuteCShiftParameters (f->FUNC_CALL_EXP.FUNC_PARAMS);
yyL5:;
# line 662 "AdaptDistributions.puma"
{
# line 663 "AdaptDistributions.puma"
if (! ((f->FUNC_CALL_EXP.FUNC_ID->PROC_OBJ.Ident == MakeIdent ("SPREAD", 6)))) goto yyL6;
}
return PermuteSpreadParameters (f->FUNC_CALL_EXP.FUNC_PARAMS);
yyL6:;
# line 667 "AdaptDistributions.puma"
{
# line 668 "AdaptDistributions.puma"
if (! ((f->FUNC_CALL_EXP.FUNC_ID->PROC_OBJ.Ident == MakeIdent ("TRANSPOSE", 9)))) goto yyL7;
}
return PermuteTransposeParameters (f->FUNC_CALL_EXP.FUNC_PARAMS);
yyL7:;
# line 672 "AdaptDistributions.puma"
{
# line 673 "AdaptDistributions.puma"
error_protocol ("intrinsic not handled");
# line 674 "AdaptDistributions.puma"
tree_protocol ("intrinsic function is : ", f);
}
return PermuteIntrinsicParameters (f->FUNC_CALL_EXP.FUNC_PARAMS);
}
yyAbort ("PermuteIntrinsicFunction");
}
static Permutation PermuteIntrinsicParameters
# if defined __STDC__ | defined __cplusplus
(register tTree p)
# else
(p)
register tTree p;
# endif
{
if (p->Kind == kBTP_LIST) {
# line 680 "AdaptDistributions.puma"
{
Permutation perm1;
Permutation perm2;
{
# line 682 "AdaptDistributions.puma"
# line 683 "AdaptDistributions.puma"
# line 685 "AdaptDistributions.puma"
perm1 = PermuteExpression (p->BTP_LIST.Elem);
# line 686 "AdaptDistributions.puma"
perm2 = PermuteIntrinsicParameters (p->BTP_LIST.Next);
# line 688 "AdaptDistributions.puma"
if (!conform_permutations (perm1, perm2))
error_protocol ("implicit transpose in expression");
}
{
return merge_permutation (perm1, perm2);
}
}
}
if (p->Kind == kBTP_EMPTY) {
# line 695 "AdaptDistributions.puma"
return make_id_permutation (0);
}
yyAbort ("PermuteIntrinsicParameters");
}
static Permutation PermuteReductionParameters
# if defined __STDC__ | defined __cplusplus
(register tTree p)
# else
(p)
register tTree p;
# endif
{
if (p->Kind == kBTP_LIST) {
if (p->BTP_LIST.Next->Kind == kBTP_EMPTY) {
# line 709 "AdaptDistributions.puma"
return PermuteExpression (p->BTP_LIST.Elem);
}
if (p->BTP_LIST.Next->Kind == kBTP_LIST) {
if (p->BTP_LIST.Next->BTP_LIST.Next->Kind == kBTP_EMPTY) {
# line 726 "AdaptDistributions.puma"
{
Permutation array_perm;
int idim;
int ndim;
bool found;
{
# line 728 "AdaptDistributions.puma"
# line 729 "AdaptDistributions.puma"
# line 730 "AdaptDistributions.puma"
# line 731 "AdaptDistributions.puma"
# line 733 "AdaptDistributions.puma"
array_perm = PermuteExpression (p->BTP_LIST.Elem);
# line 735 "AdaptDistributions.puma"
GetIntConstValue (p->BTP_LIST.Next->BTP_LIST.Elem, &found, &idim);
if (is_id_permutation (array_perm))
array_perm = make_id_permutation (array_perm.n - 1);
else if (!found)
error_protocol ("unknown dim parameter in reduction (transpose?)");
else
{ ndim = new_perm_position (array_perm, idim);
p->BTP_LIST.Next->BTP_LIST.Elem = ChangeConstValue (p->BTP_LIST.Next->BTP_LIST.Elem, ndim);
array_perm = reduce_permutation (array_perm, idim, ndim);
stmt_protocol ("reduction has changed dimension");
}
}
{
return array_perm;
}
}
}
}
}
yyAbort ("PermuteReductionParameters");
}
static Permutation PermuteCShiftParameters
# if defined __STDC__ | defined __cplusplus
(register tTree p)
# else
(p)
register tTree p;
# endif
{
if (p->Kind == kBTP_LIST) {
if (p->BTP_LIST.Next->Kind == kBTP_LIST) {
if (p->BTP_LIST.Next->BTP_LIST.Next->Kind == kBTP_LIST) {
if (p->BTP_LIST.Next->BTP_LIST.Next->BTP_LIST.Next->Kind == kBTP_EMPTY) {
# line 768 "AdaptDistributions.puma"
{
Permutation array_perm;
int idim;
bool found;
{
# line 770 "AdaptDistributions.puma"
# line 772 "AdaptDistributions.puma"
array_perm = PermuteExpression (p->BTP_LIST.Elem);
# line 774 "AdaptDistributions.puma"
# line 775 "AdaptDistributions.puma"
# line 777 "AdaptDistributions.puma"
GetIntConstValue (p->BTP_LIST.Next->BTP_LIST.Elem, &found, &idim);
if (is_id_permutation (array_perm))
idim = idim;
else if (!found)
error_protocol ("unknown dim parameter in cshift (transpose?)");
else
{ idim = new_perm_position (array_perm, idim);
p->BTP_LIST.Next->BTP_LIST.Elem = ChangeConstValue (p->BTP_LIST.Next->BTP_LIST.Elem, idim);
}
}
{
return array_perm;
}
}
}
}
}
}
yyAbort ("PermuteCShiftParameters");
}
static Permutation PermuteTransposeParameters
# if defined __STDC__ | defined __cplusplus
(register tTree p)
# else
(p)
register tTree p;
# endif
{
if (p->Kind == kBTP_LIST) {
if (p->BTP_LIST.Next->Kind == kBTP_EMPTY) {
# line 800 "AdaptDistributions.puma"
{
Permutation array_perm;
{
# line 802 "AdaptDistributions.puma"
# line 804 "AdaptDistributions.puma"
array_perm = PermuteExpression (p->BTP_LIST.Elem);
# line 806 "AdaptDistributions.puma"
if (!is_id_permutation (array_perm))
error_protocol ("array in transpose is already transposed");
}
{
return array_perm;
}
}
}
}
yyAbort ("PermuteTransposeParameters");
}
static Permutation PermuteSpreadParameters
# if defined __STDC__ | defined __cplusplus
(register tTree p)
# else
(p)
register tTree p;
# endif
{
if (p->Kind == kBTP_LIST) {
if (p->BTP_LIST.Next->Kind == kBTP_LIST) {
if (p->BTP_LIST.Next->BTP_LIST.Next->Kind == kBTP_LIST) {
if (p->BTP_LIST.Next->BTP_LIST.Next->BTP_LIST.Next->Kind == kBTP_EMPTY) {
# line 827 "AdaptDistributions.puma"
{
Permutation array_perm;
{
# line 829 "AdaptDistributions.puma"
# line 831 "AdaptDistributions.puma"
array_perm = PermuteExpression (p->BTP_LIST.Elem);
# line 833 "AdaptDistributions.puma"
array_perm.pa[array_perm.n] = array_perm.n + 1;
array_perm.n = array_perm.n + 1;
}
{
return array_perm;
}
}
}
}
}
}
yyAbort ("PermuteSpreadParameters");
}
static tTree ChangeConstValue
# if defined __STDC__ | defined __cplusplus
(register tTree exp, register int val)
# else
(exp, val)
register tTree exp;
register int val;
# endif
{
if (exp->Kind == kVAR_PARAM) {
if (exp->VAR_PARAM.V->Kind == kADDR) {
# line 847 "AdaptDistributions.puma"
{
# line 848 "AdaptDistributions.puma"
exp->VAR_PARAM.V->ADDR.E = ChangeConstValue (exp->VAR_PARAM.V->ADDR.E, val);
}
return exp;
}
# line 852 "AdaptDistributions.puma"
{
# line 853 "AdaptDistributions.puma"
exp->VAR_PARAM.V = mADDR (mCONST_EXP (mINT_CONSTANT (val)));
}
return exp;
}
if (exp->Kind == kCONST_EXP) {
if (exp->CONST_EXP.C->Kind == kINT_CONSTANT) {
# line 857 "AdaptDistributions.puma"
{
# line 858 "AdaptDistributions.puma"
exp->CONST_EXP.C->INT_CONSTANT.value = val;
}
return exp;
}
}
# line 862 "AdaptDistributions.puma"
return mCONST_EXP (mINT_CONSTANT (val));
}
static void PermuteIntrinsicSubroutine
# if defined __STDC__ | defined __cplusplus
(register tIdent name, register tTree params)
# else
(name, params)
register tIdent name;
register tTree params;
# endif
{
if (params == NoTree) return;
if (equaltIdent (name, MakeIdent ("CMF_RANDOM", 10))) {
# line 874 "AdaptDistributions.puma"
{
# line 875 "AdaptDistributions.puma"
TransformParamDistributions (params, true);
}
return;
}
if (equaltIdent (name, MakeIdent ("CMF_RANDOMIZE", 13))) {
# line 878 "AdaptDistributions.puma"
{
# line 879 "AdaptDistributions.puma"
TransformParamDistributions (params, true);
}
return;
}
if (equaltIdent (name, MakeIdent ("WALLTIME", 8))) {
# line 882 "AdaptDistributions.puma"
{
# line 883 "AdaptDistributions.puma"
TransformParamDistributions (params, true);
}
return;
}
if (equaltIdent (name, MakeIdent ("CM_TIMER_CLEAR", 14))) {
# line 886 "AdaptDistributions.puma"
{
# line 887 "AdaptDistributions.puma"
TransformParamDistributions (params, true);
}
return;
}
if (equaltIdent (name, MakeIdent ("CM_TIMER_PRINT", 14))) {
# line 890 "AdaptDistributions.puma"
{
# line 891 "AdaptDistributions.puma"
TransformParamDistributions (params, true);
}
return;
}
if (equaltIdent (name, MakeIdent ("CM_TIMER_START", 14))) {
# line 894 "AdaptDistributions.puma"
{
# line 895 "AdaptDistributions.puma"
TransformParamDistributions (params, true);
}
return;
}
if (equaltIdent (name, MakeIdent ("CM_TIMER_STOP", 13))) {
# line 898 "AdaptDistributions.puma"
{
# line 899 "AdaptDistributions.puma"
TransformParamDistributions (params, true);
}
return;
}
if (equaltIdent (name, MakeIdent ("GLOBAL_GET", 10))) {
# line 902 "AdaptDistributions.puma"
{
# line 903 "AdaptDistributions.puma"
PermuteGlobalGetParams (params);
}
return;
}
if (equaltIdent (name, MakeIdent ("GLOBAL_SEND", 11))) {
# line 906 "AdaptDistributions.puma"
{
# line 907 "AdaptDistributions.puma"
PermuteGlobalSendParams (params);
}
return;
}
# line 910 "AdaptDistributions.puma"
{
# line 911 "AdaptDistributions.puma"
error_protocol ("Unknown intrinsic Subroutine in Distributions");
}
return;
;
}
static void PermuteGlobalGetParams
# if defined __STDC__ | defined __cplusplus
(register tTree param_list)
# else
(param_list)
register tTree param_list;
# endif
{
# line 922 "AdaptDistributions.puma"
int rank;
tTree A, B, M, indexes;
Permutation perm;
if (param_list == NoTree) return;
# line 928 "AdaptDistributions.puma"
{
# line 930 "AdaptDistributions.puma"
SplitGet (param_list, &rank, &A, &B, &indexes, &M);
perm = PermuteExpression (A);
SwitchGetSendIndexes (perm, indexes, rank);
if (M != NoTree)
SwitchGetSendIndex (perm, M);
perm = PermuteExpression (B);
switch_parameters (indexes, perm);
}
return;
;
}
static void PermuteGlobalSendParams
# if defined __STDC__ | defined __cplusplus
(register tTree param_list)
# else
(param_list)
register tTree param_list;
# endif
{
# line 957 "AdaptDistributions.puma"
int rank;
tTree A, B, M, indexes, op;
Permutation perm;
if (param_list == NoTree) return;
# line 963 "AdaptDistributions.puma"
{
# line 965 "AdaptDistributions.puma"
SplitSend (param_list, &rank, &A, &B, &indexes, &M, &op);
perm = PermuteExpression (A);
SwitchGetSendIndexes (perm, indexes, rank);
if (M != NoTree)
SwitchGetSendIndex (perm, M);
perm = PermuteExpression (B);
switch_parameters (indexes, perm);
}
return;
;
}
static void SwitchGetSendIndexes
# if defined __STDC__ | defined __cplusplus
(Permutation ap, register tTree indexlist, register int n)
# else
(ap, indexlist, n)
Permutation ap;
register tTree indexlist;
register int n;
# endif
{
if (indexlist == NoTree) return;
if (equalint (n, 0)) {
# line 986 "AdaptDistributions.puma"
return;
}
if (indexlist->Kind == kBTP_LIST) {
if (indexlist->BTP_LIST.Elem->Kind == kVAR_PARAM) {
# line 989 "AdaptDistributions.puma"
{
# line 991 "AdaptDistributions.puma"
SwitchGetSendIndex (ap, indexlist->BTP_LIST.Elem->VAR_PARAM.V);
# line 992 "AdaptDistributions.puma"
SwitchGetSendIndexes (ap, indexlist->BTP_LIST.Next, n - 1);
}
return;
}
}
;
}
static void SwitchGetSendIndex
# if defined __STDC__ | defined __cplusplus
(Permutation ap, register tTree index)
# else
(ap, index)
Permutation ap;
register tTree index;
# endif
{
if (index == NoTree) return;
# line 997 "AdaptDistributions.puma"
{
Permutation ip;
{
# line 999 "AdaptDistributions.puma"
# line 1001 "AdaptDistributions.puma"
ip = PermuteExpression (index);
if (!equal_permutations (ip, ap))
{ error_protocol ("implicit transpose global get/send");
tree_protocol ("not conform is ", index);
}
}
return;
}
;
}
static void ResolveDistTranspose
# if defined __STDC__ | defined __cplusplus
(register tTree t, Permutation dist1, Permutation dist2)
# else
(t, dist1, dist2)
register tTree t;
Permutation dist1;
Permutation dist2;
# endif
{
if (t == NoTree) return;
if (t->Kind == kASSIGN_STMT) {
# line 1022 "AdaptDistributions.puma"
{
tTree f;
tTree pl;
tIdent n;
{
# line 1024 "AdaptDistributions.puma"
# line 1025 "AdaptDistributions.puma"
# line 1026 "AdaptDistributions.puma"
# line 1028 "AdaptDistributions.puma"
if (! ((transpose_permutations (dist1, dist2) != false))) goto yyL1;
{
# line 1030 "AdaptDistributions.puma"
n = MakeIdent ("TRANSPOSE", 9);
pl = mBTP_LIST (ExpToVarParam (t->ASSIGN_STMT.ASSIGN_EXP), mBTP_EMPTY());
f = mPROC_OBJ (MakeIdent("TRANSPOSE",9));
f->PROC_OBJ.Object = GetDeclEntry (n, GetIntrinsicEntries ());
t->ASSIGN_STMT.ASSIGN_EXP = mFUNC_CALL_EXP (f, pl);
}
}
return;
}
yyL1:;
}
# line 1038 "AdaptDistributions.puma"
{
# line 1039 "AdaptDistributions.puma"
error_protocol ("implicit transpose in assignment not resolved");
}
return;
;
}
void BeginAdaptDistributions ()
{
}
void CloseAdaptDistributions ()
{
}