home *** CD-ROM | disk | FTP | other *** search
/ OS/2 Professional / OS2PRO194.ISO / os2 / prgramer / adaptor / src / adaptfor.c < prev    next >
Encoding:
C/C++ Source or Header  |  1994-01-03  |  15.4 KB  |  666 lines
  1. # include "Forall.h"
  2. # include "yyAForal.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 23 "AdaptForall.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 "Dependen.h"
  45. # include "Transfor.h"        /* CombineACF, ReplaceACF */
  46. # include "F90.h"         /* MakeArrayAssignment    */
  47.  
  48. # define MAXForall 10
  49.  
  50. /*********************************************************************
  51. *                                                                    *
  52. *  Nest[0]          FORALL I1 = ...                                  *
  53. *  Nest[1]          FORALL I2 = ...                                  *
  54. *  ...                                                               *
  55. *  Nest[Nesting-1]  FORALL Ik = ...                                  *
  56. *                                                                    *
  57. *    stmt      :         A(I1,I2,...,Ik)  = ....                     *
  58. *                                                                    *
  59. *     proves that no dataflow dependences will exist                 *
  60. *                                                                    *
  61. *                                                                    *
  62. *   kind1   :       var = exp    (can be a movement)                 *
  63. *                                                                    *
  64. *                     can become array expressionn                   *
  65. *                                                                    *
  66. *   kind2   :       if (...) ...... end if                           *
  67. *                   from where statement                             *
  68. *                                                                    *
  69. *                   will not be transformed at all                   *
  70. *                                                                    *
  71. *********************************************************************/
  72.  
  73. static int   Nesting;          /* nesting depth */
  74. static tTree Nest[MAXForall];  /* DOLOCAL loops for maximal nesting */
  75.  
  76. static tTree forallstmt;       /* FORALL : innermost stmt */
  77.  
  78. static tTree forallvar;        /* only set for single assignment */
  79. static tTree forallexp;        /*    forallvar = forallexp       */
  80.  
  81. static bool  dataflow, movement;
  82.  
  83.  
  84.  
  85. static FILE * yyf = stdout;
  86.  
  87. static void yyAbort
  88. # ifdef __cplusplus
  89.  (char * yyFunction)
  90. # else
  91.  (yyFunction) char * yyFunction;
  92. # endif
  93. {
  94.  (void) fprintf (stderr, "Error: module AdaptForall, routine %s failed\n", yyFunction);
  95.  exit (1);
  96. }
  97.  
  98. tTree TransformFORALL ARGS((tTree t));
  99. static void SetUpForall ARGS((tTree body));
  100. static void CheckDataFlowExp ARGS((tTree var, tTree exp));
  101. static void CheckDataFlow1 ARGS((tTree var, tTree stmt));
  102. static void CheckDataFlow ARGS((tTree stmt, tTree body));
  103.  
  104. tTree TransformFORALL
  105. # if defined __STDC__ | defined __cplusplus
  106. (register tTree t)
  107. # else
  108. (t)
  109.  register tTree t;
  110. # endif
  111. {
  112. # line 80 "AdaptForall.puma"
  113.  
  114. int i;
  115. tTree pl, newa;
  116.  
  117.   if (t->Kind == kACF_FORALL) {
  118. # line 85 "AdaptForall.puma"
  119.   {
  120. # line 87 "AdaptForall.puma"
  121.  
  122.  
  123.      Nesting    = 0;
  124.      forallvar  = NoTree;
  125.      forallexp  = NoTree;
  126.  
  127.      SetUpForall (t);
  128.  
  129.  
  130.  
  131.      dataflow = false;
  132.  
  133.      CheckDataFlow (forallstmt, forallstmt);
  134.  
  135.      if (!dataflow)
  136.        {
  137.        }
  138.  
  139.      movement = (forallvar != NoTree);
  140.  
  141.      if (movement)
  142.         movement = (CountMovements (forallvar, forallexp) > 0);
  143.  
  144.      if (movement)
  145.  
  146.        {
  147.  
  148.          stmt_protocol ("forall will be transformed to array movement:\n");
  149.          newa = MakeArrayAssignment (t);
  150.          tree_protocol ("array movement is : \n", newa);
  151.  
  152.           for (i=0; i<Nesting; i++)
  153.            { pl = Nest[i];
  154.              pl->Kind = kACF_DO;
  155.            }
  156.        }
  157.  
  158.      else
  159.  
  160.        {
  161.  
  162.           for (i=0; i<Nesting; i++)
  163.            { pl = Nest[i];
  164.              pl->Kind = kACF_DOLOCAL;
  165.            }
  166.           newa = t;
  167.        }
  168.  
  169.  
  170.  
  171.   }
  172.    return newa;
  173.  
  174.   }
  175. # line 141 "AdaptForall.puma"
  176.   {
  177. # line 142 "AdaptForall.puma"
  178.    printf ("Illegal call of TransformFORALL\n");
  179. # line 143 "AdaptForall.puma"
  180.    WriteTree (stdout, t);
  181. # line 144 "AdaptForall.puma"
  182.    FileUnparse (stdout, t);
  183. # line 145 "AdaptForall.puma"
  184.    kill_in_protocol ();
  185.   }
  186.    return t;
  187.  
  188. }
  189.  
  190. static void SetUpForall
  191. # if defined __STDC__ | defined __cplusplus
  192. (register tTree body)
  193. # else
  194. (body)
  195.  register tTree body;
  196. # endif
  197. {
  198.   if (body == NoTree) return;
  199.   if (body->Kind == kACF_LIST) {
  200.   if (body->ACF_LIST.Elem->Kind == kACF_BASIC) {
  201.   if (body->ACF_LIST.Elem->ACF_BASIC.BASIC_STMT->Kind == kASSIGN_STMT) {
  202.   if (body->ACF_LIST.Next->Kind == kACF_EMPTY) {
  203. # line 159 "AdaptForall.puma"
  204.   {
  205. # line 161 "AdaptForall.puma"
  206.    forallstmt = body->ACF_LIST.Elem;
  207. # line 162 "AdaptForall.puma"
  208.    forallvar = body->ACF_LIST.Elem->ACF_BASIC.BASIC_STMT->ASSIGN_STMT.ASSIGN_VAR;
  209. # line 163 "AdaptForall.puma"
  210.    forallexp = body->ACF_LIST.Elem->ACF_BASIC.BASIC_STMT->ASSIGN_STMT.ASSIGN_EXP;
  211.   }
  212.    return;
  213.  
  214.   }
  215.   }
  216.   }
  217.   if (body->ACF_LIST.Next->Kind == kACF_EMPTY) {
  218. # line 166 "AdaptForall.puma"
  219.   {
  220. # line 168 "AdaptForall.puma"
  221.    SetUpForall (body->ACF_LIST.Elem);
  222.   }
  223.    return;
  224.  
  225.   }
  226. # line 171 "AdaptForall.puma"
  227.   {
  228. # line 174 "AdaptForall.puma"
  229.    if (! (forallstmt = body)) goto yyL3;
  230.   }
  231.    return;
  232. yyL3:;
  233.  
  234.   }
  235.   if (body->Kind == kACF_IF) {
  236. # line 179 "AdaptForall.puma"
  237.   {
  238. # line 180 "AdaptForall.puma"
  239.    forallstmt = body;
  240.   }
  241.    return;
  242.  
  243.   }
  244.   if (body->Kind == kACF_FORALL) {
  245. # line 183 "AdaptForall.puma"
  246.   {
  247. # line 184 "AdaptForall.puma"
  248.  if (Nesting >= MAXForall)
  249.        simple_error_protocol ("to deep forall nesting");
  250.      else
  251.        { Nest [Nesting] = body;
  252.          Nesting += 1;
  253.          SetUpForall (body->ACF_FORALL.FORALL_BODY);
  254.        }
  255.  
  256.   }
  257.    return;
  258.  
  259.   }
  260. # line 194 "AdaptForall.puma"
  261.   {
  262. # line 195 "AdaptForall.puma"
  263.    printf ("SetUpForall failed for \n");
  264. # line 196 "AdaptForall.puma"
  265.    FileUnparse (stdout, body);
  266. # line 197 "AdaptForall.puma"
  267.    WriteTree (stdout, body);
  268. # line 198 "AdaptForall.puma"
  269.    exit (- 1);
  270.   }
  271.    return;
  272.  
  273. ;
  274. }
  275.  
  276. static void CheckDataFlowExp
  277. # if defined __STDC__ | defined __cplusplus
  278. (register tTree var, register tTree exp)
  279. # else
  280. (var, exp)
  281.  register tTree var;
  282.  register tTree exp;
  283. # endif
  284. {
  285. # line 216 "AdaptForall.puma"
  286.  
  287. char PString [100];
  288.  
  289.   if (var == NoTree) return;
  290.   if (exp == NoTree) return;
  291.   if (exp->Kind == kOP_EXP) {
  292. # line 220 "AdaptForall.puma"
  293.   {
  294. # line 221 "AdaptForall.puma"
  295.    CheckDataFlowExp (var, exp->OP_EXP.OPND1);
  296. # line 222 "AdaptForall.puma"
  297.    CheckDataFlowExp (var, exp->OP_EXP.OPND2);
  298.   }
  299.    return;
  300.  
  301.   }
  302.   if (exp->Kind == kOP1_EXP) {
  303. # line 225 "AdaptForall.puma"
  304.   {
  305. # line 226 "AdaptForall.puma"
  306.    CheckDataFlowExp (var, exp->OP1_EXP.OPND);
  307.   }
  308.    return;
  309.  
  310.   }
  311.   if (exp->Kind == kCONST_EXP) {
  312. # line 229 "AdaptForall.puma"
  313.    return;
  314.  
  315.   }
  316.   if (exp->Kind == kUSED_VAR) {
  317. # line 232 "AdaptForall.puma"
  318.    return;
  319.  
  320.   }
  321.   if (exp->Kind == kLOOP_VAR) {
  322. # line 236 "AdaptForall.puma"
  323.    return;
  324.  
  325.   }
  326.   if (exp->Kind == kVAR_EXP) {
  327. # line 240 "AdaptForall.puma"
  328.   {
  329. # line 241 "AdaptForall.puma"
  330.    CheckDataFlowExp (var, exp->VAR_EXP.V);
  331.   }
  332.    return;
  333.  
  334.   }
  335.   if (var->Kind == kINDEXED_VAR) {
  336.   if (var->INDEXED_VAR.IND_VAR->Kind == kUSED_VAR) {
  337.   if (exp->Kind == kINDEXED_VAR) {
  338.   if (exp->INDEXED_VAR.IND_VAR->Kind == kUSED_VAR) {
  339. # line 244 "AdaptForall.puma"
  340.  {
  341.   Predicate P;
  342.   PredVector PV;
  343.   int ConstLoops;
  344.   int CommonLoops;
  345.   {
  346. # line 246 "AdaptForall.puma"
  347.    if (! (var->INDEXED_VAR.IND_VAR->USED_VAR.VARNAME->VAR_OBJ.Ident == exp->INDEXED_VAR.IND_VAR->USED_VAR.VARNAME->VAR_OBJ.Ident)) goto yyL7;
  348.   {
  349. # line 250 "AdaptForall.puma"
  350.  
  351. # line 251 "AdaptForall.puma"
  352.  
  353. # line 253 "AdaptForall.puma"
  354.  
  355. # line 254 "AdaptForall.puma"
  356.  
  357. # line 256 "AdaptForall.puma"
  358.  CommonLoops = Nesting;
  359.       PMakeFalse (&P);
  360.       for (ConstLoops = 0; ConstLoops < Nesting; ConstLoops++)
  361.         {
  362.           PVMakeForLoopNest (Nesting, CommonLoops, ConstLoops, &PV);
  363.           Dependences (var, Nest, Nesting, exp, Nest, Nesting,
  364.                        CommonLoops, ConstLoops, &PV);
  365.           POrVector (&P, &PV);
  366.         }
  367.       if (!PIsFalse (&P))
  368.         { dataflow = true;
  369.           error_protocol ("Cannot sequentialize FORALL -> true dep");
  370.           tree_protocol ("Variable = ", var);
  371.           tree_protocol ("Expression = ", exp);
  372.           strcpy (PString, "Dependences : ");
  373.           POut (PString, &P);
  374.           print_protocol (PString);
  375.         }
  376.  
  377.   }
  378.   }
  379.    return;
  380.  }
  381. yyL7:;
  382.  
  383. # line 277 "AdaptForall.puma"
  384.   {
  385. # line 279 "AdaptForall.puma"
  386.    if (! (var->INDEXED_VAR.IND_VAR->USED_VAR.VARNAME->VAR_OBJ.Ident != exp->INDEXED_VAR.IND_VAR->USED_VAR.VARNAME->VAR_OBJ.Ident)) goto yyL8;
  387.   }
  388.    return;
  389. yyL8:;
  390.  
  391.   }
  392.   }
  393.   }
  394.   }
  395.   if (exp->Kind == kFUNC_CALL_EXP) {
  396. # line 282 "AdaptForall.puma"
  397.   {
  398. # line 283 "AdaptForall.puma"
  399.    CheckDataFlowExp (var, exp->FUNC_CALL_EXP.FUNC_PARAMS);
  400.   }
  401.    return;
  402.  
  403.   }
  404.   if (exp->Kind == kADDR) {
  405. # line 286 "AdaptForall.puma"
  406.   {
  407. # line 287 "AdaptForall.puma"
  408.    CheckDataFlowExp (var, exp->ADDR.E);
  409.   }
  410.    return;
  411.  
  412.   }
  413.   if (exp->Kind == kBTP_LIST) {
  414.   if (exp->BTP_LIST.Elem->Kind == kVAR_PARAM) {
  415. # line 290 "AdaptForall.puma"
  416.   {
  417. # line 291 "AdaptForall.puma"
  418.    CheckDataFlowExp (var, exp->BTP_LIST.Elem->VAR_PARAM.V);
  419. # line 292 "AdaptForall.puma"
  420.    CheckDataFlowExp (var, exp->BTP_LIST.Next);
  421.   }
  422.    return;
  423.  
  424.   }
  425.   }
  426.   if (exp->Kind == kBTP_EMPTY) {
  427. # line 295 "AdaptForall.puma"
  428.    return;
  429.  
  430.   }
  431. # line 298 "AdaptForall.puma"
  432.   {
  433. # line 299 "AdaptForall.puma"
  434.    printf ("CheckDataFlowExp failed\n");
  435. # line 300 "AdaptForall.puma"
  436.    FileUnparse (stdout, var);
  437. # line 300 "AdaptForall.puma"
  438.    printf (" is variable\n");
  439. # line 301 "AdaptForall.puma"
  440.    WriteTree (stdout, var);
  441. # line 302 "AdaptForall.puma"
  442.    FileUnparse (stdout, exp);
  443. # line 302 "AdaptForall.puma"
  444.    printf (" is expression\n");
  445. # line 303 "AdaptForall.puma"
  446.    WriteTree (stdout, exp);
  447.   }
  448.    return;
  449.  
  450. ;
  451. }
  452.  
  453. static void CheckDataFlow1
  454. # if defined __STDC__ | defined __cplusplus
  455. (register tTree var, register tTree stmt)
  456. # else
  457. (var, stmt)
  458.  register tTree var;
  459.  register tTree stmt;
  460. # endif
  461. {
  462.   if (var == NoTree) return;
  463.   if (stmt == NoTree) return;
  464.  
  465.   switch (stmt->Kind) {
  466.   case kACF_LIST:
  467. # line 318 "AdaptForall.puma"
  468.   {
  469. # line 319 "AdaptForall.puma"
  470.    CheckDataFlow1 (var, stmt->ACF_LIST.Elem);
  471. # line 320 "AdaptForall.puma"
  472.    CheckDataFlow1 (var, stmt->ACF_LIST.Next);
  473.   }
  474.    return;
  475.  
  476.   case kACF_EMPTY:
  477. # line 323 "AdaptForall.puma"
  478.    return;
  479.  
  480.   case kACF_IF:
  481. # line 326 "AdaptForall.puma"
  482.   {
  483. # line 327 "AdaptForall.puma"
  484.    CheckDataFlowExp (var, stmt->ACF_IF.IF_EXP);
  485. # line 328 "AdaptForall.puma"
  486.    CheckDataFlow1 (var, stmt->ACF_IF.THEN_PART);
  487. # line 329 "AdaptForall.puma"
  488.    CheckDataFlow1 (var, stmt->ACF_IF.ELSE_PART);
  489.   }
  490.    return;
  491.  
  492.   case kACF_DOLOCAL:
  493. # line 332 "AdaptForall.puma"
  494.   {
  495. # line 333 "AdaptForall.puma"
  496.    CheckDataFlow1 (var, stmt->ACF_DOLOCAL.DOLOCAL_BODY);
  497.   }
  498.    return;
  499.  
  500.   case kACF_BASIC:
  501. # line 336 "AdaptForall.puma"
  502.   {
  503. # line 337 "AdaptForall.puma"
  504.    CheckDataFlow1 (var, stmt->ACF_BASIC.BASIC_STMT);
  505.   }
  506.    return;
  507.  
  508.   case kASSIGN_STMT:
  509. # line 340 "AdaptForall.puma"
  510.   {
  511. # line 341 "AdaptForall.puma"
  512.  if (var != stmt->ASSIGN_STMT.ASSIGN_VAR)
  513.          CheckDataFlowExp (var, stmt->ASSIGN_STMT.ASSIGN_VAR);
  514.  
  515. # line 344 "AdaptForall.puma"
  516.    CheckDataFlowExp (var, stmt->ASSIGN_STMT.ASSIGN_EXP);
  517.   }
  518.    return;
  519.  
  520.   case kREDUCE_STMT:
  521.   if (stmt->REDUCE_STMT.RED_PARAMS->Kind == kBTP_LIST) {
  522.   if (stmt->REDUCE_STMT.RED_PARAMS->BTP_LIST.Elem->Kind == kVAR_PARAM) {
  523. # line 347 "AdaptForall.puma"
  524.   {
  525. # line 348 "AdaptForall.puma"
  526.  if (var != stmt->REDUCE_STMT.RED_PARAMS->BTP_LIST.Elem->VAR_PARAM.V)
  527.          CheckDataFlowExp (var, stmt->REDUCE_STMT.RED_PARAMS->BTP_LIST.Elem->VAR_PARAM.V);
  528.  
  529. # line 351 "AdaptForall.puma"
  530.    CheckDataFlowExp (var, stmt->REDUCE_STMT.RED_PARAMS->BTP_LIST.Next);
  531.   }
  532.    return;
  533.  
  534.   }
  535.   }
  536.   break;
  537.   }
  538.  
  539. # line 354 "AdaptForall.puma"
  540.   {
  541. # line 355 "AdaptForall.puma"
  542.    printf ("CheckDataFlow1 failed\n");
  543. # line 356 "AdaptForall.puma"
  544.    FileUnparse (stdout, var);
  545. # line 356 "AdaptForall.puma"
  546.    printf (" is variable\n");
  547. # line 357 "AdaptForall.puma"
  548.    WriteTree (stdout, var);
  549. # line 358 "AdaptForall.puma"
  550.    FileUnparse (stdout, stmt);
  551. # line 358 "AdaptForall.puma"
  552.    printf (" is statement\n");
  553. # line 359 "AdaptForall.puma"
  554.    WriteTree (stdout, stmt);
  555.   }
  556.    return;
  557.  
  558. ;
  559. }
  560.  
  561. static void CheckDataFlow
  562. # if defined __STDC__ | defined __cplusplus
  563. (register tTree stmt, register tTree body)
  564. # else
  565. (stmt, body)
  566.  register tTree stmt;
  567.  register tTree body;
  568. # endif
  569. {
  570.   if (stmt == NoTree) return;
  571.   if (body == NoTree) return;
  572.  
  573.   switch (stmt->Kind) {
  574.   case kACF_LIST:
  575. # line 373 "AdaptForall.puma"
  576.   {
  577. # line 374 "AdaptForall.puma"
  578.    CheckDataFlow (stmt->ACF_LIST.Elem, body);
  579. # line 375 "AdaptForall.puma"
  580.    CheckDataFlow (stmt->ACF_LIST.Next, body);
  581.   }
  582.    return;
  583.  
  584.   case kACF_EMPTY:
  585. # line 378 "AdaptForall.puma"
  586.    return;
  587.  
  588.   case kACF_IF:
  589. # line 381 "AdaptForall.puma"
  590.   {
  591. # line 382 "AdaptForall.puma"
  592.    CheckDataFlow (stmt->ACF_IF.THEN_PART, body);
  593. # line 383 "AdaptForall.puma"
  594.    CheckDataFlow (stmt->ACF_IF.ELSE_PART, body);
  595.   }
  596.    return;
  597.  
  598.   case kACF_BASIC:
  599. # line 386 "AdaptForall.puma"
  600.   {
  601. # line 387 "AdaptForall.puma"
  602.    CheckDataFlow (stmt->ACF_BASIC.BASIC_STMT, body);
  603.   }
  604.    return;
  605.  
  606.   case kASSIGN_STMT:
  607. # line 390 "AdaptForall.puma"
  608.   {
  609. # line 391 "AdaptForall.puma"
  610.    CheckDataFlow1 (stmt->ASSIGN_STMT.ASSIGN_VAR, body);
  611.   }
  612.    return;
  613.  
  614.   case kREDUCE_STMT:
  615.   if (stmt->REDUCE_STMT.RED_PARAMS->Kind == kBTP_LIST) {
  616.   if (stmt->REDUCE_STMT.RED_PARAMS->BTP_LIST.Elem->Kind == kVAR_PARAM) {
  617. # line 394 "AdaptForall.puma"
  618.   {
  619. # line 395 "AdaptForall.puma"
  620.    CheckDataFlow1 (stmt->REDUCE_STMT.RED_PARAMS->BTP_LIST.Elem->VAR_PARAM.V, body);
  621.   }
  622.    return;
  623.  
  624.   }
  625.   }
  626.   break;
  627.   case kACF_DOLOCAL:
  628. # line 398 "AdaptForall.puma"
  629.   {
  630. # line 399 "AdaptForall.puma"
  631.    CheckDataFlow (stmt->ACF_DOLOCAL.DOLOCAL_BODY, body);
  632.   }
  633.    return;
  634.  
  635.   }
  636.  
  637. # line 402 "AdaptForall.puma"
  638.   {
  639. # line 403 "AdaptForall.puma"
  640.    printf ("CheckDataFlow failed\n");
  641. # line 404 "AdaptForall.puma"
  642.    FileUnparse (stdout, stmt);
  643. # line 404 "AdaptForall.puma"
  644.    printf (" is stmt\n");
  645. # line 405 "AdaptForall.puma"
  646.    WriteTree (stdout, stmt);
  647. # line 406 "AdaptForall.puma"
  648.    FileUnparse (stdout, body);
  649. # line 406 "AdaptForall.puma"
  650.    printf (" is body\n");
  651. # line 407 "AdaptForall.puma"
  652.    WriteTree (stdout, body);
  653.   }
  654.    return;
  655.  
  656. ;
  657. }
  658.  
  659. void BeginAdaptForall ()
  660. {
  661. }
  662.  
  663. void CloseAdaptForall ()
  664. {
  665. }
  666.