Ejemplo n.º 1
0
static  void    ChkIOErr( cg_name io_stat ) {
//===========================================

// Check for i/o errors.

    label_handle        eq_label;

    io_stat = CGUnary( O_POINTS, io_stat, TY_INTEGER );
    if( ( EndEqLabel != 0 ) && ( ErrEqLabel != 0 ) ) {
        eq_label = BENewLabel();
        CG3WayControl( io_stat, GetLabel( EndEqLabel ), eq_label,
                       GetLabel( ErrEqLabel ) );
        CGControl( O_LABEL, NULL, eq_label );
        BEFiniLabel( eq_label );
    } else if( EndEqLabel != 0 ) {
        CGControl( O_IF_TRUE,
                   CGCompare( O_LT, io_stat, CGInteger( 0, TY_INTEGER ),
                              TY_INTEGER ),
                   GetLabel( EndEqLabel ) );
    } else if( ErrEqLabel != 0 ) {
        CGControl( O_IF_TRUE,
                   CGCompare( O_NE, io_stat, CGInteger( 0, TY_INTEGER ),
                              TY_INTEGER ),
                   GetLabel( ErrEqLabel ) );
    } else if( IOStatSpecified ) {
        IOSLabel = BENewLabel();
        CGControl( O_IF_TRUE,
                   CGCompare( O_NE, io_stat, CGInteger( 0, TY_INTEGER ),
                              TY_INTEGER ),
                   IOSLabel );
    } else {
        CGDone( io_stat );
    }
}
Ejemplo n.º 2
0
void            FCDeAllocate( void ) {
//==============================

    call_handle         handle;
    sym_id              arr;
    uint                num;

    num = 0;
    handle = InitCall( RT_DEALLOCATE );
    for(;;) {
        arr = GetPtr();
        if( arr == NULL ) break;
        CGAddParm( handle, CGFEName( arr, T_POINTER ), T_POINTER );
        CGAddParm( handle, getFlags( arr ), FLAG_PARM_TYPE );
        ++num;
    }
    CGAddParm( handle, CGInteger( num, T_INTEGER ), T_INTEGER );
    if( GetU16() & ALLOC_STAT ) {
        FCodeSequence();
        CGAddParm( handle, XPop(), T_POINTER );
    } else {
        CGAddParm( handle, CGInteger( 0, T_POINTER ), T_POINTER );
    }
    CGDone( CGCall( handle ) );
}
Ejemplo n.º 3
0
static  void    Equivalent( cg_op op_code ) {
//===========================================


    cg_name     op1;
    cg_name     op2;
    unsigned_16 typ_info;
    cg_type     typ1;
    cg_type     typ2;

    typ_info = GetU16();
    typ1 = GetType1( typ_info );
    typ2 = GetType2( typ_info );
    op1 = XPopValue( typ1 );
    op2 = XPopValue( typ2 );
    typ1 = CGType( op1 );
    if( typ1 != TY_BOOLEAN ) {
        op1 = CGCompare( O_NE, op1, CGInteger( 0, typ1 ), typ1 );
    }
    typ2 = CGType( op2 );
    if( typ2 != TY_BOOLEAN ) {
        op2 = CGCompare( O_NE, op2, CGInteger( 0, typ2 ), typ2 );
    }
    XPush( CGCompare( op_code, op1, op2, TY_UINT_1 ) );
}
Ejemplo n.º 4
0
cg_name IntegerConstant( ftn_type *value, uint size ) {
//===================================================

    if( size == sizeof( intstar1 ) ) {
        return( CGInteger( value->intstar1, TY_INT_1 ) );
    } else if( size == sizeof( intstar2 ) ) {
        return( CGInteger( value->intstar2, TY_INT_2 ) );
    } else {
        return( CGInteger( value->intstar4, TY_INT_4 ) );
    }
}
Ejemplo n.º 5
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 ) );
    }
}
Ejemplo n.º 6
0
cg_name StructRef( cg_name structure, int offset ) {
//==================================================

// Reference a field in a structure.

    return( CGBinary( O_PLUS, structure, CGInteger( offset, TY_INTEGER ), TY_LOCAL_POINTER ) );
 }
Ejemplo n.º 7
0
void    ArrayIO( RTCODE num_array, RTCODE chr_array ) {
//=====================================================

// Output an array.

    sym_id      arr;
    sym_id      field;
    cg_name     addr;
    cg_name     num_elts;
    cg_name     elt_size;

    arr = GetPtr();
    field = GetPtr();
    if( field == NULL ) {
        addr = SymAddr( arr );
        num_elts = ArrayNumElts( arr );
        if( arr->ns.typ == FT_CHAR ) {
            ChrArrayIO( chr_array, addr, num_elts, ArrayEltSize( arr ) );
        } else {
            NumArrayIO( num_array, addr, num_elts,
                        ParmType( arr->ns.typ, arr->ns.xt.size ) );
        }
    } else { // must be a array field in a structure
        addr = XPop();
        num_elts = FieldArrayNumElts( field );
        if( field->fd.typ == FT_CHAR ) {
            elt_size = CGInteger( field->fd.xt.size, TY_INTEGER );
            ChrArrayIO( chr_array, addr, num_elts, elt_size );
        } else {
            NumArrayIO( num_array, addr, num_elts,
                        ParmType( field->fd.typ, field->fd.xt.size ) );
        }
    }
}
Ejemplo n.º 8
0
cg_name FieldArrayNumElts( sym_id arr ) {
//=======================================

// Get number of elements in an array.

    return( CGInteger( arr->u.fd.dim_ext->num_elts, TY_INT_4 ) );
}
Ejemplo n.º 9
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 );
}
Ejemplo n.º 10
0
cg_name Concat( uint num_args, cg_name dest ) {
//=============================================

// Do concatenation operation.

    int         count;
    call_handle call;
    cg_name     dest_1;
    cg_name     dest_2;

    if( num_args & CAT_TEMP ) {
        call = InitCall( RT_TCAT );
        num_args &= ~CAT_TEMP;
    } else if( num_args == 1 ) {
        call = InitCall( RT_MOVE );
    } else {
        call = InitCall( RT_CAT );
    }
    count = num_args;
    while( count > 0 ) {
        CGAddParm( call, StkElement( count ), TY_LOCAL_POINTER );
        --count;
    }
    PopStkElements( num_args );
    CloneCGName( dest, &dest_1, &dest_2 );
    CGAddParm( call, dest_1, TY_LOCAL_POINTER );
    if( num_args != 1 ) {
        CGAddParm( call, CGInteger( num_args, TY_UNSIGNED ), TY_UNSIGNED );
    }
    return( CGBinary( O_COMMA, CGCall( call ), dest_2, TY_LOCAL_POINTER ) );
}
Ejemplo n.º 11
0
static cg_name condSet(         // SET/RESET FLAG
    unsigned index,             // - index of flag
    bool set_flag,              // - true ==> set the flag; false ==> clear
    FN_CTL* fctl )              // - function information
{
    cg_name op_flg;             // - expression for flag setting
    cg_name op_mask;            // - mask operand
    COND_INFO cond;             // - conditional information

    CondInfoSetup( index, &cond, fctl );
    op_flg = CgSymbolPlusOffset( cond.sym, cond.offset );
    if( set_flag ) {
        op_mask = CGInteger( cond.mask, TY_UINT_1 );
        op_flg = CGLVPreGets( O_OR, op_flg, op_mask, TY_UINT_1 );
    } else {
        op_mask = CGInteger( NOT_BITARR_MASK( cond.mask ), TY_UINT_1 );
        op_flg = CGLVPreGets( O_AND, op_flg, op_mask, TY_UINT_1 );
    }
    return( op_flg );
}
Ejemplo n.º 12
0
void    FCCharNMove( void ) {
//=====================

// Perform N character assignment of non optimal lengths.

    int         src_len;
    int         dst_len;
    cg_name     dst;
    cg_name     dst2;
    call_handle call;
    bool        equal = FALSE;

    src_len = GetInt();
    dst_len = GetInt();
    if( src_len < dst_len ) {
        call = InitInlineCall( INLINE_STRBLAST_NE );
    } else {
        src_len = dst_len;
        equal = TRUE;
        call = InitInlineCall( INLINE_STRBLAST_EQ );
    }
    dst = XPop();
    CloneCGName( dst, &dst, &dst2 );

    if( OZOpts & OZOPT_O_SPACE || !equal ) {
        CGAddParm( call, CGInteger( src_len, TY_INTEGER ), TY_INTEGER );
    } else {
        // Special but common case, so we optimize it.
        CGAddParm( call, CGInteger( src_len & TAIL_MASK, TY_INTEGER ),
                        TY_INTEGER );
        CGAddParm( call, CGInteger( src_len >> TAIL_SHIFT, TY_INTEGER ),
                        TY_INTEGER );
    }

    CGAddParm( call, SCBPointer( XPop() ), TY_LOCAL_POINTER );
    if( !equal ) {
        CGAddParm( call, CGInteger( dst_len - src_len, TY_INTEGER ), TY_INTEGER );
    }
    CGAddParm( call, SCBPointer( dst ), TY_LOCAL_POINTER );
    XPush( CGBinary( O_COMMA, CGCall( call ), dst2, TY_LOCAL_POINTER ) );
}
Ejemplo n.º 13
0
void    FCAdvFillHiLo1( void ) {
//========================

// Fill hi and lo=1 bound of a dimension.

    sym_id              arr;
    cg_name             lo;
    cg_name             hi;
    cg_name             adv;
    unsigned            ss;
    uint                lo_size;
    uint                hi_size;
    int                 lo_offset;
    int                 hi_offset;
    call_handle         call;

    // Get general information
    arr = GetPtr();
    ss = GetU16();

    adv = GetAdv( arr );
    hi_size = BETypeLength( TY_ADV_HI );
    lo_size = BETypeLength( TY_ADV_LO );
    hi = GetTypedValue();

    if( Options & OPT_BOUNDS ) {
        call = InitCall( RT_ADV_FILL_HI_LO1 );
        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;
        CGDone( CGAssign( StructRef( adv, hi_offset ), hi, TY_ADV_HI ) );
        // set lo bound of the adv
        lo = CGInteger( 1, TY_INT_4 );
        lo_offset = (ss - 1) * BETypeLength( TY_ADV_ENTRY );
        adv = GetAdv( arr );
        CGDone( CGAssign( StructRef( adv, lo_offset ), lo, TY_ADV_LO ) );
    }
}
Ejemplo n.º 14
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 ) );
}
Ejemplo n.º 15
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 ) );
}
Ejemplo n.º 16
0
void    FCSetIntl( void ) {
//===================

// Call runtime routine to set internal file to character item (not array).

    call_handle handle;

    handle = InitCall( RT_SET_INTL );
    CGAddParm( handle, CGInteger( 1, TY_INT_4 ), TY_INT_4 );
    CGAddParm( handle, XPop(), TY_POINTER );
    CGDone( CGCall( handle ) );
}
Ejemplo n.º 17
0
static  void    NumArrayIO( RTCODE rtn, cg_name arr, cg_name num_elts,
                            uint typ ) {
//====================================================================

    call_handle call;

    call = InitCall( rtn );
    CGAddParm( call, CGInteger( typ, TY_INTEGER ), TY_INTEGER );
    CGAddParm( call, num_elts, TY_INT_4 );
    CGAddParm( call, arr, TY_POINTER );
    CGDone( CGCall( call ) );
}
Ejemplo n.º 18
0
static void    XCmplxMixOp( RTCODE rtn_id, bool cmplx_scalar ) {
//=======================================================

// F-Code processor for binary complex number operations involving
// runtime routines.
// x / (c,d) or (c,d) / x

    uint_16     typ_info;
    cg_type     s_typ;
    cg_type     x_typ;
    cg_name     s;
    cg_cmplx    x;

    typ_info = GetU16();
    if( cmplx_scalar ) {
        x_typ = GetType1( typ_info );
        s_typ = GetType2( typ_info );
        XPopCmplx( &x, x_typ );
        s = XPopValue( s_typ );
    } else {
        s_typ = GetType1( typ_info );
        x_typ = GetType2( typ_info );
        s = XPopValue( s_typ );
        XPopCmplx( &x, x_typ );
    }
    x_typ = ResCGType( s_typ, CmplxBaseType( x_typ ) );
    if( cmplx_scalar ) {
        // currently, the only time XCmplxMixOp() is called when the left
        // operand is complex and the right operand is a scalar, is for
        // exponentiation
        s_typ = PromoteIntType( s_typ );
        if( s_typ == TY_INT_4 ) {
            DoCmplxScalarOp( RT_C8POWI, x.realpart, x.imagpart, s );
        } else {
            DoCmplxOp( rtn_id, x.realpart, x.imagpart, s, CGInteger( 0, x_typ ) );
        }
    } else {
        DoCmplxOp( rtn_id, s, CGInteger( 0, x_typ ), x.realpart, x.imagpart );
    }
}
Ejemplo n.º 19
0
static cg_name CharArrLength( sym_id sym ) {
//==========================================

// Get element size for character*(*) arrays.

    if( sym->u.ns.flags & SY_VALUE_PARM ) {
        return( CGInteger( 0, TY_INTEGER ) );
    } else if( Options & OPT_DESCRIPTOR ) {
        return( SCBLength( CGUnary( O_POINTS, CGFEName( sym, TY_POINTER ), TY_POINTER ) ) );
    } else {
        return( CGUnary( O_POINTS, CGFEName( FindArgShadow( sym ), TY_INTEGER ), TY_INTEGER ) );
    }
}
Ejemplo n.º 20
0
void    FCFmtScan( void ) {
//===================

// Call runtime routine to scan a format specification from a character
// expression.

    call_handle handle;

    handle = InitCall( RT_FMT_SCAN );
    CGAddParm( handle, CGInteger( GetU16(), TY_UNSIGNED ), TY_UNSIGNED );
    CGAddParm( handle, XPop(), TY_POINTER );
    CGDone( CGCall( handle ) );
}
Ejemplo n.º 21
0
static  void    DoStructArrayIO( tmp_handle num_elts, struct field *fieldz ) {
//============================================================================

// Perform structure array i/o.

    label_handle        label;

    label = BENewLabel();
    CGControl( O_LABEL, NULL, label );
    StructIO( fieldz );
    CGControl( O_IF_TRUE,
               CGCompare( O_NE,
                          CGAssign( TmpPtr( num_elts, TY_INT_4 ),
                                    CGBinary( O_MINUS,
                                              TmpVal( num_elts, TY_INT_4 ),
                                              CGInteger( 1, TY_INTEGER ),
                                              TY_INT_4 ),
                                    TY_INT_4 ),
                          CGInteger( 0, TY_INTEGER ), TY_INT_4 ),
               label );
    BEFiniLabel( label );
}
Ejemplo n.º 22
0
void    FCIfArith( void ) {
//===================

// Set up control structure for arithmetic if.

    cg_name     if_expr;
    sym_id      lt;
    sym_id      eq;
    sym_id      gt;
    cg_type     typ;

    typ = GetType( GetU16() );
    if_expr = XPopValue( typ );
    lt = GetPtr();
    eq = GetPtr();
    gt = GetPtr();
    if( lt == gt ) {
        CGControl( O_IF_TRUE,
                   CGCompare( O_EQ, if_expr, CGInteger( 0, typ ), typ ),
                   GetStmtLabel( eq ) );
        CGControl( O_GOTO, NULL, GetStmtLabel( lt ) );
    } else if( lt == eq ) {
        CGControl( O_IF_TRUE,
                   CGCompare( O_GT, if_expr, CGInteger( 0, typ ), typ ),
                   GetStmtLabel( gt ) );
        CGControl( O_GOTO, NULL, GetStmtLabel( eq ) );
    } else if( eq == gt ) {
        CGControl( O_IF_TRUE,
                   CGCompare( O_LT, if_expr, CGInteger( 0, typ ), typ ),
                   GetStmtLabel( lt ) );
        CGControl( O_GOTO, NULL, GetStmtLabel( eq ) );
    } else {
        CG3WayControl( if_expr, GetStmtLabel( lt ), GetStmtLabel( eq ),
                       GetStmtLabel( gt ) );
    }
    RefStmtLabel( lt );
    RefStmtLabel( eq );
    RefStmtLabel( gt );
}
Ejemplo n.º 23
0
void    FCSetLine( void ) {
//===================

// Generate run-time call to ISN routine.

    call_handle handle;
    unsigned_16 line_num;

    line_num = GetU16();
    if( ( SubProgId->ns.flags & SY_SUBPROG_TYPE ) == SY_BLOCK_DATA ) return;
    handle = InitCall( RT_SET_LINE );
    CGAddParm( handle, CGInteger( line_num, TY_INTEGER ), TY_INTEGER );
    CGDone( CGCall( handle ) );
}
Ejemplo n.º 24
0
static  cg_name Multiplier( sym_id arr, int subs_no ) {
//=====================================================

// Compute mulitplier.

    cg_name     multiplier;

    multiplier = CGInteger( 1, TY_INT_4 );
    while( subs_no != 0 ) {
        multiplier = CGBinary( O_TIMES, multiplier,
                               HiBound( arr, subs_no - 1 ), TY_INT_4 );
        subs_no--;
    }
    return( multiplier );
}
Ejemplo n.º 25
0
void    XCCompare( int op ) {
//===========================

// Scalar/Complex compare.

    cg_name     x;
    cg_cmplx    z;
    unsigned_16 typ_info;
    cg_type     typ1;

    typ_info = GetU16();
    typ1 = GetType1( typ_info );
    x = XPopValue( typ1 );
    XPopCmplx( &z, GetType2( typ_info ) );
    CCCmp( op, x, CGInteger( 0, typ1 ), z.realpart, z.imagpart );
}
Ejemplo n.º 26
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 );
}
Ejemplo n.º 27
0
static  void    CXCompare( int op ) {
//===================================

// Complex/Scalar compare.

    cg_name     x;
    cg_cmplx    z;
    uint_16     typ_info;
    cg_type     typ2;

    typ_info = GetU16();
    typ2 = GetType2( typ_info );
    XPopCmplx( &z, GetType1( typ_info ) );
    x = XPopValue( typ2 );
    CCCmp( op, z.realpart, z.imagpart, x, CGInteger( 0, typ2 ) );
}
Ejemplo n.º 28
0
void    FCAllocated( void ) {
//=====================

// Generate code for ALLOCATED intrinsic function.

    uint                type;
    cg_name             fl;

    type = GetU16();
    fl = XPop();

    if( type & ALLOC_STRING ) {
        fl = CGUnary( O_POINTS, fl, T_POINTER );
    }
    XPush( CGCompare( O_NE, fl, CGInteger( 0, T_POINTER ), T_POINTER ) );
}
Ejemplo n.º 29
0
cg_name ArrayEltSize( sym_id arr ) {
//==================================

// Get element size of an array.

    cg_name     elt_size;
    uint        size;

    size = _SymSize( arr );
    if( size == 0 ) {   // character*(*) array
        elt_size = CharItemLen( arr );
    } else {
        elt_size = CGInteger( size, TY_INTEGER );
    }
    return( elt_size );
}
Ejemplo n.º 30
0
void    FCFmtArrScan( void ) {
//======================

// Call runtime routine to scan a format specification from a character
// array.

    call_handle handle;
    sym_id      sym;

    sym = GetPtr();
    handle = InitCall( RT_FMT_ARR_SCAN );
    CGAddParm( handle, CGInteger( GetU16(), TY_UNSIGNED ), TY_UNSIGNED );
    CGAddParm( handle, ArrayEltSize( sym ), TY_UNSIGNED );
    CGAddParm( handle, ArrayNumElts( sym ), TY_INT_4 );
    CGAddParm( handle, SymAddr( sym ), TY_POINTER );
    CGDone( CGCall( handle ) );
}