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 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 ) ); } }
cg_name SCBFlagsAddr( cg_name scb ) { //=================================== // Get pointer to flags in SCB. return( StructRef( scb, BETypeLength( TY_CHAR ) ) ); }
cg_name SCBLenAddr( cg_name scb ) { //================================= // Get pointer to length in SCB. return( StructRef( scb, BETypeLength( TY_GLOBAL_POINTER ) ) ); }
static cg_name getFlags( sym_id sym ) { //====================================== int tlen; cg_name fl; cg_type typ; if( sym->ns.flags & SY_SUBSCRIPTED ) { typ = ArrayPtrType( sym ); tlen = BETypeLength( typ ); } else { tlen = BETypeLength( T_CHAR ); typ = T_CHAR; } fl = StructRef( CGFEName( sym, typ ), tlen ); return( CGUnary( O_POINTS, fl, T_UINT_2 ) ); }
cg_name ImagPtr( cg_name dest, cg_type typ ) { //============================================ // Get pointer to imaginary part of complex number. dest = StructRef( dest, BETypeLength( typ ) ); if( OZOpts & OZOPT_O_VOLATILE ) { dest = CGVolatile( dest ); } return( dest ); }
static void addAutoLocn( sym s, cg_type type ) { AUTO_LOCN* curr; curr = CGAlloc( sizeof( AUTO_LOCN ) ); curr->s = s; curr->offset = next_auto_offset; curr->next = auto_locations; auto_locations = curr; next_auto_offset += _RoundUp( BETypeLength( type ), AUTO_PACK ); }
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 ) ); } }
// The following can be extended for more types, if required // TYPE TypeFromCgType( // GET C++ TYPE FOR cg_type cg_type cgtype ) // - code-gen type { TYPE type; // - C++ type switch( cgtype ) { case TY_UINT_1 : type = GetBasicType( TYP_UCHAR ); break; case TY_INT_1 : type = GetBasicType( TYP_SCHAR ); break; case TY_UINT_2 : type = GetBasicType( TYP_USHORT ); break; case TY_INT_2 : type = GetBasicType( TYP_SSHORT ); break; case TY_UINT_4 : #if( TARGET_INT == 4 ) type = GetBasicType( TYP_UINT ); #else type = GetBasicType( TYP_ULONG ); #endif break; case TY_INT_4 : #if( TARGET_INT == 4 ) type = GetBasicType( TYP_SINT ); #else type = GetBasicType( TYP_SLONG ); #endif break; case TY_INT_8 : type = GetBasicType( TYP_SLONG64 ); break; case TY_UINT_8 : type = GetBasicType( TYP_ULONG64 ); break; case TY_BOOLEAN : case TY_INTEGER : type = GetBasicType( TYP_SINT ); break; case TY_UNSIGNED : type = GetBasicType( TYP_UINT ); break; default : type = MakeInternalType( BETypeLength( cgtype ) ); break; } return type; }
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 ); }
static SYMBOL getExprTempSym( // EMIT CGDone, CGTrash, OR COPY TO TEMP cg_name expr, // - expression cg_type type, // - type of expression FN_CTL* fctl, // - function control DGRP_FLAGS pop_type ) // - type of popping destruction { SYMBOL temp; // - NULL or copied temp if( pop_type & DGRP_DONE ) { CGDone( expr ); temp = NULL; } else if( pop_type & DGRP_TRASH ) { CGTrash( expr ); temp = NULL; } else if( fctl->temp_dtoring ) { temp = CgVarTemp( BETypeLength( type ) ); CGDone( CGLVAssign( CgSymbol( temp ), expr, type ) ); } else { temp = NULL; } fctl->temp_dtoring = FALSE; return temp; }
void SetSegs( void ) /*********************/ { int seg; struct user_seg *useg; struct textsegment *tseg; int flags; char *name; CompFlags.low_on_memory_printed = 0; flags = GLOBAL | INIT | EXEC; if( *TextSegName == '\0' ) { name = TS_SEG_CODE; } else { name = TextSegName; flags |= GIVEN_NAME; } BEDefSeg( SEG_CODE, flags, name, SegAlign( (OptSize == 0) ? BETypeLength( TY_INTEGER ) : 1 ) ); BEDefSeg( SEG_CONST, BACK|INIT|ROM, TS_SEG_CONST, SegAlign( SegAlignment[SEG_CONST] ) ); BEDefSeg( SEG_CONST2, INIT | ROM, TS_SEG_CONST2, SegAlign( SegAlignment[SEG_CONST2] ) ); BEDefSeg( SEG_DATA, GLOBAL | INIT, TS_SEG_DATA, SegAlign( SegAlignment[SEG_DATA] ) ); if( CompFlags.ec_switch_used ) { /* 04-apr-92 */ BEDefSeg( SEG_YIB, GLOBAL | INIT, TS_SEG_YIB, 2 ); BEDefSeg( SEG_YI, GLOBAL | INIT, TS_SEG_YI, 2 ); BEDefSeg( SEG_YIE, GLOBAL | INIT, TS_SEG_YIE, 2 ); } if( CompFlags.bss_segment_used ) { BEDefSeg( SEG_BSS, GLOBAL, TS_SEG_BSS, SegAlign( SegAlignment[ SEG_BSS ] ) ); } if( CompFlags.far_strings ) { FarStringSegment = SegmentNum; /* 10-mar-95 */ ++SegmentNum; } for( seg = FIRST_PRIVATE_SEGMENT; seg < SegmentNum; ++seg ) { sprintf( Buffer, "%s%d_DATA", ModuleName, seg ); BEDefSeg( seg, INIT | PRIVATE, Buffer, SegAlign( 16 ) ); } for( useg = UserSegments; useg != NULL ; useg = useg->next ) { seg = useg->segment; switch( useg->segtype ) { // case SEGTYPE_CODE: // BEDefSeg( seg, INIT | GLOBAL | EXEC, useg->name, 1 ); // break; case SEGTYPE_DATA: /* created through #pragma data_seg */ BEDefSeg( seg, INIT | GLOBAL | NOGROUP, useg->name, SegAlign( TARGET_INT ) ); break; case SEGTYPE_BASED: BEDefSeg( seg, INIT | PRIVATE | GLOBAL, useg->name, SegAlign( TARGET_INT ) ); break; case SEGTYPE_INITFINI: BEDefSeg( seg, INIT | GLOBAL, useg->name, SegAlign( 1 ) ); break; case SEGTYPE_INITFINITR: BEDefSeg( seg, INIT | GLOBAL| THREAD_LOCAL, useg->name, SegAlign( 1 ) ); break; } } for( tseg = TextSegList; tseg != NULL; tseg = tseg->next ) { tseg->segment_number = ++SegmentNum; BEDefSeg( tseg->segment_number, GLOBAL | INIT | EXEC | GIVEN_NAME, tseg->segname, SegAlign( (OptSize == 0) ? BETypeLength( TY_INTEGER ) : 1 ) ); } }
static void DoDataInit( PTYPE var_type ) { //========================================== // Do data initialization. int const_size; int var_size; int size; byte *const_ptr; segment_id seg; seg_offset offset; byte const_buff[sizeof(ftn_type)]; if( ( DtConstType == PT_CHAR ) || ( DtConstType == PT_NOTYPE ) ) { const_size = DtConst->u.lt.length; const_ptr = &DtConst->u.lt.value; } else { const_size = DtConst->u.cn.size; const_ptr = (byte *)(&DtConst->u.cn.value); } var_size = DtItemSize; seg = GetDataSegId( InitVar ); offset = GetDataOffset( InitVar ); DtInit( seg, offset ); if( DtConstType == PT_CHAR ) { if( const_size >= var_size ) { DtBytes( const_ptr, var_size ); } else { DtBytes( const_ptr, const_size ); DtIBytes( ' ', var_size - const_size ); } } else if( ( var_type == PT_CHAR ) && IntType( DtConstType ) ) { DtBytes( const_ptr, sizeof( char ) ); if( var_size > sizeof( char ) ) { DtIBytes( ' ', var_size - sizeof( char ) ); } } else if( DtConstType == PT_NOTYPE ) { if( var_type != PT_CHAR ) { size = var_size; while( size > const_size ) { size--; const_buff[ size ] = 0; } while( size > 0 ) { size--; const_buff[ size ] = *const_ptr; const_ptr++; } const_ptr = const_buff; const_size = var_size; } if( const_size < var_size ) { DtIBytes( 0, var_size - const_size ); var_size = const_size; } else { const_ptr += const_size - var_size; } DtBytes( const_ptr, var_size ); } else if( DtConstType <= PT_LOG_4 ) { DtBytes( const_ptr, var_size ); } else { // numeric to numeric if( DtConstType != var_type ) { DataCnvTab[ ( var_type - PT_INT_1 ) * CONST_TYPES + ( DtConstType - PT_INT_1 ) ]( (ftn_type *)const_ptr, (ftn_type *)&const_buff ); const_ptr = const_buff; } // Temporary fix for identical precision between front end and code generator. { char fmt_buff[CONVERSION_BUFFER+1]; float_handle cf; if( (var_type == PT_REAL_4) || (var_type == PT_CPLX_8) ) { CnvS2S( (single *)const_ptr, fmt_buff ); cf = BFCnvSF( fmt_buff ); BFCnvTarget( cf, const_buff, BETypeLength( TY_SINGLE ) ); BFFree( cf ); } else if( (var_type == PT_REAL_8) || (var_type == PT_CPLX_16) ) { CnvD2S( (double *)const_ptr, fmt_buff ); cf = BFCnvSF( fmt_buff ); BFCnvTarget( cf, const_buff, BETypeLength( TY_DOUBLE ) ); BFFree( cf ); } else if( (var_type == PT_REAL_16) || (var_type == PT_CPLX_32) ) { CnvX2S( (extended *)const_ptr, fmt_buff ); cf = BFCnvSF( fmt_buff ); BFCnvTarget( cf, const_buff, BETypeLength( TY_LONGDOUBLE ) ); BFFree( cf ); } if( var_type == PT_CPLX_8 ) { CnvS2S( (single *)(const_ptr + sizeof( single )), fmt_buff ); cf = BFCnvSF( fmt_buff ); BFCnvTarget( cf, const_buff + sizeof( single ), BETypeLength( TY_SINGLE ) ); BFFree( cf ); } else if( var_type == PT_CPLX_16 ) { CnvD2S( (double *)(const_ptr + sizeof( double )), fmt_buff ); cf = BFCnvSF( fmt_buff ); BFCnvTarget( cf, const_buff + sizeof( double ), BETypeLength( TY_DOUBLE ) ); BFFree( cf ); } else if( var_type == PT_CPLX_32 ) { CnvX2S( (extended *)(const_ptr + sizeof( extended )), fmt_buff ); cf = BFCnvSF( fmt_buff ); BFCnvTarget( cf, const_buff + sizeof( extended ), BETypeLength( TY_LONGDOUBLE ) ); BFFree( cf ); } if( (var_type >= PT_REAL_4) && (var_type <= PT_CPLX_32) ) { const_ptr = const_buff; } } // End of temporary fix. DtBytes( const_ptr, var_size ); } DtItemSize = 0; }