]>
Commit | Line | Data |
---|---|---|
81fea2b1 JL |
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 | ||
87e6e875 | 19 | #include <math.h> /* for j0 et al */ |
81fea2b1 | 20 | #include <f2c.h> |
6d433196 | 21 | typedef void *sig_proc; /* For now, this will have to do. */ |
81fea2b1 JL |
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 | |
6d433196 CB |
101 | void *signal_ (integer *sigp, sig_proc proc) { |
102 | extern void *G77_signal_0 (integer *sigp, sig_proc proc); | |
81fea2b1 JL |
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 | ||
411d4e28 | 206 | #ifdef Ldate_y2kbuggy |
81fea2b1 | 207 | int date_ (char *buf, ftnlen buf_len) { |
411d4e28 CB |
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); | |
81fea2b1 JL |
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 | ||
81fea2b1 JL |
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 | ||
411d4e28 | 556 | #ifdef Lvxtidt_y2kbuggy |
81fea2b1 | 557 | int vxtidate_ (integer *m, integer *d, integer *y) { |
411d4e28 CB |
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); | |
81fea2b1 JL |
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 |