source: vendor/gcc/3.3.4/libf2c/f2cext.c

Last change on this file was 1391, checked in by bird, 21 years ago

GCC v3.3.3 sources.

  • Property cvs2svn:cvs-rev set to 1.1.1.2
  • Property svn:eol-style set to native
  • Property svn:executable set to *
File size: 13.8 KB
Line 
1/* Copyright (C) 1997 Free Software Foundation, Inc.
2This file is part of GNU Fortran run-time library.
3
4This library is free software; you can redistribute it and/or modify it
5under the terms of the GNU Library General Public License as published
6by the Free Software Foundation; either version 2 of the License, or
7(at your option) any later version.
8
9GNU Fortran is distributed in the hope that it will be useful,
10but WITHOUT ANY WARRANTY; without even the implied warranty of
11MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
12Library General Public License for more details.
13
14You should have received a copy of the GNU Library General Public
15License along with GNU Fortran; see the file COPYING.LIB. If
16not, write to the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
17Boston, MA 02111-1307, USA. */
18
19#include <math.h> /* for j0 et al */
20#include <f2c.h>
21typedef void *sig_proc; /* For now, this will have to do. */
22
23#ifdef Labort
24int abort_ (void) {
25 extern int G77_abort_0 (void);
26 return G77_abort_0 ();
27}
28#endif
29
30#ifdef Lderf
31double derf_ (doublereal *x) {
32 extern double G77_derf_0 (doublereal *x);
33 return G77_derf_0 (x);
34}
35#endif
36
37#ifdef Lderfc
38double derfc_ (doublereal *x) {
39 extern double G77_derfc_0 (doublereal *x);
40 return G77_derfc_0 (x);
41}
42#endif
43
44#ifdef Lef1asc
45int 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
52integer 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
59double erf_ (real *x) {
60 extern double G77_erf_0 (real *x);
61 return G77_erf_0 (x);
62}
63#endif
64
65#ifdef Lerfc
66double erfc_ (real *x) {
67 extern double G77_erfc_0 (real *x);
68 return G77_erfc_0 (x);
69}
70#endif
71
72#ifdef Lexit
73void exit_ (integer *rc) {
74 extern void G77_exit_0 (integer *rc);
75 G77_exit_0 (rc);
76}
77#endif
78
79#ifdef Lgetarg
80void 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
87void 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
94ftnint iargc_ (void) {
95 extern ftnint G77_iargc_0 (void);
96 return G77_iargc_0 ();
97}
98#endif
99
100#ifdef Lsignal
101void *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
108integer 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
115int flush_ (void) {
116 extern int G77_flush_0 (void);
117 return G77_flush_0 ();
118}
119#endif
120
121#ifdef Lftell
122integer ftell_ (integer *Unit) {
123 extern integer G77_ftell_0 (integer *Unit);
124 return G77_ftell_0 (Unit);
125}
126#endif
127
128#ifdef Lfseek
129integer 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
136integer 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
143integer 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
151double besj0_ (const real *x) {
152 return j0 (*x);
153}
154#endif
155
156#ifdef Lbesj1
157double besj1_ (const real *x) {
158 return j1 (*x);
159}
160#endif
161
162#ifdef Lbesjn
163double besjn_ (const integer *n, real *x) {
164 return jn (*n, *x);
165}
166#endif
167
168#ifdef Lbesy0
169double besy0_ (const real *x) {
170 return y0 (*x);
171}
172#endif
173
174#ifdef Lbesy1
175double besy1_ (const real *x) {
176 return y1 (*x);
177}
178#endif
179
180#ifdef Lbesyn
181double besyn_ (const integer *n, real *x) {
182 return yn (*n, *x);
183}
184#endif
185
186#ifdef Lchdir
187integer 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
194integer 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
201void 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
208int 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
217int 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
228double dbesj0_ (const double *x) {
229 return j0 (*x);
230}
231#endif
232
233#ifdef Ldbesj1
234double dbesj1_ (const double *x) {
235 return j1 (*x);
236}
237#endif
238
239#ifdef Ldbesjn
240double dbesjn_ (const integer *n, double *x) {
241 return jn (*n, *x);
242}
243#endif
244
245#ifdef Ldbesy0
246double dbesy0_ (const double *x) {
247 return y0 (*x);
248}
249#endif
250
251#ifdef Ldbesy1
252double dbesy1_ (const double *x) {
253 return y1 (*x);
254}
255#endif
256
257#ifdef Ldbesyn
258double dbesyn_ (const integer *n, double *x) {
259 return yn (*n, *x);
260}
261#endif
262
263#ifdef Ldtime
264double 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
271double 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
278void 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
285integer 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
292integer 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
299int 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
306integer fnum_ (integer *lunit) {
307 extern integer G77_fnum_0 (integer *lunit);
308 return G77_fnum_0 (lunit);
309}
310#endif
311
312#ifdef Lfputc
313integer 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
320integer 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
327integer 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
334int 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
341integer 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
348integer getgid_ (void) {
349 extern integer G77_getgid_0 (void);
350 return G77_getgid_0 ();
351}
352#endif
353
354#ifdef Lgetlog
355int 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
362integer getpid_ (void) {
363 extern integer G77_getpid_0 (void);
364 return G77_getpid_0 ();
365}
366#endif
367
368#ifdef Lgetuid
369integer getuid_ (void) {
370 extern integer G77_getuid_0 (void);
371 return G77_getuid_0 ();
372}
373#endif
374
375#ifdef Lgmtime
376int 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
383integer 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
390int 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
397integer ierrno_ (void) {
398 extern integer G77_ierrno_0 (void);
399 return G77_ierrno_0 ();
400}
401#endif
402
403#ifdef Lirand
404integer irand_ (integer *flag) {
405 extern integer G77_irand_0 (integer *flag);
406 return G77_irand_0 (flag);
407}
408#endif
409
410#ifdef Lisatty
411logical isatty_ (integer *lunit) {
412 extern logical G77_isatty_0 (integer *lunit);
413 return G77_isatty_0 (lunit);
414}
415#endif
416
417#ifdef Litime
418int 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
425integer 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
432integer 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
439integer 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
446integer 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
453int 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
460longint mclock_ (void) {
461 extern longint G77_mclock_0 (void);
462 return G77_mclock_0 ();
463}
464#endif
465
466#ifdef Lperror
467int 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
474double rand_ (integer *flag) {
475 extern double G77_rand_0 (integer *flag);
476 return G77_rand_0 (flag);
477}
478#endif
479
480#ifdef Lrename
481integer 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
488double secnds_ (real *r) {
489 extern double G77_secnds_0 (real *r);
490 return G77_secnds_0 (r);
491}
492#endif
493
494#ifdef Lsecond
495double second_ () {
496 extern double G77_second_0 ();
497 return G77_second_0 ();
498}
499#endif
500
501#ifdef Lsleep
502int 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
509int 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
516integer 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
523integer 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
530longint time_ (void) {
531 extern longint G77_time_0 (void);
532 return G77_time_0 ();
533}
534#endif
535
536#ifdef Lttynam
537void 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
544integer umask_ (integer *mask) {
545 extern integer G77_umask_0 (integer *mask);
546 return G77_umask_0 (mask);
547}
548#endif
549
550#ifdef Lunlink
551integer 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
558int 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
567int 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
578void 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
Note: See TracBrowser for help on using the repository browser.