declar.g 21 KB

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