home *** CD-ROM | disk | FTP | other *** search
/ OS/2 Professional / OS2PRO194.ISO / os2 / prgramer / adaptor / src / adaptloc.c < prev    next >
Text File  |  1994-01-02  |  20KB  |  802 lines
  1. # include "Local.h"
  2. # include "yyALocal.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 27 "AdaptLocal.puma"
  36.  
  37. # include "Idents.h"
  38.  
  39. # include "protocol.h"
  40.  
  41. # include "Transfor.h"   /* ExpToVarParam, ... */
  42. # include "Dalib.h"       /* MakeUsedVarA, .... */
  43. # include "Shapes.h"      /* struct shape */
  44. # include "Types.h"       /* LastIndex    */
  45.  
  46. # include "IndexSha.h" /* FindShapeExp */
  47.  
  48.  
  49. static FILE * yyf = stdout;
  50.  
  51. static void yyAbort
  52. # ifdef __cplusplus
  53.  (char * yyFunction)
  54. # else
  55.  (yyFunction) char * yyFunction;
  56. # endif
  57. {
  58.  (void) fprintf (stderr, "Error: module AdaptLocal, routine %s failed\n", yyFunction);
  59.  exit (1);
  60. }
  61.  
  62. tTree LocalDoLocal ARGS((tTree t, tTree parvar));
  63. tTree LocalArrayAssignment ARGS((tTree t));
  64. tTree MakeRangeStmt ARGS((tTree v, tTree slice));
  65. static void MakeLocalRange ARGS((tTree var, tTree range, tTree * stmt, tTree * local_range));
  66. static void ReplaceLocalRange ARGS((tTree range, tTree local_range));
  67. static bool IsFullLastIndex ARGS((tTree v, tTree slice));
  68. static tTree MakeRangeSlice ARGS((tIdent name, tTree slice));
  69. static tTree MakeLocalSlice ARGS((tIdent name, tTree slice));
  70. static tTree MakeLocalExp ARGS((tTree exp, tTree range, tTree local_range));
  71. static void RestrictActualShape ARGS((tTree formal, tTree actual, tTree local_f));
  72.  
  73. tTree LocalDoLocal
  74. # if defined __STDC__ | defined __cplusplus
  75. (register tTree t, register tTree parvar)
  76. # else
  77. (t, parvar)
  78.  register tTree t;
  79.  register tTree parvar;
  80. # endif
  81. {
  82.   if (t->Kind == kACF_DOLOCAL) {
  83.   if (parvar->Kind == kINDEXED_VAR) {
  84. # line 48 "AdaptLocal.puma"
  85.  {
  86.   tTree newfor;
  87.   {
  88. # line 54 "AdaptLocal.puma"
  89.  if (TreeVarName (t->ACF_DOLOCAL.DOLOCAL_ID) != TreeVarName (LastIndex (parvar->INDEXED_VAR.IND_EXPS)))
  90.         { printf("LocalParfor: INTERNAL ERROR \n");
  91.           FileUnparse (stdout, parvar);
  92.           exit (-1);
  93.         }
  94.  
  95. # line 61 "AdaptLocal.puma"
  96.  
  97. # line 63 "AdaptLocal.puma"
  98.    newfor = MakeRangeStmt (parvar->INDEXED_VAR.IND_VAR, t->ACF_DOLOCAL.DOLOCAL_RANGE);
  99. # line 65 "AdaptLocal.puma"
  100.  if (newfor != NoTree)
  101.         newfor = mACF_LIST (newfor, mACF_LIST (t, NoTree));
  102.       else
  103.         newfor = t;
  104.  
  105. # line 71 "AdaptLocal.puma"
  106.  t->Kind = kACF_DO;
  107.   }
  108.   {
  109.    return newfor;
  110.   }
  111.  }
  112.  
  113.   }
  114.   }
  115. # line 76 "AdaptLocal.puma"
  116.   {
  117. # line 77 "AdaptLocal.puma"
  118.    error_protocol ("Illegal Call of LocalDoLocal");
  119. # line 78 "AdaptLocal.puma"
  120.    printf ("Illegal Call of LocalDoLocal\n");
  121. # line 79 "AdaptLocal.puma"
  122.    FileUnparse (stdout, t);
  123. # line 80 "AdaptLocal.puma"
  124.    FileUnparse (stdout, parvar);
  125.   }
  126.    return NoTree;
  127.  
  128. }
  129.  
  130. tTree LocalArrayAssignment
  131. # if defined __STDC__ | defined __cplusplus
  132. (register tTree t)
  133. # else
  134. (t)
  135.  register tTree t;
  136. # endif
  137. {
  138.   if (t->Kind == kACF_BASIC) {
  139.   if (t->ACF_BASIC.BASIC_STMT->Kind == kASSIGN_STMT) {
  140. # line 99 "AdaptLocal.puma"
  141.   {
  142. # line 100 "AdaptLocal.puma"
  143.    if (! ((TreeDistribution (t->ACF_BASIC.BASIC_STMT->ASSIGN_STMT.ASSIGN_VAR) != 1))) goto yyL1;
  144.   {
  145. # line 101 "AdaptLocal.puma"
  146.    error_protocol ("LocalArrayAssignment: lhs var not distributed");
  147.   }
  148.   }
  149.    return t;
  150. yyL1:;
  151.  
  152.   if (t->ACF_BASIC.BASIC_STMT->ASSIGN_STMT.ASSIGN_VAR->Kind == kINDEXED_VAR) {
  153. # line 105 "AdaptLocal.puma"
  154.   {
  155. # line 106 "AdaptLocal.puma"
  156.    if (! ((TreeDistribution (t->ACF_BASIC.BASIC_STMT->ASSIGN_STMT.ASSIGN_VAR->INDEXED_VAR.IND_EXPS) != 0))) goto yyL2;
  157.   {
  158. # line 107 "AdaptLocal.puma"
  159.    error_protocol ("LocalArrayAssignment: lhs var indexes not replicated");
  160.   }
  161.   }
  162.    return t;
  163. yyL2:;
  164.  
  165. # line 119 "AdaptLocal.puma"
  166.  {
  167.   tTree NewAssign;
  168.   {
  169. # line 121 "AdaptLocal.puma"
  170.  
  171. # line 123 "AdaptLocal.puma"
  172.    if (! ((TreeRank (LastIndex (t->ACF_BASIC.BASIC_STMT->ASSIGN_STMT.ASSIGN_VAR->INDEXED_VAR.IND_EXPS)) == 0))) goto yyL3;
  173.   {
  174. # line 125 "AdaptLocal.puma"
  175.    stmt_protocol ("LocalArrayAssignment (masked)");
  176. # line 127 "AdaptLocal.puma"
  177.    NewAssign = MaskNodeStmt (t, t->ACF_BASIC.BASIC_STMT->ASSIGN_STMT.ASSIGN_VAR);
  178. # line 129 "AdaptLocal.puma"
  179.    tree_protocol ("New Statement : ", NewAssign);
  180.   }
  181.   }
  182.   {
  183.    return NewAssign;
  184.   }
  185.  }
  186. yyL3:;
  187.  
  188. # line 142 "AdaptLocal.puma"
  189.  {
  190.   tTree last_index;
  191.   tTree NewAssign;
  192.   tTree local_range;
  193.   {
  194. # line 144 "AdaptLocal.puma"
  195.  
  196. # line 146 "AdaptLocal.puma"
  197.    last_index = LastIndex (t->ACF_BASIC.BASIC_STMT->ASSIGN_STMT.ASSIGN_VAR->INDEXED_VAR.IND_EXPS);
  198. # line 148 "AdaptLocal.puma"
  199.  
  200. # line 149 "AdaptLocal.puma"
  201.  
  202. # line 151 "AdaptLocal.puma"
  203.  if (last_index->Kind == kSLICE_EXP)
  204.       {
  205.  
  206.         stmt_protocol ("local array assignment (restricted slice)");
  207.  
  208.         MakeLocalRange (t->ACF_BASIC.BASIC_STMT->ASSIGN_STMT.ASSIGN_VAR->INDEXED_VAR.IND_VAR, last_index, &NewAssign, &local_range);
  209.  
  210.  
  211.  
  212.         t->ACF_BASIC.BASIC_STMT->ASSIGN_STMT.ASSIGN_EXP = MakeLocalExp (t->ACF_BASIC.BASIC_STMT->ASSIGN_STMT.ASSIGN_EXP, last_index, local_range);
  213.  
  214.  
  215.  
  216.         ReplaceLocalRange (last_index, local_range);
  217.  
  218.         if (NewAssign != NoTree)
  219.           NewAssign = mACF_LIST (NewAssign, mACF_LIST (t, NoTree));
  220.          else
  221.           NewAssign = mACF_LIST (t, NoTree);
  222.         tree_protocol ("New Statement(s) : ", NewAssign);
  223.       }
  224.      else
  225.       { NewAssign = t;
  226.         error_protocol ("LocalArrayAssignment: vector-valued subscript");
  227.       }
  228.  
  229.   }
  230.   {
  231.    return NewAssign;
  232.   }
  233.  }
  234.  
  235.   }
  236.   }
  237.   }
  238.  yyAbort ("LocalArrayAssignment");
  239. }
  240.  
  241. tTree MakeRangeStmt
  242. # if defined __STDC__ | defined __cplusplus
  243. (register tTree v, register tTree slice)
  244. # else
  245. (v, slice)
  246.  register tTree v;
  247.  register tTree slice;
  248. # endif
  249. {
  250. # line 190 "AdaptLocal.puma"
  251.  
  252. bool  found;
  253. int   value;
  254. tTree new;
  255.  
  256.   if (v->Kind == kUSED_VAR) {
  257.   if (slice->Kind == kSLICE_EXP) {
  258.   if (slice->SLICE_EXP.START->Kind == kDUMMY_EXP) {
  259.   if (slice->SLICE_EXP.STOP->Kind == kDUMMY_EXP) {
  260.   if (slice->SLICE_EXP.INC->Kind == kDUMMY_EXP) {
  261. # line 202 "AdaptLocal.puma"
  262.    return NoTree;
  263.  
  264.   }
  265.   }
  266.   }
  267. # line 207 "AdaptLocal.puma"
  268.  {
  269.   tTree yyV1;
  270.   tTree yyV2;
  271.   {
  272. # line 208 "AdaptLocal.puma"
  273.    MakeLocalRange (v, slice, & yyV1, & yyV2);
  274. # line 209 "AdaptLocal.puma"
  275.    ReplaceLocalRange (slice, yyV2);
  276.   }
  277.   {
  278.    return yyV1;
  279.   }
  280.  }
  281.  
  282.   }
  283.   }
  284. # line 213 "AdaptLocal.puma"
  285.   {
  286. # line 214 "AdaptLocal.puma"
  287.    printf ("MakeRangeStmt fails\n");
  288. # line 215 "AdaptLocal.puma"
  289.    printf ("var = ");
  290. # line 215 "AdaptLocal.puma"
  291.    FileUnparse (stdout, v);
  292. # line 215 "AdaptLocal.puma"
  293.    printf ("\n");
  294. # line 216 "AdaptLocal.puma"
  295.    printf ("slice = ");
  296. # line 216 "AdaptLocal.puma"
  297.    FileUnparse (stdout, slice);
  298. # line 216 "AdaptLocal.puma"
  299.    printf ("\n");
  300. # line 217 "AdaptLocal.puma"
  301.    WriteTree (stdout, v);
  302. # line 218 "AdaptLocal.puma"
  303.    WriteTree (stdout, slice);
  304. # line 219 "AdaptLocal.puma"
  305.    kill_in_protocol ();
  306.   }
  307.    return NoTree;
  308.  
  309. }
  310.  
  311. static void MakeLocalRange
  312. # if defined __STDC__ | defined __cplusplus
  313. (register tTree var, register tTree range, register tTree * stmt, register tTree * local_range)
  314. # else
  315. (var, range, stmt, local_range)
  316.  register tTree var;
  317.  register tTree range;
  318.  register tTree * stmt;
  319.  register tTree * local_range;
  320. # endif
  321. {
  322. # line 236 "AdaptLocal.puma"
  323.  
  324. bool found;
  325. int  value;
  326.  
  327.   if (var == NoTree) return;
  328.   if (range == NoTree) return;
  329.   if (var->Kind == kUSED_VAR) {
  330. # line 241 "AdaptLocal.puma"
  331.  {
  332.   tTree yyV1;
  333.   tTree yyV2;
  334.   {
  335. # line 242 "AdaptLocal.puma"
  336.    MakeLocalRange (var->USED_VAR.VARNAME, range, & yyV1, & yyV2);
  337.   }
  338.    * stmt = yyV1;
  339.    * local_range = yyV2;
  340.    return;
  341.  }
  342.  
  343.   }
  344.   if (var->Kind == kVAR_OBJ) {
  345.   if (range->Kind == kSLICE_EXP) {
  346. # line 245 "AdaptLocal.puma"
  347.  {
  348.   tTree slice;
  349.   tTree new;
  350.   {
  351. # line 247 "AdaptLocal.puma"
  352.  
  353. # line 248 "AdaptLocal.puma"
  354.  
  355. # line 250 "AdaptLocal.puma"
  356.  if ((range->SLICE_EXP.START->Kind == kDUMMY_EXP) || (range->SLICE_EXP.STOP->Kind == kDUMMY_EXP))
  357.        { printf ("MakeLocalRange: range not normalized");
  358.          WriteTree (stdout, range);
  359.        }
  360.  
  361.      if (range->SLICE_EXP.INC->Kind != kDUMMY_EXP)
  362.        { GetIntConstValue (range->SLICE_EXP.INC, &found, &value);
  363.          if (found && (value == 1))
  364.             range->SLICE_EXP.INC = mDUMMY_EXP ();
  365.        }
  366.  
  367.      slice = mSLICE_EXP (range->SLICE_EXP.START, range->SLICE_EXP.STOP, range->SLICE_EXP.INC);
  368.  
  369.      if (IsFullLastIndex (var, slice))
  370.         new = MakeLocalSlice (var->VAR_OBJ.Ident, slice);
  371.       else
  372.         new = MakeRangeSlice (var->VAR_OBJ.Ident, slice);
  373.  
  374.   }
  375.    * stmt = new;
  376.    * local_range = slice;
  377.    return;
  378.  }
  379.  
  380.   }
  381.   }
  382. ;
  383. }
  384.  
  385. static void ReplaceLocalRange
  386. # if defined __STDC__ | defined __cplusplus
  387. (register tTree range, register tTree local_range)
  388. # else
  389. (range, local_range)
  390.  register tTree range;
  391.  register tTree local_range;
  392. # endif
  393. {
  394.   if (range == NoTree) return;
  395.   if (local_range == NoTree) return;
  396.   if (range->Kind == kSLICE_EXP) {
  397.   if (local_range->Kind == kSLICE_EXP) {
  398. # line 272 "AdaptLocal.puma"
  399.   {
  400. # line 273 "AdaptLocal.puma"
  401.  range->SLICE_EXP.START = local_range->SLICE_EXP.START;
  402.      range->SLICE_EXP.STOP = local_range->SLICE_EXP.STOP;
  403.      range->SLICE_EXP.INC = local_range->SLICE_EXP.INC;
  404.  
  405.   }
  406.    return;
  407.  
  408.   }
  409.   }
  410. ;
  411. }
  412.  
  413. static bool IsFullLastIndex
  414. # if defined __STDC__ | defined __cplusplus
  415. (register tTree v, register tTree slice)
  416. # else
  417. (v, slice)
  418.  register tTree v;
  419.  register tTree slice;
  420. # endif
  421. {
  422.   if (v == NoTree) return false;
  423.   if (slice == NoTree) return false;
  424.   if (v->Kind == kVAR_OBJ) {
  425.   if (slice->Kind == kSLICE_EXP) {
  426.   if (slice->SLICE_EXP.INC->Kind == kDUMMY_EXP) {
  427. # line 289 "AdaptLocal.puma"
  428.  {
  429.   int rank;
  430.   struct_shape shp;
  431.   {
  432. # line 291 "AdaptLocal.puma"
  433.  
  434. # line 292 "AdaptLocal.puma"
  435.  
  436. # line 294 "AdaptLocal.puma"
  437.    rank = VarRank (v->VAR_OBJ.Object);
  438. # line 295 "AdaptLocal.puma"
  439.    GetCurrentShape (v, & shp);
  440. # line 297 "AdaptLocal.puma"
  441.    if (! (EqualExpression (slice->SLICE_EXP.START, shp . bounds [rank - 1] [0]) == true)) goto yyL1;
  442.   {
  443. # line 298 "AdaptLocal.puma"
  444.    if (! (EqualExpression (slice->SLICE_EXP.STOP, shp . bounds [rank - 1] [1]) == true)) goto yyL1;
  445.   }
  446.   }
  447.    return true;
  448.  }
  449. yyL1:;
  450.  
  451.   }
  452.   }
  453.   }
  454.   return false;
  455. }
  456.  
  457. static tTree MakeRangeSlice
  458. # if defined __STDC__ | defined __cplusplus
  459. (register tIdent name, register tTree slice)
  460. # else
  461. (name, slice)
  462.  register tIdent name;
  463.  register tTree slice;
  464. # endif
  465. {
  466.   if (slice->Kind == kSLICE_EXP) {
  467.   if (slice->SLICE_EXP.INC->Kind == kDUMMY_EXP) {
  468. # line 310 "AdaptLocal.puma"
  469.  {
  470.   tTree ParamList;
  471.   tTree Param;
  472.   tTree CallStmt;
  473.   {
  474. # line 312 "AdaptLocal.puma"
  475.  
  476. # line 313 "AdaptLocal.puma"
  477.  
  478. # line 315 "AdaptLocal.puma"
  479.    ParamList = mBTP_EMPTY ();
  480. # line 317 "AdaptLocal.puma"
  481.    Param = mVAR_PARAM (MakeUsedVarA (name, "_STOP"));
  482. # line 318 "AdaptLocal.puma"
  483.    ParamList = mBTP_LIST (Param, ParamList);
  484. # line 320 "AdaptLocal.puma"
  485.    Param = mVAR_PARAM (MakeUsedVarA (name, "_START"));
  486. # line 321 "AdaptLocal.puma"
  487.    ParamList = mBTP_LIST (Param, ParamList);
  488. # line 323 "AdaptLocal.puma"
  489.    Param = ExpToVarParam (slice->SLICE_EXP.STOP);
  490. # line 324 "AdaptLocal.puma"
  491.    ParamList = mBTP_LIST (Param, ParamList);
  492. # line 326 "AdaptLocal.puma"
  493.    Param = ExpToVarParam (slice->SLICE_EXP.START);
  494. # line 327 "AdaptLocal.puma"
  495.    ParamList = mBTP_LIST (Param, ParamList);
  496. # line 329 "AdaptLocal.puma"
  497.    Param = ArrayFormals (GetLocalDecl (name));
  498. # line 330 "AdaptLocal.puma"
  499.    ParamList = DalibLastFormalParam (Param, ParamList);
  500. # line 332 "AdaptLocal.puma"
  501.  
  502. # line 334 "AdaptLocal.puma"
  503.    CallStmt = mPROC_OBJ (MakeDalibId ("local_slice"));
  504. # line 335 "AdaptLocal.puma"
  505.    CallStmt = mACF_BASIC (mCALL_STMT (CallStmt, ParamList));
  506. # line 337 "AdaptLocal.puma"
  507.    slice->SLICE_EXP.START = mVAR_EXP (MakeUsedVarA (name, "_START"));
  508. # line 338 "AdaptLocal.puma"
  509.    slice->SLICE_EXP.STOP = mVAR_EXP (MakeUsedVarA (name, "_STOP"));
  510.   }
  511.   {
  512.    return CallStmt;
  513.   }
  514.  }
  515.  
  516.   }
  517. # line 350 "AdaptLocal.puma"
  518.  {
  519.   tTree ParamList;
  520.   tTree Param;
  521.   tTree CallStmt;
  522.   {
  523. # line 352 "AdaptLocal.puma"
  524.  
  525. # line 353 "AdaptLocal.puma"
  526.  
  527. # line 355 "AdaptLocal.puma"
  528.    ParamList = mBTP_EMPTY ();
  529. # line 357 "AdaptLocal.puma"
  530.    Param = mVAR_PARAM (MakeUsedVarA (name, "_INC"));
  531. # line 358 "AdaptLocal.puma"
  532.    ParamList = mBTP_LIST (Param, ParamList);
  533. # line 360 "AdaptLocal.puma"
  534.    Param = mVAR_PARAM (MakeUsedVarA (name, "_STOP"));
  535. # line 361 "AdaptLocal.puma"
  536.    ParamList = mBTP_LIST (Param, ParamList);
  537. # line 363 "AdaptLocal.puma"
  538.    Param = mVAR_PARAM (MakeUsedVarA (name, "_START"));
  539. # line 364 "AdaptLocal.puma"
  540.    ParamList = mBTP_LIST (Param, ParamList);
  541. # line 366 "AdaptLocal.puma"
  542.    Param = ExpToVarParam (slice->SLICE_EXP.INC);
  543. # line 367 "AdaptLocal.puma"
  544.    ParamList = mBTP_LIST (Param, ParamList);
  545. # line 369 "AdaptLocal.puma"
  546.    Param = ExpToVarParam (slice->SLICE_EXP.STOP);
  547. # line 370 "AdaptLocal.puma"
  548.    ParamList = mBTP_LIST (Param, ParamList);
  549. # line 372 "AdaptLocal.puma"
  550.    Param = ExpToVarParam (slice->SLICE_EXP.START);
  551. # line 373 "AdaptLocal.puma"
  552.    ParamList = mBTP_LIST (Param, ParamList);
  553. # line 375 "AdaptLocal.puma"
  554.    Param = ArrayFormals (GetLocalDecl (name));
  555. # line 376 "AdaptLocal.puma"
  556.    ParamList = DalibLastFormalParam (Param, ParamList);
  557. # line 378 "AdaptLocal.puma"
  558.  
  559. # line 380 "AdaptLocal.puma"
  560.    CallStmt = mPROC_OBJ (MakeDalibId ("local_range"));
  561. # line 381 "AdaptLocal.puma"
  562.    CallStmt = mACF_BASIC (mCALL_STMT (CallStmt, ParamList));
  563. # line 383 "AdaptLocal.puma"
  564.    slice->SLICE_EXP.START = mVAR_EXP (MakeUsedVarA (name, "_START"));
  565. # line 384 "AdaptLocal.puma"
  566.    slice->SLICE_EXP.STOP = mVAR_EXP (MakeUsedVarA (name, "_STOP"));
  567. # line 385 "AdaptLocal.puma"
  568.    slice->SLICE_EXP.INC = mVAR_EXP (MakeUsedVarA (name, "_INC"));
  569.   }
  570.   {
  571.    return CallStmt;
  572.   }
  573.  }
  574.  
  575.   }
  576.  yyAbort ("MakeRangeSlice");
  577. }
  578.  
  579. static tTree MakeLocalSlice
  580. # if defined __STDC__ | defined __cplusplus
  581. (register tIdent name, register tTree slice)
  582. # else
  583. (name, slice)
  584.  register tIdent name;
  585.  register tTree slice;
  586. # endif
  587. {
  588.   if (slice->Kind == kSLICE_EXP) {
  589.   if (slice->SLICE_EXP.INC->Kind == kDUMMY_EXP) {
  590. # line 399 "AdaptLocal.puma"
  591.   {
  592. # line 401 "AdaptLocal.puma"
  593.    slice->SLICE_EXP.START = mVAR_EXP (MakeUsedVarA (name, "_LOW"));
  594. # line 402 "AdaptLocal.puma"
  595.    slice->SLICE_EXP.STOP = mVAR_EXP (MakeUsedVarA (name, "_HIGH"));
  596.   }
  597.    return NoTree;
  598.  
  599.   }
  600.   }
  601.  yyAbort ("MakeLocalSlice");
  602. }
  603.  
  604. static tTree MakeLocalExp
  605. # if defined __STDC__ | defined __cplusplus
  606. (register tTree exp, register tTree range, register tTree local_range)
  607. # else
  608. (exp, range, local_range)
  609.  register tTree exp;
  610.  register tTree range;
  611.  register tTree local_range;
  612. # endif
  613. {
  614.  
  615.   switch (exp->Kind) {
  616.   case kOP_EXP:
  617. # line 423 "AdaptLocal.puma"
  618.   {
  619. # line 424 "AdaptLocal.puma"
  620.  exp->OP_EXP.OPND1 = MakeLocalExp (exp->OP_EXP.OPND1, range, local_range);
  621. # line 425 "AdaptLocal.puma"
  622.  exp->OP_EXP.OPND2 = MakeLocalExp (exp->OP_EXP.OPND2, range, local_range);
  623.   }
  624.    return exp;
  625.  
  626.   case kOP1_EXP:
  627. # line 429 "AdaptLocal.puma"
  628.   {
  629. # line 430 "AdaptLocal.puma"
  630.  exp->OP1_EXP.OPND = MakeLocalExp (exp->OP1_EXP.OPND, range, local_range);
  631.   }
  632.    return exp;
  633.  
  634.   case kCONST_EXP:
  635. # line 434 "AdaptLocal.puma"
  636.    return exp;
  637.  
  638.   case kADDR:
  639. # line 438 "AdaptLocal.puma"
  640.   {
  641. # line 439 "AdaptLocal.puma"
  642.  exp->ADDR.E = MakeLocalExp (exp->ADDR.E, range, local_range);
  643.   }
  644.    return exp;
  645.  
  646.   case kVAR_EXP:
  647. # line 443 "AdaptLocal.puma"
  648.   {
  649. # line 444 "AdaptLocal.puma"
  650.  exp->VAR_EXP.V = MakeLocalExp (exp->VAR_EXP.V, range, local_range);
  651.   }
  652.    return exp;
  653.  
  654.   case kFUNC_CALL_EXP:
  655. # line 448 "AdaptLocal.puma"
  656.   {
  657. # line 449 "AdaptLocal.puma"
  658.    if (! (IsIntrFunc (exp) == true)) goto yyL6;
  659.   {
  660. # line 450 "AdaptLocal.puma"
  661.    if (! ((IntrFuncKind1 (exp->FUNC_CALL_EXP.FUNC_ID->PROC_OBJ.Ident)
  662.        || IntrFuncKind2 (exp->FUNC_CALL_EXP.FUNC_ID->PROC_OBJ.Ident)
  663.        || IntrFuncKindn (exp->FUNC_CALL_EXP.FUNC_ID->PROC_OBJ.Ident)
  664.       ))) goto yyL6;
  665.   {
  666. # line 451 "AdaptLocal.puma"
  667.  exp->FUNC_CALL_EXP.FUNC_PARAMS = MakeLocalExp (exp->FUNC_CALL_EXP.FUNC_PARAMS, range, local_range);
  668.   }
  669.   }
  670.   }
  671.    return exp;
  672. yyL6:;
  673.  
  674.   break;
  675.   case kBTP_LIST:
  676.   if (exp->BTP_LIST.Elem->Kind == kVAR_PARAM) {
  677. # line 455 "AdaptLocal.puma"
  678.   {
  679. # line 456 "AdaptLocal.puma"
  680.  exp->BTP_LIST.Elem->VAR_PARAM.V = MakeLocalExp (exp->BTP_LIST.Elem->VAR_PARAM.V, range, local_range);
  681. # line 457 "AdaptLocal.puma"
  682.  exp->BTP_LIST.Next  = MakeLocalExp (exp->BTP_LIST.Next, range, local_range);
  683.   }
  684.    return exp;
  685.  
  686.   }
  687.   break;
  688.   case kBTP_EMPTY:
  689. # line 461 "AdaptLocal.puma"
  690.    return exp;
  691.  
  692.   case kARRAY_EXP:
  693.   if (exp->ARRAY_EXP.ELEMENTS->Kind == kBTE_LIST) {
  694.   if (exp->ARRAY_EXP.ELEMENTS->BTE_LIST.Elem->Kind == kSLICE_EXP) {
  695.   if (exp->ARRAY_EXP.ELEMENTS->BTE_LIST.Next->Kind == kBTE_EMPTY) {
  696. # line 471 "AdaptLocal.puma"
  697.   {
  698. # line 472 "AdaptLocal.puma"
  699.    RestrictActualShape (range, exp->ARRAY_EXP.ELEMENTS->BTE_LIST.Elem, local_range);
  700.   }
  701.    return exp;
  702.  
  703.   }
  704.   }
  705.   }
  706.   break;
  707.   case kUSED_VAR:
  708. # line 482 "AdaptLocal.puma"
  709.   {
  710. # line 483 "AdaptLocal.puma"
  711.    if (! ((TreeRank (exp->USED_VAR.VARNAME) == 0))) goto yyL10;
  712.   }
  713.    return exp;
  714. yyL10:;
  715.  
  716. # line 495 "AdaptLocal.puma"
  717.    return MakeLocalExp (MakeFullShape (exp), range, local_range);
  718.  
  719.   case kINDEXED_VAR:
  720. # line 499 "AdaptLocal.puma"
  721.  {
  722.   tTree h;
  723.   {
  724. # line 501 "AdaptLocal.puma"
  725.  
  726. # line 503 "AdaptLocal.puma"
  727.  h = MakeFullShape (exp);
  728. # line 505 "AdaptLocal.puma"
  729.    RestrictActualShape (range, LastIndex (exp->INDEXED_VAR.IND_EXPS), local_range);
  730.   }
  731.   {
  732.    return exp;
  733.   }
  734.  }
  735.  
  736.   }
  737.  
  738. # line 510 "AdaptLocal.puma"
  739.   {
  740. # line 511 "AdaptLocal.puma"
  741.    printf ("MakeLocalExp failed\n");
  742. # line 512 "AdaptLocal.puma"
  743.    FileUnparse (stdout, exp);
  744. # line 513 "AdaptLocal.puma"
  745.    WriteTree (stdout, exp);
  746.   }
  747.    return exp;
  748.  
  749. }
  750.  
  751. static void RestrictActualShape
  752. # if defined __STDC__ | defined __cplusplus
  753. (register tTree formal, register tTree actual, register tTree local_f)
  754. # else
  755. (formal, actual, local_f)
  756.  register tTree formal;
  757.  register tTree actual;
  758.  register tTree local_f;
  759. # endif
  760. {
  761.   if (formal == NoTree) return;
  762.   if (actual == NoTree) return;
  763.   if (local_f == NoTree) return;
  764.   if (formal->Kind == kSLICE_EXP) {
  765.   if (actual->Kind == kSLICE_EXP) {
  766.   if (local_f->Kind == kSLICE_EXP) {
  767. # line 532 "AdaptLocal.puma"
  768.  {
  769.   tTree new_lb;
  770.   tTree new_ub;
  771.   {
  772. # line 535 "AdaptLocal.puma"
  773.  
  774. # line 536 "AdaptLocal.puma"
  775.  
  776. # line 538 "AdaptLocal.puma"
  777.  new_lb = CopyTree (local_f->SLICE_EXP.START);
  778.      new_lb = FindShapeExp (actual, formal->SLICE_EXP.START, formal->SLICE_EXP.STOP, formal->SLICE_EXP.INC, new_lb);
  779.      new_ub = CopyTree (local_f->SLICE_EXP.STOP);
  780.      new_ub = FindShapeExp (actual, formal->SLICE_EXP.START, formal->SLICE_EXP.STOP, formal->SLICE_EXP.INC, new_ub);
  781.  
  782.      actual->SLICE_EXP.START = new_lb;
  783.      actual->SLICE_EXP.STOP = new_ub;
  784.  
  785.   }
  786.    return;
  787.  }
  788.  
  789.   }
  790.   }
  791.   }
  792. ;
  793. }
  794.  
  795. void BeginAdaptLocal ()
  796. {
  797. }
  798.  
  799. void CloseAdaptLocal ()
  800. {
  801. }
  802.