+2010-07-19 Jerry DeLisle <jvdelisle@gcc.gnu.org>
+
+ PR libfortran/44953
+ * io/unix.c (mem_alloc_w4): Return gfc_char4_t instead of char type
+ pointer. (mem_write4): Remove cast to gfc_char4_t.
+ * io/transfer.c (write_block): Use a gfc_char4_t pointer.
+ (memset4): New helper function. (next_record_w): Use new helper
+ function rather than sset for internal units. Don't attempt to pad
+ with spaces if it is not needed.
+ * io/unix.h: Update prototype for mem_alloc_w4.
+ * io/write.c (memset4): Use gfc_char4_t pointer and chracter type.
+ Don't use multiply by 4 to compute offset. (memcpy4): Likewise.
+ (write_default_char4): Use a gfc_char4_t pointer and update memset4
+ and memcpy calls. (write_a): Likewise. (write_l): Likewise.
+ (write_boz): Likewise. (write_decimal): Likewise. (write_x): Likewise.
+ (write_char): Add support for character(kind=4) internal units that
+ was previously missed. (write_integer): Use a gfc_char4_t pointer and
+ update memset4 and memcpy calls. (write_character): Likewise.
+ (write_separator): Add support for character(kind=4) internal units
+ that was previously missed.
+ * write_float.def (output_float): Use a gfc_char4_t pointer and
+ update memset4 and memcpy calls. (write_infnan): Likewise.
+ (output_float_FMT_G_): Likewise.
+
2010-07-16 Jerry DeLisle <jvdelisle@gcc.gnu.org>
PR libfortran/37077
if (is_internal_unit (dtp))
{
if (dtp->common.unit) /* char4 internel unit. */
- dest = mem_alloc_w4 (dtp->u.p.current_unit->s, &length);
+ {
+ gfc_char4_t *dest4;
+ dest4 = mem_alloc_w4 (dtp->u.p.current_unit->s, &length);
+ if (dest4 == NULL)
+ {
+ generate_error (&dtp->common, LIBERROR_END, NULL);
+ return NULL;
+ }
+ return dest4;
+ }
else
dest = mem_alloc_w (dtp->u.p.current_unit->s, &length);
return nbyte - bytes_left;
}
+static inline void
+memset4 (gfc_char4_t *p, gfc_char4_t c, int k)
+{
+ int j;
+ for (j = 0; j < k; j++)
+ *p++ = c;
+}
+
/* Position to the next record in write mode. */
static void
if (is_internal_unit (dtp))
{
+ char *p;
if (is_array_io (dtp))
{
int finished;
length = (int) (dtp->u.p.current_unit->recl - max_pos);
}
- if (sset (dtp->u.p.current_unit->s, ' ', length) != length)
- {
- generate_error (&dtp->common, LIBERROR_END, NULL);
- return;
+ p = write_block (dtp, length);
+ if (p == NULL)
+ return;
+
+ if (unlikely (is_char4_unit (dtp)))
+ {
+ gfc_char4_t *p4 = (gfc_char4_t *) p;
+ memset4 (p4, ' ', length);
}
+ else
+ memset (p, ' ', length);
/* Now that the current record has been padded out,
determine where the next record in the array is. */
else
length = (int) dtp->u.p.current_unit->bytes_left;
}
-
- if (sset (dtp->u.p.current_unit->s, ' ', length) != length)
+ if (length > 0)
{
- generate_error (&dtp->common, LIBERROR_END, NULL);
- return;
+ p = write_block (dtp, length);
+ if (p == NULL)
+ return;
+
+ if (unlikely (is_char4_unit (dtp)))
+ {
+ gfc_char4_t *p4 = (gfc_char4_t *) p;
+ memset4 (p4, (gfc_char4_t) ' ', length);
+ }
+ else
+ memset (p, ' ', length);
}
}
}
}
-char *
+gfc_char4_t *
mem_alloc_w4 (stream * strm, int * len)
{
unix_stream * s = (unix_stream *) strm;
gfc_offset m;
gfc_offset where = s->logical_offset;
+ gfc_char4_t *result = (gfc_char4_t *) s->buffer;
m = where + *len;
return NULL;
s->logical_offset = m;
- return s->buffer + (where - s->buffer_offset) * 4;
+ return &result[where - s->buffer_offset];
}
gfc_char4_t *p;
int nw = nwords;
- p = (gfc_char4_t *) mem_alloc_w4 (s, &nw);
+ p = mem_alloc_w4 (s, &nw);
if (p)
{
while (nw--)
extern char * mem_alloc_r (stream *, int *);
internal_proto(mem_alloc_r);
-extern char * mem_alloc_w4 (stream *, int *);
+extern gfc_char4_t * mem_alloc_w4 (stream *, int *);
internal_proto(mem_alloc_w4);
extern char * mem_alloc_r4 (stream *, int *);
by write_float.def. */
static inline void
-memset4 (void *p, int offs, uchar c, int k)
+memset4 (gfc_char4_t *p, gfc_char4_t c, int k)
{
int j;
- gfc_char4_t *q = (gfc_char4_t *) (p + offs * 4);
for (j = 0; j < k; j++)
- *q++ = c;
+ *p++ = c;
}
static inline void
-memcpy4 (void *dest, int offs, const char *source, int k)
+memcpy4 (gfc_char4_t *dest, const char *source, int k)
{
int j;
const char *p = source;
- gfc_char4_t *q = (gfc_char4_t *) (dest + offs * 4);
for (j = 0; j < k; j++)
- *q++ = (gfc_char4_t) *p++;
+ *dest++ = (gfc_char4_t) *p++;
}
/* This include contains the heart and soul of formatted floating point. */
if (p == NULL)
return;
if (is_char4_unit (dtp))
- memset4 (p, 0, ' ', k);
+ {
+ gfc_char4_t *p4 = (gfc_char4_t *) p;
+ memset4 (p4, ' ', k);
+ }
else
memset (p, ' ', k);
}
if (unlikely (is_char4_unit (dtp)))
{
+ gfc_char4_t *p4 = (gfc_char4_t *) p;
if (wlen < len)
- memcpy4 (p, 0, source, wlen);
+ memcpy4 (p4, source, wlen);
else
{
- memset4 (p, 0, ' ', wlen - len);
- memcpy4 (p, wlen - len, source, len);
+ memset4 (p4, ' ', wlen - len);
+ memcpy4 (p4 + wlen - len, source, len);
}
return;
}
if (unlikely (is_char4_unit (dtp)))
{
gfc_char4_t *p4 = (gfc_char4_t *) p;
- memset4 (p, 0, ' ', wlen -1);
+ memset4 (p4, ' ', wlen -1);
p4[wlen - 1] = (n) ? 'T' : 'F';
return;
}
if (p == NULL)
return;
if (unlikely (is_char4_unit (dtp)))
- memset4 (p, 0, ' ', w);
+ {
+ gfc_char4_t *p4 = (gfc_char4_t *) p;
+ memset4 (p4, ' ', w);
+ }
else
memset (p, ' ', w);
goto done;
gfc_char4_t *p4 = (gfc_char4_t *) p;
if (nblank < 0)
{
- memset4 (p4, 0, '*', w);
+ memset4 (p4, '*', w);
return;
}
if (!dtp->u.p.no_leading_blank)
{
- memset4 (p4, 0, ' ', nblank);
+ memset4 (p4, ' ', nblank);
q += nblank;
- memset4 (p4, 0, '0', nzero);
+ memset4 (p4, '0', nzero);
q += nzero;
- memcpy4 (p4, 0, q, digits);
+ memcpy4 (p4, q, digits);
}
else
{
- memset4 (p4, 0, '0', nzero);
+ memset4 (p4, '0', nzero);
q += nzero;
- memcpy4 (p4, 0, q, digits);
+ memcpy4 (p4, q, digits);
q += digits;
- memset4 (p4, 0, ' ', nblank);
+ memset4 (p4, ' ', nblank);
dtp->u.p.no_leading_blank = 0;
}
return;
if (p == NULL)
return;
if (unlikely (is_char4_unit (dtp)))
- memset4 (p, 0, ' ', w);
+ {
+ gfc_char4_t *p4 = (gfc_char4_t *) p;
+ memset4 (p4, ' ', w);
+ }
else
memset (p, ' ', w);
goto done;
gfc_char4_t * p4 = (gfc_char4_t *) p;
if (nblank < 0)
{
- memset4 (p4, 0, '*', w);
+ memset4 (p4, '*', w);
goto done;
}
- memset4 (p4, 0, ' ', nblank);
+ memset4 (p4, ' ', nblank);
p4 += nblank;
switch (sign)
break;
}
- memset4 (p4, 0, '0', nzero);
+ memset4 (p4, '0', nzero);
p4 += nzero;
- memcpy4 (p4, 0, q, digits);
+ memcpy4 (p4, q, digits);
return;
}
if (nspaces > 0 && len - nspaces >= 0)
{
if (unlikely (is_char4_unit (dtp)))
- memset4 (p, len - nspaces, ' ', nspaces);
+ {
+ gfc_char4_t *p4 = (gfc_char4_t *) p;
+ memset4 (&p4[len - nspaces], ' ', nspaces);
+ }
else
memset (&p[len - nspaces], ' ', nspaces);
}
something goes wrong. */
static int
-write_char (st_parameter_dt *dtp, char c)
+write_char (st_parameter_dt *dtp, int c)
{
char *p;
p = write_block (dtp, 1);
if (p == NULL)
return 1;
+ if (unlikely (is_char4_unit (dtp)))
+ {
+ gfc_char4_t *p4 = (gfc_char4_t *) p;
+ *p4 = c;
+ return 0;
+ }
- *p = c;
+ *p = (uchar) c;
return 0;
}
if (unlikely (is_char4_unit (dtp)))
{
+ gfc_char4_t *p4 = (gfc_char4_t *) p;
if (dtp->u.p.no_leading_blank)
{
- memcpy4 (p, 0, q, digits);
- memset4 (p, digits, ' ', width - digits);
+ memcpy4 (p4, q, digits);
+ memset4 (p4 + digits, ' ', width - digits);
}
else
{
- memset4 (p, 0, ' ', width - digits);
- memcpy4 (p, width - digits, q, digits);
+ memset4 (p4, ' ', width - digits);
+ memcpy4 (p4 + width - digits, q, digits);
}
return;
}
gfc_char4_t *p4 = (gfc_char4_t *) p;
if (d4 == ' ')
- memcpy4 (p4, 0, source, length);
+ memcpy4 (p4, source, length);
else
{
*p4++ = d4;
p = write_block (dtp, options.separator_len);
if (p == NULL)
return;
-
- memcpy (p, options.separator, options.separator_len);
+ if (unlikely (is_char4_unit (dtp)))
+ {
+ gfc_char4_t *p4 = (gfc_char4_t *) p;
+ memcpy4 (p4, options.separator, options.separator_len);
+ }
+ else
+ memcpy (p, options.separator, options.separator_len);
}
{
if (unlikely (is_char4_unit (dtp)))
{
- memset4 (out, 0, '*', w);
+ gfc_char4_t *out4 = (gfc_char4_t *) out;
+ memset4 (out4, '*', w);
return;
}
star_fill (out, w);
if ( ( nblanks > 0 ) && !dtp->u.p.no_leading_blank)
{
- memset4 (out, 0, ' ', nblanks);
+ memset4 (out4, ' ', nblanks);
out4 += nblanks;
}
if (nbefore > ndigits)
{
i = ndigits;
- memcpy4 (out4, 0, digits, i);
+ memcpy4 (out4, digits, i);
ndigits = 0;
while (i < nbefore)
out4[i++] = '0';
else
{
i = nbefore;
- memcpy4 (out4, 0, digits, i);
+ memcpy4 (out4, digits, i);
ndigits -= i;
}
else
i = nafter;
- memcpy4 (out4, 0, digits, i);
+ memcpy4 (out4, digits, i);
while (i < nafter)
out4[i++] = '0';
#else
sprintf (buffer, "%+0*d", edigits, e);
#endif
- memcpy4 (out4, 0, buffer, edigits);
+ memcpy4 (out4, buffer, edigits);
}
if (dtp->u.p.no_leading_blank)
{
out4 += edigits;
- memset4 (out4 , 0, ' ' , nblanks);
+ memset4 (out4, ' ' , nblanks);
dtp->u.p.no_leading_blank = 0;
}
return;
if (nb < 3)
{
if (unlikely (is_char4_unit (dtp)))
- memset4 (p, 0, '*', nb);
+ {
+ gfc_char4_t *p4 = (gfc_char4_t *) p;
+ memset4 (p4, '*', nb);
+ }
else
memset (p, '*', nb);
return;
}
if (unlikely (is_char4_unit (dtp)))
- memset4 (p, 0, ' ', nb);
+ {
+ gfc_char4_t *p4 = (gfc_char4_t *) p;
+ memset4 (p4, ' ', nb);
+ }
else
memset(p, ' ', nb);
if (nb == 3)
{
if (unlikely (is_char4_unit (dtp)))
- memset4 (p, 0, '*', nb);
+ {
+ gfc_char4_t *p4 = (gfc_char4_t *) p;
+ memset4 (p4, '*', nb);
+ }
else
memset (p, '*', nb);
return;
gfc_char4_t *p4 = (gfc_char4_t *) p;
if (nb > 8)
/* We have room, so output 'Infinity' */
- memcpy4 (p4, nb - 8, "Infinity", 8);
+ memcpy4 (p4 + nb - 8, "Infinity", 8);
else
/* For the case of width equals 8, there is not enough room
for the sign and 'Infinity' so we go with 'Inf' */
- memcpy4 (p4, nb - 3, "Inf", 3);
+ memcpy4 (p4 + nb - 3, "Inf", 3);
if (nb < 9 && nb > 3)
/* Put the sign in front of Inf */
else
{
if (unlikely (is_char4_unit (dtp)))
- memcpy4 (p, nb - 3, "NaN", 3);
+ {
+ gfc_char4_t *p4 = (gfc_char4_t *) p;
+ memcpy4 (p4 + nb - 3, "NaN", 3);
+ }
else
memcpy(p + nb - 3, "NaN", 3);
}
free (newf);\
\
if (nb > 0 && !dtp->u.p.g0_no_blanks)\
- { \
+ {\
p = write_block (dtp, nb);\
if (p == NULL)\
return;\
if (unlikely (is_char4_unit (dtp)))\
- memset4 (p, 0, ' ', nb);\
+ {\
+ gfc_char4_t *p4 = (gfc_char4_t *) p;\
+ memset4 (p4, ' ', nb);\
+ }\
else\
memset (p, ' ', nb);\
}\