PR fortran/4730 fortran/5473

2002-02-06  Toon Moene  <toon@moene.indiv.nluug.nl>

	PR fortran/4730 fortran/5473
	* com.c (ffecom_expr_): Deal with %VAL constructs.
	* intrin.c (ffeintrin_check_): Handle 'N' constraints for intrinsics,
	to indicate "no larger than default kind" integers and logicals.
	* intrin.def: Use 'N' constraints in table of intrinsics.
	* intdoc.c: Document this constraint.
	* intdoc.texi: Regenerated.

From-SVN: r49554

diff --git a/gcc/f/ChangeLog b/gcc/f/ChangeLog
index d386e1d1fa7d942afa77c4d478dc7910019ae972..a2214e54c44a58436a4bb87c744298fc086b5b00 100644 (file)
--- a/gcc/f/ChangeLog
+++ b/gcc/f/ChangeLog
@@ -1,3 +1,13 @@
+2002-02-06  Toon Moene  <toon@moene.indiv.nluug.nl>
+
+       PR fortran/4730 fortran/5473
+       * com.c (ffecom_expr_): Deal with %VAL constructs.
+       * intrin.c (ffeintrin_check_): Handle 'N' constraints for intrinsics,
+       to indicate "no larger than default kind" integers and logicals.
+       * intrin.def: Use 'N' constraints in table of intrinsics.
+       * intdoc.c: Document this constraint.
+       * intdoc.texi: Regenerated.
+       
 2002-02-04  Philipp Thomas  <pthomas@suse.de>
 
        * implic.c lex.c stb.c ste.c stu.c: Update copyright dates.

diff --git a/gcc/f/com.c b/gcc/f/com.c
index 2fdacbd7e3108b80ecc7d62b072823b1b9fb9b5e..bdb2a4ac5e7b9a12d8e44e564e3d0d55cf5d3053 100644 (file)
--- a/gcc/f/com.c
+++ b/gcc/f/com.c
@@ -3730,6 +3730,10 @@ ffecom_expr_ (ffebld expr, tree dest_tree, ffebld dest,
       item = ffecom_arg_ptr_to_expr (ffebld_left (expr), &list);
       return convert (tree_type, item);
 
+    case FFEBLD_opPERCENT_VAL:
+      item = ffecom_arg_expr (ffebld_left (expr), &list);
+      return convert (tree_type, item);
+
     case FFEBLD_opITEM:
     case FFEBLD_opSTAR:
     case FFEBLD_opBOUNDS:

diff --git a/gcc/f/intdoc.c b/gcc/f/intdoc.c
index 84720a321c1798339bd9cf746cc9e91373a2a167..fb88e88cecd6f032becbb4f630d713641488be4a 100644 (file)
--- a/gcc/f/intdoc.c
+++ b/gcc/f/intdoc.c
@@ -709,6 +709,10 @@ types of all the arguments.\n\n");
                      argument_name_string (imp, 0));
              break;
 
+           case 'N':
+             printf ("@code{INTEGER} not wider than the default kind");
+             break;
+
            default:
              assert ("Ia" == NULL);
              break;
@@ -732,6 +736,10 @@ types of all the arguments.\n\n");
                      argument_name_string (imp, 0));
              break;
 
+           case 'N':
+             printf ("@code{LOGICAL} not wider than the default kind");
+             break;
+
            default:
              assert ("La" == NULL);
              break;
@@ -779,6 +787,10 @@ types of all the arguments.\n\n");
                      argument_name_string (imp, 0));
              break;
 
+           case 'N':
+             printf ("@code{INTEGER} or @code{LOGICAL} not wider than the default kind");
+             break;
+
            default:
              assert ("Ba" == NULL);
              break;

diff --git a/gcc/f/intdoc.texi b/gcc/f/intdoc.texi
index 6165e442bb352adc3bddba78c6d0ce72831839b6..e829b35706107c192b998643c3061c12b7ad2581 100644 (file)
--- a/gcc/f/intdoc.texi
+++ b/gcc/f/intdoc.texi
@@ -1673,7 +1673,7 @@ BesJN(@var{N}, @var{X})
 BesJN: @code{REAL} function, the @samp{KIND=} value of the type being that of argument @var{X}.
 
 @noindent
-@var{N}: @code{INTEGER}; scalar; INTENT(IN).
+@var{N}: @code{INTEGER} not wider than the default kind; scalar; INTENT(IN).
 
 @noindent
 @var{X}: @code{REAL}; scalar; INTENT(IN).
@@ -1748,7 +1748,7 @@ BesYN(@var{N}, @var{X})
 BesYN: @code{REAL} function, the @samp{KIND=} value of the type being that of argument @var{X}.
 
 @noindent
-@var{N}: @code{INTEGER}; scalar; INTENT(IN).
+@var{N}: @code{INTEGER} not wider than the default kind; scalar; INTENT(IN).
 
 @noindent
 @var{X}: @code{REAL}; scalar; INTENT(IN).
@@ -3113,7 +3113,7 @@ DbesJN(@var{N}, @var{X})
 DbesJN: @code{REAL(KIND=2)} function.
 
 @noindent
-@var{N}: @code{INTEGER}; scalar; INTENT(IN).
+@var{N}: @code{INTEGER} not wider than the default kind; scalar; INTENT(IN).
 
 @noindent
 @var{X}: @code{REAL(KIND=2)}; scalar; INTENT(IN).
@@ -3194,7 +3194,7 @@ DbesYN(@var{N}, @var{X})
 DbesYN: @code{REAL(KIND=2)} function.
 
 @noindent
-@var{N}: @code{INTEGER}; scalar; INTENT(IN).
+@var{N}: @code{INTEGER} not wider than the default kind; scalar; INTENT(IN).
 
 @noindent
 @var{X}: @code{REAL(KIND=2)}; scalar; INTENT(IN).
@@ -4385,7 +4385,7 @@ CALL Exit(@var{Status})
 @end example
 
 @noindent
-@var{Status}: @code{INTEGER}; OPTIONAL; scalar; INTENT(IN).
+@var{Status}: @code{INTEGER} not wider than the default kind; OPTIONAL; scalar; INTENT(IN).
 
 @noindent
 Intrinsic groups: @code{unix}.
@@ -5249,7 +5249,7 @@ CALL GetArg(@var{Pos}, @var{Value})
 @end example
 
 @noindent
-@var{Pos}: @code{INTEGER}; scalar; INTENT(IN).
+@var{Pos}: @code{INTEGER} not wider than the default kind; scalar; INTENT(IN).
 
 @noindent
 @var{Value}: @code{CHARACTER}; scalar; INTENT(OUT).

diff --git a/gcc/f/intrin.c b/gcc/f/intrin.c
index 83a478c706575d6183e583f313c3027d30044335..1c6c00c732108adb1b6093ee987831c14ba1b499 100644 (file)
--- a/gcc/f/intrin.c
+++ b/gcc/f/intrin.c
@@ -414,6 +414,24 @@ ffeintrin_check_ (ffeintrinImp imp, ffebldOp op,
                : firstarg_kt;
              break;
 
+           case 'N':
+             /* Accept integers and logicals not wider than the default integer/logical.  */
+             if (ffeinfo_basictype (i) == FFEINFO_basictypeINTEGER)
+               {
+                 okay &= anynum || (ffeinfo_kindtype (i) == FFEINFO_kindtypeINTEGER1
+                                       || ffeinfo_kindtype (i) == FFEINFO_kindtypeINTEGER2
+                                       || ffeinfo_kindtype (i) == FFEINFO_kindtypeINTEGER3);
+                 akt = FFEINFO_kindtypeINTEGER1;       /* The default.  */
+               }
+             else if (ffeinfo_basictype (i) == FFEINFO_basictypeLOGICAL)
+               {
+                 okay &= anynum || (ffeinfo_kindtype (i) == FFEINFO_kindtypeLOGICAL1
+                                       || ffeinfo_kindtype (i) == FFEINFO_kindtypeLOGICAL2
+                                       || ffeinfo_kindtype (i) == FFEINFO_kindtypeLOGICAL3);
+                 akt = FFEINFO_kindtypeLOGICAL1;       /* The default.  */
+               }
+             break;
+
            case '*':
            default:
              break;

diff --git a/gcc/f/intrin.def b/gcc/f/intrin.def
index 9451a2715b6e342df3d938397bb76387fbe9fdbe..5d712ba21c0286abc85fccbf6d6d07b1ff2f05af 100644 (file)
--- a/gcc/f/intrin.def
+++ b/gcc/f/intrin.def
@@ -3102,6 +3102,7 @@ DEFSPEC (NONE,
      4    (Twice the size of 2)
      6    (Twice the size as 3)
      A    Same as first argument
+     N    Not wider than the default kind
 
    <arg-len> is:
 
@@ -3218,10 +3219,10 @@ DEFIMP  (ALARM,         "ALARM",        ALARM,,,        "--:-:Seconds=I*,Handler=s*,Status=?I1w")
 DEFIMP (AND,           "AND",          ,,,             "B=:*:I=B*,J=B*")
 DEFIMP (BESJ0,         "BESJ0",        L_BESJ0,,,      "R=:0:X=R*")
 DEFIMP (BESJ1,         "BESJ1",        L_BESJ1,,,      "R=:0:X=R*")
-DEFIMP (BESJN,         "BESJN",        L_BESJN,,,      "R=:1:N=I*,X=R*")
+DEFIMP (BESJN,         "BESJN",        L_BESJN,,,      "R=:1:N=IN,X=R*")
 DEFIMP (BESY0,         "BESY0",        L_BESY0,,,      "R=:0:X=R*")
 DEFIMP (BESY1,         "BESY1",        L_BESY1,,,      "R=:0:X=R*")
-DEFIMP (BESYN,         "BESYN",        L_BESYN,,,      "R=:1:N=I*,X=R*")
+DEFIMP (BESYN,         "BESYN",        L_BESYN,,,      "R=:1:N=IN,X=R*")
 DEFIMP (BIT_SIZE,      "BIT_SIZE",     ,,,             "I=:0:I=I*i")
 DEFIMP (BTEST,         "BTEST",        ,,,             "L1:*:I=I*,Pos=I*")
 DEFIMP (CDABS,         "CDABS",        ,CDABS,,        "R2:-:A=C2")
@@ -3242,10 +3243,10 @@ DEFIMPY (DATE,          "DATE",         DATE,,,         "--:-:Date=A1w",        TRUE)
 DEFIMP (DATE_AND_TIME, "DATE_AND_TIME", DATE_AND_TIME,,, "--:-:Date=A1w,Time=?A1w,Zone=?A1w,Values=?I1(8)w")
 DEFIMP (DBESJ0,        "DBESJ0",       L_BESJ0,,,      "R2:-:X=R2")
 DEFIMP (DBESJ1,        "DBESJ1",       L_BESJ1,,,      "R2:-:X=R2")
-DEFIMP (DBESJN,        "DBESJN",       L_BESJN,,,      "R2:-:N=I*,X=R2")
+DEFIMP (DBESJN,        "DBESJN",       L_BESJN,,,      "R2:-:N=IN,X=R2")
 DEFIMP (DBESY0,        "DBESY0",       L_BESY0,,,      "R2:-:X=R2")
 DEFIMP (DBESY1,        "DBESY1",       L_BESY1,,,      "R2:-:X=R2")
-DEFIMP (DBESYN,        "DBESYN",       L_BESYN,,,      "R2:-:N=I*,X=R2")
+DEFIMP (DBESYN,        "DBESYN",       L_BESYN,,,      "R2:-:N=IN,X=R2")
 DEFIMP (DCONJG,        "DCONJG",       ,DCONJG,,       "C2:-:Z=C2")
 DEFIMP (DERF,          "DERF",         L_ERF,DERF,,    "R2:-:X=R2")
 DEFIMP (DERFC,         "DERFC",        L_ERFC,DERFC,,  "R2:-:X=R2")
@@ -3258,7 +3259,7 @@ DEFIMP    (ERF,           "ERF",          L_ERF,ERF,,     "R=:0:X=R*")
 DEFIMP (ERFC,          "ERFC",         L_ERFC,ERFC,,   "R=:0:X=R*")
 DEFIMP (ETIME_func,    "ETIME_func",   ETIME,,,        "R1:-:TArray=R1(2)w")
 DEFIMP (ETIME_subr,    "ETIME_subr",   ETIME,,,        "--:-:TArray=R1(2)w,Result=R1w")
-DEFIMP (EXIT,          "EXIT",         EXIT,,,         "--:-:Status=?I*")
+DEFIMP (EXIT,          "EXIT",         EXIT,,,         "--:-:Status=?IN")
 DEFIMP (FDATE_func,    "FDATE_func",   FDATE,,,        "A1*:-:")
 DEFIMP (FDATE_subr,    "FDATE_subr",   FDATE,,,        "--:-:Date=A1w")
 DEFIMP (FGET_func,     "FGET_func",    FGET,,,         "I1:-:C=A1w")
@@ -3277,7 +3278,7 @@ DEFIMP    (FSTAT_subr,    "FSTAT_subr",   FSTAT,,,        "--:-:Unit=I*,SArray=I1(13)w,Status=?
 DEFIMP (FTELL_func,    "FTELL_func",   FTELL,,,        "I1:-:Unit=I*")
 DEFIMP (FTELL_subr,    "FTELL_subr",   FTELL,,,        "--:-:Unit=I*,Offset=I1w")
 DEFIMP (GERROR,        "GERROR",       GERROR,,,       "--:-:Message=A1w")
-DEFIMP (GETARG,        "GETARG",       GETARG,,,       "--:-:Pos=I*,Value=A1w")
+DEFIMP (GETARG,        "GETARG",       GETARG,,,       "--:-:Pos=IN,Value=A1w")
 DEFIMP (GETCWD_func,   "GETCWD_func",  GETCWD,,,       "I1:-:Name=A1w")
 DEFIMP (GETCWD_subr,   "GETCWD_subr",  GETCWD,,,       "--:-:Name=A1w,Status=?I1w")
 DEFIMP (GETGID,        "GETGID",       GETGID,,,       "I1:-:")