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 ) ); } } } }