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
This commit is contained in:
Toon Moene
Toon Moene
parent
e8487c0417
commit
5e3f4df7fe
@ -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.
|
||||
|
||||
@ -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:
|
||||
|
||||
@ -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;
|
||||
|
||||
@ -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).
|
||||
|
||||
@ -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;
|
||||
|
||||
@ -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:-:")
|
||||
|
||||
Loading…
Reference in New Issue
Block a user