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