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

diff --git a/gcc/f/ChangeLog b/gcc/f/ChangeLog
index 174a15ffe82775b8b7533de59b379c1bf6ed4589..0d7dadaf8fa5129c0be295d25dab4e48afacb089 100644 (file)
--- a/gcc/f/ChangeLog
+++ b/gcc/f/ChangeLog
@@ -1,3 +1,19 @@
+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

diff --git a/gcc/f/bad.def b/gcc/f/bad.def
index 347cd44150244cc3c06c68890772f29a71e41f93..9a3cf5a323d3296f9cbb53612b2de5522664947d 100644 (file)
--- a/gcc/f/bad.def
+++ b/gcc/f/bad.def
@@ -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")

diff --git a/gcc/f/stb.c b/gcc/f/stb.c
index 9cf655fa56bd0d048cf1a7841bf2a69735561f93..90ae83d56379e19aa8a54ad28ed4fc99f3e1eff0 100644 (file)
--- a/gcc/f/stb.c
+++ b/gcc/f/stb.c
@@ -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);

diff --git a/gcc/f/std.c b/gcc/f/std.c
index 5c11c40a9a37585a52bbbe4dca21a5355582659a..78538d1597821020edc409762d5d83bc09ed1711 100644 (file)
--- a/gcc/f/std.c
+++ b/gcc/f/std.c
@@ -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);