static char *sccsid
="@(#)pftn.c 1.3 (Berkeley) %G%";
int in_sz
; /* size of array element */
int in_x
; /* current index for structure member in structure initializations */
int in_n
; /* number of initializations seen */
int in_id
; /* stab index */
int in_fl
; /* flag which says if this level is controlled by {} */
OFFSZ in_off
; /* offset of the beginning of this level */
/* defines used for getting things off of the initialization stack */
struct symtab
* mknonuniq();
defid( q
, class ) NODE
*q
; {
register struct symtab
*p
;
if( q
== NIL
) return; /* an error was detected */
if( q
< node
|| q
>= &node
[TREESZ
] ) cerror( "defid call" );
if( idp
< 0 ) cerror( "tyreduce" );
printf( "defid( %.8s (%d), ", p
->sname
, idp
);
printf( "defid( %s (%d), ", p
->sname
, idp
);
printf( ", %s, (%d,%d) ), level %d\n", scnames(class), q
->fn
.cdim
, q
->fn
.csiz
, blevel
);
class = fixclass( class, type
);
printf( " modified to " );
printf( ", %s\n", scnames(class) );
printf( " previous def'n: " );
printf( ", %s, (%d,%d) ), level %d\n", scnames(p
->sclass
), p
->dimoff
, p
->sizoff
, slev
);
if( stp
== FTN
&& p
->sclass
== SNULL
)goto enter
;
/* name encountered as function, not yet defined */
if( stp
== UNDEF
|| stp
== FARG
){
if( blevel
==1 && stp
!=FARG
) switch( class ){
if(!(class&FIELD
)) uerror( "declared argument %.8s is missing", p
->sname
);
if(!(class&FIELD
)) uerror( "declared argument %s is missing", p
->sname
);
if( type
!= stp
) goto mismatch
;
/* test (and possibly adjust) dimensions */
for( temp
=type
; temp
&TMASK
; temp
= DECREF(temp
) ){
dimtab
[dsym
] = dimtab
[ddef
];
else if (dimtab
[ddef
]!=0&&dimtab
[dsym
]!=dimtab
[ddef
]) {
/* check that redeclarations are to the same structure */
if( (temp
==STRTY
||temp
==UNIONTY
||temp
==ENUMTY
) && p
->sizoff
!= q
->fn
.csiz
&& class!=STNAME
&& class!=UNAME
&& class!=ENAME
){
printf( " previous class: %s\n", scnames(scl
) );
if( !falloc( p
, class&FLDSIZ
, 1, NIL
) ) {
/* successful allocation */
/* blew it: resume at end of switch... */
if( scl
==USTATIC
|| (scl
==EXTERN
&& blevel
==0) ){
if( ISFTN(type
) ) curftn
= idp
;
if( scl
==STATIC
|| scl
==USTATIC
) return;
if( scl
== class ) return;
if( scl
== UFORTRAN
|| scl
== FORTRAN
) return;
if( ISFTN(type
) ) curftn
= idp
;
if( oalloc( p
, &strucoff
) ) break;
if( class == MOU
) strucoff
= 0;
if( p
->offset
!= strucoff
++ ) break;
if( ISFTN(type
) ) curftn
= idp
;
if( scl
!= class ) break;
if( dimtab
[p
->sizoff
] == 0 ) return; /* previous entry just a mention */
if( scl
== LABEL
|| scl
== ULABEL
) return;
/* allow nonunique structure/union member names */
if( class==MOU
|| class==MOS
|| class & FIELD
){/* make a new entry */
p
->sflags
|= SNONUNIQ
; /* old entry is nonunique */
/* determine if name has occurred in this structure/union */
for( memp
= ¶mstk
[paramno
-1];
/* while */ *memp
>=0 && stab
[*memp
].sclass
!= STNAME
&& stab
[*memp
].sclass
!= UNAME
;
/* iterate */ --memp
){ char * cname
, * oname
;
if( stab
[*memp
].sflags
& SNONUNIQ
){int k
;
for(k
=1; k
<=NCHNAM
; ++k
){
if(*cname
++ != *oname
)goto diff
;
if (cname
!= oname
) goto diff
;
uerror("redeclaration of: %s",p
->sname
);
p
= mknonuniq( &idp
); /* update p and idp to new entry */
if( blevel
> slev
&& class != EXTERN
&& class != FORTRAN
&&
class != UFORTRAN
&& !( class == LABEL
&& slev
>= 2 ) ){
q
->tn
.rval
= idp
= hide( p
);
uerror( "redeclaration of %.8s", p
->sname
);
uerror( "redeclaration of %s", p
->sname
);
if( class==EXTDEF
&& ISFTN(type
) ) curftn
= idp
;
enter
: /* make a new entry */
if( ddebug
) printf( " new entry made\n" );
if( type
== UNDEF
) uerror("void type for %s",p
->sname
);
if( class == STNAME
|| class == UNAME
|| class == ENAME
) {
dstash( -1 ); /* index to members of str or union */
dstash( ALSTRUCT
); /* alignment */
falloc( p
, class&FLDSIZ
, 0, NIL
); /* new entry */
if( ISFTN(type
) ) curftn
= idp
;
if( class == MOU
) strucoff
= 0;
if( blevel
== 1 ) p
->sflags
|= SSET
;
if( regvar
< minrvar
) minrvar
= regvar
;
/* user-supplied routine to fix up new definitions */
if( ddebug
) printf( " dimoff, sizoff, offset: %d, %d, %d\n", p
->dimoff
, p
->sizoff
, p
->offset
);
if( paramno
>= PARAMSZ
){
cerror( "parameter stack overflow");
paramstk
[ paramno
++ ] = i
;
ftnend(){ /* end of function */
if( retlab
!= NOLAB
){ /* inside a real function */
brklab
= contlab
= retlab
= NOLAB
;
if( psavbc
!= & asavbc
[0] ) cerror("bcsave error");
if( paramno
!= 0 ) cerror("parameter reset error");
if( swx
!= 0 ) cerror( "switch error");
minrvar
= regvar
= MAXRVAR
;
register struct symtab
*p
;
if( ddebug
> 2) printf("dclargs()\n");
for( i
=0; i
<paramno
; ++i
){
if( (j
= paramstk
[i
]) < 0 ) continue;
printf("\t%s (%d) ",p
->sname
, j
);
q
= block(FREE
,NIL
,NIL
,INT
,0,INT
);
FIXARG(p
); /* local arg hook, eg. for sym. debugger */
oalloc( p
, &argoff
); /* always set aside space, even for register arguments */
bfcode( paramstk
, paramno
);
rstruct( idn
, soru
){ /* reference to a structure or union, with no definition */
register struct symtab
*p
;
q
= block( FREE
, NIL
, NIL
, 0, 0, 0 );
q
->in
.type
= (soru
&INSTRUCT
) ? STRTY
: ( (soru
&INUNION
) ? UNIONTY
: ENUMTY
);
defid( q
, (soru
&INSTRUCT
) ? STNAME
: ( (soru
&INUNION
) ? UNAME
: ENAME
) );
if( soru
& INSTRUCT
) break;
if( soru
& INUNION
) break;
if( !(soru
&(INUNION
|INSTRUCT
)) ) break;
return( mkty( p
->stype
, 0, p
->sizoff
) );
q
= block( FREE
, NIL
, NIL
, MOETY
, 0, 0 );
if( idn
>=0 ) defid( q
, MOE
);
bstruct( idn
, soru
){ /* begining of structure or union declaration */
q
= block( FREE
, NIL
, NIL
, 0, 0, 0 );
if( instruct
==INSTRUCT
){
if( idn
>= 0 ) defid( q
, STNAME
);
else if( instruct
== INUNION
) {
if( idn
>= 0 ) defid( q
, UNAME
);
if( idn
>= 0 ) defid( q
, ENAME
);
psave( idn
= q
->tn
.rval
);
/* the "real" definition is where the members are seen */
if ( idn
>= 0 ) stab
[idn
].suse
= lineno
;
register struct symtab
*p
;
register i
, al
, sa
, j
, sz
, szindex
;
paramstack[ oparam ] = previous instruct
paramstack[ oparam+1 ] = previous class
paramstk[ oparam+2 ] = previous strucoff
paramstk[ oparam+3 ] = structure name
paramstk[ oparam+4, ... ] = member stab indices
if( (i
=paramstk
[oparam
+3]) < 0 ){
dstash( -1 ); /* index to member names */
dstash( ALSTRUCT
); /* alignment */
dstash( -lineno
); /* name of structure */
szindex
= stab
[i
].sizoff
;
printf( "dclstruct( %.8s ), szindex = %d\n", (i
>=0)? stab
[i
].sname
: "??", szindex
);
printf( "dclstruct( %s ), szindex = %d\n", (i
>=0)? stab
[i
].sname
: "??", szindex
);
temp
= (instruct
&INSTRUCT
)?STRTY
:((instruct
&INUNION
)?UNIONTY
:ENUMTY
);
stwart
= instruct
= paramstk
[ oparam
];
curclass
= paramstk
[ oparam
+1 ];
dimtab
[ szindex
+1 ] = curdim
;
for( i
= oparam
+4; i
< paramno
; ++i
){
if( j
<0 || j
>= SYMTSZ
) cerror( "gummy structure member" );
if( p
->offset
< low
) low
= p
->offset
;
if( p
->offset
> high
) high
= p
->offset
;
sa
= talign( p
->stype
, p
->sizoff
);
sz
= tsize( p
->stype
, p
->dimoff
, p
->sizoff
);
werror( "illegal zero sized structure member: %.8s", p
->sname
);
werror( "illegal zero sized structure member: %s", p
->sname
);
if( sz
> strucoff
) strucoff
= sz
; /* for use with unions */
/* set al, the alignment, to the lcm of the alignments of the members */
dstash( -1 ); /* endmarker */
if( (char)high
== high
&& (char)low
== low
) ty
= ctype( CHAR
);
else if( (short)high
== high
&& (short)low
== low
) ty
= ctype( SHORT
);
strucoff
= tsize( ty
, 0, (int)ty
);
dimtab
[ szindex
+2 ] = al
= talign( ty
, (int)ty
);
if( strucoff
== 0 ) uerror( "zero sized structure" );
dimtab
[ szindex
] = strucoff
;
dimtab
[ szindex
+2 ] = al
;
dimtab
[ szindex
+3 ] = paramstk
[ oparam
+3 ]; /* name index */
FIXSTRUCT( szindex
, oparam
); /* local hook, eg. for sym debugger */
printf( "\tdimtab[%d,%d,%d] = %d,%d,%d\n", szindex
,szindex
+1,szindex
+2,
dimtab
[szindex
],dimtab
[szindex
+1],dimtab
[szindex
+2] );
for( i
= dimtab
[szindex
+1]; dimtab
[i
] >= 0; ++i
){
printf( "\tmember %.8s(%d)\n", stab
[dimtab
[i
]].sname
, dimtab
[i
] );
printf( "\tmember %s(%d)\n", stab
[dimtab
[i
]].sname
, dimtab
[i
] );
strucoff
= paramstk
[ oparam
+2 ];
return( mkty( temp
, 0, szindex
) );
yyerror( s
) char *s
; { /* error printing routine in parser */
switch( stab
[idn
].stype
){
/* this parameter, entered at scan */
uerror("redeclaration of formal parameter, %.8s",
uerror("redeclaration of formal parameter, %s",
/* the name of this function matches parm */
/* unused entry, fill it */
stab
[idn
].sclass
= PARAM
;
talign( ty
, s
) register unsigned ty
; register s
; {
/* compute the alignment of an object with type ty, sizeoff index s */
if( s
<0 && ty
!=INT
&& ty
!=CHAR
&& ty
!=SHORT
&& ty
!=UNSIGNED
&& ty
!=UCHAR
&& ty
!=USHORT
for( i
=0; i
<=(SZINT
-BTSHIFT
-1); i
+=TSHIFT
){
cerror( "compiler takes alignment of function");
return( (unsigned int) dimtab
[ s
+2 ] );
tsize( ty
, d
, s
) TWORD ty
; {
/* compute the size associated with type ty,
dimoff d, and sizoff s */
/* BETTER NOT BE CALLED WHEN t, d, and s REFER TO A BIT FIELD... */
for( i
=0; i
<=(SZINT
-BTSHIFT
-1); i
+=TSHIFT
){
cerror( "compiler takes size of function");
return( SZPOINT
* mult
);
mult
*= (unsigned int) dimtab
[ d
++ ];
return( (unsigned int) dimtab
[ s
] * mult
);
inforce( n
) OFFSZ n
; { /* force inoff to have the value n */
/* inoff is updated to have the value n */
/* rest is used to do a lot of conversion to ints... */
cerror( "initialization alignment error");
/* wb now has the next higher word boundary */
if( wb
>= n
){ /* in the same word */
/* otherwise, extend inoff to be word aligned */
/* now, skip full words until near to n */
/* now, the remainder of the last word */
if( inoff
!= n
) cerror( "inoff error");
vfdalign( n
){ /* make inoff have the offset the next alignment of n */
int ibseen
= 0; /* the number of } constructions which have been filled */
int iclass
; /* storage class of thing being initialized */
int ilocctr
= 0; /* location counter for current initialization */
/* beginning of initilization; set location ctr and set type */
register struct symtab
*p
;
if( idebug
>= 3 ) printf( "beginit(), curid = %d\n", curid
);
if( curclass
== EXTERN
|| curclass
== FORTRAN
) iclass
= EXTERN
;
ilocctr
= ISARY(p
->stype
)?ADATA
:DATA
;
defalign( talign( p
->stype
, p
->sizoff
) );
instk( curid
, p
->stype
, p
->dimoff
, p
->sizoff
, inoff
);
instk( id
, t
, d
, s
, off
) OFFSZ off
; TWORD t
; {
/* make a new entry on the parameter stack to initialize id */
register struct symtab
*p
;
if( idebug
) printf( "instk((%d, %o,%d,%d, %d)\n", id
, t
, d
, s
, off
);
/* save information on the stack */
if( !pstk
) pstk
= instack
;
pstk
->in_fl
= 0; /* { flag */
pstk
->in_n
= 0; /* number seen */
pstk
->in_x
= t
==STRTY
?dimtab
[s
+1] : 0 ;
pstk
->in_off
= off
; /* offset at the beginning of this element */
/* if t is an array, DECREF(t) can't be a field */
/* INS_sz has size of array elements, and -size for fields */
pstk
->in_sz
= tsize( DECREF(t
), d
+1, s
);
else if( stab
[id
].sclass
& FIELD
){
pstk
->in_sz
= - ( stab
[id
].sclass
& FLDSIZ
);
if( (iclass
==AUTO
|| iclass
== REGISTER
) &&
(ISARY(t
) || t
==STRTY
) ) uerror( "no automatic aggregate initialization" );
/* now, if this is not a scalar, put on another element */
if( p
->sclass
!= MOS
&& !(p
->sclass
&FIELD
) ) cerror( "insane structure member list" );
getstr(){ /* decide if the string is external or an initializer, and get the contents accordingly */
if( (iclass
==EXTDEF
||iclass
==STATIC
) && (pstk
->in_t
== CHAR
|| pstk
->in_t
== UCHAR
) &&
pstk
!=instack
&& ISARY( pstk
[-1].in_t
) ){
/* treat "abc" as { 'a', 'b', 'c', 0 } */
ilbrace(); /* simulate { */
/* if the array is inflexible (not top level), pass in the size and
be prepared to throw away unwanted initializers */
lxstr((pstk
-1)!=instack
?dimtab
[(pstk
-1)->in_d
]:0); /* get the contents */
irbrace(); /* simulate } */
else { /* make a label, and get the contents and stash them away */
if( iclass
!= SNULL
){ /* initializing */
/* fill out previous word, to permit pointer */
temp
= locctr( blevel
==0?ISTRNG
:STRNG
); /* set up location counter */
lxstr(0); /* get the contents */
locctr( blevel
==0?ilocctr
:temp
);
p
= buildtree( STRING
, NIL
, NIL
);
putbyte( v
){ /* simulate byte v appearing in a list of integer values */
if( idebug
) printf( "endinit(), inoff = %d\n", inoff
);
vfdalign( pstk
->in_sz
); /* fill out part of the last element, if needed */
n
= inoff
/pstk
->in_sz
; /* real number of initializers */
/* once again, t is an array, so no fields */
inforce( tsize( t
, d
, s
) );
if( d1
!=0 && d1
!=n
) uerror( "too many initializers");
if( n
==0 ) werror( "empty array declaration");
if( d1
==0 ) FIXDEF(&stab
[pstk
->in_id
]);
else if( t
== STRTY
|| t
== UNIONTY
){
/* clearly not fields either */
inforce( tsize( t
, d
, s
) );
else if( n
> 1 ) uerror( "bad scalar initialization");
/* this will never be called with a field element... */
else inforce( tsize(t
,d
,s
) );
doinit( p
) register NODE
*p
; {
/* take care of generating a value for the initializer p */
/* inoff has the current offset (last bit written)
in the current word being generated */
/* note: size of an individual initializer is assumed to fit into an int */
if( iclass
< 0 ) goto leave
;
if( iclass
== EXTERN
|| iclass
== UNAME
){
uerror( "cannot initialize extern or union" );
if( iclass
== AUTO
|| iclass
== REGISTER
){
/* do the initialization and get out, without regard
for filing out the variable with zeros, etc. */
p
= buildtree( ASSIGN
, buildtree( NAME
, NIL
, NIL
), p
);
if( p
== NIL
) return; /* for throwing away strings that have been turned into lists */
if( idebug
> 1 ) printf( "doinit(%o)\n", p
);
t
= pstk
->in_t
; /* type required */
if( pstk
->in_sz
< 0 ){ /* bit field */
p
= buildtree( ASSIGN
, block( NAME
, NIL
,NIL
, t
, d
, s
), p
);
p
->in
.left
->in
.op
= FREE
;
p
->in
.left
= p
->in
.right
;
p
->in
.left
= optim( p
->in
.left
);
if( p
->in
.left
->in
.op
== UNARY AND
){
p
->in
.left
->in
.op
= FREE
;
p
->in
.left
= p
->in
.left
->in
.left
;
if( sz
< SZINT
){ /* special case: bit fields, etc. */
if( p
->in
.left
->in
.op
!= ICON
) uerror( "illegal initialization" );
else incode( p
->in
.left
, sz
);
else if( p
->in
.left
->in
.op
== FCON
){
fincode( p
->in
.left
->fpn
.dval
, sz
);
for( ; pstk
> instack
; ) {
if( pstk
->in_fl
) ++ibseen
;
if( (id
=dimtab
[ix
]) < 0 ) continue;
/* otherwise, put next element on the stack */
instk( id
, p
->stype
, p
->dimoff
, p
->sizoff
, p
->offset
+pstk
->in_off
);
if( n
>= dimtab
[pstk
->in_d
] && pstk
> instack
) continue;
/* put the new element onto the stack */
instk( pstk
->in_id
, (TWORD
)DECREF(pstk
->in_t
), pstk
->in_d
+1, pstk
->in_s
,
ilbrace(){ /* process an initializer's left brace */
for( ; pstk
> instack
; --pstk
){
if( t
!= STRTY
&& !ISARY(t
) ) continue; /* not an aggregate */
if( pstk
->in_fl
){ /* already associated with a { */
if( pstk
->in_n
) uerror( "illegal {");
/* ignore such right braces */
/* called when a '}' is seen */
if( idebug
) printf( "irbrace(): paramno = %d on entry\n", paramno
);
for( ; pstk
> instack
; --pstk
){
if( !pstk
->in_fl
) continue;
pstk
->in_fl
= 0; /* cancel { */
gotscal(); /* take it away... */
/* these right braces match ignored left braces: throw out */
upoff( size
, alignment
, poff
) register alignment
, *poff
; {
/* update the offset pointed to by poff; return the
/* offset of a value of size `size', alignment `alignment',
/* given that off is increasing */
SETOFF( off
, alignment
);
if( (offsz
-off
) < size
){
if( instruct
!=INSTRUCT
)cerror("too many local variables");
else cerror("Structure too large");
oalloc( p
, poff
) register struct symtab
*p
; register *poff
; {
/* allocate p with offset *poff, and update *poff */
al
= talign( p
->stype
, p
->sizoff
);
tsz
= tsize( p
->stype
, p
->dimoff
, p
->sizoff
);
if( (offsz
-off
) < tsz
) cerror("too many local variables");
if( p
->sclass
== PARAM
&& ( tsz
< SZINT
) ){
off
= upoff( SZINT
, ALINT
, &noff
);
off
= upoff( tsz
, al
, &noff
);
if( p
->sclass
!= REGISTER
){ /* in case we are allocating stack space for register arguments */
if( p
->offset
== NOOFFSET
) p
->offset
= off
;
else if( off
!= p
->offset
) return(1);
falloc( p
, w
, new, pty
) register struct symtab
*p
; NODE
*pty
; {
/* allocate a field of width w */
/* new is 0 if new entry, 1 if redefinition, -1 if alignment */
type
= (new<0)? pty
->in
.type
: p
->stype
;
/* this must be fixed to use the current type in alignments */
switch( new<0?pty
->in
.type
:p
->stype
){
s
= new<0 ? pty
->fn
.csiz
: p
->sizoff
;
uerror( "illegal field type" );
uerror( "field too big");
if( w
== 0 ){ /* align only */
if( new >= 0 ) uerror( "zero size field");
if( strucoff
%al
+ w
> sz
) SETOFF( strucoff
, al
);
if( (offsz
-strucoff
) < w
)
cerror("structure too large");
strucoff
+= w
; /* we know it will fit */
/* establish the field */
if( new == 1 ) { /* previous definition */
if( p
->offset
!= strucoff
|| p
->sclass
!= (FIELD
|w
) ) return(1);
if( (offsz
-strucoff
) < w
) cerror("structure too large");
nidcl( p
) NODE
*p
; { /* handle unitialized declarations */
/* assumed to be not functions */
register commflag
; /* flag for labelled common declarations */
if( (class=curclass
) == SNULL
){
if( blevel
> 1 ) class = AUTO
;
else if( blevel
!= 0 || instruct
) cerror( "nidcl error" );
if( class == EXTERN
) commflag
= 1;
/* hack so stab will come at as LCSYM rather than STSYM */
if( class==EXTDEF
|| class==STATIC
){
register struct symtab
*s
= &stab
[p
->tn
.rval
];
int sz
= tsize(s
->stype
, s
->dimoff
, s
->sizoff
)/SZCHAR
;
sz
+= sizeof (int) - (sz
% sizeof (int));
printf(" .lcomm L%d,%d\n", s
->offset
, sz
);
printf(" .lcomm %s,%d\n", exname(s
->sname
), sz
);
}else if (class == EXTDEF
) {
/* simulate initialization by 0 */
if( commflag
) commdec( p
->tn
.rval
);
types( t1
, t2
, t3
) TWORD t1
, t2
, t3
; {
/* return a basic type from basic types t1, t2, and t3 */
TWORD t
[3], noun
, adj
, unsg
;
unsg
= INT
; /* INT or UNSIGNED */
noun
= UNDEF
; /* INT, CHAR, or FLOAT */
adj
= INT
; /* INT, LONG, or SHORT */
uerror( "illegal type combination" );
if( unsg
!= INT
) goto bad
;
if( adj
!= INT
) goto bad
;
if( noun
!= UNDEF
) goto bad
;
/* now, construct final type */
if( noun
== UNDEF
) noun
= INT
;
else if( noun
== FLOAT
){
if( unsg
!= INT
|| adj
== SHORT
) goto bad
;
return( adj
==LONG
? DOUBLE
: FLOAT
);
else if( noun
== CHAR
&& adj
!= INT
) goto bad
;
/* now, noun is INT or CHAR */
if( adj
!= INT
) noun
= adj
;
if( unsg
== UNSIGNED
) return( noun
+ (UNSIGNED
-INT
) );
tymerge( typ
, idp
) NODE
*typ
, *idp
; {
/* merge type typ with identifier idp */
if( typ
->in
.op
!= TYPE
) cerror( "tymerge: arg 1" );
if(idp
== NIL
) return( NIL
);
if( ddebug
> 2 ) fwalk( idp
, eprint
, 0 );
idp
->in
.type
= typ
->in
.type
;
idp
->fn
.csiz
= typ
->fn
.csiz
;
for( t
=typ
->in
.type
, i
=typ
->fn
.cdim
; t
&TMASK
; t
= DECREF(t
) ){
if( ISARY(t
) ) dstash( dimtab
[i
++] );
/* now idp is a single node: fix up type */
idp
->in
.type
= ctype( idp
->in
.type
);
if( (t
= BTYPE(idp
->in
.type
)) != STRTY
&& t
!= UNIONTY
&& t
!= ENUMTY
){
idp
->fn
.csiz
= t
; /* in case ctype has rewritten things */
tyreduce( p
) register NODE
*p
; {
/* build a type, and stash away dimensions, from a parse tree of the declaration */
/* the type is build top down, the dimensions bottom up */
t
= INCREF( p
->in
.type
);
if( o
== UNARY CALL
) t
+= (FTN
-PTR
);
temp
= p
->in
.right
->tn
.lval
;
p
->in
.right
->in
.op
= FREE
;
if( ( temp
== 0 ) & ( p
->in
.left
->tn
.op
== LB
) )
uerror( "Null dimension" );
if( o
== LB
) dstash( temp
);
p
->tn
.rval
= p
->in
.left
->tn
.rval
;
p
->in
.type
= p
->in
.left
->in
.type
;
fixtype( p
, class ) register NODE
*p
; {
register unsigned t
, type
;
/* fix up the types, and check for legality */
if( (type
= p
->in
.type
) == UNDEF
) return;
if( mod2
= (type
&TMASK
) ){
while( mod1
=mod2
, mod2
= (t
&TMASK
) ){
if( mod1
== ARY
&& mod2
== FTN
){
uerror( "array of functions is illegal" );
else if( mod1
== FTN
&& ( mod2
== ARY
|| mod2
== FTN
) ){
uerror( "function returns illegal type" );
/* detect function arguments, watching out for structure declarations */
/* for example, beware of f(x) struct [ int a[10]; } *x; { ... } */
/* the danger is that "a" will be converted to a pointer */
if( class==SNULL
&& blevel
==1 && !(instruct
&(INSTRUCT
|INUNION
)) ) class = PARAM
;
if( class == PARAM
|| ( class==REGISTER
&& blevel
==1 ) ){
if( type
== FLOAT
) type
= DOUBLE
;
werror( "a function is declared as an argument" );
if( instruct
&& ISFTN(type
) ){
uerror( "function illegal in structure or union" );
uclass( class ) register class; {
/* give undefined version of class */
if( class == SNULL
) return( EXTERN
);
else if( class == STATIC
) return( USTATIC
);
else if( class == FORTRAN
) return( UFORTRAN
);
fixclass( class, type
) TWORD type
; {
/* first, fix null class */
if( instruct
&INSTRUCT
) class = MOS
;
else if( instruct
&INUNION
) class = MOU
;
else if( blevel
== 0 ) class = EXTDEF
;
else if( blevel
== 1 ) class = PARAM
;
/* now, do general checking */
uerror( "function has illegal storage class" );
if( !(instruct
&INSTRUCT
) ) uerror( "illegal use of field" );
if( !(instruct
&INUNION
) ) uerror( "illegal class" );
if( !(instruct
&INSTRUCT
) ) uerror( "illegal class" );
if( instruct
& (INSTRUCT
|INUNION
) ) uerror( "illegal class" );
if( blevel
== 0 ) uerror( "illegal register declaration" );
else if( regvar
>= MINRVAR
&& cisreg( type
) ) return( class );
if( blevel
== 1 ) return( PARAM
);
if( blevel
< 2 ) uerror( "illegal class" );
if( blevel
!= 1 ) uerror( "illegal class" );
NOFORTRAN
; /* a condition which can regulate the FORTRAN usage */
if( !ISFTN(type
) ) uerror( "fortran declaration must apply to function" );
if( ISFTN(type
) || ISARY(type
) || ISPTR(type
) ) {
uerror( "fortran function has wrong type" );
cerror( "illegal class: %d", class );
mknonuniq(idindex
) int *idindex
; {/* locate a symbol table entry for */
/* an occurrence of a nonunique structure member name */
register struct symtab
* sp
;
sp
= & stab
[ i
= *idindex
]; /* position search at old entry */
while( sp
->stype
!= TNULL
){ /* locate unused entry */
if( ++i
>= SYMTSZ
){/* wrap around symbol table */
if( i
== *idindex
) cerror("Symbol table full");
sp
->sflags
= SNONUNIQ
| SMOS
;
q
= stab
[*idindex
].sname
; /* old entry name */
sp
->sname
= stab
[*idindex
].sname
;
printf("\tnonunique entry for %s from %d to %d\n",
for( i
=1; i
<=NCHNAM
; ++i
){ /* copy name */
if( *p
++ = *q
/* assign */ ) ++q
;
lookup( name
, s
) char *name
; {
/* look up name: must agree with s w.r.t. STAG, SMOS and SHIDDEN */
register struct symtab
*sp
;
/* compute initial hash index */
printf( "lookup( %s, %d ), stwart=%d, instruct=%d\n", name
, s
, stwart
, instruct
);
for( p
=name
, j
=0; *p
!= '\0'; ++p
){
if( ++j
>= NCHNAM
) break;
for(;;){ /* look for name */
if( sp
->stype
== TNULL
){ /* empty slot */
sp
->sflags
= s
; /* set STAG, SMOS if needed, turn off all others */
for( j
=0; j
<NCHNAM
; ++j
) if( *p
++ = *name
) ++name
;
if( (sp
->sflags
& (STAG
|SMOS
|SHIDDEN
)) != s
) goto next
;
for( j
=0; j
<NCHNAM
;++j
){
if( *p
++ != *q
) goto next
;
if( i
== ii
) cerror( "symbol table full" );
/* if not debugging, make checkst a macro */
register struct symtab
*p
, *q
;
for( i
=0, p
=stab
; i
<SYMTSZ
; ++i
, ++p
){
if( p
->stype
== TNULL
) continue;
j
= lookup( p
->sname
, p
->sflags
&(SMOS
|STAG
) );
q
->slevel
<= p
->slevel
){
cerror( "check error: %.8s", q
->sname
);
cerror( "check error: %s", q
->sname
);
else if( p
->slevel
> lev
) cerror( "%.8s check at level %d", p
->sname
, lev
);
else if( p
->slevel
> lev
) cerror( "%s check at level %d", p
->sname
, lev
);
relook(p
) register struct symtab
*p
; { /* look up p again, and see where it lies */
register struct symtab
*q
;
/* I'm not sure that this handles towers of several hidden definitions in all cases */
q
= &stab
[lookup( p
->sname
, p
->sflags
&(STAG
|SMOS
|SHIDDEN
) )];
/* make relook always point to either p or an empty cell */
if( q
->stype
== TNULL
) break;
if( ++q
>= &stab
[SYMTSZ
] ) q
=stab
;
clearst( lev
){ /* clear entries of internal scope from the symbol table */
register struct symtab
*p
, *q
, *r
;
register int temp
, rehash
;
/* first, find an empty slot to prevent newly hashed entries from
for( q
=stab
; q
< &stab
[SYMTSZ
]; ++q
){
if( q
->stype
== TNULL
)goto search
;
cerror( "symbol table full");
if( p
->stype
== TNULL
) {
if( lineno
< 0 ) lineno
= - lineno
;
if( p
->slevel
>lev
){ /* must clobber */
if( p
->stype
== UNDEF
|| ( p
->sclass
== ULABEL
&& lev
< 2 ) ){
uerror( "%.8s undefined", p
->sname
);
uerror( "%s undefined", p
->sname
);
if (ddebug
) printf("removing %8s from stab[ %d], flags %o level %d\n",
if (ddebug
) printf("removing %s from stab[ %d], flags %o level %d\n",
p
->sname
,p
-stab
,p
->sflags
,p
->slevel
);
if( p
->sflags
& SHIDES
) unhide(p
);
if( (r
=relook(p
)) != p
){
if( ++p
>= &stab
[SYMTSZ
] ) p
= stab
;
movestab( p
, q
) register struct symtab
*p
, *q
; {
/* structure assignment: *p = *q; */
for( k
=0; k
<NCHNAM
; ++k
){
p
->sname
[k
] = q
->sname
[k
];
hide( p
) register struct symtab
*p
; {
register struct symtab
*q
;
if( q
>= &stab
[SYMTSZ
] ) q
= stab
;
if( q
== p
) cerror( "symbol table full" );
if( q
->stype
== TNULL
) break;
q
->sflags
= (p
->sflags
&(SMOS
|STAG
)) | SHIDES
;
if( hflag
) werror( "%.8s redefinition hides earlier one", p
->sname
);
if( hflag
) werror( "%s redefinition hides earlier one", p
->sname
);
if( ddebug
) printf( " %d hidden in %d\n", p
-stab
, q
-stab
);
return( idname
= q
-stab
);
unhide( p
) register struct symtab
*p
; {
register struct symtab
*q
;
s
= p
->sflags
& (SMOS
|STAG
);
if( q
== stab
) q
= &stab
[SYMTSZ
-1];
if( (q
->sflags
&(SMOS
|STAG
)) == s
){
for( j
=0; j
<NCHNAM
; ++j
) if( p
->sname
[j
] != q
->sname
[j
] ) break;
if( j
== NCHNAM
){ /* found the name */
if (p
->sname
== q
->sname
) {
if( ddebug
) printf( "unhide uncovered %d from %d\n", q
-stab
,p
-stab
);
cerror( "unhide fails" );