home *** CD-ROM | disk | FTP | other *** search
/ OS/2 Professional / OS2PRO194.ISO / os2 / prgramer / adaptor / src / wsarrays.c < prev    next >
Encoding:
C/C++ Source or Header  |  1994-01-03  |  27.0 KB  |  1,143 lines
  1. # include "MakeStaA.h"
  2. # include "yyMSarra.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 38 "MakeStaticArrays.puma"
  36.  
  37.  
  38. # include <stdio.h>
  39. # include "Idents.h"
  40. # include "StringMe.h"
  41. # include "Types.h"
  42. # include "Expressi.h"  /* MakeSliceExp */
  43. # include "Transfor.h"    /* ReplaceDECL */
  44. # include "Dalib.h"        /* MakeVarDeclA */
  45.  
  46. tIdent global_unitname;
  47.  
  48.  
  49.  
  50. static FILE * yyf = stdout;
  51.  
  52. static void yyAbort
  53. # ifdef __cplusplus
  54.  (char * yyFunction)
  55. # else
  56.  (yyFunction) char * yyFunction;
  57. # endif
  58. {
  59.  (void) fprintf (stderr, "Error: module MakeStaticArrays, routine %s failed\n", yyFunction);
  60.  exit (1);
  61. }
  62.  
  63. void MakeStatic ARGS((tTree t, tIdent unitname));
  64. static tTree MakeStaticDecls ARGS((tTree t));
  65. static tTree MakeStaticArray ARGS((tTree val, int rank, tTree comptype));
  66. static tTree MakeStaticDIMVars ARGS((int rank, tIdent name, tTree t, tTree f));
  67. tTree InsertStaticDecls ARGS((tIdent name, int rank, tTree type, tTree end_decls));
  68. static tTree MakeStaticACF ARGS((tTree t));
  69. static void MakeStaticIndexing ARGS((tTree t));
  70. tTree MakeInitialStatic ARGS((tIdent name, tTree lb, tTree ub, int overlap));
  71. static tTree MakeAllocateStatic ARGS((tTree t));
  72. static tTree MakeStaticDimensions ARGS((tTree t, tIdent name, int n));
  73. static tTree MakeStaticDimExp ARGS((tTree t, tIdent name, int n));
  74. static tTree MakeStaticOffset ARGS((tTree t, tIdent name));
  75. static tTree MakeStaticOffsetAdd ARGS((tTree t, tIdent name, int n));
  76. static tTree MakeStaticCheck ARGS((tIdent name, int n));
  77. static void ChangeFullIndexExpression ARGS((tTree index, tTree var));
  78. static void ChangeLastIndexExpression ARGS((tTree index, tTree var));
  79. static tTree MakeStaticIndexExpression ARGS((tTree index, tTree var, int n));
  80. static tTree MakeDimExp ARGS((tTree exp, tIdent name, int n));
  81.  
  82. void MakeStatic
  83. # if defined __STDC__ | defined __cplusplus
  84. (register tTree t, register tIdent unitname)
  85. # else
  86. (t, unitname)
  87.  register tTree t;
  88.  register tIdent unitname;
  89. # endif
  90. {
  91.   if (t == NoTree) return;
  92.   if (t->Kind == kBODY_NODE) {
  93. # line 81 "MakeStaticArrays.puma"
  94.   {
  95. # line 82 "MakeStaticArrays.puma"
  96.  global_unitname = unitname;
  97.         t->BODY_NODE.DECLS = MakeStaticDecls (t->BODY_NODE.DECLS);
  98.         t->BODY_NODE.STATS = MakeStaticACF (t->BODY_NODE.STATS);
  99.  
  100.   }
  101.    return;
  102.  
  103.   }
  104. ;
  105. }
  106.  
  107. static tTree MakeStaticDecls
  108. # if defined __STDC__ | defined __cplusplus
  109. (register tTree t)
  110. # else
  111. (t)
  112.  register tTree t;
  113. # endif
  114. {
  115. # line 98 "MakeStaticArrays.puma"
  116.  
  117. tTree newdecl;
  118. tObject Obj;
  119.  
  120.   if (t->Kind == kDECL_LIST) {
  121. # line 103 "MakeStaticArrays.puma"
  122.   {
  123. # line 104 "MakeStaticArrays.puma"
  124.  newdecl = MakeStaticDecls (t->DECL_LIST.Elem);
  125.         t->DECL_LIST.Next    = MakeStaticDecls (t->DECL_LIST.Next);
  126.         newdecl = ReplaceDECL (t, newdecl, t->DECL_LIST.Next);
  127.  
  128.   }
  129.    return newdecl;
  130.  
  131.   }
  132.   if (t->Kind == kVAR_DECL) {
  133.   if (t->VAR_DECL.VAL->Kind == kARRAY_TYPE) {
  134. # line 111 "MakeStaticArrays.puma"
  135.   {
  136. # line 115 "MakeStaticArrays.puma"
  137.    Obj = GetLocalDecl (t->VAR_DECL.Name);
  138. # line 117 "MakeStaticArrays.puma"
  139.    if (! ((IsVarAllocatable (Obj) == true))) goto yyL2;
  140.   {
  141. # line 118 "MakeStaticArrays.puma"
  142.    if (! ((array_kind == STATIC_ARRAYS))) goto yyL2;
  143.   }
  144.   }
  145.    return MakeStaticArray (t, VarRank (Obj), ArrayCompType (Obj));
  146. yyL2:;
  147.  
  148.   }
  149.   }
  150. # line 123 "MakeStaticArrays.puma"
  151.    return t;
  152.  
  153. }
  154.  
  155. static tTree MakeStaticArray
  156. # if defined __STDC__ | defined __cplusplus
  157. (register tTree val, register int rank, register tTree comptype)
  158. # else
  159. (val, rank, comptype)
  160.  register tTree val;
  161.  register int rank;
  162.  register tTree comptype;
  163. # endif
  164. {
  165.   if (val->Kind == kVAR_DECL) {
  166. # line 141 "MakeStaticArrays.puma"
  167.  {
  168.   tTree new_var;
  169.   tTree new_decl;
  170.   {
  171. # line 143 "MakeStaticArrays.puma"
  172.  
  173. # line 144 "MakeStaticArrays.puma"
  174.  
  175. # line 146 "MakeStaticArrays.puma"
  176.  new_decl = InsertStaticDecls (val->VAR_DECL.Name, rank, mINTEGER_TYPE (4), NoTree);
  177.  
  178.  
  179.  
  180.  
  181.  
  182.      new_var = mINDEX_TYPE (MakeConstant (1),
  183.                             MakeConstant (StaticArraySize));
  184.  
  185.      new_var = mARRAY_TYPE (mTYPE_LIST (new_var, mTYPE_EMPTY()), comptype);
  186.  
  187.      new_var = mVAR_DECL (val->VAR_DECL.Name, val->VAR_DECL.Pos, new_var);
  188.  
  189.      new_decl = mDECL_LIST (new_var, new_decl);
  190.  
  191.  
  192.   }
  193.   {
  194.    return new_decl;
  195.   }
  196.  }
  197.  
  198.   }
  199.  yyAbort ("MakeStaticArray");
  200. }
  201.  
  202. static tTree MakeStaticDIMVars
  203. # if defined __STDC__ | defined __cplusplus
  204. (register int rank, register tIdent name, register tTree t, register tTree f)
  205. # else
  206. (rank, name, t, f)
  207.  register int rank;
  208.  register tIdent name;
  209.  register tTree t;
  210.  register tTree f;
  211. # endif
  212. {
  213. # line 181 "MakeStaticArrays.puma"
  214.  
  215. tTree newdecl;
  216. char s [10];
  217.  
  218.   if (equalint (rank, 0)) {
  219. # line 186 "MakeStaticArrays.puma"
  220.    return f;
  221.  
  222.   }
  223. # line 190 "MakeStaticArrays.puma"
  224.   {
  225. # line 191 "MakeStaticArrays.puma"
  226.  sprintf (s, "_DIM%d", rank);
  227.      newdecl = MakeVarDeclA (name, s, t);
  228.      newdecl = mDECL_LIST (newdecl, f);
  229.  
  230.   }
  231.    return MakeStaticDIMVars (rank - 1, name, t, newdecl);
  232.  
  233. }
  234.  
  235. tTree InsertStaticDecls
  236. # if defined __STDC__ | defined __cplusplus
  237. (register tIdent name, register int rank, register tTree type, register tTree end_decls)
  238. # else
  239. (name, rank, type, end_decls)
  240.  register tIdent name;
  241.  register int rank;
  242.  register tTree type;
  243.  register tTree end_decls;
  244. # endif
  245. {
  246. # line 213 "MakeStaticArrays.puma"
  247.  {
  248.   tTree new_decls;
  249.   {
  250. # line 215 "MakeStaticArrays.puma"
  251.  
  252. # line 217 "MakeStaticArrays.puma"
  253.  new_decls = mDECL_LIST (MakeVarDeclA (name, "_OFS", type), end_decls);
  254.      new_decls = MakeStaticDIMVars (rank, name, type, new_decls);
  255.  
  256.   }
  257.   {
  258.    return new_decls;
  259.   }
  260.  }
  261.  
  262. }
  263.  
  264. static tTree MakeStaticACF
  265. # if defined __STDC__ | defined __cplusplus
  266. (register tTree t)
  267. # else
  268. (t)
  269.  register tTree t;
  270. # endif
  271. {
  272.  
  273.   switch (t->Kind) {
  274.   case kACF_LIST:
  275. # line 236 "MakeStaticArrays.puma"
  276.  {
  277.   tTree newacf;
  278.   {
  279. # line 237 "MakeStaticArrays.puma"
  280.  
  281. # line 238 "MakeStaticArrays.puma"
  282.  newacf = MakeStaticACF (t->ACF_LIST.Elem);
  283.        t->ACF_LIST.Next   = MakeStaticACF (t->ACF_LIST.Next);
  284.        newacf = ReplaceACF (t, newacf, t->ACF_LIST.Next);
  285.  
  286.   }
  287.   {
  288.    return newacf;
  289.   }
  290.  }
  291.  
  292.   case kACF_EMPTY:
  293. # line 245 "MakeStaticArrays.puma"
  294.    return t;
  295.  
  296.   case kACF_DUMMY:
  297. # line 249 "MakeStaticArrays.puma"
  298.    return t;
  299.  
  300.   case kACF_IF:
  301. # line 253 "MakeStaticArrays.puma"
  302.   {
  303. # line 254 "MakeStaticArrays.puma"
  304.  t->ACF_IF.IF_EXP   = MakeStaticACF (t->ACF_IF.IF_EXP);
  305.        t->ACF_IF.THEN_PART = MakeStaticACF (t->ACF_IF.THEN_PART);
  306.        t->ACF_IF.ELSE_PART = MakeStaticACF (t->ACF_IF.ELSE_PART);
  307.  
  308.   }
  309.    return t;
  310.  
  311.   case kACF_WHILE:
  312. # line 261 "MakeStaticArrays.puma"
  313.   {
  314. # line 262 "MakeStaticArrays.puma"
  315.  t->ACF_WHILE.WHILE_EXP  = MakeStaticACF (t->ACF_WHILE.WHILE_EXP);
  316.        t->ACF_WHILE.WHILE_BODY = MakeStaticACF (t->ACF_WHILE.WHILE_BODY);
  317.  
  318.   }
  319.    return t;
  320.  
  321.   case kACF_WHERE:
  322. # line 268 "MakeStaticArrays.puma"
  323.   {
  324. # line 269 "MakeStaticArrays.puma"
  325.  t->ACF_WHERE.WHERE_EXP   = MakeStaticACF (t->ACF_WHERE.WHERE_EXP);
  326.        t->ACF_WHERE.TRUE_PART = MakeStaticACF (t->ACF_WHERE.TRUE_PART);
  327.        t->ACF_WHERE.FALSE_PART = MakeStaticACF (t->ACF_WHERE.FALSE_PART);
  328.  
  329.   }
  330.    return t;
  331.  
  332.   case kACF_DOLOCAL:
  333. # line 276 "MakeStaticArrays.puma"
  334.   {
  335. # line 277 "MakeStaticArrays.puma"
  336.  t->ACF_DOLOCAL.DOLOCAL_RANGE = MakeStaticACF (t->ACF_DOLOCAL.DOLOCAL_RANGE);
  337.        t->ACF_DOLOCAL.DOLOCAL_BODY  = MakeStaticACF (t->ACF_DOLOCAL.DOLOCAL_BODY);
  338.  
  339.   }
  340.    return t;
  341.  
  342.   case kACF_DO:
  343. # line 283 "MakeStaticArrays.puma"
  344.   {
  345. # line 284 "MakeStaticArrays.puma"
  346.  t->ACF_DO.DO_RANGE = MakeStaticACF (t->ACF_DO.DO_RANGE);
  347.        t->ACF_DO.DO_BODY  = MakeStaticACF (t->ACF_DO.DO_BODY);
  348.  
  349.   }
  350.    return t;
  351.  
  352.   case kACF_DOVEC:
  353. # line 290 "MakeStaticArrays.puma"
  354.   {
  355. # line 291 "MakeStaticArrays.puma"
  356.  t->ACF_DOVEC.DOVEC_RANGE = MakeStaticACF (t->ACF_DOVEC.DOVEC_RANGE);
  357.        t->ACF_DOVEC.DOVEC_BODY  = MakeStaticACF (t->ACF_DOVEC.DOVEC_BODY);
  358.  
  359.   }
  360.    return t;
  361.  
  362.   case kACF_CASE:
  363. # line 297 "MakeStaticArrays.puma"
  364.   {
  365. # line 298 "MakeStaticArrays.puma"
  366.  t->ACF_CASE.CASE_EXP = MakeStaticACF (t->ACF_CASE.CASE_EXP);
  367.        t->ACF_CASE.CASE_ALTS = MakeStaticACF (t->ACF_CASE.CASE_ALTS);
  368.        t->ACF_CASE.CASE_OTHERWISE = MakeStaticACF (t->ACF_CASE.CASE_OTHERWISE);
  369.  
  370.   }
  371.    return t;
  372.  
  373.   case kSELECTED_ACF_LIST:
  374. # line 305 "MakeStaticArrays.puma"
  375.   {
  376. # line 306 "MakeStaticArrays.puma"
  377.  t->SELECTED_ACF_LIST.Elem = MakeStaticACF (t->SELECTED_ACF_LIST.Elem);
  378.        t->SELECTED_ACF_LIST.Next = MakeStaticACF (t->SELECTED_ACF_LIST.Next);
  379.  
  380.   }
  381.    return t;
  382.  
  383.   case kSELECTED_ACF_NODE:
  384. # line 312 "MakeStaticArrays.puma"
  385.   {
  386. # line 313 "MakeStaticArrays.puma"
  387.  t->SELECTED_ACF_NODE.SELECT_LIST  = MakeStaticACF (t->SELECTED_ACF_NODE.SELECT_LIST);
  388.        t->SELECTED_ACF_NODE.SELECT_ACFS = MakeStaticACF (t->SELECTED_ACF_NODE.SELECT_ACFS);
  389.  
  390.   }
  391.    return t;
  392.  
  393.   case kACF_BASIC:
  394.   if (t->ACF_BASIC.BASIC_STMT->Kind == kALLOCATE_STMT) {
  395. # line 325 "MakeStaticArrays.puma"
  396.   {
  397. # line 329 "MakeStaticArrays.puma"
  398.    if (! ((array_kind == STATIC_ARRAYS))) goto yyL13;
  399.   }
  400.    return MakeAllocateStatic (t->ACF_BASIC.BASIC_STMT->ALLOCATE_STMT.PARAMS);
  401. yyL13:;
  402.  
  403. # line 333 "MakeStaticArrays.puma"
  404.    return t;
  405.  
  406.   }
  407.   if (t->ACF_BASIC.BASIC_STMT->Kind == kDEALLOCATE_STMT) {
  408. # line 338 "MakeStaticArrays.puma"
  409.   {
  410. # line 340 "MakeStaticArrays.puma"
  411.    if (! ((array_kind == STATIC_ARRAYS))) goto yyL15;
  412.   }
  413.    return NoTree;
  414. yyL15:;
  415.  
  416. # line 344 "MakeStaticArrays.puma"
  417.    return t;
  418.  
  419.   }
  420. # line 349 "MakeStaticArrays.puma"
  421.   {
  422. # line 350 "MakeStaticArrays.puma"
  423.  t->ACF_BASIC.BASIC_STMT = MakeStaticACF (t->ACF_BASIC.BASIC_STMT);
  424.   }
  425.    return t;
  426.  
  427.   case kASSIGN_STMT:
  428. # line 360 "MakeStaticArrays.puma"
  429.   {
  430. # line 361 "MakeStaticArrays.puma"
  431.  t->ASSIGN_STMT.ASSIGN_VAR = MakeStaticACF (t->ASSIGN_STMT.ASSIGN_VAR);
  432.        t->ASSIGN_STMT.ASSIGN_EXP = MakeStaticACF (t->ASSIGN_STMT.ASSIGN_EXP);
  433.  
  434.   }
  435.    return t;
  436.  
  437.   case kFORMAT_STMT:
  438. # line 367 "MakeStaticArrays.puma"
  439.    return t;
  440.  
  441.   case kSTOP_STMT:
  442. # line 371 "MakeStaticArrays.puma"
  443.    return t;
  444.  
  445.   case kCALL_STMT:
  446. # line 375 "MakeStaticArrays.puma"
  447.   {
  448. # line 376 "MakeStaticArrays.puma"
  449.  t->CALL_STMT.CALL_PARAMS = MakeStaticACF (t->CALL_STMT.CALL_PARAMS);
  450.   }
  451.    return t;
  452.  
  453.   case kIO_STMT:
  454. # line 380 "MakeStaticArrays.puma"
  455.   {
  456. # line 381 "MakeStaticArrays.puma"
  457.  t->IO_STMT.IO_ITEMS = MakeStaticACF (t->IO_STMT.IO_ITEMS);
  458.   }
  459.    return t;
  460.  
  461.   case kRETURN_STMT:
  462. # line 385 "MakeStaticArrays.puma"
  463.    return t;
  464.  
  465.   case kGOTO_STMT:
  466. # line 389 "MakeStaticArrays.puma"
  467.    return t;
  468.  
  469.   case kCOMP_GOTO_STMT:
  470. # line 393 "MakeStaticArrays.puma"
  471.    return t;
  472.  
  473.   case kCOMP_IF_STMT:
  474. # line 397 "MakeStaticArrays.puma"
  475.    return t;
  476.  
  477.   case kBTP_LIST:
  478. # line 407 "MakeStaticArrays.puma"
  479.   {
  480. # line 408 "MakeStaticArrays.puma"
  481.  t->BTP_LIST.Elem = MakeStaticACF (t->BTP_LIST.Elem);
  482.        t->BTP_LIST.Next = MakeStaticACF (t->BTP_LIST.Next);
  483.  
  484.   }
  485.    return t;
  486.  
  487.   case kBTP_EMPTY:
  488. # line 414 "MakeStaticArrays.puma"
  489.    return t;
  490.  
  491.   case kVAR_PARAM:
  492. # line 418 "MakeStaticArrays.puma"
  493.   {
  494. # line 419 "MakeStaticArrays.puma"
  495.  t->VAR_PARAM.V = MakeStaticACF (t->VAR_PARAM.V);
  496.   }
  497.    return t;
  498.  
  499.   case kPROC_PARAM:
  500. # line 423 "MakeStaticArrays.puma"
  501.    return t;
  502.  
  503.   case kVALUE_PARAM:
  504. # line 432 "MakeStaticArrays.puma"
  505.   {
  506. # line 433 "MakeStaticArrays.puma"
  507.  t->VALUE_PARAM.E = MakeStaticACF (t->VALUE_PARAM.E);
  508.   }
  509.    return t;
  510.  
  511.   case kFUNC_PARAM:
  512. # line 437 "MakeStaticArrays.puma"
  513.    return t;
  514.  
  515.   case kBTE_LIST:
  516. # line 451 "MakeStaticArrays.puma"
  517.   {
  518. # line 452 "MakeStaticArrays.puma"
  519.  t->BTE_LIST.Elem = MakeStaticACF (t->BTE_LIST.Elem);
  520.        t->BTE_LIST.Next = MakeStaticACF (t->BTE_LIST.Next);
  521.  
  522.   }
  523.    return t;
  524.  
  525.   case kBTE_EMPTY:
  526. # line 458 "MakeStaticArrays.puma"
  527.    return t;
  528.  
  529.   case kARRAY_EXP:
  530. # line 462 "MakeStaticArrays.puma"
  531.   {
  532. # line 463 "MakeStaticArrays.puma"
  533.  t->ARRAY_EXP.ELEMENTS = MakeStaticACF (t->ARRAY_EXP.ELEMENTS);
  534.   }
  535.    return t;
  536.  
  537.   case kADDR:
  538. # line 467 "MakeStaticArrays.puma"
  539.   {
  540. # line 468 "MakeStaticArrays.puma"
  541.  t->ADDR.E = MakeStaticACF (t->ADDR.E);
  542.   }
  543.    return t;
  544.  
  545.   case kDUMMY_EXP:
  546. # line 472 "MakeStaticArrays.puma"
  547.    return t;
  548.  
  549.   case kCONST_EXP:
  550. # line 476 "MakeStaticArrays.puma"
  551.    return t;
  552.  
  553.   case kSLICE_EXP:
  554. # line 480 "MakeStaticArrays.puma"
  555.   {
  556. # line 481 "MakeStaticArrays.puma"
  557.  t->SLICE_EXP.START = MakeStaticACF (t->SLICE_EXP.START);
  558.        t->SLICE_EXP.STOP  = MakeStaticACF (t->SLICE_EXP.STOP);
  559.        t->SLICE_EXP.INC   = MakeStaticACF (t->SLICE_EXP.INC);
  560.  
  561.   }
  562.    return t;
  563.  
  564.   case kOP_EXP:
  565. # line 488 "MakeStaticArrays.puma"
  566.   {
  567. # line 489 "MakeStaticArrays.puma"
  568.  t->OP_EXP.OPND1 = MakeStaticACF (t->OP_EXP.OPND1);
  569.        t->OP_EXP.OPND2 = MakeStaticACF (t->OP_EXP.OPND2);
  570.  
  571.   }
  572.    return t;
  573.  
  574.   case kOP1_EXP:
  575. # line 495 "MakeStaticArrays.puma"
  576.   {
  577. # line 496 "MakeStaticArrays.puma"
  578.  t->OP1_EXP.OPND = MakeStaticACF (t->OP1_EXP.OPND);
  579.   }
  580.    return t;
  581.  
  582.   case kVAR_EXP:
  583. # line 500 "MakeStaticArrays.puma"
  584.   {
  585. # line 501 "MakeStaticArrays.puma"
  586.  t->VAR_EXP.V = MakeStaticACF (t->VAR_EXP.V);
  587.   }
  588.    return t;
  589.  
  590.   case kFUNC_CALL_EXP:
  591. # line 505 "MakeStaticArrays.puma"
  592.   {
  593. # line 506 "MakeStaticArrays.puma"
  594.  t->FUNC_CALL_EXP.FUNC_PARAMS = MakeStaticACF (t->FUNC_CALL_EXP.FUNC_PARAMS);
  595.   }
  596.    return t;
  597.  
  598.   case kDO_EXP:
  599. # line 510 "MakeStaticArrays.puma"
  600.   {
  601. # line 511 "MakeStaticArrays.puma"
  602.  t->DO_EXP.RANGE = MakeStaticACF (t->DO_EXP.RANGE);
  603.        t->DO_EXP.BODY = MakeStaticACF (t->DO_EXP.BODY);
  604.  
  605.   }
  606.    return t;
  607.  
  608.   case kUSED_VAR:
  609. # line 524 "MakeStaticArrays.puma"
  610.    return t;
  611.  
  612.   case kLOOP_VAR:
  613. # line 528 "MakeStaticArrays.puma"
  614.    return t;
  615.  
  616.   case kSUBSTRING_VAR:
  617. # line 532 "MakeStaticArrays.puma"
  618.   {
  619. # line 533 "MakeStaticArrays.puma"
  620.  t->SUBSTRING_VAR.IND_VAR = MakeStaticACF (t->SUBSTRING_VAR.IND_VAR);
  621.        t->SUBSTRING_VAR.IND_EXP = MakeStaticACF (t->SUBSTRING_VAR.IND_EXP);
  622.  
  623.   }
  624.    return t;
  625.  
  626.   case kINDEXED_VAR:
  627.   if (t->INDEXED_VAR.IND_VAR->Kind == kUSED_VAR) {
  628. # line 539 "MakeStaticArrays.puma"
  629.   {
  630. # line 541 "MakeStaticArrays.puma"
  631.  t->INDEXED_VAR.IND_EXPS = MakeStaticACF (t->INDEXED_VAR.IND_EXPS);
  632.        MakeStaticIndexing (t);
  633.  
  634.   }
  635.    return t;
  636.  
  637.   }
  638.   break;
  639.   case kDO_VAR:
  640. # line 547 "MakeStaticArrays.puma"
  641.   {
  642. # line 548 "MakeStaticArrays.puma"
  643.  t->DO_VAR.RANGE = MakeStaticACF (t->DO_VAR.RANGE);
  644.        t->DO_VAR.BODY = MakeStaticACF (t->DO_VAR.BODY);
  645.  
  646.   }
  647.    return t;
  648.  
  649.   case kBTV_LIST:
  650. # line 554 "MakeStaticArrays.puma"
  651.   {
  652. # line 555 "MakeStaticArrays.puma"
  653.  t->BTV_LIST.Elem = MakeStaticACF (t->BTV_LIST.Elem);
  654.        t->BTV_LIST.Next = MakeStaticACF (t->BTV_LIST.Next);
  655.  
  656.   }
  657.    return t;
  658.  
  659.   case kBTV_EMPTY:
  660. # line 561 "MakeStaticArrays.puma"
  661.    return t;
  662.  
  663.   }
  664.  
  665. # line 565 "MakeStaticArrays.puma"
  666.   {
  667. # line 566 "MakeStaticArrays.puma"
  668.    failure_protocol ("MakeStaticArrays", "MakeStaticACF", t);
  669.   }
  670.    return NoTree;
  671.  
  672. }
  673.  
  674. static void MakeStaticIndexing
  675. # if defined __STDC__ | defined __cplusplus
  676. (register tTree t)
  677. # else
  678. (t)
  679.  register tTree t;
  680. # endif
  681. {
  682.   if (t == NoTree) return;
  683.   if (t->Kind == kINDEXED_VAR) {
  684.   if (t->INDEXED_VAR.IND_VAR->Kind == kUSED_VAR) {
  685. # line 588 "MakeStaticArrays.puma"
  686.   {
  687. # line 589 "MakeStaticArrays.puma"
  688.    if (! ((IsVarAllocatable (t->INDEXED_VAR.IND_VAR->USED_VAR.VARNAME->VAR_OBJ.Object) == true))) goto yyL1;
  689.   {
  690. # line 590 "MakeStaticArrays.puma"
  691.    if (! ((array_kind == STATIC_ARRAYS))) goto yyL1;
  692.   {
  693. # line 591 "MakeStaticArrays.puma"
  694.    ChangeFullIndexExpression (t->INDEXED_VAR.IND_EXPS, t->INDEXED_VAR.IND_VAR);
  695.   }
  696.   }
  697.   }
  698.    return;
  699. yyL1:;
  700.  
  701. # line 604 "MakeStaticArrays.puma"
  702.   {
  703. # line 605 "MakeStaticArrays.puma"
  704.    if (! ((IsVarAllocatable (t->INDEXED_VAR.IND_VAR->USED_VAR.VARNAME->VAR_OBJ.Object) != true))) goto yyL2;
  705.   {
  706. # line 606 "MakeStaticArrays.puma"
  707.    if (! ((IsVarDummy (t->INDEXED_VAR.IND_VAR->USED_VAR.VARNAME->VAR_OBJ.Object) != true))) goto yyL2;
  708.   {
  709. # line 607 "MakeStaticArrays.puma"
  710.    if (! ((TreeDistribution (t->INDEXED_VAR.IND_VAR) == 1))) goto yyL2;
  711.   {
  712. # line 608 "MakeStaticArrays.puma"
  713.    ChangeLastIndexExpression (t->INDEXED_VAR.IND_EXPS, t->INDEXED_VAR.IND_VAR);
  714.   }
  715.   }
  716.   }
  717.   }
  718.    return;
  719. yyL2:;
  720.  
  721.   }
  722.   }
  723. ;
  724. }
  725.  
  726. tTree MakeInitialStatic
  727. # if defined __STDC__ | defined __cplusplus
  728. (register tIdent name, register tTree lb, register tTree ub, register int overlap)
  729. # else
  730. (name, lb, ub, overlap)
  731.  register tIdent name;
  732.  register tTree lb;
  733.  register tTree ub;
  734.  register int overlap;
  735. # endif
  736. {
  737. # line 625 "MakeStaticArrays.puma"
  738.  
  739. tTree var, exp, stmt, newacf;
  740.  
  741. # line 629 "MakeStaticArrays.puma"
  742.   {
  743. # line 630 "MakeStaticArrays.puma"
  744.  var    = MakeUsedVarA (name, "_OFS");
  745.       exp    = mOP_EXP (mOP_MINUS(), MakeConstant (1), CopyTree (lb));
  746.       stmt   = mACF_BASIC (mASSIGN_STMT (var, exp));
  747.       newacf = mACF_LIST (stmt, NoTree);
  748.       var    = MakeUsedVarA (name, "_DIM1");
  749.       exp    = mOP_EXP (mOP_MINUS (), ub, lb);
  750.       exp    = mOP_EXP (mOP_PLUS (), exp, MakeConstant (1+overlap));
  751.       stmt   = mACF_BASIC (mASSIGN_STMT (var, exp));
  752.       newacf = mACF_LIST (stmt, newacf);
  753.  
  754.   }
  755.    return newacf;
  756.  
  757. }
  758.  
  759. static tTree MakeAllocateStatic
  760. # if defined __STDC__ | defined __cplusplus
  761. (register tTree t)
  762. # else
  763. (t)
  764.  register tTree t;
  765. # endif
  766. {
  767.   if (t->Kind == kBTP_LIST) {
  768.   if (t->BTP_LIST.Elem->Kind == kVAR_PARAM) {
  769. # line 660 "MakeStaticArrays.puma"
  770.    return CombineACF (MakeAllocateStatic (t->BTP_LIST.Elem->VAR_PARAM.V), MakeAllocateStatic (t->BTP_LIST.Next));
  771.  
  772.   }
  773.   }
  774.   if (t->Kind == kBTP_EMPTY) {
  775. # line 665 "MakeStaticArrays.puma"
  776.    return NoTree;
  777.  
  778.   }
  779.   if (t->Kind == kINDEXED_VAR) {
  780.   if (t->INDEXED_VAR.IND_VAR->Kind == kUSED_VAR) {
  781.   if (Definitions_IsType (t->INDEXED_VAR.IND_VAR->USED_VAR.VARNAME->VAR_OBJ.Object, kObject)) {
  782. # line 669 "MakeStaticArrays.puma"
  783.    return CombineACF (CombineACF (MakeStaticDimensions (t->INDEXED_VAR.IND_EXPS, t->INDEXED_VAR.IND_VAR->USED_VAR.VARNAME->VAR_OBJ.Ident, 1), MakeStaticOffset (t->INDEXED_VAR.IND_EXPS, t->INDEXED_VAR.IND_VAR->USED_VAR.VARNAME->VAR_OBJ.Ident)),
  784. MakeStaticCheck (t->INDEXED_VAR.IND_VAR->USED_VAR.VARNAME->VAR_OBJ.Ident, TreeListLength (t->INDEXED_VAR.IND_EXPS)));
  785.  
  786.   }
  787.   }
  788.   }
  789.  yyAbort ("MakeAllocateStatic");
  790. }
  791.  
  792. static tTree MakeStaticDimensions
  793. # if defined __STDC__ | defined __cplusplus
  794. (register tTree t, register tIdent name, register int n)
  795. # else
  796. (t, name, n)
  797.  register tTree t;
  798.  register tIdent name;
  799.  register int n;
  800. # endif
  801. {
  802. # line 684 "MakeStaticArrays.puma"
  803.  
  804. tTree var, exp, newacf;
  805. char s [20];
  806.  
  807.   if (t->Kind == kBTE_LIST) {
  808. # line 689 "MakeStaticArrays.puma"
  809.   {
  810. # line 690 "MakeStaticArrays.puma"
  811.  sprintf (s, "_DIM%d", n);
  812.       var    = MakeUsedVarA (name, s);
  813.       exp    = MakeStaticDimExp (t->BTE_LIST.Elem, name, n);
  814.       newacf = mACF_BASIC (mASSIGN_STMT (var, exp));
  815.       newacf = CombineACF (newacf, MakeStaticDimensions (t->BTE_LIST.Next, name, n+1));
  816.  
  817.   }
  818.    return newacf;
  819.  
  820.   }
  821.   if (t->Kind == kBTE_EMPTY) {
  822. # line 699 "MakeStaticArrays.puma"
  823.    return NoTree;
  824.  
  825.   }
  826.  yyAbort ("MakeStaticDimensions");
  827. }
  828.  
  829. static tTree MakeStaticDimExp
  830. # if defined __STDC__ | defined __cplusplus
  831. (register tTree t, register tIdent name, register int n)
  832. # else
  833. (t, name, n)
  834.  register tTree t;
  835.  register tIdent name;
  836.  register int n;
  837. # endif
  838. {
  839. # line 705 "MakeStaticArrays.puma"
  840.  
  841. tTree exp, var;
  842. char s [20];
  843.  
  844.   if (t->Kind == kSLICE_EXP) {
  845. # line 710 "MakeStaticArrays.puma"
  846.    return MakeDimExp (MakeSliceExp (t->SLICE_EXP.START, t->SLICE_EXP.STOP), name, n - 1);
  847.  
  848.   }
  849. # line 715 "MakeStaticArrays.puma"
  850.    return MakeDimExp (t, name, n - 1);
  851.  
  852. }
  853.  
  854. static tTree MakeStaticOffset
  855. # if defined __STDC__ | defined __cplusplus
  856. (register tTree t, register tIdent name)
  857. # else
  858. (t, name)
  859.  register tTree t;
  860.  register tIdent name;
  861. # endif
  862. {
  863. # line 732 "MakeStaticArrays.puma"
  864.  
  865. tTree var, exp, newacf;
  866.  
  867. # line 736 "MakeStaticArrays.puma"
  868.   {
  869. # line 737 "MakeStaticArrays.puma"
  870.  var = MakeUsedVarA (name, "_OFS");
  871.       exp = MakeConstant (1);
  872.       exp = mOP_EXP (mOP_MINUS (), exp, MakeStaticOffsetAdd (t, name, 0));
  873.       newacf = mASSIGN_STMT (var, exp);
  874.       newacf = mACF_BASIC (newacf);
  875.       newacf = mACF_LIST (newacf, NoTree);
  876.  
  877.   }
  878.    return newacf;
  879.  
  880. }
  881.  
  882. static tTree MakeStaticOffsetAdd
  883. # if defined __STDC__ | defined __cplusplus
  884. (register tTree t, register tIdent name, register int n)
  885. # else
  886. (t, name, n)
  887.  register tTree t;
  888.  register tIdent name;
  889.  register int n;
  890. # endif
  891. {
  892.   if (t->Kind == kBTE_LIST) {
  893.   if (t->BTE_LIST.Elem->Kind == kSLICE_EXP) {
  894.   if (t->BTE_LIST.Next->Kind == kBTE_EMPTY) {
  895. # line 749 "MakeStaticArrays.puma"
  896.    return MakeDimExp (t->BTE_LIST.Elem->SLICE_EXP.START, name, n);
  897.  
  898.   }
  899. # line 754 "MakeStaticArrays.puma"
  900.    return mOP_EXP (mOP_PLUS (), MakeDimExp (t->BTE_LIST.Elem->SLICE_EXP.START, name, n), MakeStaticOffsetAdd (t->BTE_LIST.Next, name, n + 1));
  901.  
  902.   }
  903.   }
  904. # line 760 "MakeStaticArrays.puma"
  905.   {
  906. # line 761 "MakeStaticArrays.puma"
  907.    printf ("MakeStaticOffsetAdd failed\n");
  908. # line 762 "MakeStaticArrays.puma"
  909.    WriteTree (stdout, t);
  910. # line 763 "MakeStaticArrays.puma"
  911.    kill_in_protocol ();
  912.   }
  913.    return NoTree;
  914.  
  915. }
  916.  
  917. static tTree MakeStaticCheck
  918. # if defined __STDC__ | defined __cplusplus
  919. (register tIdent name, register int n)
  920. # else
  921. (name, n)
  922.  register tIdent name;
  923.  register int n;
  924. # endif
  925. {
  926. # line 777 "MakeStaticArrays.puma"
  927.  
  928. tTree var, exp, newacf, p, specs, items;
  929. tStringRef sc;
  930. char s[30], msg[100], uname[30];
  931.  
  932. # line 783 "MakeStaticArrays.puma"
  933.   {
  934. # line 784 "MakeStaticArrays.puma"
  935.  sprintf (s, "_DIM%d", n);
  936.     var = MakeUsedVarA (name, s);
  937.     exp = MakeConstant (StaticArraySize);
  938.     exp = mOP_EXP (mOP_GT(), mVAR_EXP(var), exp);
  939.     p = mPROC_OBJ (MakeIdent ("PRINT", 5));
  940.     specs = mVAR_PARAM (mADDR (mDUMMY_EXP()));
  941.     specs = mBTP_LIST (specs, mBTP_EMPTY());
  942.     GetString (name, s);
  943.     GetString (global_unitname, uname);
  944.     sprintf (msg, "%s: %s is out of memory, needs : ", uname, s);
  945.     sc = PutString (msg, strlen (msg));
  946.     items = mCONST_EXP (mSTRING_CONSTANT (sc));
  947.     items = mBTP_LIST (mVAR_PARAM (mADDR (items)),
  948.              mBTP_LIST (mVAR_PARAM (var), mBTP_EMPTY()));
  949.     newacf = mACF_LIST (mACF_BASIC (mIO_STMT (p, specs, items)),
  950.                         mACF_EMPTY());
  951.     newacf = mACF_IF (exp, newacf, mACF_EMPTY());
  952.     newacf = mACF_LIST (newacf, NoTree);
  953.  
  954.   }
  955.    return newacf;
  956.  
  957. }
  958.  
  959. static void ChangeFullIndexExpression
  960. # if defined __STDC__ | defined __cplusplus
  961. (register tTree index, register tTree var)
  962. # else
  963. (index, var)
  964.  register tTree index;
  965.  register tTree var;
  966. # endif
  967. {
  968.   if (index == NoTree) return;
  969.   if (var == NoTree) return;
  970.   if (var->Kind == kUSED_VAR) {
  971. # line 819 "MakeStaticArrays.puma"
  972.   {
  973. # line 820 "MakeStaticArrays.puma"
  974.    ChangeFullIndexExpression (index, var->USED_VAR.VARNAME);
  975.   }
  976.    return;
  977.  
  978.   }
  979.   if (index->Kind == kBTE_LIST) {
  980.   if (var->Kind == kVAR_OBJ) {
  981. # line 823 "MakeStaticArrays.puma"
  982.   {
  983. # line 824 "MakeStaticArrays.puma"
  984.  index->BTE_LIST.Elem  = MakeStaticIndexExpression (index, var, 0);
  985.        index->BTE_LIST.Next = mBTE_EMPTY ();
  986.  
  987.   }
  988.    return;
  989.  
  990.   }
  991.   }
  992. # line 829 "MakeStaticArrays.puma"
  993.   {
  994. # line 830 "MakeStaticArrays.puma"
  995.    printf ("ChangeFullIndexExpression failed\n");
  996. # line 831 "MakeStaticArrays.puma"
  997.    FileUnparse (stdout, index);
  998. # line 832 "MakeStaticArrays.puma"
  999.    WriteTree (stdout, index);
  1000. # line 833 "MakeStaticArrays.puma"
  1001.    exit (- 1);
  1002.   }
  1003.    return;
  1004.  
  1005. ;
  1006. }
  1007.  
  1008. static void ChangeLastIndexExpression
  1009. # if defined __STDC__ | defined __cplusplus
  1010. (register tTree index, register tTree var)
  1011. # else
  1012. (index, var)
  1013.  register tTree index;
  1014.  register tTree var;
  1015. # endif
  1016. {
  1017.   if (index == NoTree) return;
  1018.   if (var == NoTree) return;
  1019.   if (var->Kind == kUSED_VAR) {
  1020. # line 849 "MakeStaticArrays.puma"
  1021.   {
  1022. # line 850 "MakeStaticArrays.puma"
  1023.    ChangeLastIndexExpression (index, var->USED_VAR.VARNAME);
  1024.   }
  1025.    return;
  1026.  
  1027.   }
  1028.   if (index->Kind == kBTE_LIST) {
  1029.   if (index->BTE_LIST.Next->Kind == kBTE_EMPTY) {
  1030.   if (var->Kind == kVAR_OBJ) {
  1031. # line 853 "MakeStaticArrays.puma"
  1032.   {
  1033. # line 854 "MakeStaticArrays.puma"
  1034.  index->BTE_LIST.Elem  = MakeStaticIndexExpression (index, var, 0);
  1035.   }
  1036.    return;
  1037.  
  1038.   }
  1039.   }
  1040.   if (var->Kind == kVAR_OBJ) {
  1041. # line 857 "MakeStaticArrays.puma"
  1042.   {
  1043. # line 859 "MakeStaticArrays.puma"
  1044.    ChangeLastIndexExpression (index->BTE_LIST.Next, var);
  1045.   }
  1046.    return;
  1047.  
  1048.   }
  1049.   }
  1050. # line 862 "MakeStaticArrays.puma"
  1051.   {
  1052. # line 863 "MakeStaticArrays.puma"
  1053.    printf ("ChangeLastIndexExpression failed\n");
  1054. # line 864 "MakeStaticArrays.puma"
  1055.    FileUnparse (stdout, index);
  1056. # line 865 "MakeStaticArrays.puma"
  1057.    WriteTree (stdout, index);
  1058. # line 866 "MakeStaticArrays.puma"
  1059.    exit (- 1);
  1060.   }
  1061.    return;
  1062.  
  1063. ;
  1064. }
  1065.  
  1066. static tTree MakeStaticIndexExpression
  1067. # if defined __STDC__ | defined __cplusplus
  1068. (register tTree index, register tTree var, register int n)
  1069. # else
  1070. (index, var, n)
  1071.  register tTree index;
  1072.  register tTree var;
  1073.  register int n;
  1074. # endif
  1075. {
  1076.   if (index->Kind == kBTE_LIST) {
  1077.   if (var->Kind == kVAR_OBJ) {
  1078. # line 871 "MakeStaticArrays.puma"
  1079.    return mOP_EXP (mOP_PLUS (), MakeStaticIndexExpression (index->BTE_LIST.Next, var, n + 1), MakeDimExp (index->BTE_LIST.Elem, var->VAR_OBJ.Ident, n));
  1080.  
  1081.   }
  1082.   }
  1083.   if (index->Kind == kBTE_EMPTY) {
  1084.   if (var->Kind == kVAR_OBJ) {
  1085. # line 878 "MakeStaticArrays.puma"
  1086.    return mVAR_EXP (MakeUsedVarA (var->VAR_OBJ.Ident, "_OFS"));
  1087.  
  1088.   }
  1089.   }
  1090.  yyAbort ("MakeStaticIndexExpression");
  1091. }
  1092.  
  1093. static tTree MakeDimExp
  1094. # if defined __STDC__ | defined __cplusplus
  1095. (register tTree exp, register tIdent name, register int n)
  1096. # else
  1097. (exp, name, n)
  1098.  register tTree exp;
  1099.  register tIdent name;
  1100.  register int n;
  1101. # endif
  1102. {
  1103. # line 892 "MakeStaticArrays.puma"
  1104.  
  1105. char dimid [10];
  1106. tTree newexp;
  1107. int val;
  1108. bool found;
  1109.  
  1110. # line 899 "MakeStaticArrays.puma"
  1111.   {
  1112. # line 900 "MakeStaticArrays.puma"
  1113.    if (! ((n <= 0))) goto yyL1;
  1114.   }
  1115.    return exp;
  1116. yyL1:;
  1117.  
  1118. # line 903 "MakeStaticArrays.puma"
  1119.   {
  1120. # line 904 "MakeStaticArrays.puma"
  1121.  sprintf (dimid, "_DIM%d", n);
  1122.      newexp = mVAR_EXP (MakeUsedVarA (name, dimid));
  1123.      GetIntConstValue (exp, &found, &val);
  1124.      if (found && (val == 0))
  1125.         newexp = exp;
  1126.       else if (found && (val == 1))
  1127.         newexp = newexp;
  1128.       else
  1129.         newexp = mOP_EXP (mOP_TIMES (), exp, newexp);
  1130.  
  1131.   }
  1132.    return newexp;
  1133.  
  1134. }
  1135.  
  1136. void BeginMakeStaticArrays ()
  1137. {
  1138. }
  1139.  
  1140. void CloseMakeStaticArrays ()
  1141. {
  1142. }
  1143.