home *** CD-ROM | disk | FTP | other *** search
/ OS/2 Professional / OS2PRO194.ISO / os2 / prgramer / adaptor / src / adaptser.c < prev    next >
Encoding:
C/C++ Source or Header  |  1994-01-03  |  12.6 KB  |  572 lines
  1. # include "Serial.h"
  2. # include "yyASeria.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 26 "AdaptSerial.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"  /* temporary scalar for array assignment */
  47.  
  48. # include "F77.h"     /* F77Assign       */
  49. # include "Forall.h"  /* TransformFORALL */
  50. # include "DoLocal.h"  /* TransformDoLocal */
  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 AdaptSerial, routine %s failed\n", yyFunction);
  64.  exit (1);
  65. }
  66.  
  67. void AdaptSerial ARGS((tTree t));
  68. static tTree AdaptACFForall ARGS((tTree t));
  69. static tTree AdaptACFDoLocal ARGS((tTree t));
  70. static tTree CheckArrayAssignment ARGS((tTree assign, int vardist, int expdist));
  71.  
  72. void AdaptSerial
  73. # if defined __STDC__ | defined __cplusplus
  74. (register tTree t)
  75. # else
  76. (t)
  77.  register tTree t;
  78. # endif
  79. {
  80. # line 53 "AdaptSerial.puma"
  81.  
  82. tObject Obj;
  83.  
  84.   if (t == NoTree) return;
  85.   if (t->Kind == kCOMP_UNIT) {
  86. # line 57 "AdaptSerial.puma"
  87.   {
  88. # line 58 "AdaptSerial.puma"
  89.    open_protocol ("adaptor.seq");
  90. # line 59 "AdaptSerial.puma"
  91.    AdaptSerial (t->COMP_UNIT.COMP_ELEMENTS);
  92. # line 60 "AdaptSerial.puma"
  93.    close_protocol ();
  94.   }
  95.    return;
  96.  
  97.   }
  98.   if (t->Kind == kDECL_EMPTY) {
  99. # line 63 "AdaptSerial.puma"
  100.    return;
  101.  
  102.   }
  103.   if (t->Kind == kDECL_LIST) {
  104.   if (t->DECL_LIST.Elem->Kind == kPROGRAM_DECL) {
  105. # line 66 "AdaptSerial.puma"
  106.  {
  107.   tDefinitions Obj;
  108.   {
  109. # line 67 "AdaptSerial.puma"
  110.  
  111. # line 68 "AdaptSerial.puma"
  112.    set_protocol_unit (t->DECL_LIST.Elem);
  113. # line 69 "AdaptSerial.puma"
  114.    Obj = GetDeclEntry (t->DECL_LIST.Elem->PROGRAM_DECL.Name, GetUnitEntries ());
  115. # line 70 "AdaptSerial.puma"
  116.    OpenScope (Obj->ProcObject.Declarations);
  117. # line 71 "AdaptSerial.puma"
  118.    AdaptSerial (t->DECL_LIST.Elem->PROGRAM_DECL.PROGRAM_BODY);
  119. # line 72 "AdaptSerial.puma"
  120.    CloseScope ();
  121. # line 73 "AdaptSerial.puma"
  122.    AdaptSerial (t->DECL_LIST.Next);
  123.   }
  124.    return;
  125.  }
  126.  
  127.   }
  128.   if (t->DECL_LIST.Elem->Kind == kPROC_DECL) {
  129. # line 76 "AdaptSerial.puma"
  130.  {
  131.   tDefinitions Obj;
  132.   {
  133. # line 77 "AdaptSerial.puma"
  134.  
  135. # line 78 "AdaptSerial.puma"
  136.    set_protocol_unit (t->DECL_LIST.Elem);
  137. # line 79 "AdaptSerial.puma"
  138.    Obj = GetDeclEntry (t->DECL_LIST.Elem->PROC_DECL.Name, GetUnitEntries ());
  139. # line 80 "AdaptSerial.puma"
  140.    OpenScope (Obj->ProcObject.Declarations);
  141. # line 81 "AdaptSerial.puma"
  142.    AdaptSerial (t->DECL_LIST.Elem->PROC_DECL.PROC_BODY);
  143. # line 82 "AdaptSerial.puma"
  144.    CloseScope ();
  145. # line 83 "AdaptSerial.puma"
  146.    AdaptSerial (t->DECL_LIST.Next);
  147.   }
  148.    return;
  149.  }
  150.  
  151.   }
  152.   if (t->DECL_LIST.Elem->Kind == kFUNC_DECL) {
  153. # line 86 "AdaptSerial.puma"
  154.  {
  155.   tDefinitions Obj;
  156.   {
  157. # line 87 "AdaptSerial.puma"
  158.  
  159. # line 88 "AdaptSerial.puma"
  160.    set_protocol_unit (t->DECL_LIST.Elem);
  161. # line 89 "AdaptSerial.puma"
  162.    Obj = GetDeclEntry (t->DECL_LIST.Elem->FUNC_DECL.Name, GetUnitEntries ());
  163. # line 90 "AdaptSerial.puma"
  164.    OpenScope (Obj->FuncObject.Declarations);
  165. # line 91 "AdaptSerial.puma"
  166.    AdaptSerial (t->DECL_LIST.Elem->FUNC_DECL.FUNC_BODY);
  167. # line 92 "AdaptSerial.puma"
  168.    CloseScope ();
  169. # line 93 "AdaptSerial.puma"
  170.    AdaptSerial (t->DECL_LIST.Next);
  171.   }
  172.    return;
  173.  }
  174.  
  175.   }
  176.   if (t->DECL_LIST.Elem->Kind == kBLOCK_DATA_DECL) {
  177. # line 96 "AdaptSerial.puma"
  178.  {
  179.   tDefinitions Obj;
  180.   {
  181. # line 97 "AdaptSerial.puma"
  182.  
  183. # line 98 "AdaptSerial.puma"
  184.    set_protocol_unit (t->DECL_LIST.Elem);
  185. # line 99 "AdaptSerial.puma"
  186.    Obj = GetDeclEntry (t->DECL_LIST.Elem->BLOCK_DATA_DECL.Name, GetUnitEntries ());
  187. # line 100 "AdaptSerial.puma"
  188.    OpenScope (Obj->BlockObject.Declarations);
  189. # line 101 "AdaptSerial.puma"
  190.    AdaptSerial (t->DECL_LIST.Elem->BLOCK_DATA_DECL.DATA_BODY);
  191. # line 102 "AdaptSerial.puma"
  192.    CloseScope ();
  193. # line 103 "AdaptSerial.puma"
  194.    AdaptSerial (t->DECL_LIST.Next);
  195.   }
  196.    return;
  197.  }
  198.  
  199.   }
  200.   }
  201.   if (t->Kind == kBODY_NODE) {
  202. # line 106 "AdaptSerial.puma"
  203.   {
  204. # line 107 "AdaptSerial.puma"
  205.    if (! (AdaptACFForall (t))) goto yyL7;
  206.   {
  207. # line 108 "AdaptSerial.puma"
  208.    TempScalarsInitBody (t);
  209. # line 109 "AdaptSerial.puma"
  210.    if (! (AdaptACFDoLocal (t))) goto yyL7;
  211.   {
  212. # line 110 "AdaptSerial.puma"
  213.    TempScalarsDoneBody (t);
  214.   }
  215.   }
  216.   }
  217.    return;
  218. yyL7:;
  219.  
  220.   }
  221. ;
  222. }
  223.  
  224. static tTree AdaptACFForall
  225. # if defined __STDC__ | defined __cplusplus
  226. (register tTree t)
  227. # else
  228. (t)
  229.  register tTree t;
  230. # endif
  231. {
  232. # line 129 "AdaptSerial.puma"
  233.  
  234. int i;
  235. tTree newacf;
  236.  
  237.  
  238.   switch (t->Kind) {
  239.   case kBODY_NODE:
  240. # line 134 "AdaptSerial.puma"
  241.   {
  242. # line 135 "AdaptSerial.puma"
  243.  t->BODY_NODE.STATS = AdaptACFForall (t->BODY_NODE.STATS);
  244.   }
  245.    return t;
  246.  
  247.   case kACF_LIST:
  248. # line 139 "AdaptSerial.puma"
  249.   {
  250. # line 140 "AdaptSerial.puma"
  251.  set_protocol_stmt (t->ACF_LIST.Elem);
  252.      newacf = AdaptACFForall (t->ACF_LIST.Elem);
  253.      t->ACF_LIST.Next = AdaptACFForall (t->ACF_LIST.Next);
  254.      newacf = ReplaceACF (t, newacf, t->ACF_LIST.Next);
  255.  
  256.   }
  257.    return newacf;
  258.  
  259.   case kACF_BASIC:
  260.   if (t->ACF_BASIC.BASIC_STMT->Kind == kASSIGN_STMT) {
  261. # line 148 "AdaptSerial.puma"
  262.    return t;
  263.  
  264.   }
  265.   if (t->ACF_BASIC.BASIC_STMT->Kind == kCALL_STMT) {
  266. # line 152 "AdaptSerial.puma"
  267.    return t;
  268.  
  269.   }
  270.   if (t->ACF_BASIC.BASIC_STMT->Kind == kALLOCATE_STMT) {
  271. # line 156 "AdaptSerial.puma"
  272.   {
  273. # line 157 "AdaptSerial.puma"
  274.    SetAllocateShapes (t->ACF_BASIC.BASIC_STMT->ALLOCATE_STMT.PARAMS);
  275.   }
  276.    return t;
  277.  
  278.   }
  279.   if (t->ACF_BASIC.BASIC_STMT->Kind == kDEALLOCATE_STMT) {
  280. # line 161 "AdaptSerial.puma"
  281.   {
  282. # line 162 "AdaptSerial.puma"
  283.    ResetDeallocateShapes (t->ACF_BASIC.BASIC_STMT->DEALLOCATE_STMT.PARAMS);
  284.   }
  285.    return t;
  286.  
  287.   }
  288.   if (t->ACF_BASIC.BASIC_STMT->Kind == kIO_STMT) {
  289. # line 166 "AdaptSerial.puma"
  290.    return t;
  291.  
  292.   }
  293. # line 170 "AdaptSerial.puma"
  294.    return t;
  295.  
  296.   case kACF_EMPTY:
  297. # line 175 "AdaptSerial.puma"
  298.    return t;
  299.  
  300.   case kACF_DUMMY:
  301. # line 179 "AdaptSerial.puma"
  302.    return t;
  303.  
  304.   case kACF_WHILE:
  305. # line 183 "AdaptSerial.puma"
  306.   {
  307. # line 184 "AdaptSerial.puma"
  308.  t->ACF_WHILE.WHILE_BODY = AdaptACFForall (t->ACF_WHILE.WHILE_BODY);
  309.   }
  310.    return t;
  311.  
  312.   case kACF_DO:
  313. # line 188 "AdaptSerial.puma"
  314.   {
  315. # line 189 "AdaptSerial.puma"
  316.  t->ACF_DO.DO_BODY = AdaptACFForall (t->ACF_DO.DO_BODY);
  317.   }
  318.    return t;
  319.  
  320.   case kACF_DOLOCAL:
  321. # line 193 "AdaptSerial.puma"
  322.   {
  323. # line 195 "AdaptSerial.puma"
  324.  t->ACF_DOLOCAL.DOLOCAL_BODY = AdaptACFForall (t->ACF_DOLOCAL.DOLOCAL_BODY);
  325.   }
  326.    return t;
  327.  
  328.   case kACF_FORALL:
  329. # line 199 "AdaptSerial.puma"
  330.    return TransformFORALL (t);
  331.  
  332.   case kACF_IF:
  333. # line 206 "AdaptSerial.puma"
  334.   {
  335. # line 207 "AdaptSerial.puma"
  336.  t->ACF_IF.THEN_PART = AdaptACFForall (t->ACF_IF.THEN_PART);
  337.      t->ACF_IF.ELSE_PART = AdaptACFForall (t->ACF_IF.ELSE_PART);
  338.  
  339.   }
  340.    return t;
  341.  
  342.   case kACF_WHERE:
  343. # line 213 "AdaptSerial.puma"
  344.    return t;
  345.  
  346.   }
  347.  
  348. # line 217 "AdaptSerial.puma"
  349.   {
  350. # line 218 "AdaptSerial.puma"
  351.    printf ("AdaptACFForall failed\n");
  352. # line 219 "AdaptSerial.puma"
  353.    WriteTree (stdout, t);
  354. # line 220 "AdaptSerial.puma"
  355.    kill_in_protocol ();
  356.   }
  357.    return t;
  358.  
  359. }
  360.  
  361. static tTree AdaptACFDoLocal
  362. # if defined __STDC__ | defined __cplusplus
  363. (register tTree t)
  364. # else
  365. (t)
  366.  register tTree t;
  367. # endif
  368. {
  369. # line 239 "AdaptSerial.puma"
  370.  
  371. int i;
  372. tTree newacf;
  373.  
  374.  
  375.   switch (t->Kind) {
  376.   case kBODY_NODE:
  377. # line 244 "AdaptSerial.puma"
  378.   {
  379. # line 245 "AdaptSerial.puma"
  380.  t->BODY_NODE.STATS = AdaptACFDoLocal (t->BODY_NODE.STATS);
  381.   }
  382.    return t;
  383.  
  384.   case kACF_LIST:
  385. # line 249 "AdaptSerial.puma"
  386.   {
  387. # line 250 "AdaptSerial.puma"
  388.  set_protocol_stmt (t->ACF_LIST.Elem);
  389.     newacf = AdaptACFDoLocal (t->ACF_LIST.Elem);
  390.     t->ACF_LIST.Next = AdaptACFDoLocal (t->ACF_LIST.Next);
  391.     newacf = ReplaceACF (t, newacf, t->ACF_LIST.Next);
  392.  
  393.   }
  394.    return newacf;
  395.  
  396.   case kACF_BASIC:
  397.   if (t->ACF_BASIC.BASIC_STMT->Kind == kCALL_STMT) {
  398. # line 258 "AdaptSerial.puma"
  399.    return t;
  400.  
  401.   }
  402.   if (t->ACF_BASIC.BASIC_STMT->Kind == kALLOCATE_STMT) {
  403. # line 270 "AdaptSerial.puma"
  404.   {
  405. # line 271 "AdaptSerial.puma"
  406.    SetAllocateShapes (t->ACF_BASIC.BASIC_STMT->ALLOCATE_STMT.PARAMS);
  407.   }
  408.    return t;
  409.  
  410.   }
  411.   if (t->ACF_BASIC.BASIC_STMT->Kind == kDEALLOCATE_STMT) {
  412. # line 275 "AdaptSerial.puma"
  413.   {
  414. # line 276 "AdaptSerial.puma"
  415.    ResetDeallocateShapes (t->ACF_BASIC.BASIC_STMT->DEALLOCATE_STMT.PARAMS);
  416.   }
  417.    return t;
  418.  
  419.   }
  420.   if (t->ACF_BASIC.BASIC_STMT->Kind == kIO_STMT) {
  421. # line 280 "AdaptSerial.puma"
  422.    return t;
  423.  
  424.   }
  425.   if (t->ACF_BASIC.BASIC_STMT->Kind == kASSIGN_STMT) {
  426. # line 284 "AdaptSerial.puma"
  427.   {
  428. # line 288 "AdaptSerial.puma"
  429.    if (! ((TreeRank (t->ACF_BASIC.BASIC_STMT->ASSIGN_STMT.ASSIGN_VAR) > 0))) goto yyL7;
  430.   {
  431. # line 289 "AdaptSerial.puma"
  432.    if (! ((TreeRank (t->ACF_BASIC.BASIC_STMT->ASSIGN_STMT.ASSIGN_EXP) == 0))) goto yyL7;
  433.   {
  434. # line 290 "AdaptSerial.puma"
  435.    if (! ((CountMovements (t->ACF_BASIC.BASIC_STMT->ASSIGN_STMT.ASSIGN_VAR, t->ACF_BASIC.BASIC_STMT->ASSIGN_STMT.ASSIGN_EXP) > 0))) goto yyL7;
  436.   }
  437.   }
  438.   }
  439.    return CheckArrayAssignment (t, TreeDistribution (t->ACF_BASIC.BASIC_STMT->ASSIGN_STMT.ASSIGN_VAR), TreeDistribution (t->ACF_BASIC.BASIC_STMT->ASSIGN_STMT.ASSIGN_EXP));
  440. yyL7:;
  441.  
  442.   }
  443. # line 296 "AdaptSerial.puma"
  444.    return t;
  445.  
  446.   case kACF_EMPTY:
  447. # line 301 "AdaptSerial.puma"
  448.    return t;
  449.  
  450.   case kACF_DUMMY:
  451. # line 305 "AdaptSerial.puma"
  452.    return t;
  453.  
  454.   case kACF_WHILE:
  455. # line 309 "AdaptSerial.puma"
  456.   {
  457. # line 310 "AdaptSerial.puma"
  458.  t->ACF_WHILE.WHILE_BODY = AdaptACFDoLocal (t->ACF_WHILE.WHILE_BODY);
  459.   }
  460.    return t;
  461.  
  462.   case kACF_DO:
  463. # line 314 "AdaptSerial.puma"
  464.   {
  465. # line 315 "AdaptSerial.puma"
  466.  t->ACF_DO.DO_BODY = AdaptACFDoLocal (t->ACF_DO.DO_BODY);
  467.   }
  468.    return t;
  469.  
  470.   case kACF_DOLOCAL:
  471. # line 319 "AdaptSerial.puma"
  472.    return TransformDoLocal (t);
  473.  
  474.   case kACF_IF:
  475. # line 324 "AdaptSerial.puma"
  476.   {
  477. # line 325 "AdaptSerial.puma"
  478.  t->ACF_IF.THEN_PART = AdaptACFDoLocal (t->ACF_IF.THEN_PART);
  479.      t->ACF_IF.ELSE_PART = AdaptACFDoLocal (t->ACF_IF.ELSE_PART);
  480.  
  481.   }
  482.    return t;
  483.  
  484.   case kACF_WHERE:
  485. # line 331 "AdaptSerial.puma"
  486.    return t;
  487.  
  488.   }
  489.  
  490. # line 335 "AdaptSerial.puma"
  491.   {
  492. # line 336 "AdaptSerial.puma"
  493.    printf ("AdaptACFDoLocal failed\n");
  494. # line 337 "AdaptSerial.puma"
  495.    WriteTree (stdout, t);
  496. # line 338 "AdaptSerial.puma"
  497.    kill_in_protocol ();
  498.   }
  499.    return t;
  500.  
  501. }
  502.  
  503. static tTree CheckArrayAssignment
  504. # if defined __STDC__ | defined __cplusplus
  505. (register tTree assign, register int vardist, register int expdist)
  506. # else
  507. (assign, vardist, expdist)
  508.  register tTree assign;
  509.  register int vardist;
  510.  register int expdist;
  511. # endif
  512. {
  513.   if (assign->Kind == kACF_BASIC) {
  514.   if (assign->ACF_BASIC.BASIC_STMT->Kind == kASSIGN_STMT) {
  515. # line 353 "AdaptSerial.puma"
  516.  {
  517.   tTree new;
  518.   {
  519. # line 355 "AdaptSerial.puma"
  520.    if (! ((expdist != 0))) goto yyL1;
  521.   {
  522. # line 357 "AdaptSerial.puma"
  523.  
  524. # line 359 "AdaptSerial.puma"
  525.  
  526.  
  527.      assign->ACF_BASIC.BASIC_STMT->ASSIGN_STMT.ASSIGN_EXP = ExtractScalarMovements (assign->ACF_BASIC.BASIC_STMT->ASSIGN_STMT.ASSIGN_EXP, &new);
  528.  
  529.  
  530.  
  531.      if (new != NoTree)
  532.        {  tTree new_assign;
  533.  
  534.  
  535.  
  536.           if (target_language == FORTRAN_77)
  537.              { new_assign = F77Assign (assign);
  538.                new_assign = TransformFORALL (new_assign);
  539.                new_assign = TransformDoLocal (new_assign);
  540.              }
  541.             else
  542.              new_assign = assign;
  543.           new = CombineACF (new, mACF_LIST (new_assign, NoTree));
  544.           stmt_protocol ("array = scalar (distributed) resolved");
  545.           tree_protocol ("new statements are : \n", new);
  546.        }
  547.       else
  548.        new = assign;
  549.  
  550.   }
  551.   }
  552.   {
  553.    return new;
  554.   }
  555.  }
  556. yyL1:;
  557.  
  558.   }
  559.   }
  560. # line 387 "AdaptSerial.puma"
  561.    return assign;
  562.  
  563. }
  564.  
  565. void BeginAdaptSerial ()
  566. {
  567. }
  568.  
  569. void CloseAdaptSerial ()
  570. {
  571. }
  572.