Commit 575094a2 by Craig Burley Committed by Jeff Law

Support FORMAT(I<1+2>) (constant variable-FORMAT expressions):

        Support FORMAT(I<1+2>) (constant variable-FORMAT
        expressions):
        * bad.def (FFEBAD_FORMAT_VARIABLE): New diagnostic.
        * std.c (ffestd_R1001rtexpr_): New function.
        (ffestd_R1001dump_, ffestd_R1001dump_1005_1_,
        ffestd_R1001dump_1005_2_, ffestd_R1001dump_1005_3_,
        ffestd_R1001dump_1005_4_, ffestd_R1001dump_1005_5_,
        ffestd_R1001dump_1010_2_, ffestd_R1001dump_1010_3_,
        ffestd_R1001dump_1010_4_, ffestd_R1001dump_1010_5_):
        Use new function instead of ffestd_R1001error_.
        * stb.c (ffestb_R10014_, ffestb_R10016_, ffestb_R10018_,
        ffestb_R100110_): Restructure `for' loop for style.
Change from Craig.

From-SVN: r18181
parent 45c48869
Sun Jan 11 02:14:47 1998 Craig Burley <burley@gnu.org>
Support FORMAT(I<1+2>) (constant variable-FORMAT
expressions):
* bad.def (FFEBAD_FORMAT_VARIABLE): New diagnostic.
* std.c (ffestd_R1001rtexpr_): New function.
(ffestd_R1001dump_, ffestd_R1001dump_1005_1_,
ffestd_R1001dump_1005_2_, ffestd_R1001dump_1005_3_,
ffestd_R1001dump_1005_4_, ffestd_R1001dump_1005_5_,
ffestd_R1001dump_1010_2_, ffestd_R1001dump_1010_3_,
ffestd_R1001dump_1010_4_, ffestd_R1001dump_1010_5_):
Use new function instead of ffestd_R1001error_.
* stb.c (ffestb_R10014_, ffestb_R10016_, ffestb_R10018_,
ffestb_R100110_): Restructure `for' loop for style.
Fri Oct 10 13:00:48 1997 Craig Burley <burley@gnu.ai.mit.edu>
* ste.c (ffeste_begin_iterdo_): Fix loop setup so iteration
......
......@@ -549,6 +549,8 @@ FFEBAD_MSGS1 (FFEBAD_ARRAY_AS_SFARG, FATAL,
"Array supplied at %1 for dummy argument `%A' in statement function reference at %0")
FFEBAD_MSGS1 (FFEBAD_FORMAT_UNSUPPORTED, FATAL,
"Unsupported FORMAT specifier at %0")
FFEBAD_MSGS1 (FFEBAD_FORMAT_VARIABLE, FATAL,
"Variable-expression FORMAT specifier at %0 -- unsupported")
FFEBAD_MSGS2 (FFEBAD_OPEN_UNSUPPORTED, WARN,
"Unsupported OPEN control item at %0 -- ACTION=, ASSOCIATEVARIABLE=, BLOCKSIZE=, BUFFERCOUNT=, CARRIAGECONTROL=, DEFAULTFILE=, DELIM=, DISPOSE=, EXTENDSIZE=, INITIALSIZE=, KEY=, MAXREC=, NOSPANBLOCKS, ORGANIZATION=, PAD=, POSITION=, READONLY=, RECORDTYPE=, SHARED=, and USEROPEN= are not supported",
"Unsupported OPEN control item at %0")
......
......@@ -9214,14 +9214,14 @@ ffestb_R10014_ (ffelexToken t)
}
if (ffestb_local_.format.sign)
{
for (i = 0; i < ffelex_token_length (t); ++i)
for (i = ffelex_token_length (t) + 1; i > 0; --i)
ffestb_local_.format.pre.u.signed_val *= 10;
ffestb_local_.format.pre.u.signed_val += strtoul (ffelex_token_text (t),
NULL, 10);
}
else
{
for (i = 0; i < ffelex_token_length (t); ++i)
for (i = ffelex_token_length (t) + 1; i > 0; --i)
ffestb_local_.format.pre.u.unsigned_val *= 10;
ffestb_local_.format.pre.u.unsigned_val += strtoul (ffelex_token_text (t),
NULL, 10);
......@@ -10105,7 +10105,7 @@ ffestb_R10016_ (ffelexToken t)
ffebad_finish ();
return (ffelexHandler) ffestb_R10016_;
}
for (i = 0; i < ffelex_token_length (t); ++i)
for (i = ffelex_token_length (t) + 1; i > 0; --i)
ffestb_local_.format.post.u.unsigned_val *= 10;
ffestb_local_.format.post.u.unsigned_val += strtoul (ffelex_token_text (t),
NULL, 10);
......@@ -10205,7 +10205,7 @@ ffestb_R10018_ (ffelexToken t)
ffebad_finish ();
return (ffelexHandler) ffestb_R10018_;
}
for (i = 0; i < ffelex_token_length (t); ++i)
for (i = ffelex_token_length (t) + 1; i > 0; --i)
ffestb_local_.format.dot.u.unsigned_val *= 10;
ffestb_local_.format.dot.u.unsigned_val += strtoul (ffelex_token_text (t),
NULL, 10);
......@@ -10332,7 +10332,7 @@ ffestb_R100110_ (ffelexToken t)
ffebad_finish ();
return (ffelexHandler) ffestb_R100110_;
}
for (i = 0; i < ffelex_token_length (t); ++i)
for (i = ffelex_token_length (t) + 1; i > 0; --i)
ffestb_local_.format.exp.u.unsigned_val *= 10;
ffestb_local_.format.exp.u.unsigned_val += strtoul (ffelex_token_text (t),
NULL, 10);
......
......@@ -546,6 +546,7 @@ static void ffestd_R1001dump_1010_4_ (ffests s, ffesttFormatList f,
static void ffestd_R1001dump_1010_5_ (ffests s, ffesttFormatList f,
char *string);
static void ffestd_R1001error_ (ffesttFormatList f);
static void ffestd_R1001rtexpr_ (ffests s, ffesttFormatList f, ffebld expr);
/* Internal macros. */
......@@ -4360,7 +4361,7 @@ ffestd_R1001dump_ (ffests s, ffesttFormatList list)
if (next->u.R1003D.R1004.present)
{
if (next->u.R1003D.R1004.rtexpr)
ffestd_R1001error_ (next);
ffestd_R1001rtexpr_ (s, next, next->u.R1003D.R1004.u.expr);
else
ffests_printf_1U (s, "%lu",
next->u.R1003D.R1004.u.unsigned_val);
......@@ -4393,7 +4394,7 @@ ffestd_R1001dump_1005_1_ (ffests s, ffesttFormatList f, char *string)
if (f->u.R1005.R1004.present)
{
if (f->u.R1005.R1004.rtexpr)
ffestd_R1001error_ (f);
ffestd_R1001rtexpr_ (s, f, f->u.R1005.R1004.u.expr);
else
ffests_printf_1U (s, "%lu", f->u.R1005.R1004.u.unsigned_val);
}
......@@ -4403,7 +4404,7 @@ ffestd_R1001dump_1005_1_ (ffests s, ffesttFormatList f, char *string)
if (f->u.R1005.R1006.present)
{
if (f->u.R1005.R1006.rtexpr)
ffestd_R1001error_ (f);
ffestd_R1001rtexpr_ (s, f, f->u.R1005.R1006.u.expr);
else
ffests_printf_1U (s, "%lu", f->u.R1005.R1006.u.unsigned_val);
}
......@@ -4426,7 +4427,7 @@ ffestd_R1001dump_1005_2_ (ffests s, ffesttFormatList f, char *string)
if (f->u.R1005.R1004.present)
{
if (f->u.R1005.R1004.rtexpr)
ffestd_R1001error_ (f);
ffestd_R1001rtexpr_ (s, f, f->u.R1005.R1004.u.expr);
else
ffests_printf_1U (s, "%lu", f->u.R1005.R1004.u.unsigned_val);
}
......@@ -4434,7 +4435,7 @@ ffestd_R1001dump_1005_2_ (ffests s, ffesttFormatList f, char *string)
ffests_puts (s, string);
if (f->u.R1005.R1006.rtexpr)
ffestd_R1001error_ (f);
ffestd_R1001rtexpr_ (s, f, f->u.R1005.R1006.u.expr);
else
ffests_printf_1U (s, "%lu", f->u.R1005.R1006.u.unsigned_val);
}
......@@ -4455,7 +4456,7 @@ ffestd_R1001dump_1005_3_ (ffests s, ffesttFormatList f, char *string)
if (f->u.R1005.R1004.present)
{
if (f->u.R1005.R1004.rtexpr)
ffestd_R1001error_ (f);
ffestd_R1001rtexpr_ (s, f, f->u.R1005.R1004.u.expr);
else
ffests_printf_1U (s, "%lu", f->u.R1005.R1004.u.unsigned_val);
}
......@@ -4463,7 +4464,7 @@ ffestd_R1001dump_1005_3_ (ffests s, ffesttFormatList f, char *string)
ffests_puts (s, string);
if (f->u.R1005.R1006.rtexpr)
ffestd_R1001error_ (f);
ffestd_R1001rtexpr_ (s, f, f->u.R1005.R1006.u.expr);
else
ffests_printf_1U (s, "%lu", f->u.R1005.R1006.u.unsigned_val);
......@@ -4471,7 +4472,7 @@ ffestd_R1001dump_1005_3_ (ffests s, ffesttFormatList f, char *string)
{
ffests_putc (s, '.');
if (f->u.R1005.R1007_or_R1008.rtexpr)
ffestd_R1001error_ (f);
ffestd_R1001rtexpr_ (s, f, f->u.R1005.R1007_or_R1008.u.expr);
else
ffests_printf_1U (s, "%lu",
f->u.R1005.R1007_or_R1008.u.unsigned_val);
......@@ -4495,7 +4496,7 @@ ffestd_R1001dump_1005_4_ (ffests s, ffesttFormatList f, char *string)
if (f->u.R1005.R1004.present)
{
if (f->u.R1005.R1004.rtexpr)
ffestd_R1001error_ (f);
ffestd_R1001rtexpr_ (s, f, f->u.R1005.R1004.u.expr);
else
ffests_printf_1U (s, "%lu", f->u.R1005.R1004.u.unsigned_val);
}
......@@ -4503,13 +4504,13 @@ ffestd_R1001dump_1005_4_ (ffests s, ffesttFormatList f, char *string)
ffests_puts (s, string);
if (f->u.R1005.R1006.rtexpr)
ffestd_R1001error_ (f);
ffestd_R1001rtexpr_ (s, f, f->u.R1005.R1006.u.expr);
else
ffests_printf_1U (s, "%lu", f->u.R1005.R1006.u.unsigned_val);
ffests_putc (s, '.');
if (f->u.R1005.R1007_or_R1008.rtexpr)
ffestd_R1001error_ (f);
ffestd_R1001rtexpr_ (s, f, f->u.R1005.R1007_or_R1008.u.expr);
else
ffests_printf_1U (s, "%lu", f->u.R1005.R1007_or_R1008.u.unsigned_val);
}
......@@ -4530,7 +4531,7 @@ ffestd_R1001dump_1005_5_ (ffests s, ffesttFormatList f, char *string)
if (f->u.R1005.R1004.present)
{
if (f->u.R1005.R1004.rtexpr)
ffestd_R1001error_ (f);
ffestd_R1001rtexpr_ (s, f, f->u.R1005.R1004.u.expr);
else
ffests_printf_1U (s, "%lu", f->u.R1005.R1004.u.unsigned_val);
}
......@@ -4538,13 +4539,13 @@ ffestd_R1001dump_1005_5_ (ffests s, ffesttFormatList f, char *string)
ffests_puts (s, string);
if (f->u.R1005.R1006.rtexpr)
ffestd_R1001error_ (f);
ffestd_R1001rtexpr_ (s, f, f->u.R1005.R1006.u.expr);
else
ffests_printf_1U (s, "%lu", f->u.R1005.R1006.u.unsigned_val);
ffests_putc (s, '.');
if (f->u.R1005.R1007_or_R1008.rtexpr)
ffestd_R1001error_ (f);
ffestd_R1001rtexpr_ (s, f, f->u.R1005.R1007_or_R1008.u.expr);
else
ffests_printf_1U (s, "%lu", f->u.R1005.R1007_or_R1008.u.unsigned_val);
......@@ -4552,7 +4553,7 @@ ffestd_R1001dump_1005_5_ (ffests s, ffesttFormatList f, char *string)
{
ffests_putc (s, 'E');
if (f->u.R1005.R1009.rtexpr)
ffestd_R1001error_ (f);
ffestd_R1001rtexpr_ (s, f, f->u.R1005.R1009.u.expr);
else
ffests_printf_1U (s, "%lu", f->u.R1005.R1009.u.unsigned_val);
}
......@@ -4586,7 +4587,7 @@ ffestd_R1001dump_1010_2_ (ffests s, ffesttFormatList f, char *string)
if (f->u.R1010.val.present)
{
if (f->u.R1010.val.rtexpr)
ffestd_R1001error_ (f);
ffestd_R1001rtexpr_ (s, f, f->u.R1010.val.u.expr);
else
ffests_printf_1U (s, "%lu", f->u.R1010.val.u.unsigned_val);
}
......@@ -4607,7 +4608,7 @@ ffestd_R1001dump_1010_3_ (ffests s, ffesttFormatList f, char *string)
assert (f->u.R1010.val.present);
if (f->u.R1010.val.rtexpr)
ffestd_R1001error_ (f);
ffestd_R1001rtexpr_ (s, f, f->u.R1010.val.u.expr);
else
ffests_printf_1U (s, "%lu", f->u.R1010.val.u.unsigned_val);
......@@ -4627,7 +4628,7 @@ ffestd_R1001dump_1010_4_ (ffests s, ffesttFormatList f, char *string)
assert (f->u.R1010.val.present);
if (f->u.R1010.val.rtexpr)
ffestd_R1001error_ (f);
ffestd_R1001rtexpr_ (s, f, f->u.R1010.val.u.expr);
else
ffests_printf_1D (s, "%ld", f->u.R1010.val.u.signed_val);
......@@ -4649,7 +4650,7 @@ ffestd_R1001dump_1010_5_ (ffests s, ffesttFormatList f, char *string)
ffests_puts (s, string);
if (f->u.R1010.val.rtexpr)
ffestd_R1001error_ (f);
ffestd_R1001rtexpr_ (s, f, f->u.R1010.val.u.expr);
else
ffests_printf_1U (s, "%lu", f->u.R1010.val.u.unsigned_val);
}
......@@ -4669,6 +4670,52 @@ ffestd_R1001error_ (ffesttFormatList f)
ffebad_finish ();
}
static void
ffestd_R1001rtexpr_ (ffests s, ffesttFormatList f, ffebld expr)
{
if ((expr == NULL)
|| (ffebld_op (expr) != FFEBLD_opCONTER)
|| (ffeinfo_basictype (ffebld_info (expr)) != FFEINFO_basictypeINTEGER)
|| (ffeinfo_kindtype (ffebld_info (expr)) == FFEINFO_kindtypeINTEGER4))
{
ffebad_start (FFEBAD_FORMAT_VARIABLE);
ffebad_here (0, ffelex_token_where_line (f->t), ffelex_token_where_column (f->t));
ffebad_finish ();
}
else
{
int val;
switch (ffeinfo_kindtype (ffebld_info (expr)))
{
#if FFETARGET_okINTEGER1
case FFEINFO_kindtypeINTEGER1:
val = ffebld_constant_integer1 (ffebld_conter (expr));
break;
#endif
#if FFETARGET_okINTEGER2
case FFEINFO_kindtypeINTEGER2:
val = ffebld_constant_integer2 (ffebld_conter (expr));
break;
#endif
#if FFETARGET_okINTEGER3
case FFEINFO_kindtypeINTEGER3:
val = ffebld_constant_integer3 (ffebld_conter (expr));
break;
#endif
default:
assert ("bad INTEGER constant kind type" == NULL);
/* Fall through. */
case FFEINFO_kindtypeANY:
return;
}
ffests_printf_1D (s, "%ld", val);
}
}
/* ffestd_R1102 -- PROGRAM statement
ffestd_R1102(name_token);
......
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment