void FCPassLabel( void ) { //===================== // Pass label to run-time routine. call_handle handle; handle = InitCall( GetU16() ); CGAddParm( handle, CGBackName( (back_handle)GetLabel( GetU16() ), TY_POINTER ), TY_POINTER ); CGDone( CGCall( handle ) ); }
void FCSetFmt( void ) { //================== // Set format string from FORMAT statement. call_handle handle; handle = InitCall( RT_SET_FMT ); CGAddParm( handle, CGBackName( (back_handle)GetStmtLabel( GetPtr() ), TY_POINTER ), TY_POINTER ); CGDone( CGCall( handle ) ); }
void FCPushLit( void ) { //=================== // Process PUSH_LIT F-Code. sym_id sym; sym = GetPtr(); if( sym->lt.flags & (LT_SCB_REQUIRED | LT_SCB_TMP_REFERENCE) ) { XPush( CGBackName( ConstBack( sym ), TY_CHAR ) ); } }
cg_name GetAdv( sym_id arr ) { //============================ act_dim_list *dim_ptr; dim_ptr = arr->u.ns.si.va.u.dim_ext; if( dim_ptr->adv == NULL ) { // ADV is allocated on the stack return( CGFEName( FindAdvShadow( arr ), TY_ADV_ENTRY ) ); } else { return( CGBackName( dim_ptr->adv, TY_ADV_ENTRY ) ); } }
static void Break( RTCODE routine ) { //======================================= // Process PAUSE/STOP statement. call_handle handle; sym_id lit; cg_name arg; handle = InitCall( routine ); lit = GetPtr(); if( lit == NULL ) { arg = CGInteger( 0, TY_LOCAL_POINTER ); } else { arg = CGBackName( ConstBack( lit ), TY_LOCAL_POINTER ); } CGAddParm( handle, arg, TY_LOCAL_POINTER ); CGDone( CGCall( handle ) ); }
void FCAssign( void ) { //================== // Process ASSIGN statement. sym_id stmt; stmt = GetPtr(); if( stmt->u.st.flags & SN_FORMAT ) { CGDone( CGAssign( SymAddr( GetPtr() ), CGBackName( GetFmtLabel( stmt->u.st.address ), TY_LOCAL_POINTER ), TY_LOCAL_POINTER ) ); } else { CGDone( CGAssign( SymAddr( GetPtr() ), CGInteger( stmt->u.st.address, TY_INTEGER ), TY_INTEGER ) ); RefStmtLabel( stmt ); } }
void FCSetNml( void ) { //================== // Set NAMELIST format. call_handle handle; sym_id nl; grp_entry *ge; NmlSpecified = TRUE; handle = InitCall( RT_SET_NML ); nl = GetPtr(); ReverseList( &nl->nl.group_list ); ge = nl->nl.group_list; while( ge != NULL ) { CGAddParm( handle, SymAddr( ge->sym ), TY_POINTER ); ge = ge->link; } ReverseList( &nl->nl.group_list ); CGAddParm( handle, CGBackName( nl->nl.address, TY_POINTER ), TY_POINTER ); CGDone( CGCall( handle ) ); }
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 ); }