* stb.c (ffestb_R10014_, ffestb_R10016_, ffestb_R10018_,
ffestb_R100110_): Restructure `for' loop for style.
+Tue Dec 23 14:58:04 1997 Craig Burley <burley@gnu.org>
+
+ * com.c (ffecom_gfrt_basictype):
+ (ffecom_gfrt_kindtype):
+ (ffecom_make_gfrt_):
+ (FFECOM_rttypeVOIDSTAR_): New return type `void *', for
+ the SIGNAL intrinsic.
+ * com-rt.def (FFECOM_rttypeSIGNAL): Now returns `void *'.
+ * intdoc.c: Replace `p' kind specifier with `7'.
+ * intrin.c (ffeintrin_check_, ffeintrin_init_0): Replace
+ `p' kind specifier with `7'.
+ * intrin.def (FFEINTRIN_impLOC, FFEINTRIN_impSIGNAL_func,
+ FFEINTRIN_impSIGNAL_subr): Replace `p' specifier with `7'.
+ Also, SIGNAL now returns a `void *' status, not `int'.
+
+Mon Dec 22 12:41:07 1997 Craig Burley <burley@gnu.org>
+
+ * intrin.c (ffeintrin_init_0): Remove duplicate
+ check for `!'.
+
+Sun Dec 14 02:49:58 1997 Craig Burley <burley@gnu.org>
+
+ * intrin.c (ffeintrin_init_0): Fix up indentation a bit.
+ Fix bug that prevented checking of arguments other
+ than the first.
+
+ * intdoc.c: Fix up indentation a bit.
+
+Mon Dec 1 19:12:36 1997 Craig Burley <burley@gnu.org>
+
+ * intrin.c (ffeintrin_check_): Fix up indentation a bit more.
+
+Sun Nov 30 22:22:22 1997 Craig Burley <burley@gnu.org>
+
+ * intdoc.c: Minor fix-ups.
+
+ * intrin.c (ffeintrin_check_): Fix up indentation a bit.
+
+
Fri Oct 10 13:00:48 1997 Craig Burley <burley@gnu.ai.mit.edu>
* ste.c (ffeste_begin_iterdo_): Fix loop setup so iteration
DEFGFRT (FFECOM_gfrtSECNDS, "G77_secnds_0", FFECOM_rttypeREAL_F2C_, "&f", FALSE, FALSE)
DEFGFRT (FFECOM_gfrtSECOND, "G77_second_0", FFECOM_rttypeREAL_F2C_, 0, FALSE, FALSE)
DEFGFRT (FFECOM_gfrtSIGN, "r_sign", FFECOM_rttypeREAL_F2C_, "&f&f", FALSE, FALSE)
-DEFGFRT (FFECOM_gfrtL_SIGNAL, "G77_signal_0", FFECOM_rttypeFTNINT_, "&i0", FALSE, FALSE)
+DEFGFRT (FFECOM_gfrtL_SIGNAL, "G77_signal_0", FFECOM_rttypeVOIDSTAR_, "&i0", FALSE, FALSE)
DEFGFRT (FFECOM_gfrtSIN, "r_sin", FFECOM_rttypeREAL_F2C_, "&f", FALSE, FALSE)
DEFGFRT (FFECOM_gfrtSINH, "r_sinh", FFECOM_rttypeREAL_F2C_, "&f", FALSE, FALSE)
DEFGFRT (FFECOM_gfrtSLEEP, "G77_sleep_0", FFECOM_rttypeVOID_, "&i", FALSE, FALSE)
typedef enum
{
FFECOM_rttypeVOID_,
+ FFECOM_rttypeVOIDSTAR_, /* C's `void *' type. */
FFECOM_rttypeFTNINT_, /* f2c's `ftnint' type. */
FFECOM_rttypeINTEGER_, /* f2c's `integer' type. */
FFECOM_rttypeLONGINT_, /* f2c's `longint' type. */
ttype = void_type_node;
break;
+ case FFECOM_rttypeVOIDSTAR_:
+ ttype = TREE_TYPE (null_pointer_node); /* `void *'. */
+ break;
+
case FFECOM_rttypeFTNINT_:
ttype = ffecom_f2c_ftnint_type_node;
break;
switch (ffecom_gfrt_type_[gfrt])
{
case FFECOM_rttypeVOID_:
+ case FFECOM_rttypeVOIDSTAR_:
return FFEINFO_basictypeNONE;
case FFECOM_rttypeFTNINT_:
switch (ffecom_gfrt_type_[gfrt])
{
case FFECOM_rttypeVOID_:
+ case FFECOM_rttypeVOIDSTAR_:
return FFEINFO_kindtypeNONE;
case FFECOM_rttypeFTNINT_:
if ((argi[0] == '*')
|| (argi[0] == 'n')
|| (argi[0] == '+')
- || (argi[0] == 'p'))
+ || (argi[0] == 'p'))
printf ("-1, @var{%s}-2, @dots{}, @var{%s}-n",
argc, argc);
}
}
#if 0
else if ((c[0] == 'I')
- && (c[1] == 'p'))
+ && (c[1] == '7'))
printf (", the exact type being wide enough to hold a pointer\n\
on the target system (typically @code{INTEGER(KIND=1)} or @code{INTEGER(KIND=4)}).\n\n");
#endif
argument_name_string (imp, 0));
break;
- case 'p':
- printf ("@code{INTEGER} wide enough to hold a pointer");
- break;
-
default:
assert ("Ia" == NULL);
break;
break;
default:
- assert ("N1" == NULL);
+ assert ("E1" == NULL);
break;
}
break;
printf ("@code{INTEGER(KIND=%d)}", (kind - '0'));
break;
- case 'p':
- printf ("@code{INTEGER(KIND=0)}");
- break;
-
default:
assert ("Ia" == NULL);
break;
break;
default:
- assert ("arg type?" == NULL);
+ assert ("type?" == NULL);
break;
}
}
If @var{@2@} is a an @code{EXTERNAL} routine, arranges for it to be
invoked with a single integer argument (of system-dependent length)
when signal @var{@1@} occurs.
-If @var{@1@} is an integer, it can be
-used to turn off handling of signal @var{@2@} or revert to its default
+If @var{@2@} is an integer, it can be
+used to turn off handling of signal @var{@1@} or revert to its default
action.
See @code{signal(2)}.
-Note that @var{@2@} will be called using C conventions, so its value in
+Note that @var{@2@} will be called using C conventions,
+so the value of its argument in Fortran terms
Fortran terms is obtained by applying @code{%LOC()} (or @var{LOC()}) to it.
The value returned by @code{signal(2)} is written to @var{@3@}, if
Some non-GNU implementations of Fortran provide this intrinsic as
only a function, not as a subroutine, or do not support the
(optional) @var{@3@} argument.
+
+@emph{Warning:} Use of the @code{libf2c} run-time library function
+@samp{signal_} directly
+(such as via @samp{EXTERNAL SIGNAL})
+requires use of the @code{%VAL()} construct
+to pass an @code{INTEGER} value
+(such as @samp{SIG_IGN} or @samp{SIG_DFL})
+for the @var{@2@} argument.
+
+However, while @samp{CALL SIGNAL(@var{signum}, %VAL(SIG_IGN))}
+works when @samp{SIGNAL} is treated as an external procedure
+(and resolves, at link time, to @code{libf2c}'s @samp{signal_} routine),
+this construct is not valid when @samp{SIGNAL} is recognized
+as the intrinsic of that name.
+
+Therefore, for maximum portability and reliability,
+code such references to the @samp{SIGNAL} facility as follows:
+
+@smallexample
+INTRINSIC SIGNAL
+@dots{}
+CALL SIGNAL(@var{signum}, SIG_IGN)
+@end smallexample
+
+@code{g77} will compile such a call correctly,
+while other compilers will generally either do so as well
+or reject the @samp{INTRINSIC SIGNAL} statement via a diagnostic,
+allowing you to take appropriate action.
")
DEFDOC (SIGNAL_func, "Muck with signal handling.", "\
If @var{@2@} is a an @code{EXTERNAL} routine, arranges for it to be
invoked with a single integer argument (of system-dependent length)
when signal @var{@1@} occurs.
-If @var{@1@} is an integer, it can be
-used to turn off handling of signal @var{@2@} or revert to its default
+If @var{@2@} is an integer, it can be
+used to turn off handling of signal @var{@1@} or revert to its default
action.
See @code{signal(2)}.
-Note that @var{@2@} will be called using C conventions, so its value in
-Fortran terms is obtained by applying @code{%LOC()} (or @var{LOC()}) to it.
+Note that @var{@2@} will be called using C conventions,
+so the value of its argument in Fortran terms
+is obtained by applying @code{%LOC()} (or @var{LOC()}) to it.
The value returned by @code{signal(2)} is returned.
Due to the side effects performed by this intrinsic, the function
form is not recommended.
+
+@emph{Warning:} If the returned value is stored in
+an @code{INTEGER(KIND=1)} (default @code{INTEGER}) argument,
+truncation of the original return value occurs on some systems
+(such as Alphas, which have 64-bit pointers but 32-bit default integers),
+with no warning issued by @code{g77} under normal circumstances.
+
+Therefore, the following code fragment might silently fail on
+some systems:
+
+@smallexample
+INTEGER RTN
+EXTERNAL MYHNDL
+RTN = SIGNAL(@var{signum}, MYHNDL)
+@dots{}
+! Restore original handler:
+RTN = SIGNAL(@var{signum}, RTN)
+@end smallexample
+
+The reason for the failure is that @samp{RTN} might not hold
+all the information on the original handler for the signal,
+thus restoring an invalid handler.
+This bug could manifest itself as a spurious run-time failure
+at an arbitrary point later during the program's execution,
+for example.
+
+@emph{Warning:} Use of the @code{libf2c} run-time library function
+@samp{signal_} directly
+(such as via @samp{EXTERNAL SIGNAL})
+requires use of the @code{%VAL()} construct
+to pass an @code{INTEGER} value
+(such as @samp{SIG_IGN} or @samp{SIG_DFL})
+for the @var{@2@} argument.
+
+However, while @samp{RTN = SIGNAL(@var{signum}, %VAL(SIG_IGN))}
+works when @samp{SIGNAL} is treated as an external procedure
+(and resolves, at link time, to @code{libf2c}'s @samp{signal_} routine),
+this construct is not valid when @samp{SIGNAL} is recognized
+as the intrinsic of that name.
+
+Therefore, for maximum portability and reliability,
+code such references to the @samp{SIGNAL} facility as follows:
+
+@smallexample
+INTRINSIC SIGNAL
+@dots{}
+RTN = SIGNAL(@var{signum}, SIG_IGN)
+@end smallexample
+
+@code{g77} will compile such a call correctly,
+while other compilers will generally either do so as well
+or reject the @samp{INTRINSIC SIGNAL} statement via a diagnostic,
+allowing you to take appropriate action.
")
DEFDOC (KILL_func, "Signal a process.", "\
case 6:
akt = 3;
break;
+
+ case 7:
+ akt = ffecom_pointer_kind ();
+ break;
}
}
okay &= anynum || (ffeinfo_kindtype (i) == akt);
case 6:
kt = 3;
break;
+
+ case 7:
+ kt = ffecom_pointer_kind ();
+ break;
}
}
break;
kt = 1;
break;
- case 'p':
- kt = ffecom_pointer_kind ();
- break;
-
case '=':
need_col = TRUE;
/* Fall through. */
case 6:
akt = 3;
break;
+
+ case 7:
+ akt = ffecom_pointer_kind ();
+ break;
}
}
okay &= anynum || (ffeinfo_kindtype (i) == akt);
if ((c[0] != '-')
&& (c[0] != 'A')
- && (c[0] != 'C')
- && (c[0] != 'I')
- && (c[0] != 'L')
- && (c[0] != 'R')
- && (c[0] != 'B')
- && (c[0] != 'F')
- && (c[0] != 'N')
- && (c[0] != 'S'))
+ && (c[0] != 'C')
+ && (c[0] != 'I')
+ && (c[0] != 'L')
+ && (c[0] != 'R')
+ && (c[0] != 'B')
+ && (c[0] != 'F')
+ && (c[0] != 'N')
+ && (c[0] != 'S'))
{
fprintf (stderr, "%s: bad return-base-type\n",
ffeintrin_imps_[i].name);
}
if ((c[1] != '-')
&& (c[1] != '=')
- && ((c[1] < '1')
- || (c[1] > '9'))
- && (c[1] != 'C')
- && (c[1] != 'p'))
+ && ((c[1] < '1')
+ || (c[1] > '9'))
+ && (c[1] != 'C'))
{
fprintf (stderr, "%s: bad return-kind-type\n",
ffeintrin_imps_[i].name);
}
if ((c[colon + 1] != '-')
&& (c[colon + 1] != '*')
- && ((c[colon + 1] < '0')
- || (c[colon + 1] > '9')))
+ && ((c[colon + 1] < '0')
+ || (c[colon + 1] > '9')))
{
fprintf (stderr, "%s: bad COL-spec\n",
ffeintrin_imps_[i].name);
{
while ((c[0] != '=')
&& (c[0] != ',')
- && (c[0] != '\0'))
+ && (c[0] != '\0'))
++c;
if (c[0] != '=')
{
}
if ((c[1] == '?')
|| (c[1] == '!')
- || (c[1] == '!')
|| (c[1] == '+')
- || (c[1] == '*')
+ || (c[1] == '*')
|| (c[1] == 'n')
- || (c[1] == 'p'))
+ || (c[1] == 'p'))
++c;
if (((c[1] != '-')
&& (c[1] != 'A')
- && (c[1] != 'C')
- && (c[1] != 'I')
- && (c[1] != 'L')
- && (c[1] != 'R')
- && (c[1] != 'B')
- && (c[1] != 'F')
- && (c[1] != 'N')
- && (c[1] != 'S')
- && (c[1] != 'g')
- && (c[1] != 's'))
+ && (c[1] != 'C')
+ && (c[1] != 'I')
+ && (c[1] != 'L')
+ && (c[1] != 'R')
+ && (c[1] != 'B')
+ && (c[1] != 'F')
+ && (c[1] != 'N')
+ && (c[1] != 'S')
+ && (c[1] != 'g')
+ && (c[1] != 's'))
|| ((c[2] != '*')
&& ((c[2] < '1')
|| (c[2] > '9'))
- && (c[2] != 'A')))
+ && (c[2] != 'A')))
{
fprintf (stderr, "%s: bad arg-type\n",
ffeintrin_imps_[i].name);
++c;
if ((c[3] == '&')
|| (c[3] == 'i')
- || (c[3] == 'w')
- || (c[3] == 'x'))
+ || (c[3] == 'w')
+ || (c[3] == 'x'))
++c;
if (c[3] == ',')
{
c += 4;
- break;
+ continue;
}
if (c[3] != '\0')
{
3 (Same size as CHARACTER*1)
4 (Twice the size of 2)
6 (Twice the size as 3)
+ 7 (Same size as `char *')
C Like 1 (F77), except (F90), if COL is COMPLEX, uses kind type of COL
- p ffecom_pointer_kind_
<return-modifier> is:
DEFIMP (LSTAT_func, "LSTAT_func", LSTAT,,, "I1:-:File=A1,SArray=I1(13)w")
DEFIMP (LSTAT_subr, "LSTAT_subr", LSTAT,,, "--:-:File=A1,SArray=I1(13)w,Status=?I1w")
DEFIMP (LTIME, "LTIME", LTIME,,, "--:-:STime=I1,TArray=I1(9)w")
-DEFIMP (LOC, "LOC", ,,, "Ip:-:Entity=-*&&")
+DEFIMP (LOC, "LOC", ,,, "I7:-:Entity=-*&&")
DEFIMP (LSHIFT, "LSHIFT", ,,, "I=:0:I=I*,Shift=I*")
DEFIMP (MCLOCK, "MCLOCK", MCLOCK,,, "I1:-:")
DEFIMP (MCLOCK8, "MCLOCK8", MCLOCK,,, "I2:-:")
DEFIMP (SECOND_func, "SECOND_func", SECOND,SECOND,, "R1:-:")
DEFIMP (SECOND_subr, "SECOND_subr", SECOND,,, "--:-:Seconds=R1w")
DEFIMP (SHORT, "SHORT", ,,, "I6:-:A=I*")
-DEFIMP (SIGNAL_func, "SIGNAL_func", L_SIGNAL,,, "I1:-:Number=I*,Handler=s*")
-DEFIMP (SIGNAL_subr, "SIGNAL_subr", L_SIGNAL,,, "--:-:Number=I*,Handler=s*,Status=?I1w")
+DEFIMP (SIGNAL_func, "SIGNAL_func", L_SIGNAL,,, "I7:-:Number=I*,Handler=s*")
+DEFIMP (SIGNAL_subr, "SIGNAL_subr", L_SIGNAL,,, "--:-:Number=I*,Handler=s*,Status=?I7w")
DEFIMP (SLEEP, "SLEEP", SLEEP,,, "--:-:Seconds=I1")
DEFIMP (SRAND, "SRAND", SRAND,,, "--:-:Seed=I*")
DEFIMP (STAT_func, "STAT_func", STAT,,, "I1:-:File=A1,SArray=I1(13)w")
@heading In 0.5.22:
@itemize @bullet
+@item
+Fix @code{SIGNAL} intrinsic so it offers portable
+support for 64-bit systems (such as Digital Alphas
+running GNU/Linux).
+
+@item
+Support @samp{FORMAT(I<@var{expr}>)} when @var{expr} is a
+compile-time constant @code{INTEGER} expression.
+
@item
Fix code generation for iterative @code{DO} loops that
have one or more references to the iteration variable,
+Tue Dec 23 22:56:01 1997 Craig Burley <burley@gnu.org>
+
+ * libF77/signal_.c (G77_signal_0): Return type is
+ now `void *', to cope with returning previous signal
+ handler on 64-bit systems like Alphas.
+ * f2cext.c (signal_): Changed accordingly.
+
Tue Sep 30 00:41:39 1997 Craig Burley <burley@gnu.ai.mit.edu>
Do a better job of printing the offending FORMAT string
#include <f2c.h>
-typedef int (*sig_proc)(int);
+typedef void *sig_proc; /* For now, this will have to do. */
#ifdef Labort
int abort_ (void) {
#endif
#ifdef Lsignal
-ftnint signal_ (integer *sigp, sig_proc proc) {
- extern ftnint G77_signal_0 (integer *sigp, sig_proc proc);
+void *signal_ (integer *sigp, sig_proc proc) {
+ extern void *G77_signal_0 (integer *sigp, sig_proc proc);
return G77_signal_0 (sigp, proc);
}
#endif
#include "signal1.h"
#ifdef KR_headers
-ftnint G77_signal_0 (sigp, proc) integer *sigp; sig_pf proc;
+void *
+G77_signal_0 (sigp, proc) integer *sigp; sig_pf proc;
#else
-ftnint G77_signal_0 (integer *sigp, sig_pf proc)
+void *
+G77_signal_0 (integer *sigp, sig_pf proc)
#endif
{
int sig;
sig = (int)*sigp;
- return (ftnint)signal(sig, proc);
+ return (void *) signal(sig, proc);
}
+
projects / gcc.git / commitdiff