static void GetFloat( extended *result, int prec ) {
//======================================================
ftnfile *fcb;
char *start;
uint len;
int status;
fcb = IOCB->fileinfo;
start = fcb->buffer + fcb->col;
len = GetDelim( start, fcb->buffer + fcb->len ) - start;
status = FmtS2F( start, len, 0, false, 0, prec, result, false, NULL, false );
if( status == FLT_OK ) {
fcb->col += len;
} else {
if( status == FLT_INVALID ) {
IOErr( IO_BAD_CHAR );
} else { // FLT_RANGE_EXCEEDED
IOErr( IO_FRANGE_EXCEEDED );
}
}
}
void R_FIFloat( void ) {
//===================
// Input an real or complex variable in D, E, F, G format.
extended value;
fmt2 PGM *fmtptr;
ftnfile *fcb;
PTYPE typ;
int prec;
int status;
bool comma;
uint width;
fcb = IOCB->fileinfo;
fmtptr = &IOCB->fmtptr->fmt2;
typ = IOCB->typ;
ChkBuffLen( fmtptr->fld1 );
switch( typ ) {
case( PT_REAL_8 ):
case( PT_CPLX_16 ):
prec = PRECISION_DOUBLE;
break;
case( PT_REAL_16 ):
case( PT_CPLX_32 ):
prec = PRECISION_EXTENDED;
break;
default:
prec = PRECISION_SINGLE;
}
comma = __AllowCommaSep();
status = FmtS2F( fcb->buffer + fcb->col, fmtptr->fld1, fmtptr->fld2, ( fcb->blanks == BLANK_ZERO ),
IOCB->scale, prec, &value, comma, &width, false );
if( status == FLT_OK ) {
if( comma && ( fmtptr->fld1 != width ) ) {
fcb->col += width;
if( fcb->buffer[ fcb->col ] == ',' ) {
fcb->col++;
} else {
IOErr( IO_BAD_CHAR );
}
} else {
fcb->col += fmtptr->fld1;
}
if( typ == PT_REAL_4 ) {
*(single PGM *)(IORslt.pgm_ptr) = value;
} else if( typ == PT_REAL_8 ) {
*(double PGM *)(IORslt.pgm_ptr) = value;
} else if( typ == PT_REAL_16 ) {
*(extended PGM *)(IORslt.pgm_ptr) = value;
} else if( typ == PT_CPLX_8 ) {
if( IOCB->flags & IOF_FMTREALPART ) {
((scomplex PGM *)(IORslt.pgm_ptr))->realpart = value;
} else {
((scomplex PGM *)(IORslt.pgm_ptr))->imagpart = value;
}
} else if( typ == PT_CPLX_16 ) {
if( IOCB->flags & IOF_FMTREALPART ) {
((dcomplex PGM *)(IORslt.pgm_ptr))->realpart = value;
} else {
((dcomplex PGM *)(IORslt.pgm_ptr))->imagpart = value;
}
} else {
if( IOCB->flags & IOF_FMTREALPART ) {
((xcomplex PGM *)(IORslt.pgm_ptr))->realpart = value;
} else {
((xcomplex PGM *)(IORslt.pgm_ptr))->imagpart = value;
}
}
} else {
if( status == FLT_INVALID ) {
IOErr( IO_BAD_CHAR );
} else { // FLT_RANGE_EXCEEDED
IOErr( IO_FRANGE_EXCEEDED );
}
}
}
