mirror of
git://gcc.gnu.org/git/gcc.git
synced 2024-12-20 01:29:20 +08:00
304a3a85de
* f2cext.c (alarm_): Mark parameter(s) with attribute `unused'. * libF77/h_len.c (h_len): Likewise. * libF77/i_len.c (i_len): Likewise. * libI77/rsli.c (i_ungetc): Likewise. * libU77/date_.c (G77_date_y2kbuggy_0): Likewise. * libU77/fputc_.c (G77_fputc_0): Likewise. * libU77/vxtidate_.c (G77_vxtidate_y2kbuggy_0): Likewise. * libU77/vxttime_.c (G77_vxttime_0): Likewise. From-SVN: r54289
583 lines
14 KiB
C
583 lines
14 KiB
C
/* Copyright (C) 1997 Free Software Foundation, Inc.
|
|
This file is part of GNU Fortran run-time library.
|
|
|
|
This library is free software; you can redistribute it and/or modify it
|
|
under the terms of the GNU Library General Public License as published
|
|
by the Free Software Foundation; either version 2 of the License, or
|
|
(at your option) any later version.
|
|
|
|
GNU Fortran is distributed in the hope that it will be useful,
|
|
but WITHOUT ANY WARRANTY; without even the implied warranty of
|
|
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
|
|
Library General Public License for more details.
|
|
|
|
You should have received a copy of the GNU Library General Public
|
|
License along with GNU Fortran; see the file COPYING.LIB. If
|
|
not, write to the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
|
|
Boston, MA 02111-1307, USA. */
|
|
|
|
#include <math.h> /* for j0 et al */
|
|
#include <f2c.h>
|
|
typedef void *sig_proc; /* For now, this will have to do. */
|
|
|
|
#ifdef Labort
|
|
int abort_ (void) {
|
|
extern int G77_abort_0 (void);
|
|
return G77_abort_0 ();
|
|
}
|
|
#endif
|
|
|
|
#ifdef Lderf
|
|
double derf_ (doublereal *x) {
|
|
extern double G77_derf_0 (doublereal *x);
|
|
return G77_derf_0 (x);
|
|
}
|
|
#endif
|
|
|
|
#ifdef Lderfc
|
|
double derfc_ (doublereal *x) {
|
|
extern double G77_derfc_0 (doublereal *x);
|
|
return G77_derfc_0 (x);
|
|
}
|
|
#endif
|
|
|
|
#ifdef Lef1asc
|
|
int ef1asc_ (ftnint *a, ftnlen *la, ftnint *b, ftnlen *lb) {
|
|
extern int G77_ef1asc_0 (ftnint *a, ftnlen *la, ftnint *b, ftnlen *lb);
|
|
return G77_ef1asc_0 (a, la, b, lb);
|
|
}
|
|
#endif
|
|
|
|
#ifdef Lef1cmc
|
|
integer ef1cmc_ (ftnint *a, ftnlen *la, ftnint *b, ftnlen *lb) {
|
|
extern integer G77_ef1cmc_0 (ftnint *a, ftnlen *la, ftnint *b, ftnlen *lb);
|
|
return G77_ef1cmc_0 (a, la, b, lb);
|
|
}
|
|
#endif
|
|
|
|
#ifdef Lerf
|
|
double erf_ (real *x) {
|
|
extern double G77_erf_0 (real *x);
|
|
return G77_erf_0 (x);
|
|
}
|
|
#endif
|
|
|
|
#ifdef Lerfc
|
|
double erfc_ (real *x) {
|
|
extern double G77_erfc_0 (real *x);
|
|
return G77_erfc_0 (x);
|
|
}
|
|
#endif
|
|
|
|
#ifdef Lexit
|
|
void exit_ (integer *rc) {
|
|
extern void G77_exit_0 (integer *rc);
|
|
G77_exit_0 (rc);
|
|
}
|
|
#endif
|
|
|
|
#ifdef Lgetarg
|
|
void getarg_ (ftnint *n, char *s, ftnlen ls) {
|
|
extern void G77_getarg_0 (ftnint *n, char *s, ftnlen ls);
|
|
G77_getarg_0 (n, s, ls);
|
|
}
|
|
#endif
|
|
|
|
#ifdef Lgetenv
|
|
void getenv_ (char *fname, char *value, ftnlen flen, ftnlen vlen) {
|
|
extern void G77_getenv_0 (char *fname, char *value, ftnlen flen, ftnlen vlen);
|
|
G77_getenv_0 (fname, value, flen, vlen);
|
|
}
|
|
#endif
|
|
|
|
#ifdef Liargc
|
|
ftnint iargc_ (void) {
|
|
extern ftnint G77_iargc_0 (void);
|
|
return G77_iargc_0 ();
|
|
}
|
|
#endif
|
|
|
|
#ifdef Lsignal
|
|
void *signal_ (integer *sigp, sig_proc proc) {
|
|
extern void *G77_signal_0 (integer *sigp, sig_proc proc);
|
|
return G77_signal_0 (sigp, proc);
|
|
}
|
|
#endif
|
|
|
|
#ifdef Lsystem
|
|
integer system_ (char *s, ftnlen n) {
|
|
extern integer G77_system_0 (char *s, ftnlen n);
|
|
return G77_system_0 (s, n);
|
|
}
|
|
#endif
|
|
|
|
#ifdef Lflush
|
|
int flush_ (void) {
|
|
extern int G77_flush_0 (void);
|
|
return G77_flush_0 ();
|
|
}
|
|
#endif
|
|
|
|
#ifdef Lftell
|
|
integer ftell_ (integer *Unit) {
|
|
extern integer G77_ftell_0 (integer *Unit);
|
|
return G77_ftell_0 (Unit);
|
|
}
|
|
#endif
|
|
|
|
#ifdef Lfseek
|
|
integer fseek_ (integer *Unit, integer *offset, integer *xwhence) {
|
|
extern integer G77_fseek_0 (integer *Unit, integer *offset, integer *xwhence);
|
|
return G77_fseek_0 (Unit, offset, xwhence);
|
|
}
|
|
#endif
|
|
|
|
#ifdef Laccess
|
|
integer access_ (const char *name, const char *mode, ftnlen Lname, ftnlen Lmode) {
|
|
extern integer G77_access_0 (const char *name, const char *mode, ftnlen Lname, ftnlen Lmode);
|
|
return G77_access_0 (name, mode, Lname, Lmode);
|
|
}
|
|
#endif
|
|
|
|
#ifdef Lalarm
|
|
integer alarm_ (integer *seconds, sig_proc proc,
|
|
integer *status __attribute__ ((__unused__))) {
|
|
extern integer G77_alarm_0 (integer *seconds, sig_proc proc);
|
|
return G77_alarm_0 (seconds, proc);
|
|
}
|
|
#endif
|
|
|
|
#ifdef Lbesj0
|
|
double besj0_ (const real *x) {
|
|
return j0 (*x);
|
|
}
|
|
#endif
|
|
|
|
#ifdef Lbesj1
|
|
double besj1_ (const real *x) {
|
|
return j1 (*x);
|
|
}
|
|
#endif
|
|
|
|
#ifdef Lbesjn
|
|
double besjn_ (const integer *n, real *x) {
|
|
return jn (*n, *x);
|
|
}
|
|
#endif
|
|
|
|
#ifdef Lbesy0
|
|
double besy0_ (const real *x) {
|
|
return y0 (*x);
|
|
}
|
|
#endif
|
|
|
|
#ifdef Lbesy1
|
|
double besy1_ (const real *x) {
|
|
return y1 (*x);
|
|
}
|
|
#endif
|
|
|
|
#ifdef Lbesyn
|
|
double besyn_ (const integer *n, real *x) {
|
|
return yn (*n, *x);
|
|
}
|
|
#endif
|
|
|
|
#ifdef Lchdir
|
|
integer chdir_ (const char *name, const ftnlen Lname) {
|
|
extern integer G77_chdir_0 (const char *name, const ftnlen Lname);
|
|
return G77_chdir_0 (name, Lname);
|
|
}
|
|
#endif
|
|
|
|
#ifdef Lchmod
|
|
integer chmod_ (const char *name, const char *mode, const ftnlen Lname, const ftnlen Lmode) {
|
|
extern integer G77_chmod_0 (const char *name, const char *mode, const ftnlen Lname, const ftnlen Lmode);
|
|
return G77_chmod_0 (name, mode, Lname, Lmode);
|
|
}
|
|
#endif
|
|
|
|
#ifdef Lctime
|
|
void ctime_ (char *chtime, const ftnlen Lchtime, longint *xstime) {
|
|
extern void G77_ctime_0 (char *chtime, const ftnlen Lchtime, longint *xstime);
|
|
G77_ctime_0 (chtime, Lchtime, xstime);
|
|
}
|
|
#endif
|
|
|
|
#ifdef Ldate_y2kbuggy
|
|
int date_ (char *buf, ftnlen buf_len) {
|
|
/* Fail to link, so user sees attempt to invoke non-Y2K-compliant
|
|
routine. */
|
|
extern int G77_date_y2kbuggy_0 (char *buf, ftnlen buf_len);
|
|
return G77_date_y2kbuggy_0 (buf, buf_len);
|
|
}
|
|
#endif
|
|
|
|
#ifdef Ldate_y2kbug
|
|
int date_y2kbug__ (char *buf, ftnlen buf_len) {
|
|
/* If user wants to invoke the non-Y2K-compliant routine via
|
|
an `EXTERNAL' interface, avoiding the warning via g77's
|
|
`INTRINSIC' interface, force coding of "y2kbug" string in
|
|
user's program. */
|
|
extern int G77_date_y2kbug_0 (char *buf, ftnlen buf_len);
|
|
return G77_date_y2kbug_0 (buf, buf_len);
|
|
}
|
|
#endif
|
|
|
|
#ifdef Ldbesj0
|
|
double dbesj0_ (const double *x) {
|
|
return j0 (*x);
|
|
}
|
|
#endif
|
|
|
|
#ifdef Ldbesj1
|
|
double dbesj1_ (const double *x) {
|
|
return j1 (*x);
|
|
}
|
|
#endif
|
|
|
|
#ifdef Ldbesjn
|
|
double dbesjn_ (const integer *n, double *x) {
|
|
return jn (*n, *x);
|
|
}
|
|
#endif
|
|
|
|
#ifdef Ldbesy0
|
|
double dbesy0_ (const double *x) {
|
|
return y0 (*x);
|
|
}
|
|
#endif
|
|
|
|
#ifdef Ldbesy1
|
|
double dbesy1_ (const double *x) {
|
|
return y1 (*x);
|
|
}
|
|
#endif
|
|
|
|
#ifdef Ldbesyn
|
|
double dbesyn_ (const integer *n, double *x) {
|
|
return yn (*n, *x);
|
|
}
|
|
#endif
|
|
|
|
#ifdef Ldtime
|
|
double dtime_ (real tarray[2]) {
|
|
extern double G77_dtime_0 (real tarray[2]);
|
|
return G77_dtime_0 (tarray);
|
|
}
|
|
#endif
|
|
|
|
#ifdef Letime
|
|
double etime_ (real tarray[2]) {
|
|
extern double G77_etime_0 (real tarray[2]);
|
|
return G77_etime_0 (tarray);
|
|
}
|
|
#endif
|
|
|
|
#ifdef Lfdate
|
|
void fdate_ (char *ret_val, ftnlen ret_val_len) {
|
|
extern void G77_fdate_0 (char *ret_val, ftnlen ret_val_len);
|
|
G77_fdate_0 (ret_val, ret_val_len);
|
|
}
|
|
#endif
|
|
|
|
#ifdef Lfgetc
|
|
integer fgetc_ (const integer *lunit, char *c, ftnlen Lc) {
|
|
extern integer G77_fgetc_0 (const integer *lunit, char *c, ftnlen Lc);
|
|
return G77_fgetc_0 (lunit, c, Lc);
|
|
}
|
|
#endif
|
|
|
|
#ifdef Lfget
|
|
integer fget_ (char *c, const ftnlen Lc) {
|
|
extern integer G77_fget_0 (char *c, const ftnlen Lc);
|
|
return G77_fget_0 (c, Lc);
|
|
}
|
|
#endif
|
|
|
|
#ifdef Lflush1
|
|
int flush1_ (const integer *lunit) {
|
|
extern int G77_flush1_0 (const integer *lunit);
|
|
return G77_flush1_0 (lunit);
|
|
}
|
|
#endif
|
|
|
|
#ifdef Lfnum
|
|
integer fnum_ (integer *lunit) {
|
|
extern integer G77_fnum_0 (integer *lunit);
|
|
return G77_fnum_0 (lunit);
|
|
}
|
|
#endif
|
|
|
|
#ifdef Lfputc
|
|
integer fputc_ (const integer *lunit, const char *c, const ftnlen Lc) {
|
|
extern integer G77_fputc_0 (const integer *lunit, const char *c, const ftnlen Lc);
|
|
return G77_fputc_0 (lunit, c, Lc);
|
|
}
|
|
#endif
|
|
|
|
#ifdef Lfput
|
|
integer fput_ (const char *c, const ftnlen Lc) {
|
|
extern integer G77_fput_0 (const char *c, const ftnlen Lc);
|
|
return G77_fput_0 (c, Lc);
|
|
}
|
|
#endif
|
|
|
|
#ifdef Lfstat
|
|
integer fstat_ (const integer *lunit, integer statb[13]) {
|
|
extern integer G77_fstat_0 (const integer *lunit, integer statb[13]);
|
|
return G77_fstat_0 (lunit, statb);
|
|
}
|
|
#endif
|
|
|
|
#ifdef Lgerror
|
|
int gerror_ (char *str, ftnlen Lstr) {
|
|
extern int G77_gerror_0 (char *str, ftnlen Lstr);
|
|
return G77_gerror_0 (str, Lstr);
|
|
}
|
|
#endif
|
|
|
|
#ifdef Lgetcwd
|
|
integer getcwd_ (char *str, const ftnlen Lstr) {
|
|
extern integer G77_getcwd_0 (char *str, const ftnlen Lstr);
|
|
return G77_getcwd_0 (str, Lstr);
|
|
}
|
|
#endif
|
|
|
|
#ifdef Lgetgid
|
|
integer getgid_ (void) {
|
|
extern integer G77_getgid_0 (void);
|
|
return G77_getgid_0 ();
|
|
}
|
|
#endif
|
|
|
|
#ifdef Lgetlog
|
|
int getlog_ (char *str, const ftnlen Lstr) {
|
|
extern int G77_getlog_0 (char *str, const ftnlen Lstr);
|
|
return G77_getlog_0 (str, Lstr);
|
|
}
|
|
#endif
|
|
|
|
#ifdef Lgetpid
|
|
integer getpid_ (void) {
|
|
extern integer G77_getpid_0 (void);
|
|
return G77_getpid_0 ();
|
|
}
|
|
#endif
|
|
|
|
#ifdef Lgetuid
|
|
integer getuid_ (void) {
|
|
extern integer G77_getuid_0 (void);
|
|
return G77_getuid_0 ();
|
|
}
|
|
#endif
|
|
|
|
#ifdef Lgmtime
|
|
int gmtime_ (const integer *stime, integer tarray[9]) {
|
|
extern int G77_gmtime_0 (const integer *stime, integer tarray[9]);
|
|
return G77_gmtime_0 (stime, tarray);
|
|
}
|
|
#endif
|
|
|
|
#ifdef Lhostnm
|
|
integer hostnm_ (char *name, ftnlen Lname) {
|
|
extern integer G77_hostnm_0 (char *name, ftnlen Lname);
|
|
return G77_hostnm_0 (name, Lname);
|
|
}
|
|
#endif
|
|
|
|
#ifdef Lidate
|
|
int idate_ (int iarray[3]) {
|
|
extern int G77_idate_0 (int iarray[3]);
|
|
return G77_idate_0 (iarray);
|
|
}
|
|
#endif
|
|
|
|
#ifdef Lierrno
|
|
integer ierrno_ (void) {
|
|
extern integer G77_ierrno_0 (void);
|
|
return G77_ierrno_0 ();
|
|
}
|
|
#endif
|
|
|
|
#ifdef Lirand
|
|
integer irand_ (integer *flag) {
|
|
extern integer G77_irand_0 (integer *flag);
|
|
return G77_irand_0 (flag);
|
|
}
|
|
#endif
|
|
|
|
#ifdef Lisatty
|
|
logical isatty_ (integer *lunit) {
|
|
extern logical G77_isatty_0 (integer *lunit);
|
|
return G77_isatty_0 (lunit);
|
|
}
|
|
#endif
|
|
|
|
#ifdef Litime
|
|
int itime_ (integer tarray[3]) {
|
|
extern int G77_itime_0 (integer tarray[3]);
|
|
return G77_itime_0 (tarray);
|
|
}
|
|
#endif
|
|
|
|
#ifdef Lkill
|
|
integer kill_ (const integer *pid, const integer *signum) {
|
|
extern integer G77_kill_0 (const integer *pid, const integer *signum);
|
|
return G77_kill_0 (pid, signum);
|
|
}
|
|
#endif
|
|
|
|
#ifdef Llink
|
|
integer link_ (const char *path1, const char *path2, const ftnlen Lpath1, const ftnlen Lpath2) {
|
|
extern integer G77_link_0 (const char *path1, const char *path2, const ftnlen Lpath1, const ftnlen Lpath2);
|
|
return G77_link_0 (path1, path2, Lpath1, Lpath2);
|
|
}
|
|
#endif
|
|
|
|
#ifdef Llnblnk
|
|
integer lnblnk_ (char *str, ftnlen str_len) {
|
|
extern integer G77_lnblnk_0 (char *str, ftnlen str_len);
|
|
return G77_lnblnk_0 (str, str_len);
|
|
}
|
|
#endif
|
|
|
|
#ifdef Llstat
|
|
integer lstat_ (const char *name, integer statb[13], const ftnlen Lname) {
|
|
extern integer G77_lstat_0 (const char *name, integer statb[13], const ftnlen Lname);
|
|
return G77_lstat_0 (name, statb, Lname);
|
|
}
|
|
#endif
|
|
|
|
#ifdef Lltime
|
|
int ltime_ (const integer *stime, integer tarray[9]) {
|
|
extern int G77_ltime_0 (const integer *stime, integer tarray[9]);
|
|
return G77_ltime_0 (stime, tarray);
|
|
}
|
|
#endif
|
|
|
|
#ifdef Lmclock
|
|
longint mclock_ (void) {
|
|
extern longint G77_mclock_0 (void);
|
|
return G77_mclock_0 ();
|
|
}
|
|
#endif
|
|
|
|
#ifdef Lperror
|
|
int perror_ (const char *str, const ftnlen Lstr) {
|
|
extern int G77_perror_0 (const char *str, const ftnlen Lstr);
|
|
return G77_perror_0 (str, Lstr);
|
|
}
|
|
#endif
|
|
|
|
#ifdef Lrand
|
|
double rand_ (integer *flag) {
|
|
extern double G77_rand_0 (integer *flag);
|
|
return G77_rand_0 (flag);
|
|
}
|
|
#endif
|
|
|
|
#ifdef Lrename
|
|
integer rename_ (const char *path1, const char *path2, const ftnlen Lpath1, const ftnlen Lpath2) {
|
|
extern integer G77_rename_0 (const char *path1, const char *path2, const ftnlen Lpath1, const ftnlen Lpath2);
|
|
return G77_rename_0 (path1, path2, Lpath1, Lpath2);
|
|
}
|
|
#endif
|
|
|
|
#ifdef Lsecnds
|
|
double secnds_ (real *r) {
|
|
extern double G77_secnds_0 (real *r);
|
|
return G77_secnds_0 (r);
|
|
}
|
|
#endif
|
|
|
|
#ifdef Lsecond
|
|
double second_ () {
|
|
extern double G77_second_0 ();
|
|
return G77_second_0 ();
|
|
}
|
|
#endif
|
|
|
|
#ifdef Lsleep
|
|
int sleep_ (const integer *seconds) {
|
|
extern int G77_sleep_0 (const integer *seconds);
|
|
return G77_sleep_0 (seconds);
|
|
}
|
|
#endif
|
|
|
|
#ifdef Lsrand
|
|
int srand_ (const integer *seed) {
|
|
extern int G77_srand_0 (const integer *seed);
|
|
return G77_srand_0 (seed);
|
|
}
|
|
#endif
|
|
|
|
#ifdef Lstat
|
|
integer stat_ (const char *name, integer statb[13], const ftnlen Lname) {
|
|
extern integer G77_stat_0 (const char *name, integer statb[13], const ftnlen Lname);
|
|
return G77_stat_0 (name, statb, Lname);
|
|
}
|
|
#endif
|
|
|
|
#ifdef Lsymlnk
|
|
integer symlnk_ (const char *path1, const char *path2, const ftnlen Lpath1, const ftnlen Lpath2) {
|
|
extern integer G77_symlnk_0 (const char *path1, const char *path2, const ftnlen Lpath1, const ftnlen Lpath2);
|
|
return G77_symlnk_0 (path1, path2, Lpath1, Lpath2);
|
|
}
|
|
#endif
|
|
|
|
#ifdef Ltime
|
|
longint time_ (void) {
|
|
extern longint G77_time_0 (void);
|
|
return G77_time_0 ();
|
|
}
|
|
#endif
|
|
|
|
#ifdef Lttynam
|
|
void ttynam_ (char *ret_val, ftnlen ret_val_len, integer *lunit) {
|
|
extern void G77_ttynam_0 (char *ret_val, ftnlen ret_val_len, integer *lunit);
|
|
G77_ttynam_0 (ret_val, ret_val_len, lunit);
|
|
}
|
|
#endif
|
|
|
|
#ifdef Lumask
|
|
integer umask_ (integer *mask) {
|
|
extern integer G77_umask_0 (integer *mask);
|
|
return G77_umask_0 (mask);
|
|
}
|
|
#endif
|
|
|
|
#ifdef Lunlink
|
|
integer unlink_ (const char *str, const ftnlen Lstr) {
|
|
extern integer G77_unlink_0 (const char *str, const ftnlen Lstr);
|
|
return G77_unlink_0 (str, Lstr);
|
|
}
|
|
#endif
|
|
|
|
#ifdef Lvxtidt_y2kbuggy
|
|
int vxtidate_ (integer *m, integer *d, integer *y) {
|
|
/* Fail to link, so user sees attempt to invoke non-Y2K-compliant
|
|
routine. */
|
|
extern int G77_vxtidate_y2kbuggy_0 (integer *m, integer *d, integer *y);
|
|
return G77_vxtidate_y2kbuggy_0 (m, d, y);
|
|
}
|
|
#endif
|
|
|
|
#ifdef Lvxtidt_y2kbug
|
|
int vxtidate_y2kbug__ (integer *m, integer *d, integer *y) {
|
|
/* If user wants to invoke the non-Y2K-compliant routine via
|
|
an `EXTERNAL' interface, avoiding the warning via g77's
|
|
`INTRINSIC' interface, force coding of "y2kbug" string in
|
|
user's program. */
|
|
extern int G77_vxtidate_y2kbug_0 (integer *m, integer *d, integer *y);
|
|
return G77_vxtidate_y2kbug_0 (m, d, y);
|
|
}
|
|
#endif
|
|
|
|
#ifdef Lvxttim
|
|
void vxttime_ (char chtime[8], const ftnlen Lchtime) {
|
|
extern void G77_vxttime_0 (char chtime[8], const ftnlen Lchtime);
|
|
G77_vxttime_0 (chtime, Lchtime);
|
|
}
|
|
#endif
|