static void SetTypeUsage( unsigned_16 type_usage ) {
//=====================================================
// Indicate that a names' use and type has been established.
CITNode->sym_ptr->ns.flags = CITNode->flags;
CkTypeDeclared();
CITNode->flags |= type_usage;
CITNode->sym_ptr->ns.flags |= type_usage;
}
void InitDo( signed_32 term )
{
// Initialize a DO or implied DO.
// Process "do i=e1,e2,e3" where e1, e2 and e3 are numeric expressions.
//
do_entry *do_pointer;
sym_id do_var;
if( ( StmtSw & SS_DATA_INIT ) == 0 ) {
CSHead->branch = NextLabel();
CSHead->bottom = NextLabel();
CSHead->cycle = NextLabel();
}
do_pointer = FMemAlloc( sizeof( do_entry ) );
CSHead->cs_info.do_parms = do_pointer;
do_pointer->do_term = term;
do_pointer->do_parm = NULL;
if( ReqDoVar() ) {
CkTypeDeclared();
do_var = CITNode->sym_ptr;
BIOutSymbol( do_var );
do_var->u.ns.flags |= SY_REFERENCED;
do_var->u.ns.u1.s.xflags |= SY_DEFINED;
if( do_var->u.ns.flags & SY_DO_PARM ) {
Error( DO_PARM_REDEFINED );
}
do_pointer->do_parm = do_var; // remember id of "i"
ReqNextOpr( OPR_EQU, EQ_NO_EQUALS );
if( StmtSw & SS_DATA_INIT ) {
if( !_IsTypeInteger( do_var->u.ns.u1.s.typ ) ) {
NameErr( DA_BAD_DO_VAR, do_var );
}
do_var = STShadow( do_var );
CITNode->flags = do_var->u.ns.flags;
}
CITNode->sym_ptr = do_var;
GDoInit( do_var->u.ns.u1.s.typ );
do_var->u.ns.flags |= SY_DO_PARM;
}
}
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 );
}
