home *** CD-ROM | disk | FTP | other *** search
/ OS/2 Shareware BBS: 10 Tools / 10-Tools.zip / adaptor.zip / adapt.zip / adaptor / src / semdecls.c < prev    next >
Text File  |  1994-01-03  |  38KB  |  1,779 lines
  1. # include "SemDecls.h"
  2. # include "yySDecls.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 "SemDecls.puma"
  36.  
  37. # include "Idents.h"
  38. # include "StringMe.h"
  39. # include "Types.h"
  40. # include "protocol.h"
  41.  
  42.  
  43. # include "SemExp.h"  /* import SemExp  */
  44.  
  45. int IsDistributed;   /* global variable needed for GetArrayKind */
  46.  
  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 SemDecls, routine %s failed\n", yyFunction);
  59.  exit (1);
  60. }
  61.  
  62. void SemDeclarations ARGS((tTree t, tTree current_unit));
  63. static void UpdateCommon ARGS((tDefinitions t, tTree common, bool is_main));
  64. void SemDefinitions ARGS((tDefinitions t));
  65. static void SemObjectType ARGS((tDefinitions o));
  66. static bool CorrectType ARGS((tTree t));
  67. static void GetArrayKind ARGS((tTree t, int * yyP2, int * yyP1));
  68. static int GetOverlap ARGS((tTree elem));
  69. static int LocalSize ARGS((int size, int overlap, int MinProc));
  70. static int TypeCombination ARGS((int kind1, int kind2));
  71. static bool CheckArrayKind ARGS((tTree type, tDefinitions desc, tDefinitions dist));
  72. static void SetDefaultDistribution ARGS((tDefinitions t));
  73. static tDefinitions GetDefaultDistribution ARGS((tTree d));
  74. static tDefinitions MakeLastDimDistribution ARGS((int rank));
  75. static tDefinitions EvalAlignDistribution ARGS((tDefinitions d, int rank));
  76. static int GetCommonDistVars ARGS((tTree t));
  77. static void MatchCommonDecls ARGS((tTree cd1, tTree cd2, bool only_warning));
  78. static int GetCommonSize ARGS((tTree t));
  79. static int GetTypeSize ARGS((tTree t));
  80. static int GetIndexSize ARGS((tTree t));
  81.  
  82. void SemDeclarations
  83. # if defined __STDC__ | defined __cplusplus
  84. (register tTree t, register tTree current_unit)
  85. # else
  86. (t, current_unit)
  87.  register tTree t;
  88.  register tTree current_unit;
  89. # endif
  90. {
  91.   if (t == NoTree) return;
  92.   if (current_unit == NoTree) return;
  93.  
  94.   switch (t->Kind) {
  95.   case kDECL_EMPTY:
  96. # line 61 "SemDecls.puma"
  97.    return;
  98.  
  99.   case kDECL_LIST:
  100. # line 64 "SemDecls.puma"
  101.   {
  102. # line 65 "SemDecls.puma"
  103.    SemDeclarations (t->DECL_LIST.Elem, current_unit);
  104. # line 66 "SemDecls.puma"
  105.    SemDeclarations (t->DECL_LIST.Next, current_unit);
  106.   }
  107.    return;
  108.  
  109.   case kVAR_DECL:
  110. # line 75 "SemDecls.puma"
  111.    return;
  112.  
  113.   case kTEMPLATE_DECL:
  114. # line 79 "SemDecls.puma"
  115.    return;
  116.  
  117.   case kDIMENSION_DECL:
  118. # line 83 "SemDecls.puma"
  119.   {
  120. # line 84 "SemDecls.puma"
  121.    error_protocol ("there should be no longer any DIMENSION_DECL");
  122.   }
  123.    return;
  124.  
  125.   case kPARAMETER_DECL:
  126. # line 87 "SemDecls.puma"
  127.    return;
  128.  
  129.   case kCOMMON_DECL:
  130. # line 91 "SemDecls.puma"
  131.   {
  132. # line 95 "SemDecls.puma"
  133.    UpdateCommon (GetDeclEntry (t->COMMON_DECL.Name, GetCommonEntries ()), t, (current_unit -> Kind == kPROGRAM_DECL));
  134.   }
  135.    return;
  136.  
  137.   case kNAMELIST_DECL:
  138. # line 99 "SemDecls.puma"
  139.    return;
  140.  
  141.   case kEQV_DECL:
  142. # line 103 "SemDecls.puma"
  143.    return;
  144.  
  145.   case kDATA_DECL:
  146. # line 107 "SemDecls.puma"
  147.    return;
  148.  
  149.   case kSAVE_DECL:
  150. # line 110 "SemDecls.puma"
  151.    return;
  152.  
  153.   case kSEQUENCE_DECL:
  154. # line 114 "SemDecls.puma"
  155.    return;
  156.  
  157.   case kNOSEQUENCE_DECL:
  158. # line 117 "SemDecls.puma"
  159.    return;
  160.  
  161.   case kEXT_PROC_DECL:
  162. # line 120 "SemDecls.puma"
  163.    return;
  164.  
  165.   case kEXTERNAL_DECL:
  166. # line 123 "SemDecls.puma"
  167.    return;
  168.  
  169.   case kINTRINSIC_DECL:
  170. # line 126 "SemDecls.puma"
  171.    return;
  172.  
  173.   case kIMPLICIT_DECL:
  174. # line 129 "SemDecls.puma"
  175.    return;
  176.  
  177.   case kDISTRIBUTE_DECL:
  178. # line 133 "SemDecls.puma"
  179.    return;
  180.  
  181.   case kALIGN_DECL:
  182. # line 137 "SemDecls.puma"
  183.    return;
  184.  
  185.   case kSTMT_FUNC_DECL:
  186. # line 141 "SemDecls.puma"
  187.    return;
  188.  
  189.   }
  190.  
  191. # line 145 "SemDecls.puma"
  192.   {
  193. # line 146 "SemDecls.puma"
  194.    failure_protocol ("SemDecls", "SemDeclarations", t);
  195.   }
  196.    return;
  197.  
  198. ;
  199. }
  200.  
  201. static void UpdateCommon
  202. # if defined __STDC__ | defined __cplusplus
  203. (register tDefinitions t, register tTree common, register bool is_main)
  204. # else
  205. (t, common, is_main)
  206.  register tDefinitions t;
  207.  register tTree common;
  208.  register bool is_main;
  209. # endif
  210. {
  211. # line 157 "SemDecls.puma"
  212.  
  213. char msg[150];
  214.  
  215.   if (t == NoDefinitions) return;
  216.   if (common == NoTree) return;
  217. # line 161 "SemDecls.puma"
  218.   {
  219. # line 165 "SemDecls.puma"
  220.    if (! ((t == NoObject))) goto yyL1;
  221.   {
  222. # line 166 "SemDecls.puma"
  223.    tree_error_protocol ("No Object for Common", common);
  224.   }
  225.   }
  226.    return;
  227. yyL1:;
  228.  
  229.   if (t->Kind == kCommonObject) {
  230. # line 169 "SemDecls.puma"
  231.   {
  232. # line 171 "SemDecls.puma"
  233.    if (! ((t->CommonObject.decl == common))) goto yyL2;
  234.   {
  235. # line 173 "SemDecls.puma"
  236.  t->CommonObject.size        = GetCommonSize     (common);
  237.      t->CommonObject.distributed_vars = GetCommonDistVars (common);
  238.      t->CommonObject.main     = is_main;
  239.  
  240.   }
  241.   }
  242.    return;
  243. yyL2:;
  244.  
  245. # line 179 "SemDecls.puma"
  246.  {
  247.   int no;
  248.   int size;
  249.   {
  250. # line 183 "SemDecls.puma"
  251.  
  252. # line 184 "SemDecls.puma"
  253.  
  254. # line 186 "SemDecls.puma"
  255.  t->CommonObject.main = t->CommonObject.main || is_main;
  256.      no = GetCommonDistVars (common);
  257.      if (no != t->CommonObject.distributed_vars)
  258.        { simple_error_protocol ("different distributions in common");
  259.          sprintf (msg,"this use has %d distributed variables", t->CommonObject.distributed_vars);
  260.          tree_protocol (msg, t->CommonObject.decl);
  261.          sprintf (msg,"this use has %d distributed variables", no);
  262.          tree_protocol (msg, common);
  263.        }
  264.      size = GetCommonSize (common);
  265.      if (size != t->CommonObject.size)
  266.        { if (t->CommonObject.distributed_vars > 0)
  267.            simple_error_protocol ("incompatible lengths for common block data");
  268.           else
  269.            simple_warning_protocol
  270.               ("incompatible lengths for common block data");
  271.          sprintf (msg,"first use has size %d : ", t->CommonObject.size);
  272.          tree_protocol (msg, t->CommonObject.decl);
  273.          sprintf (msg,"this use has size %d : ", size);
  274.          tree_protocol (msg, common);
  275.      }
  276.      MatchCommonDecls (t->CommonObject.decl, common, (t->CommonObject.distributed_vars == 0));
  277.  
  278.  
  279.   }
  280.    return;
  281.  }
  282.  
  283.   }
  284. # line 212 "SemDecls.puma"
  285.   {
  286. # line 213 "SemDecls.puma"
  287.    failure_protocol ("SemDecls", "UpdateCommon", common);
  288.   }
  289.    return;
  290.  
  291. ;
  292. }
  293.  
  294. void SemDefinitions
  295. # if defined __STDC__ | defined __cplusplus
  296. (register tDefinitions t)
  297. # else
  298. (t)
  299.  register tDefinitions t;
  300. # endif
  301. {
  302.   if (t == NoDefinitions) return;
  303.  
  304.   switch (t->Kind) {
  305.   case kENTRY_LIST:
  306. # line 226 "SemDecls.puma"
  307.   {
  308. # line 227 "SemDecls.puma"
  309.    SemObjectType (t->ENTRY_LIST.Elem);
  310. # line 229 "SemDecls.puma"
  311.    SetDefaultDistribution (t->ENTRY_LIST.Elem);
  312. # line 230 "SemDecls.puma"
  313.    SemDefinitions (t->ENTRY_LIST.Elem);
  314. # line 231 "SemDecls.puma"
  315.    SemDefinitions (t->ENTRY_LIST.Next);
  316.   }
  317.    return;
  318.  
  319.   case kENTRY_EMPTY:
  320. # line 234 "SemDecls.puma"
  321.    return;
  322.  
  323.   case kVarObject:
  324.   if (t->VarObject.decl->Kind == kVAR_DECL) {
  325. # line 237 "SemDecls.puma"
  326.   {
  327. # line 238 "SemDecls.puma"
  328.  if (!CheckArrayKind (t->VarObject.decl->VAR_DECL.VAL, t->VarObject.Kind, t->VarObject.Dist))
  329.          obj_error_protocol ("Array Declaration illegal ", t);
  330.  
  331.   }
  332.    return;
  333.  
  334.   }
  335.   if (t->VarObject.decl->Kind == kVAR_PARAM_DECL) {
  336. # line 243 "SemDecls.puma"
  337.   {
  338. # line 244 "SemDecls.puma"
  339.  if (!CheckArrayKind (t->VarObject.decl->VAR_PARAM_DECL.VAL, t->VarObject.Kind, t->VarObject.Dist))
  340.           tree_error_protocol ("Array Declaration illegal ", t->VarObject.decl);
  341.  
  342.   }
  343.    return;
  344.  
  345.   }
  346.   if (t->VarObject.decl->Kind == kPARAMETER_DECL) {
  347.   if (t->VarObject.Kind->Kind == kVarConstant) {
  348. # line 249 "SemDecls.puma"
  349.    return;
  350.  
  351.   }
  352.   }
  353.   break;
  354.   case kTemplateObject:
  355.   if (t->TemplateObject.decl->Kind == kTEMPLATE_DECL) {
  356. # line 252 "SemDecls.puma"
  357.    return;
  358.  
  359.   }
  360.   break;
  361.   case kProcessorsObject:
  362.   if (t->ProcessorsObject.decl->Kind == kPROCESSORS_DECL) {
  363. # line 257 "SemDecls.puma"
  364.    return;
  365.  
  366.   }
  367.   break;
  368.   case kFuncObject:
  369.   if (t->FuncObject.decl->Kind == kFUNC_DECL) {
  370. # line 261 "SemDecls.puma"
  371.    return;
  372.  
  373.   }
  374.   if (t->FuncObject.decl->Kind == kEXT_FUNC_DECL) {
  375. # line 265 "SemDecls.puma"
  376.    return;
  377.  
  378.   }
  379.   if (t->FuncObject.decl->Kind == kSTMT_FUNC_DECL) {
  380. # line 269 "SemDecls.puma"
  381.    return;
  382.  
  383.   }
  384.   if (t->FuncObject.decl->Kind == kFUNC_PARAM_DECL) {
  385. # line 273 "SemDecls.puma"
  386.    return;
  387.  
  388.   }
  389.   if (t->FuncObject.decl->Kind == kINTRINSIC_DECL) {
  390. # line 277 "SemDecls.puma"
  391.    return;
  392.  
  393.   }
  394.   break;
  395.   case kProcObject:
  396.   if (t->ProcObject.decl->Kind == kPROC_DECL) {
  397. # line 281 "SemDecls.puma"
  398.    return;
  399.  
  400.   }
  401.   if (t->ProcObject.decl->Kind == kEXT_PROC_DECL) {
  402. # line 284 "SemDecls.puma"
  403.    return;
  404.  
  405.   }
  406.   if (t->ProcObject.decl->Kind == kINTRINSIC_DECL) {
  407. # line 287 "SemDecls.puma"
  408.    return;
  409.  
  410.   }
  411.   if (t->ProcObject.decl->Kind == kPROC_PARAM_DECL) {
  412. # line 290 "SemDecls.puma"
  413.    return;
  414.  
  415.   }
  416.   break;
  417.   }
  418.  
  419.   if (t->Kind == kTypeObject) {
  420. # line 293 "SemDecls.puma"
  421.   {
  422. # line 294 "SemDecls.puma"
  423.    SemDefinitions (t->TypeObject.Components);
  424.   }
  425.    return;
  426.  
  427.   }
  428.   if (t->Kind == kNameListObject) {
  429. # line 297 "SemDecls.puma"
  430.    return;
  431.  
  432.   }
  433.   if (Definitions_IsType (t, kObject)) {
  434. # line 300 "SemDecls.puma"
  435.   {
  436. # line 302 "SemDecls.puma"
  437.    tree_error_protocol ("Unknown/Illegal object in Semantic Analysis : ", t->Object.decl);
  438.   }
  439.    return;
  440.  
  441.   }
  442. ;
  443. }
  444.  
  445. static void SemObjectType
  446. # if defined __STDC__ | defined __cplusplus
  447. (register tDefinitions o)
  448. # else
  449. (o)
  450.  register tDefinitions o;
  451. # endif
  452. {
  453.   if (o == NoDefinitions) return;
  454.   if (o->Kind == kVarObject) {
  455.   if (o->VarObject.decl->Kind == kVAR_DECL) {
  456. # line 315 "SemDecls.puma"
  457.   {
  458. # line 316 "SemDecls.puma"
  459.    if (! ((! CorrectType (o->VarObject.decl->VAR_DECL.VAL)))) goto yyL1;
  460.   {
  461. # line 317 "SemDecls.puma"
  462.    obj_error_protocol ("Illegal type in variable declaration : ", o);
  463.   }
  464.   }
  465.    return;
  466. yyL1:;
  467.  
  468.   }
  469.   if (o->VarObject.decl->Kind == kVAR_PARAM_DECL) {
  470. # line 320 "SemDecls.puma"
  471.   {
  472. # line 321 "SemDecls.puma"
  473.    if (! ((! CorrectType (o->VarObject.decl->VAR_PARAM_DECL.VAL)))) goto yyL2;
  474.   {
  475. # line 322 "SemDecls.puma"
  476.    obj_error_protocol ("Illegal type for dummy declaration : ", o);
  477.   }
  478.   }
  479.    return;
  480. yyL2:;
  481.  
  482.   }
  483.   if (o->VarObject.decl->Kind == kPARAMETER_DECL) {
  484.   if (o->VarObject.Kind->Kind == kVarConstant) {
  485. # line 325 "SemDecls.puma"
  486.   {
  487. # line 326 "SemDecls.puma"
  488.    if (! ((! CorrectType (o->VarObject.Kind->VarConstant.Type)))) goto yyL3;
  489.   {
  490. # line 327 "SemDecls.puma"
  491.    obj_error_protocol ("Illegal type for constant value : ", o);
  492.   }
  493.   }
  494.    return;
  495. yyL3:;
  496.  
  497.   }
  498.   }
  499.   }
  500.   if (o->Kind == kFuncObject) {
  501.   if (o->FuncObject.decl->Kind == kFUNC_DECL) {
  502. # line 330 "SemDecls.puma"
  503.   {
  504. # line 331 "SemDecls.puma"
  505.    if (! ((! CorrectType (o->FuncObject.decl->FUNC_DECL.RESULT_TYPE)))) goto yyL4;
  506.   {
  507. # line 332 "SemDecls.puma"
  508.    obj_error_protocol ("Illegal result type for user function: ", o);
  509.   }
  510.   }
  511.    return;
  512. yyL4:;
  513.  
  514.   }
  515.   if (o->FuncObject.decl->Kind == kEXT_FUNC_DECL) {
  516. # line 335 "SemDecls.puma"
  517.   {
  518. # line 336 "SemDecls.puma"
  519.    if (! ((! CorrectType (o->FuncObject.decl->EXT_FUNC_DECL.RESULT_TYPE)))) goto yyL5;
  520.   {
  521. # line 337 "SemDecls.puma"
  522.    obj_error_protocol ("Illegal result type for external function: ", o);
  523.   }
  524.   }
  525.    return;
  526. yyL5:;
  527.  
  528.   }
  529.   if (o->FuncObject.decl->Kind == kSTMT_FUNC_DECL) {
  530. # line 340 "SemDecls.puma"
  531.   {
  532. # line 341 "SemDecls.puma"
  533.    if (! ((! CorrectType (o->FuncObject.decl->STMT_FUNC_DECL.RESULT_TYPE)))) goto yyL6;
  534.   {
  535. # line 342 "SemDecls.puma"
  536.    obj_error_protocol ("Illegal result type for statement function: ", o);
  537.   }
  538.   }
  539.    return;
  540. yyL6:;
  541.  
  542.   }
  543.   if (o->FuncObject.decl->Kind == kFUNC_PARAM_DECL) {
  544. # line 345 "SemDecls.puma"
  545.   {
  546. # line 346 "SemDecls.puma"
  547.    if (! ((! CorrectType (o->FuncObject.decl->FUNC_PARAM_DECL.RESULT_TYPE)))) goto yyL7;
  548.   {
  549. # line 347 "SemDecls.puma"
  550.    obj_error_protocol ("Illegal result type for formal function: ", o);
  551.   }
  552.   }
  553.    return;
  554. yyL7:;
  555.  
  556.   }
  557.   }
  558. ;
  559. }
  560.  
  561. static bool CorrectType
  562. # if defined __STDC__ | defined __cplusplus
  563. (register tTree t)
  564. # else
  565. (t)
  566.  register tTree t;
  567. # endif
  568. {
  569.   if (t == NoTree) return false;
  570.  
  571.   switch (t->Kind) {
  572.   case kDUMMY_TYPE:
  573. # line 358 "SemDecls.puma"
  574.   {
  575. # line 359 "SemDecls.puma"
  576.    tree_protocol ("Dummy Type not allowed", t);
  577. # line 360 "SemDecls.puma"
  578.    return false;
  579.   }
  580.  
  581.   case kINTEGER_TYPE:
  582.   if (equalint (t->INTEGER_TYPE.size, 4)) {
  583. # line 363 "SemDecls.puma"
  584.    return true;
  585.  
  586.   }
  587. # line 366 "SemDecls.puma"
  588.   {
  589. # line 367 "SemDecls.puma"
  590.    tree_protocol ("Only INTEGER*4 allowed, not : ", t);
  591. # line 368 "SemDecls.puma"
  592.    return false;
  593.   }
  594.  
  595.   case kREAL_TYPE:
  596.   if (equalint (t->REAL_TYPE.size, 4)) {
  597. # line 371 "SemDecls.puma"
  598.    return true;
  599.  
  600.   }
  601.   if (equalint (t->REAL_TYPE.size, 8)) {
  602. # line 372 "SemDecls.puma"
  603.    return true;
  604.  
  605.   }
  606. # line 374 "SemDecls.puma"
  607.   {
  608. # line 375 "SemDecls.puma"
  609.    tree_protocol ("Only REAL*4 | REAL*8 allowed, not : ", t);
  610. # line 376 "SemDecls.puma"
  611.    return false;
  612.   }
  613.  
  614.   case kBOOLEAN_TYPE:
  615.   if (equalint (t->BOOLEAN_TYPE.size, 1)) {
  616. # line 379 "SemDecls.puma"
  617.    return true;
  618.  
  619.   }
  620.   if (equalint (t->BOOLEAN_TYPE.size, 4)) {
  621. # line 380 "SemDecls.puma"
  622.    return true;
  623.  
  624.   }
  625. # line 382 "SemDecls.puma"
  626.   {
  627. # line 383 "SemDecls.puma"
  628.    tree_protocol ("Only LOGICAL*1 | LOGICAL*4 allowed, not : ", t);
  629. # line 384 "SemDecls.puma"
  630.    return false;
  631.   }
  632.  
  633.   case kCOMPLEX_TYPE:
  634.   if (equalint (t->COMPLEX_TYPE.size, 8)) {
  635. # line 387 "SemDecls.puma"
  636.    return true;
  637.  
  638.   }
  639.   if (equalint (t->COMPLEX_TYPE.size, 16)) {
  640. # line 388 "SemDecls.puma"
  641.    return true;
  642.  
  643.   }
  644. # line 390 "SemDecls.puma"
  645.   {
  646. # line 391 "SemDecls.puma"
  647.    tree_protocol ("Only COMPLEX*8 | COMPLEX*16 allowed, not : ", t);
  648. # line 392 "SemDecls.puma"
  649.    return false;
  650.   }
  651.  
  652.   case kCHAR_TYPE:
  653. # line 395 "SemDecls.puma"
  654.    return true;
  655.  
  656.   case kSTRING_TYPE:
  657.   if (t->STRING_TYPE.LENGTH->Kind == kDUMMY_EXP) {
  658. # line 397 "SemDecls.puma"
  659.    return true;
  660.  
  661.   }
  662. # line 399 "SemDecls.puma"
  663.  {
  664.   int rank;
  665.   {
  666. # line 401 "SemDecls.puma"
  667.  
  668. # line 402 "SemDecls.puma"
  669.    SemExp (t->STRING_TYPE.LENGTH, & rank);
  670. # line 403 "SemDecls.puma"
  671.    if (! ((TreeRank (t->STRING_TYPE.LENGTH) != 0))) goto yyL15;
  672.   {
  673. # line 404 "SemDecls.puma"
  674.    tree_protocol ("rank of string length not equal 0 : ", t);
  675. # line 405 "SemDecls.puma"
  676.    return false;
  677.   }
  678.   }
  679.  }
  680. yyL15:;
  681.  
  682. # line 408 "SemDecls.puma"
  683.  {
  684.   int len;
  685.   bool found;
  686.   {
  687. # line 409 "SemDecls.puma"
  688.  
  689. # line 410 "SemDecls.puma"
  690.  
  691. # line 411 "SemDecls.puma"
  692.    GetIntConstValue (t->STRING_TYPE.LENGTH, & found, & len);
  693. # line 412 "SemDecls.puma"
  694.    if (! (found == true)) goto yyL16;
  695.   }
  696.    return true;
  697.  }
  698. yyL16:;
  699.  
  700. # line 415 "SemDecls.puma"
  701.   {
  702. # line 416 "SemDecls.puma"
  703.    tree_protocol ("string length unknown : ", t->STRING_TYPE.LENGTH);
  704. # line 417 "SemDecls.puma"
  705.    return false;
  706.   }
  707.  
  708.   case kARRAY_TYPE:
  709. # line 420 "SemDecls.puma"
  710.   {
  711. # line 421 "SemDecls.puma"
  712.    if (! (CorrectType (t->ARRAY_TYPE.ARRAY_INDEX_TYPES))) goto yyL18;
  713.   {
  714. # line 422 "SemDecls.puma"
  715.    if (! (CorrectType (t->ARRAY_TYPE.ARRAY_COMP_TYPE))) goto yyL18;
  716.   }
  717.   }
  718.    return true;
  719. yyL18:;
  720.  
  721.   break;
  722.   case kTYPE_LIST:
  723. # line 425 "SemDecls.puma"
  724.   {
  725. # line 426 "SemDecls.puma"
  726.    if (! (CorrectType (t->TYPE_LIST.Elem))) goto yyL19;
  727.   {
  728. # line 427 "SemDecls.puma"
  729.    if (! (CorrectType (t->TYPE_LIST.Next))) goto yyL19;
  730.   }
  731.   }
  732.    return true;
  733. yyL19:;
  734.  
  735.   break;
  736.   case kTYPE_EMPTY:
  737. # line 430 "SemDecls.puma"
  738.    return true;
  739.  
  740.   case kINDEX_TYPE:
  741. # line 433 "SemDecls.puma"
  742.  {
  743.   int rank;
  744.   {
  745. # line 435 "SemDecls.puma"
  746.  
  747. # line 436 "SemDecls.puma"
  748.    SemExp (t->INDEX_TYPE.LOWER, & rank);
  749. # line 437 "SemDecls.puma"
  750.    if (! ((rank != 0))) goto yyL21;
  751.   {
  752. # line 438 "SemDecls.puma"
  753.    tree_protocol ("Tree Rank lower bound in DIMENSION > 0 : ", t);
  754. # line 439 "SemDecls.puma"
  755.    return false;
  756.   }
  757.   }
  758.  }
  759. yyL21:;
  760.  
  761. # line 442 "SemDecls.puma"
  762.  {
  763.   int rank;
  764.   {
  765. # line 444 "SemDecls.puma"
  766.  
  767. # line 445 "SemDecls.puma"
  768.    SemExp (t->INDEX_TYPE.UPPER, & rank);
  769. # line 446 "SemDecls.puma"
  770.    if (! ((rank != 0))) goto yyL22;
  771.   {
  772. # line 447 "SemDecls.puma"
  773.    tree_protocol ("Tree Rank upper bound in DIMENSION > 0 : ", t);
  774. # line 448 "SemDecls.puma"
  775.    return false;
  776.   }
  777.   }
  778.  }
  779. yyL22:;
  780.  
  781. # line 451 "SemDecls.puma"
  782.    return true;
  783.  
  784.   case kDYNAMIC:
  785. # line 454 "SemDecls.puma"
  786.    return true;
  787.  
  788.   case kTYPE_ID:
  789. # line 460 "SemDecls.puma"
  790.    return true;
  791.  
  792.   }
  793.  
  794.   return false;
  795. }
  796.  
  797. static void GetArrayKind
  798. # if defined __STDC__ | defined __cplusplus
  799. (register tTree t, register int * yyP2, register int * yyP1)
  800. # else
  801. (t, yyP2, yyP1)
  802.  register tTree t;
  803.  register int * yyP2;
  804.  register int * yyP1;
  805. # endif
  806. {
  807.   if (t == NoTree) return;
  808.   if (t->Kind == kINDEX_TYPE) {
  809.   if (t->INDEX_TYPE.UPPER->Kind == kDUMMY_EXP) {
  810. # line 481 "SemDecls.puma"
  811.    * yyP2 = arr_assumed_size;
  812.    * yyP1 = 0;
  813.    return;
  814.  
  815.   }
  816. # line 485 "SemDecls.puma"
  817.  {
  818.   int k;
  819.   int size;
  820.   int val;
  821.   bool found;
  822.   {
  823. # line 489 "SemDecls.puma"
  824.  
  825. # line 490 "SemDecls.puma"
  826.  
  827. # line 491 "SemDecls.puma"
  828.  
  829. # line 492 "SemDecls.puma"
  830.  
  831. # line 494 "SemDecls.puma"
  832.    GetIntConstValue (t->INDEX_TYPE.LOWER, & found, & val);
  833. # line 495 "SemDecls.puma"
  834.    if (! (found)) goto yyL2;
  835.   {
  836. # line 496 "SemDecls.puma"
  837.    GetIntConstValue (t->INDEX_TYPE.UPPER, & found, & size);
  838. # line 497 "SemDecls.puma"
  839.    if (! (found)) goto yyL2;
  840.   {
  841. # line 498 "SemDecls.puma"
  842.    size = size - val + 1 + t->INDEX_TYPE.left_overlap + t->INDEX_TYPE.right_overlap;
  843.   }
  844.   }
  845.   }
  846.    * yyP2 = arr_fixed_size;
  847.    * yyP1 = size;
  848.    return;
  849.  }
  850. yyL2:;
  851.  
  852. # line 501 "SemDecls.puma"
  853.    * yyP2 = arr_automatic;
  854.    * yyP1 = 0;
  855.    return;
  856.  
  857.   }
  858.   if (t->Kind == kDYNAMIC) {
  859. # line 506 "SemDecls.puma"
  860.    * yyP2 = 2;
  861.    * yyP1 = 0;
  862.    return;
  863.  
  864.   }
  865.   if (t->Kind == kARRAY_TYPE) {
  866. # line 521 "SemDecls.puma"
  867.  {
  868.   int yyV1;
  869.   int yyV2;
  870.   {
  871. # line 523 "SemDecls.puma"
  872.    GetArrayKind (t->ARRAY_TYPE.ARRAY_INDEX_TYPES, & yyV1, & yyV2);
  873.   }
  874.    * yyP2 = yyV1;
  875.    * yyP1 = yyV2;
  876.    return;
  877.  }
  878.  
  879.   }
  880.   if (t->Kind == kTYPE_LIST) {
  881.   if (t->TYPE_LIST.Next->Kind == kTYPE_EMPTY) {
  882. # line 526 "SemDecls.puma"
  883.  {
  884.   int yyV1;
  885.   int yyV2;
  886.   {
  887. # line 528 "SemDecls.puma"
  888.    GetArrayKind (t->TYPE_LIST.Elem, & yyV1, & yyV2);
  889. # line 530 "SemDecls.puma"
  890.  if (IsDistributed)
  891.         yyV2 = LocalSize (yyV2, GetOverlap(t->TYPE_LIST.Elem), MinProc);
  892.  
  893.   }
  894.    * yyP2 = yyV1;
  895.    * yyP1 = yyV2;
  896.    return;
  897.  }
  898.  
  899.   }
  900. # line 535 "SemDecls.puma"
  901.  {
  902.   int yyV1;
  903.   int yyV2;
  904.   int yyV3;
  905.   int yyV4;
  906.   {
  907. # line 537 "SemDecls.puma"
  908.    GetArrayKind (t->TYPE_LIST.Elem, & yyV1, & yyV2);
  909. # line 538 "SemDecls.puma"
  910.    GetArrayKind (t->TYPE_LIST.Next, & yyV3, & yyV4);
  911.   }
  912.    * yyP2 = TypeCombination (yyV1, yyV3);
  913.    * yyP1 = yyV2 * yyV4;
  914.    return;
  915.  }
  916.  
  917.   }
  918. # line 541 "SemDecls.puma"
  919.   {
  920. # line 542 "SemDecls.puma"
  921.    printf ("GetArrayKind fails\n");
  922. # line 543 "SemDecls.puma"
  923.    kill_in_protocol ();
  924.   }
  925.    * yyP2 = 0;
  926.    * yyP1 = 0;
  927.    return;
  928.  
  929. ;
  930. }
  931.  
  932. static int GetOverlap
  933. # if defined __STDC__ | defined __cplusplus
  934. (register tTree elem)
  935. # else
  936. (elem)
  937.  register tTree elem;
  938. # endif
  939. {
  940.   if (elem->Kind == kINDEX_TYPE) {
  941. # line 548 "SemDecls.puma"
  942.    return elem->INDEX_TYPE.left_overlap + elem->INDEX_TYPE.right_overlap;
  943.  
  944.   }
  945.   if (elem->Kind == kDYNAMIC) {
  946. # line 552 "SemDecls.puma"
  947.    return elem->DYNAMIC.left_overlap + elem->DYNAMIC.right_overlap;
  948.  
  949.   }
  950.  yyAbort ("GetOverlap");
  951. }
  952.  
  953. static int LocalSize
  954. # if defined __STDC__ | defined __cplusplus
  955. (register int size, register int overlap, register int MinProc)
  956. # else
  957. (size, overlap, MinProc)
  958.  register int size;
  959.  register int overlap;
  960.  register int MinProc;
  961. # endif
  962. {
  963.   if (equalint (size, 0)) {
  964. # line 558 "SemDecls.puma"
  965.    return 0;
  966.  
  967.   }
  968. # line 562 "SemDecls.puma"
  969.  {
  970.   int lsize;
  971.   {
  972. # line 563 "SemDecls.puma"
  973.  
  974. # line 564 "SemDecls.puma"
  975.  lsize = size - overlap;
  976.      lsize = (lsize + MinProc - 1) / MinProc;
  977.      lsize = lsize + overlap;
  978.  
  979.   }
  980.   {
  981.    return lsize;
  982.   }
  983.  }
  984.  
  985. }
  986.  
  987. static int TypeCombination
  988. # if defined __STDC__ | defined __cplusplus
  989. (register int kind1, register int kind2)
  990. # else
  991. (kind1, kind2)
  992.  register int kind1;
  993.  register int kind2;
  994. # endif
  995. {
  996.   if (equalint (kind1, arr_illegal)) {
  997. # line 573 "SemDecls.puma"
  998.    return arr_illegal;
  999.  
  1000.   }
  1001.   if (equalint (kind2, arr_illegal)) {
  1002. # line 575 "SemDecls.puma"
  1003.    return arr_illegal;
  1004.  
  1005.   }
  1006.   if (equalint (kind1, arr_allocatable)) {
  1007.   if (equalint (kind2, arr_allocatable)) {
  1008. # line 577 "SemDecls.puma"
  1009.    return arr_allocatable;
  1010.  
  1011.   }
  1012.   }
  1013.   if (equalint (kind1, arr_allocatable)) {
  1014. # line 580 "SemDecls.puma"
  1015.    return arr_illegal;
  1016.  
  1017.   }
  1018.   if (equalint (kind2, arr_allocatable)) {
  1019. # line 583 "SemDecls.puma"
  1020.    return arr_illegal;
  1021.  
  1022.   }
  1023.   if (equalint (kind1, arr_assumed_size)) {
  1024. # line 586 "SemDecls.puma"
  1025.    return arr_illegal;
  1026.  
  1027.   }
  1028.   if (equalint (kind1, arr_fixed_size)) {
  1029.   if (equalint (kind2, arr_fixed_size)) {
  1030. # line 589 "SemDecls.puma"
  1031.    return arr_fixed_size;
  1032.  
  1033.   }
  1034.   }
  1035.   if (equalint (kind1, arr_fixed_size)) {
  1036.   if (equalint (kind2, arr_automatic)) {
  1037. # line 592 "SemDecls.puma"
  1038.    return arr_automatic;
  1039.  
  1040.   }
  1041.   }
  1042.   if (equalint (kind1, arr_fixed_size)) {
  1043.   if (equalint (kind2, arr_assumed_size)) {
  1044. # line 595 "SemDecls.puma"
  1045.    return arr_assumed_size;
  1046.  
  1047.   }
  1048.   }
  1049.   if (equalint (kind1, arr_automatic)) {
  1050.   if (equalint (kind2, arr_fixed_size)) {
  1051. # line 598 "SemDecls.puma"
  1052.    return arr_fixed_size;
  1053.  
  1054.   }
  1055.   }
  1056.   if (equalint (kind1, arr_automatic)) {
  1057.   if (equalint (kind2, arr_automatic)) {
  1058. # line 601 "SemDecls.puma"
  1059.    return arr_automatic;
  1060.  
  1061.   }
  1062.   }
  1063.   if (equalint (kind1, arr_automatic)) {
  1064.   if (equalint (kind2, arr_assumed_size)) {
  1065. # line 604 "SemDecls.puma"
  1066.    return arr_assumed_size;
  1067.  
  1068.   }
  1069.   }
  1070.  yyAbort ("TypeCombination");
  1071. }
  1072.  
  1073. static bool CheckArrayKind
  1074. # if defined __STDC__ | defined __cplusplus
  1075. (register tTree type, register tDefinitions desc, register tDefinitions dist)
  1076. # else
  1077. (type, desc, dist)
  1078.  register tTree type;
  1079.  register tDefinitions desc;
  1080.  register tDefinitions dist;
  1081. # endif
  1082. {
  1083. # line 611 "SemDecls.puma"
  1084.  
  1085. int  k, size;
  1086. bool okay;
  1087.  
  1088.   if (type->Kind == kARRAY_TYPE) {
  1089.   if (desc->Kind == kVarDummy) {
  1090. # line 616 "SemDecls.puma"
  1091.   {
  1092. # line 618 "SemDecls.puma"
  1093.  IsDistributed=(dist->Kind == kNodeDistribution);
  1094.      GetArrayKind (type, &k, &size);
  1095.      desc->VarDummy.dynamic = k;
  1096.      dist->Distribution.size = size;
  1097.      okay = true;
  1098.      if (k == arr_illegal)
  1099.        { print_protocol ("illegal specification for dummy variable");
  1100.          okay = false;
  1101.        }
  1102.  
  1103.   }
  1104.    return okay;
  1105.  
  1106.   }
  1107.   if (desc->Kind == kVarLocal) {
  1108. # line 631 "SemDecls.puma"
  1109.   {
  1110. # line 633 "SemDecls.puma"
  1111.  IsDistributed=(dist->Kind == kNodeDistribution);
  1112.      GetArrayKind (type, &k, &size);
  1113.      desc->VarLocal.dynamic = k;
  1114.      dist->Distribution.size = size;
  1115.      okay = true;
  1116.      if (k == arr_assumed_size)
  1117.        { print_protocol ("assumed size not allowed for local variable");
  1118.          okay = false;
  1119.        }
  1120.      if (k == arr_illegal)
  1121.        { print_protocol ("illegal specification for local variable");
  1122.          okay = false;
  1123.        }
  1124.  
  1125.   }
  1126.    return okay;
  1127.  
  1128.   }
  1129.   if (desc->Kind == kVarCommon) {
  1130. # line 650 "SemDecls.puma"
  1131.   {
  1132. # line 652 "SemDecls.puma"
  1133.  IsDistributed=(dist->Kind == kNodeDistribution);
  1134.      GetArrayKind (type, &k, &size);
  1135.      dist->Distribution.size = size;
  1136.      okay = true;
  1137.      if (k != arr_fixed_size)
  1138.        { okay = false;
  1139.          print_protocol ("size of common variable is unknown");
  1140.        }
  1141.  
  1142.   }
  1143.    return okay;
  1144.  
  1145.   }
  1146.   }
  1147. # line 664 "SemDecls.puma"
  1148.    return true;
  1149.  
  1150. }
  1151.  
  1152. static void SetDefaultDistribution
  1153. # if defined __STDC__ | defined __cplusplus
  1154. (register tDefinitions t)
  1155. # else
  1156. (t)
  1157.  register tDefinitions t;
  1158. # endif
  1159. {
  1160.   if (t == NoDefinitions) return;
  1161.   if (t->Kind == kVarObject) {
  1162.   if (t->VarObject.Kind->Kind == kVarCommon) {
  1163.   if (t->VarObject.Dist->Kind == kDefaultDistribution) {
  1164. # line 681 "SemDecls.puma"
  1165.  {
  1166.   tDefinitions Obj;
  1167.   {
  1168. # line 682 "SemDecls.puma"
  1169.  
  1170. # line 683 "SemDecls.puma"
  1171.    Obj = GetDeclEntry (t->VarObject.Kind->VarCommon.Block, GetCommonEntries ());
  1172. # line 684 "SemDecls.puma"
  1173.    if (! ((Obj->CommonObject.sequence == 1))) goto yyL1;
  1174.   {
  1175. # line 685 "SemDecls.puma"
  1176.  t->VarObject.Dist = mSerialDistribution (0,0);
  1177.   }
  1178.   }
  1179.    return;
  1180.  }
  1181. yyL1:;
  1182.  
  1183.   }
  1184.   if (t->VarObject.Dist->Kind == kArrayUseDistribution) {
  1185. # line 688 "SemDecls.puma"
  1186.  {
  1187.   tDefinitions Obj;
  1188.   {
  1189. # line 689 "SemDecls.puma"
  1190.  
  1191. # line 690 "SemDecls.puma"
  1192.    Obj = GetDeclEntry (t->VarObject.Kind->VarCommon.Block, GetCommonEntries ());
  1193. # line 691 "SemDecls.puma"
  1194.    if (! ((Obj->CommonObject.sequence == 1))) goto yyL2;
  1195.   {
  1196. # line 692 "SemDecls.puma"
  1197.  t->VarObject.Dist = mSerialDistribution (0,0);
  1198.   }
  1199.   }
  1200.    return;
  1201.  }
  1202. yyL2:;
  1203.  
  1204.   }
  1205.   }
  1206.   if (t->VarObject.Dist->Kind == kDefaultDistribution) {
  1207. # line 699 "SemDecls.puma"
  1208.   {
  1209. # line 700 "SemDecls.puma"
  1210.    if (! ((target_model == UNI_PROC))) goto yyL3;
  1211.   {
  1212. # line 701 "SemDecls.puma"
  1213.  t->VarObject.Dist = mSerialDistribution (0,0);
  1214.   }
  1215.   }
  1216.    return;
  1217. yyL3:;
  1218.  
  1219. # line 713 "SemDecls.puma"
  1220.   {
  1221. # line 714 "SemDecls.puma"
  1222.    if (! ((ddefault_kind == DDEFAULT_REPLICATED))) goto yyL5;
  1223.   {
  1224. # line 715 "SemDecls.puma"
  1225.  t->VarObject.Dist = mSerialDistribution (0,0);
  1226.   }
  1227.   }
  1228.    return;
  1229. yyL5:;
  1230.  
  1231. # line 727 "SemDecls.puma"
  1232.   {
  1233. # line 728 "SemDecls.puma"
  1234.    if (! ((ddefault_kind == DDEFAULT_CM))) goto yyL7;
  1235.   {
  1236. # line 729 "SemDecls.puma"
  1237.  t->VarObject.Dist = mSerialDistribution (0,0);
  1238.   }
  1239.   }
  1240.    return;
  1241. yyL7:;
  1242.  
  1243. # line 741 "SemDecls.puma"
  1244.   {
  1245. # line 742 "SemDecls.puma"
  1246.  t->VarObject.Dist = GetDefaultDistribution (t->VarObject.decl);
  1247.   }
  1248.    return;
  1249.  
  1250.   }
  1251.   if (t->VarObject.Dist->Kind == kArrayUseDistribution) {
  1252. # line 704 "SemDecls.puma"
  1253.   {
  1254. # line 705 "SemDecls.puma"
  1255.    if (! ((target_model == UNI_PROC))) goto yyL4;
  1256.   {
  1257. # line 706 "SemDecls.puma"
  1258.  t->VarObject.Dist = mSerialDistribution (0,0);
  1259.   }
  1260.   }
  1261.    return;
  1262. yyL4:;
  1263.  
  1264. # line 718 "SemDecls.puma"
  1265.   {
  1266. # line 719 "SemDecls.puma"
  1267.    if (! ((ddefault_kind == DDEFAULT_REPLICATED))) goto yyL6;
  1268.   {
  1269. # line 720 "SemDecls.puma"
  1270.  t->VarObject.Dist = mSerialDistribution (0,0);
  1271.   }
  1272.   }
  1273.    return;
  1274. yyL6:;
  1275.  
  1276. # line 732 "SemDecls.puma"
  1277.   {
  1278. # line 733 "SemDecls.puma"
  1279.    if (! ((ddefault_kind == DDEFAULT_CM))) goto yyL8;
  1280.   {
  1281. # line 734 "SemDecls.puma"
  1282.  t->VarObject.Dist = GetDefaultDistribution (t->VarObject.decl);
  1283.   }
  1284.   }
  1285.    return;
  1286. yyL8:;
  1287.  
  1288. # line 745 "SemDecls.puma"
  1289.   {
  1290. # line 746 "SemDecls.puma"
  1291.  t->VarObject.Dist = GetDefaultDistribution (t->VarObject.decl);
  1292.   }
  1293.    return;
  1294.  
  1295.   }
  1296.   if (t->VarObject.Dist->Kind == kAlignDistribution) {
  1297. # line 773 "SemDecls.puma"
  1298.   {
  1299. # line 774 "SemDecls.puma"
  1300.  t->VarObject.Dist = EvalAlignDistribution (t->VarObject.Dist, VarRank (t));
  1301.   }
  1302.    return;
  1303.  
  1304.   }
  1305.   }
  1306.   if (t->Kind == kTemplateObject) {
  1307.   if (t->TemplateObject.decl->Kind == kTEMPLATE_DECL) {
  1308.   if (t->TemplateObject.Dist->Kind == kDefaultDistribution) {
  1309. # line 753 "SemDecls.puma"
  1310.   {
  1311. # line 755 "SemDecls.puma"
  1312.    if (! ((target_model == UNI_PROC))) goto yyL11;
  1313.   {
  1314. # line 756 "SemDecls.puma"
  1315.  t->TemplateObject.Dist = mSerialDistribution (0,0);
  1316.   }
  1317.   }
  1318.    return;
  1319. yyL11:;
  1320.  
  1321. # line 759 "SemDecls.puma"
  1322.   {
  1323. # line 761 "SemDecls.puma"
  1324.    if (! ((ddefault_kind == DDEFAULT_REPLICATED))) goto yyL12;
  1325.   {
  1326. # line 762 "SemDecls.puma"
  1327.  t->TemplateObject.Dist = mSerialDistribution (0,0);
  1328.   }
  1329.   }
  1330.    return;
  1331. yyL12:;
  1332.  
  1333. # line 765 "SemDecls.puma"
  1334.   {
  1335. # line 767 "SemDecls.puma"
  1336.  t->TemplateObject.Dist = MakeLastDimDistribution (TreeListLength (t->TemplateObject.decl->TEMPLATE_DECL.DIMENSIONS));
  1337.      simple_warning_protocol ("Default Distribution for a Template");
  1338.      obj_protocol ("template is : ", t);
  1339.  
  1340.   }
  1341.    return;
  1342.  
  1343.   }
  1344.   }
  1345.   }
  1346. # line 777 "SemDecls.puma"
  1347.    return;
  1348.  
  1349. ;
  1350. }
  1351.  
  1352. static tDefinitions GetDefaultDistribution
  1353. # if defined __STDC__ | defined __cplusplus
  1354. (register tTree d)
  1355. # else
  1356. (d)
  1357.  register tTree d;
  1358. # endif
  1359. {
  1360.   if (d->Kind == kPARAMETER_DECL) {
  1361. # line 789 "SemDecls.puma"
  1362.    return mSerialDistribution (0, 0);
  1363.  
  1364.   }
  1365.   if (d->Kind == kVAR_DECL) {
  1366. # line 793 "SemDecls.puma"
  1367.    return GetDefaultDistribution (d->VAR_DECL.VAL);
  1368.  
  1369.   }
  1370.   if (d->Kind == kVAR_PARAM_DECL) {
  1371. # line 797 "SemDecls.puma"
  1372.    return GetDefaultDistribution (d->VAR_PARAM_DECL.VAL);
  1373.  
  1374.   }
  1375. # line 801 "SemDecls.puma"
  1376.  {
  1377.   int dist;
  1378.   tTree comptype;
  1379.   tDefinitions result;
  1380.   {
  1381. # line 803 "SemDecls.puma"
  1382.  
  1383. # line 804 "SemDecls.puma"
  1384.  
  1385. # line 805 "SemDecls.puma"
  1386.  
  1387. # line 807 "SemDecls.puma"
  1388.    dist = TreeRank (d);
  1389. # line 811 "SemDecls.puma"
  1390.  if (dist > 0)
  1391.        { comptype = TreeType (d);
  1392.          if (comptype->Kind == kSTRING_TYPE)
  1393.             dist = 0;
  1394.           else if (comptype->Kind == kCHAR_TYPE)
  1395.             dist = 0;
  1396.        }
  1397.  
  1398.   }
  1399.   {
  1400.    return MakeLastDimDistribution (dist);
  1401.   }
  1402.  }
  1403.  
  1404. }
  1405.  
  1406. static tDefinitions MakeLastDimDistribution
  1407. # if defined __STDC__ | defined __cplusplus
  1408. (register int rank)
  1409. # else
  1410. (rank)
  1411.  register int rank;
  1412. # endif
  1413. {
  1414. # line 824 "SemDecls.puma"
  1415.  
  1416. int i;
  1417. DistributedDimensions dims;
  1418.  
  1419.   if (equalint (rank, 0)) {
  1420. # line 829 "SemDecls.puma"
  1421.    return mSerialDistribution (0, 0);
  1422.  
  1423.   }
  1424. # line 833 "SemDecls.puma"
  1425.   {
  1426. # line 834 "SemDecls.puma"
  1427.  dims.no_dims = rank;
  1428.     for (i = 0; i < rank; i++)
  1429.        dims.DimsArray [i] = 0;
  1430.     dims.DimsArray[rank-1] = 1;
  1431.  
  1432.   }
  1433.    return mNodeDistribution (0, 0, DefaultId (), dims);
  1434.  
  1435. }
  1436.  
  1437. static tDefinitions EvalAlignDistribution
  1438. # if defined __STDC__ | defined __cplusplus
  1439. (register tDefinitions d, register int rank)
  1440. # else
  1441. (d, rank)
  1442.  register tDefinitions d;
  1443.  register int rank;
  1444. # endif
  1445. {
  1446. # line 856 "SemDecls.puma"
  1447.  
  1448. int i, trank, source_dim;
  1449. DistributedDimensions dims;
  1450. bool is_serial;
  1451. tObject dist;
  1452.  
  1453.   if (d->Kind == kAlignDistribution) {
  1454.   if (d->AlignDistribution.template->Kind == kTemplateObject) {
  1455.   if (d->AlignDistribution.template->TemplateObject.Dist->Kind == kSerialDistribution) {
  1456. # line 863 "SemDecls.puma"
  1457.    return mSerialDistribution (0, 0);
  1458.  
  1459.   }
  1460.   if (d->AlignDistribution.template->TemplateObject.Dist->Kind == kNodeDistribution) {
  1461. # line 870 "SemDecls.puma"
  1462.   {
  1463. # line 874 "SemDecls.puma"
  1464.  
  1465.  
  1466.      dims.no_dims = rank;
  1467.      for (i=0; i<rank; i++)
  1468.        dims.DimsArray[i] = 0;
  1469.  
  1470.      is_serial = true;
  1471.  
  1472.      trank = d->AlignDistribution.template->TemplateObject.Dist->NodeDistribution.dims.no_dims;
  1473.  
  1474.      for (i=0; i < trank; i++)
  1475.         if (d->AlignDistribution.template->TemplateObject.Dist->NodeDistribution.dims.DimsArray[i] > 0)
  1476.           {
  1477.             source_dim = d->AlignDistribution.dims.DimsArray[i];
  1478.  
  1479.             if (source_dim > 0)
  1480.              { dims.DimsArray[source_dim - 1] = 1;
  1481.                is_serial = false;
  1482.              }
  1483.           }
  1484.  
  1485.      if (is_serial)
  1486.        dist = mSerialDistribution (0,0);
  1487.       else
  1488.        dist = mNodeDistribution (0,0,DefaultId(),dims);
  1489.  
  1490.   }
  1491.    return dist;
  1492.  
  1493.   }
  1494.   if (d->AlignDistribution.template->TemplateObject.Dist->Kind == kDefaultDistribution) {
  1495. # line 903 "SemDecls.puma"
  1496.   {
  1497. # line 906 "SemDecls.puma"
  1498.    obj_error_protocol ("alignment to a not distributed template", d->AlignDistribution.template);
  1499.   }
  1500.    return mSerialDistribution (0, 0);
  1501.  
  1502.   }
  1503.   }
  1504. # line 910 "SemDecls.puma"
  1505.   {
  1506. # line 911 "SemDecls.puma"
  1507.    printf ("EvalAlignDistribution fails\n");
  1508. # line 912 "SemDecls.puma"
  1509.    obj_error_protocol ("can not align this object: ", d->AlignDistribution.template);
  1510. # line 913 "SemDecls.puma"
  1511.    kill_in_protocol ();
  1512.   }
  1513.    return d;
  1514.  
  1515.   }
  1516.  yyAbort ("EvalAlignDistribution");
  1517. }
  1518.  
  1519. static int GetCommonDistVars
  1520. # if defined __STDC__ | defined __cplusplus
  1521. (register tTree t)
  1522. # else
  1523. (t)
  1524.  register tTree t;
  1525. # endif
  1526. {
  1527.   if (t->Kind == kCOMMON_DECL) {
  1528. # line 929 "SemDecls.puma"
  1529.    return GetCommonDistVars (t->COMMON_DECL.IDS);
  1530.  
  1531.   }
  1532.   if (t->Kind == kDECL_LIST) {
  1533. # line 933 "SemDecls.puma"
  1534.    return GetCommonDistVars (t->DECL_LIST.Elem) + GetCommonDistVars (t->DECL_LIST.Next);
  1535.  
  1536.   }
  1537.   if (t->Kind == kDECL_EMPTY) {
  1538. # line 937 "SemDecls.puma"
  1539.    return 0;
  1540.  
  1541.   }
  1542.   if (t->Kind == kVAR_DECL) {
  1543. # line 941 "SemDecls.puma"
  1544.  {
  1545.   int n;
  1546.   tDefinitions Obj;
  1547.   {
  1548. # line 943 "SemDecls.puma"
  1549.  
  1550. # line 944 "SemDecls.puma"
  1551.  
  1552. # line 946 "SemDecls.puma"
  1553.    Obj = GetLocalDecl (t->VAR_DECL.Name);
  1554. # line 947 "SemDecls.puma"
  1555.  if (VarDistribution(Obj) == 0)
  1556.         n = 0;
  1557.        else
  1558.         n = 1;
  1559.  
  1560.   }
  1561.   {
  1562.    return n;
  1563.   }
  1564.  }
  1565.  
  1566.   }
  1567. # line 955 "SemDecls.puma"
  1568.   {
  1569. # line 956 "SemDecls.puma"
  1570.    failure_protocol ("SemDecls", "GetCommonDistVars", t);
  1571.   }
  1572.    return 0;
  1573.  
  1574. }
  1575.  
  1576. static void MatchCommonDecls
  1577. # if defined __STDC__ | defined __cplusplus
  1578. (register tTree cd1, register tTree cd2, register bool only_warning)
  1579. # else
  1580. (cd1, cd2, only_warning)
  1581.  register tTree cd1;
  1582.  register tTree cd2;
  1583.  register bool only_warning;
  1584. # endif
  1585. {
  1586.   if (cd1 == NoTree) return;
  1587.   if (cd2 == NoTree) return;
  1588.   if (cd1->Kind == kCOMMON_DECL) {
  1589.   if (cd2->Kind == kCOMMON_DECL) {
  1590. # line 968 "SemDecls.puma"
  1591.   {
  1592. # line 969 "SemDecls.puma"
  1593.    if (! ((TreeListLength (cd1->COMMON_DECL.IDS) != TreeListLength (cd2->COMMON_DECL.IDS)))) goto yyL1;
  1594.   {
  1595. # line 970 "SemDecls.puma"
  1596.  if (only_warning)
  1597.        simple_warning_protocol ("inconsistent number of entries in common");
  1598.       else
  1599.        simple_error_protocol ("inconsistent number of entries in common");
  1600.      tree_protocol ("first use : ", cd1);
  1601.      tree_protocol ("other use : ", cd2);
  1602.  
  1603.   }
  1604.   }
  1605.    return;
  1606. yyL1:;
  1607.  
  1608. # line 979 "SemDecls.puma"
  1609.    return;
  1610.  
  1611.   }
  1612.   }
  1613. # line 984 "SemDecls.puma"
  1614.   {
  1615. # line 985 "SemDecls.puma"
  1616.    failure_protocol ("SemDecls", "MatchCommonDecls", cd1);
  1617.   }
  1618.    return;
  1619.  
  1620. ;
  1621. }
  1622.  
  1623. static int GetCommonSize
  1624. # if defined __STDC__ | defined __cplusplus
  1625. (register tTree t)
  1626. # else
  1627. (t)
  1628.  register tTree t;
  1629. # endif
  1630. {
  1631.   if (t->Kind == kCOMMON_DECL) {
  1632. # line 1000 "SemDecls.puma"
  1633.    return GetCommonSize (t->COMMON_DECL.IDS);
  1634.  
  1635.   }
  1636.   if (t->Kind == kDECL_LIST) {
  1637. # line 1004 "SemDecls.puma"
  1638.    return GetCommonSize (t->DECL_LIST.Elem) + GetCommonSize (t->DECL_LIST.Next);
  1639.  
  1640.   }
  1641.   if (t->Kind == kDECL_EMPTY) {
  1642. # line 1008 "SemDecls.puma"
  1643.    return 0;
  1644.  
  1645.   }
  1646.   if (t->Kind == kVAR_DECL) {
  1647. # line 1012 "SemDecls.puma"
  1648.  {
  1649.   tDefinitions Obj;
  1650.   {
  1651. # line 1014 "SemDecls.puma"
  1652.  
  1653. # line 1015 "SemDecls.puma"
  1654.    Obj = GetLocalDecl (t->VAR_DECL.Name);
  1655.   }
  1656.   {
  1657.    return GetTypeSize (Obj->VarObject.decl);
  1658.   }
  1659.  }
  1660.  
  1661.   }
  1662. # line 1019 "SemDecls.puma"
  1663.   {
  1664. # line 1020 "SemDecls.puma"
  1665.    failure_protocol ("SemDecls", "GetCommonSize", t);
  1666.   }
  1667.    return 0;
  1668.  
  1669. }
  1670.  
  1671. static int GetTypeSize
  1672. # if defined __STDC__ | defined __cplusplus
  1673. (register tTree t)
  1674. # else
  1675. (t)
  1676.  register tTree t;
  1677. # endif
  1678. {
  1679.   if (t->Kind == kVAR_DECL) {
  1680. # line 1030 "SemDecls.puma"
  1681.    return GetTypeSize (t->VAR_DECL.VAL);
  1682.  
  1683.   }
  1684.   if (t->Kind == kARRAY_TYPE) {
  1685. # line 1034 "SemDecls.puma"
  1686.    return GetIndexSize (t->ARRAY_TYPE.ARRAY_INDEX_TYPES) * TreeSize (t->ARRAY_TYPE.ARRAY_COMP_TYPE);
  1687.  
  1688.   }
  1689. # line 1038 "SemDecls.puma"
  1690.    return TreeSize (t);
  1691.  
  1692. }
  1693.  
  1694. static int GetIndexSize
  1695. # if defined __STDC__ | defined __cplusplus
  1696. (register tTree t)
  1697. # else
  1698. (t)
  1699.  register tTree t;
  1700. # endif
  1701. {
  1702.   if (t->Kind == kTYPE_LIST) {
  1703.   if (t->TYPE_LIST.Next->Kind == kTYPE_EMPTY) {
  1704. # line 1048 "SemDecls.puma"
  1705.    return GetIndexSize (t->TYPE_LIST.Elem);
  1706.  
  1707.   }
  1708. # line 1052 "SemDecls.puma"
  1709.    return GetIndexSize (t->TYPE_LIST.Elem) * GetIndexSize (t->TYPE_LIST.Next);
  1710.  
  1711.   }
  1712.   if (t->Kind == kINDEX_TYPE) {
  1713.   if (t->INDEX_TYPE.UPPER->Kind == kDUMMY_EXP) {
  1714. # line 1056 "SemDecls.puma"
  1715.    return 0;
  1716.  
  1717.   }
  1718. # line 1060 "SemDecls.puma"
  1719.  {
  1720.   int lval;
  1721.   int hval;
  1722.   int size;
  1723.   bool found;
  1724.   {
  1725. # line 1064 "SemDecls.puma"
  1726.  
  1727. # line 1065 "SemDecls.puma"
  1728.  
  1729. # line 1066 "SemDecls.puma"
  1730.  
  1731. # line 1067 "SemDecls.puma"
  1732.  
  1733. # line 1069 "SemDecls.puma"
  1734.    GetIntConstValue (t->INDEX_TYPE.LOWER, & found, & lval);
  1735. # line 1070 "SemDecls.puma"
  1736.    if (! (found)) goto yyL4;
  1737.   {
  1738. # line 1071 "SemDecls.puma"
  1739.    GetIntConstValue (t->INDEX_TYPE.UPPER, & found, & hval);
  1740. # line 1072 "SemDecls.puma"
  1741.    if (! (found)) goto yyL4;
  1742.   {
  1743. # line 1073 "SemDecls.puma"
  1744.    size = hval - lval + 1 + t->INDEX_TYPE.left_overlap + t->INDEX_TYPE.right_overlap;
  1745.   }
  1746.   }
  1747.   }
  1748.   {
  1749.    return size;
  1750.   }
  1751.  }
  1752. yyL4:;
  1753.  
  1754. # line 1077 "SemDecls.puma"
  1755.    return 0;
  1756.  
  1757.   }
  1758.   if (t->Kind == kDYNAMIC) {
  1759. # line 1081 "SemDecls.puma"
  1760.    return 0;
  1761.  
  1762.   }
  1763. # line 1085 "SemDecls.puma"
  1764.   {
  1765. # line 1086 "SemDecls.puma"
  1766.    failure_protocol ("SemDecls", "GetIndexSize", t);
  1767.   }
  1768.    return 0;
  1769.  
  1770. }
  1771.  
  1772. void BeginSemDecls ()
  1773. {
  1774. }
  1775.  
  1776. void CloseSemDecls ()
  1777. {
  1778. }
  1779.