943 lines
20 KiB
Plaintext
943 lines
20 KiB
Plaintext
/* 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;
|
|
}
|
|
;
|