From 1e572fcea99db21083098373a032ae52f5e54b28 Mon Sep 17 00:00:00 2001
From: toon <toon@138bc75d-0d04-0410-961f-82ee72b054a4>
Date: Wed, 6 Feb 2002 21:49:42 +0000
Subject: [PATCH] 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.
git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@49554 138bc75d-0d04-0410-961f-82ee72b054a4
---
gcc/f/ChangeLog | 10 ++++++++++
gcc/f/com.c | 4 ++++
gcc/f/intdoc.c | 12 ++++++++++++
gcc/f/intdoc.texi | 12 ++++++------
gcc/f/intrin.c | 18 ++++++++++++++++++
gcc/f/intrin.def | 13 +++++++------
6 files changed, 57 insertions(+), 12 deletions(-)
diff --git a/gcc/f/ChangeLog b/gcc/f/ChangeLog
index d386e1d1fa7d..a2214e54c44a 100644
--- 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 2fdacbd7e310..bdb2a4ac5e7b 100644
--- 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 84720a321c17..fb88e88cecd6 100644
--- 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 6165e442bb35..e829b3570610 100644
--- 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 83a478c70657..1c6c00c73210 100644
--- 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 9451a2715b6e..5d712ba21c02 100644
--- 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:-:")
--
GitLab