call_handle InitInlineCall( int rtn_id ) {
//============================================
// Initialize a call to a runtime routine.
#if _CPU == 386 || _CPU == 8086
sym_id sym;
inline_rtn __FAR *in_entry;
uint name_len;
if( !CreatedPragmas ) {
InitInlinePragmas();
}
in_entry = &InlineTab[ rtn_id ];
sym = in_entry->sym_ptr;
if( sym == NULL ) {
name_len = strlen( in_entry->name );
strcpy( SymBuff, in_entry->name );
sym = STAdd( SymBuff, name_len );
sym->u.ns.flags = SY_USAGE | SY_TYPE | SY_SUBPROGRAM | SY_FUNCTION;
sym->u.ns.u1.s.typ = FT_INTEGER_TARG;
sym->u.ns.xt.size = TypeSize( sym->u.ns.u1.s.typ );
sym->u.ns.u3.address = NULL;
in_entry->sym_ptr = sym;
in_entry->aux = AuxLookupName( in_entry->name, name_len );
}
return( CGInitCall( CGFEName( sym, in_entry->typ ), in_entry->typ, in_entry->sym_ptr ) );
#else
rtn_id = rtn_id;
return( 0 );
#endif
}
aux_info *AuxLookupAdd( char *name, int name_len ) {
//=====================================================
aux_info *aux;
aux = AuxLookupName( name, name_len );
if( aux == NULL ) {
aux = NewAuxEntry( name, name_len );
CopyAuxInfo( aux, &FortranInfo );
}
return( aux );
}
aux_info *AuxLookup( sym_id sym ) {
//====================================
aux_info *info;
if( sym == NULL ) return( &FortranInfo );
if( ( sym->ns.flags & SY_CLASS ) == SY_SUBPROGRAM ) {
if( sym->ns.flags & SY_INTRINSIC ) {
if( IFVarArgs( sym->ns.si.fi.index ) ) {
return( &IFVarInfo );
// check for character arguments must come first so that
// IF@xxx gets generated for intrinsic functions with character
// arguments (instead of XF@xxxx)
} else if( IFArgType( sym->ns.si.fi.index ) == FT_CHAR ) {
if( sym->ns.flags & SY_IF_ARGUMENT ) {
if( !(Options & OPT_DESCRIPTOR) ) {
return( &IFChar2Info );
}
}
return( &IFCharInfo );
} else if( sym->ns.flags & SY_IF_ARGUMENT ) {
return( &IFXInfo );
}
return( &IFInfo );
} else if( sym->ns.flags & SY_RT_ROUTINE ) {
return( RTAuxInfo( sym ) );
} else if( ( sym->ns.flags & SY_SUBPROG_TYPE ) == SY_PROGRAM ) {
return( &ProgramInfo );
} else {
info = AuxLookupName( sym->ns.name, sym->ns.u2.name_len );
if( info == NULL ) return( &FortranInfo );
return( info );
}
} else {
info = AuxLookupName( sym->ns.name, sym->ns.u2.name_len );
if( info == NULL ) return( &FortranInfo );
return( info );
}
}
void GBegCall( itnode *itptr ) {
//=================================
// Initialize for subprogram invocation.
sym_id sp;
obj_ptr curr_obj;
int num_args;
sp = itptr->sym_ptr;
#if _CPU == 386
{
aux_info *aux;
aux = AuxLookupName( sp->u.ns.name, sp->u.ns.u2.name_len );
if( aux != NULL ) {
if( aux->cclass & FAR16_CALL ) {
if( (SubProgId->u.ns.flags & SY_SUBPROG_TYPE) == SY_PROGRAM ) {
ProgramInfo.cclass |= THUNK_PROLOG;
} else {
aux = AuxLookupAdd( SubProgId->u.ns.name, SubProgId->u.ns.u2.name_len );
aux->cclass |= THUNK_PROLOG;
}
}
}
}
#endif
EmitOp( FC_CALL );
OutPtr( itptr->sym_ptr );
curr_obj = ObjTell();
OutU16( 0 );
if( (Options & OPT_DESCRIPTOR) == 0 ) {
if( (sp->u.ns.flags & SY_SUBPROG_TYPE) == SY_FUNCTION ) {
if( (sp->u.ns.flags & SY_INTRINSIC) == 0 ) {
if( sp->u.ns.u1.s.typ == FT_CHAR ) {
OutPtr( GTempString( sp->u.ns.xt.size ) );
}
}
}
}
num_args = DumpArgInfo( itptr->list );
curr_obj = ObjSeek( curr_obj );
OutU16( num_args );
ObjSeek( curr_obj );
if( (sp->u.ns.flags & SY_SUBPROG_TYPE) == SY_FUNCTION ) {
if( sp->u.ns.u1.s.typ == FT_CHAR ) {
if( (Options & OPT_DESCRIPTOR) || (sp->u.ns.flags & SY_INTRINSIC) ) {
OutPtr( GTempString( sp->u.ns.xt.size ) );
}
}
}
}