Exemplo n.º 1
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 ) );
    }
}
Exemplo n.º 2
0
cg_name SymIndex( sym_id sym, cg_name i ) {
//=========================================

// Get address of symbol plus an index.
// Merges offset of symbols in common or equivalence with index so that
// we don't get two run-time calls for huge pointer arithmetic.

    sym_id      leader;
    cg_name     addr;
    signed_32   offset;
    com_eq      *ce_ext;
    cg_type     p_type;
    bool        data_reference;

    data_reference = TRUE;
    if( ( sym->ns.flags & SY_CLASS ) == SY_SUBPROGRAM ) {
        if( ( sym->ns.flags & SY_SUBPROG_TYPE ) == SY_STMT_FUNC ) {
            addr = CGFEName( sym, F772CGType( sym ) );
        } else {
            addr = CGFEName( sym, TY_CODE_PTR );
            if( sym->ns.flags & SY_SUB_PARM ) {
                addr = CGUnary( O_POINTS, addr, TY_CODE_PTR );
            }
            data_reference = FALSE;
        }
    } else if( sym->ns.flags & SY_PS_ENTRY ) {
        // it's the shadow symbol for function return value
        if( CommonEntry == NULL ) {
            if( sym->ns.typ == FT_CHAR ) {
                if( Options & OPT_DESCRIPTOR ) {
                    addr = CGFEName( ReturnValue, F772CGType( sym ) );
                    addr = CGUnary( O_POINTS, addr, TY_POINTER );
                } else {
                    addr = SubAltSCB( sym->ns.si.ms.sym );
                }
            } else {
                addr = CGFEName( ReturnValue, F772CGType( sym ) );
            }
        } else {
            if( (sym->ns.typ == FT_CHAR) && !(Options & OPT_DESCRIPTOR) ) {
                addr = SubAltSCB( CommonEntry );
            } else {
                addr = CGUnary( O_POINTS, CGFEName( ReturnValue, TY_POINTER ),
                                TY_POINTER );
            }
        }
    } else if( sym->ns.flags & SY_SUB_PARM ) {
        // subprogram argument
        if( sym->ns.flags & SY_SUBSCRIPTED ) {
            p_type = ArrayPtrType( sym );
            if( sym->ns.typ == FT_CHAR ) {
                addr = CGUnary( O_POINTS, CGFEName( sym, p_type ), p_type );
                if( !(sym->ns.flags & SY_VALUE_PARM) ) {
                    if( Options & OPT_DESCRIPTOR ) {
                        addr = SCBPointer( addr );
                    }
                }
            } else {
                addr = CGUnary( O_POINTS, CGFEName( sym, p_type ), p_type );
            }
        } else {
            p_type = TY_POINTER;
            if( sym->ns.typ == FT_CHAR ) {
                if( SCBRequired( sym ) ) {
                    addr = VarAltSCB( sym );
                } else {
                    addr = CGUnary( O_POINTS, CGFEName( sym, p_type ), p_type );
                }
            } else if( sym->ns.flags & SY_VALUE_PARM ) {
                p_type = F772CGType( sym );
                if( TypeCmplx( sym->ns.typ ) ) {
                    p_type = CmplxBaseType( p_type );
                    addr = CGFEName( sym, p_type );
                    XPush( CGUnary( O_POINTS,
                                    CGFEName( FindArgShadow( sym ), p_type ),
                                    p_type ) );
                    addr = CGUnary( O_POINTS, addr, p_type );
                } else {
                    addr = CGFEName( sym, p_type );
                }
            } else {
                addr = CGUnary( O_POINTS, CGFEName( sym, p_type ), p_type );
            }
        }
    } else if( sym->ns.flags & SY_IN_EQUIV ) {
        leader = sym;
        offset = 0;
        for(;;) {
            if( leader->ns.si.va.vi.ec_ext->ec_flags & LEADER ) break;
            offset += leader->ns.si.va.vi.ec_ext->offset;
            leader = leader->ns.si.va.vi.ec_ext->link_eqv;
        }
        if( leader->ns.si.va.vi.ec_ext->ec_flags & MEMBER_IN_COMMON ) {
            addr = CGFEName( leader->ns.si.va.vi.ec_ext->com_blk,
                             F772CGType( sym ) );
            offset += leader->ns.si.va.vi.ec_ext->offset;
        } else {
            sym_id      shadow;

            shadow = FindEqSetShadow( leader );
            if( shadow != NULL ) {
                addr = CGFEName( shadow, shadow->ns.si.ms.cg_typ );
                offset -= leader->ns.si.va.vi.ec_ext->low;
            } else if( (leader->ns.typ == FT_CHAR) &&
                       !(leader->ns.flags & SY_SUBSCRIPTED) ) {
                addr = CGBackName( leader->ns.si.va.bck_hdl, F772CGType( sym ) );
            } else {
                addr = CGFEName( leader, F772CGType( sym ) );
            }
        }
        if( i != NULL ) {
            i = CGBinary( O_PLUS, i, CGInteger( offset, TY_INT_4 ), TY_INT_4 );
        } else {
            i = CGInteger( offset, TY_INT_4 );
        }
        addr = CGBinary( O_PLUS, addr, i, SymPtrType( sym ) );
        if( (sym->ns.typ == FT_CHAR) && !(sym->ns.flags & SY_SUBSCRIPTED) ) {
            // tell code generator where storage pointed to by SCB is located
            addr = CGBinary( O_COMMA, addr,
                             CGFEName( sym, F772CGType( sym ) ), TY_DEFAULT );
        }
        i = NULL;
    } else if( ( sym->ns.typ == FT_CHAR ) &&
               ( ( sym->ns.flags & SY_SUBSCRIPTED ) == 0 ) ) {
        // character variable, address of scb
        addr = CGFEName( sym, F772CGType( sym ) );
    } else if( sym->ns.flags & SY_IN_COMMON ) {
        ce_ext = sym->ns.si.va.vi.ec_ext;
        if( i != NULL ) {
            i = CGBinary( O_PLUS, i, CGInteger( ce_ext->offset, TY_INT_4 ),
                          TY_INT_4 );
        } else {
            i = CGInteger( ce_ext->offset, TY_INT_4 );
        }
        addr = CGBinary( O_PLUS, CGFEName( ce_ext->com_blk, F772CGType( sym ) ),
                         i, SymPtrType( sym ) );
        i = NULL;
    } else {
        addr = CGFEName( sym, F772CGType( sym ) );
        if( ( sym->ns.flags & SY_SUBSCRIPTED ) && _Allocatable( sym ) ) {
            addr = CGUnary( O_POINTS, addr, ArrayPtrType( sym ) );
        }
    }
    if( i != NULL ) {
        addr = CGBinary( O_PLUS, addr, i, SymPtrType( sym ) );
    }
    if( ( OZOpts & OZOPT_O_VOLATILE ) && data_reference &&
        ( ( sym->ns.typ >= FT_REAL ) && ( sym->ns.typ <= FT_XCOMPLEX ) ) ) {
        addr = CGVolatile( addr );
    } else if( sym->ns.xflags & SY_VOLATILE ) {
        addr = CGVolatile( addr );
    }
    return( addr );
}