home *** CD-ROM | disk | FTP | other *** search
/ OS/2 Professional / OS2PRO194.ISO / os2 / prgramer / adaptor / src / wmovemen.c < prev    next >
Encoding:
C/C++ Source or Header  |  1994-01-03  |  49.9 KB  |  1,810 lines
  1. # include "Movement.h"
  2. # include "yyAMovem.w"
  3. # include <stdio.h>
  4. # if defined __STDC__ | defined __cplusplus
  5. #  include <stdlib.h>
  6. # else
  7.    extern void exit ();
  8. # endif
  9. # include "Tree.h"
  10. # include "Definiti.h"
  11.  
  12. # ifndef NULL
  13. # define NULL 0L
  14. # endif
  15. # ifndef false
  16. # define false 0
  17. # endif
  18. # ifndef true
  19. # define true 1
  20. # endif
  21.  
  22. # ifdef yyInline
  23. # define yyALLOC(tree, free, max, alloc, nodesize, make, ptr, kind) \
  24.   if ((ptr = (tree) free) >= (tree) max) ptr = alloc (); \
  25.   free += nodesize [kind]; \
  26.   ptr->yyHead.yyMark = 0; \
  27.   ptr->Kind = kind;
  28. # else
  29. # define yyALLOC(tree, free, max, alloc, nodesize, make, ptr, kind) ptr = make (kind);
  30. # endif
  31.  
  32. # define yyWrite(s) (void) fputs (s, yyf)
  33. # define yyWriteNl (void) fputc ('\n', yyf)
  34.  
  35. # line 30 "AdaptMovement.puma"
  36.  
  37. # include <stdio.h>
  38. # include "Idents.h"
  39. # include "StringMe.h"
  40.  
  41. # include "protocol.h"
  42.  
  43. # include "Types.h"
  44. # include "Transfor.h"   /* ExpToVarParam */
  45. # include "Dalib.h"       /* MakeProcObj, ... */
  46. # include "Shapes.h"      /* MakeFullShape, NormalizeShape, ..  */
  47. # include "Local.h"  /* LocalArrayAssignment            */
  48. # include "Expressi.h" /* MakeConstant, MakeSliceExp, ... */
  49.  
  50. # include "Globals.h"     /* GenGlobalSend, GenGlobalGet     */
  51.  
  52.  
  53.  
  54. static FILE * yyf = stdout;
  55.  
  56. static void yyAbort
  57. # ifdef __cplusplus
  58.  (char * yyFunction)
  59. # else
  60.  (yyFunction) char * yyFunction;
  61. # endif
  62. {
  63.  (void) fprintf (stderr, "Error: module AdaptMovement, routine %s failed\n", yyFunction);
  64.  exit (1);
  65. }
  66.  
  67. tTree AdaptOverlappedMovement ARGS((tTree assign));
  68. static tTree MakeLocalOverlap ARGS((tTree var, tTree var1));
  69. static tTree MakeCommOverlap ARGS((tTree var, tTree var1));
  70. static tTree MakeOverlapBounds ARGS((tTree formals, tTree params));
  71. tTree AdaptTranspose ARGS((tTree assign));
  72. static tTree MakeLocalTranspose ARGS((tTree var, tTree var1));
  73. static tTree MakeCommTranspose ARGS((tTree var, tTree var1));
  74. tTree AdaptCShift ARGS((tTree assign));
  75. static tTree MakeLocalCShift ARGS((tTree var, tTree var1, tTree dim, tTree pos));
  76. static tTree MakeCommCShift ARGS((tTree var, tTree var1, tTree dim, tTree pos));
  77. static tTree MakeCShiftBounds ARGS((tTree formals, tTree params));
  78. static tTree MakeTransposeBounds ARGS((tTree formals, tTree size, tTree params));
  79. tTree AdaptArrayMovement ARGS((tTree assign, int vardistribution, int expdistribution));
  80. static tTree AdaptHNMovement ARGS((tTree assign));
  81. static tTree MakeHostNodeTransfer ARGS((tTree hostvar, tTree nodevar));
  82. static tTree AdaptNHMovement ARGS((tTree assign));
  83. static tTree MakeNodeHostTransfer ARGS((tTree nodevar, tTree hostvar));
  84. static tTree AdaptRNMovement ARGS((tTree assign));
  85. static tTree MakeAllNodeTransfer ARGS((tTree repvar, tTree nodevar));
  86. static tTree AdaptNNMovement ARGS((tTree assign, int moves));
  87. tTree AdaptNNCopy ARGS((tTree lvar, tTree rvar));
  88. static tTree AdaptHelpFn ARGS((tTree var, tTree slice, tTree params));
  89. static tTree AdaptNNIndirect ARGS((tTree lvar, int d1, tTree rvar, int d2));
  90. static tTree AdaptNNGet ARGS((tTree lvar, tTree rvar));
  91. static tTree AdaptNNSet ARGS((tTree lvar, tTree rvar));
  92. static bool IndexStrides ARGS((tTree t));
  93. static bool NoSliceExp ARGS((tTree t));
  94. static tTree MakeIndexParams ARGS((tTree indexes));
  95. static void CheckMoveArrays ARGS((tTree source, tTree target));
  96.  
  97. tTree AdaptOverlappedMovement
  98. # if defined __STDC__ | defined __cplusplus
  99. (register tTree assign)
  100. # else
  101. (assign)
  102.  register tTree assign;
  103. # endif
  104. {
  105.   if (assign->Kind == kACF_BASIC) {
  106.   if (assign->ACF_BASIC.BASIC_STMT->Kind == kASSIGN_STMT) {
  107.   if (assign->ACF_BASIC.BASIC_STMT->ASSIGN_STMT.ASSIGN_EXP->Kind == kVAR_EXP) {
  108. # line 60 "AdaptMovement.puma"
  109.  {
  110.   tTree new;
  111.   int dist;
  112.   {
  113. # line 62 "AdaptMovement.puma"
  114.  
  115. # line 63 "AdaptMovement.puma"
  116.  
  117. # line 65 "AdaptMovement.puma"
  118.  CheckMoveArrays (assign->ACF_BASIC.BASIC_STMT->ASSIGN_STMT.ASSIGN_VAR, assign->ACF_BASIC.BASIC_STMT->ASSIGN_STMT.ASSIGN_EXP->VAR_EXP.V);
  119.      new  = NoTree;
  120.      dist = TreeDistribution (assign->ACF_BASIC.BASIC_STMT->ASSIGN_STMT.ASSIGN_VAR);
  121.      if (TreeRank (assign->ACF_BASIC.BASIC_STMT->ASSIGN_STMT.ASSIGN_EXP->VAR_EXP.V) != TreeRank (assign->ACF_BASIC.BASIC_STMT->ASSIGN_STMT.ASSIGN_VAR))
  122.         error_protocol ("overlapped assign, var = var', var' is illegal");
  123.       else if (!IsWholeVar (assign->ACF_BASIC.BASIC_STMT->ASSIGN_STMT.ASSIGN_VAR))
  124.         error_protocol ("overlapped assign, var = var', var is sliced");
  125.       else if (!IsWholeVar (assign->ACF_BASIC.BASIC_STMT->ASSIGN_STMT.ASSIGN_EXP->VAR_EXP.V))
  126.         error_protocol ("overlapped assign, var = var', var' is sliced");
  127.       else if (IsArrayOverlapped(assign->ACF_BASIC.BASIC_STMT->ASSIGN_STMT.ASSIGN_EXP->VAR_EXP.V))
  128.         error_protocol ("overlapped assign, right side must not be overlapped");
  129.       else if (dist != TreeDistribution (assign->ACF_BASIC.BASIC_STMT->ASSIGN_STMT.ASSIGN_EXP->VAR_EXP.V))
  130.         error_protocol ("overlapped assign, different distributions");
  131.       else if (dist == 0)
  132.         new = MakeLocalOverlap (assign->ACF_BASIC.BASIC_STMT->ASSIGN_STMT.ASSIGN_VAR, assign->ACF_BASIC.BASIC_STMT->ASSIGN_STMT.ASSIGN_EXP->VAR_EXP.V);
  133.       else if (dist == -1)
  134.         { if (IsHost)
  135.             new = MakeLocalOverlap (assign->ACF_BASIC.BASIC_STMT->ASSIGN_STMT.ASSIGN_VAR, assign->ACF_BASIC.BASIC_STMT->ASSIGN_STMT.ASSIGN_EXP->VAR_EXP.V);
  136.            else
  137.             new = NoTree;
  138.         }
  139.       else
  140.         { if (!IsHost)
  141.             new = MakeCommOverlap (assign->ACF_BASIC.BASIC_STMT->ASSIGN_STMT.ASSIGN_VAR, assign->ACF_BASIC.BASIC_STMT->ASSIGN_STMT.ASSIGN_EXP->VAR_EXP.V);
  142.            else
  143.             new = NoTree;
  144.         }
  145.  
  146.   }
  147.   {
  148.    return new;
  149.   }
  150.  }
  151.  
  152.   }
  153.   }
  154. # line 96 "AdaptMovement.puma"
  155.   {
  156. # line 97 "AdaptMovement.puma"
  157.    error_protocol ("overlapped assign, not var = var'");
  158.   }
  159.    return assign;
  160.  
  161.   }
  162.  yyAbort ("AdaptOverlappedMovement");
  163. }
  164.  
  165. static tTree MakeLocalOverlap
  166. # if defined __STDC__ | defined __cplusplus
  167. (register tTree var, register tTree var1)
  168. # else
  169. (var, var1)
  170.  register tTree var;
  171.  register tTree var1;
  172. # endif
  173. {
  174.   if (var->Kind == kINDEXED_VAR) {
  175. # line 109 "AdaptMovement.puma"
  176.    return MakeLocalOverlap (var->INDEXED_VAR.IND_VAR, var1);
  177.  
  178.   }
  179.   if (var1->Kind == kINDEXED_VAR) {
  180. # line 113 "AdaptMovement.puma"
  181.    return MakeLocalOverlap (var, var1->INDEXED_VAR.IND_VAR);
  182.  
  183.   }
  184.   if (var->Kind == kUSED_VAR) {
  185.   if (var1->Kind == kUSED_VAR) {
  186. # line 117 "AdaptMovement.puma"
  187.  {
  188.   tTree new;
  189.   tTree params;
  190.   {
  191. # line 118 "AdaptMovement.puma"
  192.  
  193. # line 119 "AdaptMovement.puma"
  194.  
  195. # line 120 "AdaptMovement.puma"
  196.  stmt_protocol ("Local Overlap");
  197.      new    = mPROC_OBJ (MakeDalibId1 ("loverlap", VarRank(var->USED_VAR.VARNAME->VAR_OBJ.Object)));
  198.      params = mBTP_EMPTY();
  199.      params = mBTP_LIST (ExpToVarParam (MakeConstant (TreeSize (var))), params);
  200.      params = MakeOverlapBounds (ArrayFormals (var->USED_VAR.VARNAME->VAR_OBJ.Object), params);
  201.  
  202.      params = mBTP_LIST (mVAR_PARAM(var), mBTP_LIST (mVAR_PARAM(var1), params));
  203.      new    = mACF_BASIC (mCALL_STMT (new, params));
  204.      tree_protocol ("New Dalib Call is : ", new);
  205.  
  206.   }
  207.   {
  208.    return new;
  209.   }
  210.  }
  211.  
  212.   }
  213.   }
  214.  yyAbort ("MakeLocalOverlap");
  215. }
  216.  
  217. static tTree MakeCommOverlap
  218. # if defined __STDC__ | defined __cplusplus
  219. (register tTree var, register tTree var1)
  220. # else
  221. (var, var1)
  222.  register tTree var;
  223.  register tTree var1;
  224. # endif
  225. {
  226.   if (var->Kind == kINDEXED_VAR) {
  227. # line 141 "AdaptMovement.puma"
  228.    return MakeCommOverlap (var->INDEXED_VAR.IND_VAR, var1);
  229.  
  230.   }
  231.   if (var1->Kind == kINDEXED_VAR) {
  232. # line 145 "AdaptMovement.puma"
  233.    return MakeCommOverlap (var, var1->INDEXED_VAR.IND_VAR);
  234.  
  235.   }
  236.   if (var->Kind == kUSED_VAR) {
  237.   if (var1->Kind == kUSED_VAR) {
  238. # line 149 "AdaptMovement.puma"
  239.  {
  240.   tTree new;
  241.   tTree params;
  242.   {
  243. # line 150 "AdaptMovement.puma"
  244.  
  245. # line 151 "AdaptMovement.puma"
  246.  
  247. # line 152 "AdaptMovement.puma"
  248.  stmt_protocol ("Communication Overlap");
  249.      new    = mPROC_OBJ (MakeDalibId1 ("coverlap", VarRank(var->USED_VAR.VARNAME->VAR_OBJ.Object)));
  250.      params = mBTP_EMPTY();
  251.      params = mBTP_LIST (ExpToVarParam (MakeConstant (TreeSize (var))), params);
  252.      params = MakeOverlapBounds (ArrayFormals (var->USED_VAR.VARNAME->VAR_OBJ.Object), params);
  253.  
  254.      params = mBTP_LIST (mVAR_PARAM(var), mBTP_LIST (mVAR_PARAM(var1), params));
  255.      new    = mACF_BASIC (mCALL_STMT (new, params));
  256.      tree_protocol ("New Dalib Call is : ", new);
  257.  
  258.   }
  259.   {
  260.    return new;
  261.   }
  262.  }
  263.  
  264.   }
  265.   }
  266.  yyAbort ("MakeCommOverlap");
  267. }
  268.  
  269. static tTree MakeOverlapBounds
  270. # if defined __STDC__ | defined __cplusplus
  271. (register tTree formals, register tTree params)
  272. # else
  273. (formals, params)
  274.  register tTree formals;
  275.  register tTree params;
  276. # endif
  277. {
  278.   if (formals->Kind == kTYPE_EMPTY) {
  279. # line 173 "AdaptMovement.puma"
  280.    return params;
  281.  
  282.   }
  283.   if (formals->Kind == kTYPE_LIST) {
  284.   if (formals->TYPE_LIST.Elem->Kind == kINDEX_TYPE) {
  285. # line 177 "AdaptMovement.puma"
  286.  {
  287.   tTree plist;
  288.   {
  289. # line 178 "AdaptMovement.puma"
  290.  
  291. # line 179 "AdaptMovement.puma"
  292.  plist = MakeOverlapBounds (formals->TYPE_LIST.Next, params);
  293.       plist = mBTP_LIST (ExpToVarParam (MakeConstant (formals->TYPE_LIST.Elem->INDEX_TYPE.right_overlap)), plist);
  294.       plist = mBTP_LIST (ExpToVarParam (MakeConstant (formals->TYPE_LIST.Elem->INDEX_TYPE.left_overlap)), plist);
  295.       plist = mBTP_LIST (ExpToVarParam (MakeSliceExp (formals->TYPE_LIST.Elem->INDEX_TYPE.LOWER, formals->TYPE_LIST.Elem->INDEX_TYPE.UPPER)), plist);
  296.  
  297.   }
  298.   {
  299.    return plist;
  300.   }
  301.  }
  302.  
  303.   }
  304.   if (formals->TYPE_LIST.Elem->Kind == kDYNAMIC) {
  305.   if (formals->TYPE_LIST.Elem->DYNAMIC.Shape->Kind == kSLICE_EXP) {
  306. # line 187 "AdaptMovement.puma"
  307.  {
  308.   tTree plist;
  309.   {
  310. # line 188 "AdaptMovement.puma"
  311.  
  312. # line 189 "AdaptMovement.puma"
  313.  plist = MakeOverlapBounds (formals->TYPE_LIST.Next, params);
  314.       plist = mBTP_LIST (ExpToVarParam (MakeConstant (formals->TYPE_LIST.Elem->DYNAMIC.right_overlap)), plist);
  315.       plist = mBTP_LIST (ExpToVarParam (MakeConstant (formals->TYPE_LIST.Elem->DYNAMIC.left_overlap)), plist);
  316.       plist = mBTP_LIST (ExpToVarParam (MakeSliceExp (formals->TYPE_LIST.Elem->DYNAMIC.Shape->SLICE_EXP.START, formals->TYPE_LIST.Elem->DYNAMIC.Shape->SLICE_EXP.STOP)), plist);
  317.  
  318.   }
  319.   {
  320.    return plist;
  321.   }
  322.  }
  323.  
  324.   }
  325.   }
  326.   }
  327.  yyAbort ("MakeOverlapBounds");
  328. }
  329.  
  330. tTree AdaptTranspose
  331. # if defined __STDC__ | defined __cplusplus
  332. (register tTree assign)
  333. # else
  334. (assign)
  335.  register tTree assign;
  336. # endif
  337. {
  338.   if (assign->Kind == kACF_BASIC) {
  339.   if (assign->ACF_BASIC.BASIC_STMT->Kind == kASSIGN_STMT) {
  340.   if (assign->ACF_BASIC.BASIC_STMT->ASSIGN_STMT.ASSIGN_EXP->Kind == kFUNC_CALL_EXP) {
  341.   if (assign->ACF_BASIC.BASIC_STMT->ASSIGN_STMT.ASSIGN_EXP->FUNC_CALL_EXP.FUNC_PARAMS->Kind == kBTP_LIST) {
  342.   if (assign->ACF_BASIC.BASIC_STMT->ASSIGN_STMT.ASSIGN_EXP->FUNC_CALL_EXP.FUNC_PARAMS->BTP_LIST.Elem->Kind == kVAR_PARAM) {
  343.   if (assign->ACF_BASIC.BASIC_STMT->ASSIGN_STMT.ASSIGN_EXP->FUNC_CALL_EXP.FUNC_PARAMS->BTP_LIST.Next->Kind == kBTP_EMPTY) {
  344. # line 209 "AdaptMovement.puma"
  345.  {
  346.   tTree new;
  347.   int dist;
  348.   {
  349. # line 213 "AdaptMovement.puma"
  350.  
  351. # line 214 "AdaptMovement.puma"
  352.  
  353. # line 216 "AdaptMovement.puma"
  354.  CheckMoveArrays (assign->ACF_BASIC.BASIC_STMT->ASSIGN_STMT.ASSIGN_VAR, assign->ACF_BASIC.BASIC_STMT->ASSIGN_STMT.ASSIGN_EXP->FUNC_CALL_EXP.FUNC_PARAMS->BTP_LIST.Elem->VAR_PARAM.V);
  355.      new  = NoTree;
  356.      dist = TreeDistribution (assign->ACF_BASIC.BASIC_STMT->ASSIGN_STMT.ASSIGN_VAR);
  357.      if (!IsWholeVar (assign->ACF_BASIC.BASIC_STMT->ASSIGN_STMT.ASSIGN_VAR))
  358.         error_protocol ("var = transpose (var'), var is sliced");
  359.       else if (!IsWholeVar (assign->ACF_BASIC.BASIC_STMT->ASSIGN_STMT.ASSIGN_EXP->FUNC_CALL_EXP.FUNC_PARAMS->BTP_LIST.Elem->VAR_PARAM.V))
  360.         error_protocol ("var = transpose (var'), var' is sliced");
  361.       else if (dist != TreeDistribution (assign->ACF_BASIC.BASIC_STMT->ASSIGN_STMT.ASSIGN_EXP->FUNC_CALL_EXP.FUNC_PARAMS->BTP_LIST.Elem->VAR_PARAM.V))
  362.         error_protocol ("transpose, different distributions");
  363.       else if (dist == 0)
  364.         { if (target_language == FORTRAN_90)
  365.              new = assign;
  366.            else
  367.              new = MakeLocalTranspose (assign->ACF_BASIC.BASIC_STMT->ASSIGN_STMT.ASSIGN_VAR, assign->ACF_BASIC.BASIC_STMT->ASSIGN_STMT.ASSIGN_EXP->FUNC_CALL_EXP.FUNC_PARAMS->BTP_LIST.Elem->VAR_PARAM.V);
  368.         }
  369.       else if (dist == -1)
  370.         { if (!IsHost)
  371.              new = NoTree;
  372.            else if (target_language == FORTRAN_90)
  373.              new = assign;
  374.            else
  375.              new = MakeLocalTranspose (assign->ACF_BASIC.BASIC_STMT->ASSIGN_STMT.ASSIGN_VAR, assign->ACF_BASIC.BASIC_STMT->ASSIGN_STMT.ASSIGN_EXP->FUNC_CALL_EXP.FUNC_PARAMS->BTP_LIST.Elem->VAR_PARAM.V);
  376.         }
  377.       else
  378.         { if (!IsHost)
  379.             new = MakeCommTranspose (assign->ACF_BASIC.BASIC_STMT->ASSIGN_STMT.ASSIGN_VAR, assign->ACF_BASIC.BASIC_STMT->ASSIGN_STMT.ASSIGN_EXP->FUNC_CALL_EXP.FUNC_PARAMS->BTP_LIST.Elem->VAR_PARAM.V);
  380.            else
  381.             new = NoTree;
  382.         }
  383.  
  384.   }
  385.   {
  386.    return new;
  387.   }
  388.  }
  389.  
  390.   }
  391.   }
  392.   }
  393.   }
  394.   }
  395. # line 249 "AdaptMovement.puma"
  396.   {
  397. # line 250 "AdaptMovement.puma"
  398.    error_protocol ("transpose, illegal use");
  399.   }
  400.    return assign;
  401.  
  402.   }
  403.  yyAbort ("AdaptTranspose");
  404. }
  405.  
  406. static tTree MakeLocalTranspose
  407. # if defined __STDC__ | defined __cplusplus
  408. (register tTree var, register tTree var1)
  409. # else
  410. (var, var1)
  411.  register tTree var;
  412.  register tTree var1;
  413. # endif
  414. {
  415.   if (var->Kind == kINDEXED_VAR) {
  416. # line 266 "AdaptMovement.puma"
  417.    return MakeLocalTranspose (var->INDEXED_VAR.IND_VAR, var1);
  418.  
  419.   }
  420.   if (var1->Kind == kINDEXED_VAR) {
  421. # line 270 "AdaptMovement.puma"
  422.    return MakeLocalTranspose (var, var1->INDEXED_VAR.IND_VAR);
  423.  
  424.   }
  425.   if (var->Kind == kUSED_VAR) {
  426.   if (var1->Kind == kUSED_VAR) {
  427. # line 274 "AdaptMovement.puma"
  428.  {
  429.   tTree new;
  430.   tTree params;
  431.   {
  432. # line 276 "AdaptMovement.puma"
  433.  
  434. # line 277 "AdaptMovement.puma"
  435.  
  436. # line 278 "AdaptMovement.puma"
  437.  stmt_protocol ("Local Transpose");
  438.      new    = mPROC_OBJ (MakeDalibId ("ltranspose"));
  439.      params = mBTP_EMPTY();
  440.      params = MakeTransposeBounds (ArrayFormals (var->USED_VAR.VARNAME->VAR_OBJ.Object),
  441.                                    MakeConstant (TreeSize (var)),
  442.                                    params);
  443.      params = mBTP_LIST (mVAR_PARAM (var1),params);
  444.      params = mBTP_LIST (mVAR_PARAM (var), params);
  445.      new    = mACF_BASIC (mCALL_STMT (new, params));
  446.      tree_protocol ("New Dalib Call is : ", new);
  447.  
  448.   }
  449.   {
  450.    return new;
  451.   }
  452.  }
  453.  
  454.   }
  455.   }
  456.  yyAbort ("MakeLocalTranspose");
  457. }
  458.  
  459. static tTree MakeCommTranspose
  460. # if defined __STDC__ | defined __cplusplus
  461. (register tTree var, register tTree var1)
  462. # else
  463. (var, var1)
  464.  register tTree var;
  465.  register tTree var1;
  466. # endif
  467. {
  468.   if (var->Kind == kINDEXED_VAR) {
  469. # line 304 "AdaptMovement.puma"
  470.    return MakeCommTranspose (var->INDEXED_VAR.IND_VAR, var1);
  471.  
  472.   }
  473.   if (var1->Kind == kINDEXED_VAR) {
  474. # line 308 "AdaptMovement.puma"
  475.    return MakeCommTranspose (var, var1->INDEXED_VAR.IND_VAR);
  476.  
  477.   }
  478.   if (var->Kind == kUSED_VAR) {
  479.   if (var1->Kind == kUSED_VAR) {
  480. # line 312 "AdaptMovement.puma"
  481.  {
  482.   tTree new;
  483.   tTree params;
  484.   {
  485. # line 314 "AdaptMovement.puma"
  486.  
  487. # line 315 "AdaptMovement.puma"
  488.  
  489. # line 316 "AdaptMovement.puma"
  490.  stmt_protocol ("Communication Transpose");
  491.      new    = mPROC_OBJ (MakeDalibId ("transpose"));
  492.      params = mBTP_EMPTY();
  493.      params = MakeTransposeBounds (ArrayFormals (var->USED_VAR.VARNAME->VAR_OBJ.Object),
  494.                                    MakeConstant (TreeSize (var)),
  495.                                    params);
  496.      params = mBTP_LIST (mVAR_PARAM (var1),params);
  497.      params = mBTP_LIST (mVAR_PARAM (var), params);
  498.      new    = mACF_BASIC (mCALL_STMT (new, params));
  499.      tree_protocol ("New Dalib Call is : ", new);
  500.  
  501.   }
  502.   {
  503.    return new;
  504.   }
  505.  }
  506.  
  507.   }
  508.   }
  509.  yyAbort ("MakeCommTranspose");
  510. }
  511.  
  512. tTree AdaptCShift
  513. # if defined __STDC__ | defined __cplusplus
  514. (register tTree assign)
  515. # else
  516. (assign)
  517.  register tTree assign;
  518. # endif
  519. {
  520.   if (assign->Kind == kACF_BASIC) {
  521.   if (assign->ACF_BASIC.BASIC_STMT->Kind == kASSIGN_STMT) {
  522.   if (assign->ACF_BASIC.BASIC_STMT->ASSIGN_STMT.ASSIGN_EXP->Kind == kFUNC_CALL_EXP) {
  523.   if (assign->ACF_BASIC.BASIC_STMT->ASSIGN_STMT.ASSIGN_EXP->FUNC_CALL_EXP.FUNC_PARAMS->Kind == kBTP_LIST) {
  524.   if (assign->ACF_BASIC.BASIC_STMT->ASSIGN_STMT.ASSIGN_EXP->FUNC_CALL_EXP.FUNC_PARAMS->BTP_LIST.Elem->Kind == kVAR_PARAM) {
  525.   if (assign->ACF_BASIC.BASIC_STMT->ASSIGN_STMT.ASSIGN_EXP->FUNC_CALL_EXP.FUNC_PARAMS->BTP_LIST.Next->Kind == kBTP_LIST) {
  526.   if (assign->ACF_BASIC.BASIC_STMT->ASSIGN_STMT.ASSIGN_EXP->FUNC_CALL_EXP.FUNC_PARAMS->BTP_LIST.Next->BTP_LIST.Next->Kind == kBTP_LIST) {
  527.   if (assign->ACF_BASIC.BASIC_STMT->ASSIGN_STMT.ASSIGN_EXP->FUNC_CALL_EXP.FUNC_PARAMS->BTP_LIST.Next->BTP_LIST.Next->BTP_LIST.Next->Kind == kBTP_EMPTY) {
  528. # line 342 "AdaptMovement.puma"
  529.  {
  530.   tTree new;
  531.   int dist;
  532.   {
  533. # line 348 "AdaptMovement.puma"
  534.  
  535. # line 349 "AdaptMovement.puma"
  536.  
  537. # line 351 "AdaptMovement.puma"
  538.  CheckMoveArrays (assign->ACF_BASIC.BASIC_STMT->ASSIGN_STMT.ASSIGN_VAR, assign->ACF_BASIC.BASIC_STMT->ASSIGN_STMT.ASSIGN_EXP->FUNC_CALL_EXP.FUNC_PARAMS->BTP_LIST.Elem->VAR_PARAM.V);
  539.      new  = NoTree;
  540.      dist = TreeDistribution (assign->ACF_BASIC.BASIC_STMT->ASSIGN_STMT.ASSIGN_VAR);
  541.      if (!IsWholeVar (assign->ACF_BASIC.BASIC_STMT->ASSIGN_STMT.ASSIGN_VAR))
  542.         error_protocol ("cshift var = cshift (var',...), var is sliced");
  543.       else if (!IsWholeVar (assign->ACF_BASIC.BASIC_STMT->ASSIGN_STMT.ASSIGN_EXP->FUNC_CALL_EXP.FUNC_PARAMS->BTP_LIST.Elem->VAR_PARAM.V))
  544.         error_protocol ("cshift var = cshift (var',...), var' is sliced");
  545.       else if (dist != TreeDistribution (assign->ACF_BASIC.BASIC_STMT->ASSIGN_STMT.ASSIGN_EXP->FUNC_CALL_EXP.FUNC_PARAMS->BTP_LIST.Elem->VAR_PARAM.V))
  546.         error_protocol ("cshift, different distributions");
  547.       else if (dist == 0)
  548.         { if (target_language == FORTRAN_90)
  549.              new = assign;
  550.            else
  551.              new = MakeLocalCShift (assign->ACF_BASIC.BASIC_STMT->ASSIGN_STMT.ASSIGN_VAR, assign->ACF_BASIC.BASIC_STMT->ASSIGN_STMT.ASSIGN_EXP->FUNC_CALL_EXP.FUNC_PARAMS->BTP_LIST.Elem->VAR_PARAM.V, assign->ACF_BASIC.BASIC_STMT->ASSIGN_STMT.ASSIGN_EXP->
  552. FUNC_CALL_EXP.FUNC_PARAMS->BTP_LIST.Next->BTP_LIST.Elem, assign->ACF_BASIC.BASIC_STMT->ASSIGN_STMT.ASSIGN_EXP->FUNC_CALL_EXP.FUNC_PARAMS->BTP_LIST.Next->BTP_LIST.Next->BTP_LIST.Elem);
  553.         }
  554.       else if (dist == -1)
  555.         { if (!IsHost)
  556.              new = NoTree;
  557.            else if (target_language == FORTRAN_90)
  558.              new = assign;
  559.            else
  560.              new = MakeLocalCShift (assign->ACF_BASIC.BASIC_STMT->ASSIGN_STMT.ASSIGN_VAR, assign->ACF_BASIC.BASIC_STMT->ASSIGN_STMT.ASSIGN_EXP->FUNC_CALL_EXP.FUNC_PARAMS->BTP_LIST.Elem->VAR_PARAM.V, assign->ACF_BASIC.BASIC_STMT->ASSIGN_STMT.ASSIGN_EXP->
  561. FUNC_CALL_EXP.FUNC_PARAMS->BTP_LIST.Next->BTP_LIST.Elem, assign->ACF_BASIC.BASIC_STMT->ASSIGN_STMT.ASSIGN_EXP->FUNC_CALL_EXP.FUNC_PARAMS->BTP_LIST.Next->BTP_LIST.Next->BTP_LIST.Elem);
  562.         }
  563.       else
  564.         { if (!IsHost)
  565.             new = MakeCommCShift (assign->ACF_BASIC.BASIC_STMT->ASSIGN_STMT.ASSIGN_VAR, assign->ACF_BASIC.BASIC_STMT->ASSIGN_STMT.ASSIGN_EXP->FUNC_CALL_EXP.FUNC_PARAMS->BTP_LIST.Elem->VAR_PARAM.V, assign->ACF_BASIC.BASIC_STMT->ASSIGN_STMT.ASSIGN_EXP->
  566. FUNC_CALL_EXP.FUNC_PARAMS->BTP_LIST.Next->BTP_LIST.Elem, assign->ACF_BASIC.BASIC_STMT->ASSIGN_STMT.ASSIGN_EXP->FUNC_CALL_EXP.FUNC_PARAMS->BTP_LIST.Next->BTP_LIST.Next->BTP_LIST.Elem);
  567.            else
  568.             new = NoTree;
  569.         }
  570.  
  571.   }
  572.   {
  573.    return new;
  574.   }
  575.  }
  576.  
  577.   }
  578.   }
  579.   }
  580.   }
  581.   }
  582.   }
  583.   }
  584. # line 384 "AdaptMovement.puma"
  585.   {
  586. # line 385 "AdaptMovement.puma"
  587.    error_protocol ("cshift, illegal use");
  588.   }
  589.    return assign;
  590.  
  591.   }
  592.  yyAbort ("AdaptCShift");
  593. }
  594.  
  595. static tTree MakeLocalCShift
  596. # if defined __STDC__ | defined __cplusplus
  597. (register tTree var, register tTree var1, register tTree dim, register tTree pos)
  598. # else
  599. (var, var1, dim, pos)
  600.  register tTree var;
  601.  register tTree var1;
  602.  register tTree dim;
  603.  register tTree pos;
  604. # endif
  605. {
  606.   if (var->Kind == kINDEXED_VAR) {
  607. # line 397 "AdaptMovement.puma"
  608.    return MakeLocalCShift (var->INDEXED_VAR.IND_VAR, var1, dim, pos);
  609.  
  610.   }
  611.   if (var1->Kind == kINDEXED_VAR) {
  612. # line 401 "AdaptMovement.puma"
  613.    return MakeLocalCShift (var, var1->INDEXED_VAR.IND_VAR, dim, pos);
  614.  
  615.   }
  616.   if (var->Kind == kUSED_VAR) {
  617.   if (var1->Kind == kUSED_VAR) {
  618. # line 405 "AdaptMovement.puma"
  619.  {
  620.   tTree new;
  621.   tTree params;
  622.   {
  623. # line 407 "AdaptMovement.puma"
  624.  
  625. # line 408 "AdaptMovement.puma"
  626.  
  627. # line 409 "AdaptMovement.puma"
  628.  stmt_protocol ("Local CShift");
  629.      new    = mPROC_OBJ (MakeDalibId1 ("lcshift", VarRank(var->USED_VAR.VARNAME->VAR_OBJ.Object)));
  630.      params = mBTP_EMPTY();
  631.      params = mBTP_LIST (pos, params);
  632.      params = mBTP_LIST (dim, params);
  633.      params = MakeCShiftBounds (ArrayFormals (var->USED_VAR.VARNAME->VAR_OBJ.Object), params);
  634.      params = mBTP_LIST (ExpToVarParam (MakeConstant (TreeSize (var))), params);
  635.      params = mBTP_LIST (mVAR_PARAM (var1),params);
  636.      params = mBTP_LIST (mVAR_PARAM (var), params);
  637.      new    = mACF_BASIC (mCALL_STMT (new, params));
  638.      tree_protocol ("New Dalib Call is : ", new);
  639.  
  640.   }
  641.   {
  642.    return new;
  643.   }
  644.  }
  645.  
  646.   }
  647.   }
  648.  yyAbort ("MakeLocalCShift");
  649. }
  650.  
  651. static tTree MakeCommCShift
  652. # if defined __STDC__ | defined __cplusplus
  653. (register tTree var, register tTree var1, register tTree dim, register tTree pos)
  654. # else
  655. (var, var1, dim, pos)
  656.  register tTree var;
  657.  register tTree var1;
  658.  register tTree dim;
  659.  register tTree pos;
  660. # endif
  661. {
  662.   if (var->Kind == kINDEXED_VAR) {
  663. # line 434 "AdaptMovement.puma"
  664.    return MakeCommCShift (var->INDEXED_VAR.IND_VAR, var1, dim, pos);
  665.  
  666.   }
  667.   if (var1->Kind == kINDEXED_VAR) {
  668. # line 438 "AdaptMovement.puma"
  669.    return MakeCommCShift (var, var1->INDEXED_VAR.IND_VAR, dim, pos);
  670.  
  671.   }
  672.   if (var->Kind == kUSED_VAR) {
  673.   if (var1->Kind == kUSED_VAR) {
  674. # line 442 "AdaptMovement.puma"
  675.  {
  676.   tTree new;
  677.   tTree params;
  678.   {
  679. # line 444 "AdaptMovement.puma"
  680.  
  681. # line 445 "AdaptMovement.puma"
  682.  
  683. # line 446 "AdaptMovement.puma"
  684.  stmt_protocol ("Communication CShift");
  685.      new    = mPROC_OBJ (MakeDalibId1 ("cshift", VarRank(var->USED_VAR.VARNAME->VAR_OBJ.Object)));
  686.      params = mBTP_EMPTY();
  687.      params = mBTP_LIST (pos, params);
  688.      params = mBTP_LIST (dim, params);
  689.      params = MakeCShiftBounds (ArrayFormals (var->USED_VAR.VARNAME->VAR_OBJ.Object), params);
  690.      params = mBTP_LIST (ExpToVarParam (MakeConstant (TreeSize (var))), params);
  691.      params = mBTP_LIST (mVAR_PARAM (var1),params);
  692.      params = mBTP_LIST (mVAR_PARAM (var), params);
  693.      new    = mACF_BASIC (mCALL_STMT (new, params));
  694.      tree_protocol ("New Dalib Call is : ", new);
  695.  
  696.   }
  697.   {
  698.    return new;
  699.   }
  700.  }
  701.  
  702.   }
  703.   }
  704.  yyAbort ("MakeCommCShift");
  705. }
  706.  
  707. static tTree MakeCShiftBounds
  708. # if defined __STDC__ | defined __cplusplus
  709. (register tTree formals, register tTree params)
  710. # else
  711. (formals, params)
  712.  register tTree formals;
  713.  register tTree params;
  714. # endif
  715. {
  716.   if (formals->Kind == kTYPE_EMPTY) {
  717. # line 471 "AdaptMovement.puma"
  718.    return params;
  719.  
  720.   }
  721.   if (formals->Kind == kTYPE_LIST) {
  722.   if (formals->TYPE_LIST.Elem->Kind == kINDEX_TYPE) {
  723. # line 475 "AdaptMovement.puma"
  724.  {
  725.   tTree plist;
  726.   {
  727. # line 476 "AdaptMovement.puma"
  728.  
  729. # line 477 "AdaptMovement.puma"
  730.  plist = MakeCShiftBounds (formals->TYPE_LIST.Next, params);
  731.       plist = mBTP_LIST (ExpToVarParam (MakeSliceExp (formals->TYPE_LIST.Elem->INDEX_TYPE.LOWER, formals->TYPE_LIST.Elem->INDEX_TYPE.UPPER)), plist);
  732.  
  733.   }
  734.   {
  735.    return plist;
  736.   }
  737.  }
  738.  
  739.   }
  740.   if (formals->TYPE_LIST.Elem->Kind == kDYNAMIC) {
  741.   if (formals->TYPE_LIST.Elem->DYNAMIC.Shape->Kind == kSLICE_EXP) {
  742. # line 483 "AdaptMovement.puma"
  743.  {
  744.   tTree plist;
  745.   {
  746. # line 484 "AdaptMovement.puma"
  747.  
  748. # line 485 "AdaptMovement.puma"
  749.  plist = MakeCShiftBounds (formals->TYPE_LIST.Next, params);
  750.       plist = mBTP_LIST (ExpToVarParam (MakeSliceExp (formals->TYPE_LIST.Elem->DYNAMIC.Shape->SLICE_EXP.START, formals->TYPE_LIST.Elem->DYNAMIC.Shape->SLICE_EXP.STOP)), plist);
  751.  
  752.   }
  753.   {
  754.    return plist;
  755.   }
  756.  }
  757.  
  758.   }
  759.   }
  760.   }
  761.  yyAbort ("MakeCShiftBounds");
  762. }
  763.  
  764. static tTree MakeTransposeBounds
  765. # if defined __STDC__ | defined __cplusplus
  766. (register tTree formals, register tTree size, register tTree params)
  767. # else
  768. (formals, size, params)
  769.  register tTree formals;
  770.  register tTree size;
  771.  register tTree params;
  772. # endif
  773. {
  774. # line 501 "AdaptMovement.puma"
  775.  {
  776.   tTree plist;
  777.   {
  778. # line 503 "AdaptMovement.puma"
  779.    if (! ((TreeListLength (formals) <= 2))) goto yyL1;
  780.   {
  781. # line 504 "AdaptMovement.puma"
  782.  
  783. # line 505 "AdaptMovement.puma"
  784.  plist = mBTP_LIST (ExpToVarParam (size), params);
  785.       plist = MakeCShiftBounds (formals, plist);
  786.  
  787.   }
  788.   }
  789.   {
  790.    return plist;
  791.   }
  792.  }
  793. yyL1:;
  794.  
  795.   if (formals->Kind == kTYPE_LIST) {
  796.   if (formals->TYPE_LIST.Elem->Kind == kDYNAMIC) {
  797.   if (formals->TYPE_LIST.Elem->DYNAMIC.Shape->Kind == kSLICE_EXP) {
  798. # line 511 "AdaptMovement.puma"
  799.  {
  800.   tTree newsize;
  801.   {
  802. # line 513 "AdaptMovement.puma"
  803.  
  804. # line 514 "AdaptMovement.puma"
  805.  newsize = mOP_EXP (mOP_TIMES(), MakeSliceExp (formals->TYPE_LIST.Elem->DYNAMIC.Shape->SLICE_EXP.START, formals->TYPE_LIST.Elem->DYNAMIC.Shape->SLICE_EXP.STOP), size);
  806.   }
  807.   {
  808.    return MakeTransposeBounds (formals->TYPE_LIST.Next, newsize, params);
  809.   }
  810.  }
  811.  
  812.   }
  813.   }
  814.   if (formals->TYPE_LIST.Elem->Kind == kINDEX_TYPE) {
  815. # line 518 "AdaptMovement.puma"
  816.  {
  817.   tTree newsize;
  818.   {
  819. # line 520 "AdaptMovement.puma"
  820.  
  821. # line 521 "AdaptMovement.puma"
  822.  newsize = mOP_EXP (mOP_TIMES(), MakeSliceExp (formals->TYPE_LIST.Elem->INDEX_TYPE.LOWER, formals->TYPE_LIST.Elem->INDEX_TYPE.UPPER), size);
  823.   }
  824.   {
  825.    return MakeTransposeBounds (formals->TYPE_LIST.Next, newsize, params);
  826.   }
  827.  }
  828.  
  829.   }
  830.   }
  831.  yyAbort ("MakeTransposeBounds");
  832. }
  833.  
  834. tTree AdaptArrayMovement
  835. # if defined __STDC__ | defined __cplusplus
  836. (register tTree assign, register int vardistribution, register int expdistribution)
  837. # else
  838. (assign, vardistribution, expdistribution)
  839.  register tTree assign;
  840.  register int vardistribution;
  841.  register int expdistribution;
  842. # endif
  843. {
  844. # line 538 "AdaptMovement.puma"
  845.  
  846. tTree t, params;
  847. int count;
  848. char string[200];
  849.  
  850.   if (equalint (vardistribution, 0)) {
  851.   if (equalint (expdistribution, 0)) {
  852. # line 548 "AdaptMovement.puma"
  853.    return assign;
  854.  
  855.   }
  856.   }
  857.   if (equalint (vardistribution, - 1)) {
  858.   if (equalint (expdistribution, 1)) {
  859. # line 557 "AdaptMovement.puma"
  860.    return AdaptHNMovement (assign);
  861.  
  862.   }
  863.   }
  864.   if (equalint (vardistribution, 1)) {
  865.   if (equalint (expdistribution, - 1)) {
  866. # line 565 "AdaptMovement.puma"
  867.    return AdaptNHMovement (assign);
  868.  
  869.   }
  870.   }
  871.   if (equalint (vardistribution, 1)) {
  872.   if (equalint (expdistribution, 0)) {
  873. # line 573 "AdaptMovement.puma"
  874.   {
  875. # line 574 "AdaptMovement.puma"
  876.  if (IsHost)
  877.          t = NoTree;
  878.        else
  879.          t = LocalArrayAssignment (assign);
  880.  
  881.   }
  882.    return t;
  883.  
  884.   }
  885.   }
  886.   if (equalint (vardistribution, 0)) {
  887.   if (equalint (expdistribution, 1)) {
  888. # line 586 "AdaptMovement.puma"
  889.    return AdaptRNMovement (assign);
  890.  
  891.   }
  892.   }
  893.   if (assign->Kind == kACF_BASIC) {
  894.   if (assign->ACF_BASIC.BASIC_STMT->Kind == kASSIGN_STMT) {
  895.   if (equalint (vardistribution, 1)) {
  896.   if (equalint (expdistribution, 1)) {
  897. # line 594 "AdaptMovement.puma"
  898.    return AdaptNNMovement (assign, CountMovements (assign->ACF_BASIC.BASIC_STMT->ASSIGN_STMT.ASSIGN_VAR, assign->ACF_BASIC.BASIC_STMT->ASSIGN_STMT.ASSIGN_EXP));
  899.  
  900.   }
  901.   }
  902.   }
  903.   }
  904. # line 598 "AdaptMovement.puma"
  905.   {
  906. # line 599 "AdaptMovement.puma"
  907.    sprintf (string, "AdaptArrayMovement fails, vardist= %d, expdist= %d", vardistribution, expdistribution);
  908. # line 601 "AdaptMovement.puma"
  909.    error_protocol (string);
  910.   }
  911.    return assign;
  912.  
  913. }
  914.  
  915. static tTree AdaptHNMovement
  916. # if defined __STDC__ | defined __cplusplus
  917. (register tTree assign)
  918. # else
  919. (assign)
  920.  register tTree assign;
  921. # endif
  922. {
  923.   if (assign->Kind == kACF_BASIC) {
  924.   if (assign->ACF_BASIC.BASIC_STMT->Kind == kASSIGN_STMT) {
  925.   if (assign->ACF_BASIC.BASIC_STMT->ASSIGN_STMT.ASSIGN_EXP->Kind == kVAR_EXP) {
  926. # line 619 "AdaptMovement.puma"
  927.   {
  928. # line 621 "AdaptMovement.puma"
  929.    if (! (IsContiguousSection (assign->ACF_BASIC.BASIC_STMT->ASSIGN_STMT.ASSIGN_VAR) != true)) goto yyL1;
  930.   {
  931. # line 622 "AdaptMovement.puma"
  932.    error_protocol ("Transfer HOST <- NODES : host var not continguous");
  933.   }
  934.   }
  935.    return NoTree;
  936. yyL1:;
  937.  
  938. # line 626 "AdaptMovement.puma"
  939.  {
  940.   tTree nv;
  941.   {
  942. # line 628 "AdaptMovement.puma"
  943.  
  944. # line 629 "AdaptMovement.puma"
  945.    nv = MakeFullShape (assign->ACF_BASIC.BASIC_STMT->ASSIGN_STMT.ASSIGN_EXP->VAR_EXP.V);
  946. # line 631 "AdaptMovement.puma"
  947.    CheckMoveArrays (assign->ACF_BASIC.BASIC_STMT->ASSIGN_STMT.ASSIGN_EXP->VAR_EXP.V, assign->ACF_BASIC.BASIC_STMT->ASSIGN_STMT.ASSIGN_VAR);
  948.   }
  949.   {
  950.    return MakeHostNodeTransfer (FirstArrayElement (assign->ACF_BASIC.BASIC_STMT->ASSIGN_STMT.ASSIGN_VAR), nv);
  951.   }
  952.  }
  953.  
  954.   }
  955.   }
  956.   }
  957. # line 635 "AdaptMovement.puma"
  958.   {
  959. # line 636 "AdaptMovement.puma"
  960.    error_protocol ("Adapting Host<-Node Movement failed");
  961.   }
  962.    return assign;
  963.  
  964. }
  965.  
  966. static tTree MakeHostNodeTransfer
  967. # if defined __STDC__ | defined __cplusplus
  968. (register tTree hostvar, register tTree nodevar)
  969. # else
  970. (hostvar, nodevar)
  971.  register tTree hostvar;
  972.  register tTree nodevar;
  973. # endif
  974. {
  975. # line 642 "AdaptMovement.puma"
  976.  
  977. char string[50];
  978. tTree t, params;
  979.  
  980.   if (nodevar->Kind == kINDEXED_VAR) {
  981.   if (nodevar->INDEXED_VAR.IND_VAR->Kind == kUSED_VAR) {
  982. # line 647 "AdaptMovement.puma"
  983.   {
  984. # line 648 "AdaptMovement.puma"
  985.    if (! (IndexStrides (nodevar->INDEXED_VAR.IND_EXPS))) goto yyL1;
  986.   {
  987. # line 649 "AdaptMovement.puma"
  988.    error_protocol ("HOSTVAR = DIST_VAR : strides for distributed variable");
  989. # line 650 "AdaptMovement.puma"
  990.    tree_protocol ("Distributed Variable (full shape) is : ", nodevar);
  991.   }
  992.   }
  993.    return NoTree;
  994. yyL1:;
  995.  
  996. # line 654 "AdaptMovement.puma"
  997.   {
  998. # line 658 "AdaptMovement.puma"
  999.  stmt_protocol ("Transfer HOST <- NODES");
  1000.     t = mPROC_OBJ (MakeDalibId1 ("host_node", VarRank(nodevar->INDEXED_VAR.IND_VAR->USED_VAR.VARNAME->VAR_OBJ.Object)));
  1001.     params = DalibRangeParams (nodevar, mBTP_EMPTY ());
  1002.     if (IsHost)
  1003.        params = mBTP_LIST (mVAR_PARAM (hostvar), params);
  1004.      else
  1005.        params = mBTP_LIST (mVAR_PARAM (nodevar->INDEXED_VAR.IND_VAR), params);
  1006.     t = mACF_BASIC (mCALL_STMT (t, params));
  1007.     tree_protocol ("New DALIB Call is : ", t);
  1008.  
  1009.   }
  1010.    return t;
  1011.  
  1012.   }
  1013.   }
  1014.  yyAbort ("MakeHostNodeTransfer");
  1015. }
  1016.  
  1017. static tTree AdaptNHMovement
  1018. # if defined __STDC__ | defined __cplusplus
  1019. (register tTree assign)
  1020. # else
  1021. (assign)
  1022.  register tTree assign;
  1023. # endif
  1024. {
  1025.   if (assign->Kind == kACF_BASIC) {
  1026.   if (assign->ACF_BASIC.BASIC_STMT->Kind == kASSIGN_STMT) {
  1027.   if (assign->ACF_BASIC.BASIC_STMT->ASSIGN_STMT.ASSIGN_EXP->Kind == kVAR_EXP) {
  1028. # line 687 "AdaptMovement.puma"
  1029.   {
  1030. # line 689 "AdaptMovement.puma"
  1031.    if (! (IsContiguousSection (assign->ACF_BASIC.BASIC_STMT->ASSIGN_STMT.ASSIGN_EXP->VAR_EXP.V) != true)) goto yyL1;
  1032.   {
  1033. # line 690 "AdaptMovement.puma"
  1034.    error_protocol ("Transfer NODES <- HOST : host var not continguous");
  1035.   }
  1036.   }
  1037.    return NoTree;
  1038. yyL1:;
  1039.  
  1040. # line 694 "AdaptMovement.puma"
  1041.  {
  1042.   tTree nv;
  1043.   {
  1044. # line 696 "AdaptMovement.puma"
  1045.  
  1046. # line 697 "AdaptMovement.puma"
  1047.    nv = MakeFullShape (assign->ACF_BASIC.BASIC_STMT->ASSIGN_STMT.ASSIGN_VAR);
  1048. # line 699 "AdaptMovement.puma"
  1049.    CheckMoveArrays (assign->ACF_BASIC.BASIC_STMT->ASSIGN_STMT.ASSIGN_EXP->VAR_EXP.V, assign->ACF_BASIC.BASIC_STMT->ASSIGN_STMT.ASSIGN_VAR);
  1050.   }
  1051.   {
  1052.    return MakeNodeHostTransfer (nv, FirstArrayElement (assign->ACF_BASIC.BASIC_STMT->ASSIGN_STMT.ASSIGN_EXP->VAR_EXP.V));
  1053.   }
  1054.  }
  1055.  
  1056.   }
  1057.   }
  1058.   }
  1059. # line 703 "AdaptMovement.puma"
  1060.   {
  1061. # line 704 "AdaptMovement.puma"
  1062.    error_protocol ("Adapting NODE<-HOST Movement failed");
  1063.   }
  1064.    return assign;
  1065.  
  1066. }
  1067.  
  1068. static tTree MakeNodeHostTransfer
  1069. # if defined __STDC__ | defined __cplusplus
  1070. (register tTree nodevar, register tTree hostvar)
  1071. # else
  1072. (nodevar, hostvar)
  1073.  register tTree nodevar;
  1074.  register tTree hostvar;
  1075. # endif
  1076. {
  1077. # line 710 "AdaptMovement.puma"
  1078.  
  1079. char string[50];
  1080. tTree t, params;
  1081.  
  1082.   if (nodevar->Kind == kINDEXED_VAR) {
  1083.   if (nodevar->INDEXED_VAR.IND_VAR->Kind == kUSED_VAR) {
  1084. # line 715 "AdaptMovement.puma"
  1085.   {
  1086. # line 716 "AdaptMovement.puma"
  1087.    if (! (IndexStrides (nodevar->INDEXED_VAR.IND_EXPS))) goto yyL1;
  1088.   {
  1089. # line 717 "AdaptMovement.puma"
  1090.    error_protocol ("DIST_VAR = HOSTVAR : strides for distributed variable");
  1091. # line 718 "AdaptMovement.puma"
  1092.    tree_protocol ("Distributed Variable (full shape) is : ", nodevar);
  1093.   }
  1094.   }
  1095.    return NoTree;
  1096. yyL1:;
  1097.  
  1098. # line 722 "AdaptMovement.puma"
  1099.   {
  1100. # line 726 "AdaptMovement.puma"
  1101.  stmt_protocol ("Transfer NODES <- HOST");
  1102.     t = mPROC_OBJ (MakeDalibId1 ("node_host", VarRank(nodevar->INDEXED_VAR.IND_VAR->USED_VAR.VARNAME->VAR_OBJ.Object)));
  1103.     params = DalibRangeParams (nodevar, mBTP_EMPTY ());
  1104.     if (IsHost)
  1105.        params = mBTP_LIST (mVAR_PARAM (hostvar), params);
  1106.      else
  1107.        params = mBTP_LIST (mVAR_PARAM (nodevar->INDEXED_VAR.IND_VAR), params);
  1108.     t = mACF_BASIC (mCALL_STMT (t, params));
  1109.     tree_protocol ("New DALIB Call is : ", t);
  1110.  
  1111.   }
  1112.    return t;
  1113.  
  1114.   }
  1115.   }
  1116.  yyAbort ("MakeNodeHostTransfer");
  1117. }
  1118.  
  1119. static tTree AdaptRNMovement
  1120. # if defined __STDC__ | defined __cplusplus
  1121. (register tTree assign)
  1122. # else
  1123. (assign)
  1124.  register tTree assign;
  1125. # endif
  1126. {
  1127.   if (assign->Kind == kACF_BASIC) {
  1128.   if (assign->ACF_BASIC.BASIC_STMT->Kind == kASSIGN_STMT) {
  1129.   if (assign->ACF_BASIC.BASIC_STMT->ASSIGN_STMT.ASSIGN_EXP->Kind == kVAR_EXP) {
  1130. # line 755 "AdaptMovement.puma"
  1131.   {
  1132. # line 757 "AdaptMovement.puma"
  1133.    if (! (IsContiguousSection (assign->ACF_BASIC.BASIC_STMT->ASSIGN_STMT.ASSIGN_VAR) != true)) goto yyL1;
  1134.   {
  1135. # line 758 "AdaptMovement.puma"
  1136.    error_protocol ("Transfer ALL <- NODES : replicated var not continguous");
  1137.   }
  1138.   }
  1139.    return NoTree;
  1140. yyL1:;
  1141.  
  1142. # line 762 "AdaptMovement.puma"
  1143.  {
  1144.   tTree nv;
  1145.   {
  1146. # line 764 "AdaptMovement.puma"
  1147.  
  1148. # line 765 "AdaptMovement.puma"
  1149.    nv = MakeFullShape (assign->ACF_BASIC.BASIC_STMT->ASSIGN_STMT.ASSIGN_EXP->VAR_EXP.V);
  1150. # line 767 "AdaptMovement.puma"
  1151.    CheckMoveArrays (assign->ACF_BASIC.BASIC_STMT->ASSIGN_STMT.ASSIGN_EXP->VAR_EXP.V, assign->ACF_BASIC.BASIC_STMT->ASSIGN_STMT.ASSIGN_VAR);
  1152.   }
  1153.   {
  1154.    return MakeAllNodeTransfer (FirstArrayElement (assign->ACF_BASIC.BASIC_STMT->ASSIGN_STMT.ASSIGN_VAR), nv);
  1155.   }
  1156.  }
  1157.  
  1158.   }
  1159.   }
  1160.   }
  1161. # line 771 "AdaptMovement.puma"
  1162.   {
  1163. # line 772 "AdaptMovement.puma"
  1164.    error_protocol ("Adapting All <- Node Movement failed");
  1165.   }
  1166.    return assign;
  1167.  
  1168. }
  1169.  
  1170. static tTree MakeAllNodeTransfer
  1171. # if defined __STDC__ | defined __cplusplus
  1172. (register tTree repvar, register tTree nodevar)
  1173. # else
  1174. (repvar, nodevar)
  1175.  register tTree repvar;
  1176.  register tTree nodevar;
  1177. # endif
  1178. {
  1179. # line 778 "AdaptMovement.puma"
  1180.  
  1181. char string[50];
  1182. tTree t, params;
  1183.  
  1184.   if (nodevar->Kind == kINDEXED_VAR) {
  1185.   if (nodevar->INDEXED_VAR.IND_VAR->Kind == kUSED_VAR) {
  1186. # line 783 "AdaptMovement.puma"
  1187.   {
  1188. # line 784 "AdaptMovement.puma"
  1189.    if (! (IndexStrides (nodevar->INDEXED_VAR.IND_EXPS))) goto yyL1;
  1190.   {
  1191. # line 785 "AdaptMovement.puma"
  1192.    error_protocol ("REP_VAR = DIST_VAR : strides for distributed variable");
  1193. # line 786 "AdaptMovement.puma"
  1194.    tree_protocol ("Distributed Variable (full shape) is : ", nodevar);
  1195.   }
  1196.   }
  1197.    return NoTree;
  1198. yyL1:;
  1199.  
  1200. # line 790 "AdaptMovement.puma"
  1201.   {
  1202. # line 794 "AdaptMovement.puma"
  1203.  stmt_protocol ("Transfer ALL <- NODES");
  1204.     t = mPROC_OBJ (MakeDalibId1 ("replicate", VarRank(nodevar->INDEXED_VAR.IND_VAR->USED_VAR.VARNAME->VAR_OBJ.Object)));
  1205.     params = DalibRangeParams (nodevar, mBTP_EMPTY());
  1206.     if (IsHost)
  1207.        params = mBTP_LIST (mVAR_PARAM (repvar), params);
  1208.      else
  1209.        params = mBTP_LIST (mVAR_PARAM (nodevar->INDEXED_VAR.IND_VAR), params);
  1210.     params = mBTP_LIST (mVAR_PARAM (repvar), params);
  1211.     t = mACF_BASIC (mCALL_STMT (t, params));
  1212.     tree_protocol ("New DALIB Call is : ", t);
  1213.  
  1214.   }
  1215.    return t;
  1216.  
  1217.   }
  1218.   }
  1219.  yyAbort ("MakeAllNodeTransfer");
  1220. }
  1221.  
  1222. static tTree AdaptNNMovement
  1223. # if defined __STDC__ | defined __cplusplus
  1224. (register tTree assign, register int moves)
  1225. # else
  1226. (assign, moves)
  1227.  register tTree assign;
  1228.  register int moves;
  1229. # endif
  1230. {
  1231. # line 816 "AdaptMovement.puma"
  1232.  
  1233. tTree t;
  1234.  
  1235.   if (assign->Kind == kACF_BASIC) {
  1236.   if (assign->ACF_BASIC.BASIC_STMT->Kind == kASSIGN_STMT) {
  1237.   if (assign->ACF_BASIC.BASIC_STMT->ASSIGN_STMT.ASSIGN_VAR->Kind == kINDEXED_VAR) {
  1238.   if (equalint (moves, 0)) {
  1239. # line 826 "AdaptMovement.puma"
  1240.   {
  1241. # line 828 "AdaptMovement.puma"
  1242.  if (IsHost)
  1243.          t = NoTree;
  1244.        else
  1245.          t = LocalArrayAssignment (assign);
  1246.  
  1247.   }
  1248.    return t;
  1249.  
  1250.   }
  1251.   }
  1252.   if (equalint (moves, 0)) {
  1253. # line 836 "AdaptMovement.puma"
  1254.   {
  1255. # line 838 "AdaptMovement.puma"
  1256.    stmt_protocol ("Local : ");
  1257. # line 839 "AdaptMovement.puma"
  1258.  if (IsHost)
  1259.         t = NoTree;
  1260.        else
  1261.         t = assign;
  1262.  
  1263.   }
  1264.    return t;
  1265.  
  1266.   }
  1267.   if (assign->ACF_BASIC.BASIC_STMT->ASSIGN_STMT.ASSIGN_EXP->Kind == kVAR_EXP) {
  1268. # line 847 "AdaptMovement.puma"
  1269.   {
  1270. # line 849 "AdaptMovement.puma"
  1271.    stmt_protocol ("Copy Node Arrays with moves");
  1272. # line 850 "AdaptMovement.puma"
  1273.  if (IsHost)
  1274.         { t = NoTree;
  1275.           print_protocol ("is removed in host program");
  1276.         }
  1277.        else
  1278.         { t = AdaptNNCopy (assign->ACF_BASIC.BASIC_STMT->ASSIGN_STMT.ASSIGN_VAR, assign->ACF_BASIC.BASIC_STMT->ASSIGN_STMT.ASSIGN_EXP->VAR_EXP.V);
  1279.           if (t == NoTree)
  1280.             error_protocol ("could not be adapted");
  1281.            else
  1282.             tree_protocol ("becomes :\n", t);
  1283.         }
  1284.  
  1285.   }
  1286.    return t;
  1287.  
  1288.   }
  1289.   }
  1290.   }
  1291. # line 865 "AdaptMovement.puma"
  1292.   {
  1293. # line 866 "AdaptMovement.puma"
  1294.    error_protocol ("*** not handled *** : Node<-Node : ");
  1295. # line 867 "AdaptMovement.puma"
  1296.  if (IsHost)
  1297.         t = NoTree;
  1298.        else
  1299.         t = assign;
  1300.  
  1301.   }
  1302.    return assign;
  1303.  
  1304. }
  1305.  
  1306. tTree AdaptNNCopy
  1307. # if defined __STDC__ | defined __cplusplus
  1308. (register tTree lvar, register tTree rvar)
  1309. # else
  1310. (lvar, rvar)
  1311.  register tTree lvar;
  1312.  register tTree rvar;
  1313. # endif
  1314. {
  1315. # line 883 "AdaptMovement.puma"
  1316.  
  1317. tTree last1, last2, t, params, stmt;
  1318. int index_dist1, index_dist2;
  1319. tIdent pname;
  1320. char procname[30];
  1321. int k;
  1322.  
  1323.   if (lvar->Kind == kINDEXED_VAR) {
  1324.   if (lvar->INDEXED_VAR.IND_VAR->Kind == kUSED_VAR) {
  1325.   if (rvar->Kind == kINDEXED_VAR) {
  1326.   if (rvar->INDEXED_VAR.IND_VAR->Kind == kUSED_VAR) {
  1327. # line 897 "AdaptMovement.puma"
  1328.   {
  1329. # line 899 "AdaptMovement.puma"
  1330.    CheckMoveArrays (rvar->INDEXED_VAR.IND_VAR, lvar->INDEXED_VAR.IND_VAR);
  1331. # line 900 "AdaptMovement.puma"
  1332.  last1 = LastIndex (lvar->INDEXED_VAR.IND_EXPS);
  1333.      last2 = LastIndex (rvar->INDEXED_VAR.IND_EXPS);
  1334.      index_dist1 = TreeDistribution (lvar->INDEXED_VAR.IND_EXPS);
  1335.      index_dist2 = TreeDistribution (rvar->INDEXED_VAR.IND_EXPS);
  1336.      if ((index_dist1 != 0) || (index_dist2 != 0))
  1337.        { t = AdaptNNIndirect (lvar, index_dist1, rvar, index_dist2); }
  1338.       else if (IndexStrides (lvar->INDEXED_VAR.IND_EXPS))
  1339.        { tree_protocol ("increments in indexes of lhs variable: ", lvar);
  1340.          t = NoTree;
  1341.        }
  1342.       else if (IndexStrides (rvar->INDEXED_VAR.IND_EXPS))
  1343.        { tree_protocol ("increments in indexes of rhs variable: ", rvar);
  1344.          t = NoTree;
  1345.        }
  1346.       else
  1347.  
  1348.        {
  1349.  
  1350.  
  1351.  
  1352.          params = mBTP_EMPTY();
  1353.          params = DalibRangeParams (lvar, params);
  1354.          params = mBTP_LIST (mVAR_PARAM (lvar->INDEXED_VAR.IND_VAR), params);
  1355.          k      = TreeListLength (lvar->INDEXED_VAR.IND_EXPS);
  1356.          stmt   = mPROC_OBJ (MakeDalibId1 ("move_target", k));
  1357.          stmt   = mACF_BASIC (mCALL_STMT (stmt, params));
  1358.          t      = mACF_LIST (stmt, NoTree);
  1359.  
  1360.  
  1361.  
  1362.          params = mBTP_EMPTY();
  1363.          params = DalibRangeParams (rvar, params);
  1364.          params = mBTP_LIST (mVAR_PARAM (rvar->INDEXED_VAR.IND_VAR), params);
  1365.          k      = TreeListLength (rvar->INDEXED_VAR.IND_EXPS);
  1366.          stmt   = mPROC_OBJ (MakeDalibId1 ("move_source", k));
  1367.          stmt   = mACF_BASIC (mCALL_STMT (stmt, params));
  1368.          t      = mACF_LIST (stmt, t);
  1369.  
  1370.  
  1371.  
  1372.          params = mBTP_EMPTY ();
  1373.          params = AdaptHelpFn (rvar->INDEXED_VAR.IND_VAR, last2, params);
  1374.          params = AdaptHelpFn (lvar->INDEXED_VAR.IND_VAR, last1, params);
  1375.          stmt   = mPROC_OBJ (MakeDalibId ("move_define"));
  1376.          stmt   = mACF_BASIC (mCALL_STMT (stmt, params));
  1377.          t      = mACF_LIST (stmt, t);
  1378.        }
  1379.  
  1380.   }
  1381.    return t;
  1382.  
  1383.   }
  1384.   }
  1385.   }
  1386.   if (rvar->Kind == kUSED_VAR) {
  1387. # line 967 "AdaptMovement.puma"
  1388.    return AdaptNNIndirect (lvar, TreeDistribution (lvar->INDEXED_VAR.IND_EXPS), rvar, 0);
  1389.  
  1390.   }
  1391.   }
  1392.   if (lvar->Kind == kUSED_VAR) {
  1393.   if (rvar->Kind == kINDEXED_VAR) {
  1394. # line 957 "AdaptMovement.puma"
  1395.    return AdaptNNIndirect (lvar, 0, rvar, TreeDistribution (rvar->INDEXED_VAR.IND_EXPS));
  1396.  
  1397.   }
  1398.   }
  1399. # line 971 "AdaptMovement.puma"
  1400.   {
  1401. # line 972 "AdaptMovement.puma"
  1402.    error_protocol ("*** not handled *** : AdaptNNCopy :");
  1403.   }
  1404.    return NoTree;
  1405.  
  1406. }
  1407.  
  1408. static tTree AdaptHelpFn
  1409. # if defined __STDC__ | defined __cplusplus
  1410. (register tTree var, register tTree slice, register tTree params)
  1411. # else
  1412. (var, slice, params)
  1413.  register tTree var;
  1414.  register tTree slice;
  1415.  register tTree params;
  1416. # endif
  1417. {
  1418. # line 980 "AdaptMovement.puma"
  1419.  
  1420. tTree newparams;
  1421.  
  1422.   if (slice->Kind == kSLICE_EXP) {
  1423. # line 984 "AdaptMovement.puma"
  1424.   {
  1425. # line 985 "AdaptMovement.puma"
  1426.  newparams = params;
  1427.      newparams = mBTP_LIST (ExpToVarParam (slice->SLICE_EXP.STOP), newparams);
  1428.      newparams = mBTP_LIST (ExpToVarParam (slice->SLICE_EXP.START), newparams);
  1429.      newparams = DalibLastFormalParam (var, newparams);
  1430.  
  1431.   }
  1432.    return newparams;
  1433.  
  1434.   }
  1435. # line 993 "AdaptMovement.puma"
  1436.   {
  1437. # line 994 "AdaptMovement.puma"
  1438.  newparams = params;
  1439.      newparams = mBTP_LIST (ExpToVarParam (slice), newparams);
  1440.      newparams = mBTP_LIST (ExpToVarParam (slice), newparams);
  1441.      newparams = DalibLastFormalParam (var, newparams);
  1442.  
  1443.   }
  1444.    return newparams;
  1445.  
  1446. }
  1447.  
  1448. static tTree AdaptNNIndirect
  1449. # if defined __STDC__ | defined __cplusplus
  1450. (register tTree lvar, register int d1, register tTree rvar, register int d2)
  1451. # else
  1452. (lvar, d1, rvar, d2)
  1453.  register tTree lvar;
  1454.  register int d1;
  1455.  register tTree rvar;
  1456.  register int d2;
  1457. # endif
  1458. {
  1459.   if (equalint (d1, 0)) {
  1460.   if (equalint (d2, 1)) {
  1461. # line 1012 "AdaptMovement.puma"
  1462.    return AdaptNNGet (lvar, rvar);
  1463.  
  1464.   }
  1465.   }
  1466.   if (equalint (d1, 1)) {
  1467.   if (equalint (d2, 0)) {
  1468. # line 1017 "AdaptMovement.puma"
  1469.    return AdaptNNSet (lvar, rvar);
  1470.  
  1471.   }
  1472.   }
  1473.   if (equalint (d1, 0)) {
  1474.   if (equalint (d2, 0)) {
  1475. # line 1022 "AdaptMovement.puma"
  1476.   {
  1477. # line 1024 "AdaptMovement.puma"
  1478.  tree_protocol ("NNIndirect: index of lhs is replicated : ", lvar );
  1479.      tree_protocol ("NNIndirect: also index of rhs is replicated : ", rvar );
  1480.  
  1481.   }
  1482.    return NoTree;
  1483.  
  1484.   }
  1485.   }
  1486.   if (equalint (d1, 1)) {
  1487.   if (equalint (d2, 1)) {
  1488. # line 1030 "AdaptMovement.puma"
  1489.   {
  1490. # line 1031 "AdaptMovement.puma"
  1491.  tree_protocol ("NNIndirect: index on lhs is already distributed: ", lvar );
  1492.      tree_protocol ("NNIndirect: index of rhs must not distributed: ", rvar );
  1493.  
  1494.   }
  1495.    return NoTree;
  1496.  
  1497.   }
  1498.   }
  1499. # line 1037 "AdaptMovement.puma"
  1500.   {
  1501. # line 1038 "AdaptMovement.puma"
  1502.  tree_protocol ("NNIndirect: illegal distribution in lhs ? ", lvar);
  1503.      tree_protocol ("NNIndirect: illegal distribution in rhs ? ", rvar);
  1504.  
  1505.   }
  1506.    return NoTree;
  1507.  
  1508. }
  1509.  
  1510. static tTree AdaptNNGet
  1511. # if defined __STDC__ | defined __cplusplus
  1512. (register tTree lvar, register tTree rvar)
  1513. # else
  1514. (lvar, rvar)
  1515.  register tTree lvar;
  1516.  register tTree rvar;
  1517. # endif
  1518. {
  1519. # line 1052 "AdaptMovement.puma"
  1520.  
  1521. tIdent procname;
  1522. tTree t, params;
  1523.  
  1524.   if (lvar->Kind == kINDEXED_VAR) {
  1525. # line 1059 "AdaptMovement.puma"
  1526.   {
  1527. # line 1060 "AdaptMovement.puma"
  1528.    if (! ((IsWholeVar (lvar) == true))) goto yyL1;
  1529.   }
  1530.    return AdaptNNGet (lvar->INDEXED_VAR.IND_VAR, rvar);
  1531. yyL1:;
  1532.  
  1533. # line 1064 "AdaptMovement.puma"
  1534.   {
  1535. # line 1065 "AdaptMovement.puma"
  1536.  tree_protocol ("global_get, gather : lhs not full array", lvar);
  1537.   }
  1538.    return NoTree;
  1539.  
  1540.   }
  1541.   if (lvar->Kind == kUSED_VAR) {
  1542.   if (rvar->Kind == kINDEXED_VAR) {
  1543.   if (rvar->INDEXED_VAR.IND_EXPS->Kind == kBTE_LIST) {
  1544.   if (rvar->INDEXED_VAR.IND_EXPS->BTE_LIST.Elem->Kind == kVAR_EXP) {
  1545.   if (rvar->INDEXED_VAR.IND_EXPS->BTE_LIST.Next->Kind == kBTE_EMPTY) {
  1546. # line 1077 "AdaptMovement.puma"
  1547.   {
  1548. # line 1078 "AdaptMovement.puma"
  1549.    if (! ((IsWholeVar (rvar->INDEXED_VAR.IND_EXPS->BTE_LIST.Elem->VAR_EXP.V) == true))) goto yyL3;
  1550.   {
  1551. # line 1079 "AdaptMovement.puma"
  1552.  
  1553.     rvar->INDEXED_VAR.IND_EXPS->BTE_LIST.Elem->VAR_EXP.V = NormalizeShape (rvar->INDEXED_VAR.IND_EXPS->BTE_LIST.Elem->VAR_EXP.V);
  1554.     params = mBTP_EMPTY();
  1555.     params = mBTP_LIST (ExpToVarParam (rvar->INDEXED_VAR.IND_EXPS->BTE_LIST.Elem), params);
  1556.     params = mBTP_LIST (mVAR_PARAM (rvar->INDEXED_VAR.IND_VAR), params);
  1557.     params = mBTP_LIST (mVAR_PARAM (lvar), params);
  1558.     t = GenGlobalGet (params);
  1559.  
  1560.   }
  1561.   }
  1562.    return t;
  1563. yyL3:;
  1564.  
  1565.   }
  1566.   }
  1567.   }
  1568.   }
  1569.   }
  1570. # line 1096 "AdaptMovement.puma"
  1571.   {
  1572. # line 1097 "AdaptMovement.puma"
  1573.    error_protocol ("AdaptNNGet : *** not handled *** ");
  1574.   }
  1575.    return NoTree;
  1576.  
  1577. }
  1578.  
  1579. static tTree AdaptNNSet
  1580. # if defined __STDC__ | defined __cplusplus
  1581. (register tTree lvar, register tTree rvar)
  1582. # else
  1583. (lvar, rvar)
  1584.  register tTree lvar;
  1585.  register tTree rvar;
  1586. # endif
  1587. {
  1588. # line 1109 "AdaptMovement.puma"
  1589.  
  1590. tIdent procname;
  1591. tTree t, params;
  1592.  
  1593.   if (rvar->Kind == kINDEXED_VAR) {
  1594. # line 1118 "AdaptMovement.puma"
  1595.   {
  1596. # line 1119 "AdaptMovement.puma"
  1597.    if (! ((IsWholeVar (rvar) == true))) goto yyL1;
  1598.   }
  1599.    return AdaptNNSet (lvar, rvar->INDEXED_VAR.IND_VAR);
  1600. yyL1:;
  1601.  
  1602. # line 1123 "AdaptMovement.puma"
  1603.   {
  1604. # line 1124 "AdaptMovement.puma"
  1605.  tree_protocol ("global_set, scatter : rhs not full array", rvar);
  1606.   }
  1607.    return NoTree;
  1608.  
  1609.   }
  1610.   if (lvar->Kind == kINDEXED_VAR) {
  1611.   if (lvar->INDEXED_VAR.IND_EXPS->Kind == kBTE_LIST) {
  1612.   if (lvar->INDEXED_VAR.IND_EXPS->BTE_LIST.Elem->Kind == kVAR_EXP) {
  1613.   if (lvar->INDEXED_VAR.IND_EXPS->BTE_LIST.Next->Kind == kBTE_EMPTY) {
  1614.   if (rvar->Kind == kUSED_VAR) {
  1615. # line 1134 "AdaptMovement.puma"
  1616.   {
  1617. # line 1135 "AdaptMovement.puma"
  1618.    if (! ((IsWholeVar (lvar->INDEXED_VAR.IND_EXPS->BTE_LIST.Elem->VAR_EXP.V) == true))) goto yyL3;
  1619.   {
  1620. # line 1136 "AdaptMovement.puma"
  1621.  
  1622.     lvar->INDEXED_VAR.IND_EXPS->BTE_LIST.Elem->VAR_EXP.V = NormalizeShape (lvar->INDEXED_VAR.IND_EXPS->BTE_LIST.Elem->VAR_EXP.V);
  1623.     params = mBTP_EMPTY();
  1624.     params = mBTP_LIST (mVAR_PARAM (rvar), params);
  1625.     params = mBTP_LIST (ExpToVarParam (lvar->INDEXED_VAR.IND_EXPS->BTE_LIST.Elem), params);
  1626.     params = mBTP_LIST (mVAR_PARAM (lvar->INDEXED_VAR.IND_VAR), params);
  1627.     t = GenGlobalSend (params);
  1628.  
  1629.   }
  1630.   }
  1631.    return t;
  1632. yyL3:;
  1633.  
  1634.   }
  1635.   }
  1636.   }
  1637.   }
  1638.   }
  1639. # line 1153 "AdaptMovement.puma"
  1640.   {
  1641. # line 1154 "AdaptMovement.puma"
  1642.    error_protocol ("AdaptNNSet: *** not handled *** ");
  1643.   }
  1644.    return NoTree;
  1645.  
  1646. }
  1647.  
  1648. static bool IndexStrides
  1649. # if defined __STDC__ | defined __cplusplus
  1650. (register tTree t)
  1651. # else
  1652. (t)
  1653.  register tTree t;
  1654. # endif
  1655. {
  1656. # line 1166 "AdaptMovement.puma"
  1657.  
  1658. bool found;
  1659. int val;
  1660.  
  1661.   if (t == NoTree) return false;
  1662.   if (t->Kind == kBTE_LIST) {
  1663.   if (t->BTE_LIST.Elem->Kind == kSLICE_EXP) {
  1664. # line 1171 "AdaptMovement.puma"
  1665.   {
  1666. # line 1172 "AdaptMovement.puma"
  1667.  SliceIncrement (t->BTE_LIST.Elem, &found, &val);
  1668.      if (!found) val = 0;
  1669.  
  1670. # line 1175 "AdaptMovement.puma"
  1671.    if (! (val != 1)) goto yyL1;
  1672.   }
  1673.    return true;
  1674. yyL1:;
  1675.  
  1676.   }
  1677. # line 1178 "AdaptMovement.puma"
  1678.   {
  1679. # line 1180 "AdaptMovement.puma"
  1680.    if (! (NoSliceExp (t->BTE_LIST.Elem))) goto yyL2;
  1681.   {
  1682. # line 1181 "AdaptMovement.puma"
  1683.    if (! (TreeRank (t->BTE_LIST.Elem) > 0)) goto yyL2;
  1684.   }
  1685.   }
  1686.    return true;
  1687. yyL2:;
  1688.  
  1689. # line 1184 "AdaptMovement.puma"
  1690.   {
  1691. # line 1185 "AdaptMovement.puma"
  1692.    if (! (IndexStrides (t->BTE_LIST.Next))) goto yyL3;
  1693.   }
  1694.    return true;
  1695. yyL3:;
  1696.  
  1697.   }
  1698.   return false;
  1699. }
  1700.  
  1701. static bool NoSliceExp
  1702. # if defined __STDC__ | defined __cplusplus
  1703. (register tTree t)
  1704. # else
  1705. (t)
  1706.  register tTree t;
  1707. # endif
  1708. {
  1709.   if (t == NoTree) return false;
  1710.   if (t->Kind == kSLICE_EXP) {
  1711. # line 1190 "AdaptMovement.puma"
  1712.   {
  1713. # line 1191 "AdaptMovement.puma"
  1714.    return false;
  1715.   }
  1716.  
  1717.   }
  1718. # line 1194 "AdaptMovement.puma"
  1719.    return true;
  1720.  
  1721. }
  1722.  
  1723. static tTree MakeIndexParams
  1724. # if defined __STDC__ | defined __cplusplus
  1725. (register tTree indexes)
  1726. # else
  1727. (indexes)
  1728.  register tTree indexes;
  1729. # endif
  1730. {
  1731. # line 1199 "AdaptMovement.puma"
  1732.  
  1733. tTree param;
  1734.  
  1735.   if (indexes->Kind == kBTE_LIST) {
  1736.   if (indexes->BTE_LIST.Elem->Kind == kSLICE_EXP) {
  1737. # line 1203 "AdaptMovement.puma"
  1738.   {
  1739. # line 1207 "AdaptMovement.puma"
  1740.  param = MakeIndexParams (indexes->BTE_LIST.Next);
  1741.        param = mBTP_LIST (ExpToVarParam (indexes->BTE_LIST.Elem->SLICE_EXP.STOP), param);
  1742.        param = mBTP_LIST (ExpToVarParam (indexes->BTE_LIST.Elem->SLICE_EXP.START), param);
  1743.  
  1744.   }
  1745.    return param;
  1746.  
  1747.   }
  1748. # line 1214 "AdaptMovement.puma"
  1749.   {
  1750. # line 1215 "AdaptMovement.puma"
  1751.  param = MakeIndexParams (indexes->BTE_LIST.Next);
  1752.        param = mBTP_LIST (ExpToVarParam (indexes->BTE_LIST.Elem), param);
  1753.        param = mBTP_LIST (ExpToVarParam (indexes->BTE_LIST.Elem), param);
  1754.  
  1755.   }
  1756.    return param;
  1757.  
  1758.   }
  1759.   if (indexes->Kind == kBTE_EMPTY) {
  1760. # line 1222 "AdaptMovement.puma"
  1761.    return mBTP_EMPTY ();
  1762.  
  1763.   }
  1764.  yyAbort ("MakeIndexParams");
  1765. }
  1766.  
  1767. static void CheckMoveArrays
  1768. # if defined __STDC__ | defined __cplusplus
  1769. (register tTree source, register tTree target)
  1770. # else
  1771. (source, target)
  1772.  register tTree source;
  1773.  register tTree target;
  1774. # endif
  1775. {
  1776.   if (source == NoTree) return;
  1777.   if (target == NoTree) return;
  1778. # line 1234 "AdaptMovement.puma"
  1779.  {
  1780.   tTree type1;
  1781.   tTree type2;
  1782.   {
  1783. # line 1236 "AdaptMovement.puma"
  1784.  
  1785. # line 1238 "AdaptMovement.puma"
  1786.  type1 = TreeType (source);
  1787.       type2 = TreeType (target);
  1788.  
  1789.       if ( (type1->Kind != type2->Kind) ||
  1790.            (TreeSize (source) != TreeSize (target)) )
  1791.          { error_protocol ("Movement requires same type");
  1792.            tree_protocol ("Source type is ", type1);
  1793.            tree_protocol ("Target type is ", type2);
  1794.          }
  1795.  
  1796.   }
  1797.    return;
  1798.  }
  1799.  
  1800. ;
  1801. }
  1802.  
  1803. void BeginAdaptMovement ()
  1804. {
  1805. }
  1806.  
  1807. void CloseAdaptMovement ()
  1808. {
  1809. }
  1810.