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 );
}
