home *** CD-ROM | disk | FTP | other *** search
/ OS/2 Professional / OS2PRO194.ISO / os2 / prgramer / adaptor / src / adaptini.c < prev    next >
Encoding:
C/C++ Source or Header  |  1994-01-03  |  19.6 KB  |  862 lines
  1. # include "Init.h"
  2. # include "yyAInit.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 29 "AdaptInit.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"    /* CombineACF, ... */
  45. # include "Shapes.h"
  46. # include "TempScal.h"  /* TempScalarsInitBody, TempScalarsDoneBody  */
  47. # include "F77.h"
  48.  
  49. tTree NewAllocates;
  50. tTree NewDeAllocates;
  51.  
  52. int forall_loops;             /* no reductions in FORALL */
  53.  
  54.  
  55.  
  56. static FILE * yyf = stdout;
  57.  
  58. static void yyAbort
  59. # ifdef __cplusplus
  60.  (char * yyFunction)
  61. # else
  62.  (yyFunction) char * yyFunction;
  63. # endif
  64. {
  65.  (void) fprintf (stderr, "Error: module AdaptInit, routine %s failed\n", yyFunction);
  66.  exit (1);
  67. }
  68.  
  69. void AdaptInit ARGS((tTree t));
  70. static void ChangeDistributedArrays ARGS((tTree t));
  71. static void ChangeVarDecl ARGS((tTree t, tDefinitions Obj));
  72. static void MakeTreeAllocatable ARGS((tTree val));
  73. static tTree MakeAllocate ARGS((tTree t));
  74. static tTree MakeDeallocate ARGS((tTree t));
  75. static tTree AdaptInitACF ARGS((tTree t));
  76. static tTree AdaptInitAssign ARGS((tTree assign, int rankvar, int rankexp));
  77. static bool TranslateArrayOperation ARGS((tTree var, tTree exp, int moves));
  78.  
  79. void AdaptInit
  80. # if defined __STDC__ | defined __cplusplus
  81. (register tTree t)
  82. # else
  83. (t)
  84.  register tTree t;
  85. # endif
  86. {
  87.   if (t == NoTree) return;
  88.   if (t->Kind == kCOMP_UNIT) {
  89. # line 62 "AdaptInit.puma"
  90.   {
  91. # line 63 "AdaptInit.puma"
  92.    open_protocol ("adaptor.ini");
  93. # line 64 "AdaptInit.puma"
  94.    AdaptInit (t->COMP_UNIT.COMP_ELEMENTS);
  95. # line 65 "AdaptInit.puma"
  96.    close_protocol ();
  97.   }
  98.    return;
  99.  
  100.   }
  101.   if (t->Kind == kDECL_EMPTY) {
  102. # line 68 "AdaptInit.puma"
  103.    return;
  104.  
  105.   }
  106.   if (t->Kind == kDECL_LIST) {
  107.   if (t->DECL_LIST.Elem->Kind == kPROGRAM_DECL) {
  108. # line 71 "AdaptInit.puma"
  109.  {
  110.   tDefinitions Obj;
  111.   {
  112. # line 72 "AdaptInit.puma"
  113.    set_protocol_unit (t->DECL_LIST.Elem);
  114. # line 73 "AdaptInit.puma"
  115.  
  116. # line 74 "AdaptInit.puma"
  117.    Obj = GetDeclEntry (t->DECL_LIST.Elem->PROGRAM_DECL.Name, GetUnitEntries ());
  118. # line 75 "AdaptInit.puma"
  119.    OpenScope (Obj->ProcObject.Declarations);
  120. # line 76 "AdaptInit.puma"
  121.    AdaptInit (t->DECL_LIST.Elem->PROGRAM_DECL.PROGRAM_BODY);
  122. # line 77 "AdaptInit.puma"
  123.    if (! (Obj->ProcObject.Declarations = GetCurrentScope ())) goto yyL3;
  124.   {
  125. # line 78 "AdaptInit.puma"
  126.    CloseScope ();
  127. # line 79 "AdaptInit.puma"
  128.    AdaptInit (t->DECL_LIST.Next);
  129.   }
  130.   }
  131.    return;
  132.  }
  133. yyL3:;
  134.  
  135.   }
  136.   if (t->DECL_LIST.Elem->Kind == kPROC_DECL) {
  137. # line 82 "AdaptInit.puma"
  138.  {
  139.   tDefinitions Obj;
  140.   {
  141. # line 83 "AdaptInit.puma"
  142.    set_protocol_unit (t->DECL_LIST.Elem);
  143. # line 84 "AdaptInit.puma"
  144.  
  145. # line 85 "AdaptInit.puma"
  146.    Obj = GetDeclEntry (t->DECL_LIST.Elem->PROC_DECL.Name, GetUnitEntries ());
  147. # line 86 "AdaptInit.puma"
  148.    OpenScope (Obj->ProcObject.Declarations);
  149. # line 87 "AdaptInit.puma"
  150.    AdaptInit (t->DECL_LIST.Elem->PROC_DECL.PROC_BODY);
  151. # line 88 "AdaptInit.puma"
  152.    if (! (Obj->ProcObject.Declarations = GetCurrentScope ())) goto yyL4;
  153.   {
  154. # line 89 "AdaptInit.puma"
  155.    CloseScope ();
  156. # line 90 "AdaptInit.puma"
  157.    AdaptInit (t->DECL_LIST.Next);
  158.   }
  159.   }
  160.    return;
  161.  }
  162. yyL4:;
  163.  
  164.   }
  165.   if (t->DECL_LIST.Elem->Kind == kFUNC_DECL) {
  166. # line 93 "AdaptInit.puma"
  167.  {
  168.   tDefinitions Obj;
  169.   {
  170. # line 94 "AdaptInit.puma"
  171.    set_protocol_unit (t->DECL_LIST.Elem);
  172. # line 95 "AdaptInit.puma"
  173.  
  174. # line 96 "AdaptInit.puma"
  175.    Obj = GetDeclEntry (t->DECL_LIST.Elem->FUNC_DECL.Name, GetUnitEntries ());
  176. # line 97 "AdaptInit.puma"
  177.    OpenScope (Obj->FuncObject.Declarations);
  178. # line 98 "AdaptInit.puma"
  179.    AdaptInit (t->DECL_LIST.Elem->FUNC_DECL.FUNC_BODY);
  180. # line 99 "AdaptInit.puma"
  181.    if (! (Obj->FuncObject.Declarations = GetCurrentScope ())) goto yyL5;
  182.   {
  183. # line 100 "AdaptInit.puma"
  184.    CloseScope ();
  185. # line 101 "AdaptInit.puma"
  186.    AdaptInit (t->DECL_LIST.Next);
  187.   }
  188.   }
  189.    return;
  190.  }
  191. yyL5:;
  192.  
  193.   }
  194.   if (t->DECL_LIST.Elem->Kind == kBLOCK_DATA_DECL) {
  195. # line 104 "AdaptInit.puma"
  196.  {
  197.   tDefinitions Obj;
  198.   {
  199. # line 105 "AdaptInit.puma"
  200.    set_protocol_unit (t->DECL_LIST.Elem);
  201. # line 106 "AdaptInit.puma"
  202.  
  203. # line 107 "AdaptInit.puma"
  204.    Obj = GetDeclEntry (t->DECL_LIST.Elem->BLOCK_DATA_DECL.Name, GetUnitEntries ());
  205. # line 108 "AdaptInit.puma"
  206.    OpenScope (Obj->BlockObject.Declarations);
  207. # line 109 "AdaptInit.puma"
  208.    AdaptInit (t->DECL_LIST.Elem->BLOCK_DATA_DECL.DATA_BODY);
  209. # line 110 "AdaptInit.puma"
  210.    if (! (Obj->BlockObject.Declarations = GetCurrentScope ())) goto yyL6;
  211.   {
  212. # line 111 "AdaptInit.puma"
  213.    CloseScope ();
  214. # line 112 "AdaptInit.puma"
  215.    AdaptInit (t->DECL_LIST.Next);
  216.   }
  217.   }
  218.    return;
  219.  }
  220. yyL6:;
  221.  
  222.   }
  223.   }
  224.   if (t->Kind == kBODY_NODE) {
  225. # line 115 "AdaptInit.puma"
  226.   {
  227. # line 116 "AdaptInit.puma"
  228.    ChangeDistributedArrays (t);
  229. # line 117 "AdaptInit.puma"
  230.    forall_loops = 0;
  231. # line 118 "AdaptInit.puma"
  232.    if (! (AdaptInitACF (t))) goto yyL7;
  233.   }
  234.    return;
  235. yyL7:;
  236.  
  237.   }
  238. ;
  239. }
  240.  
  241. static void ChangeDistributedArrays
  242. # if defined __STDC__ | defined __cplusplus
  243. (register tTree t)
  244. # else
  245. (t)
  246.  register tTree t;
  247. # endif
  248. {
  249. # line 144 "AdaptInit.puma"
  250.  
  251. tObject Obj;
  252.  
  253.   if (t == NoTree) return;
  254.   if (t->Kind == kBODY_NODE) {
  255. # line 148 "AdaptInit.puma"
  256.   {
  257. # line 149 "AdaptInit.puma"
  258.  NewAllocates = NoTree;
  259.       NewDeAllocates = mACF_EMPTY();
  260.       ChangeDistributedArrays (t->BODY_NODE.DECLS);
  261.  
  262.       t->BODY_NODE.STATS = CombineACF (t->BODY_NODE.STATS, NewDeAllocates);
  263.       t->BODY_NODE.STATS = CombineACF (NewAllocates, t->BODY_NODE.STATS);
  264.  
  265.   }
  266.    return;
  267.  
  268.   }
  269.   if (t->Kind == kDECL_LIST) {
  270. # line 158 "AdaptInit.puma"
  271.   {
  272. # line 159 "AdaptInit.puma"
  273.    ChangeDistributedArrays (t->DECL_LIST.Elem);
  274. # line 160 "AdaptInit.puma"
  275.    ChangeDistributedArrays (t->DECL_LIST.Next);
  276.   }
  277.    return;
  278.  
  279.   }
  280.   if (t->Kind == kDECL_EMPTY) {
  281. # line 163 "AdaptInit.puma"
  282.    return;
  283.  
  284.   }
  285.   if (t->Kind == kVAR_DECL) {
  286.   if (t->VAR_DECL.VAL->Kind == kARRAY_TYPE) {
  287. # line 167 "AdaptInit.puma"
  288.   {
  289. # line 168 "AdaptInit.puma"
  290.    ChangeVarDecl (t, GetLocalDecl (t->VAR_DECL.Name));
  291.   }
  292.    return;
  293.  
  294.   }
  295.   }
  296. # line 171 "AdaptInit.puma"
  297.    return;
  298.  
  299. ;
  300. }
  301.  
  302. static void ChangeVarDecl
  303. # if defined __STDC__ | defined __cplusplus
  304. (register tTree t, register tDefinitions Obj)
  305. # else
  306. (t, Obj)
  307.  register tTree t;
  308.  register tDefinitions Obj;
  309. # endif
  310. {
  311.   if (t == NoTree) return;
  312.   if (Obj == NoDefinitions) return;
  313.   if (t->Kind == kVAR_DECL) {
  314.   if (Obj->Kind == kVarObject) {
  315.   if (Obj->VarObject.Kind->Kind == kVarLocal) {
  316.   if (Obj->VarObject.Dist->Kind == kNodeDistribution) {
  317. # line 190 "AdaptInit.puma"
  318.   {
  319. # line 193 "AdaptInit.puma"
  320.    if (! (Obj->VarObject.Kind->VarLocal.dynamic != arr_allocatable)) goto yyL1;
  321.   {
  322. # line 195 "AdaptInit.puma"
  323.    if (! (((Obj->VarObject.Kind->VarLocal.dynamic != arr_fixed_size) || (array_kind == DYNAMIC_ARRAYS)))) goto yyL1;
  324.   {
  325. # line 200 "AdaptInit.puma"
  326.    NewAllocates = CombineACF (NewAllocates, mACF_LIST (MakeAllocate (t), NoTree));
  327. # line 203 "AdaptInit.puma"
  328.    NewDeAllocates = CombineACF (MakeDeallocate (t), NewDeAllocates);
  329. # line 205 "AdaptInit.puma"
  330.  if (Obj->VarObject.Kind->VarLocal.dynamic != 1)
  331.         tree_protocol ("automatic distributed array -> allocatable\n", t);
  332.        else
  333.         tree_protocol ("static distributed array -> allocatable\n", t);
  334.  
  335. # line 210 "AdaptInit.puma"
  336.    MakeTreeAllocatable (t->VAR_DECL.VAL);
  337.   }
  338.   }
  339.   }
  340.    return;
  341. yyL1:;
  342.  
  343.   }
  344. # line 219 "AdaptInit.puma"
  345.   {
  346. # line 222 "AdaptInit.puma"
  347.    if (! (Obj->VarObject.Kind->VarLocal.dynamic == 1)) goto yyL2;
  348.   {
  349. # line 223 "AdaptInit.puma"
  350.    if (! (array_kind == STATIC_ARRAYS)) goto yyL2;
  351.   {
  352. # line 225 "AdaptInit.puma"
  353.    NewAllocates = CombineACF (NewAllocates, mACF_LIST (MakeAllocate (t), NoTree));
  354. # line 228 "AdaptInit.puma"
  355.    NewDeAllocates = CombineACF (MakeDeallocate (t), NewDeAllocates);
  356. # line 230 "AdaptInit.puma"
  357.    tree_protocol ("automatic host/repl array -> allocatable\n", t);
  358. # line 232 "AdaptInit.puma"
  359.    MakeTreeAllocatable (t->VAR_DECL.VAL);
  360.   }
  361.   }
  362.   }
  363.    return;
  364. yyL2:;
  365.  
  366.   }
  367. # line 236 "AdaptInit.puma"
  368.    return;
  369.  
  370.   }
  371.   }
  372. ;
  373. }
  374.  
  375. static void MakeTreeAllocatable
  376. # if defined __STDC__ | defined __cplusplus
  377. (register tTree val)
  378. # else
  379. (val)
  380.  register tTree val;
  381. # endif
  382. {
  383.   if (val == NoTree) return;
  384.   if (val->Kind == kARRAY_TYPE) {
  385. # line 248 "AdaptInit.puma"
  386.   {
  387. # line 249 "AdaptInit.puma"
  388.    MakeTreeAllocatable (val->ARRAY_TYPE.ARRAY_INDEX_TYPES);
  389.   }
  390.    return;
  391.  
  392.   }
  393.   if (val->Kind == kTYPE_LIST) {
  394.   if (val->TYPE_LIST.Elem->Kind == kINDEX_TYPE) {
  395. # line 252 "AdaptInit.puma"
  396.  {
  397.   tTree new;
  398.   {
  399. # line 253 "AdaptInit.puma"
  400.  
  401. # line 254 "AdaptInit.puma"
  402.  new = mDYNAMIC ();
  403.  
  404.      new->DYNAMIC.left_overlap = val->TYPE_LIST.Elem->INDEX_TYPE.left_overlap;
  405.      new->DYNAMIC.right_overlap = val->TYPE_LIST.Elem->INDEX_TYPE.right_overlap;
  406.      val->TYPE_LIST.Elem = new;
  407.  
  408. # line 260 "AdaptInit.puma"
  409.    MakeTreeAllocatable (val->TYPE_LIST.Next);
  410.   }
  411.    return;
  412.  }
  413.  
  414.   }
  415.   }
  416.   if (val->Kind == kTYPE_EMPTY) {
  417. # line 263 "AdaptInit.puma"
  418.    return;
  419.  
  420.   }
  421. # line 266 "AdaptInit.puma"
  422.   {
  423. # line 267 "AdaptInit.puma"
  424.    printf ("Error in MakeTreeAllocatable: illegal array type\n");
  425. # line 268 "AdaptInit.puma"
  426.    FileUnparse (stdout, val);
  427. # line 269 "AdaptInit.puma"
  428.    WriteTree (stdout, val);
  429. # line 270 "AdaptInit.puma"
  430.    kill_in_protocol ();
  431.   }
  432.    return;
  433.  
  434. ;
  435. }
  436.  
  437. static tTree MakeAllocate
  438. # if defined __STDC__ | defined __cplusplus
  439. (register tTree t)
  440. # else
  441. (t)
  442.  register tTree t;
  443. # endif
  444. {
  445. # line 283 "AdaptInit.puma"
  446.  
  447. tTree param, v, h;
  448.  
  449.   if (t->Kind == kVAR_DECL) {
  450.   if (t->VAR_DECL.VAL->Kind == kARRAY_TYPE) {
  451. # line 287 "AdaptInit.puma"
  452.   {
  453. # line 288 "AdaptInit.puma"
  454.  param = MakeAllocate (t->VAR_DECL.VAL->ARRAY_TYPE.ARRAY_INDEX_TYPES);
  455.       v     = mVAR_OBJ (0, t->VAR_DECL.Name);
  456.       v->VAR_OBJ.Object = GetLocalDecl (t->VAR_DECL.Name);
  457.       param = mINDEXED_VAR (mUSED_VAR (v), param);
  458.       param = mBTP_LIST (mVAR_PARAM (param), mBTP_EMPTY());
  459.       h = mACF_BASIC (mALLOCATE_STMT (param, mDUMMY_VAR()));
  460.  
  461.   }
  462.    return h;
  463.  
  464.   }
  465.   }
  466.   if (t->Kind == kTYPE_LIST) {
  467. # line 298 "AdaptInit.puma"
  468.    return mBTE_LIST (MakeAllocate (t->TYPE_LIST.Elem), MakeAllocate (t->TYPE_LIST.Next));
  469.  
  470.   }
  471.   if (t->Kind == kTYPE_EMPTY) {
  472. # line 302 "AdaptInit.puma"
  473.    return mBTE_EMPTY ();
  474.  
  475.   }
  476.   if (t->Kind == kINDEX_TYPE) {
  477. # line 306 "AdaptInit.puma"
  478.    return (mSLICE_EXP (t->INDEX_TYPE.LOWER, t->INDEX_TYPE.UPPER, mDUMMY_EXP ()));
  479.  
  480.   }
  481. # line 310 "AdaptInit.puma"
  482.   {
  483. # line 311 "AdaptInit.puma"
  484.    printf ("Make Allocate failed\n");
  485. # line 312 "AdaptInit.puma"
  486.    FileUnparse (stdout, t);
  487. # line 313 "AdaptInit.puma"
  488.    WriteTree (stdout, t);
  489. # line 314 "AdaptInit.puma"
  490.    kill_in_protocol ();
  491.   }
  492.    return NoTree;
  493.  
  494. }
  495.  
  496. static tTree MakeDeallocate
  497. # if defined __STDC__ | defined __cplusplus
  498. (register tTree t)
  499. # else
  500. (t)
  501.  register tTree t;
  502. # endif
  503. {
  504. # line 328 "AdaptInit.puma"
  505.  
  506. tTree h, param;
  507.  
  508.   if (t->Kind == kVAR_DECL) {
  509.   if (t->VAR_DECL.VAL->Kind == kARRAY_TYPE) {
  510. # line 332 "AdaptInit.puma"
  511.   {
  512. # line 333 "AdaptInit.puma"
  513.  param = mVAR_OBJ (0, t->VAR_DECL.Name);
  514.       param->VAR_OBJ.Object = GetLocalDecl (t->VAR_DECL.Name);
  515.       param = mUSED_VAR (param);
  516.       param = mBTP_LIST (mVAR_PARAM (param), mBTP_EMPTY());
  517.       h = mACF_BASIC (mDEALLOCATE_STMT (param, mDUMMY_VAR()));
  518.  
  519.   }
  520.    return h;
  521.  
  522.   }
  523.   }
  524.  yyAbort ("MakeDeallocate");
  525. }
  526.  
  527. static tTree AdaptInitACF
  528. # if defined __STDC__ | defined __cplusplus
  529. (register tTree t)
  530. # else
  531. (t)
  532.  register tTree t;
  533. # endif
  534. {
  535. # line 350 "AdaptInit.puma"
  536.  
  537. int i;
  538. tTree newacf;
  539.  
  540.  
  541.   switch (t->Kind) {
  542.   case kBODY_NODE:
  543. # line 355 "AdaptInit.puma"
  544.   {
  545. # line 356 "AdaptInit.puma"
  546.  TempScalarsInitBody (t);
  547.      t->BODY_NODE.STATS = AdaptInitACF (t->BODY_NODE.STATS);
  548.      TempScalarsDoneBody (t);
  549.  
  550.   }
  551.    return t;
  552.  
  553.   case kACF_LIST:
  554. # line 363 "AdaptInit.puma"
  555.   {
  556. # line 364 "AdaptInit.puma"
  557.  set_protocol_stmt (t->ACF_LIST.Elem);
  558.        newacf = AdaptInitACF (t->ACF_LIST.Elem);
  559.        t->ACF_LIST.Next = AdaptInitACF (t->ACF_LIST.Next);
  560.        newacf = ReplaceACF (t, newacf, t->ACF_LIST.Next);
  561.  
  562.   }
  563.    return newacf;
  564.  
  565.   case kACF_BASIC:
  566.   if (t->ACF_BASIC.BASIC_STMT->Kind == kASSIGN_STMT) {
  567. # line 372 "AdaptInit.puma"
  568.    return AdaptInitAssign (t, TreeRank (t->ACF_BASIC.BASIC_STMT->ASSIGN_STMT.ASSIGN_VAR), TreeRank (t->ACF_BASIC.BASIC_STMT->ASSIGN_STMT.ASSIGN_EXP));
  569.  
  570.   }
  571.   if (t->ACF_BASIC.BASIC_STMT->Kind == kALLOCATE_STMT) {
  572. # line 384 "AdaptInit.puma"
  573.   {
  574. # line 385 "AdaptInit.puma"
  575.    SetAllocateShapes (t->ACF_BASIC.BASIC_STMT->ALLOCATE_STMT.PARAMS);
  576.   }
  577.    return t;
  578.  
  579.   }
  580.   if (t->ACF_BASIC.BASIC_STMT->Kind == kDEALLOCATE_STMT) {
  581. # line 389 "AdaptInit.puma"
  582.   {
  583. # line 390 "AdaptInit.puma"
  584.    ResetDeallocateShapes (t->ACF_BASIC.BASIC_STMT->DEALLOCATE_STMT.PARAMS);
  585.   }
  586.    return t;
  587.  
  588.   }
  589.   if (t->ACF_BASIC.BASIC_STMT->Kind == kIO_STMT) {
  590. # line 394 "AdaptInit.puma"
  591.   {
  592. # line 395 "AdaptInit.puma"
  593.  if (target_language == FORTRAN_77)
  594.         F77IO (t->ACF_BASIC.BASIC_STMT->IO_STMT.IO_ITEMS);
  595.  
  596.   }
  597.    return t;
  598.  
  599.   }
  600. # line 401 "AdaptInit.puma"
  601.    return t;
  602.  
  603.   case kACF_EMPTY:
  604. # line 406 "AdaptInit.puma"
  605.    return t;
  606.  
  607.   case kACF_DUMMY:
  608. # line 410 "AdaptInit.puma"
  609.    return t;
  610.  
  611.   case kACF_WHILE:
  612. # line 414 "AdaptInit.puma"
  613.   {
  614. # line 415 "AdaptInit.puma"
  615.  t->ACF_WHILE.WHILE_BODY = AdaptInitACF (t->ACF_WHILE.WHILE_BODY);
  616.   }
  617.    return t;
  618.  
  619.   case kACF_DO:
  620. # line 419 "AdaptInit.puma"
  621.   {
  622. # line 420 "AdaptInit.puma"
  623.  t->ACF_DO.DO_BODY = AdaptInitACF (t->ACF_DO.DO_BODY);
  624.   }
  625.    return t;
  626.  
  627.   case kACF_DOLOCAL:
  628. # line 424 "AdaptInit.puma"
  629.   {
  630. # line 425 "AdaptInit.puma"
  631.  t->ACF_DOLOCAL.DOLOCAL_BODY = AdaptInitACF (t->ACF_DOLOCAL.DOLOCAL_BODY);
  632.   }
  633.    return t;
  634.  
  635.   case kACF_FORALL:
  636. # line 429 "AdaptInit.puma"
  637.   {
  638. # line 430 "AdaptInit.puma"
  639.  forall_loops += 1;
  640.      t->ACF_FORALL.FORALL_BODY = AdaptInitACF (t->ACF_FORALL.FORALL_BODY);
  641.      forall_loops -= 1;
  642.  
  643.   }
  644.    return t;
  645.  
  646.   case kACF_IF:
  647. # line 438 "AdaptInit.puma"
  648.   {
  649. # line 439 "AdaptInit.puma"
  650.  t->ACF_IF.THEN_PART = AdaptInitACF (t->ACF_IF.THEN_PART);
  651.      t->ACF_IF.ELSE_PART = AdaptInitACF (t->ACF_IF.ELSE_PART);
  652.  
  653.   }
  654.    return t;
  655.  
  656.   case kACF_WHERE:
  657. # line 445 "AdaptInit.puma"
  658.   {
  659. # line 446 "AdaptInit.puma"
  660.  if (target_language == FORTRAN_77)
  661.         { stmt_protocol ("Make F77 from where statement");
  662.           newacf = F77Where (t);
  663.           tree_protocol ("new loop :\n", newacf);
  664.         }
  665.       else
  666.         newacf = t;
  667.  
  668.   }
  669.    return newacf;
  670.  
  671.   }
  672.  
  673. # line 457 "AdaptInit.puma"
  674.   {
  675. # line 458 "AdaptInit.puma"
  676.    printf ("AdaptInitACF failed\n");
  677. # line 459 "AdaptInit.puma"
  678.    WriteTree (stdout, t);
  679. # line 460 "AdaptInit.puma"
  680.    kill_in_protocol ();
  681.   }
  682.    return t;
  683.  
  684. }
  685.  
  686. static tTree AdaptInitAssign
  687. # if defined __STDC__ | defined __cplusplus
  688. (register tTree assign, register int rankvar, register int rankexp)
  689. # else
  690. (assign, rankvar, rankexp)
  691.  register tTree assign;
  692.  register int rankvar;
  693.  register int rankexp;
  694. # endif
  695. {
  696. # line 472 "AdaptInit.puma"
  697.  
  698. struct_shape shp;
  699. tTree new;
  700.  
  701.   if (assign->Kind == kACF_BASIC) {
  702.   if (assign->ACF_BASIC.BASIC_STMT->Kind == kASSIGN_STMT) {
  703. # line 484 "AdaptInit.puma"
  704.   {
  705. # line 486 "AdaptInit.puma"
  706.    if (! ((IsReduction (assign) == true))) goto yyL1;
  707.   {
  708. # line 487 "AdaptInit.puma"
  709.    if (! ((target_language == FORTRAN_77))) goto yyL1;
  710.   {
  711. # line 489 "AdaptInit.puma"
  712.  new = assign;
  713.      if (forall_loops > 0)
  714.        { stmt_protocol ("Make F77 from reduction in FORALL !!!");
  715.          new = F77Reduction (assign->ACF_BASIC.BASIC_STMT->ASSIGN_STMT.ASSIGN_VAR, assign->ACF_BASIC.BASIC_STMT->ASSIGN_STMT.ASSIGN_EXP);
  716.          tree_protocol ("new reduction loop in FORALL:\n", new);
  717.        }
  718.       else
  719.        { stmt_protocol ("Make F77 from reduction");
  720.          new = F77Reduction (assign->ACF_BASIC.BASIC_STMT->ASSIGN_STMT.ASSIGN_VAR, assign->ACF_BASIC.BASIC_STMT->ASSIGN_STMT.ASSIGN_EXP);
  721.          tree_protocol ("new reduction loop :\n", new);
  722.        }
  723.  
  724.   }
  725.   }
  726.   }
  727.    return new;
  728. yyL1:;
  729.  
  730. # line 513 "AdaptInit.puma"
  731.   {
  732. # line 515 "AdaptInit.puma"
  733.    if (! ((IsArrayOverlapped (assign->ACF_BASIC.BASIC_STMT->ASSIGN_STMT.ASSIGN_VAR) == true))) goto yyL2;
  734.   }
  735.    return assign;
  736. yyL2:;
  737.  
  738.   if (equalint (rankvar, 0)) {
  739.   if (equalint (rankexp, 0)) {
  740. # line 525 "AdaptInit.puma"
  741.    return assign;
  742.  
  743.   }
  744.   }
  745.   if (equalint (rankexp, 0)) {
  746. # line 535 "AdaptInit.puma"
  747.   {
  748. # line 536 "AdaptInit.puma"
  749.  new = assign;
  750.      if (CountMovements (assign->ACF_BASIC.BASIC_STMT->ASSIGN_STMT.ASSIGN_VAR, assign->ACF_BASIC.BASIC_STMT->ASSIGN_STMT.ASSIGN_EXP) == 0)
  751.        { if (target_language == FORTRAN_77)
  752.           {
  753.             stmt_protocol ("Make F77 from array = scalar");
  754.             new = F77Assign (assign);
  755.             tree_protocol ("new loops :\n", new);
  756.           }
  757.        }
  758.  
  759.   }
  760.    return new;
  761.  
  762.   }
  763. # line 555 "AdaptInit.puma"
  764.   {
  765. # line 556 "AdaptInit.puma"
  766.    if (! (rankvar == rankexp)) goto yyL5;
  767.   {
  768. # line 557 "AdaptInit.puma"
  769.  new = assign;
  770.      if (TranslateArrayOperation (assign->ACF_BASIC.BASIC_STMT->ASSIGN_STMT.ASSIGN_VAR, assign->ACF_BASIC.BASIC_STMT->ASSIGN_STMT.ASSIGN_EXP, CountMovements (assign->ACF_BASIC.BASIC_STMT->ASSIGN_STMT.ASSIGN_VAR, assign->ACF_BASIC.BASIC_STMT->
  771. ASSIGN_STMT.ASSIGN_EXP)) )
  772.        {
  773.          stmt_protocol ("Make F77 from array = array_exp");
  774.          new = F77Assign (assign);
  775.          tree_protocol ("new loops :\n", new);
  776.        }
  777.  
  778.   }
  779.   }
  780.    return new;
  781. yyL5:;
  782.  
  783.   }
  784.   }
  785. # line 568 "AdaptInit.puma"
  786.   {
  787. # line 569 "AdaptInit.puma"
  788.    if (! ((rankvar != rankexp))) goto yyL6;
  789.   {
  790. # line 571 "AdaptInit.puma"
  791.    printf ("AdaptInit: Illegal Call of InitAssign\n");
  792. # line 572 "AdaptInit.puma"
  793.    kill_in_protocol ();
  794.   }
  795.   }
  796.    return assign;
  797. yyL6:;
  798.  
  799.  yyAbort ("AdaptInitAssign");
  800. }
  801.  
  802. static bool TranslateArrayOperation
  803. # if defined __STDC__ | defined __cplusplus
  804. (register tTree var, register tTree exp, register int moves)
  805. # else
  806. (var, exp, moves)
  807.  register tTree var;
  808.  register tTree exp;
  809.  register int moves;
  810. # endif
  811. {
  812.   if (var == NoTree) return false;
  813.   if (exp == NoTree) return false;
  814. # line 578 "AdaptInit.puma"
  815.   {
  816. # line 579 "AdaptInit.puma"
  817.    if (! ((moves == 0))) goto yyL1;
  818.   {
  819. # line 580 "AdaptInit.puma"
  820.    if (! ((target_language == FORTRAN_77))) goto yyL1;
  821.   }
  822.   }
  823.    return true;
  824. yyL1:;
  825.  
  826.   if (exp->Kind == kVAR_EXP) {
  827. # line 583 "AdaptInit.puma"
  828.   {
  829. # line 585 "AdaptInit.puma"
  830.    if (! (TreeDistribution (var) != 1)) goto yyL2;
  831.   {
  832. # line 586 "AdaptInit.puma"
  833.    if (! (IsContiguousSection (var) == false)) goto yyL2;
  834.   }
  835.   }
  836.    return true;
  837. yyL2:;
  838.  
  839. # line 589 "AdaptInit.puma"
  840.   {
  841. # line 591 "AdaptInit.puma"
  842.    if (! (TreeDistribution (exp->VAR_EXP.V) != 1)) goto yyL3;
  843.   {
  844. # line 592 "AdaptInit.puma"
  845.    if (! (IsContiguousSection (exp->VAR_EXP.V) == false)) goto yyL3;
  846.   }
  847.   }
  848.    return true;
  849. yyL3:;
  850.  
  851.   }
  852.   return false;
  853. }
  854.  
  855. void BeginAdaptInit ()
  856. {
  857. }
  858.  
  859. void CloseAdaptInit ()
  860. {
  861. }
  862.