lang/pc/comp/declar.g

   1 /* D E C L A R A T I O N S */
   2
   3 {
   4 /* next line DEBUG */
   5 #include        "debug.h"
   6
   7 #include        <alloc.h>
   8 #include        <assert.h>
   9 #include        <em_arith.h>
  10 #include        <em_label.h>
  11 #include        <pc_file.h>
  12
  13 #include        "LLlex.h"
  14 #include        "chk_expr.h"
  15 #include        "def.h"
  16 #include        "idf.h"
  17 #include        "main.h"
  18 #include        "misc.h"
  19 #include        "node.h"
  20 #include        "scope.h"
  21 #include        "type.h"
  22 #include        "dbsymtab.h"
  23
  24 #define PC_BUFSIZ       (sizeof(struct file) - (int)((struct file *)0)->bufadr)
  25
  26 int proclevel = 0;              /* nesting level of procedures */
  27 int parlevel = 0;               /* nesting level of parametersections */
  28 int expect_label = 0;           /* so the parser knows that we expect a label */
  29 static int in_type_defs;        /* in type definition part or not */
  30 }
  31
  32 /* ISO section 6.2.1, p. 93 */
  33 Block(struct def *df;)
  34 {
  35         arith i;
  36 } :
  37                                         { text_label = (label) 0; }
  38         LabelDeclarationPart
  39         Module(df, &i)
  40         CompoundStatement
  41                                         { if( !err_occurred )
  42                                                 CodeEndBlock(df, i);
  43                                           if( df ) EndBlock(df);
  44                                           FreeNode(BlockScope->sc_lablist);
  45                                         }
  46 ;
  47
  48 LabelDeclarationPart
  49 {
  50         struct node *nd;
  51 } :
  52         [
  53                 LABEL Label(&nd)
  54                                 { if( nd )      {
  55                                         DeclLabel(nd);
  56                                         nd->nd_next = CurrentScope->sc_lablist;
  57                                         CurrentScope->sc_lablist = nd;
  58                                   }
  59                                 }
  60                 [ %persistent
  61                         ',' Label(&nd)
  62                                 { if( nd )      {
  63                                         DeclLabel(nd);
  64                                         nd->nd_next = CurrentScope->sc_lablist;
  65                                         CurrentScope->sc_lablist = nd;
  66                                   }
  67                                 }
  68                 ]*
  69                 ';'
  70         ]?
  71 ;
  72
  73 Module(struct def *df; arith *i;)
  74 {
  75         label save_label;
  76 } :
  77         ConstantDefinitionPart
  78                                         { in_type_defs = 1; }
  79         TypeDefinitionPart
  80                                         { in_type_defs = 0;
  81                                           /* resolve forward references */
  82                                           chk_forw_types();
  83                                         }
  84         VariableDeclarationPart
  85                                         { if( !proclevel )      {
  86                                                 chk_prog_params();
  87                                                 BssVar();
  88                                           }
  89                                           proclevel++;
  90                                           save_label = text_label;
  91                                         }
  92         ProcedureAndFunctionDeclarationPart
  93                                         { text_label = save_label;
  94
  95                                           proclevel--;
  96                                           chk_directives();
  97
  98                                           /* needed with labeldefinitions
  99                                              and for-statement
 100                                           */
 101                                           BlockScope = CurrentScope;
 102
 103                                           if( !err_occurred )
 104                                                 *i = CodeBeginBlock( df );
 105                                         }
 106 ;
 107
 108
 109
 110
 111 ConstantDefinitionPart:
 112         [
 113                 CONST
 114                 [ %persistent
 115                         ConstantDefinition ';'
 116                 ]+
 117         ]?
 118 ;
 119
 120 TypeDefinitionPart:
 121         [
 122                 TYPE
 123                 [ %persistent
 124                         TypeDefinition ';'
 125                 ]+
 126         ]?
 127 ;
 128
 129 VariableDeclarationPart:
 130         [
 131                 VAR
 132                 [ %persistent
 133                         VariableDeclaration ';'
 134                 ]+
 135         ]?
 136 ;
 137
 138 ProcedureAndFunctionDeclarationPart:
 139         [
 140                 [
 141                         ProcedureDeclaration
 142                 |
 143                         FunctionDeclaration
 144                 ] ';'
 145         ]*
 146 ;
 147
 148 /* ISO section 6.1.6, p. 92 */
 149 Label(struct node **pnd;)
 150 {
 151         char lab[5];
 152         extern char *sprint();
 153 } :     { expect_label = 1; }
 154         INTEGER         /* not really an integer, in [0..9999] */
 155         { if( dot.TOK_INT < 0 || dot.TOK_INT > 9999 )   {
 156                 if( dot.TOK_INT != -1 )         /* This means insertion */
 157                         error("label must lie in closed interval [0..9999]");
 158                 *pnd = NULLNODE;
 159           }
 160           else  {
 161                 sprint(lab, "%d", (int) dot.TOK_INT);
 162                 *pnd = MkLeaf(Name, &dot);
 163                 (*pnd)->nd_IDF = str2idf(lab, 1);
 164           }
 165           expect_label = 0;
 166         }
 167 ;
 168
 169
 170 /* ISO section 6.3, p. 95 */
 171 ConstantDefinition
 172 {
 173         register struct idf *id;
 174         register struct def *df;
 175         struct node *nd;
 176 } :
 177         IDENT                   { id = dot.TOK_IDF; }
 178         '=' Constant(&nd)
 179                         { if( df = define(id,CurrentScope,D_CONST) )    {
 180                                 df->con_const = nd;
 181                                 df->df_type = nd->nd_type;
 182                                 df->df_flags |= D_SET;
 183 #ifdef DBSYMTAB
 184                                 if (options['g']) stb_string(df, D_CONST);
 185 #endif /* DBSYMTAB */
 186                           }
 187                         }
 188 ;
 189
 190 /* ISO section 6.4.1, p. 96 */
 191 TypeDefinition
 192 {
 193         register struct idf *id;
 194         register struct def *df;
 195         struct type *tp;
 196 } :
 197         IDENT                   { id = dot.TOK_IDF; }
 198         '=' TypeDenoter(&tp)
 199                         { if( df = define(id, CurrentScope, D_TYPE) ) {
 200                                 df->df_type = tp;
 201                                 df->df_flags |= D_SET;
 202 #ifdef DBSYMTAB
 203                                 if (options['g']) stb_string(df, D_TYPE);
 204 #endif /* DBSYMTAB */
 205                           }
 206                         }
 207 ;
 208
 209 TypeDenoter(register struct type **ptp;):
 210         /* This is a changed rule, because the grammar as specified in the
 211          * reference is not LL(1), and this gives conflicts.
 212          */
 213         TypeIdentifierOrSubrangeType(ptp)
 214 |
 215         PointerType(ptp)
 216 |
 217         StructuredType(ptp)
 218 |
 219         EnumeratedType(ptp)
 220 ;
 221
 222 TypeIdentifierOrSubrangeType(register struct type **ptp;)
 223 {
 224         struct node *nd1, *nd2;
 225 } :
 226         /* This is a new rule because the grammar specified by the standard
 227          * is not exactly LL(1) (see TypeDenoter).
 228          */
 229 [
 230         %prefer
 231         IDENT                   { nd1 = MkLeaf(Name, &dot); }
 232         [
 233                 /* empty */
 234                 /* at this point IDENT must be a TypeIdentifier !! */
 235                                 { chk_type_id(ptp, nd1);
 236                                   FreeNode(nd1);
 237                                 }
 238         |
 239                 /* at this point IDENT must be a Constant !! */
 240                                 { (void) ChkConstant(nd1); }
 241                 UPTO Constant(&nd2)
 242                                 { *ptp = subr_type(nd1, nd2);
 243                                   FreeNode(nd1);
 244                                   FreeNode(nd2);
 245                                 }
 246         ]
 247 |
 248         Constant(&nd1) UPTO Constant(&nd2)
 249                                 { *ptp = subr_type(nd1, nd2);
 250                                   FreeNode(nd1);
 251                                   FreeNode(nd2);
 252                                 }
 253 ]
 254 ;
 255
 256 TypeIdentifier(register struct type **ptp;):
 257         IDENT                   { register struct node *nd = MkLeaf(Name, &dot);
 258                                   chk_type_id(ptp, nd);
 259                                   FreeNode(nd);
 260                                 }
 261 ;
 262
 263 /* ISO section 6.5.1, p. 105 */
 264 VariableDeclaration
 265 {
 266         struct node *VarList;
 267         struct type *tp;
 268 } :
 269         IdentifierList(&VarList) ':' TypeDenoter(&tp)
 270                                 { EnterVarList(VarList, tp, proclevel > 0); }
 271 ;
 272
 273 /* ISO section 6.6.1, p. 108 */
 274 ProcedureDeclaration
 275 {
 276         struct node *nd;
 277         struct type *tp;
 278         register struct scopelist *scl;
 279         register struct def *df;
 280 } :
 281         /* This is a changed rule, because the grammar as specified in the
 282          * reference is not LL(1), and this gives conflicts.
 283          *
 284          * ProcedureHeading without a FormalParameterList can be a
 285          * ProcedureIdentification, i.e. the IDENT used in the Heading is
 286          * also used in a "forward" declaration.
 287          */
 288                                 { open_scope(); }
 289         ProcedureHeading(&nd, &tp) ';'
 290                                 { scl = CurrVis; close_scope(0); }
 291         [
 292                 Directive
 293                                 { DoDirective(dot.TOK_IDF, nd, tp, scl, 0); }
 294         |
 295                                 { df = DeclProc(nd, tp, scl);
 296 #ifdef DBSYMTAB
 297                                   if (options['g']) stb_string(df, D_PROCEDURE);
 298 #endif /* DBSYMTAB */
 299                                 }
 300                 Block(df)
 301                                 { /* open_scope() is simulated in DeclProc() */
 302 #ifdef DBSYMTAB
 303                                   if (options['g']) stb_string(df, D_PEND);
 304 #endif /* DBSYMTAB */
 305                                   close_scope(1);
 306                                 }
 307         ]
 308 ;
 309
 310 ProcedureHeading(register struct node **pnd; register struct type **ptp;)
 311 {
 312         struct node *fpl;
 313 } :
 314         PROCEDURE
 315         IDENT                   {
 316                                   *pnd = MkLeaf(Name, &dot);
 317                                 }
 318         [
 319                 FormalParameterList(&fpl)
 320                                 { arith nb_pars = 0;
 321                                   struct paramlist *pr = 0;
 322
 323                                   if( !parlevel )
 324                                         /* procedure declaration */
 325                                         nb_pars = EnterParamList(fpl, &pr);
 326                                   else
 327                                         /* procedure parameter */
 328                                         nb_pars = EnterParTypes(fpl, &pr);
 329
 330                                   *ptp = proc_type(pr, nb_pars);
 331                                   FreeNode(fpl);
 332                                 }
 333         |
 334                 /* empty */
 335                                 { *ptp =
 336                                     proc_type((struct paramlist *)0,
 337                                                 (proclevel > 1) ? pointer_size : (arith) 0);
 338                                 }
 339         ]
 340 ;
 341
 342 Directive:
 343         /* see also Functiondeclaration (6.6.2, p. 110)
 344          * Not actually an identifier but 'letter {letter | digit}'
 345          */
 346         IDENT
 347 ;
 348
 349 /* ISO section 6.6.1, p. 108 */
 350 FunctionDeclaration
 351 {
 352         struct node *nd;
 353         struct type *tp;
 354         register struct scopelist *scl;
 355         register struct def *df;
 356 } :
 357         /* This is a changed rule, because the grammar as specified in the
 358          * reference is not LL(1), and this gives conflicts.
 359          */
 360                                 { open_scope(); }
 361         FunctionHeading(&nd, &tp) ';'
 362                                 { scl = CurrVis; close_scope(0); }
 363         [
 364                 Directive
 365                                 { if( !tp )     {
 366                                         node_error(nd,
 367                                          "function \"%s\": illegal declaration",
 368                                                         nd->nd_IDF->id_text);
 369                                   }
 370                                   else DoDirective(dot.TOK_IDF, nd, tp, scl, 1);
 371                                 }
 372         |
 373                                 { if( df = DeclFunc(nd, tp, scl) ) {
 374                                         df->prc_res =
 375                                              - ResultType(df->df_type)->tp_size;
 376                                         df->prc_bool =
 377                                                 CurrentScope->sc_off =
 378                                                         df->prc_res - int_size;
 379 #ifdef DBSYMTAB
 380                                         if (options['g']) stb_string(df, D_FUNCTION);
 381 #endif /* DBSYMTAB */
 382                                     }
 383                                 }
 384                         Block(df)
 385                                 { if( df ) {
 386 #ifdef DBSYMTAB
 387                                         if (options['g']) stb_string(df, D_PEND);
 388 #endif /* DBSYMTAB */
 389                                         EndFunc(df);
 390                                   }
 391
 392                                   /* open_scope() is simulated in DeclFunc() */
 393                                   close_scope(1);
 394                                 }
 395         ]
 396 ;
 397
 398 FunctionHeading(register struct node **pnd; register struct type **ptp;)
 399 {
 400         /*      This is the Function AND FunctionIdentification part.
 401                 If it is a identification, *ptp is set to NULLTYPE.
 402         */
 403         struct node *fpl = NULLNODE;
 404         struct type *tp;
 405         struct paramlist *pr = 0;
 406         arith nb_pars = (proclevel > 1) ? pointer_size : 0;
 407 } :
 408         FUNCTION
 409         IDENT                   { *pnd = MkLeaf(Name, &dot);
 410                                   *ptp = NULLTYPE;
 411                                 }
 412 [
 413         [
 414                 FormalParameterList(&fpl)
 415                                 { if( !parlevel )
 416                                         /* function declaration */
 417                                         nb_pars = EnterParamList(fpl, &pr);
 418                                   else
 419                                         /* function parameter */
 420                                         nb_pars = EnterParTypes(fpl, &pr);
 421                                 }
 422         |
 423                 /* empty */
 424         ]
 425         ':' TypeIdentifier(&tp)
 426                                 { if( IsConstructed(tp) )       {
 427                                         node_error(*pnd,
 428                                          "function has an illegal result type");
 429                                         tp = error_type;
 430                                   }
 431                                   *ptp = func_type(pr, nb_pars, tp);
 432                                   FreeNode(fpl);
 433                                 }
 434 ]?
 435 ;
 436
 437 /* ISO section 6.4.2.1, p. 96 */
 438 OrdinalType(register struct type **ptp;):
 439         /* This is a changed rule, because the grammar as specified in the
 440          * reference states that a SubrangeType can start with an IDENT and
 441          * so can an OrdinalTypeIdentifier, and this is not LL(1).
 442          */
 443         TypeIdentifierOrSubrangeType(ptp)
 444 |
 445         EnumeratedType(ptp)
 446 ;
 447
 448 /* ISO section 6.4.2.3, p. 97 */
 449 EnumeratedType(register struct type **ptp;)
 450 {
 451         struct node *EnumList;
 452         arith i = (arith) 1;
 453 } :
 454         '(' IdentifierList(&EnumList) ')'
 455                 { register struct type *tp =
 456                         standard_type(T_ENUMERATION, word_align, word_size);
 457
 458                   *ptp = tp;
 459                   EnterEnumList(EnumList, tp);
 460                   if( tp->enm_ncst == 0 )
 461                         *ptp = error_type;
 462                   else do       {
 463                         if( ufit(tp->enm_ncst-1, i) )   {
 464                                 tp->tp_psize = i;
 465                                 tp->tp_palign = i;
 466                                 break;
 467                         }
 468                         i <<= 1;
 469                   } while( i < word_size );
 470                 }
 471 ;
 472
 473 IdentifierList(register struct node **nd;)
 474 {
 475         register struct node *tnd;
 476 } :
 477         IDENT           { *nd = tnd = MkLeaf(Name, &dot); }
 478         [ %persistent
 479                 ',' IDENT
 480                         { tnd->nd_next = MkLeaf(Name, &dot);
 481                           tnd = tnd->nd_next;
 482                         }
 483         ]*
 484 ;
 485
 486 /* ISO section 6.4.3.2, p. 98 */
 487 StructuredType(register struct type **ptp;)
 488 {
 489         unsigned short packed = 0;
 490 } :
 491         [
 492                 PACKED { packed = T_PACKED; }
 493         ]?
 494         UnpackedStructuredType(ptp, packed)
 495 ;
 496
 497 UnpackedStructuredType(register struct type **ptp; unsigned short packed;):
 498         ArrayType(ptp, packed)
 499 |
 500         RecordType(ptp, packed)
 501 |
 502         SetType(ptp, packed)
 503 |
 504         FileType(ptp)
 505 ;
 506
 507 /* ISO section 6.4.3.2, p. 98 */
 508 ArrayType(register struct type **ptp; unsigned short packed;)
 509 {
 510         struct type *tp;
 511         register struct type *tp2;
 512 } :
 513         ARRAY
 514         '['
 515                 Indextype(&tp)
 516                         { *ptp = tp2 = construct_type(T_ARRAY, tp);
 517                           tp2->tp_flags |= packed;
 518                         }
 519                 [ %persistent
 520                         ',' Indextype(&tp)
 521                         { tp2->arr_elem = construct_type(T_ARRAY, tp);
 522                           tp2 = tp2->arr_elem;
 523                           tp2->tp_flags |= packed;
 524                         }
 525                 ]*
 526         ']'
 527         OF ComponentType(&tp)
 528                         { tp2->arr_elem = tp;
 529                           ArraySizes(*ptp);
 530                           if( tp->tp_flags & T_HASFILE )
 531                                 (*ptp)->tp_flags |= T_HASFILE;
 532                         }
 533 ;
 534
 535 Indextype(register struct type **ptp;):
 536         OrdinalType(ptp)
 537 ;
 538
 539 ComponentType(register struct type **ptp;):
 540         TypeDenoter(ptp)
 541 ;
 542
 543 /* ISO section 6.4.3.3, p. 99 */
 544 RecordType(register struct type **ptp; unsigned short packed;)
 545 {
 546         register struct scope *scope;
 547         register struct def *df;
 548         struct selector *sel = 0;
 549         arith size = 0;
 550         int xalign = struct_align;
 551 } :
 552         RECORD
 553                 { open_scope();         /* scope for fields of record */
 554                   scope = CurrentScope;
 555                   close_scope(0);
 556                 }
 557         FieldList(scope, &size, &xalign, packed, &sel)
 558                 { if( size == 0 )       {
 559                         warning("empty record declaration");
 560                         size = 1;
 561                   }
 562                   *ptp = standard_type(T_RECORD, xalign, size);
 563                   (*ptp)->rec_scope = scope;
 564                   (*ptp)->rec_sel = sel;
 565                   (*ptp)->tp_flags |= packed;
 566
 567                   /* copy the file component flag */
 568                   df = scope->sc_def;
 569                   while( df && !(df->df_type->tp_flags & T_HASFILE) )
 570                         df = df->df_nextinscope;
 571
 572                   if( df )
 573                         (*ptp)->tp_flags |= T_HASFILE;
 574                 }
 575         END
 576 ;
 577
 578 FieldList(struct scope *scope; arith *cnt; int *palign; unsigned short packed;
 579                                                         struct selector **sel;):
 580         /* This is a changed rule, because the grammar as specified in the
 581          * reference is not LL(1), and this gives conflicts.
 582          * Those irritating, annoying (Siklossy !!) semicolons.
 583          */
 584
 585         /* empty */
 586 |
 587         FixedPart(scope, cnt, palign, packed, sel)
 588 |
 589         VariantPart(scope, cnt, palign, packed, sel)
 590 ;
 591
 592 FixedPart(struct scope *scope; arith *cnt; int *palign; unsigned short packed;
 593                                                         struct selector **sel;):
 594         /* This is a changed rule, because the grammar as specified in the
 595          * reference is not LL(1), and this gives conflicts.
 596          * Again those frustrating semicolons !!
 597          */
 598         RecordSection(scope, cnt, palign, packed)
 599         FixedPartTail(scope, cnt, palign, packed, sel)
 600 ;
 601
 602 FixedPartTail(struct scope *scope; arith *cnt; int *palign;
 603                                 unsigned short packed; struct selector **sel;):
 604         /* This is a new rule because the grammar specified by the standard
 605          * is not exactly LL(1).
 606          * We see the light at the end of the tunnel !
 607          */
 608
 609         /* empty */
 610 |
 611         %default
 612         ';'
 613         [
 614                 /* empty */
 615         |
 616                 VariantPart(scope, cnt, palign, packed, sel)
 617         |
 618                 RecordSection(scope, cnt, palign, packed)
 619                 FixedPartTail(scope, cnt, palign, packed, sel)
 620         ]
 621 ;
 622
 623 RecordSection(struct scope *scope; arith *cnt; int *palign;
 624                                                         unsigned short packed;)
 625 {
 626         struct node *FldList;
 627         struct type *tp;
 628 } :
 629
 630         IdentifierList(&FldList) ':' TypeDenoter(&tp)
 631                         { *palign =
 632                               lcm(*palign, packed ? tp->tp_palign : word_align);
 633                           EnterFieldList(FldList, tp, scope, cnt, packed);
 634                         }
 635 ;
 636
 637 VariantPart(struct scope *scope; arith *cnt; int *palign;
 638                                 unsigned short packed; struct selector **sel;)
 639 {
 640         struct type *tp;
 641         struct def *df = 0;
 642         struct idf *id = 0;
 643         arith tcnt, max;
 644         register arith ncst = 0;/* the number of values of the tagtype */
 645         register struct selector **sp;
 646         extern char *Malloc();
 647 } :
 648         /* This is a changed rule, because the grammar as specified in the
 649          * reference is not LL(1), and this gives conflicts.
 650          * We're almost there !!
 651          */
 652
 653                 { *sel = (struct selector *) Malloc(sizeof(struct selector));
 654                   (*sel)->sel_ptrs = 0;
 655                 }
 656         CASE
 657         VariantSelector(&tp, &id)
 658                 { if (id)
 659                         df = define(id, scope, D_FIELD);
 660 /* ISO 6.4.3.3 (p. 100)
 661  * The standard permits the integertype as tagtype, but demands that the set
 662  * of values denoted by the case-constants is equal to the set of values
 663  * specified by the tagtype.
 664  */
 665                   if( !(tp->tp_fund & T_INDEX)) {
 666                         error("illegal type in variant");
 667                         tp = error_type;
 668                   }
 669                   else  {
 670                         arith lb, ub;
 671
 672                         getbounds(tp, &lb, &ub);
 673                         ncst = ub - lb + 1;
 674                         if (ncst < 0 || ncst > (~(1L<<(8*sizeof(arith)-1)))/sizeof(struct selector *)) {
 675                                 error("range of variant tag too wide");
 676                                 tp = error_type;
 677                         }
 678                         else {
 679                                 /* initialize selector */
 680                                 (*sel)->sel_ptrs = (struct selector **)
 681                                   Malloc((unsigned)ncst * sizeof(struct selector *));
 682                                 (*sel)->sel_ncst = ncst;
 683                                 (*sel)->sel_lb = lb;
 684
 685                                 /* initialize tagvalue-table */
 686                                 sp = (*sel)->sel_ptrs;
 687                                 while( ncst-- ) *sp++ = *sel;
 688                         }
 689                   }
 690                   (*sel)->sel_type = tp;
 691                   if( df )      {
 692                         df->df_type = tp;
 693                         df->fld_flags |=
 694                                   packed ? (F_PACKED | F_SELECTOR) : F_SELECTOR;
 695                         df->fld_off = align(*cnt,
 696                                          packed ? tp->tp_palign : tp->tp_align);
 697                         *cnt = df->fld_off +
 698                                          (packed ? tp->tp_psize : tp->tp_size);
 699                   }
 700                   tcnt = *cnt;
 701                 }
 702         OF
 703         Variant(scope, &tcnt, palign, packed, *sel)
 704                         { max = tcnt; }
 705         VariantTail(scope, &tcnt, &max, cnt, palign, packed, *sel)
 706                         { *cnt = max;
 707                           if( sp = (*sel)->sel_ptrs )   {
 708                                 int errflag = 0;
 709
 710                                 ncst = (*sel)->sel_ncst;
 711                                 while( ncst-- )
 712                                         if( *sp == *sel )       {
 713                                                 *sp++ = 0;
 714                                                 errflag = 1;
 715                                         }
 716                                         else *sp++;
 717                                 if( errflag )
 718                 error("record variant part: each tagvalue must have a variant");
 719                           }
 720                         }
 721 ;
 722
 723 VariantTail(register struct scope *scope; arith *tcnt; arith *max; arith *cnt;
 724                 int *palign; unsigned short packed; struct selector *sel;):
 725         /* This is a new rule because the grammar specified by the standard
 726          * is not exactly LL(1).
 727          * At last, the garden of Eden !!
 728          */
 729
 730         /* empty */
 731 |
 732 %default
 733         ';'
 734         [
 735                 /* empty */
 736         |
 737                                         { *tcnt = *cnt; }
 738                 Variant(scope, tcnt, palign, packed, sel)
 739                                         { if( *tcnt > *max ) *max = *tcnt; }
 740                 VariantTail(scope, tcnt, max, cnt, palign, packed, sel)
 741         ]
 742 ;
 743
 744 VariantSelector(register struct type **ptp; register struct idf **pid;)
 745 {
 746         register struct node *nd;
 747 } :
 748         /* This is a changed rule, because the grammar as specified in the
 749          * reference is not LL(1), and this gives conflicts.
 750          */
 751
 752         IDENT                           { nd = MkLeaf(Name, &dot); }
 753         [
 754                 /* Old fashioned ! at this point the IDENT represents
 755                  * the TagType
 756                  */
 757                                 { warning("old-fashioned syntax ':' missing");
 758                                   chk_type_id(ptp, nd);
 759                                   FreeNode(nd);
 760                                 }
 761         |
 762                 /* IDENT is now the TagField */
 763                 ':'
 764                 TypeIdentifier(ptp)
 765                                         { *pid = nd->nd_IDF;
 766                                           FreeNode(nd);
 767                                         }
 768         ]
 769 ;
 770
 771 Variant(struct scope *scope; arith *cnt; int *palign; unsigned short packed;
 772                                                         struct selector *sel;)
 773 {
 774         struct node *nd;
 775         struct selector *sel1 = 0;
 776 } :
 777         CaseConstantList(&nd)
 778         ':'
 779         '(' FieldList(scope, cnt, palign, packed, &sel1) ')'
 780                                         { TstCaseConstants(nd, sel, sel1);
 781                                           FreeNode(nd);
 782                                         }
 783 ;
 784
 785 CaseConstantList(struct node **nd;)
 786 {
 787         struct node *nd1;
 788 } :
 789         Constant(&nd1)                  { *nd = nd1; }
 790         [ %persistent
 791                 ',' Constant(&(nd1->nd_next))
 792                                         { nd1 = nd1->nd_next; }
 793         ]*
 794 ;
 795
 796 /* ISO section 6.4.3.4, p. 101 */
 797 SetType(register struct type **ptp; unsigned short packed;):
 798         SET OF OrdinalType(ptp)
 799                 { *ptp = set_type(*ptp, packed); }
 800 ;
 801
 802 /* ISO section 6.4.3.5, p. 101 */
 803 FileType(register struct type **ptp;):
 804         FILE OF
 805                         { *ptp = construct_type(T_FILE, NULLTYPE);
 806                           (*ptp)->tp_flags |= T_HASFILE;
 807                         }
 808         ComponentType(&(*ptp)->next)
 809                         { if( (*ptp)->next->tp_flags & T_HASFILE ) {
 810                               error("file type has an illegal component type");
 811                               (*ptp)->next = error_type;
 812                           }
 813                           else {
 814                                 if( (*ptp)->next->tp_size > PC_BUFSIZ )
 815                                         (*ptp)->tp_size = (*ptp)->tp_psize =
 816                                             (*ptp)->next->tp_size +
 817                                             sizeof(struct file) - PC_BUFSIZ;
 818                           }
 819                         }
 820 ;
 821
 822 /* ISO section 6.4.4, p. 103 */
 823 PointerType(register struct type **ptp;)
 824 {
 825         register struct node *nd;
 826         register struct def *df;
 827 } :
 828         '^'
 829                         { *ptp = construct_type(T_POINTER, NULLTYPE); }
 830         IDENT
 831                         { nd = MkLeaf(Name, &dot);
 832                           df = lookup(nd->nd_IDF, CurrentScope, D_INUSE);
 833                           /* if( !df && CurrentScope == GlobalScope)
 834                               df = lookup(nd->nd_IDF, PervasiveScope, D_INUSE);
 835                           */
 836                           if( in_type_defs &&
 837                               (!df || (df->df_kind & (D_ERROR | D_FORWTYPE)))
 838                             )
 839                                 /* forward declarations only in typedefintion
 840                                    part
 841                                 */
 842                                 Forward(nd, *ptp);
 843                           else  {
 844                                 chk_type_id(&(*ptp)->next, nd);
 845                                 FreeNode(nd);
 846                           }
 847                         }
 848 ;
 849
 850 /* ISO section 6.6.3.1, p. 112 */
 851 FormalParameterList(struct node **pnd;)
 852 {
 853         struct node *nd;
 854 } :
 855         '('
 856                                         { *pnd = nd = MkLeaf(Link, &dot); }
 857                 FormalParameterSection(nd)
 858                 [ %persistent
 859                                         { nd->nd_right = MkLeaf(Link, &dot);
 860                                           nd = nd->nd_right;
 861                                         }
 862                 ';' FormalParameterSection(nd)
 863                 ]*
 864         ')'
 865 ;
 866
 867 FormalParameterSection(struct node *nd;):
 868 /* This is a changed rule, because the grammar as specified
 869  * in the reference is not LL(1), and this gives conflicts.
 870  */
 871                                         { /* kind of parameter */
 872                                           nd->nd_INT = 0;
 873                                         }
 874 [
 875         [
 876                 /* ValueParameterSpecification */
 877                 /* empty */
 878                                         { nd->nd_INT = (D_VALPAR | D_SET); }
 879         |
 880                 /* VariableParameterSpecification */
 881                 VAR
 882                                         { nd->nd_INT = (D_VARPAR | D_USED); }
 883         ]
 884         IdentifierList(&(nd->nd_left)) ':'
 885         [
 886                 /* ISO section 6.6.3.7.1, p. 115 */
 887                 /* ConformantArrayParameterSpecification */
 888                 ConformantArraySchema(&(nd->nd_type))
 889         |
 890                 TypeIdentifier(&(nd->nd_type))
 891         ]
 892                         { if( nd->nd_type->tp_flags & T_HASFILE  &&
 893                               (nd->nd_INT  & D_VALPAR) ) {
 894                             error("value parameter can't have a filecomponent");
 895                             nd->nd_type = error_type;
 896                           }
 897                         }
 898 |
 899         ProceduralParameterSpecification(&(nd->nd_left), &(nd->nd_type))
 900                                         { nd->nd_INT = (D_VALPAR | D_SET); }
 901 |
 902         FunctionalParameterSpecification(&(nd->nd_left), &(nd->nd_type))
 903                                         { nd->nd_INT = (D_VALPAR | D_SET); }
 904 ]
 905 ;
 906
 907 ProceduralParameterSpecification(register struct node **pnd;
 908                                                 register struct type **ptp;):
 909                                 { parlevel++; }
 910         ProcedureHeading(pnd, ptp)
 911                                 { parlevel--; }
 912 ;
 913
 914 FunctionalParameterSpecification(register struct node **pnd;
 915                                                 register struct type **ptp;):
 916                                 { parlevel++; }
 917         FunctionHeading(pnd, ptp)
 918                                 { parlevel--;
 919                                   if( !*ptp )   {
 920                                       node_error(*pnd,
 921                                       "illegal function parameter declaration");
 922                                       *ptp = error_type;
 923                                   }
 924                                 }
 925 ;
 926
 927 ConformantArraySchema(register struct type **ptp;):
 928         PackedConformantArraySchema(ptp)
 929 |
 930         %default
 931         UnpackedConformantArraySchema(ptp)
 932 ;
 933
 934 PackedConformantArraySchema(register struct type **ptp;)
 935 {
 936         struct type *tp;
 937 } :
 938         PACKED ARRAY
 939                                 { tp = construct_type(T_ARRAY, NULLTYPE);
 940                                   tp->tp_flags |= T_PACKED;
 941                                 }
 942         '['
 943                 Index_TypeSpecification(ptp, tp)
 944                                 { tp->next = *ptp; }
 945         ']'
 946         OF TypeIdentifier(ptp)
 947                                 { if( (*ptp)->tp_flags & T_HASFILE )
 948                                         tp->tp_flags |= T_HASFILE;
 949                                   tp->arr_elem = *ptp;
 950                                   *ptp = tp;
 951                                 }
 952 ;
 953
 954 UnpackedConformantArraySchema(register struct type **ptp;)
 955 {
 956         struct type *tp, *tp2;
 957 } :
 958         ARRAY
 959                                 { *ptp = tp = construct_type(T_ARRAY,NULLTYPE);}
 960         '['
 961                 Index_TypeSpecification(&tp2, tp)
 962                                 { tp->next = tp2; }
 963                 [
 964                                 { tp->arr_elem =
 965                                         construct_type(T_ARRAY, NULLTYPE);
 966                                   tp = tp->arr_elem;
 967                                 }
 968                 ';' Index_TypeSpecification(&tp2, tp)
 969                                 { tp->next = tp2; }
 970                 ]*
 971         ']'
 972         OF
 973         [
 974                 TypeIdentifier(&tp2)
 975         |
 976                 ConformantArraySchema(&tp2)
 977         ]
 978                                 { if( tp2->tp_flags & T_HASFILE )
 979                                         (*ptp)->tp_flags |= T_HASFILE;
 980                                   tp->arr_elem = tp2;
 981                                 }
 982 ;
 983
 984 Index_TypeSpecification(register struct type **ptp; register struct type *tp;)
 985 {
 986         register struct def *df1, *df2;
 987 } :
 988         IDENT
 989                         { if( df1 =
 990                             define(dot.TOK_IDF, CurrentScope, D_LBOUND)) {
 991                                 df1->bnd_type = tp;     /* type conf. array */
 992                                 df1->df_flags |= D_SET;
 993                           }
 994                         }
 995         UPTO
 996         IDENT
 997                         { if( df2 =
 998                             define(dot.TOK_IDF, CurrentScope, D_UBOUND)) {
 999                                 df2->bnd_type = tp;     /* type conf. array */
1000                                 df2->df_flags |= D_SET;
1001                           }
1002                         }
1003         ':' TypeIdentifier(ptp)
1004                         { if( !bounded(*ptp) &&
1005                               (*ptp)->tp_fund != T_INTEGER )    {
1006                                 error("Indextypespecification: illegal type");
1007                                 *ptp = error_type;
1008                           }
1009                           df1->df_type = df2->df_type = *ptp;
1010                         }
1011 ;