dbgexpr4.c

来自「开放源码的编译器open watcom 1.6.0版的源代码」· C语言 代码 · 共 1,355 行 · 第 1/3 页

    } else {
        Error( ERR_NONE, LIT( ERR_NEED_ADDRESS ) );
    }
    MoveTH( dest, ExprSP );
    CombineEntries( ExprSP, dest, ExprSP );
}


static address AllocPgmStack( unsigned size )
{
    address     addr;
    address     new;

    if( _IsOn( SW_STACK_GROWS_UP ) ) size = -size;
    addr = GetRegSP();
    new = addr;
    new.mach.offset -= (int)size;
    PgmStackUsage[ NestedCallLevel ] += size;
    if( _IsOff( SW_STACK_GROWS_UP ) ) addr.mach.offset = new.mach.offset;
    SetRegSP( new );
    return( addr );
}


static address PokePgmStack( location_list *ll, unsigned long size )
{
    address             addr;
    location_list       dst;

    addr = AllocPgmStack( size );
    LocationCreate( &dst, LT_ADDR, &addr );
    if( LocationAssign( &dst, ll, size, FALSE ) != DS_OK ) {
        Error( ERR_NONE, LIT( ERR_NO_WRITE_MEM ), addr );
    }
    return( addr );
}


static unsigned MakeSCB( item_mach *item, address addr, item_type typ )
{
    unsigned len;

    len = ExprSP->info.size;
    switch( typ ) {
    case IT_NWSCB:
        item->nwscb.str = addr.mach.offset;
        item->nwscb.len = len;
        break;
    case IT_FWSCB:
        ConvAddr48ToAddr32( addr.mach, item->fwscb.str );
        item->fwscb.len = len;
        break;
    case IT_NDSCB:
        item->ndscb.str = addr.mach.offset;
        item->ndscb.len = len;
        break;
    case IT_FDSCB:
        item->fdscb.str = addr.mach;
        item->fdscb.len = len;
        break;
    }
    return( ItemSize( typ ) );
}

static type_modifier DerefType( type_handle *th )
{
    type_info   ti;

    if( TypeInfo( th, ExprSP->lc, &ti ) != DS_OK ) return( TM_NONE );
    if( ti.kind != TK_POINTER ) return( TM_NONE );
    if( !(ti.modifier & TM_FLAG_DEREF) ) return( TM_NONE );
    return( ti.modifier & TM_MOD_MASK );
}

static item_type DerefToSCB( type_handle *th )
{
    type_info   ti;

    if( TypeInfo( th, ExprSP->lc, &ti ) != DS_OK ) return( 0 );
    if( ti.kind != TK_POINTER ) return( 0 );
    if( !(ti.modifier & TM_FLAG_DEREF) ) return( 0 );
    switch( ti.modifier & TM_MOD_MASK ) {
    case TM_NEAR:
        //MAD: ????
        if( ti.size == sizeof( addr32_off ) ) {
            return( IT_NWSCB );
        } else {
            return( IT_NDSCB );
        }
    case TM_NONE:
    case TM_FAR:
    case TM_HUGE:
        //MAD: ????
        if( ti.size == sizeof( addr32_ptr ) ) {
            return( IT_FWSCB );
        } else {
            return( IT_FDSCB );
        }
    }
    return( 0 );
}

/*
 * Addressable - prepare stack entry for call-by-reference
 */
            /* for Fortran CHARACTER type arguments, must pass
               a pointer to an SCB of the character block */

static void Addressable( bool build_scb, type_handle *parm_type )
{
    unsigned            len;
    address             addr;
    item_mach           item;
    unsigned            i;
    location_list       src;
    DIPHDL( type, th );

    LValue( ExprSP );
    if( ExprSP->flags & SF_LOCATION ) {
        for( i = 0; i < ExprSP->v.loc.num; ++i ) {
            if( ExprSP->v.loc.e[i].type != LT_ADDR ) {
                RValue( ExprSP );
                break;
            }
        }
    }
    if( ExprSP->flags & SF_LOCATION ) {
        addr = ExprSP->v.loc.e[0].u.addr;
    } else {
        if( ExprSP->info.kind == TK_STRING ) {
            src = ExprSP->v.string.loc;
        } else {
            TypeBase( parm_type, th, NULL, NULL );
            PushType( th );
            SwapStack( 1 );
            DoConvert();
            ToItem( ExprSP, &item );
            LocationCreate( &src, LT_INTERNAL, &item );
        }
        addr = PokePgmStack( &src, ExprSP->info.size );
    }
    if( build_scb && ExprSP->info.kind == TK_STRING ) {
        len = MakeSCB( &item, addr, DerefToSCB( parm_type ) );
        if( len != 0 ) {
            LocationCreate( &src, LT_INTERNAL, &item );
            addr = PokePgmStack( &src, len );
        }
    }
    ExprSP->flags &= ~SF_LOCATION;
    ExprSP->v.addr = addr;
    ExprSetAddrInfo( ExprSP, FALSE );
    ExprSP->th = NULL;
}



/*
 * DoCall - call a procedure
 */

void DoCall( unsigned num_parms, bool build_scbs )
{
    stack_entry         *rtn_entry;
    address             addr;
    address             ret_addr;
    address             string_addr;
    location_list       ll;
    location_list       ret_ll;
    enum {
        RET_NORMAL,
        RET_REFERENCE,
        RET_SCB
    }                   ret_kind;
    DIPHDL( sym, rtn_sh );
    DIPHDL( type, obj_th );
    DIPHDL( type, rtn_th );
    DIPHDL( type, ret_th );
    DIPHDL( type, parm_th );
    DIPHDL( type, th );
    sym_info            rtn_si;
    type_info           this_ti;
    type_info           ti;
    type_info           ret_ti;
    item_mach           item;
    unsigned            parm_loc_adjust;
    unsigned            parm;
    unsigned            size;
    dip_status          ds;

    if( _IsOn( SW_CALL_FATAL ) ) Error( ERR_NONE, LIT( ERR_CALL_NOT_ALLOWED ) );
    rtn_entry = StkEntry( num_parms );
    RValue( rtn_entry );
    switch( rtn_entry->info.kind ) {
    case TK_BOOL:
    case TK_ENUM:
    case TK_CHAR:
    case TK_INTEGER:
        addr = Context.execution;
        //NYI: 64 bit offsets
        addr.mach.offset = U32FetchTrunc( rtn_entry->v.uint );
        break;
    case TK_POINTER:
    case TK_ADDRESS:
        if( (rtn_entry->info.modifier & TM_MOD_MASK) == TM_NEAR ) {
            addr = Context.execution;
            addr.mach.offset = rtn_entry->v.addr.mach.offset;
        } else {
            addr = rtn_entry->v.addr;
        }
        break;
    default:
        Error( ERR_NONE, LIT( ERR_ILL_TYPE ) );
        break;
    }
    if( DeAliasAddrSym( NO_MOD, addr, rtn_sh ) != SR_EXACT ) {
        AddrFix( &addr );
        Error( ERR_NONE, LIT( ERR_NO_ROUTINE ), addr );
    }
    SymInfo( rtn_sh, rtn_entry->lc, &rtn_si );
    if( rtn_si.kind != SK_PROCEDURE ) {
        Error( ERR_NONE, LIT( ERR_NO_ROUTINE ), addr );
    }
    SymType( rtn_sh, rtn_th );
    TypeProcInfo( rtn_th, ret_th, 0 );
    /* check if it is Fortran function returning CHARACTER blocks */
    ret_kind = RET_NORMAL;
    if( DerefType( ret_th ) != TM_NONE ) {
        ret_kind = RET_REFERENCE;
        TypeBase( ret_th, th, NULL, NULL );
        TypeInfo( th, rtn_entry->lc, &ti );
        if( ti.kind == TK_STRING ) {
            ret_kind = RET_SCB;
            if( ti.size == 0 ) {
                /* character*(*) function -- not supported */
                Error( ERR_NONE, LIT( ERR_CHAR_STAR_STAR ) );
            }
            string_addr = AllocPgmStack( ti.size );
            size = MakeSCB( &item, string_addr, DerefToSCB( ret_th ) );
            LocationCreate( &ll, LT_INTERNAL, &item );
            PushAddr( PokePgmStack( &ll, size ) );
            HDLAssign( type, ret_th, th );
            ++num_parms;
        }
    }
    SymObjType( rtn_sh, obj_th, &this_ti );
    if( this_ti.kind == TK_POINTER ) {
        if( !rtn_entry->lc->have_object ) {
            Error( ERR_NONE, LIT( ERR_NO_OBJECT_FOR_CALL ) );
        }
        parm_loc_adjust = 1;
    } else {
        parm_loc_adjust = 0;
    }
    for( parm = num_parms; parm > 0; --parm ) {
        ds = SymParmLocation( rtn_sh, rtn_entry->lc, &ll, parm + parm_loc_adjust );
        if( ds & DS_ERR ) {
            Error( ERR_NONE, LIT( ERR_CALL_NOT_ALLOWED ) );
        }
        if( ds != DS_OK ) {
            LocationCreate( &ll, LT_INTERNAL, NULL );
        }
        PushLocation( &ll, &StkEntry( parm )->info );
        MoveSP( 2 );
        if( TypeProcInfo( rtn_th, parm_th, parm ) == DS_OK ) {
            PushType( parm_th );
            MoveSP( -1 );
            if( DerefType( parm_th ) != TM_NONE ) {
                Addressable( build_scbs, parm_th );
            }
            DoConvert();
            MoveSP( 1 );
        }
    }
    if( this_ti.kind == TK_POINTER ) {
        TypeInfo( obj_th, rtn_entry->lc, &ti );
        PushLocation( &rtn_entry->lc->object, &ti );
        Addressable( FALSE, obj_th );
        ConvertTo( ExprSP, this_ti.kind, this_ti.modifier, this_ti.size );
        ds = SymParmLocation( rtn_sh, rtn_entry->lc, &ll, 1 );
        if( ds & DS_ERR ) {
            Error( ERR_NONE, LIT( ERR_CALL_NOT_ALLOWED ) );
        }
        if( ds != DS_OK ) {
            LocationCreate( &ll, LT_INTERNAL, NULL );
        }
        PushLocation( &ll, &ExprSP->info );
        MoveSP( 2 );
        ++num_parms;
    }
    MoveSP( -2 * num_parms );
    FreezeRegs();
    TypeInfo( ret_th, rtn_entry->lc, &ret_ti );
    ds = SymParmLocation( rtn_sh, rtn_entry->lc, &ret_ll, 0 );
    if( ds & DS_ERR ) {
        Error( ERR_NONE, LIT( ERR_CALL_NOT_ALLOWED ) );
    }
    if( ds != DS_OK ) {
        if( ret_kind != RET_SCB ) {
            ret_ti.kind = TK_VOID;
        }
    }
    if( rtn_si.rtn_calloc ) {
        ret_addr = AllocPgmStack( ret_ti.size );
        PushAddr( ret_addr );
        ConvertTo( ExprSP, TK_POINTER, rtn_si.ret_modifier, rtn_si.ret_size );
        ToItem( ExprSP, &item );
        DeleteEntry( ExprSP );
        LocationCreate( &ll, LT_INTERNAL, &item );
        LocationAssign( &ret_ll, &ll, rtn_si.ret_size, FALSE );
        LocationCreate( &ret_ll, LT_ADDR, &ret_addr );
    }
    if( PerformCall( addr, rtn_si.rtn_far, num_parms ) ) {
        if( ret_kind == RET_SCB ) {
            LocationCreate( &ret_ll, LT_ADDR, &string_addr );
        } else if( rtn_si.ret_modifier != TM_NONE && !rtn_si.rtn_calloc ) {
            PushLocation( &ret_ll, NULL );
            ExprSP->info.kind = TK_POINTER;
            ExprSP->info.modifier = rtn_si.ret_modifier;
            ExprSP->info.size = rtn_si.ret_size;
            RValue( ExprSP );
            LocationCreate( &ret_ll, LT_ADDR, &ExprSP->v.addr );
            DeleteEntry( ExprSP );
        }
        if( ret_ti.kind == TK_VOID ) {
            CreateEntry();
            ExprSP->info.kind = TK_VOID;
        } else {
            PushType( ret_th );
            ExprSP->v.loc = ret_ll;
            ExprSP->info = ret_ti;
            ExprSP->flags = SF_LOCATION;
            RValue( ExprSP );
            if( ret_kind == RET_REFERENCE ) {
                DoPoints( 0 );
            }
        }
    }
    ExprSP->flags &= ~(SF_CONST | SF_IMP_ADDR);
    DeleteEntry( rtn_entry );
    UnFreezeRegs();
    FreePgmStack( FALSE );
}

#if 0
void InitReturnInfo( sym_handle *f, return_info *ri )
{
    sym_info    si;
    DIPHDL( type, rtn_th );
    DIPHDL( type, ret_th );

    memset( ri, 0, sizeof( *ri ) );
    SymInfo( f, &Context, &si );
    if( si.kind != SK_PROCEDURE ) {
        Error( ERR_NONE, LIT( ERR_NOT_PROCEDURE ), f );
        return;
    }
    SymType( f, rtn_th );
    TypeProcInfo( rtn_th, ret_th, 0 );
    TypeInfo( ret_th, &Context, &ri->ti );
    /* check if it is Fortran function returning CHARACTER blocks */
    if( (ri->ti.kind == TK_POINTER) && (ri->ti.modifier & TM_FLAG_DEREF) ) {
        ri->want_base_type = 1;
        ri->ref_size = ri->ti.size;
        if( (ri->ti.modifier & TM_MOD_MASK) != TM_NEAR ) {
            ri->ref_far = TRUE;
        }
        TypeBase( ret_th, ret_th, NULL, NULL );
        TypeInfo( ret_th, &Context, &ri->ti );
        if( ri->ti.kind == TK_STRING ) {
            ri->rl_passed_in = TRUE;
            ri->scb = TRUE;
        }
    }
    if( !ri->scb && ri->ti.size == 0 ) {
        Error( ERR_NONE, LIT( ERR_CANT_GET_RV ) );
        return;
    }
    if( si.ret_modifier != TM_NONE && si.rtn_calloc ) {
        ri->rl_passed_in = TRUE;
    }
}

void PrepReturnInfo( sym_handle *f, return_info *ri )
{
    f = f;
    if( ri->rl_passed_in || ri->scb ) {
        PushLocation( &ri->ll, NULL );
        ExprSP->info.kind = TK_POINTER;
        ExprSP->info.size = ri->ref_size;
        if( ri->ref_far ) {
            ExprSP->info.modifier = TM_FAR;
        } else {
            ExprSP->info.modifier = TM_NEAR;
        }
        RValue( ExprSP );
        LocationCreate( &ri->ll, LT_ADDR, &ExprSP->v.addr );
        if( ri->scb && ri->ti.size == 0 ) {
            /* CHAR*(*) function. Get the size from the passed in SCB */
            ExprSP->v.loc = ri->ll;
            ExprSP->info.kind = TK_INTEGER;
            ExprSP->info.modifier = TM_UNSIGNED;
            ExprSP->info.size = ri->ref_size;
            if( ri->ref_far ) ExprSP->info.size -= sizeof( addr_seg );
            ExprSP->flags = SF_LOCATION;
            RValue( ExprSP );
            ri->ti.size = ExprSP->v.uint;
        }
        DeleteEntry( ExprSP );
    }
    ri->rl_passed_in = FALSE;
}

void PushReturnInfo( sym_handle *f, return_info *ri )
{
    DIPHDL( type, th );

    if( ri->rl_passed_in ) {
        Error( ERR_NONE, LIT( ERR_CANT_GET_RV ) );
        return;
    }
    if( ri->ti.kind == TK_VOID ) {
        CreateEntry();
        ExprSP->info.kind = TK_VOID;
        return;
    }
    if( ri->ref_size != 0 ) {
        PushLocation( &ri->ll, NULL );
        ExprSP->info.kind = TK_POINTER;
        ExprSP->info.size = ri->ref_size;
        if( ri->ref_far ) {
            ExprSP->info.modifier = TM_FAR;
        } else {
            ExprSP->info.modifier = TM_NEAR;
        }
        RValue( ExprSP );
        LocationCreate( &ri->ll, LT_ADDR, &ExprSP->v.addr );
        DeleteEntry( ExprSP );
        if( ri->scb ) {
            PushLocation( &ri->ll, &ri->ti );
            return;
        }
    }
    SymType( f, th );
    TypeProcInfo( th, th, 0 );
    if( ri->want_base_type ) TypeBase( th, th, NULL, NULL );
    PushType( th );
    ExprSP->v.loc = ri->ll;
    ExprSP->flags = SF_LOCATION;
}
#endif