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 ) ); } }
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 ); }
static cg_name HiBound( sym_id arr, int ss_offset ) { //==================================================== // Get hi bound from ADV. ss_offset = BETypeLength( TY_ADV_LO ) * ( ss_offset + 1 ) + BETypeLength( TY_ADV_HI ) * ss_offset; return( CGUnary( O_POINTS, StructRef( GetAdv( arr ), ss_offset ), TY_ADV_HI ) ); }
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 ) ); } }
void FCAdvFillLo( void ) { //===================== // Fill lo bound of a dimension. sym_id arr; int lo_offset; cg_name adv; cg_name lo; unsigned ss; arr = GetPtr(); adv = GetAdv( arr ); ss = GetU16(); lo = GetTypedValue(); lo_offset = (ss - 1) * BETypeLength( TY_ADV_ENTRY ); CGDone( CGAssign( StructRef( adv, lo_offset ), lo, TY_ADV_LO ) ); }
static cg_name LoBound( sym_id arr, int ss_offset ) { //==================================================== // Get lo bound from ADV. cg_name lo_bound; act_dim_list *dim_ptr; dim_ptr = arr->u.ns.si.va.u.dim_ext; if( _LoConstBound( dim_ptr->dim_flags, ss_offset + 1 ) ) { lo_bound = CGInteger( ((intstar4 *)(&dim_ptr->subs_1_lo))[2*ss_offset], TY_INT_4 ); } else { lo_bound = CGUnary( O_POINTS, StructRef( GetAdv( arr ), ss_offset*BETypeLength( TY_ADV_ENTRY ) ), TY_ADV_LO ); } return( lo_bound ); }
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 ) ); }