Merge from vendor branch BZIP:
[dragonfly.git] / contrib / gcc-3.4 / 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,
144                 integer *status __attribute__ ((__unused__))) {
145     extern integer G77_alarm_0 (integer *seconds, sig_proc proc);
146     return G77_alarm_0 (seconds, proc);
147 }
148 #endif
149
150 #ifdef Lbesj0
151 double besj0_ (const real *x) {
152     return j0 (*x);
153 }
154 #endif
155
156 #ifdef Lbesj1
157 double besj1_ (const real *x) {
158     return j1 (*x);
159 }
160 #endif
161
162 #ifdef Lbesjn
163 double besjn_ (const integer *n, real *x) {
164     return jn (*n, *x);
165 }
166 #endif
167
168 #ifdef Lbesy0
169 double besy0_ (const real *x) {
170     return y0 (*x);
171 }
172 #endif
173
174 #ifdef Lbesy1
175 double besy1_ (const real *x) {
176     return y1 (*x);
177 }
178 #endif
179
180 #ifdef Lbesyn
181 double besyn_ (const integer *n, real *x) {
182     return yn (*n, *x);
183 }
184 #endif
185
186 #ifdef Lchdir
187 integer chdir_ (const char *name, const ftnlen Lname) {
188     extern integer G77_chdir_0 (const char *name, const ftnlen Lname);
189     return G77_chdir_0 (name, Lname);
190 }
191 #endif
192
193 #ifdef Lchmod
194 integer chmod_ (const char *name, const char *mode, const ftnlen Lname, const ftnlen Lmode) {
195     extern integer G77_chmod_0 (const char *name, const char *mode, const ftnlen Lname, const ftnlen Lmode);
196     return G77_chmod_0 (name, mode, Lname, Lmode);
197 }
198 #endif
199
200 #ifdef Lctime
201 void ctime_ (char *chtime, const ftnlen Lchtime, longint *xstime) {
202     extern void G77_ctime_0 (char *chtime, const ftnlen Lchtime, longint *xstime);
203     G77_ctime_0 (chtime, Lchtime, xstime);
204 }
205 #endif
206
207 #ifdef Ldate_y2kbuggy
208 int date_ (char *buf, ftnlen buf_len) {
209   /* Fail to link, so user sees attempt to invoke non-Y2K-compliant
210      routine.  */
211     extern int G77_date_y2kbuggy_0 (char *buf, ftnlen buf_len);
212     return G77_date_y2kbuggy_0 (buf, buf_len);
213 }
214 #endif
215
216 #ifdef Ldate_y2kbug
217 int date_y2kbug__ (char *buf, ftnlen buf_len) {
218   /* If user wants to invoke the non-Y2K-compliant routine via
219      an `EXTERNAL' interface, avoiding the warning via g77's
220      `INTRINSIC' interface, force coding of "y2kbug" string in
221      user's program.  */
222     extern int G77_date_y2kbug_0 (char *buf, ftnlen buf_len);
223     return G77_date_y2kbug_0 (buf, buf_len);
224 }
225 #endif
226
227 #ifdef Ldbesj0
228 double dbesj0_ (const double *x) {
229     return j0 (*x);
230 }
231 #endif
232
233 #ifdef Ldbesj1
234 double dbesj1_ (const double *x) {
235     return j1 (*x);
236 }
237 #endif
238
239 #ifdef Ldbesjn
240 double dbesjn_ (const integer *n, double *x) {
241     return jn (*n, *x);
242 }
243 #endif
244
245 #ifdef Ldbesy0
246 double dbesy0_ (const double *x) {
247     return y0 (*x);
248 }
249 #endif
250
251 #ifdef Ldbesy1
252 double dbesy1_ (const double *x) {
253     return y1 (*x);
254 }
255 #endif
256
257 #ifdef Ldbesyn
258 double dbesyn_ (const integer *n, double *x) {
259     return yn (*n, *x);
260 }
261 #endif
262
263 #ifdef Ldtime
264 double dtime_ (real tarray[2]) {
265     extern double G77_dtime_0 (real tarray[2]);
266     return G77_dtime_0 (tarray);
267 }
268 #endif
269
270 #ifdef Letime
271 double etime_ (real tarray[2]) {
272     extern double G77_etime_0 (real tarray[2]);
273     return G77_etime_0 (tarray);
274 }
275 #endif
276
277 #ifdef Lfdate
278 void fdate_ (char *ret_val, ftnlen ret_val_len) {
279     extern void G77_fdate_0 (char *ret_val, ftnlen ret_val_len);
280     G77_fdate_0 (ret_val, ret_val_len);
281 }
282 #endif
283
284 #ifdef Lfgetc
285 integer fgetc_ (const integer *lunit, char *c, ftnlen Lc) {
286     extern integer G77_fgetc_0 (const integer *lunit, char *c, ftnlen Lc);
287     return G77_fgetc_0 (lunit, c, Lc);
288 }
289 #endif
290
291 #ifdef Lfget
292 integer fget_ (char *c, const ftnlen Lc) {
293     extern integer G77_fget_0 (char *c, const ftnlen Lc);
294     return G77_fget_0 (c, Lc);
295 }
296 #endif
297
298 #ifdef Lflush1
299 int flush1_ (const integer *lunit) {
300     extern int G77_flush1_0 (const integer *lunit);
301     return G77_flush1_0 (lunit);
302 }
303 #endif
304
305 #ifdef Lfnum
306 integer fnum_ (integer *lunit) {
307     extern integer G77_fnum_0 (integer *lunit);
308     return G77_fnum_0 (lunit);
309 }
310 #endif
311
312 #ifdef Lfputc
313 integer fputc_ (const integer *lunit, const char *c, const ftnlen Lc) {
314     extern integer G77_fputc_0 (const integer *lunit, const char *c, const ftnlen Lc);
315     return G77_fputc_0 (lunit, c, Lc);
316 }
317 #endif
318
319 #ifdef Lfput
320 integer fput_ (const char *c, const ftnlen Lc) {
321     extern integer G77_fput_0 (const char *c, const ftnlen Lc);
322     return G77_fput_0 (c, Lc);
323 }
324 #endif
325
326 #ifdef Lfstat
327 integer fstat_ (const integer *lunit, integer statb[13]) {
328     extern integer G77_fstat_0 (const integer *lunit, integer statb[13]);
329     return G77_fstat_0 (lunit, statb);
330 }
331 #endif
332
333 #ifdef Lgerror
334 int gerror_ (char *str, ftnlen Lstr) {
335     extern int G77_gerror_0 (char *str, ftnlen Lstr);
336     return G77_gerror_0 (str,  Lstr);
337 }
338 #endif
339
340 #ifdef Lgetcwd
341 integer getcwd_ (char *str, const ftnlen Lstr) {
342     extern integer G77_getcwd_0 (char *str, const ftnlen Lstr);
343     return G77_getcwd_0 (str, Lstr);
344 }
345 #endif
346
347 #ifdef Lgetgid
348 integer getgid_ (void) {
349     extern integer G77_getgid_0 (void);
350     return G77_getgid_0 ();
351 }
352 #endif
353
354 #ifdef Lgetlog
355 int getlog_ (char *str, const ftnlen Lstr) {
356     extern int G77_getlog_0 (char *str, const ftnlen Lstr);
357     return G77_getlog_0 (str, Lstr);
358 }
359 #endif
360
361 #ifdef Lgetpid
362 integer getpid_ (void) {
363     extern integer G77_getpid_0 (void);
364     return G77_getpid_0 ();
365 }
366 #endif
367
368 #ifdef Lgetuid
369 integer getuid_ (void) {
370     extern integer G77_getuid_0 (void);
371     return G77_getuid_0 ();
372 }
373 #endif
374
375 #ifdef Lgmtime
376 int gmtime_ (const integer *stime, integer tarray[9]) {
377     extern int G77_gmtime_0 (const integer *stime, integer tarray[9]);
378     return G77_gmtime_0 (stime, tarray);
379 }
380 #endif
381
382 #ifdef Lhostnm
383 integer hostnm_ (char *name, ftnlen Lname) {
384     extern integer G77_hostnm_0 (char *name, ftnlen Lname);
385     return G77_hostnm_0 (name, Lname);
386 }
387 #endif
388
389 #ifdef Lidate
390 int idate_ (int iarray[3]) {
391     extern int G77_idate_0 (int iarray[3]);
392     return G77_idate_0 (iarray);
393 }
394 #endif
395
396 #ifdef Lierrno
397 integer ierrno_ (void) {
398     extern integer G77_ierrno_0 (void);
399     return G77_ierrno_0 ();
400 }
401 #endif
402
403 #ifdef Lirand
404 integer irand_ (integer *flag) {
405     extern integer G77_irand_0 (integer *flag);
406     return G77_irand_0 (flag);
407 }
408 #endif
409
410 #ifdef Lisatty
411 logical isatty_ (integer *lunit) {
412     extern logical G77_isatty_0 (integer *lunit);
413     return G77_isatty_0 (lunit);
414 }
415 #endif
416
417 #ifdef Litime
418 int itime_ (integer tarray[3]) {
419     extern int G77_itime_0 (integer tarray[3]);
420     return G77_itime_0 (tarray);
421 }
422 #endif
423
424 #ifdef Lkill
425 integer kill_ (const integer *pid, const integer *signum) {
426     extern integer G77_kill_0 (const integer *pid, const integer *signum);
427     return G77_kill_0 (pid, signum);
428 }
429 #endif
430
431 #ifdef Llink
432 integer link_ (const char *path1, const char *path2, const ftnlen Lpath1, const ftnlen Lpath2) {
433     extern integer G77_link_0 (const char *path1, const char *path2, const ftnlen Lpath1, const ftnlen Lpath2);
434     return G77_link_0 (path1, path2, Lpath1, Lpath2);
435 }
436 #endif
437
438 #ifdef Llnblnk
439 integer lnblnk_ (char *str, ftnlen str_len) {
440     extern integer G77_lnblnk_0 (char *str, ftnlen str_len);
441     return G77_lnblnk_0 (str, str_len);
442 }
443 #endif
444
445 #ifdef Llstat
446 integer lstat_ (const char *name, integer statb[13], const ftnlen Lname) {
447     extern integer G77_lstat_0 (const char *name, integer statb[13], const ftnlen Lname);
448     return G77_lstat_0 (name, statb, Lname);
449 }
450 #endif
451
452 #ifdef Lltime
453 int ltime_ (const integer *stime, integer tarray[9]) {
454     extern int G77_ltime_0 (const integer *stime, integer tarray[9]);
455     return G77_ltime_0 (stime, tarray);
456 }
457 #endif
458
459 #ifdef Lmclock
460 longint mclock_ (void) {
461     extern longint G77_mclock_0 (void);
462     return G77_mclock_0 ();
463 }
464 #endif
465
466 #ifdef Lperror
467 int perror_ (const char *str, const ftnlen Lstr) {
468     extern int G77_perror_0 (const char *str, const ftnlen Lstr);
469     return G77_perror_0 (str, Lstr);
470 }
471 #endif
472
473 #ifdef Lrand
474 double rand_ (integer *flag) {
475     extern double G77_rand_0 (integer *flag);
476     return G77_rand_0 (flag);
477 }
478 #endif
479
480 #ifdef Lrename
481 integer rename_ (const char *path1, const char *path2, const ftnlen Lpath1, const ftnlen Lpath2) {
482     extern integer G77_rename_0 (const char *path1, const char *path2, const ftnlen Lpath1, const ftnlen Lpath2);
483     return G77_rename_0 (path1, path2, Lpath1, Lpath2);
484 }
485 #endif
486
487 #ifdef Lsecnds
488 double secnds_ (real *r) {
489     extern double G77_secnds_0 (real *r);
490     return G77_secnds_0 (r);
491 }
492 #endif
493
494 #ifdef Lsecond
495 double second_ () {
496     extern double G77_second_0 ();
497     return G77_second_0 ();
498 }
499 #endif
500
501 #ifdef Lsleep
502 int sleep_ (const integer *seconds) {
503     extern int G77_sleep_0 (const integer *seconds);
504     return G77_sleep_0 (seconds);
505 }
506 #endif
507
508 #ifdef Lsrand
509 int srand_ (const integer *seed) {
510     extern int G77_srand_0 (const integer *seed);
511     return G77_srand_0 (seed);
512 }
513 #endif
514
515 #ifdef Lstat
516 integer stat_ (const char *name, integer statb[13], const ftnlen Lname) {
517     extern integer G77_stat_0 (const char *name, integer statb[13], const ftnlen Lname);
518     return G77_stat_0 (name, statb, Lname);
519 }
520 #endif
521
522 #ifdef Lsymlnk
523 integer symlnk_ (const char *path1, const char *path2, const ftnlen Lpath1, const ftnlen Lpath2) {
524     extern integer G77_symlnk_0 (const char *path1, const char *path2, const ftnlen Lpath1, const ftnlen Lpath2);
525     return G77_symlnk_0 (path1, path2, Lpath1, Lpath2);
526 }
527 #endif
528
529 #ifdef Ltime
530 longint time_ (void) {
531     extern longint G77_time_0 (void);
532     return G77_time_0 ();
533 }
534 #endif
535
536 #ifdef Lttynam
537 void ttynam_ (char *ret_val, ftnlen ret_val_len, integer *lunit) {
538     extern void G77_ttynam_0 (char *ret_val, ftnlen ret_val_len, integer *lunit);
539     G77_ttynam_0 (ret_val, ret_val_len, lunit);
540 }
541 #endif
542
543 #ifdef Lumask
544 integer umask_ (integer *mask) {
545     extern integer G77_umask_0 (integer *mask);
546     return G77_umask_0 (mask);
547 }
548 #endif
549
550 #ifdef Lunlink
551 integer unlink_ (const char *str, const ftnlen Lstr) {
552     extern integer G77_unlink_0 (const char *str, const ftnlen Lstr);
553     return G77_unlink_0 (str, Lstr);
554 }
555 #endif
556
557 #ifdef Lvxtidt_y2kbuggy
558 int vxtidate_ (integer *m, integer *d, integer *y) {
559   /* Fail to link, so user sees attempt to invoke non-Y2K-compliant
560      routine.  */
561     extern int G77_vxtidate_y2kbuggy_0 (integer *m, integer *d, integer *y);
562     return G77_vxtidate_y2kbuggy_0 (m, d, y);
563 }
564 #endif
565
566 #ifdef Lvxtidt_y2kbug
567 int vxtidate_y2kbug__ (integer *m, integer *d, integer *y) {
568   /* If user wants to invoke the non-Y2K-compliant routine via
569      an `EXTERNAL' interface, avoiding the warning via g77's
570      `INTRINSIC' interface, force coding of "y2kbug" string in
571      user's program.  */
572     extern int G77_vxtidate_y2kbug_0 (integer *m, integer *d, integer *y);
573     return G77_vxtidate_y2kbug_0 (m, d, y);
574 }
575 #endif
576
577 #ifdef Lvxttim
578 void vxttime_ (char chtime[8], const ftnlen Lchtime) {
579     extern void G77_vxttime_0 (char chtime[8], const ftnlen Lchtime);
580     G77_vxttime_0 (chtime, Lchtime);
581 }
582 #endif