void R_FIStr( void ) { //================= uint width; byte blanks; uint length; ftnfile *fcb; char *src; char PGM *ptr; fcb = IOCB->fileinfo; width = IOCB->fmtptr->fmt4.fld1; if( IOCB->typ != PT_CHAR ) { ptr = IORslt.pgm_ptr; length = GetLen(); } else { ptr = IORslt.string.strptr; length = IORslt.string.len; } if( width == 0 ) { width = length; } if( width >= length ) { fcb->col += width - length; width = length; } ChkBuffLen( width ); blanks = length - width; src = &fcb->buffer[ fcb->col ]; pgm_memput( ptr, src, width ); pgm_memset( ptr + width, ' ', blanks ); fcb->col += width; }
intstar4 fortran FGETENV( string PGM *env_var, string PGM *value ) { //========================================================================= char *buff; char *ptr; int len; len = 0; for(;;) { if( len == env_var->len ) break; if( env_var->strptr[ len ] == ' ' ) break; ++len; } if( len == 0 ) return( 0 ); buff = alloca( len + sizeof( char ) ); if( buff != NULL ) { pgm_memget( buff, env_var->strptr, len ); buff[ len ] = NULLCHAR; ptr = getenv( buff ); if( ptr != NULL ) { len = strlen( ptr ); if( len > value->len ) { len = value->len; } pgm_memput( value->strptr, ptr, len ); pgm_memset( value->strptr + len, ' ', value->len - len ); return( len ); } } return( 0 ); }
static void RTCopy( char *ptr, string PGM *str ) { //==================================================== uint len; uint scb_len; len = strlen( ptr ); scb_len = str->len; if( len <= scb_len ) { pgm_memput( str->strptr, ptr, len ); pgm_memset( str->strptr + len, ' ', scb_len - len ); } else { pgm_memput( str->strptr, ptr, scb_len ); } }
static void GetString( void ) { //=========================== ftnfile *fcb; uint len; uint count; char PGM *ptr; len = IORslt.string.len; ptr = IORslt.string.strptr; fcb = IOCB->fileinfo; count = 0; fcb->col++; while( count < len ) { if( fcb->col >= fcb->len ) { CheckEor(); } if( fcb->buffer[ fcb->col ] == '\'' ) { fcb->col++; if( fcb->buffer[ fcb->col ] != '\'' ) break; } count++; *ptr = fcb->buffer[ fcb->col ]; ptr = ptr + sizeof( char ); fcb->col++; } if( count == len ) { for(;;) { if( fcb->buffer[ fcb->col ] == '\'' ) { fcb->col++; if( fcb->buffer[ fcb->col ] != '\'' ) break; } if( fcb->col >= fcb->len ) { CheckEor(); } fcb->col++; } } pgm_memset( ptr, ' ', len - count ); }
static void StrFill( string PGM *scb ) { //========================================== pgm_memset( scb->strptr, UNDEF_CHAR, scb->len ); }
static void RTFill( void PGM *dest, int size ) { //================================================== pgm_memset( dest, UNDEF_CHAR, size ); }
static bool FmtH2B( char *src, uint width, char PGM *dst, int len, PTYPE typ ) { //============================================================================== char ch1; byte ch2; bool valid; char *stop; #if defined( _M_IX86 ) || defined( __AXP__ ) || defined( __PPC__ ) #else typ = typ; #endif pgm_memset( dst, 0, len ); if( width >= 2 * len ) { len *= 2; src += width - len; } else { len = width; } stop = src + len; ch1 = '0'; if( ( len & 1 ) == 0 ) { ch1 = *src; src++; } ch2 = *src; src++; #if defined( _M_IX86 ) || defined( __AXP__ ) || defined( __PPC__ ) if( typ != PT_CHAR ) { ++len; len &= ~1; len /= 2; dst += len - 1; } #endif for(;;) { valid = false; if( !isxdigit( ch1 ) ) { if( ch1 != ' ' ) break; ch1 = '0'; } if( !isxdigit( ch2 ) ) { if( ch2 != ' ' ) break; ch2 = '0'; } valid = true; *dst = ( Hex( ch1 ) << 4 ) + Hex( ch2 ); #if defined( _M_IX86 ) || defined( __AXP__ ) || defined( __PPC__ ) if( typ == PT_CHAR ) { ++dst; } else { --dst; } #else dst++; #endif if( src == stop ) break; ch1 = *src; src++; ch2 = *src; src++; } return( valid ); }