#include "config.h"
#include <string.h>
#include <errno.h>
#include <ctype.h>
#include <stdlib.h>
#include "libgfortran.h"
#include "io.h"
void
set_integer (void *dest, int64_t value, int length)
{
switch (length)
{
case 8:
*((int64_t *) dest) = value;
break;
case 4:
*((int32_t *) dest) = value;
break;
case 2:
*((int16_t *) dest) = value;
break;
case 1:
*((int8_t *) dest) = value;
break;
default:
internal_error ("Bad integer kind");
}
}
uint64_t
max_value (int length, int signed_flag)
{
uint64_t value;
switch (length)
{
case 8:
value = signed_flag ? 0x7fffffffffffffff : 0xffffffffffffffff;
break;
case 4:
value = signed_flag ? 0x7fffffff : 0xffffffff;
break;
case 2:
value = signed_flag ? 0x7fff : 0xffff;
break;
case 1:
value = signed_flag ? 0x7f : 0xff;
break;
default:
internal_error ("Bad integer kind");
}
return value;
}
int
convert_real (void *dest, const char *buffer, int length)
{
errno = 0;
switch (length)
{
case 4:
*((float *) dest) = (float) strtod (buffer, NULL);
break;
case 8:
*((double *) dest) = strtod (buffer, NULL);
break;
default:
internal_error ("Bad real number kind");
}
if (errno != 0)
{
generate_error (ERROR_READ_VALUE,
"Range error during floating point read");
return 1;
}
return 0;
}
static int
convert_precision_real (void *dest, int sign,
char *buffer, int length, int exponent)
{
int w, new_dp_pos, i, slen, k, dp;
char * p, c;
double fval;
float tf;
fval =0.0;
tf = 0.0;
dp = 0;
new_dp_pos = 0;
slen = strlen (buffer);
w = slen;
p = buffer;
for (i = 0; i < w; i++)
{
if (buffer[i] == '.')
break;
}
new_dp_pos = i;
new_dp_pos += exponent;
while (w > 0)
{
c = *p;
switch (c)
{
case '0':
case '1':
case '2':
case '3':
case '4':
case '5':
case '6':
case '7':
case '8':
case '9':
fval = fval * 10.0 + c - '0';
p++;
w--;
break;
case '.':
dp = 1;
p++;
w--;
break;
default:
p++;
w--;
break;
}
}
if (sign)
fval = - fval;
i = new_dp_pos - slen + dp;
k = abs(i);
tf = 1.0;
while (k > 0)
{
tf *= 10.0 ;
k -- ;
}
if (fval != 0.0)
{
if (i < 0)
{
fval = fval / tf;
}
else
{
fval = fval * tf;
}
}
switch (length)
{
case 4:
*((float *) dest) = (float)fval;
break;
case 8:
*((double *) dest) = fval;
break;
default:
internal_error ("Bad real number kind");
}
return 0;
}
void
read_l (fnode * f, char *dest, int length)
{
char *p;
int w;
w = f->u.w;
p = read_block (&w);
if (p == NULL)
return;
while (*p == ' ')
{
if (--w == 0)
goto bad;
p++;
}
if (*p == '.')
{
if (--w == 0)
goto bad;
p++;
}
switch (*p)
{
case 't':
case 'T':
set_integer (dest, 1, length);
break;
case 'f':
case 'F':
set_integer (dest, 0, length);
break;
default:
bad:
generate_error (ERROR_READ_VALUE, "Bad value on logical read");
break;
}
}
void
read_a (fnode * f, char *p, int length)
{
char *source;
int w, m, n;
w = f->u.w;
if (w == -1)
w = length;
source = read_block (&w);
if (source == NULL)
return;
if (w > length)
source += (w - length);
m = (w > length) ? length : w;
memcpy (p, source, m);
n = length - w;
if (n > 0)
memset (p + m, ' ', n);
}
static char *
eat_leading_spaces (int *width, char *p)
{
for (;;)
{
if (*width == 0 || *p != ' ')
break;
(*width)--;
p++;
}
return p;
}
static char
next_char (char **p, int *w)
{
char c, *q;
if (*w == 0)
return '\0';
q = *p;
c = *q++;
*p = q;
(*w)--;
if (c != ' ')
return c;
if (g.blank_status == BLANK_ZERO)
return '0';
while (*w > 0)
{
if (*q++ != ' ')
return '?';
(*w)--;
}
*p = q;
return '\0';
}
void
read_decimal (fnode * f, char *dest, int length)
{
unsigned value, maxv, maxv_10;
int v, w, negative;
char c, *p;
w = f->u.w;
p = read_block (&w);
if (p == NULL)
return;
p = eat_leading_spaces (&w, p);
if (w == 0)
{
set_integer (dest, 0, length);
return;
}
maxv = max_value (length, 1);
maxv_10 = maxv / 10;
negative = 0;
value = 0;
switch (*p)
{
case '-':
negative = 1;
case '+':
p++;
if (--w == 0)
goto bad;
default:
break;
}
value = 0;
for (;;)
{
c = next_char (&p, &w);
if (c == '\0')
break;
if (c < '0' || c > '9')
goto bad;
if (value > maxv_10)
goto overflow;
c -= '0';
value = 10 * value;
if (value > maxv - c)
goto overflow;
value += c;
}
v = (signed int) value;
if (negative)
v = -v;
set_integer (dest, v, length);
return;
bad:
generate_error (ERROR_READ_VALUE, "Bad value during integer read");
return;
overflow:
generate_error (ERROR_READ_OVERFLOW,
"Value overflowed during integer read");
return;
}
void
read_radix (fnode * f, char *dest, int length, int radix)
{
unsigned value, maxv, maxv_r;
int v, w, negative;
char c, *p;
w = f->u.w;
p = read_block (&w);
if (p == NULL)
return;
p = eat_leading_spaces (&w, p);
if (w == 0)
{
set_integer (dest, 0, length);
return;
}
maxv = max_value (length, 0);
maxv_r = maxv / radix;
negative = 0;
value = 0;
switch (*p)
{
case '-':
negative = 1;
case '+':
p++;
if (--w == 0)
goto bad;
default:
break;
}
value = 0;
for (;;)
{
c = next_char (&p, &w);
if (c == '\0')
break;
switch (radix)
{
case 2:
if (c < '0' || c > '1')
goto bad;
break;
case 8:
if (c < '0' || c > '7')
goto bad;
break;
case 16:
switch (c)
{
case '0':
case '1':
case '2':
case '3':
case '4':
case '5':
case '6':
case '7':
case '8':
case '9':
break;
case 'a':
case 'b':
case 'c':
case 'd':
case 'e':
case 'f':
c = c - 'a' + '9' + 1;
break;
case 'A':
case 'B':
case 'C':
case 'D':
case 'E':
case 'F':
c = c - 'A' + '9' + 1;
break;
default:
goto bad;
}
break;
}
if (value > maxv_r)
goto overflow;
c -= '0';
value = radix * value;
if (maxv - c < value)
goto overflow;
value += c;
}
v = (signed int) value;
if (negative)
v = -v;
set_integer (dest, v, length);
return;
bad:
generate_error (ERROR_READ_VALUE, "Bad value during integer read");
return;
overflow:
generate_error (ERROR_READ_OVERFLOW,
"Value overflowed during integer read");
return;
}
void
read_f (fnode * f, char *dest, int length)
{
int w, seen_dp, exponent;
int exponent_sign, val_sign;
char *p, *buffer, *n;
val_sign = 0;
seen_dp = 0;
w = f->u.w;
p = read_block (&w);
if (p == NULL)
return;
p = eat_leading_spaces (&w, p);
if (w == 0)
{
switch (length)
{
case 4:
*((float *) dest) = 0.0;
break;
case 8:
*((double *) dest) = 0.0;
break;
}
return;
}
if (w + 2 < SCRATCH_SIZE)
buffer = scratch;
else
buffer = get_mem (w + 2);
memset(buffer, 0, w + 2);
n = buffer;
if (*p == '-' || *p == '+')
{
if (*p == '-')
val_sign = 1;
p++;
if (--w == 0)
goto bad_float;
}
exponent_sign = 1;
if (!isdigit (*p) && *p != '.')
goto bad_float;
while (w > 0)
{
switch (*p)
{
case '0':
case '1':
case '2':
case '3':
case '4':
case '5':
case '6':
case '7':
case '8':
case '9':
*n++ = *p++;
w--;
break;
case '.':
if (seen_dp)
goto bad_float;
seen_dp = 1;
*n++ = *p++;
w--;
break;
case ' ':
if (g.blank_status == BLANK_ZERO)
*n++ = '0';
p++;
w--;
break;
case '-':
exponent_sign = -1;
case '+':
p++;
w--;
goto exp2;
case 'd':
case 'e':
case 'D':
case 'E':
p++;
w--;
goto exp1;
default:
goto bad_float;
}
}
exponent = -g.scale_factor;
goto done;
bad_float:
generate_error (ERROR_READ_VALUE, "Bad value during floating point read");
if (buffer != scratch)
free_mem (buffer);
return;
exp1:
while (w > 0 && *p == ' ')
{
w--;
p++;
}
switch (*p)
{
case '-':
exponent_sign = -1;
case '+':
p++;
w--;
break;
}
if (w == 0)
goto bad_float;
exp2:
if (!isdigit (*p))
goto bad_float;
exponent = *p - '0';
p++;
w--;
while (w > 0 && isdigit (*p))
{
exponent = 10 * exponent + *p - '0';
if (exponent > 999999)
goto bad_float;
p++;
w--;
}
while (w > 0)
{
if (*p != ' ')
goto bad_float;
p++;
w--;
}
exponent = exponent * exponent_sign;
done:
if (!seen_dp)
exponent -= f->u.real.d;
convert_precision_real (dest, val_sign, buffer, length, exponent);
if (buffer != scratch)
free_mem (buffer);
return;
}
void
read_x (fnode * f)
{
int n;
n = f->u.n;
read_block (&n);
}