home *** CD-ROM | disk | FTP | other *** search
- # include "Scalar.h"
- # include "yyAScala.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 8 "AdaptScalar.puma"
-
- # include <stdio.h>
- # include "Idents.h"
- # include "StringMe.h"
-
- # include "protocol.h"
-
- # include "Types.h" /* LastIndex */
- # include "Transfor.h" /* ExpToVarParam */
- # include "Dalib.h" /* IsHost, ... */
- # include "Movement.h" /* AdaptNNCopy */
- # include "Reductio.h"
- # include "Local.h" /* LocalArrayAssignment */
- # include "Broadcas.h" /* MakeBroadcast */
-
-
-
- static FILE * yyf = stdout;
-
- static void yyAbort
- # ifdef __cplusplus
- (char * yyFunction)
- # else
- (yyFunction) char * yyFunction;
- # endif
- {
- (void) fprintf (stderr, "Error: module AdaptScalar, routine %s failed\n", yyFunction);
- exit (1);
- }
-
- tTree AdaptScalarAssign ARGS((tTree assign, int vardistribution, int expdistribution));
- static tTree AdaptScalarReduction ARGS((tTree assign, tTree var, tTree exp));
- static tTree GenReductionStmt ARGS((tTree var, tTree funccall));
-
- tTree AdaptScalarAssign
- # if defined __STDC__ | defined __cplusplus
- (register tTree assign, register int vardistribution, register int expdistribution)
- # else
- (assign, vardistribution, expdistribution)
- register tTree assign;
- register int vardistribution;
- register int expdistribution;
- # endif
- {
- # line 34 "AdaptScalar.puma"
-
- tTree mask, t;
- char string[200];
-
- if (assign->Kind == kACF_BASIC) {
- if (assign->ACF_BASIC.BASIC_STMT->Kind == kASSIGN_STMT) {
- if (equalint (vardistribution, 0)) {
- if (equalint (expdistribution, 0)) {
- # line 45 "AdaptScalar.puma"
- return assign;
-
- }
- }
- if (assign->ACF_BASIC.BASIC_STMT->ASSIGN_STMT.ASSIGN_EXP->Kind == kVAR_EXP) {
- if (assign->ACF_BASIC.BASIC_STMT->ASSIGN_STMT.ASSIGN_EXP->VAR_EXP.V->Kind == kINDEXED_VAR) {
- {
- tTree new;
- if (equalint (vardistribution, 0)) {
- if (equalint (expdistribution, - 1)) {
- # line 58 "AdaptScalar.puma"
- {
- # line 61 "AdaptScalar.puma"
-
- # line 63 "AdaptScalar.puma"
- if (IsHost)
- { new = MakeBroadcast (CopyTree (assign->ACF_BASIC.BASIC_STMT->ASSIGN_STMT.ASSIGN_VAR));
- new = mACF_LIST (assign, mACF_LIST (new, NoTree));
- }
- else
- new = MakeBroadcast (assign->ACF_BASIC.BASIC_STMT->ASSIGN_STMT.ASSIGN_VAR);
-
- }
- {
- return new;
- }
-
- }
- }
- }
- {
- tTree params;
- tTree new;
- if (equalint (vardistribution, 0)) {
- if (equalint (expdistribution, 1)) {
- # line 82 "AdaptScalar.puma"
- {
- # line 89 "AdaptScalar.puma"
-
- # line 90 "AdaptScalar.puma"
-
- # line 92 "AdaptScalar.puma"
- params = DalibLastActualParam (assign->ACF_BASIC.BASIC_STMT->ASSIGN_STMT.ASSIGN_EXP->VAR_EXP.V, mBTP_EMPTY());
- params = DalibLastFormalParam (assign->ACF_BASIC.BASIC_STMT->ASSIGN_STMT.ASSIGN_EXP->VAR_EXP.V, params);
- params = DalibTreeSizeParam (assign->ACF_BASIC.BASIC_STMT->ASSIGN_STMT.ASSIGN_EXP->VAR_EXP.V, params);
- if (IsHost)
- params = mBTP_LIST (mVAR_PARAM (CopyTree(assign->ACF_BASIC.BASIC_STMT->ASSIGN_STMT.ASSIGN_VAR)), params);
- else
- params = mBTP_LIST (mVAR_PARAM (assign->ACF_BASIC.BASIC_STMT->ASSIGN_STMT.ASSIGN_EXP->VAR_EXP.V), params);
-
- params = mBTP_LIST (mVAR_PARAM (assign->ACF_BASIC.BASIC_STMT->ASSIGN_STMT.ASSIGN_VAR), params);
-
- new = mCALL_STMT (mPROC_OBJ (MakeDalibId ("node_get")), params);
- new = mACF_BASIC (new);
-
- }
- {
- return new;
- }
-
- }
- }
- }
- }
- }
- if (equalint (vardistribution, 0)) {
- # line 115 "AdaptScalar.puma"
- {
- # line 116 "AdaptScalar.puma"
- if (! ((IsReduction (assign) == true))) goto yyL4;
- {
- # line 117 "AdaptScalar.puma"
- t = AdaptScalarReduction (assign, assign->ACF_BASIC.BASIC_STMT->ASSIGN_STMT.ASSIGN_VAR, assign->ACF_BASIC.BASIC_STMT->ASSIGN_STMT.ASSIGN_EXP);
- if (t == NoTree)
- error_protocol ("adaption of reduction fails\n");
-
- }
- }
- return t;
- yyL4:;
-
- }
- if (assign->ACF_BASIC.BASIC_STMT->ASSIGN_STMT.ASSIGN_VAR->Kind == kINDEXED_VAR) {
- if (equalint (vardistribution, 1)) {
- if (equalint (expdistribution, 0)) {
- # line 130 "AdaptScalar.puma"
- {
- # line 134 "AdaptScalar.puma"
- if (IsHost)
- t = NoTree;
- else
- t = LocalArrayAssignment (assign);
-
-
- }
- return t;
-
- }
- }
- if (equalint (vardistribution, 1)) {
- if (equalint (expdistribution, 1)) {
- # line 149 "AdaptScalar.puma"
- {
- # line 150 "AdaptScalar.puma"
- if (!IsHost)
- { if (CountMovements (assign->ACF_BASIC.BASIC_STMT->ASSIGN_STMT.ASSIGN_VAR, assign->ACF_BASIC.BASIC_STMT->ASSIGN_STMT.ASSIGN_EXP) == 0)
- {
- t = LocalArrayAssignment (assign);
- }
- else if (assign->ACF_BASIC.BASIC_STMT->ASSIGN_STMT.ASSIGN_EXP->Kind != kVAR_EXP)
- { error_protocol ("Scalar Node-Copy failed");
- t = NoTree;
- }
- else
- {
- stmt_protocol ("Scalar Node<->Node Transfer");
- t = AdaptNNCopy (assign->ACF_BASIC.BASIC_STMT->ASSIGN_STMT.ASSIGN_VAR, assign->ACF_BASIC.BASIC_STMT->ASSIGN_STMT.ASSIGN_EXP->VAR_EXP.V);
- if (t == NoTree)
- error_protocol ("fails");
- else
- tree_protocol ("becomes : ", t);
- }
- }
- else t = NoTree;
-
- }
- return t;
-
- }
- }
- if (equalint (vardistribution, - 1)) {
- if (equalint (expdistribution, 0)) {
- # line 179 "AdaptScalar.puma"
- {
- # line 183 "AdaptScalar.puma"
- if (IsHost)
- mask = assign;
- else
- mask = NoTree;
-
- }
- return mask;
-
- }
- }
- if (equalint (vardistribution, - 1)) {
- if (equalint (expdistribution, - 1)) {
- # line 191 "AdaptScalar.puma"
- {
- # line 195 "AdaptScalar.puma"
- if (IsHost)
- mask = assign;
- else
- mask = NoTree;
-
- }
- return mask;
-
- }
- }
- }
- }
- }
- if (equalint (vardistribution, - 1)) {
- # line 203 "AdaptScalar.puma"
- {
- # line 204 "AdaptScalar.puma"
- error_protocol ("Update of a host var with distributed var");
- }
- return assign;
-
- }
- # line 208 "AdaptScalar.puma"
- {
- # line 209 "AdaptScalar.puma"
- sprintf (string, "AdaptScalarAssign failed, vardist= %d, expdist= %d\n", vardistribution, expdistribution);
- # line 211 "AdaptScalar.puma"
- error_protocol (string);
- }
- return assign;
-
- }
-
- static tTree AdaptScalarReduction
- # if defined __STDC__ | defined __cplusplus
- (register tTree assign, register tTree var, register tTree exp)
- # else
- (assign, var, exp)
- register tTree assign;
- register tTree var;
- register tTree exp;
- # endif
- {
- # line 224 "AdaptScalar.puma"
-
- tTree mask, t, last;
-
- if (exp->Kind == kFUNC_CALL_EXP) {
- if (exp->FUNC_CALL_EXP.FUNC_PARAMS->Kind == kBTP_LIST) {
- if (exp->FUNC_CALL_EXP.FUNC_PARAMS->BTP_LIST.Elem->Kind == kVAR_PARAM) {
- if (exp->FUNC_CALL_EXP.FUNC_PARAMS->BTP_LIST.Elem->VAR_PARAM.V->Kind == kUSED_VAR) {
- # line 228 "AdaptScalar.puma"
- {
- # line 230 "AdaptScalar.puma"
-
- t = GenReductionStmt (var, exp);
- if (t == NoTree)
- { error_protocol ("generate reduction fails");
- t = assign;
- }
- else
- { stmt_protocol ("Global reduction: ");
- if (!IsHost)
- t = mACF_LIST (assign, mACF_LIST (t, NoTree));
- }
-
- }
- return t;
-
- }
- if (exp->FUNC_CALL_EXP.FUNC_PARAMS->BTP_LIST.Elem->VAR_PARAM.V->Kind == kINDEXED_VAR) {
- # line 245 "AdaptScalar.puma"
- {
- # line 247 "AdaptScalar.puma"
-
- t = GenReductionStmt (var, exp);
- if (!IsHost)
- {
- t = mACF_LIST (assign, mACF_LIST (t, NoTree));
- last = LastIndex (exp->FUNC_CALL_EXP.FUNC_PARAMS->BTP_LIST.Elem->VAR_PARAM.V->INDEXED_VAR.IND_EXPS);
- if (last->Kind == kSLICE_EXP)
- {
- mask = MakeRangeStmt (exp->FUNC_CALL_EXP.FUNC_PARAMS->BTP_LIST.Elem->VAR_PARAM.V->INDEXED_VAR.IND_VAR, last);
-
- if (mask != NoTree)
- t = mACF_LIST (mask, t);
- }
- else
- {
- mask = MakeRangeStmt (exp->FUNC_CALL_EXP.FUNC_PARAMS->BTP_LIST.Elem->VAR_PARAM.V->INDEXED_VAR.IND_VAR, last);
-
- if (mask != NoTree)
- t = mACF_LIST (mask, t);
- }
- }
-
- }
- return t;
-
- }
- }
- }
- }
- # line 272 "AdaptScalar.puma"
- return NoTree;
-
- }
-
- static tTree GenReductionStmt
- # if defined __STDC__ | defined __cplusplus
- (register tTree var, register tTree funccall)
- # else
- (var, funccall)
- register tTree var;
- register tTree funccall;
- # endif
- {
- # line 279 "AdaptScalar.puma"
- tTree t;
- if (funccall->Kind == kFUNC_CALL_EXP) {
- if (funccall->FUNC_CALL_EXP.FUNC_PARAMS->Kind == kBTP_LIST) {
- if (funccall->FUNC_CALL_EXP.FUNC_PARAMS->BTP_LIST.Next->Kind == kBTP_EMPTY) {
- # line 281 "AdaptScalar.puma"
- {
- # line 282 "AdaptScalar.puma"
- t = GlobalReductionStmt (var, TreeType (var), funccall->FUNC_CALL_EXP.FUNC_ID);
- }
- return t;
-
- }
- }
- # line 287 "AdaptScalar.puma"
- {
- # line 288 "AdaptScalar.puma"
- printf ("Generate Reduction Statement failed (too many params)\n");
- # line 289 "AdaptScalar.puma"
- printf ("var = ");
- # line 289 "AdaptScalar.puma"
- FileUnparse (stdout, var);
- # line 289 "AdaptScalar.puma"
- printf ("\n");
- # line 290 "AdaptScalar.puma"
- printf ("call = ");
- # line 290 "AdaptScalar.puma"
- FileUnparse (stdout, funccall);
- # line 290 "AdaptScalar.puma"
- printf ("\n");
- }
- return NoTree;
-
- }
- yyAbort ("GenReductionStmt");
- }
-
- void BeginAdaptScalar ()
- {
- }
-
- void CloseAdaptScalar ()
- {
- }