Initial revision
This commit is contained in:
ceriel
942
lang/pc/comp/declar.g
Normal file
942
lang/pc/comp/declar.g
Normal file
@@ -0,0 +1,942 @@
|
||||
/* D E C L A R A T I O N S */
|
||||
|
||||
{
|
||||
#include <alloc.h>
|
||||
#include <assert.h>
|
||||
#include <em_arith.h>
|
||||
#include <em_label.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"
|
||||
|
||||
int proclevel = 0; /* nesting level of procedures */
|
||||
int parlevel = 0; /* nesting level of parametersections */
|
||||
static int in_type_defs; /* in type definition part or not */
|
||||
}
|
||||
|
||||
/* ISO section 6.2.1, p. 93 */
|
||||
Block(struct def *df;)
|
||||
{
|
||||
arith i;
|
||||
label save_label;
|
||||
} :
|
||||
{ text_label = (label) 0; }
|
||||
LabelDeclarationPart
|
||||
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 );
|
||||
}
|
||||
CompoundStatement
|
||||
{ if( !err_occurred )
|
||||
CodeEndBlock(df, i);
|
||||
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;
|
||||
}
|
||||
}
|
||||
]*
|
||||
';'
|
||||
]?
|
||||
;
|
||||
|
||||
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();
|
||||
} :
|
||||
INTEGER /* not really an integer, in [0..9999] */
|
||||
{ if( dot.TOK_INT < 0 || dot.TOK_INT > 9999 ) {
|
||||
error("label must lie in closed interval [0..9999]");
|
||||
*pnd = NULLNODE;
|
||||
}
|
||||
else {
|
||||
sprint(lab, "%d", dot.TOK_INT);
|
||||
*pnd = MkLeaf(Name, &dot);
|
||||
(*pnd)->nd_IDF = str2idf(lab, 1);
|
||||
}
|
||||
}
|
||||
;
|
||||
|
||||
|
||||
/* 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;
|
||||
}
|
||||
}
|
||||
;
|
||||
|
||||
/* 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;
|
||||
}
|
||||
;
|
||||
|
||||
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(); }
|
||||
[
|
||||
Directive
|
||||
{ DoDirective(dot.TOK_IDF, nd, tp, scl, 0); }
|
||||
|
|
||||
{ df = DeclProc(nd, tp, scl); }
|
||||
Block(df)
|
||||
{ /* open_scope() is simulated in DeclProc() */
|
||||
close_scope();
|
||||
}
|
||||
]
|
||||
;
|
||||
|
||||
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 */
|
||||
EnterParTypes(fpl, &pr);
|
||||
|
||||
*ptp = proc_type(pr, nb_pars);
|
||||
FreeNode(fpl);
|
||||
}
|
||||
|
|
||||
/* empty */
|
||||
{ *ptp = proc_type(0, 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(); }
|
||||
[
|
||||
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 = CurrentScope->sc_off =
|
||||
- ResultType(df->df_type)->tp_size;
|
||||
}
|
||||
Block(df)
|
||||
{ if( df )
|
||||
/* assignment to functionname is illegal
|
||||
outside the functionblock
|
||||
*/
|
||||
df->prc_res = 0;
|
||||
|
||||
/* open_scope() is simulated in DeclFunc() */
|
||||
close_scope();
|
||||
}
|
||||
]
|
||||
;
|
||||
|
||||
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 = 0;
|
||||
} :
|
||||
FUNCTION
|
||||
IDENT { *pnd = MkLeaf(Name, &dot);
|
||||
*ptp = NULLTYPE;
|
||||
}
|
||||
[
|
||||
[
|
||||
FormalParameterList(&fpl)
|
||||
{ if( !parlevel )
|
||||
/* function declaration */
|
||||
nb_pars = EnterParamList(fpl, &pr);
|
||||
else
|
||||
/* function parameter */
|
||||
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();
|
||||
}
|
||||
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. So we've decided not to allow integer as tagtype,
|
||||
* because it's not practical to enumerate ALL integers as case-constants.
|
||||
* Though it wouldn't make a great difference to allow it as 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;
|
||||
|
||||
/* initialize selector */
|
||||
(*sel)->sel_ptrs = (struct selector **)
|
||||
Malloc(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, *max, *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;
|
||||
}
|
||||
}
|
||||
;
|
||||
|
||||
/* 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);
|
||||
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; }
|
||||
|
|
||||
/* VariableParameterSpecification */
|
||||
VAR
|
||||
{ nd->nd_INT = D_VARPAR; }
|
||||
]
|
||||
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))
|
||||
|
|
||||
FunctionalParameterSpecification(&(nd->nd_left), &(nd->nd_type))
|
||||
]
|
||||
;
|
||||
|
||||
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, *tp;)
|
||||
{
|
||||
register struct def *df1, *df2;
|
||||
} :
|
||||
IDENT
|
||||
{ if( df1 = define(dot.TOK_IDF, CurrentScope, D_LBOUND))
|
||||
df1->bnd_type = tp; /* type conf. array */
|
||||
}
|
||||
UPTO
|
||||
IDENT
|
||||
{ if( df2 = define(dot.TOK_IDF, CurrentScope, D_UBOUND))
|
||||
df2->bnd_type = tp; /* type conf. array */
|
||||
}
|
||||
':' TypeIdentifier(ptp)
|
||||
{ if( !bounded(*ptp) &&
|
||||
(*ptp)->tp_fund != T_INTEGER ) {
|
||||
error("Indextypespecification: illegal type");
|
||||
*ptp = error_type;
|
||||
}
|
||||
df1->df_type = df2->df_type = *ptp;
|
||||
}
|
||||
;
|
||||
Reference in New Issue
Block a user