예제 #1
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 ) );
}
예제 #2
0
static void    XMulDivMix( int op, bool cmplx_scalar, uint_16 typ_info ) {
//=====================================================================

// Binary F-Code processor for mixed multiplication and division.

    cg_cmplx    z;
    cg_name     s;
    cg_type     s_typ;
    cg_type     z_typ;
    cg_name     s_1;
    cg_name     s_2;

    if( cmplx_scalar ) {
        z_typ = GetType1( typ_info );
        s_typ = GetType2( typ_info );
        XPopCmplx( &z, z_typ );
        s = XPopValue( s_typ );
    } else {
        s_typ = GetType1( typ_info );
        z_typ = GetType2( typ_info );
        s = XPopValue( s_typ );
        XPopCmplx( &z, z_typ );
    }
    z_typ = ResCGType( s_typ, CmplxBaseType( z_typ ) );
    CloneCGName( s, &s_1, &s_2 );
    XPush( CGBinary( op, z.imagpart, s_1, z_typ ) );
    XPush( CGBinary( op, z.realpart, s_2, z_typ ) );
}
예제 #3
0
void    SplitCmplx( cg_name cmplx_addr, cg_type typ ) {
//=====================================================

// Split real and imaginary parts of complex number.

    cg_name     cmplx_1;
    cg_name     cmplx_2;

    typ = CmplxBaseType( typ );
    CloneCGName( cmplx_addr, &cmplx_1, &cmplx_2 );
    XPush( CGUnary( O_POINTS, ImagPtr( cmplx_1, typ ), typ ) );
    XPush( CGUnary( O_POINTS, cmplx_2, typ ) );
}
예제 #4
0
static void    InLineMulCC( uint_16 typ_info ) {
//===========================================

// Do complex multiplication in-line.
// (c,d) * (a,b).

    cg_name     d_1;
    cg_name     d_2;
    cg_name     c_1;
    cg_name     c_2;
    cg_name     b_1;
    cg_name     b_2;
    cg_name     a_1;
    cg_name     a_2;
    cg_type     typ1;
    cg_type     typ2;
    cg_cmplx    x;
    cg_cmplx    y;

    typ1 = GetType1( typ_info );
    typ2 = GetType2( typ_info );
    XPopCmplx( &x, typ1 );
    XPopCmplx( &y, typ2 );
    typ1 = CmplxBaseType( typ1 );
    typ2 = CmplxBaseType( typ2 );
    CloneCGName( x.realpart, &a_1, &a_2 );
    CloneCGName( x.imagpart, &b_1, &b_2 );
    CloneCGName( y.realpart, &c_1, &c_2 );
    CloneCGName( y.imagpart, &d_1, &d_2 );
    typ1 = ResCGType( typ1, typ2 );
    XPush( CGBinary( O_PLUS,
                     CGBinary( O_TIMES, a_1, d_1, typ1 ),
                     CGBinary( O_TIMES, b_1, c_1, typ1 ),
                     typ1 ) );
    XPush( CGBinary( O_MINUS,
                     CGBinary( O_TIMES, a_2, c_2, typ1 ),
                     CGBinary( O_TIMES, b_2, d_2, typ1 ),
                     typ1 ) );
}
예제 #5
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 ) );
}
예제 #6
0
void    FCSubString( void ) {
//=====================

// Do substring operation.

    sym_id      char_var;
    sym_id      dest;
    cg_name     src;
    cg_name     first_1;
    cg_name     first_2;
    cg_name     last;
    unsigned_16 typ_info;
    cg_name     len;
    cg_name     ptr;
    call_handle call;

    char_var = GetPtr();
    typ_info = GetU16();
    src = XPop();
    first_1 = XPopValue( GetType1( typ_info ) );
    if( char_var == NULL ) { // i.e. chr(i:i)
        len = CGInteger( GetInt(), TY_INTEGER );
        if( Options & OPT_BOUNDS ) {
            CloneCGName( first_1, &first_1, &last );
            last = CGBinary( O_PLUS, last, len, TY_INTEGER );
            last = CGBinary( O_MINUS, last, CGInteger( 1, TY_INTEGER ),
                             TY_INTEGER );
        }
    } else {
        last = XPop();
        if( last == NULL ) {
            if( char_var->ns.xt.size == 0 ) {
                last = CharItemLen( char_var );
            } else {
                last = CGInteger( char_var->ns.xt.size, TY_INTEGER );
            }
        } else {
            XPush( last );
            last = XPopValue( GetType2( typ_info ) );
        }
        if( !( Options & OPT_BOUNDS ) ) {
            CloneCGName( first_1, &first_1, &first_2 );
            len = CGBinary( O_MINUS, last, first_2, TY_INTEGER );
            len = CGBinary( O_PLUS, len, CGInteger( 1, TY_INTEGER ), TY_INTEGER );
        }
    }
    dest = GetPtr();
    if( Options & OPT_BOUNDS ) {
        call = InitCall( RT_SUBSTRING );
        CGAddParm( call, CGFEName( dest, TY_CHAR ), TY_LOCAL_POINTER );
        CGAddParm( call, last, TY_INT_4 );
        CGAddParm( call, first_1, TY_INT_4 );
        CGAddParm( call, src, TY_LOCAL_POINTER );
        XPush( CGBinary( O_COMMA, CGCall( call ), CGFEName( dest, TY_CHAR ),
                         TY_LOCAL_POINTER ) );
    } else {
        ptr = CGBinary( O_PLUS, SCBPointer( src ),
                        CGBinary( O_MINUS, first_1, CGInteger( 1, TY_INTEGER ),
                                  TY_INTEGER ),
                        TY_GLOBAL_POINTER );
        CGTrash( CGAssign( SCBLenAddr( CGFEName( dest, TY_CHAR ) ),
                           len, TY_INTEGER ) );
        // Assumption is that the pointer in the SCB is the first field in
        // the SCB so that when we push the cg_name returned by CGAssign()
        // it is a pointer to the SCB.  We must leave the assignment of the
        // pointer into the SCB in the tree so that the aliasing information
        // is not lost.
        XPush( CGLVAssign( SCBPtrAddr( CGFEName( dest, TY_CHAR ) ),
                           ptr, TY_GLOBAL_POINTER ) );
// Don't do it the following way:
//        CGTrash( CGAssign( SCBPtrAddr( CGFEName( dest, TY_CHAR ) ),
//                           ptr, TY_GLOBAL_POINTER ) );
//        XPush( CGFEName( dest, TY_CHAR ) );
    }
}
예제 #7
0
void            CmplxAssign( sym_id sym, cg_type dst_typ, cg_type src_typ ) {
//===========================================================================

// Do complex assignment.

    cg_type     typ;
    cg_name     dest;
    cg_name     dest_1;
    cg_name     dest_2;
    cg_cmplx    z;
    uint_16     flags;
    temp_handle tr;
    temp_handle ti;

    flags = sym->u.ns.flags;
    dest = NULL;
    if( (flags & SY_CLASS) == SY_SUBPROGRAM ) {
        // assigning to statement function
        if( (OZOpts & OZOPT_O_INLINE) == 0 ) {
            dest = SymAddr( sym );
        }
    } else {
        // check for structure type before checking for array
        // Consider:    A(1).X = A(2).X
        //    where A is an array of structures containing complex field X
        if( sym->u.ns.u1.s.typ == FT_STRUCTURE ) {
            dest = XPop();
            GetU16(); // ignore structure information
        } else if( flags & SY_SUBSCRIPTED ) {
            dest = XPop();
        } else {
            dest = SymAddr( sym );
        }
    }
    typ = CmplxBaseType( dst_typ );
    if( ( src_typ != TY_COMPLEX ) && ( src_typ != TY_DCOMPLEX ) &&
                                                ( src_typ != TY_XCOMPLEX ) ) {
        z.realpart = XPopValue( src_typ );
        z.imagpart = CGInteger( 0, typ );
    } else {
        XPopCmplx( &z, src_typ );
        z.imagpart = CGEval( z.imagpart );
    }
    z.realpart = CGEval( z.realpart );
    // Before assigning the real and imaginary parts, force evaluation of each.
    // Consider:    Z = Z * Z
    // The above expression will be evaluated as follows.
    //     z.r = z.r*z.r - z.i*z.i
    //     z.i = z.r*z.i + z.r*z.i
    // In the expression that evaluates the imaginary part, the value of "z.r"
    // must be the original value and not the new value.
    if( ((flags & SY_CLASS) == SY_SUBPROGRAM) && (OZOpts & OZOPT_O_INLINE) ) {
        XPush( z.imagpart );
        XPush( z.realpart );
        return;
    }

    // Code to avoid the criss cross problem
    // i.e. z = complx(imag(z), real(z))
    // or similar problems due to overwriting of one part with the other
    // before accessing it.
    // This should not affect efficiency (for optimized code) very much
    // because the temps will not be used when they are not required
    tr = CGTemp( typ );
    ti = CGTemp( typ );
    CGDone( CGAssign( CGTempName( tr, typ ), z.realpart, typ ) );
    CGDone( CGAssign( CGTempName( ti, typ ), z.imagpart, typ ) );

    CloneCGName( dest, &dest_1, &dest_2 );
    XPush( CGAssign( ImagPtr( dest_2, typ ),
                CGUnary( O_POINTS, CGTempName( ti, typ ), typ ), typ ) );
    XPush( CGAssign( dest_1, CGUnary( O_POINTS, CGTempName( tr, typ ), typ ),
                        typ ) );
}