home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
OS/2 Professional
/
OS2PRO194.ISO
/
os2
/
prgramer
/
adaptor
/
src
/
adapton.c
< prev
next >
Wrap
Text File
|
1994-01-02
|
11KB
|
480 lines
# include "On.h"
# include "yyAOn.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 24 "AdaptOn.puma"
# include <stdio.h>
# include "Idents.h"
# include "StringMe.h"
# include "protocol.h"
# include "Types.h"
# include "Transfor.h" /* IsHost, CombineACF, ReplaceACF */
# include "Dalib.h" /* MaskNodeStmt, IsHost, ... */
# include "Local.h" /* MakeRangeStmt, MakeMask */
# include "Broadcas.h" /* MakeSizeExp */
# include "Reductio.h" /* GlobalReductionStmt, ResolveReduce */
static FILE * yyf = stdout;
static void yyAbort
# ifdef __cplusplus
(char * yyFunction)
# else
(yyFunction) char * yyFunction;
# endif
{
(void) fprintf (stderr, "Error: module AdaptOn, routine %s failed\n", yyFunction);
exit (1);
}
tTree AdaptOn ARGS((tTree stmt));
static tTree CollectREDUCE ARGS((tTree t, tTree pv));
static tTree GlobalLocExchange ARGS((tTree params));
static void ReplaceREDUCE ARGS((tTree t));
tTree AdaptOn
# if defined __STDC__ | defined __cplusplus
(register tTree stmt)
# else
(stmt)
register tTree stmt;
# endif
{
if (stmt->Kind == kACF_ON) {
# line 58 "AdaptOn.puma"
{
tTree globals;
tTree newacf;
{
# line 62 "AdaptOn.puma"
if (! ((TreeDistribution (stmt->ACF_ON.ON_VAR) == - 1))) goto yyL1;
{
# line 64 "AdaptOn.puma"
# line 65 "AdaptOn.puma"
# line 67 "AdaptOn.puma"
globals = CollectREDUCE (stmt->ACF_ON.ON_STMT, stmt->ACF_ON.ON_VAR);
if (IsHost)
{ ReplaceREDUCE (stmt->ACF_ON.ON_STMT);
newacf = stmt->ACF_ON.ON_STMT;
}
else
newacf = NoTree;
if (globals != NoTree)
error_protocol ("Reductions for Host Variables not supported");
}
}
{
return newacf;
}
}
yyL1:;
# line 83 "AdaptOn.puma"
{
# line 85 "AdaptOn.puma"
if (! ((TreeDistribution (stmt->ACF_ON.ON_VAR) != 1))) goto yyL2;
{
# line 87 "AdaptOn.puma"
error_protocol ("illegal on statement\n");
}
}
return stmt->ACF_ON.ON_STMT;
yyL2:;
if (stmt->ACF_ON.ON_VAR->Kind == kINDEXED_VAR) {
if (stmt->ACF_ON.ON_STMT->Kind == kACF_DOLOCAL) {
# line 97 "AdaptOn.puma"
{
tTree last;
tTree globals;
tTree newacf;
{
# line 101 "AdaptOn.puma"
# line 102 "AdaptOn.puma"
# line 103 "AdaptOn.puma"
# line 105 "AdaptOn.puma"
last = LastIndex (stmt->ACF_ON.ON_VAR->INDEXED_VAR.IND_EXPS);
globals = CollectREDUCE (stmt->ACF_ON.ON_STMT, stmt->ACF_ON.ON_VAR);
if (!IsHost)
{ ReplaceREDUCE (stmt->ACF_ON.ON_STMT);
newacf = MakeRangeStmt (stmt->ACF_ON.ON_VAR->INDEXED_VAR.IND_VAR, stmt->ACF_ON.ON_STMT->ACF_DOLOCAL.DOLOCAL_RANGE);
stmt->ACF_ON.ON_STMT->Kind = kACF_DOVEC;
if (newacf != NoTree)
newacf = mACF_LIST (newacf, mACF_LIST (stmt->ACF_ON.ON_STMT, NoTree));
else
newacf = stmt->ACF_ON.ON_STMT;
}
else
newacf = NoTree;
newacf = CombineACF (newacf, globals);
}
{
return newacf;
}
}
}
# line 138 "AdaptOn.puma"
{
tTree last;
tTree globals;
tTree newacf;
{
# line 140 "AdaptOn.puma"
# line 141 "AdaptOn.puma"
# line 142 "AdaptOn.puma"
# line 144 "AdaptOn.puma"
globals = CollectREDUCE (stmt->ACF_ON.ON_STMT, stmt->ACF_ON.ON_VAR);
if (!IsHost)
{ ReplaceREDUCE (stmt->ACF_ON.ON_STMT);
newacf = MaskNodeStmt (stmt->ACF_ON.ON_STMT, stmt->ACF_ON.ON_VAR);
}
else
newacf = NoTree;
newacf = CombineACF (newacf, globals);
}
{
return newacf;
}
}
}
}
yyAbort ("AdaptOn");
}
static tTree CollectREDUCE
# if defined __STDC__ | defined __cplusplus
(register tTree t, register tTree pv)
# else
(t, pv)
register tTree t;
register tTree pv;
# endif
{
# line 182 "AdaptOn.puma"
tTree newacf;
switch (t->Kind) {
case kACF_DOLOCAL:
# line 186 "AdaptOn.puma"
return CollectREDUCE (t->ACF_DOLOCAL.DOLOCAL_BODY, pv);
case kACF_LIST:
# line 190 "AdaptOn.puma"
return (CombineACF (CollectREDUCE (t->ACF_LIST.Elem, pv), CollectREDUCE (t->ACF_LIST.Next, pv)));
case kACF_EMPTY:
# line 195 "AdaptOn.puma"
return NoTree;
case kACF_IF:
# line 199 "AdaptOn.puma"
return (CombineACF (CollectREDUCE (t->ACF_IF.THEN_PART, pv), CollectREDUCE (t->ACF_IF.ELSE_PART, pv)));
case kACF_WHILE:
# line 204 "AdaptOn.puma"
return CollectREDUCE (t->ACF_WHILE.WHILE_BODY, pv);
case kACF_DO:
# line 208 "AdaptOn.puma"
return CollectREDUCE (t->ACF_DO.DO_BODY, pv);
case kACF_DOVEC:
# line 212 "AdaptOn.puma"
return CollectREDUCE (t->ACF_DOVEC.DOVEC_BODY, pv);
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) {
# line 216 "AdaptOn.puma"
{
int distribution;
{
# line 218 "AdaptOn.puma"
# line 220 "AdaptOn.puma"
distribution = TreeDistribution (t->ACF_BASIC.BASIC_STMT->REDUCE_STMT.RED_PARAMS->BTP_LIST.Elem->VAR_PARAM.V);
# line 224 "AdaptOn.puma"
if (! (distribution != 0)) goto yyL8;
{
# line 226 "AdaptOn.puma"
if (distribution == -1)
{
if (TreeDistribution(pv) != -1)
{ error_protocol ("reduction to a node variable, but on host");
tree_protocol ("reduction is : \n", t);
tree_protocol ("on variable is : \n", pv);
}
}
else
{
if (CountMovements (t->ACF_BASIC.BASIC_STMT->REDUCE_STMT.RED_PARAMS->BTP_LIST.Elem->VAR_PARAM.V, pv) > 0)
{ error_protocol ("reduction to node variable requires movement");
tree_protocol ("reduction is : \n", t);
tree_protocol ("on variable is : \n", pv);
}
}
}
}
{
return NoTree;
}
}
yyL8:;
# line 246 "AdaptOn.puma"
{
# line 250 "AdaptOn.puma"
if (! (TreeRank (t->ACF_BASIC.BASIC_STMT->REDUCE_STMT.RED_PARAMS->BTP_LIST.Elem->VAR_PARAM.V) > 0)) goto yyL9;
{
# line 252 "AdaptOn.puma"
error_protocol ("reduction to a replicated array not handled\n");
# line 253 "AdaptOn.puma"
tree_protocol ("reduction is : \n", t);
}
}
return NoTree;
yyL9:;
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 258 "AdaptOn.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 267 "AdaptOn.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 277 "AdaptOn.puma"
return NoTree;
case kACF_DUMMY:
# line 281 "AdaptOn.puma"
return NoTree;
}
# line 285 "AdaptOn.puma"
{
# line 286 "AdaptOn.puma"
failure_protocol ("AdaptOn", "CollectREDUCE", t);
}
return NoTree;
}
static tTree GlobalLocExchange
# if defined __STDC__ | defined __cplusplus
(register tTree params)
# else
(params)
register tTree params;
# endif
{
# line 294 "AdaptOn.puma"
tTree newparams, stmt;
if (params->Kind == kBTP_EMPTY) {
# line 298 "AdaptOn.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 302 "AdaptOn.puma"
{
# line 304 "AdaptOn.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 void ReplaceREDUCE
# if defined __STDC__ | defined __cplusplus
(register tTree t)
# else
(t)
register tTree t;
# endif
{
# line 322 "AdaptOn.puma"
tTree newacf;
if (t == NoTree) return;
switch (t->Kind) {
case kACF_DOLOCAL:
# line 326 "AdaptOn.puma"
{
# line 327 "AdaptOn.puma"
ReplaceREDUCE (t->ACF_DOLOCAL.DOLOCAL_BODY);
}
return;
case kACF_LIST:
if (t->ACF_LIST.Elem->Kind == kACF_BASIC) {
if (t->ACF_LIST.Elem->ACF_BASIC.BASIC_STMT->Kind == kREDUCE_STMT) {
# line 330 "AdaptOn.puma"
{
# line 334 "AdaptOn.puma"
t->ACF_LIST.Elem = ResolveReduce (t->ACF_LIST.Elem);
# line 336 "AdaptOn.puma"
ReplaceREDUCE (t->ACF_LIST.Next);
}
return;
}
}
# line 339 "AdaptOn.puma"
{
# line 340 "AdaptOn.puma"
ReplaceREDUCE (t->ACF_LIST.Elem);
# line 341 "AdaptOn.puma"
ReplaceREDUCE (t->ACF_LIST.Next);
}
return;
case kACF_EMPTY:
# line 344 "AdaptOn.puma"
return;
case kACF_IF:
# line 347 "AdaptOn.puma"
{
# line 348 "AdaptOn.puma"
ReplaceREDUCE (t->ACF_IF.THEN_PART);
# line 349 "AdaptOn.puma"
ReplaceREDUCE (t->ACF_IF.ELSE_PART);
}
return;
case kACF_WHILE:
# line 352 "AdaptOn.puma"
{
# line 353 "AdaptOn.puma"
ReplaceREDUCE (t->ACF_WHILE.WHILE_BODY);
}
return;
case kACF_DO:
# line 356 "AdaptOn.puma"
{
# line 357 "AdaptOn.puma"
ReplaceREDUCE (t->ACF_DO.DO_BODY);
}
return;
case kACF_DOVEC:
# line 360 "AdaptOn.puma"
{
# line 361 "AdaptOn.puma"
ReplaceREDUCE (t->ACF_DOVEC.DOVEC_BODY);
}
return;
case kACF_BASIC:
# line 364 "AdaptOn.puma"
return;
}
;
}
void BeginAdaptOn ()
{
}
void CloseAdaptOn ()
{
}