home *** CD-ROM | disk | FTP | other *** search
/ OS/2 Professional / OS2PRO194.ISO / os2 / prgramer / adaptor / src / wtransfo.c < prev    next >
Encoding:
C/C++ Source or Header  |  1994-01-03  |  38.7 KB  |  1,639 lines
  1. # include "Transfor.h"
  2. # include "yyATrans.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 32 "AdaptTransform.puma"
  36.  
  37. # include <stdio.h>
  38. # include "Idents.h"
  39. # include "StringMe.h"
  40. # include "Types.h"
  41.  
  42. # include "protocol.h"
  43.  
  44. # include "Transfor.h"       /* IsHost, Replace*, Make* */
  45. # include "Dalib.h"           /* MakeDalibId, ... */
  46.  
  47. # include "Shapes.h"          /* SetAllocateShapes, ResetDeallocateShapes */
  48. # include "Local.h"      /* local operations on distributed arrays */
  49. # include "Vars.h"       /* all exported functions */
  50. # include "Scalar.h"
  51. # include "Movement.h"
  52. # include "On.h"         /* AdaptOn */
  53. # include "CM.h"
  54. # include "Broadcas.h"  /* MakeParamBroadcast */
  55.  
  56. # include "MakeStaA.h"   /* MakeStatic */
  57.  
  58. extern void exit ();
  59.  
  60. bool IsMainUnit;              /* true in a PROGRAM_DECL, needed to decide
  61.                                  for (de)allocate of common variables     */
  62.  
  63. tIdent unitname;        /* global used for translation in the current unit */
  64.  
  65. tIdent NewUnitName (id)
  66. tIdent id;
  67. { char string[250];
  68.   GetString (id,string);
  69.   if (IsHost)
  70.      strcat (string, "_H");
  71.     else
  72.      strcat (string, "_N");
  73.   return (MakeIdent (string, strlen (string)));
  74. }
  75.  
  76. tTree MakeDalibPid ()
  77. { tTree h1, h2;
  78.   tIdent id;
  79.   id = MakeDalibId ("pid");
  80.   h1 = mVAR_DECL (id, 0, mINTEGER_TYPE (4));
  81.   h2 = mEXT_PROC_DECL (id, 0, mDECL_EMPTY());
  82.   return mDECL_LIST (h1, mDECL_LIST (h2, mDECL_EMPTY ()));
  83. }
  84.  
  85. tTree MakeDalibHaveI ()
  86. { tTree h1, h2;
  87.   tIdent id;
  88.   id = MakeDalibId ("have_i");
  89.   h1 = mVAR_DECL (id, 0, mBOOLEAN_TYPE (4));
  90.   h2 = mEXT_PROC_DECL (id, 0, mDECL_EMPTY());
  91.   return mDECL_LIST (h1, mDECL_LIST (h2, mDECL_EMPTY ()));
  92. }
  93.  
  94.  
  95.  
  96. static FILE * yyf = stdout;
  97.  
  98. static void yyAbort
  99. # ifdef __cplusplus
  100.  (char * yyFunction)
  101. # else
  102.  (yyFunction) char * yyFunction;
  103. # endif
  104. {
  105.  (void) fprintf (stderr, "Error: module AdaptTransform, routine %s failed\n", yyFunction);
  106.  exit (1);
  107. }
  108.  
  109. void HostAdapt ARGS((tTree t));
  110. void NodeAdapt ARGS((tTree t));
  111. static tTree UnitsAdapt ARGS((tTree t));
  112. static tTree TransformDECL ARGS((tTree t));
  113. static tTree TransformCommonDECL ARGS((tTree t));
  114. static tTree TransformACF ARGS((tTree t));
  115. static tTree TransformActuals ARGS((tTree t));
  116. static tTree AdaptAssign ARGS((tTree assign, int rankvar, int rankexp));
  117. static tTree AdaptArrayAssign ARGS((tTree assign, int vardistribution, int expdistribution));
  118. static void UpdateLocal ARGS((tTree t));
  119. static void UpdateFuncCall ARGS((tTree e));
  120. static void RemoveOverlaps ARGS((tTree t));
  121.  
  122. void HostAdapt
  123. # if defined __STDC__ | defined __cplusplus
  124. (register tTree t)
  125. # else
  126. (t)
  127.  register tTree t;
  128. # endif
  129. {
  130.   if (t == NoTree) return;
  131.   if (t->Kind == kCOMP_UNIT) {
  132. # line 94 "AdaptTransform.puma"
  133.   {
  134. # line 95 "AdaptTransform.puma"
  135.    IsHost = 1;
  136. # line 96 "AdaptTransform.puma"
  137.    open_protocol ("adaptor.tra");
  138. # line 97 "AdaptTransform.puma"
  139.  t->COMP_UNIT.COMP_ELEMENTS = UnitsAdapt (t->COMP_UNIT.COMP_ELEMENTS);
  140. # line 98 "AdaptTransform.puma"
  141.    close_protocol ();
  142.   }
  143.    return;
  144.  
  145.   }
  146. ;
  147. }
  148.  
  149. void NodeAdapt
  150. # if defined __STDC__ | defined __cplusplus
  151. (register tTree t)
  152. # else
  153. (t)
  154.  register tTree t;
  155. # endif
  156. {
  157.   if (t == NoTree) return;
  158.   if (t->Kind == kCOMP_UNIT) {
  159. # line 103 "AdaptTransform.puma"
  160.   {
  161. # line 104 "AdaptTransform.puma"
  162.    IsHost = 0;
  163. # line 105 "AdaptTransform.puma"
  164.    open_protocol ("adaptor.tra");
  165. # line 106 "AdaptTransform.puma"
  166.  t->COMP_UNIT.COMP_ELEMENTS = UnitsAdapt (t->COMP_UNIT.COMP_ELEMENTS);
  167. # line 107 "AdaptTransform.puma"
  168.    close_protocol ();
  169. # line 108 "AdaptTransform.puma"
  170.    gen_makefile ();
  171.   }
  172.    return;
  173.  
  174.   }
  175. ;
  176. }
  177.  
  178. static tTree UnitsAdapt
  179. # if defined __STDC__ | defined __cplusplus
  180. (register tTree t)
  181. # else
  182. (t)
  183.  register tTree t;
  184. # endif
  185. {
  186. # line 119 "AdaptTransform.puma"
  187.  
  188. char string[256];
  189. tIdent  pid;
  190.  
  191.  
  192.   switch (t->Kind) {
  193.   case kDECL_LIST:
  194. # line 126 "AdaptTransform.puma"
  195.  {
  196.   tTree new_decl;
  197.   {
  198. # line 128 "AdaptTransform.puma"
  199.  
  200. # line 130 "AdaptTransform.puma"
  201.  new_decl = UnitsAdapt (t->DECL_LIST.Elem);
  202.        t->DECL_LIST.Next     = UnitsAdapt (t->DECL_LIST.Next);
  203.        new_decl = ReplaceDECL (t, new_decl, t->DECL_LIST.Next);
  204.  
  205.   }
  206.   {
  207.    return new_decl;
  208.   }
  209.  }
  210.  
  211.   case kDECL_EMPTY:
  212. # line 137 "AdaptTransform.puma"
  213.    return t;
  214.  
  215.   case kPROGRAM_DECL:
  216. # line 141 "AdaptTransform.puma"
  217.  {
  218.   tDefinitions Obj;
  219.   {
  220. # line 142 "AdaptTransform.puma"
  221.    set_protocol_unit (t);
  222. # line 143 "AdaptTransform.puma"
  223.  
  224. # line 144 "AdaptTransform.puma"
  225.    Obj = GetDeclEntry (t->PROGRAM_DECL.Name, GetUnitEntries ());
  226. # line 145 "AdaptTransform.puma"
  227.    OpenScope (Obj->ProcObject.Declarations);
  228. # line 146 "AdaptTransform.puma"
  229.  if (IsHost)
  230.            pid = MakeIdent ("HOSTMODULE",10);
  231.          else
  232.            pid = MakeIdent ("NODEMODULE",10);
  233.        unitname = pid;
  234.        t = mPROC_DECL (pid, t->PROGRAM_DECL.Pos, t->PROGRAM_DECL.FORMALS, t->PROGRAM_DECL.PROGRAM_BODY);
  235.  
  236. # line 153 "AdaptTransform.puma"
  237.    IsMainUnit = true;
  238. # line 154 "AdaptTransform.puma"
  239.    IsPure = false;
  240. # line 155 "AdaptTransform.puma"
  241.  t->PROGRAM_DECL.PROGRAM_BODY = UnitsAdapt (t->PROGRAM_DECL.PROGRAM_BODY);
  242. # line 156 "AdaptTransform.puma"
  243.    CloseScope ();
  244.   }
  245.   {
  246.    return t;
  247.   }
  248.  }
  249.  
  250.   case kPROC_DECL:
  251. # line 160 "AdaptTransform.puma"
  252.   {
  253. # line 161 "AdaptTransform.puma"
  254.    if (! ((IsHost && t->PROC_DECL.IsPure))) goto yyL4;
  255.   {
  256. # line 162 "AdaptTransform.puma"
  257.    set_protocol_unit (t);
  258. # line 163 "AdaptTransform.puma"
  259.    print_protocol ("Pure Subroutine is removed in host.f");
  260.   }
  261.   }
  262.    return NoTree;
  263. yyL4:;
  264.  
  265. # line 167 "AdaptTransform.puma"
  266.  {
  267.   tDefinitions Obj;
  268.   {
  269. # line 168 "AdaptTransform.puma"
  270.    set_protocol_unit (t);
  271. # line 169 "AdaptTransform.puma"
  272.  
  273. # line 170 "AdaptTransform.puma"
  274.    Obj = GetDeclEntry (t->PROC_DECL.Name, GetUnitEntries ());
  275. # line 171 "AdaptTransform.puma"
  276.    OpenScope (Obj->ProcObject.Declarations);
  277. # line 172 "AdaptTransform.puma"
  278.  t->PROC_DECL.FORMALS = TransformDECL (t->PROC_DECL.FORMALS);
  279. # line 173 "AdaptTransform.puma"
  280.    t->PROC_DECL.Name = NewUnitName (t->PROC_DECL.Name);
  281. # line 175 "AdaptTransform.puma"
  282.    unitname = t->PROC_DECL.Name;
  283. # line 176 "AdaptTransform.puma"
  284.    IsMainUnit = false;
  285. # line 177 "AdaptTransform.puma"
  286.    IsPure = t->PROC_DECL.IsPure;
  287. # line 178 "AdaptTransform.puma"
  288.  t->PROC_DECL.PROC_BODY = UnitsAdapt (t->PROC_DECL.PROC_BODY);
  289. # line 179 "AdaptTransform.puma"
  290.    CloseScope ();
  291. # line 180 "AdaptTransform.puma"
  292.  t->PROC_DECL.IsPure = false;
  293.   }
  294.   {
  295.    return t;
  296.   }
  297.  }
  298.  
  299.   case kFUNC_DECL:
  300. # line 184 "AdaptTransform.puma"
  301.   {
  302. # line 185 "AdaptTransform.puma"
  303.    if (! ((IsHost && t->FUNC_DECL.IsPure))) goto yyL6;
  304.   {
  305. # line 186 "AdaptTransform.puma"
  306.    set_protocol_unit (t);
  307. # line 187 "AdaptTransform.puma"
  308.    print_protocol ("Pure Function is removed in host.f");
  309.   }
  310.   }
  311.    return NoTree;
  312. yyL6:;
  313.  
  314. # line 191 "AdaptTransform.puma"
  315.  {
  316.   tDefinitions Obj;
  317.   {
  318. # line 192 "AdaptTransform.puma"
  319.    set_protocol_unit (t);
  320. # line 193 "AdaptTransform.puma"
  321.  
  322. # line 194 "AdaptTransform.puma"
  323.    Obj = GetDeclEntry (t->FUNC_DECL.Name, GetUnitEntries ());
  324. # line 195 "AdaptTransform.puma"
  325.    OpenScope (Obj->FuncObject.Declarations);
  326. # line 196 "AdaptTransform.puma"
  327.  t->FUNC_DECL.FORMALS = TransformDECL (t->FUNC_DECL.FORMALS);
  328. # line 197 "AdaptTransform.puma"
  329.    t->FUNC_DECL.Name = NewUnitName (t->FUNC_DECL.Name);
  330. # line 198 "AdaptTransform.puma"
  331.    unitname = t->FUNC_DECL.Name;
  332. # line 199 "AdaptTransform.puma"
  333.    IsMainUnit = false;
  334. # line 200 "AdaptTransform.puma"
  335.    IsPure = t->FUNC_DECL.IsPure;
  336. # line 201 "AdaptTransform.puma"
  337.  t->FUNC_DECL.FUNC_BODY = UnitsAdapt (t->FUNC_DECL.FUNC_BODY);
  338. # line 202 "AdaptTransform.puma"
  339.    CloseScope ();
  340. # line 203 "AdaptTransform.puma"
  341.  t->FUNC_DECL.IsPure = false;
  342.   }
  343.   {
  344.    return t;
  345.   }
  346.  }
  347.  
  348.   case kBLOCK_DATA_DECL:
  349. # line 207 "AdaptTransform.puma"
  350.  {
  351.   tDefinitions Obj;
  352.   {
  353. # line 208 "AdaptTransform.puma"
  354.    set_protocol_unit (t);
  355. # line 209 "AdaptTransform.puma"
  356.  
  357. # line 210 "AdaptTransform.puma"
  358.    GetString (t->BLOCK_DATA_DECL.Name, string);
  359. # line 211 "AdaptTransform.puma"
  360.    Obj = GetDeclEntry (t->BLOCK_DATA_DECL.Name, GetUnitEntries ());
  361. # line 212 "AdaptTransform.puma"
  362.    OpenScope (Obj->BlockObject.Declarations);
  363. # line 213 "AdaptTransform.puma"
  364.    t->BLOCK_DATA_DECL.Name = NewUnitName (t->BLOCK_DATA_DECL.Name);
  365. # line 214 "AdaptTransform.puma"
  366.    unitname = t->BLOCK_DATA_DECL.Name;
  367. # line 215 "AdaptTransform.puma"
  368.    IsMainUnit = false;
  369. # line 216 "AdaptTransform.puma"
  370.    IsPure = false;
  371. # line 217 "AdaptTransform.puma"
  372.  t->BLOCK_DATA_DECL.DATA_BODY = UnitsAdapt (t->BLOCK_DATA_DECL.DATA_BODY);
  373. # line 218 "AdaptTransform.puma"
  374.    CloseScope ();
  375.   }
  376.   {
  377.    return t;
  378.   }
  379.  }
  380.  
  381.   case kBODY_NODE:
  382. # line 222 "AdaptTransform.puma"
  383.   {
  384. # line 223 "AdaptTransform.puma"
  385.  NewDefines = NoTree;
  386.        t->BODY_NODE.DECLS = TransformDECL (t->BODY_NODE.DECLS);
  387.        t->BODY_NODE.STATS = TransformACF (t->BODY_NODE.STATS);
  388.        t->BODY_NODE.STATS = CombineACF (NewDefines, t->BODY_NODE.STATS);
  389.  
  390.        RemoveOverlaps (t->BODY_NODE.DECLS);
  391.  
  392.        MakeStatic (t, unitname);
  393.  
  394.        if ( (!IsHost) && (target_model != UNI_PROC) )
  395.           t->BODY_NODE.DECLS = AppendDECLS (t->BODY_NODE.DECLS, MakeDalibHaveI ());
  396.  
  397.        if (target_model == ONLY_NODE)
  398.           t->BODY_NODE.DECLS = AppendDECLS (t->BODY_NODE.DECLS, MakeDalibPid());
  399.  
  400.   }
  401.    return t;
  402.  
  403.   }
  404.  
  405.  yyAbort ("UnitsAdapt");
  406. }
  407.  
  408. static tTree TransformDECL
  409. # if defined __STDC__ | defined __cplusplus
  410. (register tTree t)
  411. # else
  412. (t)
  413.  register tTree t;
  414. # endif
  415. {
  416.  
  417.   switch (t->Kind) {
  418.   case kDECL_LIST:
  419. # line 249 "AdaptTransform.puma"
  420.  {
  421.   tTree new_decl;
  422.   {
  423. # line 251 "AdaptTransform.puma"
  424.  
  425. # line 253 "AdaptTransform.puma"
  426.  new_decl = TransformDECL (t->DECL_LIST.Elem);
  427.        t->DECL_LIST.Next     = TransformDECL (t->DECL_LIST.Next);
  428.        new_decl = ReplaceDECL (t, new_decl, t->DECL_LIST.Next);
  429.  
  430.   }
  431.   {
  432.    return new_decl;
  433.   }
  434.  }
  435.  
  436.   case kDECL_EMPTY:
  437. # line 260 "AdaptTransform.puma"
  438.    return t;
  439.  
  440.   case kVAR_DECL:
  441.   if (t->VAR_DECL.VAL->Kind == kARRAY_TYPE) {
  442. # line 264 "AdaptTransform.puma"
  443.  {
  444.   int var_dist;
  445.   tTree new_decl;
  446.   tDefinitions Obj;
  447.   {
  448. # line 266 "AdaptTransform.puma"
  449.  
  450. # line 267 "AdaptTransform.puma"
  451.  
  452. # line 268 "AdaptTransform.puma"
  453.  
  454. # line 270 "AdaptTransform.puma"
  455.    Obj = GetLocalDecl (t->VAR_DECL.Name);
  456. # line 271 "AdaptTransform.puma"
  457.    var_dist = VarDistribution (Obj);
  458. # line 272 "AdaptTransform.puma"
  459.    new_decl = AdaptVarDecl (t, var_dist, IsMainUnit);
  460.   }
  461.   {
  462.    return new_decl;
  463.   }
  464.  }
  465.  
  466.   }
  467. # line 277 "AdaptTransform.puma"
  468.  {
  469.   tDefinitions Obj;
  470.   {
  471. # line 279 "AdaptTransform.puma"
  472.  
  473. # line 280 "AdaptTransform.puma"
  474.    Obj = GetLocalDecl (t->VAR_DECL.Name);
  475. # line 281 "AdaptTransform.puma"
  476.  if ((Obj != NoObject) && (Obj == GetDeclEntry (t->VAR_DECL.Name, GetUnitEntries())))
  477.           t->VAR_DECL.Name = NewUnitName (t->VAR_DECL.Name);
  478.  
  479.   }
  480.   {
  481.    return t;
  482.   }
  483.  }
  484.  
  485.   case kVAR_PARAM_DECL:
  486. # line 287 "AdaptTransform.puma"
  487.  {
  488.   int var_dist;
  489.   tTree new_decl;
  490.   tDefinitions Obj;
  491.   {
  492. # line 291 "AdaptTransform.puma"
  493.  
  494. # line 292 "AdaptTransform.puma"
  495.  
  496. # line 293 "AdaptTransform.puma"
  497.  
  498. # line 295 "AdaptTransform.puma"
  499.    Obj = GetLocalDecl (t->VAR_PARAM_DECL.Name);
  500. # line 296 "AdaptTransform.puma"
  501.    var_dist = VarDistribution (Obj);
  502. # line 297 "AdaptTransform.puma"
  503.    new_decl = AdaptParamDecl (t, var_dist);
  504.   }
  505.   {
  506.    return new_decl;
  507.   }
  508.  }
  509.  
  510.   case kPARAMETER_DECL:
  511. # line 301 "AdaptTransform.puma"
  512.    return t;
  513.  
  514.   case kEXTERNAL_DECL:
  515. # line 305 "AdaptTransform.puma"
  516.  {
  517.   tDefinitions Obj;
  518.   {
  519. # line 309 "AdaptTransform.puma"
  520.  
  521. # line 310 "AdaptTransform.puma"
  522.    Obj = GetLocalDecl (t->EXTERNAL_DECL.Name);
  523. # line 312 "AdaptTransform.puma"
  524.  if ((Obj != NoObject) && (Obj == GetDeclEntry (t->EXTERNAL_DECL.Name, GetUnitEntries())))
  525.           t->EXTERNAL_DECL.Name = NewUnitName (t->EXTERNAL_DECL.Name);
  526.  
  527.   }
  528.   {
  529.    return t;
  530.   }
  531.  }
  532.  
  533.   case kINTRINSIC_DECL:
  534. # line 318 "AdaptTransform.puma"
  535.    return NoTree;
  536.  
  537.   case kIMPLICIT_DECL:
  538. # line 322 "AdaptTransform.puma"
  539.    return t;
  540.  
  541.   case kCOMMON_DECL:
  542. # line 327 "AdaptTransform.puma"
  543.   {
  544. # line 328 "AdaptTransform.puma"
  545.  t->COMMON_DECL.IDS = TransformCommonDECL (t->COMMON_DECL.IDS);
  546.   }
  547.    return t;
  548.  
  549.   case kNAMELIST_DECL:
  550. # line 332 "AdaptTransform.puma"
  551.    return t;
  552.  
  553.   case kDATA_DECL:
  554. # line 336 "AdaptTransform.puma"
  555.    return t;
  556.  
  557.   case kSAVE_DECL:
  558. # line 340 "AdaptTransform.puma"
  559.    return t;
  560.  
  561.   case kSEQUENCE_DECL:
  562. # line 344 "AdaptTransform.puma"
  563.    return NoTree;
  564.  
  565.   case kNOSEQUENCE_DECL:
  566. # line 348 "AdaptTransform.puma"
  567.    return NoTree;
  568.  
  569.   case kEQV_DECL:
  570. # line 352 "AdaptTransform.puma"
  571.    return t;
  572.  
  573.   case kTEMPLATE_DECL:
  574. # line 356 "AdaptTransform.puma"
  575.    return NoTree;
  576.  
  577.   case kALIGN_DECL:
  578. # line 360 "AdaptTransform.puma"
  579.    return NoTree;
  580.  
  581.   case kDISTRIBUTE_DECL:
  582. # line 364 "AdaptTransform.puma"
  583.    return NoTree;
  584.  
  585.   case kSTMT_FUNC_DECL:
  586. # line 368 "AdaptTransform.puma"
  587.    return t;
  588.  
  589.   }
  590.  
  591. # line 373 "AdaptTransform.puma"
  592.   {
  593. # line 374 "AdaptTransform.puma"
  594.    printf ("TransformDECL failed\n");
  595. # line 375 "AdaptTransform.puma"
  596.    WriteTree (stdout, t);
  597. # line 376 "AdaptTransform.puma"
  598.    exit (- 1);
  599.   }
  600.    return t;
  601.  
  602. }
  603.  
  604. static tTree TransformCommonDECL
  605. # if defined __STDC__ | defined __cplusplus
  606. (register tTree t)
  607. # else
  608. (t)
  609.  register tTree t;
  610. # endif
  611. {
  612.   if (t->Kind == kDECL_LIST) {
  613. # line 382 "AdaptTransform.puma"
  614.  {
  615.   tTree new_decl;
  616.   {
  617. # line 384 "AdaptTransform.puma"
  618.  
  619. # line 386 "AdaptTransform.puma"
  620.  new_decl = TransformCommonDECL (t->DECL_LIST.Elem);
  621.        t->DECL_LIST.Next     = TransformCommonDECL (t->DECL_LIST.Next);
  622.        new_decl = ReplaceDECL (t, new_decl, t->DECL_LIST.Next);
  623.  
  624.   }
  625.   {
  626.    return new_decl;
  627.   }
  628.  }
  629.  
  630.   }
  631.   if (t->Kind == kDECL_EMPTY) {
  632. # line 393 "AdaptTransform.puma"
  633.    return t;
  634.  
  635.   }
  636.   if (t->Kind == kVAR_DECL) {
  637. # line 397 "AdaptTransform.puma"
  638.    return AdaptCommonVarDecl (t, VarDistribution (GetLocalDecl (t->VAR_DECL.Name)));
  639.  
  640.   }
  641. # line 401 "AdaptTransform.puma"
  642.   {
  643. # line 402 "AdaptTransform.puma"
  644.    failure_protocol ("AdaptTransform", "TransformCommonDECL", t);
  645.   }
  646.    return t;
  647.  
  648. }
  649.  
  650. static tTree TransformACF
  651. # if defined __STDC__ | defined __cplusplus
  652. (register tTree t)
  653. # else
  654. (t)
  655.  register tTree t;
  656. # endif
  657. {
  658. # line 414 "AdaptTransform.puma"
  659.  
  660. tTree newacf;
  661.  
  662.   if (t->Kind == kACF_LIST) {
  663. # line 418 "AdaptTransform.puma"
  664.   {
  665. # line 420 "AdaptTransform.puma"
  666.    set_protocol_stmt (t->ACF_LIST.Elem);
  667. # line 422 "AdaptTransform.puma"
  668.  newacf = TransformACF (t->ACF_LIST.Elem);
  669.        t->ACF_LIST.Next   = TransformACF (t->ACF_LIST.Next);
  670.  
  671. # line 426 "AdaptTransform.puma"
  672.    newacf = ReplaceACF (t, newacf, t->ACF_LIST.Next);
  673.   }
  674.    return newacf;
  675.  
  676.   }
  677.   if (t->Kind == kACF_EMPTY) {
  678. # line 431 "AdaptTransform.puma"
  679.    return t;
  680.  
  681.   }
  682.   if (t->Kind == kACF_BASIC) {
  683.  
  684.   switch (t->ACF_BASIC.BASIC_STMT->Kind) {
  685.   case kIO_STMT:
  686.  {
  687.   tTree iostmt;
  688.   if (equaltIdent (t->ACF_BASIC.BASIC_STMT->IO_STMT.ID->PROC_OBJ.Ident, MakeIdent ("READ", 4))) {
  689. # line 435 "AdaptTransform.puma"
  690.   {
  691. # line 437 "AdaptTransform.puma"
  692.  
  693. # line 438 "AdaptTransform.puma"
  694.  newacf = CombineACF (MakeReadSpecBroadcast (t->ACF_BASIC.BASIC_STMT->IO_STMT.IO_SPECS),
  695.                             MakeParamBroadcast (t->ACF_BASIC.BASIC_STMT->IO_STMT.IO_ITEMS));
  696.        iostmt = DoSingleNode (t);
  697.        if (iostmt != NoTree)
  698.           newacf = mACF_LIST (iostmt, newacf);
  699.  
  700.   }
  701.   {
  702.    return newacf;
  703.   }
  704.  
  705.   }
  706.  }
  707. # line 447 "AdaptTransform.puma"
  708.   {
  709. # line 448 "AdaptTransform.puma"
  710.  newacf = DoSingleNode (t);
  711.        UpdateFuncCall (t->ACF_BASIC.BASIC_STMT->IO_STMT.IO_ITEMS);
  712.  
  713.   }
  714.    return newacf;
  715.  
  716.   case kALLOCATE_STMT:
  717. # line 454 "AdaptTransform.puma"
  718.   {
  719. # line 455 "AdaptTransform.puma"
  720.    SetAllocateShapes (t->ACF_BASIC.BASIC_STMT->ALLOCATE_STMT.PARAMS);
  721. # line 456 "AdaptTransform.puma"
  722.  newacf = AdaptAllocate (t->ACF_BASIC.BASIC_STMT->ALLOCATE_STMT.PARAMS, IsMainUnit);
  723.   }
  724.    return newacf;
  725.  
  726.   case kDEALLOCATE_STMT:
  727. # line 460 "AdaptTransform.puma"
  728.   {
  729. # line 461 "AdaptTransform.puma"
  730.    ResetDeallocateShapes (t->ACF_BASIC.BASIC_STMT->DEALLOCATE_STMT.PARAMS);
  731. # line 462 "AdaptTransform.puma"
  732.  newacf = AdaptDeallocate (t->ACF_BASIC.BASIC_STMT->DEALLOCATE_STMT.PARAMS, IsMainUnit);
  733.   }
  734.    return newacf;
  735.  
  736.   case kCALL_STMT:
  737. # line 466 "AdaptTransform.puma"
  738.   {
  739. # line 470 "AdaptTransform.puma"
  740.    if (! (t->ACF_BASIC.BASIC_STMT->CALL_STMT.CALL_ID->PROC_OBJ.Object == GetDeclEntry (t->ACF_BASIC.BASIC_STMT->CALL_STMT.CALL_ID->PROC_OBJ.Ident, GetIntrinsicEntries ()))) goto yyL7;
  741.   {
  742. # line 472 "AdaptTransform.puma"
  743.   newacf = t;
  744.        if (IsCMSubroutine (t->ACF_BASIC.BASIC_STMT->CALL_STMT.CALL_ID->PROC_OBJ.Ident))
  745.          {
  746.            newacf = AdaptCMIntrinsic (t);
  747.          }
  748.        else
  749.          error_protocol ("Adaption of intrinsic subroutine failed");
  750.  
  751. # line 481 "AdaptTransform.puma"
  752.    UpdateFuncCall (t->ACF_BASIC.BASIC_STMT->CALL_STMT.CALL_PARAMS);
  753.   }
  754.   }
  755.    return newacf;
  756. yyL7:;
  757.  
  758. # line 485 "AdaptTransform.puma"
  759.  {
  760.   tTree iostmt;
  761.   {
  762. # line 489 "AdaptTransform.puma"
  763.    if (! (t->ACF_BASIC.BASIC_STMT->CALL_STMT.CALL_ID->PROC_OBJ.Object == GetDeclEntry (t->ACF_BASIC.BASIC_STMT->CALL_STMT.CALL_ID->PROC_OBJ.Ident, GetExternalEntries ()))) goto yyL8;
  764.   {
  765. # line 491 "AdaptTransform.puma"
  766.  
  767. # line 492 "AdaptTransform.puma"
  768.  newacf = MakeParamBroadcast (t->ACF_BASIC.BASIC_STMT->CALL_STMT.CALL_PARAMS);
  769.       iostmt = DoSingleNode (t);
  770.       if (iostmt != NoTree)
  771.          newacf = mACF_LIST (iostmt, newacf);
  772.  
  773. # line 498 "AdaptTransform.puma"
  774.    UpdateFuncCall (t->ACF_BASIC.BASIC_STMT->CALL_STMT.CALL_PARAMS);
  775.   }
  776.   }
  777.   {
  778.    return newacf;
  779.   }
  780.  }
  781. yyL8:;
  782.  
  783. # line 502 "AdaptTransform.puma"
  784.   {
  785. # line 506 "AdaptTransform.puma"
  786.    t->ACF_BASIC.BASIC_STMT->CALL_STMT.CALL_ID->PROC_OBJ.Ident = NewUnitName (t->ACF_BASIC.BASIC_STMT->CALL_STMT.CALL_ID->PROC_OBJ.Ident);
  787. # line 507 "AdaptTransform.puma"
  788.  t->ACF_BASIC.BASIC_STMT->CALL_STMT.CALL_PARAMS = TransformActuals (t->ACF_BASIC.BASIC_STMT->CALL_STMT.CALL_PARAMS);
  789. # line 508 "AdaptTransform.puma"
  790.    UpdateFuncCall (t->ACF_BASIC.BASIC_STMT->CALL_STMT.CALL_PARAMS);
  791.   }
  792.    return t;
  793.  
  794.   case kSTOP_STMT:
  795. # line 512 "AdaptTransform.puma"
  796.   {
  797. # line 513 "AdaptTransform.puma"
  798.  if (IsHost)
  799.          newacf = t;
  800.        else
  801.          newacf = NoTree;
  802.  
  803.   }
  804.    return newacf;
  805.  
  806.   case kGOTO_STMT:
  807. # line 521 "AdaptTransform.puma"
  808.    return t;
  809.  
  810.   case kCOMP_IF_STMT:
  811. # line 525 "AdaptTransform.puma"
  812.    return t;
  813.  
  814.   case kASSIGN_STMT:
  815. # line 535 "AdaptTransform.puma"
  816.   {
  817. # line 536 "AdaptTransform.puma"
  818.  UpdateFuncCall (t->ACF_BASIC.BASIC_STMT->ASSIGN_STMT.ASSIGN_VAR);
  819.          UpdateFuncCall (t->ACF_BASIC.BASIC_STMT->ASSIGN_STMT.ASSIGN_EXP);
  820.  
  821.   }
  822.    return (AdaptAssign (t, TreeRank (t->ACF_BASIC.BASIC_STMT->ASSIGN_STMT.ASSIGN_VAR), TreeRank (t->ACF_BASIC.BASIC_STMT->ASSIGN_STMT.ASSIGN_EXP)));
  823.  
  824.   }
  825.  
  826. # line 542 "AdaptTransform.puma"
  827.    return t;
  828.  
  829.   }
  830.  
  831.   switch (t->Kind) {
  832.   case kACF_DUMMY:
  833. # line 546 "AdaptTransform.puma"
  834.    return t;
  835.  
  836.   case kACF_WHILE:
  837. # line 550 "AdaptTransform.puma"
  838.   {
  839. # line 551 "AdaptTransform.puma"
  840.   if (TreeDistribution (t->ACF_WHILE.WHILE_EXP) != 0)
  841.             error_protocol ("while condition is not replicated");
  842.          t->ACF_WHILE.WHILE_BODY = TransformACF (t->ACF_WHILE.WHILE_BODY);
  843.          UpdateFuncCall (t->ACF_WHILE.WHILE_EXP);
  844.  
  845.   }
  846.    return t;
  847.  
  848.   case kACF_DO:
  849. # line 559 "AdaptTransform.puma"
  850.   {
  851. # line 560 "AdaptTransform.puma"
  852.  if (TreeDistribution (t->ACF_DO.DO_RANGE) != 0)
  853.             error_protocol ("for slice is not replicated");
  854.         t->ACF_DO.DO_BODY = TransformACF (t->ACF_DO.DO_BODY);
  855.  
  856.   }
  857.    return t;
  858.  
  859.   case kACF_DOVEC:
  860. # line 567 "AdaptTransform.puma"
  861.   {
  862. # line 568 "AdaptTransform.puma"
  863.  if (TreeDistribution (t->ACF_DOVEC.DOVEC_RANGE) != 0)
  864.             error_protocol ("vecfor slice is not replicated");
  865.         t->ACF_DOVEC.DOVEC_BODY = TransformACF (t->ACF_DOVEC.DOVEC_BODY);
  866.  
  867.   }
  868.    return t;
  869.  
  870.   case kACF_ON:
  871. # line 575 "AdaptTransform.puma"
  872.  {
  873.   tTree new;
  874.   {
  875. # line 577 "AdaptTransform.puma"
  876.  
  877. # line 581 "AdaptTransform.puma"
  878.    new = AdaptOn (t);
  879. # line 582 "AdaptTransform.puma"
  880.    UpdateLocal (new);
  881.   }
  882.   {
  883.    return new;
  884.   }
  885.  }
  886.  
  887.   case kACF_IF:
  888. # line 587 "AdaptTransform.puma"
  889.   {
  890. # line 589 "AdaptTransform.puma"
  891.  if (TreeDistribution (t->ACF_IF.IF_EXP) != 0)
  892.             error_protocol ("if condition is not replicated");
  893.         t->ACF_IF.THEN_PART = TransformACF (t->ACF_IF.THEN_PART);
  894.         t->ACF_IF.ELSE_PART = TransformACF (t->ACF_IF.ELSE_PART);
  895.         UpdateFuncCall (t->ACF_IF.IF_EXP);
  896.  
  897.   }
  898.    return t;
  899.  
  900.   case kACF_WHERE:
  901. # line 598 "AdaptTransform.puma"
  902.   {
  903. # line 599 "AdaptTransform.puma"
  904.  if (!IsHost)
  905.           { t->ACF_WHERE.TRUE_PART = TransformACF (t->ACF_WHERE.TRUE_PART);
  906.             t->ACF_WHERE.FALSE_PART = TransformACF (t->ACF_WHERE.FALSE_PART);
  907.             newacf = t;
  908.           }
  909.          else newacf = NoTree;
  910.  
  911.   }
  912.    return newacf;
  913.  
  914.   case kACF_NODE:
  915.   case kACF_BASIC:
  916.   case kACF_SWITCH:
  917.   case kACF_ALTER:
  918.   case kACF_CASE:
  919.   case kACF_REPEAT:
  920.   case kACF_WITH:
  921.   case kACF_LOOP:
  922.   case kACF_DOLOCAL:
  923.   case kACF_DOALL:
  924.   case kACF_FORALL:
  925.   case kACF_BODY:
  926.   case kACF_FLOW_GRAPH:
  927.   case kACF_ENTRY:
  928. # line 609 "AdaptTransform.puma"
  929.    return t;
  930.  
  931.   }
  932.  
  933. # line 613 "AdaptTransform.puma"
  934.   {
  935. # line 614 "AdaptTransform.puma"
  936.    printf ("TransformACF failed\n");
  937. # line 615 "AdaptTransform.puma"
  938.    WriteTree (stdout, t);
  939. # line 616 "AdaptTransform.puma"
  940.    exit (- 1);
  941.   }
  942.    return t;
  943.  
  944. }
  945.  
  946. static tTree TransformActuals
  947. # if defined __STDC__ | defined __cplusplus
  948. (register tTree t)
  949. # else
  950. (t)
  951.  register tTree t;
  952. # endif
  953. {
  954. # line 630 "AdaptTransform.puma"
  955.  
  956. tTree newdecl, hdecl, p;
  957. int dist;
  958.  
  959.   if (t->Kind == kBTP_EMPTY) {
  960. # line 635 "AdaptTransform.puma"
  961.    return t;
  962.  
  963.   }
  964.   if (t->Kind == kBTP_LIST) {
  965. # line 639 "AdaptTransform.puma"
  966.   {
  967. # line 640 "AdaptTransform.puma"
  968.  newdecl = TransformActuals (t->BTP_LIST.Elem);
  969.        t->BTP_LIST.Next    = TransformActuals (t->BTP_LIST.Next);
  970.        if (newdecl == NoTree)
  971.           newdecl = t->BTP_LIST.Next;
  972.        else if (newdecl->Kind == kBTP_EMPTY)
  973.           newdecl = t->BTP_LIST.Next;
  974.         else if (newdecl->Kind == kBTP_LIST)
  975.           { hdecl = newdecl;
  976.             while (hdecl->BTP_LIST.Next->Kind == kBTP_LIST)
  977.               hdecl = hdecl->BTP_LIST.Next;
  978.             hdecl->BTP_LIST.Next = t->BTP_LIST.Next;
  979.           }
  980.         else
  981.           newdecl = t;
  982.  
  983.   }
  984.    return newdecl;
  985.  
  986.   }
  987.   if (t->Kind == kVAR_PARAM) {
  988.   if (t->VAR_PARAM.V->Kind == kUSED_VAR) {
  989. # line 658 "AdaptTransform.puma"
  990.   {
  991. # line 659 "AdaptTransform.puma"
  992.  dist = TreeDistribution (t);
  993.        if (dist == 1)
  994.          {
  995.            if (IsHost)
  996.              {
  997.                newdecl = mBTP_EMPTY ();
  998.              }
  999.             else
  1000.              {
  1001.                newdecl = mBTP_EMPTY ();
  1002.                p = MakeUsedVarA (t->VAR_PARAM.V->USED_VAR.VARNAME->VAR_OBJ.Ident, "_HIGH");
  1003.                newdecl = mBTP_LIST (mVAR_PARAM (p), newdecl);
  1004.                p = MakeUsedVarA (t->VAR_PARAM.V->USED_VAR.VARNAME->VAR_OBJ.Ident, "_LOW");
  1005.                newdecl = mBTP_LIST (mVAR_PARAM (p), newdecl);
  1006.                newdecl = mBTP_LIST (t, newdecl);
  1007.              }
  1008.          }
  1009.         else
  1010.          newdecl = t;
  1011.  
  1012.   }
  1013.    return newdecl;
  1014.  
  1015.   }
  1016. # line 682 "AdaptTransform.puma"
  1017.    return t;
  1018.  
  1019.   }
  1020.   if (t->Kind == kPROC_PARAM) {
  1021. # line 686 "AdaptTransform.puma"
  1022.    return t;
  1023.  
  1024.   }
  1025.   if (t->Kind == kFUNC_PARAM) {
  1026. # line 690 "AdaptTransform.puma"
  1027.    return t;
  1028.  
  1029.   }
  1030. # line 694 "AdaptTransform.puma"
  1031.   {
  1032. # line 695 "AdaptTransform.puma"
  1033.    failure_protocol ("AdaptTransform", "TransformActuals", t);
  1034.   }
  1035.    return t;
  1036.  
  1037. }
  1038.  
  1039. static tTree AdaptAssign
  1040. # if defined __STDC__ | defined __cplusplus
  1041. (register tTree assign, register int rankvar, register int rankexp)
  1042. # else
  1043. (assign, rankvar, rankexp)
  1044.  register tTree assign;
  1045.  register int rankvar;
  1046.  register int rankexp;
  1047. # endif
  1048. {
  1049. # line 708 "AdaptTransform.puma"
  1050.  
  1051. char string[256];     /* for error message */
  1052.  
  1053.   if (assign->Kind == kACF_BASIC) {
  1054.   if (assign->ACF_BASIC.BASIC_STMT->Kind == kASSIGN_STMT) {
  1055. # line 718 "AdaptTransform.puma"
  1056.   {
  1057. # line 719 "AdaptTransform.puma"
  1058.    if (! ((IsPure == true))) goto yyL1;
  1059.   }
  1060.    return assign;
  1061. yyL1:;
  1062.  
  1063. # line 729 "AdaptTransform.puma"
  1064.   {
  1065. # line 730 "AdaptTransform.puma"
  1066.    if (! (IsArrayOverlapped (assign->ACF_BASIC.BASIC_STMT->ASSIGN_STMT.ASSIGN_VAR) == true)) goto yyL2;
  1067.   }
  1068.    return (AdaptOverlappedMovement (assign));
  1069. yyL2:;
  1070.  
  1071.   if (equalint (rankvar, 0)) {
  1072.   if (equalint (rankexp, 0)) {
  1073. # line 740 "AdaptTransform.puma"
  1074.    return (AdaptScalarAssign (assign, TreeDistribution (assign->ACF_BASIC.BASIC_STMT->ASSIGN_STMT.ASSIGN_VAR), TreeDistribution (assign->ACF_BASIC.BASIC_STMT->ASSIGN_STMT.ASSIGN_EXP)));
  1075.  
  1076.   }
  1077.   }
  1078.   if (equalint (rankexp, 0)) {
  1079. # line 751 "AdaptTransform.puma"
  1080.    return (AdaptArrayAssign (assign, TreeDistribution (assign->ACF_BASIC.BASIC_STMT->ASSIGN_STMT.ASSIGN_VAR), TreeDistribution (assign->ACF_BASIC.BASIC_STMT->ASSIGN_STMT.ASSIGN_EXP)));
  1081.  
  1082.   }
  1083.   if (assign->ACF_BASIC.BASIC_STMT->ASSIGN_STMT.ASSIGN_EXP->Kind == kFUNC_CALL_EXP) {
  1084. # line 765 "AdaptTransform.puma"
  1085.   {
  1086. # line 770 "AdaptTransform.puma"
  1087.    if (! (rankvar == rankexp)) goto yyL5;
  1088.   {
  1089. # line 771 "AdaptTransform.puma"
  1090.    if (! (IsIntrFunc (assign->ACF_BASIC.BASIC_STMT->ASSIGN_STMT.ASSIGN_EXP) == true)) goto yyL5;
  1091.   {
  1092. # line 772 "AdaptTransform.puma"
  1093.    if (! (assign->ACF_BASIC.BASIC_STMT->ASSIGN_STMT.ASSIGN_EXP->FUNC_CALL_EXP.FUNC_ID->PROC_OBJ.Ident == MakeIdent ("CSHIFT", 6))) goto yyL5;
  1094.   }
  1095.   }
  1096.   }
  1097.    return AdaptCShift (assign);
  1098. yyL5:;
  1099.  
  1100. # line 783 "AdaptTransform.puma"
  1101.   {
  1102. # line 788 "AdaptTransform.puma"
  1103.    if (! (rankvar == rankexp)) goto yyL6;
  1104.   {
  1105. # line 789 "AdaptTransform.puma"
  1106.    if (! (IsIntrFunc (assign->ACF_BASIC.BASIC_STMT->ASSIGN_STMT.ASSIGN_EXP) == true)) goto yyL6;
  1107.   {
  1108. # line 790 "AdaptTransform.puma"
  1109.    if (! (assign->ACF_BASIC.BASIC_STMT->ASSIGN_STMT.ASSIGN_EXP->FUNC_CALL_EXP.FUNC_ID->PROC_OBJ.Ident == MakeIdent ("TRANSPOSE", 9))) goto yyL6;
  1110.   }
  1111.   }
  1112.   }
  1113.    return AdaptTranspose (assign);
  1114. yyL6:;
  1115.  
  1116.   }
  1117. # line 801 "AdaptTransform.puma"
  1118.   {
  1119. # line 802 "AdaptTransform.puma"
  1120.    if (! (rankvar == rankexp)) goto yyL7;
  1121.   {
  1122. # line 805 "AdaptTransform.puma"
  1123.  assign->ACF_BASIC.BASIC_STMT->ASSIGN_STMT.ASSIGN_VAR = MakeFullShape (assign->ACF_BASIC.BASIC_STMT->ASSIGN_STMT.ASSIGN_VAR);
  1124.   }
  1125.   }
  1126.    return (AdaptArrayMovement (assign, TreeDistribution (assign->ACF_BASIC.BASIC_STMT->ASSIGN_STMT.ASSIGN_VAR), TreeDistribution (assign->ACF_BASIC.BASIC_STMT->ASSIGN_STMT.ASSIGN_EXP)));
  1127. yyL7:;
  1128.  
  1129.   }
  1130.   }
  1131. # line 812 "AdaptTransform.puma"
  1132.   {
  1133. # line 813 "AdaptTransform.puma"
  1134.    sprintf (string, "AdapptAssign: rank lvar = %d, Rank rvar = %d", rankvar, rankexp);
  1135. # line 814 "AdaptTransform.puma"
  1136.    failure_protocol ("AdaptTransform", "AdaptAssign: rank error", assign);
  1137.   }
  1138.    return NoTree;
  1139.  
  1140. }
  1141.  
  1142. static tTree AdaptArrayAssign
  1143. # if defined __STDC__ | defined __cplusplus
  1144. (register tTree assign, register int vardistribution, register int expdistribution)
  1145. # else
  1146. (assign, vardistribution, expdistribution)
  1147.  register tTree assign;
  1148.  register int vardistribution;
  1149.  register int expdistribution;
  1150. # endif
  1151. {
  1152. # line 827 "AdaptTransform.puma"
  1153.  
  1154. tTree t, index, new;
  1155. char string[250];
  1156.  
  1157.   if (equalint (vardistribution, 0)) {
  1158.   if (equalint (expdistribution, 0)) {
  1159. # line 838 "AdaptTransform.puma"
  1160.    return assign;
  1161.  
  1162.   }
  1163.   }
  1164.   if (equalint (vardistribution, - 1)) {
  1165.   if (equalint (expdistribution, 0)) {
  1166. # line 848 "AdaptTransform.puma"
  1167.   {
  1168. # line 849 "AdaptTransform.puma"
  1169.  if (IsHost)
  1170.         t = assign;
  1171.       else
  1172.         t = NoTree;
  1173.  
  1174.   }
  1175.    return t;
  1176.  
  1177.   }
  1178.   }
  1179.   if (assign->Kind == kACF_BASIC) {
  1180.   if (assign->ACF_BASIC.BASIC_STMT->Kind == kASSIGN_STMT) {
  1181.   if (assign->ACF_BASIC.BASIC_STMT->ASSIGN_STMT.ASSIGN_VAR->Kind == kINDEXED_VAR) {
  1182.   if (equalint (vardistribution, 1)) {
  1183.   if (equalint (expdistribution, 0)) {
  1184. # line 867 "AdaptTransform.puma"
  1185.   {
  1186. # line 868 "AdaptTransform.puma"
  1187.  if (IsHost)
  1188.         t = NoTree;
  1189.        else
  1190.         t = LocalArrayAssignment (assign);
  1191.  
  1192.   }
  1193.    return t;
  1194.  
  1195.   }
  1196.   }
  1197.   }
  1198.   }
  1199.   }
  1200. # line 876 "AdaptTransform.puma"
  1201.   {
  1202. # line 877 "AdaptTransform.puma"
  1203.    sprintf (string, "%s: vardist = %d, expdist = %d\n", "Adapting Array Assignment", vardistribution, expdistribution);
  1204. # line 879 "AdaptTransform.puma"
  1205.    error_protocol (string);
  1206.   }
  1207.    return assign;
  1208.  
  1209. }
  1210.  
  1211. static void UpdateLocal
  1212. # if defined __STDC__ | defined __cplusplus
  1213. (register tTree t)
  1214. # else
  1215. (t)
  1216.  register tTree t;
  1217. # endif
  1218. {
  1219.   if (t == NoTree) return;
  1220.  
  1221.   switch (t->Kind) {
  1222.   case kACF_LIST:
  1223. # line 891 "AdaptTransform.puma"
  1224.   {
  1225. # line 892 "AdaptTransform.puma"
  1226.    UpdateLocal (t->ACF_LIST.Elem);
  1227. # line 893 "AdaptTransform.puma"
  1228.    UpdateLocal (t->ACF_LIST.Next);
  1229.   }
  1230.    return;
  1231.  
  1232.   case kACF_EMPTY:
  1233. # line 896 "AdaptTransform.puma"
  1234.    return;
  1235.  
  1236.   case kACF_DUMMY:
  1237. # line 899 "AdaptTransform.puma"
  1238.    return;
  1239.  
  1240.   case kACF_BASIC:
  1241.   if (t->ACF_BASIC.BASIC_STMT->Kind == kASSIGN_STMT) {
  1242. # line 902 "AdaptTransform.puma"
  1243.   {
  1244. # line 903 "AdaptTransform.puma"
  1245.    UpdateFuncCall (t->ACF_BASIC.BASIC_STMT->ASSIGN_STMT.ASSIGN_VAR);
  1246. # line 904 "AdaptTransform.puma"
  1247.    UpdateFuncCall (t->ACF_BASIC.BASIC_STMT->ASSIGN_STMT.ASSIGN_EXP);
  1248.   }
  1249.    return;
  1250.  
  1251.   }
  1252.   if (t->ACF_BASIC.BASIC_STMT->Kind == kCALL_STMT) {
  1253. # line 907 "AdaptTransform.puma"
  1254.   {
  1255. # line 908 "AdaptTransform.puma"
  1256.  if (    (GetDeclEntry (t->ACF_BASIC.BASIC_STMT->CALL_STMT.CALL_ID->PROC_OBJ.Ident, GetUnitEntries ()) == t->ACF_BASIC.BASIC_STMT->CALL_STMT.CALL_ID->PROC_OBJ.Object)
  1257.           && (t->ACF_BASIC.BASIC_STMT->CALL_STMT.CALL_ID->PROC_OBJ.Object != NoObject))
  1258.  
  1259.        { t->ACF_BASIC.BASIC_STMT->CALL_STMT.CALL_ID->PROC_OBJ.Ident = NewUnitName (t->ACF_BASIC.BASIC_STMT->CALL_STMT.CALL_ID->PROC_OBJ.Ident);
  1260.  
  1261.          t->ACF_BASIC.BASIC_STMT->CALL_STMT.CALL_PARAMS = TransformActuals (t->ACF_BASIC.BASIC_STMT->CALL_STMT.CALL_PARAMS);
  1262.        }
  1263.  
  1264. # line 916 "AdaptTransform.puma"
  1265.    UpdateFuncCall (t->ACF_BASIC.BASIC_STMT->CALL_STMT.CALL_PARAMS);
  1266.   }
  1267.    return;
  1268.  
  1269.   }
  1270. # line 919 "AdaptTransform.puma"
  1271.    return;
  1272.  
  1273.   case kACF_WHILE:
  1274. # line 922 "AdaptTransform.puma"
  1275.   {
  1276. # line 923 "AdaptTransform.puma"
  1277.    UpdateFuncCall (t->ACF_WHILE.WHILE_EXP);
  1278. # line 924 "AdaptTransform.puma"
  1279.    UpdateLocal (t->ACF_WHILE.WHILE_BODY);
  1280.   }
  1281.    return;
  1282.  
  1283.   case kACF_DO:
  1284. # line 927 "AdaptTransform.puma"
  1285.   {
  1286. # line 928 "AdaptTransform.puma"
  1287.    UpdateFuncCall (t->ACF_DO.DO_RANGE);
  1288. # line 929 "AdaptTransform.puma"
  1289.    UpdateLocal (t->ACF_DO.DO_BODY);
  1290.   }
  1291.    return;
  1292.  
  1293.   case kACF_DOVEC:
  1294. # line 932 "AdaptTransform.puma"
  1295.   {
  1296. # line 933 "AdaptTransform.puma"
  1297.    UpdateFuncCall (t->ACF_DOVEC.DOVEC_RANGE);
  1298. # line 934 "AdaptTransform.puma"
  1299.    UpdateLocal (t->ACF_DOVEC.DOVEC_BODY);
  1300.   }
  1301.    return;
  1302.  
  1303.   case kACF_IF:
  1304. # line 937 "AdaptTransform.puma"
  1305.   {
  1306. # line 938 "AdaptTransform.puma"
  1307.    UpdateFuncCall (t->ACF_IF.IF_EXP);
  1308. # line 939 "AdaptTransform.puma"
  1309.    UpdateLocal (t->ACF_IF.THEN_PART);
  1310. # line 940 "AdaptTransform.puma"
  1311.    UpdateLocal (t->ACF_IF.ELSE_PART);
  1312.   }
  1313.    return;
  1314.  
  1315.   case kACF_WHERE:
  1316. # line 943 "AdaptTransform.puma"
  1317.   {
  1318. # line 944 "AdaptTransform.puma"
  1319.    UpdateFuncCall (t->ACF_WHERE.WHERE_EXP);
  1320. # line 945 "AdaptTransform.puma"
  1321.    UpdateLocal (t->ACF_WHERE.TRUE_PART);
  1322. # line 946 "AdaptTransform.puma"
  1323.    UpdateLocal (t->ACF_WHERE.FALSE_PART);
  1324.   }
  1325.    return;
  1326.  
  1327.   }
  1328.  
  1329. # line 949 "AdaptTransform.puma"
  1330.   {
  1331. # line 950 "AdaptTransform.puma"
  1332.    failure_protocol ("AdaptTransform", "UpdateLocal", t);
  1333.   }
  1334.    return;
  1335.  
  1336. ;
  1337. }
  1338.  
  1339. static void UpdateFuncCall
  1340. # if defined __STDC__ | defined __cplusplus
  1341. (register tTree e)
  1342. # else
  1343. (e)
  1344.  register tTree e;
  1345. # endif
  1346. {
  1347.   if (e == NoTree) return;
  1348.  
  1349.   switch (e->Kind) {
  1350.   case kVAR_OBJ:
  1351. # line 963 "AdaptTransform.puma"
  1352.   {
  1353. # line 964 "AdaptTransform.puma"
  1354.  if ((GetDeclEntry (e->VAR_OBJ.Ident, GetUnitEntries ()) == e->VAR_OBJ.Object)
  1355.          && (e->VAR_OBJ.Object != NoObject))
  1356.  
  1357.        e->VAR_OBJ.Ident = NewUnitName (e->VAR_OBJ.Ident);
  1358.  
  1359.   }
  1360.    return;
  1361.  
  1362.   case kUSED_VAR:
  1363. # line 971 "AdaptTransform.puma"
  1364.   {
  1365. # line 972 "AdaptTransform.puma"
  1366.    UpdateFuncCall (e->USED_VAR.VARNAME);
  1367.   }
  1368.    return;
  1369.  
  1370.   case kLOOP_VAR:
  1371. # line 975 "AdaptTransform.puma"
  1372.    return;
  1373.  
  1374.   case kINDEXED_VAR:
  1375. # line 978 "AdaptTransform.puma"
  1376.   {
  1377. # line 979 "AdaptTransform.puma"
  1378.    UpdateFuncCall (e->INDEXED_VAR.IND_EXPS);
  1379.   }
  1380.    return;
  1381.  
  1382.   case kSUBSTRING_VAR:
  1383. # line 982 "AdaptTransform.puma"
  1384.   {
  1385. # line 983 "AdaptTransform.puma"
  1386.    UpdateFuncCall (e->SUBSTRING_VAR.IND_EXP);
  1387.   }
  1388.    return;
  1389.  
  1390.   case kDO_VAR:
  1391. # line 986 "AdaptTransform.puma"
  1392.   {
  1393. # line 987 "AdaptTransform.puma"
  1394.    UpdateFuncCall (e->DO_VAR.BODY);
  1395.   }
  1396.    return;
  1397.  
  1398.   case kBTV_LIST:
  1399. # line 990 "AdaptTransform.puma"
  1400.   {
  1401. # line 991 "AdaptTransform.puma"
  1402.    UpdateFuncCall (e->BTV_LIST.Elem);
  1403. # line 992 "AdaptTransform.puma"
  1404.    UpdateFuncCall (e->BTV_LIST.Next);
  1405.   }
  1406.    return;
  1407.  
  1408.   case kBTV_EMPTY:
  1409. # line 995 "AdaptTransform.puma"
  1410.    return;
  1411.  
  1412.   case kBTE_LIST:
  1413. # line 998 "AdaptTransform.puma"
  1414.   {
  1415. # line 999 "AdaptTransform.puma"
  1416.    UpdateFuncCall (e->BTE_LIST.Elem);
  1417. # line 1000 "AdaptTransform.puma"
  1418.    UpdateFuncCall (e->BTE_LIST.Next);
  1419.   }
  1420.    return;
  1421.  
  1422.   case kBTE_EMPTY:
  1423. # line 1003 "AdaptTransform.puma"
  1424.    return;
  1425.  
  1426.   case kADDR:
  1427. # line 1006 "AdaptTransform.puma"
  1428.   {
  1429. # line 1007 "AdaptTransform.puma"
  1430.    UpdateFuncCall (e->ADDR.E);
  1431.   }
  1432.    return;
  1433.  
  1434.   case kDUMMY_EXP:
  1435. # line 1010 "AdaptTransform.puma"
  1436.    return;
  1437.  
  1438.   case kCONST_EXP:
  1439. # line 1013 "AdaptTransform.puma"
  1440.    return;
  1441.  
  1442.   case kSLICE_EXP:
  1443. # line 1016 "AdaptTransform.puma"
  1444.    return;
  1445.  
  1446.   case kOP_EXP:
  1447. # line 1019 "AdaptTransform.puma"
  1448.   {
  1449. # line 1020 "AdaptTransform.puma"
  1450.    UpdateFuncCall (e->OP_EXP.OPND1);
  1451. # line 1021 "AdaptTransform.puma"
  1452.    UpdateFuncCall (e->OP_EXP.OPND2);
  1453.   }
  1454.    return;
  1455.  
  1456.   case kOP1_EXP:
  1457. # line 1024 "AdaptTransform.puma"
  1458.   {
  1459. # line 1025 "AdaptTransform.puma"
  1460.    UpdateFuncCall (e->OP1_EXP.OPND);
  1461.   }
  1462.    return;
  1463.  
  1464.   case kVAR_EXP:
  1465. # line 1028 "AdaptTransform.puma"
  1466.   {
  1467. # line 1029 "AdaptTransform.puma"
  1468.    UpdateFuncCall (e->VAR_EXP.V);
  1469.   }
  1470.    return;
  1471.  
  1472.   case kFUNC_CALL_EXP:
  1473. # line 1032 "AdaptTransform.puma"
  1474.   {
  1475. # line 1033 "AdaptTransform.puma"
  1476.    UpdateFuncCall (e->FUNC_CALL_EXP.FUNC_PARAMS);
  1477. # line 1034 "AdaptTransform.puma"
  1478.  if ((GetDeclEntry (e->FUNC_CALL_EXP.FUNC_ID->PROC_OBJ.Ident, GetUnitEntries ()) == e->FUNC_CALL_EXP.FUNC_ID->PROC_OBJ.Object) && (e->FUNC_CALL_EXP.FUNC_ID->PROC_OBJ.Object != NoObject))
  1479.  
  1480.        e->FUNC_CALL_EXP.FUNC_ID->PROC_OBJ.Ident = NewUnitName (e->FUNC_CALL_EXP.FUNC_ID->PROC_OBJ.Ident);
  1481.  
  1482.   }
  1483.    return;
  1484.  
  1485.   case kARRAY_EXP:
  1486. # line 1040 "AdaptTransform.puma"
  1487.   {
  1488. # line 1041 "AdaptTransform.puma"
  1489.    UpdateFuncCall (e->ARRAY_EXP.ELEMENTS);
  1490.   }
  1491.    return;
  1492.  
  1493.   case kDO_EXP:
  1494. # line 1044 "AdaptTransform.puma"
  1495.   {
  1496. # line 1045 "AdaptTransform.puma"
  1497.    UpdateFuncCall (e->DO_EXP.BODY);
  1498.   }
  1499.    return;
  1500.  
  1501.   case kBTP_LIST:
  1502. # line 1048 "AdaptTransform.puma"
  1503.   {
  1504. # line 1049 "AdaptTransform.puma"
  1505.    UpdateFuncCall (e->BTP_LIST.Elem);
  1506. # line 1050 "AdaptTransform.puma"
  1507.    UpdateFuncCall (e->BTP_LIST.Next);
  1508.   }
  1509.    return;
  1510.  
  1511.   case kBTP_EMPTY:
  1512. # line 1053 "AdaptTransform.puma"
  1513.    return;
  1514.  
  1515.   case kVAR_PARAM:
  1516. # line 1056 "AdaptTransform.puma"
  1517.   {
  1518. # line 1057 "AdaptTransform.puma"
  1519.    UpdateFuncCall (e->VAR_PARAM.V);
  1520.   }
  1521.    return;
  1522.  
  1523.   case kPROC_PARAM:
  1524. # line 1060 "AdaptTransform.puma"
  1525.   {
  1526. # line 1061 "AdaptTransform.puma"
  1527.  if (    (GetDeclEntry (e->PROC_PARAM.P->PROC_OBJ.Ident, GetUnitEntries ()) == e->PROC_PARAM.P->PROC_OBJ.Object)
  1528.           && (e->PROC_PARAM.P->PROC_OBJ.Object != NoObject))
  1529.  
  1530.        e->PROC_PARAM.P->PROC_OBJ.Ident = NewUnitName (e->PROC_PARAM.P->PROC_OBJ.Ident);
  1531.  
  1532.   }
  1533.    return;
  1534.  
  1535.   case kFUNC_PARAM:
  1536. # line 1068 "AdaptTransform.puma"
  1537.   {
  1538. # line 1069 "AdaptTransform.puma"
  1539.  if (    (GetDeclEntry (e->FUNC_PARAM.F->PROC_OBJ.Ident, GetUnitEntries ()) == e->FUNC_PARAM.F->PROC_OBJ.Object)
  1540.           && (e->FUNC_PARAM.F->PROC_OBJ.Object != NoObject))
  1541.  
  1542.        e->FUNC_PARAM.F->PROC_OBJ.Ident = NewUnitName (e->FUNC_PARAM.F->PROC_OBJ.Ident);
  1543.  
  1544.   }
  1545.    return;
  1546.  
  1547.   }
  1548.  
  1549. # line 1076 "AdaptTransform.puma"
  1550.   {
  1551. # line 1077 "AdaptTransform.puma"
  1552.    printf ("UpdateFuncCall failed (usually no problems)\n");
  1553. # line 1078 "AdaptTransform.puma"
  1554.    error_protocol ("no update of func call possible");
  1555. # line 1079 "AdaptTransform.puma"
  1556.    FileUnparse (stdout, e);
  1557. # line 1080 "AdaptTransform.puma"
  1558.    WriteTree (stdout, e);
  1559.   }
  1560.    return;
  1561.  
  1562. ;
  1563. }
  1564.  
  1565. static void RemoveOverlaps
  1566. # if defined __STDC__ | defined __cplusplus
  1567. (register tTree t)
  1568. # else
  1569. (t)
  1570.  register tTree t;
  1571. # endif
  1572. {
  1573.   if (t == NoTree) return;
  1574.   if (t->Kind == kDECL_LIST) {
  1575. # line 1091 "AdaptTransform.puma"
  1576.   {
  1577. # line 1092 "AdaptTransform.puma"
  1578.    RemoveOverlaps (t->DECL_LIST.Elem);
  1579. # line 1093 "AdaptTransform.puma"
  1580.    RemoveOverlaps (t->DECL_LIST.Next);
  1581.   }
  1582.    return;
  1583.  
  1584.   }
  1585.   if (t->Kind == kVAR_DECL) {
  1586.   if (t->VAR_DECL.VAL->Kind == kARRAY_TYPE) {
  1587. # line 1096 "AdaptTransform.puma"
  1588.   {
  1589. # line 1097 "AdaptTransform.puma"
  1590.    RemoveOverlaps (t->VAR_DECL.VAL->ARRAY_TYPE.ARRAY_INDEX_TYPES);
  1591.   }
  1592.    return;
  1593.  
  1594.   }
  1595.   }
  1596.   if (t->Kind == kTYPE_LIST) {
  1597. # line 1100 "AdaptTransform.puma"
  1598.   {
  1599. # line 1101 "AdaptTransform.puma"
  1600.    RemoveOverlaps (t->TYPE_LIST.Elem);
  1601. # line 1102 "AdaptTransform.puma"
  1602.    RemoveOverlaps (t->TYPE_LIST.Next);
  1603.   }
  1604.    return;
  1605.  
  1606.   }
  1607.   if (t->Kind == kINDEX_TYPE) {
  1608. # line 1105 "AdaptTransform.puma"
  1609.   {
  1610. # line 1106 "AdaptTransform.puma"
  1611.    t->INDEX_TYPE.left_overlap = 0;
  1612. # line 1107 "AdaptTransform.puma"
  1613.    t->INDEX_TYPE.right_overlap = 0;
  1614.   }
  1615.    return;
  1616.  
  1617.   }
  1618.   if (t->Kind == kDYNAMIC) {
  1619. # line 1110 "AdaptTransform.puma"
  1620.   {
  1621. # line 1111 "AdaptTransform.puma"
  1622.    t->DYNAMIC.left_overlap = 0;
  1623. # line 1112 "AdaptTransform.puma"
  1624.    t->DYNAMIC.right_overlap = 0;
  1625.   }
  1626.    return;
  1627.  
  1628.   }
  1629. ;
  1630. }
  1631.  
  1632. void BeginAdaptTransform ()
  1633. {
  1634. }
  1635.  
  1636. void CloseAdaptTransform ()
  1637. {
  1638. }
  1639.