static bool BlockName( unsigned_16 rb_defined )
{
sym_id sym_ptr;
unsigned_16 flag_mask;
bool rb_name;
CSExtn();
rb_name = FALSE;
if( ReqName( NAME_REM_BLOCK ) ) {
sym_ptr = LkSym();
if( ( sym_ptr->ns.flags & ~SY_REFERENCED ) == 0 ) {
sym_ptr->ns.si.rb.entry = NextLabel();
sym_ptr->ns.flags = RB_FLAGS;
}
flag_mask = (unsigned_16)~( SY_RB_DEFINED | SY_REFERENCED );
if( ( ( sym_ptr->ns.flags & flag_mask ) == RB_FLAGS ) &&
( ( sym_ptr->ns.flags & rb_defined ) == 0 ) ) {
sym_ptr->ns.flags |= rb_defined;
rb_name = TRUE;
} else {
IllName( sym_ptr );
}
}
return( rb_name );
}
static bool ReadKWList( void ) {
//====================================
OPR opr;
if( Scan4ListOprs() )
return( true );
if( SPtr1->opn.ds != DSOPN_PHI )
return( true ); // have ( ciolist ) name
opr = SPtr1->link->opr;
if( opr == OPR_COM )
return( false ); // have ( fmt ),
if( opr == OPR_LBR )
return( true ); // we have ( ciolist ) (a(i) i==1,10)
if( opr != OPR_TRM )
return( false );
if( RecNOpn() )
return( false );
if( CITNode->opn.ds == DSOPN_LIT )
return( false );
if( CITNode->opn.ds > DSOPN_LIT )
return( true );
if( LkSym()->u.ns.u1.s.typ == FT_CHAR )
return( false );
return( true );
}
static parameter *NameParm( entry_pt *entry )
{
// Process a symbolic dummy argument.
parameter *result;
sym_id sym;
act_dim_list *dim_ptr;
unsigned_16 flags;
unsigned_16 class;
sym = LkSym();
flags = sym->u.ns.flags;
class = flags & SY_CLASS;
if( class == SY_VARIABLE ) {
if( InArgList( entry, sym ) ) {
NameErr( AR_DUPLICATE_PARM, sym );
return( NULL );
} else if( flags & SY_SAVED ) {
Error( SA_SAVED );
return( NULL );
} else if( flags & SY_IN_EC ) {
IllName( sym );
return( NULL );
} else if( flags & SY_SUBSCRIPTED ) {
dim_ptr = sym->u.ns.si.va.u.dim_ext;
if( dim_ptr->dim_flags & DIM_PVD ) {
dim_ptr->dim_flags |= DIM_ASSUMED;
NameExt( SV_PVD, sym );
if( dim_ptr->dim_flags & DIM_USED_IN_IO ) {
NameErr( SV_CANT_USE_ASSUMED, sym );
return( NULL );
}
}
}
} else if( class == SY_PARAMETER ) {
void CpIntrinsic(void) {
//=====================
// Compile INTRINSIC statement.
// INTRINSIC FUNC {,FUNC1} . . .
unsigned_16 flags;
IFF func;
sym_id sym_ptr;
TYPE func_typ;
for(;;) {
if( ReqName( NAME_INTRINSIC ) ) {
func = IFLookUp();
if( func > 0 ) {
func_typ = IFType( func );
sym_ptr = LkSym();
flags = sym_ptr->u.ns.flags;
if( ( flags & SY_USAGE ) != 0 ) {
if( ( flags & SY_CLASS ) == SY_SUBPROGRAM ) {
if( ( flags & SY_INTRINSIC ) != 0 ) {
Error( SR_PREV_INTRNSC );
} else if( ( flags & SY_EXTERNAL ) != 0 ) {
Error( SR_INTRNSC_EXTRN );
}
} else {
IllName( sym_ptr );
}
} else if( flags & ERR_MASK ) {
IllName( sym_ptr );
} else if( ( flags & SY_TYPE ) &&
( sym_ptr->u.ns.u1.s.typ != func_typ ) ) {
NameTypeErr( TY_TYP_PREV_DEF, sym_ptr );
} else {
// we must OR the flags since SY_TYPE and/or SY_REFERENCED
// bit might already be set in the symbol table
sym_ptr->u.ns.flags |= SY_USAGE | SY_SUBPROGRAM |
SY_FUNCTION | SY_INTRINSIC;
func_typ = IFType( func );
sym_ptr->u.ns.u1.s.typ = func_typ;
sym_ptr->u.ns.xt.size = TypeSize( func_typ );
sym_ptr->u.ns.si.fi.index = func;
}
} else {
Error( SR_NOT_INTRNSC );
}
}
AdvanceITPtr();
if( !RecComma() ) {
break;
}
}
ReqEOS();
}
static void VarList( void ) {
//=========================
// Process one variable list in a DATA statement.
OPR last_opr;
OPR opr;
int do_level;
itnode *last_node;
do_level = 0;
last_opr = FindSlash( &last_node );
while( CITNode != last_node ) {
if( AError )
break;
if( RecTrmOpr() && ( CITNode != ITHead ) ) {
--do_level;
FinishImpDo();
} else if( StartImpDo() ) {
++do_level;
} else if( ReqName( NAME_VAR_OR_ARR ) ) {
InitVar = LkSym();
if( InitVar->u.ns.u1.s.typ == FT_STRUCTURE ) {
// make sure structure size is calculated - normally
// structure size is calculated by StructResolve() which
// is not called until the first executable statement
CalcStructSize( InitVar->u.ns.xt.sym_record );
}
CkFlags();
opr = CITNode->opr;
ProcDataExpr();
CITNode->opr = opr;
ListItem();
if( !RecTrmOpr() ) {
ReqComma();
}
} else {
AdvanceITPtr();
AError = true;
break;
}
}
if( AError ) {
while( do_level != 0 ) { // clean up hanging do entrys
TermDo();
--do_level;
}
} else {
CITNode->opr = last_opr;
ReqDiv();
}
}
void CpCall(void) {
//================
itnode *next;
unsigned_16 sp_type;
next = CITNode->link;
if( next->opr == OPR_TRM ) {
ASType = AST_CNA; // call with no parameter list
} else if( ( next->opr == OPR_LBR ) &&
( next->opn.ds == DSOPN_PHI ) &&
( next->link->opr == OPR_RBR ) &&
( next->link->opn.ds == DSOPN_PHI ) &&
( next->link->link->opr == OPR_TRM ) ) {
next->opr = OPR_TRM; // make CALL SAM() same as CALL SAM
ASType = AST_CNA; // call with no parameter list
} else {
ReqNextOpr( OPR_LBR, SX_SURP_OPR );
if( ( SPtr1 != NULL ) && ( SPtr1->link->opr != OPR_TRM ) ) {
Error( SX_JUNK_AFTER_RBR ); // ignore anything after
SPtr1->link->opr = OPR_TRM; // closing parenthesis
}
ASType = AST_OFF;
}
if( ReqName( NAME_SUBROUTINE ) ) {
LkSym();
if( ClassIs( SY_SUBPROGRAM ) ) {
sp_type = CITNode->flags & SY_SUBPROG_TYPE;
if( sp_type == SY_SUBROUTINE ) {
ASType |= AST_ALT;
Arith();
} else if( sp_type == SY_FUNCTION ) {
Extension( SR_FUNC_AS_SUB );
Arith();
} else if( sp_type == 0 ) {
ArithNewSubr();
} else {
Error( SR_NO_SUBRTN_NAME );
}
} else {
if( CITNode->flags & SY_USAGE ) {
Error( SR_NO_SUBRTN_NAME );
} else if( CITNode->flags & SY_SAVED ) {
Error( SA_SAVED );
} else {
ArithNewSubr();
}
}
}
}
void CpSave( void ) {
//================
// Compile SAVE statement : SAVE A1 {,A2 ... }
//
// where Ai is 1. a common block name preceded and followed by a /
// 2. an array name
// 3. a variable name
sym_id sym_ptr;
if( RecNOpn() && RecNextOpr( OPR_TRM ) ) {
if( ( (SgmtSw & SG_LITTLE_SAVE) != 0 ) || ( (SgmtSw & SG_BIG_SAVE) != 0 ) ) {
Error( SA_SAVED );
}
SgmtSw |= SG_BIG_SAVE;
} else {
for( ;; ) {
if( RecNOpn() && RecNextOpr( OPR_DIV ) ) {
AdvanceITPtr();
if( ReqName( NAME_COMMON ) ) {
sym_ptr = LkCommon();
if( sym_ptr->u.ns.flags == 0 ) {
sym_ptr->u.ns.flags |= SY_USAGE | SY_COMMON;
}
Save( sym_ptr );
}
AdvanceITPtr();
ReqDiv();
ReqNOpn();
} else if( ReqName( NAME_VAR_OR_ARR ) ) {
sym_ptr = LkSym();
if( ( sym_ptr->u.ns.flags & ~SV_ON_OR_OFF ) != SY_VARIABLE ) {
IllName( sym_ptr );
} else {
Save( sym_ptr );
}
}
AdvanceITPtr();
if( !RecComma() ) {
break;
}
}
ReqEOS();
}
}
void CpEntry( void )
{
entry_pt *entry;
bool in_subr;
sym_id sym;
if( ( ProgSw & PS_IN_SUBPROGRAM ) == 0 ) {
StmtErr( SR_ILL_IN_PROG );
}
if( !EmptyCSList() ) {
Error( EY_NOT_IN_CS );
}
if( ReqName( NAME_FUNCTION ) ) {
in_subr = (SubProgId->u.ns.flags & SY_SUBPROG_TYPE) == SY_SUBROUTINE;
sym = LkSym();
if( ( sym->u.ns.flags & (SY_USAGE|SY_SUB_PARM|SY_IN_EC|SY_SAVED) ) ||
( in_subr && (sym->u.ns.flags & SY_TYPE) ) ) {
IllName( sym );
} else {
sym->u.ns.u1.s.typ = CITNode->typ;
sym->u.ns.flags &= SY_TYPE;
if( in_subr ) {
sym->u.ns.flags |= SY_USAGE | SY_SUBPROGRAM | SY_SENTRY |
SY_SUBROUTINE | SY_REFERENCED;
} else {
sym->u.ns.flags |= SY_USAGE | SY_SUBPROGRAM | SY_SENTRY |
SY_FUNCTION;
}
STFnShadow( sym );
entry = AddEntryPt( sym );
AdvanceITPtr();
if( Options & OPT_TRACE ) {
GSetSrcLine();
}
if( RecOpenParen() ) {
ParmList( in_subr, entry );
ReqCloseParen();
ReqNOpn();
AdvanceITPtr();
}
BIStartRBorEP( sym );
ReqEOS();
}
}
SgmtSw &= ~SG_PROLOG_DONE; // indicate we need prologue
}
void CpExternal(void) {
//====================
// Compile EXTERNAL statement.
// EXTERNAL PROC {,PROC1} . . .
sym_id sym;
unsigned_16 flags;
for(;;) {
if( ReqName( NAME_EXT_PROC ) ) {
sym = LkSym();
flags = sym->u.ns.flags;
if( ( flags & SY_CLASS ) == SY_SUBPROGRAM ) {
if( ( flags & SY_EXTERNAL ) != 0 ) {
Error( SR_EXTRNED_TWICE );
} else if( ( flags & SY_INTRINSIC ) != 0 ) {
Error( SR_INTRNSC_EXTRN );
}
} else if( ( flags & SY_USAGE ) != 0 ) {
IllName( sym );
} else {
flags = SY_USAGE | SY_SUBPROGRAM | SY_EXTERNAL;
if( ( sym->u.ns.flags & SY_TYPE ) != 0 ) {
flags |= SY_FUNCTION;
}
sym->u.ns.flags |= flags;
if( ( Options & OPT_REFERENCE ) == 0 ) {
sym->u.ns.flags |= SY_RELAX_EXTERN;
}
}
}
AdvanceITPtr();
if( !RecComma() ) break;
}
ReqEOS();
}
static entry_pt *SubProgName( TYPE typ, unsigned_16 flags,
uint def_size, bool len_spec )
{
// Process the symbolic name of a SUBROUTINE or FUNCTION.
entry_pt *entry;
itnode *name_node;
itnode *next_node;
sym_id sym_ptr;
uint size;
sym_ptr = LkSym();
SubProgId = sym_ptr;
GSegLabel(); // must be before DumpStatement() so that ISN code for
if( Options & OPT_TRACE ) {
GSetSrcLine();
}
name_node = CITNode;
sym_ptr->u.ns.flags = flags;
name_node->flags = flags;
size = def_size;
next_node = CITNode->link;
if( !len_spec ) {
AdvanceITPtr();
if( !LenSpec( typ, &size ) ) {
size = StorageSize( typ );
}
next_node = CITNode;
}
sym_ptr->u.ns.xt.size = size;
name_node->size = size;
typ = MapTypes( typ, size );
sym_ptr->u.ns.u1.s.typ = typ;
name_node->typ = typ;
CITNode = name_node;
entry = AddEntryPt( sym_ptr );
CITNode = next_node;
return( entry );
}
void CpVolatile( void ) {
//====================
// Compile VOLATILE statement.
// VOLATILE VAR {,VAR1} . . .
sym_id sym;
for(;;) {
if( ReqName( NAME_VAR_OR_ARR ) ) {
sym = LkSym();
if( (sym->ns.flags & ~ERR_MASK ) != SY_VARIABLE ) {
IllName( sym );
} else {
sym->ns.xflags |= SY_VOLATILE;
}
}
AdvanceITPtr();
if( !RecComma() ) break;
}
ReqEOS();
}
static bool IsVariable( void ) {
//============================
unsigned_16 flags;
if( !RecName() )
return( false );
LkSym();
flags = CITNode->flags;
if( ( flags & SY_CLASS ) == SY_VARIABLE ) {
if( flags & SY_SUBSCRIPTED )
return( false );
return( true );
}
if( ( flags & SY_CLASS ) == SY_SUBPROGRAM ) {
if( ( flags & SY_SUBPROG_TYPE ) != SY_FUNCTION )
return( false );
if( !(flags & SY_PS_ENTRY) )
return( false );
GetFunctionShadow();
return( true );
}
return( false );
}
void SFPrologue( void ) {
//====================
// Generate code for statement function prologue.
sym_id sym;
itnode *func_node;
itnode *arg_list;
sf_parm **parm;
StmtSw |= SS_SF_REFERENCED;
CkTypeDeclared();
SFSymId = CITNode->sym_ptr;
if( ( SFSymId->ns.typ == FT_CHAR ) && ( SFSymId->ns.xt.size == 0 ) ) {
Error( SF_ILL_CHAR_LEN );
} else if( SFSymId->ns.typ == FT_STRUCTURE ) {
Error( SF_ILL_TYPE );
}
GStartSF();
SFSymId->ns.flags = SY_USAGE | SY_TYPE | SY_SUBPROGRAM | SY_STMT_FUNC;
CITNode->flags = SFSymId->ns.flags;
func_node = CITNode;
AdvanceITPtr();
ReqOpenParen();
SFSymId->ns.si.sf.header = FMemAlloc( sizeof( sf_header ) );
SFSymId->ns.si.sf.header->ref_count = 1;
parm = &SFSymId->ns.si.sf.header->parm_list;
*parm = NULL;
if( RecNOpn() ) {
AdvanceITPtr();
} else {
for(;;) {
if( ReqName( NAME_SF_DUMMY ) ) {
sym = LkSym();
sym->ns.xflags |= SY_DEFINED;
CkTypeDeclared();
if( ( ( sym->ns.flags & SY_CLASS ) == SY_VARIABLE ) &&
( ( sym->ns.flags & SY_SUBSCRIPTED ) == 0 ) &&
( ( sym->ns.typ != FT_CHAR ) ||
( sym->ns.xt.size != 0 ) ) &&
( sym->ns.typ != FT_STRUCTURE ) ) {
if( sym->ns.flags & SY_SPECIAL_PARM ) {
Error( SF_DUPLICATE_DUMMY_PARM );
} else {
*parm = FMemAlloc( sizeof( sf_parm ) );
(*parm)->link = NULL;
(*parm)->actual = sym;
(*parm)->shadow = STShadow( sym );
parm = &((*parm)->link);
}
} else {
Error( SF_ILL_DUMMY_PARM );
}
}
AdvanceITPtr();
if( !RecComma() ) break;
}
}
ReqCloseParen();
ReqNOpn();
arg_list = func_node->link;
func_node->link = CITNode->link;
CITNode->link = NULL;
CITNode = func_node;
FreeITNodes( arg_list );
}
void CpParameter( void ) {
//=====================
// Compile PARAMETER statement.
//
// PARAMETER (P1=E1,...,Pn=En), n > 0
uint parm_size;
byte *lit;
byte *string;
int lit_len;
sym_id sym;
sym_id value_id;
TYPE typ;
byte assign_val;
ReqNOpn();
AdvanceITPtr();
ReqOpenParen();
for(;;) {
if( ReqName( NAME_VARIABLE ) ) {
sym = LkSym();
typ = sym->u.ns.u1.s.typ;
assign_val = TRUE;
if( sym->u.ns.flags & (SY_USAGE | SY_SUB_PARM | SY_IN_EC) ) {
IllName( sym );
assign_val = FALSE;
} else if( typ == FT_STRUCTURE ) {
IllType( sym );
assign_val = FALSE;
} else {
CkSymDeclared( sym );
}
AdvanceITPtr();
ReqEquSign();
parm_size = sym->u.ns.xt.size;
if( typ == FT_STRUCTURE ) {
ConstExpr( FT_NO_TYPE );
} else if( _IsTypeLogical( typ ) ) {
CLogicExpr();
} else if( typ == FT_CHAR ) {
CCharExpr();
} else {
CArithExpr();
}
if( !AError && assign_val ) {
if( typ == FT_CHAR ) {
string = (byte *)CITNode->value.cstring.strptr;
if( CITNode->size < parm_size ) {
lit = FMemAlloc( parm_size );
lit_len = CITNode->size;
memcpy( lit, string, lit_len );
memset( lit + lit_len, ' ', parm_size - lit_len );
value_id = STLit( lit, parm_size );
FMemFree( lit );
} else {
if( parm_size == 0 ) { // *(*)
parm_size = CITNode->size;
}
value_id = STLit( string, parm_size );
}
} else {
if( !_IsTypeLogical( typ ) ) {
CnvTo( CITNode, typ, parm_size );
}
value_id = STConst( &CITNode->value, typ, parm_size );
}
sym->u.ns.flags |= SY_USAGE | SY_PARAMETER | SY_TYPE;
sym->u.ns.xt.size = parm_size;
sym->u.ns.si.pc.value = value_id;
}
}
AdvanceITPtr();
if( !RecComma() ) break;
}
ReqCloseParen();
if( ReqNOpn() ) {
AdvanceITPtr();
ReqEOS();
}
}
void CpEquivalence(void) {
//=======================
// Compile EQUIVALENCE statement.
// EQUIVALENCE (A1,...,An) {,(B1,...,Bm)} . . .
sym_id sym;
int num_equived;
intstar4 *subscripts;
int eq_size;
act_eq_entry *new_eq;
act_eq_entry *eqv_entry;
act_eq_entry *eq_head;
act_eq_entry *eq_set;
bool ill_name;
bool sub_strung;
act_eq_entry equiv;
eq_set = EquivSets;
if( EquivSets != NULL ) {
while( eq_set->next_eq_set != NULL ) {
eq_set = eq_set->next_eq_set;
}
}
for(;;) {
if( RecNOpn() ) {
AdvanceITPtr();
}
ReqOpenParen();
eqv_entry = NULL;
eq_head = NULL;
num_equived = 0;
for(;;) {
AError = FALSE;
if( ReqName( NAME_VAR_OR_ARR ) ) {
num_equived++;
sym = LkSym();
ill_name = TRUE;
if( ( sym->ns.flags & SY_CLASS ) == SY_VARIABLE ) {
if( sym->ns.flags & SY_DATA_INIT ) {
NameErr( ST_DATA_ALREADY, sym );
} else if( sym->ns.flags & SY_SUB_PARM ) {
IllName( sym );
} else if( ( sym->ns.flags & SY_SUBSCRIPTED ) &&
_Allocatable( sym ) ) {
IllName( sym );
} else {
sym->ns.flags |= SY_IN_EQUIV;
ill_name = FALSE;
}
} else {
IllName( sym );
}
AdvanceITPtr();
equiv.name_equived = sym;
equiv.next_eq_entry = NULL;
equiv.next_eq_set = NULL;
equiv.subs_no = 0;
equiv.substr = 0;
equiv.substr1 = 1;
equiv.substr2 = 0;
subscripts = equiv.subscrs;
if( RecOpenParen() ) {
if( !RecNOpn() || !RecNextOpr( OPR_COL ) ) {
sub_strung = FALSE;
for(;;) {
CIntExpr();
*subscripts = ITIntValue( CITNode );
AdvanceITPtr();
if( RecColon() ) {
sub_strung = TRUE;
break;
}
subscripts++;
equiv.subs_no++;
if( equiv.subs_no == MAX_DIM ) break;
if( !RecComma() ) break;
}
if( !sub_strung ) {
ReqCloseParen();
ReqNOpn();
AdvanceITPtr();
if( RecOpenParen() ) {
*subscripts = 1;
if( !RecNOpn() ) {
CIntExpr();
*subscripts = ITIntValue( CITNode );
}
AdvanceITPtr();
sub_strung = ReqColon();
}
}
} else {
sub_strung = TRUE;
}
if( sub_strung ) {
equiv.substr = 1;
if( SubStr2( subscripts ) ) {
equiv.substr = 2;
}
}
}
if( AError ) {
equiv.subs_no = 0;
equiv.substr = 0;
}
if( ( ( SgmtSw & SG_SYMTAB_RESOLVED ) == 0 ) && !ill_name ) {
eq_size = sizeof( eq_entry ) +
equiv.subs_no * sizeof( intstar4 );
if( equiv.substr != 0 ) {
eq_size += 2 * sizeof( intstar4 );
}
new_eq = FMemAlloc( eq_size );
memcpy( new_eq, &equiv, eq_size );
if( eqv_entry == NULL ) {
eq_head = new_eq;
eqv_entry = new_eq;
} else {
eqv_entry->next_eq_entry = new_eq;
eqv_entry = new_eq;
}
if( sym->ns.si.va.vi.ec_ext == NULL ) {
sym->ns.si.va.vi.ec_ext = STComEq();
}
}
} else {
AdvanceITPtr();
}
if( !RecComma() ) break;
}
if( num_equived < 2 ) {
Error( EV_EQUIV_LIST );
}
if( eq_set == NULL ) {
eq_set = eq_head;
EquivSets = eq_head;
} else {
eq_set->next_eq_set = eq_head;
eq_set = eq_head;
}
ReqCloseParen();
ReqNOpn();
AdvanceITPtr();
if( !RecComma() ) break;
}
ReqEOS();
}
void DSName( void ) {
//================
// Downscan a name.
sym_id sym_ptr;
CITNode->opn.us = USOPN_NNL;
if( RecNextOpr( OPR_LBR ) ) {
CITNode->link->opr = OPR_FBR;
CITNode->opn.us = USOPN_NWL;
}
if( ( FieldNode != NULL ) &&
( ( CITNode->opr == OPR_FLD ) || ( CITNode->opr == OPR_DPT ) ) ) {
if( FieldNode->opn.us & USOPN_FLD ) {
LkField( FieldNode->sym_ptr->fd.xt.sym_record );
} else {
LkField( FieldNode->sym_ptr->ns.xt.sym_record );
}
CITNode->opn.us |= USOPN_FLD;
if( CITNode->sym_ptr != NULL ) { // make sure field name exists
if( CITNode->sym_ptr->fd.dim_ext != NULL ) { // field is an array
if( ( CITNode->opn.us & USOPN_WHAT ) != USOPN_NWL ) {
CITNode->opn.us &= ~USOPN_WHAT;
CITNode->opn.us |= USOPN_ARR;
CkFieldNoList();
}
} else if( ( CITNode->opn.us & USOPN_WHAT ) == USOPN_NWL ) {
// field better be character and substrung
if( ( CITNode->sym_ptr->fd.typ != FT_CHAR ) || !SubStrung() ) {
AdvError( PC_SURP_PAREN );
}
}
// setup FieldNode for the next field lookup
if( CITNode->sym_ptr->fd.typ == FT_STRUCTURE ) {
// chain fields for CkFieldNoList()
CITNode->value.sc.struct_chain = FieldNode;
FieldNode = CITNode; // must come after LkField()
} else {
// this field is not structured so go back to the previous
// FieldNode
// consider: STRUCTURE /S1/
// INTEGER J
// END STRUCTURE
// STRUCTURE /S2/
// RECORD /S1/ A(10)
// END STRUCTURE
// RECORD /S2/ X
// RECORD /S1/ I
// X%A(I%J)%K
// when we are done with I%J, set FieldNode back to "A" so we
// can compute offset of "K" (see ChkStructName())
//
// we must go back as many as necessary, i.e. a(b.c.d.e).f
while( (FieldNode->opr==OPR_DPT) || (FieldNode->opr==OPR_FLD) ){
FieldNode = FieldNode->value.sc.struct_chain;
}
FieldNode = FieldNode->value.sc.struct_chain;
}
}
return;
}
if( ASType & AST_ISIZEOF ) {
// Case 1: Case 2:
// STRUCTURE /XXX/ STRUCTURE /XXX/
// INTEGER I INTEGER I
// END STRUCTURE END STRUCTURE
// INTEGER XXX PRINT *, ISIZEOF( XXX )
// PRINT *, ISIZEOF( XXX )
// Case 1:
// We want to issue an "unreferenced" error for XXX so don't set
// SY_REFERENCED bit in symbol table.
// Case 2:
// We don't want to issue "undeclared type" error for XXX if XXX
// did not appear in a type declaration statement.
sym_id sd;
ASType &= ~AST_ISIZEOF;
sd = FindStruct( CITNode->opnd, CITNode->opnd_size );
if( sd != NULL ) {
CITNode->opn.us = USOPN_CON;
CITNode->typ = FT_STRUCTURE;
CITNode->value.intstar4 = sd->sd.size;
return;
}
}
sym_ptr = LkSym();
if( ( ASType & AST_DEXP ) && ( sym_ptr != InitVar ) &&
( ( sym_ptr->ns.flags & SY_CLASS ) != SY_PARAMETER ) &&
( ( ( sym_ptr->ns.flags & SY_CLASS ) != SY_VARIABLE ) ||
( ( sym_ptr->ns.flags & SY_SPECIAL_PARM ) == 0 ) ) ) {
NameErr( DA_BAD_VAR_IN_EXPR, sym_ptr );
}
if( ClassIs( SY_VARIABLE ) ) {
ChkStructName();
if( Subscripted() ) { // if dimensioned
if( ASType & AST_DIM ) {
ClassErr( DM_SYM_PARM, sym_ptr );
} else if( !RecNWL() ) {
CITNode->opn.us = USOPN_ARR; // array without subscript list
CkNameNoList();
}
SetTypeUsage( SY_TYPE | SY_USAGE );
} else if( RecNWL() ) { // if name with list, not dimensioned
if( ASType & AST_DIM ) {
IllName( sym_ptr );
} else if( (CITNode->typ == FT_CHAR) && SubStrung() ) {
SetTypeUsage( SY_TYPE | SY_USAGE );
} else {
ScanningFunction();
}
} else {
if( ASType & AST_DIM ) {
CITNode->flags |= SY_IN_DIMEXPR;
SetTypeUsage( SY_USAGE );
} else {
SetTypeUsage( SY_TYPE | SY_USAGE );
}
}
} else if( ClassIs( SY_SUBPROGRAM ) ) {
ChkStructName();
if( ASType & AST_DIM ) {
ClassErr( DM_SYM_PARM, sym_ptr );
} else {
SubProg();
}
} else { // if( ClassIs( SY_PARAMETER ) ) {
if( RecNWL() ) {
IllName( sym_ptr );
} else {
CITNode->opn.us = USOPN_CON;
CITNode->sym_ptr = sym_ptr->ns.si.pc.value;
if( CITNode->typ == FT_CHAR ) {
if( StmtSw & SY_DATA_INIT ) {
CITNode->sym_ptr->lt.flags |= LT_DATA_STMT;
} else {
CITNode->sym_ptr->lt.flags |= LT_EXEC_STMT;
}
CITNode->value.cstring.strptr = (char *)&CITNode->sym_ptr->lt.value;
CITNode->value.cstring.len = CITNode->sym_ptr->lt.length;
} else {
memcpy( &CITNode->value, &CITNode->sym_ptr->cn.value,
CITNode->size );
}
}
}
BIOutSymbol( sym_ptr );
if( ( sym_ptr->ns.flags & SY_REFERENCED ) == 0 ) {
if( ASType & AST_ASF ) {
if( sym_ptr != SFSymId ) {
sym_ptr->ns.flags |= SY_REFERENCED;
}
} else if( ( ASType & AST_DEXP ) == 0 ) {
if( SgmtSw & SG_SYMTAB_RESOLVED ) {
sym_ptr->ns.flags |= SY_REFERENCED;
} else if( ASType & ( AST_DIM | AST_CEX | AST_DIEXP ) ) {
sym_ptr->ns.flags |= SY_REFERENCED;
}
}
}
}
