declar.g 20 KB

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