home *** CD-ROM | disk | FTP | other *** search
/ OS/2 Shareware BBS: 10 Tools / 10-Tools.zip / adaptor.zip / adapt.zip / adaptor / src / adapton.c < prev    next >
Text File  |  1994-01-03  |  11KB  |  480 lines
  1. # include "On.h"
  2. # include "yyAOn.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 24 "AdaptOn.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"        /* IsHost, CombineACF, ReplaceACF  */
  45. # include "Dalib.h"            /* MaskNodeStmt, IsHost, ... */
  46. # include "Local.h"       /* MakeRangeStmt, MakeMask */
  47. # include "Broadcas.h"   /* MakeSizeExp             */
  48. # include "Reductio.h"       /* GlobalReductionStmt, ResolveReduce  */
  49.  
  50.  
  51.  
  52. static FILE * yyf = stdout;
  53.  
  54. static void yyAbort
  55. # ifdef __cplusplus
  56.  (char * yyFunction)
  57. # else
  58.  (yyFunction) char * yyFunction;
  59. # endif
  60. {
  61.  (void) fprintf (stderr, "Error: module AdaptOn, routine %s failed\n", yyFunction);
  62.  exit (1);
  63. }
  64.  
  65. tTree AdaptOn ARGS((tTree stmt));
  66. static tTree CollectREDUCE ARGS((tTree t, tTree pv));
  67. static tTree GlobalLocExchange ARGS((tTree params));
  68. static void ReplaceREDUCE ARGS((tTree t));
  69.  
  70. tTree AdaptOn
  71. # if defined __STDC__ | defined __cplusplus
  72. (register tTree stmt)
  73. # else
  74. (stmt)
  75.  register tTree stmt;
  76. # endif
  77. {
  78.   if (stmt->Kind == kACF_ON) {
  79. # line 58 "AdaptOn.puma"
  80.  {
  81.   tTree globals;
  82.   tTree newacf;
  83.   {
  84. # line 62 "AdaptOn.puma"
  85.    if (! ((TreeDistribution (stmt->ACF_ON.ON_VAR) == - 1))) goto yyL1;
  86.   {
  87. # line 64 "AdaptOn.puma"
  88.  
  89. # line 65 "AdaptOn.puma"
  90.  
  91. # line 67 "AdaptOn.puma"
  92.  globals = CollectREDUCE (stmt->ACF_ON.ON_STMT, stmt->ACF_ON.ON_VAR);
  93.  
  94.      if (IsHost)
  95.        { ReplaceREDUCE (stmt->ACF_ON.ON_STMT);
  96.          newacf = stmt->ACF_ON.ON_STMT;
  97.        }
  98.       else
  99.          newacf = NoTree;
  100.  
  101.      if (globals != NoTree)
  102.        error_protocol ("Reductions for Host Variables not supported");
  103.  
  104.   }
  105.   }
  106.   {
  107.    return newacf;
  108.   }
  109.  }
  110. yyL1:;
  111.  
  112. # line 83 "AdaptOn.puma"
  113.   {
  114. # line 85 "AdaptOn.puma"
  115.    if (! ((TreeDistribution (stmt->ACF_ON.ON_VAR) != 1))) goto yyL2;
  116.   {
  117. # line 87 "AdaptOn.puma"
  118.    error_protocol ("illegal on statement\n");
  119.   }
  120.   }
  121.    return stmt->ACF_ON.ON_STMT;
  122. yyL2:;
  123.  
  124.   if (stmt->ACF_ON.ON_VAR->Kind == kINDEXED_VAR) {
  125.   if (stmt->ACF_ON.ON_STMT->Kind == kACF_DOLOCAL) {
  126. # line 97 "AdaptOn.puma"
  127.  {
  128.   tTree last;
  129.   tTree globals;
  130.   tTree newacf;
  131.   {
  132. # line 101 "AdaptOn.puma"
  133.  
  134. # line 102 "AdaptOn.puma"
  135.  
  136. # line 103 "AdaptOn.puma"
  137.  
  138. # line 105 "AdaptOn.puma"
  139.  last = LastIndex (stmt->ACF_ON.ON_VAR->INDEXED_VAR.IND_EXPS);
  140.  
  141.  
  142.  
  143.      globals = CollectREDUCE (stmt->ACF_ON.ON_STMT, stmt->ACF_ON.ON_VAR);
  144.  
  145.      if (!IsHost)
  146.         { ReplaceREDUCE (stmt->ACF_ON.ON_STMT);
  147.           newacf  = MakeRangeStmt (stmt->ACF_ON.ON_VAR->INDEXED_VAR.IND_VAR, stmt->ACF_ON.ON_STMT->ACF_DOLOCAL.DOLOCAL_RANGE);
  148.           stmt->ACF_ON.ON_STMT->Kind = kACF_DOVEC;
  149.           if (newacf != NoTree)
  150.              newacf = mACF_LIST (newacf, mACF_LIST (stmt->ACF_ON.ON_STMT, NoTree));
  151.            else
  152.              newacf = stmt->ACF_ON.ON_STMT;
  153.         }
  154.  
  155.       else
  156.  
  157.           newacf = NoTree;
  158.  
  159.      newacf = CombineACF (newacf, globals);
  160.  
  161.  
  162.   }
  163.   {
  164.    return newacf;
  165.   }
  166.  }
  167.  
  168.   }
  169. # line 138 "AdaptOn.puma"
  170.  {
  171.   tTree last;
  172.   tTree globals;
  173.   tTree newacf;
  174.   {
  175. # line 140 "AdaptOn.puma"
  176.  
  177. # line 141 "AdaptOn.puma"
  178.  
  179. # line 142 "AdaptOn.puma"
  180.  
  181. # line 144 "AdaptOn.puma"
  182.  
  183.  
  184.      globals = CollectREDUCE (stmt->ACF_ON.ON_STMT, stmt->ACF_ON.ON_VAR);
  185.  
  186.      if (!IsHost)
  187.  
  188.         { ReplaceREDUCE (stmt->ACF_ON.ON_STMT);
  189.  
  190.  
  191.  
  192.           newacf = MaskNodeStmt (stmt->ACF_ON.ON_STMT, stmt->ACF_ON.ON_VAR);
  193.         }
  194.  
  195.       else
  196.  
  197.           newacf = NoTree;
  198.  
  199.      newacf = CombineACF (newacf, globals);
  200.  
  201.   }
  202.   {
  203.    return newacf;
  204.   }
  205.  }
  206.  
  207.   }
  208.   }
  209.  yyAbort ("AdaptOn");
  210. }
  211.  
  212. static tTree CollectREDUCE
  213. # if defined __STDC__ | defined __cplusplus
  214. (register tTree t, register tTree pv)
  215. # else
  216. (t, pv)
  217.  register tTree t;
  218.  register tTree pv;
  219. # endif
  220. {
  221. # line 182 "AdaptOn.puma"
  222.  
  223. tTree newacf;
  224.  
  225.  
  226.   switch (t->Kind) {
  227.   case kACF_DOLOCAL:
  228. # line 186 "AdaptOn.puma"
  229.    return CollectREDUCE (t->ACF_DOLOCAL.DOLOCAL_BODY, pv);
  230.  
  231.   case kACF_LIST:
  232. # line 190 "AdaptOn.puma"
  233.    return (CombineACF (CollectREDUCE (t->ACF_LIST.Elem, pv), CollectREDUCE (t->ACF_LIST.Next, pv)));
  234.  
  235.   case kACF_EMPTY:
  236. # line 195 "AdaptOn.puma"
  237.    return NoTree;
  238.  
  239.   case kACF_IF:
  240. # line 199 "AdaptOn.puma"
  241.    return (CombineACF (CollectREDUCE (t->ACF_IF.THEN_PART, pv), CollectREDUCE (t->ACF_IF.ELSE_PART, pv)));
  242.  
  243.   case kACF_WHILE:
  244. # line 204 "AdaptOn.puma"
  245.    return CollectREDUCE (t->ACF_WHILE.WHILE_BODY, pv);
  246.  
  247.   case kACF_DO:
  248. # line 208 "AdaptOn.puma"
  249.    return CollectREDUCE (t->ACF_DO.DO_BODY, pv);
  250.  
  251.   case kACF_DOVEC:
  252. # line 212 "AdaptOn.puma"
  253.    return CollectREDUCE (t->ACF_DOVEC.DOVEC_BODY, pv);
  254.  
  255.   case kACF_BASIC:
  256.   if (t->ACF_BASIC.BASIC_STMT->Kind == kREDUCE_STMT) {
  257.   if (t->ACF_BASIC.BASIC_STMT->REDUCE_STMT.RED_PARAMS->Kind == kBTP_LIST) {
  258.   if (t->ACF_BASIC.BASIC_STMT->REDUCE_STMT.RED_PARAMS->BTP_LIST.Elem->Kind == kVAR_PARAM) {
  259. # line 216 "AdaptOn.puma"
  260.  {
  261.   int distribution;
  262.   {
  263. # line 218 "AdaptOn.puma"
  264.  
  265. # line 220 "AdaptOn.puma"
  266.    distribution = TreeDistribution (t->ACF_BASIC.BASIC_STMT->REDUCE_STMT.RED_PARAMS->BTP_LIST.Elem->VAR_PARAM.V);
  267. # line 224 "AdaptOn.puma"
  268.    if (! (distribution != 0)) goto yyL8;
  269.   {
  270. # line 226 "AdaptOn.puma"
  271.  if (distribution == -1)
  272.        {
  273.          if (TreeDistribution(pv) != -1)
  274.            { error_protocol ("reduction to a node variable, but on host");
  275.              tree_protocol ("reduction is : \n", t);
  276.              tree_protocol ("on variable is : \n", pv);
  277.            }
  278.        }
  279.       else
  280.        {
  281.          if (CountMovements (t->ACF_BASIC.BASIC_STMT->REDUCE_STMT.RED_PARAMS->BTP_LIST.Elem->VAR_PARAM.V, pv) > 0)
  282.            { error_protocol ("reduction to node variable requires movement");
  283.              tree_protocol ("reduction is : \n", t);
  284.              tree_protocol ("on variable is : \n", pv);
  285.            }
  286.        }
  287.  
  288.   }
  289.   }
  290.   {
  291.    return NoTree;
  292.   }
  293.  }
  294. yyL8:;
  295.  
  296. # line 246 "AdaptOn.puma"
  297.   {
  298. # line 250 "AdaptOn.puma"
  299.    if (! (TreeRank (t->ACF_BASIC.BASIC_STMT->REDUCE_STMT.RED_PARAMS->BTP_LIST.Elem->VAR_PARAM.V) > 0)) goto yyL9;
  300.   {
  301. # line 252 "AdaptOn.puma"
  302.    error_protocol ("reduction to a replicated array not handled\n");
  303. # line 253 "AdaptOn.puma"
  304.    tree_protocol ("reduction is : \n", t);
  305.   }
  306.   }
  307.    return NoTree;
  308. yyL9:;
  309.  
  310.   if (t->ACF_BASIC.BASIC_STMT->REDUCE_STMT.RED_PARAMS->BTP_LIST.Next->Kind == kBTP_LIST) {
  311.   if (t->ACF_BASIC.BASIC_STMT->REDUCE_STMT.RED_PARAMS->BTP_LIST.Next->BTP_LIST.Next->Kind == kBTP_EMPTY) {
  312. # line 258 "AdaptOn.puma"
  313.    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);
  314.  
  315.   }
  316. # line 267 "AdaptOn.puma"
  317.    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->
  318. REDUCE_STMT.RED_FUNC), GlobalLocExchange (t->ACF_BASIC.BASIC_STMT->REDUCE_STMT.RED_PARAMS->BTP_LIST.Next->BTP_LIST.Next));
  319.  
  320.   }
  321.   }
  322.   }
  323.   }
  324. # line 277 "AdaptOn.puma"
  325.    return NoTree;
  326.  
  327.   case kACF_DUMMY:
  328. # line 281 "AdaptOn.puma"
  329.    return NoTree;
  330.  
  331.   }
  332.  
  333. # line 285 "AdaptOn.puma"
  334.   {
  335. # line 286 "AdaptOn.puma"
  336.    failure_protocol ("AdaptOn", "CollectREDUCE", t);
  337.   }
  338.    return NoTree;
  339.  
  340. }
  341.  
  342. static tTree GlobalLocExchange
  343. # if defined __STDC__ | defined __cplusplus
  344. (register tTree params)
  345. # else
  346. (params)
  347.  register tTree params;
  348. # endif
  349. {
  350. # line 294 "AdaptOn.puma"
  351.  
  352. tTree newparams, stmt;
  353.  
  354.   if (params->Kind == kBTP_EMPTY) {
  355. # line 298 "AdaptOn.puma"
  356.    return NoTree;
  357.  
  358.   }
  359.   if (params->Kind == kBTP_LIST) {
  360.   if (params->BTP_LIST.Elem->Kind == kVAR_PARAM) {
  361.   if (params->BTP_LIST.Next->Kind == kBTP_LIST) {
  362. # line 302 "AdaptOn.puma"
  363.   {
  364. # line 304 "AdaptOn.puma"
  365.  newparams = mBTP_EMPTY () ;
  366.       newparams = mBTP_LIST (ExpToVarParam (MakeSizeExp(params->BTP_LIST.Elem->VAR_PARAM.V)), newparams);
  367.       newparams = mBTP_LIST (mVAR_PARAM (params->BTP_LIST.Elem->VAR_PARAM.V), newparams);
  368.       stmt = mPROC_OBJ (MakeDalibId ("loc_exchange"));
  369.       stmt = mACF_BASIC (mCALL_STMT (stmt, newparams));
  370.  
  371.   }
  372.    return CombineACF (stmt, GlobalLocExchange (params->BTP_LIST.Next->BTP_LIST.Next));
  373.  
  374.   }
  375.   }
  376.   }
  377.  yyAbort ("GlobalLocExchange");
  378. }
  379.  
  380. static void ReplaceREDUCE
  381. # if defined __STDC__ | defined __cplusplus
  382. (register tTree t)
  383. # else
  384. (t)
  385.  register tTree t;
  386. # endif
  387. {
  388. # line 322 "AdaptOn.puma"
  389.  
  390. tTree newacf;
  391.  
  392.   if (t == NoTree) return;
  393.  
  394.   switch (t->Kind) {
  395.   case kACF_DOLOCAL:
  396. # line 326 "AdaptOn.puma"
  397.   {
  398. # line 327 "AdaptOn.puma"
  399.    ReplaceREDUCE (t->ACF_DOLOCAL.DOLOCAL_BODY);
  400.   }
  401.    return;
  402.  
  403.   case kACF_LIST:
  404.   if (t->ACF_LIST.Elem->Kind == kACF_BASIC) {
  405.   if (t->ACF_LIST.Elem->ACF_BASIC.BASIC_STMT->Kind == kREDUCE_STMT) {
  406. # line 330 "AdaptOn.puma"
  407.   {
  408. # line 334 "AdaptOn.puma"
  409.  t->ACF_LIST.Elem = ResolveReduce (t->ACF_LIST.Elem);
  410. # line 336 "AdaptOn.puma"
  411.    ReplaceREDUCE (t->ACF_LIST.Next);
  412.   }
  413.    return;
  414.  
  415.   }
  416.   }
  417. # line 339 "AdaptOn.puma"
  418.   {
  419. # line 340 "AdaptOn.puma"
  420.    ReplaceREDUCE (t->ACF_LIST.Elem);
  421. # line 341 "AdaptOn.puma"
  422.    ReplaceREDUCE (t->ACF_LIST.Next);
  423.   }
  424.    return;
  425.  
  426.   case kACF_EMPTY:
  427. # line 344 "AdaptOn.puma"
  428.    return;
  429.  
  430.   case kACF_IF:
  431. # line 347 "AdaptOn.puma"
  432.   {
  433. # line 348 "AdaptOn.puma"
  434.    ReplaceREDUCE (t->ACF_IF.THEN_PART);
  435. # line 349 "AdaptOn.puma"
  436.    ReplaceREDUCE (t->ACF_IF.ELSE_PART);
  437.   }
  438.    return;
  439.  
  440.   case kACF_WHILE:
  441. # line 352 "AdaptOn.puma"
  442.   {
  443. # line 353 "AdaptOn.puma"
  444.    ReplaceREDUCE (t->ACF_WHILE.WHILE_BODY);
  445.   }
  446.    return;
  447.  
  448.   case kACF_DO:
  449. # line 356 "AdaptOn.puma"
  450.   {
  451. # line 357 "AdaptOn.puma"
  452.    ReplaceREDUCE (t->ACF_DO.DO_BODY);
  453.   }
  454.    return;
  455.  
  456.   case kACF_DOVEC:
  457. # line 360 "AdaptOn.puma"
  458.   {
  459. # line 361 "AdaptOn.puma"
  460.    ReplaceREDUCE (t->ACF_DOVEC.DOVEC_BODY);
  461.   }
  462.    return;
  463.  
  464.   case kACF_BASIC:
  465. # line 364 "AdaptOn.puma"
  466.    return;
  467.  
  468.   }
  469.  
  470. ;
  471. }
  472.  
  473. void BeginAdaptOn ()
  474. {
  475. }
  476.  
  477. void CloseAdaptOn ()
  478. {
  479. }
  480.