void GFiniSS( itnode *sym_node, itnode *ss_node ) { //==================================================== // Finish a substring operation. if( sym_node->opn.us & USOPN_FLD ) { PushOpn( sym_node ); EmitOp( FC_FIELD_SUBSTRING ); OutPtr( sym_node->sym_ptr ); if( sym_node->opn.us & USOPN_SS1 ) { // length known at compile-time OutInt( sym_node->value.st.ss_size ); } else { OutInt( 0 ); // we don't know the length } } else { EmitOp( FC_SUBSTRING ); if( sym_node->opn.us & USOPN_SS1 ) { // length known at compile-time OutPtr( NULL ); } else { SymRef( sym_node ); // in case we need the length of SCB if } // character*(*) and no upper bound specified } GenTypes( ss_node, ss_node->link ); if( (sym_node->opn.us & USOPN_FLD) == 0 ) { if( sym_node->opn.us & USOPN_SS1 ) { // length known at compile-time OutInt( sym_node->value.st.ss_size ); } if( (StmtSw & SS_DATA_INIT) == 0 ) { sym_node->value.st.ss_id = sym_node->sym_ptr; sym_node->sym_ptr = GTempString( 0 ); OutPtr( sym_node->sym_ptr ); sym_node->opn.us |= USOPN_ASY; } } }
void AsgnChar( void ) { //======================== // Perform character assignment. itnode *save_cit; uint num_args; uint i; uint j; save_cit = CITNode; AdvanceITPtr(); num_args = AsgnCat(); i = SrcChar( CITNode ); j = TargChar( save_cit ); if( ( num_args == 1 ) && ( i > 0 ) && ( j > 0 ) ) { if( OptimalChSize( i ) && OptimalChSize( j ) && ( i == j ) ) { PushOpn( save_cit ); EmitOp( FC_CHAR_1_MOVE ); DumpType( MapTypes( FT_INTEGER, i ), i ); GenChar1Op( CITNode ); if( ( CITNode->opn.us & USOPN_WHAT ) == USOPN_CON ) { CITNode->sym_ptr->u.lt.flags &= ~LT_SCB_TMP_REFERENCE; } CITNode = save_cit; } else { #if ( _CPU == 386 || _CPU == 8086 ) if( j < i ) { i = j; } CITNode = save_cit; PushOpn( CITNode ); EmitOp( FC_CHAR_N_MOVE ); OutInt( i ); OutInt( j ); #else CatArgs( num_args ); CITNode = save_cit; PushOpn( CITNode ); EmitOp( FC_CAT ); OutU16( (uint_16)num_args ); #endif } } else { CatArgs( num_args ); CITNode = save_cit; PushOpn( CITNode ); EmitOp( FC_CAT ); OutU16( (uint_16)num_args ); } }
tVoid PrintArgs( int argc , char** argv ) { int idx ; for( idx = 0 ; idx < argc ; idx++ ) { OutInt( idx , sizeof( idx ) ) ; OutString( " : " ) ; OutString( argv[ idx ] ) ; OutLinefeed() ; } }
void R_FOG( void ) { //=============== int width; int dec; int exp; int logval; char *buf; ftnfile *fcb; char ch; extended value; extended absvalue; width = IOCB->fmtptr->fmt3.fld1; dec = IOCB->fmtptr->fmt3.fld2; exp = IOCB->fmtptr->fmt3.fld3; fcb = IOCB->fileinfo; buf = &fcb->buffer[ fcb->col ]; if( IOCB->typ <= PT_LOG_4 ) { R_FOLog(); } else if( IOCB->typ <= PT_INT_4 ) { OutInt( width, 1 ); } else { if( GetRealRtn( &value, width ) ) { absvalue = value; if( value < 0.0 ) { absvalue = -value; } /* round to "dec" digits */ absvalue = absvalue + .5 * pow( 10, -dec ); if( ( IOCB->typ == PT_REAL_4 ) || ( IOCB->typ == PT_CPLX_8 ) ) { logval = Div10S( absvalue ); } else if((IOCB->typ == PT_REAL_8) || (IOCB->typ == PT_CPLX_16)) { logval = Div10L( absvalue ); } else { logval = Div10X( absvalue ); } // use E format if less than 0.1 unless value is zero // use E format if there are more digits than the width if( (( absvalue < 0.1 ) || ( logval >= dec )) && ( value != 0.0 ) ) { ch = 'E'; if( exp == 0 ) { // if Gw.d #if defined( _M_IX86 ) || defined( __AXP__ ) || defined( __PPC__ ) if( ( ( absvalue <= P1d_99 ) || ( absvalue >= P1d100 ) ) && ( absvalue != 0.0 ) ) { ch = NULLCHAR; // no exponent letter exp = 3; } else { #endif exp = 2; #if defined( _M_IX86 ) || defined( __AXP__ ) || defined( __PPC__ ) } #endif } R_F2E( value, buf, width, dec, (IOCB->flags & IOF_PLUS) != 0, IOCB->scale, exp, ch ); fcb->col += width; } else { if( exp == 0 ) { // if Gw.d exp = 4; } else { exp += 2; } width -= exp; if( width > 0 ) { dec -= ( logval + 1 ); if( ( dec <= width ) && ( dec >= 0 ) ) { R_F2F( value, buf, width, dec, ( IOCB->flags & IOF_PLUS ) != 0, 0 ); fcb->col += width; if( *buf == '*' ) { // fill remaining field SendChar( '*', exp ); } else { SendChar( ' ', exp ); } } else { SendChar( '*', width + exp ); } } else { SendChar( '*', width + exp ); } } } else { // undefined chars will be filled in for value fcb->col += width; } } }
void R_FOInt( void ) { //================= OutInt( IOCB->fmtptr->fmt2.fld1, IOCB->fmtptr->fmt2.fld2 ); }