libf2c/f2cext.c

   1 /* Copyright (C) 1997 Free Software Foundation, Inc.
   2 This file is part of GNU Fortran run-time library.
   3
   4 This library is free software; you can redistribute it and/or modify it
   5 under the terms of the GNU Library General Public License as published
   6 by the Free Software Foundation; either version 2 of the License, or
   7 (at your option) any later version.
   8
   9 GNU Fortran is distributed in the hope that it will be useful,
  10 but WITHOUT ANY WARRANTY; without even the implied warranty of
  11 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
  12 Library General Public License for more details.
  13
  14 You should have received a copy of the GNU Library General Public
  15 License along with GNU Fortran; see the file COPYING.LIB.  If
  16 not, write to the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
  17 Boston, MA 02111-1307, USA.  */
  18
  19 #include <math.h>               /* for j0 et al */
  20 #include <f2c.h>
  21 typedef void *sig_proc; /* For now, this will have to do. */
  22
  23 #ifdef Labort
  24 int abort_ (void) {
  25     extern int G77_abort_0 (void);
  26     return G77_abort_0 ();
  27 }
  28 #endif
  29
  30 #ifdef Lderf
  31 double derf_ (doublereal *x) {
  32     extern double G77_derf_0 (doublereal *x);
  33     return G77_derf_0 (x);
  34 }
  35 #endif
  36
  37 #ifdef Lderfc
  38 double derfc_ (doublereal *x) {
  39     extern double G77_derfc_0 (doublereal *x);
  40     return G77_derfc_0 (x);
  41 }
  42 #endif
  43
  44 #ifdef Lef1asc
  45 int ef1asc_ (ftnint *a, ftnlen *la, ftnint *b, ftnlen *lb) {
  46     extern int G77_ef1asc_0 (ftnint *a, ftnlen *la, ftnint *b, ftnlen *lb);
  47     return G77_ef1asc_0 (a, la, b, lb);
  48 }
  49 #endif
  50
  51 #ifdef Lef1cmc
  52 integer ef1cmc_ (ftnint *a, ftnlen *la, ftnint *b, ftnlen *lb) {
  53     extern integer G77_ef1cmc_0 (ftnint *a, ftnlen *la, ftnint *b, ftnlen *lb);
  54     return G77_ef1cmc_0 (a, la, b, lb);
  55 }
  56 #endif
  57
  58 #ifdef Lerf
  59 double erf_ (real *x) {
  60     extern double G77_erf_0 (real *x);
  61     return G77_erf_0 (x);
  62 }
  63 #endif
  64
  65 #ifdef Lerfc
  66 double erfc_ (real *x) {
  67     extern double G77_erfc_0 (real *x);
  68     return G77_erfc_0 (x);
  69 }
  70 #endif
  71
  72 #ifdef Lexit
  73 void exit_ (integer *rc) {
  74     extern void G77_exit_0 (integer *rc);
  75     G77_exit_0 (rc);
  76 }
  77 #endif
  78
  79 #ifdef Lgetarg
  80 void getarg_ (ftnint *n, char *s, ftnlen ls) {
  81     extern void G77_getarg_0 (ftnint *n, char *s, ftnlen ls);
  82     G77_getarg_0 (n, s, ls);
  83 }
  84 #endif
  85
  86 #ifdef Lgetenv
  87 void getenv_ (char *fname, char *value, ftnlen flen, ftnlen vlen) {
  88     extern void G77_getenv_0 (char *fname, char *value, ftnlen flen, ftnlen vlen);
  89     G77_getenv_0 (fname, value, flen, vlen);
  90 }
  91 #endif
  92
  93 #ifdef Liargc
  94 ftnint iargc_ (void) {
  95     extern ftnint G77_iargc_0 (void);
  96     return G77_iargc_0 ();
  97 }
  98 #endif
  99
 100 #ifdef Lsignal
 101 void *signal_ (integer *sigp, sig_proc proc) {
 102     extern void *G77_signal_0 (integer *sigp, sig_proc proc);
 103     return G77_signal_0 (sigp, proc);
 104 }
 105 #endif
 106
 107 #ifdef Lsystem
 108 integer system_ (char *s, ftnlen n) {
 109     extern integer G77_system_0 (char *s, ftnlen n);
 110     return G77_system_0 (s, n);
 111 }
 112 #endif
 113
 114 #ifdef Lflush
 115 int flush_ (void) {
 116     extern int G77_flush_0 (void);
 117     return G77_flush_0 ();
 118 }
 119 #endif
 120
 121 #ifdef Lftell
 122 integer ftell_ (integer *Unit) {
 123     extern integer G77_ftell_0 (integer *Unit);
 124     return G77_ftell_0 (Unit);
 125 }
 126 #endif
 127
 128 #ifdef Lfseek
 129 integer fseek_ (integer *Unit, integer *offset, integer *xwhence) {
 130     extern integer G77_fseek_0 (integer *Unit, integer *offset, integer *xwhence);
 131     return G77_fseek_0 (Unit, offset, xwhence);
 132 }
 133 #endif
 134
 135 #ifdef Laccess
 136 integer access_ (const char *name, const char *mode, ftnlen Lname, ftnlen Lmode) {
 137     extern integer G77_access_0 (const char *name, const char *mode, ftnlen Lname, ftnlen Lmode);
 138     return G77_access_0 (name, mode, Lname, Lmode);
 139 }
 140 #endif
 141
 142 #ifdef Lalarm
 143 integer alarm_ (integer *seconds, sig_proc proc, integer *status) {
 144     extern integer G77_alarm_0 (integer *seconds, sig_proc proc);
 145     return G77_alarm_0 (seconds, proc);
 146 }
 147 #endif
 148
 149 #ifdef Lbesj0
 150 double besj0_ (const real *x) {
 151     return j0 (*x);
 152 }
 153 #endif
 154
 155 #ifdef Lbesj1
 156 double besj1_ (const real *x) {
 157     return j1 (*x);
 158 }
 159 #endif
 160
 161 #ifdef Lbesjn
 162 double besjn_ (const integer *n, real *x) {
 163     return jn (*n, *x);
 164 }
 165 #endif
 166
 167 #ifdef Lbesy0
 168 double besy0_ (const real *x) {
 169     return y0 (*x);
 170 }
 171 #endif
 172
 173 #ifdef Lbesy1
 174 double besy1_ (const real *x) {
 175     return y1 (*x);
 176 }
 177 #endif
 178
 179 #ifdef Lbesyn
 180 double besyn_ (const integer *n, real *x) {
 181     return yn (*n, *x);
 182 }
 183 #endif
 184
 185 #ifdef Lchdir
 186 integer chdir_ (const char *name, const ftnlen Lname) {
 187     extern integer G77_chdir_0 (const char *name, const ftnlen Lname);
 188     return G77_chdir_0 (name, Lname);
 189 }
 190 #endif
 191
 192 #ifdef Lchmod
 193 integer chmod_ (const char *name, const char *mode, const ftnlen Lname, const ftnlen Lmode) {
 194     extern integer G77_chmod_0 (const char *name, const char *mode, const ftnlen Lname, const ftnlen Lmode);
 195     return G77_chmod_0 (name, mode, Lname, Lmode);
 196 }
 197 #endif
 198
 199 #ifdef Lctime
 200 void ctime_ (char *chtime, const ftnlen Lchtime, longint *xstime) {
 201     extern void G77_ctime_0 (char *chtime, const ftnlen Lchtime, longint *xstime);
 202     G77_ctime_0 (chtime, Lchtime, xstime);
 203 }
 204 #endif
 205
 206 #ifdef Ldate
 207 int date_ (char *buf, ftnlen buf_len) {
 208     extern int G77_date_0 (char *buf, ftnlen buf_len);
 209     return G77_date_0 (buf, buf_len);
 210 }
 211 #endif
 212
 213 #ifdef Ldbesj0
 214 double dbesj0_ (const double *x) {
 215     return j0 (*x);
 216 }
 217 #endif
 218
 219 #ifdef Ldbesj1
 220 double dbesj1_ (const double *x) {
 221     return j1 (*x);
 222 }
 223 #endif
 224
 225 #ifdef Ldbesjn
 226 double dbesjn_ (const integer *n, double *x) {
 227     return jn (*n, *x);
 228 }
 229 #endif
 230
 231 #ifdef Ldbesy0
 232 double dbesy0_ (const double *x) {
 233     return y0 (*x);
 234 }
 235 #endif
 236
 237 #ifdef Ldbesy1
 238 double dbesy1_ (const double *x) {
 239     return y1 (*x);
 240 }
 241 #endif
 242
 243 #ifdef Ldbesyn
 244 double dbesyn_ (const integer *n, double *x) {
 245     return yn (*n, *x);
 246 }
 247 #endif
 248
 249 #ifdef Ldtime
 250 double dtime_ (real tarray[2]) {
 251     extern double G77_dtime_0 (real tarray[2]);
 252     return G77_dtime_0 (tarray);
 253 }
 254 #endif
 255
 256 #ifdef Letime
 257 double etime_ (real tarray[2]) {
 258     extern double G77_etime_0 (real tarray[2]);
 259     return G77_etime_0 (tarray);
 260 }
 261 #endif
 262
 263 #ifdef Lfdate
 264 void fdate_ (char *ret_val, ftnlen ret_val_len) {
 265     extern void G77_fdate_0 (char *ret_val, ftnlen ret_val_len);
 266     G77_fdate_0 (ret_val, ret_val_len);
 267 }
 268 #endif
 269
 270 #ifdef Lfgetc
 271 integer fgetc_ (const integer *lunit, char *c, ftnlen Lc) {
 272     extern integer G77_fgetc_0 (const integer *lunit, char *c, ftnlen Lc);
 273     return G77_fgetc_0 (lunit, c, Lc);
 274 }
 275 #endif
 276
 277 #ifdef Lfget
 278 integer fget_ (char *c, const ftnlen Lc) {
 279     extern integer G77_fget_0 (char *c, const ftnlen Lc);
 280     return G77_fget_0 (c, Lc);
 281 }
 282 #endif
 283
 284 #ifdef Lflush1
 285 int flush1_ (const integer *lunit) {
 286     extern int G77_flush1_0 (const integer *lunit);
 287     return G77_flush1_0 (lunit);
 288 }
 289 #endif
 290
 291 #ifdef Lfnum
 292 integer fnum_ (integer *lunit) {
 293     extern integer G77_fnum_0 (integer *lunit);
 294     return G77_fnum_0 (lunit);
 295 }
 296 #endif
 297
 298 #ifdef Lfputc
 299 integer fputc_ (const integer *lunit, const char *c, const ftnlen Lc) {
 300     extern integer G77_fputc_0 (const integer *lunit, const char *c, const ftnlen Lc);
 301     return G77_fputc_0 (lunit, c, Lc);
 302 }
 303 #endif
 304
 305 #ifdef Lfput
 306 integer fput_ (const char *c, const ftnlen Lc) {
 307     extern integer G77_fput_0 (const char *c, const ftnlen Lc);
 308     return G77_fput_0 (c, Lc);
 309 }
 310 #endif
 311
 312 #ifdef Lfstat
 313 integer fstat_ (const integer *lunit, integer statb[13]) {
 314     extern integer G77_fstat_0 (const integer *lunit, integer statb[13]);
 315     return G77_fstat_0 (lunit, statb);
 316 }
 317 #endif
 318
 319 #ifdef Lgerror
 320 int gerror_ (char *str, ftnlen Lstr) {
 321     extern int G77_gerror_0 (char *str, ftnlen Lstr);
 322     return G77_gerror_0 (str,  Lstr);
 323 }
 324 #endif
 325
 326 #ifdef Lgetcwd
 327 integer getcwd_ (char *str, const ftnlen Lstr) {
 328     extern integer G77_getcwd_0 (char *str, const ftnlen Lstr);
 329     return G77_getcwd_0 (str, Lstr);
 330 }
 331 #endif
 332
 333 #ifdef Lgetgid
 334 integer getgid_ (void) {
 335     extern integer G77_getgid_0 (void);
 336     return G77_getgid_0 ();
 337 }
 338 #endif
 339
 340 #ifdef Lgetlog
 341 int getlog_ (char *str, const ftnlen Lstr) {
 342     extern int G77_getlog_0 (char *str, const ftnlen Lstr);
 343     return G77_getlog_0 (str, Lstr);
 344 }
 345 #endif
 346
 347 #ifdef Lgetpid
 348 integer getpid_ (void) {
 349     extern integer G77_getpid_0 (void);
 350     return G77_getpid_0 ();
 351 }
 352 #endif
 353
 354 #ifdef Lgetuid
 355 integer getuid_ (void) {
 356     extern integer G77_getuid_0 (void);
 357     return G77_getuid_0 ();
 358 }
 359 #endif
 360
 361 #ifdef Lgmtime
 362 int gmtime_ (const integer *stime, integer tarray[9]) {
 363     extern int G77_gmtime_0 (const integer *stime, integer tarray[9]);
 364     return G77_gmtime_0 (stime, tarray);
 365 }
 366 #endif
 367
 368 #ifdef Lhostnm
 369 integer hostnm_ (char *name, ftnlen Lname) {
 370     extern integer G77_hostnm_0 (char *name, ftnlen Lname);
 371     return G77_hostnm_0 (name, Lname);
 372 }
 373 #endif
 374
 375 #ifdef Lidate
 376 int idate_ (int iarray[3]) {
 377     extern int G77_idate_0 (int iarray[3]);
 378     return G77_idate_0 (iarray);
 379 }
 380 #endif
 381
 382 #ifdef Lierrno
 383 integer ierrno_ (void) {
 384     extern integer G77_ierrno_0 (void);
 385     return G77_ierrno_0 ();
 386 }
 387 #endif
 388
 389 #ifdef Lirand
 390 integer irand_ (integer *flag) {
 391     extern integer G77_irand_0 (integer *flag);
 392     return G77_irand_0 (flag);
 393 }
 394 #endif
 395
 396 #ifdef Lisatty
 397 logical isatty_ (integer *lunit) {
 398     extern logical G77_isatty_0 (integer *lunit);
 399     return G77_isatty_0 (lunit);
 400 }
 401 #endif
 402
 403 #ifdef Litime
 404 int itime_ (integer tarray[3]) {
 405     extern int G77_itime_0 (integer tarray[3]);
 406     return G77_itime_0 (tarray);
 407 }
 408 #endif
 409
 410 #ifdef Lkill
 411 integer kill_ (const integer *pid, const integer *signum) {
 412     extern integer G77_kill_0 (const integer *pid, const integer *signum);
 413     return G77_kill_0 (pid, signum);
 414 }
 415 #endif
 416
 417 #ifdef Llink
 418 integer link_ (const char *path1, const char *path2, const ftnlen Lpath1, const ftnlen Lpath2) {
 419     extern integer G77_link_0 (const char *path1, const char *path2, const ftnlen Lpath1, const ftnlen Lpath2);
 420     return G77_link_0 (path1, path2, Lpath1, Lpath2);
 421 }
 422 #endif
 423
 424 #ifdef Llnblnk
 425 integer lnblnk_ (char *str, ftnlen str_len) {
 426     extern integer G77_lnblnk_0 (char *str, ftnlen str_len);
 427     return G77_lnblnk_0 (str, str_len);
 428 }
 429 #endif
 430
 431 #ifdef Llstat
 432 integer lstat_ (const char *name, integer statb[13], const ftnlen Lname) {
 433     extern integer G77_lstat_0 (const char *name, integer statb[13], const ftnlen Lname);
 434     return G77_lstat_0 (name, statb, Lname);
 435 }
 436 #endif
 437
 438 #ifdef Lltime
 439 int ltime_ (const integer *stime, integer tarray[9]) {
 440     extern int G77_ltime_0 (const integer *stime, integer tarray[9]);
 441     return G77_ltime_0 (stime, tarray);
 442 }
 443 #endif
 444
 445 #ifdef Lmclock
 446 longint mclock_ (void) {
 447     extern longint G77_mclock_0 (void);
 448     return G77_mclock_0 ();
 449 }
 450 #endif
 451
 452 #ifdef Lperror
 453 int perror_ (const char *str, const ftnlen Lstr) {
 454     extern int G77_perror_0 (const char *str, const ftnlen Lstr);
 455     return G77_perror_0 (str, Lstr);
 456 }
 457 #endif
 458
 459 #ifdef Lrand
 460 double rand_ (integer *flag) {
 461     extern double G77_rand_0 (integer *flag);
 462     return G77_rand_0 (flag);
 463 }
 464 #endif
 465
 466 #ifdef Lrename
 467 integer rename_ (const char *path1, const char *path2, const ftnlen Lpath1, const ftnlen Lpath2) {
 468     extern integer G77_rename_0 (const char *path1, const char *path2, const ftnlen Lpath1, const ftnlen Lpath2);
 469     return G77_rename_0 (path1, path2, Lpath1, Lpath2);
 470 }
 471 #endif
 472
 473 #ifdef Lsecnds
 474 double secnds_ (real *r) {
 475     extern double G77_secnds_0 (real *r);
 476     return G77_secnds_0 (r);
 477 }
 478 #endif
 479
 480 #ifdef Lsecond
 481 double second_ () {
 482     extern double G77_second_0 ();
 483     return G77_second_0 ();
 484 }
 485 #endif
 486
 487 #ifdef Lsleep
 488 int sleep_ (const integer *seconds) {
 489     extern int G77_sleep_0 (const integer *seconds);
 490     return G77_sleep_0 (seconds);
 491 }
 492 #endif
 493
 494 #ifdef Lsrand
 495 int srand_ (const integer *seed) {
 496     extern int G77_srand_0 (const integer *seed);
 497     return G77_srand_0 (seed);
 498 }
 499 #endif
 500
 501 #ifdef Lstat
 502 integer stat_ (const char *name, integer statb[13], const ftnlen Lname) {
 503     extern integer G77_stat_0 (const char *name, integer statb[13], const ftnlen Lname);
 504     return G77_stat_0 (name, statb, Lname);
 505 }
 506 #endif
 507
 508 #ifdef Lsymlnk
 509 integer symlnk_ (const char *path1, const char *path2, const ftnlen Lpath1, const ftnlen Lpath2) {
 510     extern integer G77_symlnk_0 (const char *path1, const char *path2, const ftnlen Lpath1, const ftnlen Lpath2);
 511     return G77_symlnk_0 (path1, path2, Lpath1, Lpath2);
 512 }
 513 #endif
 514
 515 #ifdef Ltime
 516 longint time_ (void) {
 517     extern longint G77_time_0 (void);
 518     return G77_time_0 ();
 519 }
 520 #endif
 521
 522 #ifdef Lttynam
 523 void ttynam_ (char *ret_val, ftnlen ret_val_len, integer *lunit) {
 524     extern void G77_ttynam_0 (char *ret_val, ftnlen ret_val_len, integer *lunit);
 525     G77_ttynam_0 (ret_val, ret_val_len, lunit);
 526 }
 527 #endif
 528
 529 #ifdef Lumask
 530 integer umask_ (integer *mask) {
 531     extern integer G77_umask_0 (integer *mask);
 532     return G77_umask_0 (mask);
 533 }
 534 #endif
 535
 536 #ifdef Lunlink
 537 integer unlink_ (const char *str, const ftnlen Lstr) {
 538     extern integer G77_unlink_0 (const char *str, const ftnlen Lstr);
 539     return G77_unlink_0 (str, Lstr);
 540 }
 541 #endif
 542
 543 #ifdef Lvxtidt
 544 int vxtidate_ (integer *m, integer *d, integer *y) {
 545     extern int G77_vxtidate_0 (integer *m, integer *d, integer *y);
 546     return G77_vxtidate_0 (m, d, y);
 547 }
 548 #endif
 549
 550 #ifdef Lvxttim
 551 void vxttime_ (char chtime[8], const ftnlen Lchtime) {
 552     extern void G77_vxttime_0 (char chtime[8], const ftnlen Lchtime);
 553     G77_vxttime_0 (chtime, Lchtime);
 554 }
 555 #endif