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

6 files changed, 57 insertions, 12 deletions

diff --git a/gcc/f/ChangeLog b/gcc/f/ChangeLog
index d386e1d1fa7..a2214e54c44 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 2fdacbd7e31..bdb2a4ac5e7 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 84720a321c1..fb88e88cecd 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 6165e442bb3..e829b357061 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 83a478c7065..1c6c00c7321 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 9451a2715b6..5d712ba21c0 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:-:")