Exemple #1
0
void    GEndSubScr( itnode *arr ) {
//=================================

// Finish off a subscripting operation.

    itnode      *arg;
    int         dim_cnt;

    if( arr->opn.us & USOPN_FLD ) {
        PushOpn( arr );
        EmitOp( FC_FIELD_SUBSCRIPT );
        OutPtr( arr->sym_ptr );
        dim_cnt = _DimCount( arr->sym_ptr->u.fd.dim_ext->dim_flags );
    } else {
        EmitOp( FC_SUBSCRIPT );
        OutPtr( arr->sym_ptr );
        dim_cnt = _DimCount( arr->sym_ptr->u.ns.si.va.u.dim_ext->dim_flags );
    }
    arg = arr->list;
    while( dim_cnt-- > 0 ) {
        GenType( arg );
        arg = arg->link;
    }
    if( ( arr->opn.us & USOPN_FLD ) == 0 ) {
        if( ( StmtSw & SS_DATA_INIT ) == 0 ) {
            if( arr->sym_ptr->u.ns.u1.s.typ == FT_CHAR ) {
                OutPtr( GTempString( 0 ) );
            }
        }
    }
    SetOpn( arr, USOPN_SAFE );
}
Exemple #2
0
static  void    DbSubscript( sym_id arr ) {
//=========================================

// Generate call to debugging subscript routine.

    act_dim_list        *dim_ptr;
    int                 dims_no;
    int                 i;
    call_handle         call;
    cg_name             offset;
    cg_name             subscripts[MAX_DIM];

    dim_ptr = arr->u.ns.si.va.u.dim_ext;
    dims_no = _DimCount( dim_ptr->dim_flags );
    call = InitCall( RT_SUBSCRIPT );
    for( i = 0; i < dims_no; ++i ) {
        subscripts[ i ] = GetTypedValue();
    }
    for( i = 1; i <= dims_no; ++i ) {
        CGAddParm( call, subscripts[ dims_no - i ], TY_INT_4 );
    }
    CGAddParm( call, GetAdv( arr ), TY_LOCAL_POINTER );
    CGAddParm( call, CGInteger( _DimCount( dim_ptr->dim_flags ), TY_INTEGER ), TY_INTEGER );
    offset = CGUnary( O_POINTS, CGCall( call ), TY_INT_4 );
    Index( arr, offset );
}
Exemple #3
0
void    DetSubList(void) {
//====================

    itnode      *cit;
    int         count;
    byte        no_subs;
    itnode      *save_cit;
    uint        ch_size;

    if( CITNode->opn.us & USOPN_FLD ) {
        no_subs = _DimCount( CITNode->sym_ptr->u.fd.dim_ext->dim_flags );
    } else {
        no_subs = _DimCount( CITNode->sym_ptr->u.ns.si.va.u.dim_ext->dim_flags );
    }
    count = 0;
    cit = CITNode;
    AdvanceITPtr();
    while( RecComma() || RecFBr() ) {
        if( CheckColon() ) {
            if( count == 0 ) {
                save_cit = CITNode;
                CITNode = cit;
                OpndErr( SV_TRIED_SSTR );
                CITNode = save_cit;
            } else if( count != no_subs ) {
                Error( SV_INV_SSCR );
            }
            SubStrArgs( cit );
            cit->opn.us &= ~USOPN_WHAT;
            cit->opn.us |= USOPN_ASS;
            Detach( cit );
            return;
        }
        if( RecNOpn() ) break;
        ++count;
        CkScrStr();
        AdvanceITPtr();
    }
    if( !RecCloseParen() ) {
        Error( PC_NO_CLOSEPAREN );
    }
    if( count != no_subs ) {
        Error( SV_INV_SSCR );
    }
    // we must make sure the array isn't substrung before we can set OPN_SS1
    if( !( cit->opn.us & USOPN_FLD ) && ( cit->sym_ptr->u.ns.u1.s.typ == FT_CHAR ) ) {
        ch_size = cit->sym_ptr->u.ns.xt.size;
        if( ch_size > 0 ) {
            cit->opn.us |= USOPN_SS1;
            cit->value.st.ss_size = ch_size;
        }
    }
    Detach( cit );
}
Exemple #4
0
static  intstar4        CheckSubscr( act_eq_entry *eqv_entry ) {
//==============================================================

// Check that array is properly subscripted.

    sym_id              sym;
    act_dim_list        *dims;
    int                 dims_no;
    intstar4            offset;

    sym = eqv_entry->name_equived;
    dims_no = 0;
    if( sym->ns.flags & SY_SUBSCRIPTED ) {
        dims = sym->ns.si.va.dim_ext;
        dims_no = _DimCount( dims->dim_flags );
        dims->dim_flags &= ~DIM_PVD;
    }
    if( eqv_entry->subs_no == 0 ) {
        offset = 0;
    } else if( dims_no != eqv_entry->subs_no ) {
        if( eqv_entry->subs_no == 1 ) {
            offset = eqv_entry->subscrs[0] - 1;
        } else {
            offset = 0;
            NameStmtErr( EV_SSCR_INVALID, sym, PR_EQUIV );
        }
    } else if( !DoSubscript( dims, eqv_entry->subscrs, &offset ) ) {
        offset = 0;
        NameStmtErr( EV_SSCR_INVALID, sym, PR_EQUIV );
    }
    return( offset * _SymSize( sym ) );
}
Exemple #5
0
act_dim_list    *STSubsList( act_dim_list *subs_ptr ) {
//======================================================

// Allocate a dimension extension.

    int             size;
    act_dim_list    *ste_ptr;

    size = sizeof( dim_list ) + ( 2 * sizeof( intstar4 ) ) * _DimCount( subs_ptr->dim_flags );
    ste_ptr = FMemAlloc( size );
    memcpy( ste_ptr, subs_ptr, size );
    return( ste_ptr );
}
Exemple #6
0
void    FCAdvFillHi( void ) {
//=====================

// Fill hi bound of a dimension (actually computes # of elements in dimension).

    sym_id              arr;
    act_dim_list        *dim_ptr;
    uint                lo_size;
    uint                hi_size;
    int                 hi_offset;
    int                 ss;
    cg_name             num_elts;
    cg_name             hi;
    cg_name             adv;
    call_handle         call;

    arr = GetPtr();
    dim_ptr = arr->u.ns.si.va.u.dim_ext;
    adv = GetAdv( arr );
    hi_size = BETypeLength( TY_ADV_HI );
    lo_size = BETypeLength( TY_ADV_LO );
    ss = GetU16();
    hi = GetTypedValue();
    if( CGOpts & CGOPT_DI_CV ) {
        hi_offset = _DimCount( dim_ptr->dim_flags ) * BETypeLength( TY_ADV_ENTRY );
        if( Options & OPT_BOUNDS ) {
            hi_offset += BETypeLength( TY_POINTER );
        }
        hi_offset += (ss - 1) * (lo_size + BETypeLength( TY_ADV_HI_CV )) + lo_size;
        hi = CGAssign( StructRef( adv, hi_offset ), hi, TY_ADV_HI_CV );
        adv = GetAdv( arr );
    }
    if( Options & OPT_BOUNDS ) {
        call = InitCall( RT_ADV_FILL_HI );
        CGAddParm( call, hi, TY_INT_4 );
        CGAddParm( call, CGInteger( ss, TY_UNSIGNED ), TY_UNSIGNED );
        CGAddParm( call, adv, TY_LOCAL_POINTER );
        CGDone( CGUnary( O_POINTS, CGCall( call ), TY_INT_4 ) );
    } else {
        hi_offset = (ss - 1) * ( lo_size + hi_size ) + lo_size;
        num_elts = CGBinary( O_PLUS, hi,
                             CGBinary( O_MINUS, CGInteger( 1, TY_INTEGER ),
                                       LoBound( arr, ss - 1 ),
                                       TY_ADV_HI ),
                             TY_ADV_HI );
        CGDone( CGAssign( StructRef( adv, hi_offset ), num_elts, TY_ADV_HI ) );
    }
}
Exemple #7
0
cg_name ArrayNumElts( sym_id arr ) {
//==================================

// Get number of elements in an array.

    cg_name             num_elts;
    act_dim_list        *dim;

    dim = arr->u.ns.si.va.u.dim_ext;
    if( _AdvRequired( dim ) ) {
        num_elts = Multiplier( arr, _DimCount( dim->dim_flags ) );
    } else {
        num_elts = CGInteger( dim->num_elts, TY_INT_4 );
    }
    return( num_elts );
}
Exemple #8
0
static  bool    Subscript( act_dim_list *dim, intstar4 *offset ) {
//================================================================

// Data initialize an array element.

    int         dims_no;
    intstar4    subscrs[MAX_DIM];

    dims_no = 0;
    while( dims_no < _DimCount( dim->dim_flags ) ) {
        subscrs[ dims_no ] = DXPop();
        GetU16();       // skip typing information
        dims_no++;
    }
    return( DoSubscript( dim, subscrs, offset ) );
}
Exemple #9
0
static  void    VariableDims( sym_id arr ) {
//==========================================

// Subscript an array that has a variable array declarator.

    act_dim_list        *dim_ptr;
    int                 dims_no;
    int                 ss_offset;
    cg_name             offset;
    cg_name             c_offset;

    dim_ptr = arr->u.ns.si.va.u.dim_ext;
    dims_no = _DimCount( dim_ptr->dim_flags );
    offset = CGInteger( 0, TY_INT_4 );
    c_offset = CGInteger( 0, TY_INT_4 );
    ss_offset = 0;
    while( ss_offset < dims_no ) {

        // offset += ( ss - lo ) * multiplier;
        //              or
        // offset   += ss*multiplier
        // c_offset -= lo*multiplier

        offset = CGBinary( O_PLUS,
                           offset,
                           CGBinary( O_TIMES,
                                     GetTypedValue(),
                                     Multiplier( arr, ss_offset ),
                                     TY_INT_4 ),
                           TY_INT_4 );
        c_offset = CGBinary( O_MINUS,
                             c_offset,
                             CGBinary( O_TIMES,
                                       LoBound( arr, ss_offset ),
                                       Multiplier( arr, ss_offset ),
                                       TY_INT_4 ),
                             TY_INT_4 );
        ss_offset++;
    }
    Index( arr, CGBinary( O_PLUS, c_offset, offset, TY_INT_4 ) );
}
Exemple #10
0
cg_name ConstArrayOffset( act_dim_list *dims ) {
//==============================================

    int                 dims_no;
    cg_name             hi_off;
    intstar4            multiplier;
    intstar4            hi;
    intstar4            lo;
    intstar4            *bounds;
    intstar4            lo_off;

    dims_no = _DimCount( dims->dim_flags );
    bounds = &dims->subs_1_lo;
    multiplier = 1;
    hi_off = CGInteger( 0, TY_INT_4 );
    lo_off = 0;
    for(;;) {
        lo = *bounds;
        bounds++;
        hi = *bounds;
        bounds++;

        // offset += ( ss - lo ) * multiplier;
        //              or
        // hi_off += ss*multiplier
        // lo_off -= lo*multiplier

        hi_off = CGBinary( O_PLUS,
                           hi_off,
                           CGBinary( O_TIMES,
                                     GetTypedValue(),
                                     CGInteger( multiplier, TY_INT_4 ),
                                     TY_INT_4 ),
                           TY_INT_4 );
        lo_off -= lo * multiplier;
        if( --dims_no == 0 ) break;

        multiplier *= ( hi - lo + 1 );
    }
    return( CGBinary( O_PLUS, CGInteger( lo_off, TY_INT_4 ), hi_off, TY_INT_4 ) );
}
Exemple #11
0
static dw_handle BIGetArrayType( sym_id ste_ptr ) {
//=================================================

// Get An array type of a named symbol

    int         dim = _DimCount( ste_ptr->u.ns.si.va.u.dim_ext->dim_flags );
    int         x = 0;
    dw_dim_info data;
    intstar4    *sub;
    dw_handle   ret;

    data.index_type = BIGetBaseType( FT_INTEGER );
    sub = &( ste_ptr->u.ns.si.va.u.dim_ext->subs_1_lo );

    ret = DWBeginArray( cBIId, BIGetType( ste_ptr ), 0, NULL, 0, 0 );
    for( x = 0; x < dim; x++ ) {
        data.lo_data = *sub++;
        data.hi_data = *sub++;
        DWArrayDimension( cBIId, &data );
    }
    DWDeclPos( cBIId, CurrFile->rec, 0 );
    DWEndArray( cBIId );
    return( ret );
}
Exemple #12
0
void            FCAllocate( void ) {
//============================

    call_handle         handle;
    sym_id              arr;
    act_dim_list        *dim;
    uint                num;
    unsigned_16         alloc_flags;
    cg_name             expr_stat;
    cg_name             expr_loc;
    cg_name             fl;
    label_handle        label;

    num = 0;
    SymPush( NULL );
    for(;;) {
        arr = GetPtr();
        if( arr == NULL ) break;
        // check if array is already allocated before filling in ADV
        label = BENewLabel();
        fl = getFlags( arr );
        fl = CGBinary( O_AND, fl, CGInteger( ALLOC_MEM, T_UINT_2 ), T_UINT_2 );
        CGControl( O_IF_TRUE, CGCompare( O_NE, fl,
                                CGInteger( 0, T_UINT_2 ), T_UINT_2 ), label );
        FCodeSequence(); // fill in the ADV, SCB or RCB
        CGControl( O_LABEL, NULL, label );
        BEFiniLabel( label );
        SymPush( arr );
        ++num;
    }
    alloc_flags = GetU16();
    if( alloc_flags & ALLOC_NONE ) {
        expr_loc = CGInteger( 0, T_POINTER );
    } else {
        FCodeSequence();
        if( alloc_flags & ALLOC_LOC ) {
            expr_loc = XPopValue( T_INT_4 );
            if( alloc_flags & ALLOC_STAT ) {
                FCodeSequence();
                expr_stat = XPop();
            }
        } else {
            expr_stat = XPop();
        }
    }
    handle = InitCall( RT_ALLOCATE );
    for(;;) {
        arr = SymPop();
        if( arr == NULL ) break;
        if( arr->ns.flags & SY_SUBSCRIPTED ) {
            dim = arr->ns.si.va.dim_ext;
            CGAddParm( handle, CGInteger( _SymSize( arr ), T_INT_4 ),
                       T_INT_4 );
            CGAddParm( handle, CGInteger( _DimCount( dim->dim_flags ),
                                          T_INTEGER ),
                       T_INTEGER );
            CGAddParm( handle, GetAdv( arr ), T_LOCAL_POINTER );
        }
        CGAddParm( handle, CGFEName( arr, T_POINTER ), T_POINTER );
        CGAddParm( handle, getFlags( arr ), FLAG_PARM_TYPE );
    }
    if( alloc_flags & ALLOC_NONE ) {
        CGAddParm( handle, expr_loc, T_POINTER );
    } else {
        if( alloc_flags & ALLOC_LOC ) {
            CGAddParm( handle, expr_loc, T_INT_4 );
        }
        if( alloc_flags & ALLOC_STAT ) {
            CGAddParm( handle, expr_stat, T_POINTER );
        }
    }
    CGAddParm( handle, CGInteger( num, T_INTEGER ), T_INTEGER );
    CGAddParm( handle, CGInteger( alloc_flags, T_UINT_2 ), FLAG_PARM_TYPE );
    CGDone( CGCall( handle ) );
}