diff options
-rw-r--r-- | gcc/f/ChangeLog | 39 | ||||
-rw-r--r-- | gcc/f/com-rt.def | 2 | ||||
-rw-r--r-- | gcc/f/com.c | 7 | ||||
-rw-r--r-- | gcc/f/intdoc.c | 16 | ||||
-rw-r--r-- | gcc/f/intdoc.in | 97 | ||||
-rw-r--r-- | gcc/f/intrin.c | 78 | ||||
-rw-r--r-- | gcc/f/intrin.def | 8 | ||||
-rw-r--r-- | gcc/f/news.texi | 9 | ||||
-rw-r--r-- | libf2c/ChangeLog | 7 | ||||
-rw-r--r-- | libf2c/f2cext.c | 6 | ||||
-rw-r--r-- | libf2c/libF77/signal_.c | 9 |
11 files changed, 212 insertions, 66 deletions
diff --git a/gcc/f/ChangeLog b/gcc/f/ChangeLog index 0d7dadaf8fa..bd3d47d5de4 100644 --- a/gcc/f/ChangeLog +++ b/gcc/f/ChangeLog @@ -14,6 +14,45 @@ Sun Jan 11 02:14:47 1998 Craig Burley <burley@gnu.org> * 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 diff --git a/gcc/f/com-rt.def b/gcc/f/com-rt.def index bbf6c7b6a34..f124379c9cf 100644 --- a/gcc/f/com-rt.def +++ b/gcc/f/com-rt.def @@ -225,7 +225,7 @@ DEFGFRT (FFECOM_gfrtRENAME, "G77_rename_0", FFECOM_rttypeINTEGER_, "&a&a", FALSE 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) diff --git a/gcc/f/com.c b/gcc/f/com.c index 659652f529b..4d8e02611f4 100644 --- a/gcc/f/com.c +++ b/gcc/f/com.c @@ -345,6 +345,7 @@ tree ffecom_f2c_ptr_to_ftnint_type_node; 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. */ @@ -7448,6 +7449,10 @@ ffecom_make_gfrt_ (ffecomGfrt ix) 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; @@ -11632,6 +11637,7 @@ ffecom_gfrt_basictype (ffecomGfrt gfrt) switch (ffecom_gfrt_type_[gfrt]) { case FFECOM_rttypeVOID_: + case FFECOM_rttypeVOIDSTAR_: return FFEINFO_basictypeNONE; case FFECOM_rttypeFTNINT_: @@ -11678,6 +11684,7 @@ ffecom_gfrt_kindtype (ffecomGfrt gfrt) switch (ffecom_gfrt_type_[gfrt]) { case FFECOM_rttypeVOID_: + case FFECOM_rttypeVOIDSTAR_: return FFEINFO_kindtypeNONE; case FFECOM_rttypeFTNINT_: diff --git a/gcc/f/intdoc.c b/gcc/f/intdoc.c index 30e2d5b1744..6e88df4dbbb 100644 --- a/gcc/f/intdoc.c +++ b/gcc/f/intdoc.c @@ -494,7 +494,7 @@ external procedure.\n\ 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); } @@ -559,7 +559,7 @@ this intrinsic is valid only when used as the argument to\n\ } #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 @@ -730,10 +730,6 @@ types of all the arguments.\n\n"); argument_name_string (imp, 0)); break; - case 'p': - printf ("@code{INTEGER} wide enough to hold a pointer"); - break; - default: assert ("Ia" == NULL); break; @@ -848,7 +844,7 @@ types of all the arguments.\n\n"); break; default: - assert ("N1" == NULL); + assert ("E1" == NULL); break; } break; @@ -1209,10 +1205,6 @@ print_type_string (char *c) printf ("@code{INTEGER(KIND=%d)}", (kind - '0')); break; - case 'p': - printf ("@code{INTEGER(KIND=0)}"); - break; - default: assert ("Ia" == NULL); break; @@ -1336,7 +1328,7 @@ print_type_string (char *c) break; default: - assert ("arg type?" == NULL); + assert ("type?" == NULL); break; } } diff --git a/gcc/f/intdoc.in b/gcc/f/intdoc.in index eabb2e7e4e6..80046b730c2 100644 --- a/gcc/f/intdoc.in +++ b/gcc/f/intdoc.in @@ -2190,12 +2190,13 @@ DEFDOC (SIGNAL_subr, "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 +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 @@ -2205,24 +2206,106 @@ Otherwise the return value is ignored. 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.", "\ diff --git a/gcc/f/intrin.c b/gcc/f/intrin.c index 16f36fbdb3c..553a6d63d55 100644 --- a/gcc/f/intrin.c +++ b/gcc/f/intrin.c @@ -398,6 +398,10 @@ ffeintrin_check_ (ffeintrinImp imp, ffebldOp op, case 6: akt = 3; break; + + case 7: + akt = ffecom_pointer_kind (); + break; } } okay &= anynum || (ffeinfo_kindtype (i) == akt); @@ -593,6 +597,10 @@ ffeintrin_check_ (ffeintrinImp imp, ffebldOp op, case 6: kt = 3; break; + + case 7: + kt = ffecom_pointer_kind (); + break; } } break; @@ -603,10 +611,6 @@ ffeintrin_check_ (ffeintrinImp imp, ffebldOp op, kt = 1; break; - case 'p': - kt = ffecom_pointer_kind (); - break; - case '=': need_col = TRUE; /* Fall through. */ @@ -991,6 +995,10 @@ ffeintrin_check_ (ffeintrinImp imp, ffebldOp op, case 6: akt = 3; break; + + case 7: + akt = ffecom_pointer_kind (); + break; } } okay &= anynum || (ffeinfo_kindtype (i) == akt); @@ -1569,14 +1577,14 @@ ffeintrin_init_0 () 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); @@ -1584,10 +1592,9 @@ ffeintrin_init_0 () } 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); @@ -1613,8 +1620,8 @@ ffeintrin_init_0 () } 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); @@ -1625,7 +1632,7 @@ ffeintrin_init_0 () { while ((c[0] != '=') && (c[0] != ',') - && (c[0] != '\0')) + && (c[0] != '\0')) ++c; if (c[0] != '=') { @@ -1635,28 +1642,27 @@ ffeintrin_init_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); @@ -1693,13 +1699,13 @@ ffeintrin_init_0 () ++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') { diff --git a/gcc/f/intrin.def b/gcc/f/intrin.def index fb40cc663c9..5fbe83eb46c 100644 --- a/gcc/f/intrin.def +++ b/gcc/f/intrin.def @@ -3038,8 +3038,8 @@ DEFSPEC (NONE, 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: @@ -3309,7 +3309,7 @@ DEFIMP (LONG, "LONG", ,,, "I1:-:A=I6") 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:-:") @@ -3326,8 +3326,8 @@ DEFIMP (SECNDS, "SECNDS", SECNDS,,, "R1:-:T=R1") 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") diff --git a/gcc/f/news.texi b/gcc/f/news.texi index 780cfff7538..31324ce41ff 100644 --- a/gcc/f/news.texi +++ b/gcc/f/news.texi @@ -27,6 +27,15 @@ involve a combination of these elements. @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, or to aliases of it, in their control expressions. diff --git a/libf2c/ChangeLog b/libf2c/ChangeLog index c6c0dd3f11e..1adcc0d582a 100644 --- a/libf2c/ChangeLog +++ b/libf2c/ChangeLog @@ -1,3 +1,10 @@ +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 diff --git a/libf2c/f2cext.c b/libf2c/f2cext.c index d5ac815c9b4..fa1eff7e197 100644 --- a/libf2c/f2cext.c +++ b/libf2c/f2cext.c @@ -18,7 +18,7 @@ Boston, MA 02111-1307, USA. */ #include <f2c.h> -typedef int (*sig_proc)(int); +typedef void *sig_proc; /* For now, this will have to do. */ #ifdef Labort int abort_ (void) { @@ -98,8 +98,8 @@ ftnint iargc_ (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 diff --git a/libf2c/libF77/signal_.c b/libf2c/libF77/signal_.c index 1ac81391aef..efd969b672d 100644 --- a/libf2c/libF77/signal_.c +++ b/libf2c/libF77/signal_.c @@ -2,13 +2,16 @@ #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); } + |