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