123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452453454455456457458459460461462463464465466467468469470471472473474475476477478479480481482483484485486487488489490491492493494495496497498499500501502503504505506507508509510511512513514515516517518519520521522523524525526527528529530531532533534535536537538539540541542543544545546547548549550551552553554555556557558559560561562563564565566567568569570571572573574575576577578579580581582583584585586587588589590591592593594595596597598599600601602603604605606607608609610611612613614615616617618619620621622623624625626627628629630631632633634635636637638639640641642643644645646647648649650651652653654655656657658659660661662663664665666667668669670671672673674675676677678679680681682683684685686687688689690691692693694695696697698699700701702703704705706707708709710711712713714715716717718719720721722723724725726727728729730731732733734735736737738739740741742743744745746747748749750751752753754755756757758759760761762763764765766767768769770771772773774775776777778779780781782783784785786787788789790791792793794795796797798799800801802803804805806807808809810811812813814815816817818819820821822823824825826827828829830831832833834835836837838839840841842843844845846847848849850851852853854855856857858859860861862863864865866867868869870871872873874875876877878879880881882883884885886887888889890891892893894895896897898899900901902903904905906907908909910911912913914915916917918919920921922923924925926927928929930931932933934935936937938939940941942943944945946947948949950951952953954955956957958959960961962963964965966967968969970971972973974975976977978979980981982983984985986987988989990991992993994995996997998999100010011002100310041005100610071008100910101011 |
- /* D E C L A R A T I O N S */
- {
- /* next line DEBUG */
- #include "debug.h"
- #include <alloc.h>
- #include <assert.h>
- #include <em_arith.h>
- #include <em_label.h>
- #include <pc_file.h>
- #include "LLlex.h"
- #include "chk_expr.h"
- #include "def.h"
- #include "idf.h"
- #include "main.h"
- #include "misc.h"
- #include "node.h"
- #include "scope.h"
- #include "type.h"
- #include "dbsymtab.h"
- #define PC_BUFSIZ (sizeof(struct file) - (int)((struct file *)0)->bufadr)
- int proclevel = 0; /* nesting level of procedures */
- int parlevel = 0; /* nesting level of parametersections */
- int expect_label = 0; /* so the parser knows that we expect a label */
- static int in_type_defs; /* in type definition part or not */
- }
- /* ISO section 6.2.1, p. 93 */
- Block(struct def *df;)
- {
- arith i;
- } :
- { text_label = (label) 0; }
- LabelDeclarationPart
- Module(df, &i)
- CompoundStatement
- { if( !err_occurred )
- CodeEndBlock(df, i);
- if( df ) EndBlock(df);
- FreeNode(BlockScope->sc_lablist);
- }
- ;
- LabelDeclarationPart
- {
- struct node *nd;
- } :
- [
- LABEL Label(&nd)
- { if( nd ) {
- DeclLabel(nd);
- nd->nd_next = CurrentScope->sc_lablist;
- CurrentScope->sc_lablist = nd;
- }
- }
- [ %persistent
- ',' Label(&nd)
- { if( nd ) {
- DeclLabel(nd);
- nd->nd_next = CurrentScope->sc_lablist;
- CurrentScope->sc_lablist = nd;
- }
- }
- ]*
- ';'
- ]?
- ;
- Module(struct def *df; arith *i;)
- {
- label save_label;
- } :
- ConstantDefinitionPart
- { in_type_defs = 1; }
- TypeDefinitionPart
- { in_type_defs = 0;
- /* resolve forward references */
- chk_forw_types();
- }
- VariableDeclarationPart
- { if( !proclevel ) {
- chk_prog_params();
- BssVar();
- }
- proclevel++;
- save_label = text_label;
- }
- ProcedureAndFunctionDeclarationPart
- { text_label = save_label;
- proclevel--;
- chk_directives();
- /* needed with labeldefinitions
- and for-statement
- */
- BlockScope = CurrentScope;
- if( !err_occurred )
- *i = CodeBeginBlock( df );
- }
- ;
- ConstantDefinitionPart:
- [
- CONST
- [ %persistent
- ConstantDefinition ';'
- ]+
- ]?
- ;
- TypeDefinitionPart:
- [
- TYPE
- [ %persistent
- TypeDefinition ';'
- ]+
- ]?
- ;
- VariableDeclarationPart:
- [
- VAR
- [ %persistent
- VariableDeclaration ';'
- ]+
- ]?
- ;
- ProcedureAndFunctionDeclarationPart:
- [
- [
- ProcedureDeclaration
- |
- FunctionDeclaration
- ] ';'
- ]*
- ;
- /* ISO section 6.1.6, p. 92 */
- Label(struct node **pnd;)
- {
- char lab[5];
- extern char *sprint();
- } : { expect_label = 1; }
- INTEGER /* not really an integer, in [0..9999] */
- { if( dot.TOK_INT < 0 || dot.TOK_INT > 9999 ) {
- if( dot.TOK_INT != -1 ) /* This means insertion */
- error("label must lie in closed interval [0..9999]");
- *pnd = NULLNODE;
- }
- else {
- sprint(lab, "%d", (int) dot.TOK_INT);
- *pnd = MkLeaf(Name, &dot);
- (*pnd)->nd_IDF = str2idf(lab, 1);
- }
- expect_label = 0;
- }
- ;
- /* ISO section 6.3, p. 95 */
- ConstantDefinition
- {
- register struct idf *id;
- register struct def *df;
- struct node *nd;
- } :
- IDENT { id = dot.TOK_IDF; }
- '=' Constant(&nd)
- { if( df = define(id,CurrentScope,D_CONST) ) {
- df->con_const = nd;
- df->df_type = nd->nd_type;
- df->df_flags |= D_SET;
- #ifdef DBSYMTAB
- if (options['g']) stb_string(df, D_CONST);
- #endif /* DBSYMTAB */
- }
- }
- ;
- /* ISO section 6.4.1, p. 96 */
- TypeDefinition
- {
- register struct idf *id;
- register struct def *df;
- struct type *tp;
- } :
- IDENT { id = dot.TOK_IDF; }
- '=' TypeDenoter(&tp)
- { if( df = define(id, CurrentScope, D_TYPE) ) {
- df->df_type = tp;
- df->df_flags |= D_SET;
- #ifdef DBSYMTAB
- if (options['g']) stb_string(df, D_TYPE);
- #endif /* DBSYMTAB */
- }
- }
- ;
- TypeDenoter(register struct type **ptp;):
- /* This is a changed rule, because the grammar as specified in the
- * reference is not LL(1), and this gives conflicts.
- */
- TypeIdentifierOrSubrangeType(ptp)
- |
- PointerType(ptp)
- |
- StructuredType(ptp)
- |
- EnumeratedType(ptp)
- ;
- TypeIdentifierOrSubrangeType(register struct type **ptp;)
- {
- struct node *nd1, *nd2;
- } :
- /* This is a new rule because the grammar specified by the standard
- * is not exactly LL(1) (see TypeDenoter).
- */
- [
- %prefer
- IDENT { nd1 = MkLeaf(Name, &dot); }
- [
- /* empty */
- /* at this point IDENT must be a TypeIdentifier !! */
- { chk_type_id(ptp, nd1);
- FreeNode(nd1);
- }
- |
- /* at this point IDENT must be a Constant !! */
- { (void) ChkConstant(nd1); }
- UPTO Constant(&nd2)
- { *ptp = subr_type(nd1, nd2);
- FreeNode(nd1);
- FreeNode(nd2);
- }
- ]
- |
- Constant(&nd1) UPTO Constant(&nd2)
- { *ptp = subr_type(nd1, nd2);
- FreeNode(nd1);
- FreeNode(nd2);
- }
- ]
- ;
- TypeIdentifier(register struct type **ptp;):
- IDENT { register struct node *nd = MkLeaf(Name, &dot);
- chk_type_id(ptp, nd);
- FreeNode(nd);
- }
- ;
- /* ISO section 6.5.1, p. 105 */
- VariableDeclaration
- {
- struct node *VarList;
- struct type *tp;
- } :
- IdentifierList(&VarList) ':' TypeDenoter(&tp)
- { EnterVarList(VarList, tp, proclevel > 0); }
- ;
- /* ISO section 6.6.1, p. 108 */
- ProcedureDeclaration
- {
- struct node *nd;
- struct type *tp;
- register struct scopelist *scl;
- register struct def *df;
- } :
- /* This is a changed rule, because the grammar as specified in the
- * reference is not LL(1), and this gives conflicts.
- *
- * ProcedureHeading without a FormalParameterList can be a
- * ProcedureIdentification, i.e. the IDENT used in the Heading is
- * also used in a "forward" declaration.
- */
- { open_scope(); }
- ProcedureHeading(&nd, &tp) ';'
- { scl = CurrVis; close_scope(0); }
- [
- Directive
- { DoDirective(dot.TOK_IDF, nd, tp, scl, 0); }
- |
- { df = DeclProc(nd, tp, scl);
- #ifdef DBSYMTAB
- if (options['g']) stb_string(df, D_PROCEDURE);
- #endif /* DBSYMTAB */
- }
- Block(df)
- { /* open_scope() is simulated in DeclProc() */
- #ifdef DBSYMTAB
- if (options['g']) stb_string(df, D_PEND);
- #endif /* DBSYMTAB */
- close_scope(1);
- }
- ]
- ;
- ProcedureHeading(register struct node **pnd; register struct type **ptp;)
- {
- struct node *fpl;
- } :
- PROCEDURE
- IDENT {
- *pnd = MkLeaf(Name, &dot);
- }
- [
- FormalParameterList(&fpl)
- { arith nb_pars = 0;
- struct paramlist *pr = 0;
- if( !parlevel )
- /* procedure declaration */
- nb_pars = EnterParamList(fpl, &pr);
- else
- /* procedure parameter */
- nb_pars = EnterParTypes(fpl, &pr);
-
- *ptp = proc_type(pr, nb_pars);
- FreeNode(fpl);
- }
- |
- /* empty */
- { *ptp =
- proc_type((struct paramlist *)0,
- (proclevel > 1) ? pointer_size : (arith) 0);
- }
- ]
- ;
- Directive:
- /* see also Functiondeclaration (6.6.2, p. 110)
- * Not actually an identifier but 'letter {letter | digit}'
- */
- IDENT
- ;
- /* ISO section 6.6.1, p. 108 */
- FunctionDeclaration
- {
- struct node *nd;
- struct type *tp;
- register struct scopelist *scl;
- register struct def *df;
- } :
- /* This is a changed rule, because the grammar as specified in the
- * reference is not LL(1), and this gives conflicts.
- */
- { open_scope(); }
- FunctionHeading(&nd, &tp) ';'
- { scl = CurrVis; close_scope(0); }
- [
- Directive
- { if( !tp ) {
- node_error(nd,
- "function \"%s\": illegal declaration",
- nd->nd_IDF->id_text);
- }
- else DoDirective(dot.TOK_IDF, nd, tp, scl, 1);
- }
- |
- { if( df = DeclFunc(nd, tp, scl) ) {
- df->prc_res =
- - ResultType(df->df_type)->tp_size;
- df->prc_bool =
- CurrentScope->sc_off =
- df->prc_res - int_size;
- #ifdef DBSYMTAB
- if (options['g']) stb_string(df, D_FUNCTION);
- #endif /* DBSYMTAB */
- }
- }
- Block(df)
- { if( df ) {
- #ifdef DBSYMTAB
- if (options['g']) stb_string(df, D_PEND);
- #endif /* DBSYMTAB */
- EndFunc(df);
- }
- /* open_scope() is simulated in DeclFunc() */
- close_scope(1);
- }
- ]
- ;
- FunctionHeading(register struct node **pnd; register struct type **ptp;)
- {
- /* This is the Function AND FunctionIdentification part.
- If it is a identification, *ptp is set to NULLTYPE.
- */
- struct node *fpl = NULLNODE;
- struct type *tp;
- struct paramlist *pr = 0;
- arith nb_pars = (proclevel > 1) ? pointer_size : 0;
- } :
- FUNCTION
- IDENT { *pnd = MkLeaf(Name, &dot);
- *ptp = NULLTYPE;
- }
- [
- [
- FormalParameterList(&fpl)
- { if( !parlevel )
- /* function declaration */
- nb_pars = EnterParamList(fpl, &pr);
- else
- /* function parameter */
- nb_pars = EnterParTypes(fpl, &pr);
- }
- |
- /* empty */
- ]
- ':' TypeIdentifier(&tp)
- { if( IsConstructed(tp) ) {
- node_error(*pnd,
- "function has an illegal result type");
- tp = error_type;
- }
- *ptp = func_type(pr, nb_pars, tp);
- FreeNode(fpl);
- }
- ]?
- ;
- /* ISO section 6.4.2.1, p. 96 */
- OrdinalType(register struct type **ptp;):
- /* This is a changed rule, because the grammar as specified in the
- * reference states that a SubrangeType can start with an IDENT and
- * so can an OrdinalTypeIdentifier, and this is not LL(1).
- */
- TypeIdentifierOrSubrangeType(ptp)
- |
- EnumeratedType(ptp)
- ;
- /* ISO section 6.4.2.3, p. 97 */
- EnumeratedType(register struct type **ptp;)
- {
- struct node *EnumList;
- arith i = (arith) 1;
- } :
- '(' IdentifierList(&EnumList) ')'
- { register struct type *tp =
- standard_type(T_ENUMERATION, word_align, word_size);
- *ptp = tp;
- EnterEnumList(EnumList, tp);
- if( tp->enm_ncst == 0 )
- *ptp = error_type;
- else do {
- if( ufit(tp->enm_ncst-1, i) ) {
- tp->tp_psize = i;
- tp->tp_palign = i;
- break;
- }
- i <<= 1;
- } while( i < word_size );
- }
- ;
- IdentifierList(register struct node **nd;)
- {
- register struct node *tnd;
- } :
- IDENT { *nd = tnd = MkLeaf(Name, &dot); }
- [ %persistent
- ',' IDENT
- { tnd->nd_next = MkLeaf(Name, &dot);
- tnd = tnd->nd_next;
- }
- ]*
- ;
- /* ISO section 6.4.3.2, p. 98 */
- StructuredType(register struct type **ptp;)
- {
- unsigned short packed = 0;
- } :
- [
- PACKED { packed = T_PACKED; }
- ]?
- UnpackedStructuredType(ptp, packed)
- ;
- UnpackedStructuredType(register struct type **ptp; unsigned short packed;):
- ArrayType(ptp, packed)
- |
- RecordType(ptp, packed)
- |
- SetType(ptp, packed)
- |
- FileType(ptp)
- ;
- /* ISO section 6.4.3.2, p. 98 */
- ArrayType(register struct type **ptp; unsigned short packed;)
- {
- struct type *tp;
- register struct type *tp2;
- } :
- ARRAY
- '['
- Indextype(&tp)
- { *ptp = tp2 = construct_type(T_ARRAY, tp);
- tp2->tp_flags |= packed;
- }
- [ %persistent
- ',' Indextype(&tp)
- { tp2->arr_elem = construct_type(T_ARRAY, tp);
- tp2 = tp2->arr_elem;
- tp2->tp_flags |= packed;
- }
- ]*
- ']'
- OF ComponentType(&tp)
- { tp2->arr_elem = tp;
- ArraySizes(*ptp);
- if( tp->tp_flags & T_HASFILE )
- (*ptp)->tp_flags |= T_HASFILE;
- }
- ;
- Indextype(register struct type **ptp;):
- OrdinalType(ptp)
- ;
- ComponentType(register struct type **ptp;):
- TypeDenoter(ptp)
- ;
- /* ISO section 6.4.3.3, p. 99 */
- RecordType(register struct type **ptp; unsigned short packed;)
- {
- register struct scope *scope;
- register struct def *df;
- struct selector *sel = 0;
- arith size = 0;
- int xalign = struct_align;
- } :
- RECORD
- { open_scope(); /* scope for fields of record */
- scope = CurrentScope;
- close_scope(0);
- }
- FieldList(scope, &size, &xalign, packed, &sel)
- { if( size == 0 ) {
- warning("empty record declaration");
- size = 1;
- }
- *ptp = standard_type(T_RECORD, xalign, size);
- (*ptp)->rec_scope = scope;
- (*ptp)->rec_sel = sel;
- (*ptp)->tp_flags |= packed;
- /* copy the file component flag */
- df = scope->sc_def;
- while( df && !(df->df_type->tp_flags & T_HASFILE) )
- df = df->df_nextinscope;
- if( df )
- (*ptp)->tp_flags |= T_HASFILE;
- }
- END
- ;
- FieldList(struct scope *scope; arith *cnt; int *palign; unsigned short packed;
- struct selector **sel;):
- /* This is a changed rule, because the grammar as specified in the
- * reference is not LL(1), and this gives conflicts.
- * Those irritating, annoying (Siklossy !!) semicolons.
- */
- /* empty */
- |
- FixedPart(scope, cnt, palign, packed, sel)
- |
- VariantPart(scope, cnt, palign, packed, sel)
- ;
- FixedPart(struct scope *scope; arith *cnt; int *palign; unsigned short packed;
- struct selector **sel;):
- /* This is a changed rule, because the grammar as specified in the
- * reference is not LL(1), and this gives conflicts.
- * Again those frustrating semicolons !!
- */
- RecordSection(scope, cnt, palign, packed)
- FixedPartTail(scope, cnt, palign, packed, sel)
- ;
- FixedPartTail(struct scope *scope; arith *cnt; int *palign;
- unsigned short packed; struct selector **sel;):
- /* This is a new rule because the grammar specified by the standard
- * is not exactly LL(1).
- * We see the light at the end of the tunnel !
- */
- /* empty */
- |
- %default
- ';'
- [
- /* empty */
- |
- VariantPart(scope, cnt, palign, packed, sel)
- |
- RecordSection(scope, cnt, palign, packed)
- FixedPartTail(scope, cnt, palign, packed, sel)
- ]
- ;
- RecordSection(struct scope *scope; arith *cnt; int *palign;
- unsigned short packed;)
- {
- struct node *FldList;
- struct type *tp;
- } :
- IdentifierList(&FldList) ':' TypeDenoter(&tp)
- { *palign =
- lcm(*palign, packed ? tp->tp_palign : word_align);
- EnterFieldList(FldList, tp, scope, cnt, packed);
- }
- ;
- VariantPart(struct scope *scope; arith *cnt; int *palign;
- unsigned short packed; struct selector **sel;)
- {
- struct type *tp;
- struct def *df = 0;
- struct idf *id = 0;
- arith tcnt, max;
- register arith ncst = 0;/* the number of values of the tagtype */
- register struct selector **sp;
- extern char *Malloc();
- } :
- /* This is a changed rule, because the grammar as specified in the
- * reference is not LL(1), and this gives conflicts.
- * We're almost there !!
- */
- { *sel = (struct selector *) Malloc(sizeof(struct selector));
- (*sel)->sel_ptrs = 0;
- }
- CASE
- VariantSelector(&tp, &id)
- { if (id)
- df = define(id, scope, D_FIELD);
- /* ISO 6.4.3.3 (p. 100)
- * The standard permits the integertype as tagtype, but demands that the set
- * of values denoted by the case-constants is equal to the set of values
- * specified by the tagtype.
- */
- if( !(tp->tp_fund & T_INDEX)) {
- error("illegal type in variant");
- tp = error_type;
- }
- else {
- arith lb, ub;
- getbounds(tp, &lb, &ub);
- ncst = ub - lb + 1;
- if (ncst < 0 || ncst > (~(1L<<(8*sizeof(arith)-1)))/sizeof(struct selector *)) {
- error("range of variant tag too wide");
- tp = error_type;
- }
- else {
- /* initialize selector */
- (*sel)->sel_ptrs = (struct selector **)
- Malloc((unsigned)ncst * sizeof(struct selector *));
- (*sel)->sel_ncst = ncst;
- (*sel)->sel_lb = lb;
-
- /* initialize tagvalue-table */
- sp = (*sel)->sel_ptrs;
- while( ncst-- ) *sp++ = *sel;
- }
- }
- (*sel)->sel_type = tp;
- if( df ) {
- df->df_type = tp;
- df->fld_flags |=
- packed ? (F_PACKED | F_SELECTOR) : F_SELECTOR;
- df->fld_off = align(*cnt,
- packed ? tp->tp_palign : tp->tp_align);
- *cnt = df->fld_off +
- (packed ? tp->tp_psize : tp->tp_size);
- }
- tcnt = *cnt;
- }
- OF
- Variant(scope, &tcnt, palign, packed, *sel)
- { max = tcnt; }
- VariantTail(scope, &tcnt, &max, cnt, palign, packed, *sel)
- { *cnt = max;
- if( sp = (*sel)->sel_ptrs ) {
- int errflag = 0;
- ncst = (*sel)->sel_ncst;
- while( ncst-- )
- if( *sp == *sel ) {
- *sp++ = 0;
- errflag = 1;
- }
- else *sp++;
- if( errflag )
- error("record variant part: each tagvalue must have a variant");
- }
- }
- ;
- VariantTail(register struct scope *scope; arith *tcnt; arith *max; arith *cnt;
- int *palign; unsigned short packed; struct selector *sel;):
- /* This is a new rule because the grammar specified by the standard
- * is not exactly LL(1).
- * At last, the garden of Eden !!
- */
- /* empty */
- |
- %default
- ';'
- [
- /* empty */
- |
- { *tcnt = *cnt; }
- Variant(scope, tcnt, palign, packed, sel)
- { if( *tcnt > *max ) *max = *tcnt; }
- VariantTail(scope, tcnt, max, cnt, palign, packed, sel)
- ]
- ;
- VariantSelector(register struct type **ptp; register struct idf **pid;)
- {
- register struct node *nd;
- } :
- /* This is a changed rule, because the grammar as specified in the
- * reference is not LL(1), and this gives conflicts.
- */
- IDENT { nd = MkLeaf(Name, &dot); }
- [
- /* Old fashioned ! at this point the IDENT represents
- * the TagType
- */
- { warning("old-fashioned syntax ':' missing");
- chk_type_id(ptp, nd);
- FreeNode(nd);
- }
- |
- /* IDENT is now the TagField */
- ':'
- TypeIdentifier(ptp)
- { *pid = nd->nd_IDF;
- FreeNode(nd);
- }
- ]
- ;
- Variant(struct scope *scope; arith *cnt; int *palign; unsigned short packed;
- struct selector *sel;)
- {
- struct node *nd;
- struct selector *sel1 = 0;
- } :
- CaseConstantList(&nd)
- ':'
- '(' FieldList(scope, cnt, palign, packed, &sel1) ')'
- { TstCaseConstants(nd, sel, sel1);
- FreeNode(nd);
- }
- ;
- CaseConstantList(struct node **nd;)
- {
- struct node *nd1;
- } :
- Constant(&nd1) { *nd = nd1; }
- [ %persistent
- ',' Constant(&(nd1->nd_next))
- { nd1 = nd1->nd_next; }
- ]*
- ;
- /* ISO section 6.4.3.4, p. 101 */
- SetType(register struct type **ptp; unsigned short packed;):
- SET OF OrdinalType(ptp)
- { *ptp = set_type(*ptp, packed); }
- ;
- /* ISO section 6.4.3.5, p. 101 */
- FileType(register struct type **ptp;):
- FILE OF
- { *ptp = construct_type(T_FILE, NULLTYPE);
- (*ptp)->tp_flags |= T_HASFILE;
- }
- ComponentType(&(*ptp)->next)
- { if( (*ptp)->next->tp_flags & T_HASFILE ) {
- error("file type has an illegal component type");
- (*ptp)->next = error_type;
- }
- else {
- if( (*ptp)->next->tp_size > PC_BUFSIZ )
- (*ptp)->tp_size = (*ptp)->tp_psize =
- (*ptp)->next->tp_size +
- sizeof(struct file) - PC_BUFSIZ;
- }
- }
- ;
- /* ISO section 6.4.4, p. 103 */
- PointerType(register struct type **ptp;)
- {
- register struct node *nd;
- register struct def *df;
- } :
- '^'
- { *ptp = construct_type(T_POINTER, NULLTYPE); }
- IDENT
- { nd = MkLeaf(Name, &dot);
- df = lookup(nd->nd_IDF, CurrentScope, D_INUSE);
- /* if( !df && CurrentScope == GlobalScope)
- df = lookup(nd->nd_IDF, PervasiveScope, D_INUSE);
- */
- if( in_type_defs &&
- (!df || (df->df_kind & (D_ERROR | D_FORWTYPE)))
- )
- /* forward declarations only in typedefintion
- part
- */
- Forward(nd, *ptp);
- else {
- chk_type_id(&(*ptp)->next, nd);
- FreeNode(nd);
- }
- }
- ;
- /* ISO section 6.6.3.1, p. 112 */
- FormalParameterList(struct node **pnd;)
- {
- struct node *nd;
- } :
- '('
- { *pnd = nd = MkLeaf(Link, &dot); }
- FormalParameterSection(nd)
- [ %persistent
- { nd->nd_right = MkLeaf(Link, &dot);
- nd = nd->nd_right;
- }
- ';' FormalParameterSection(nd)
- ]*
- ')'
- ;
- FormalParameterSection(struct node *nd;):
- /* This is a changed rule, because the grammar as specified
- * in the reference is not LL(1), and this gives conflicts.
- */
- { /* kind of parameter */
- nd->nd_INT = 0;
- }
- [
- [
- /* ValueParameterSpecification */
- /* empty */
- { nd->nd_INT = (D_VALPAR | D_SET); }
- |
- /* VariableParameterSpecification */
- VAR
- { nd->nd_INT = (D_VARPAR | D_USED); }
- ]
- IdentifierList(&(nd->nd_left)) ':'
- [
- /* ISO section 6.6.3.7.1, p. 115 */
- /* ConformantArrayParameterSpecification */
- ConformantArraySchema(&(nd->nd_type))
- |
- TypeIdentifier(&(nd->nd_type))
- ]
- { if( nd->nd_type->tp_flags & T_HASFILE &&
- (nd->nd_INT & D_VALPAR) ) {
- error("value parameter can't have a filecomponent");
- nd->nd_type = error_type;
- }
- }
- |
- ProceduralParameterSpecification(&(nd->nd_left), &(nd->nd_type))
- { nd->nd_INT = (D_VALPAR | D_SET); }
- |
- FunctionalParameterSpecification(&(nd->nd_left), &(nd->nd_type))
- { nd->nd_INT = (D_VALPAR | D_SET); }
- ]
- ;
- ProceduralParameterSpecification(register struct node **pnd;
- register struct type **ptp;):
- { parlevel++; }
- ProcedureHeading(pnd, ptp)
- { parlevel--; }
- ;
- FunctionalParameterSpecification(register struct node **pnd;
- register struct type **ptp;):
- { parlevel++; }
- FunctionHeading(pnd, ptp)
- { parlevel--;
- if( !*ptp ) {
- node_error(*pnd,
- "illegal function parameter declaration");
- *ptp = error_type;
- }
- }
- ;
- ConformantArraySchema(register struct type **ptp;):
- PackedConformantArraySchema(ptp)
- |
- %default
- UnpackedConformantArraySchema(ptp)
- ;
- PackedConformantArraySchema(register struct type **ptp;)
- {
- struct type *tp;
- } :
- PACKED ARRAY
- { tp = construct_type(T_ARRAY, NULLTYPE);
- tp->tp_flags |= T_PACKED;
- }
- '['
- Index_TypeSpecification(ptp, tp)
- { tp->next = *ptp; }
- ']'
- OF TypeIdentifier(ptp)
- { if( (*ptp)->tp_flags & T_HASFILE )
- tp->tp_flags |= T_HASFILE;
- tp->arr_elem = *ptp;
- *ptp = tp;
- }
- ;
- UnpackedConformantArraySchema(register struct type **ptp;)
- {
- struct type *tp, *tp2;
- } :
- ARRAY
- { *ptp = tp = construct_type(T_ARRAY,NULLTYPE);}
- '['
- Index_TypeSpecification(&tp2, tp)
- { tp->next = tp2; }
- [
- { tp->arr_elem =
- construct_type(T_ARRAY, NULLTYPE);
- tp = tp->arr_elem;
- }
- ';' Index_TypeSpecification(&tp2, tp)
- { tp->next = tp2; }
- ]*
- ']'
- OF
- [
- TypeIdentifier(&tp2)
- |
- ConformantArraySchema(&tp2)
- ]
- { if( tp2->tp_flags & T_HASFILE )
- (*ptp)->tp_flags |= T_HASFILE;
- tp->arr_elem = tp2;
- }
- ;
- Index_TypeSpecification(register struct type **ptp; register struct type *tp;)
- {
- register struct def *df1, *df2;
- } :
- IDENT
- { if( df1 =
- define(dot.TOK_IDF, CurrentScope, D_LBOUND)) {
- df1->bnd_type = tp; /* type conf. array */
- df1->df_flags |= D_SET;
- }
- }
- UPTO
- IDENT
- { if( df2 =
- define(dot.TOK_IDF, CurrentScope, D_UBOUND)) {
- df2->bnd_type = tp; /* type conf. array */
- df2->df_flags |= D_SET;
- }
- }
- ':' TypeIdentifier(ptp)
- { if( !bounded(*ptp) &&
- (*ptp)->tp_fund != T_INTEGER ) {
- error("Indextypespecification: illegal type");
- *ptp = error_type;
- }
- df1->df_type = df2->df_type = *ptp;
- }
- ;
|