From 81fea2b1d147752f431b46c08f4c12a18a2d78bc Mon Sep 17 00:00:00 2001 From: Jeff Law Date: Sat, 31 Jan 1998 18:37:08 -0700 Subject: [PATCH] * Previous contents of gcc/f/runtime moved into toplevel "libf2c" directory. From-SVN: r17568 --- libf2c/ChangeLog | 787 +++++++++ libf2c/ChangeLog.egcs | 108 ++ libf2c/Makefile.in | 228 +++ libf2c/README | 46 + libf2c/TODO | 17 + libf2c/changes.netlib | 2850 +++++++++++++++++++++++++++++++++ libf2c/configure | 2197 +++++++++++++++++++++++++ libf2c/configure.in | 391 +++++ libf2c/disclaimer.netlib | 15 + libf2c/f2c.h.in | 227 +++ libf2c/f2cext.c | 562 +++++++ libf2c/libF77/F77_aloc.c | 32 + libf2c/libF77/Makefile.in | 76 + libf2c/libF77/Notice | 23 + libf2c/libF77/README.netlib | 108 ++ libf2c/libF77/Version.c | 67 + libf2c/libF77/abort_.c | 18 + libf2c/libF77/c_abs.c | 14 + libf2c/libF77/c_cos.c | 21 + libf2c/libF77/c_div.c | 40 + libf2c/libF77/c_exp.c | 23 + libf2c/libF77/c_log.c | 21 + libf2c/libF77/c_sin.c | 21 + libf2c/libF77/c_sqrt.c | 38 + libf2c/libF77/cabs.c | 27 + libf2c/libF77/d_abs.c | 12 + libf2c/libF77/d_acos.c | 13 + libf2c/libF77/d_asin.c | 13 + libf2c/libF77/d_atan.c | 13 + libf2c/libF77/d_atn2.c | 13 + libf2c/libF77/d_cnjg.c | 17 + libf2c/libF77/d_cos.c | 13 + libf2c/libF77/d_cosh.c | 13 + libf2c/libF77/d_dim.c | 10 + libf2c/libF77/d_exp.c | 13 + libf2c/libF77/d_imag.c | 10 + libf2c/libF77/d_int.c | 13 + libf2c/libF77/d_lg10.c | 15 + libf2c/libF77/d_log.c | 13 + libf2c/libF77/d_mod.c | 40 + libf2c/libF77/d_nint.c | 14 + libf2c/libF77/d_prod.c | 10 + libf2c/libF77/d_sign.c | 12 + libf2c/libF77/d_sin.c | 13 + libf2c/libF77/d_sinh.c | 13 + libf2c/libF77/d_sqrt.c | 13 + libf2c/libF77/d_tan.c | 13 + libf2c/libF77/d_tanh.c | 13 + libf2c/libF77/derf_.c | 12 + libf2c/libF77/derfc_.c | 14 + libf2c/libF77/dtime_.c | 45 + libf2c/libF77/ef1asc_.c | 21 + libf2c/libF77/ef1cmc_.c | 14 + libf2c/libF77/erf_.c | 12 + libf2c/libF77/erfc_.c | 12 + libf2c/libF77/etime_.c | 38 + libf2c/libF77/exit_.c | 37 + libf2c/libF77/f2ch.add | 162 ++ libf2c/libF77/getarg_.c | 28 + libf2c/libF77/getenv_.c | 51 + libf2c/libF77/h_abs.c | 12 + libf2c/libF77/h_dim.c | 10 + libf2c/libF77/h_dnnt.c | 14 + libf2c/libF77/h_indx.c | 26 + libf2c/libF77/h_len.c | 10 + libf2c/libF77/h_mod.c | 10 + libf2c/libF77/h_nint.c | 14 + libf2c/libF77/h_sign.c | 12 + libf2c/libF77/hl_ge.c | 12 + libf2c/libF77/hl_gt.c | 12 + libf2c/libF77/hl_le.c | 12 + libf2c/libF77/hl_lt.c | 12 + libf2c/libF77/i_abs.c | 12 + libf2c/libF77/i_dim.c | 10 + libf2c/libF77/i_dnnt.c | 14 + libf2c/libF77/i_indx.c | 26 + libf2c/libF77/i_len.c | 10 + libf2c/libF77/i_mod.c | 10 + libf2c/libF77/i_nint.c | 14 + libf2c/libF77/i_sign.c | 12 + libf2c/libF77/iargc_.c | 11 + libf2c/libF77/l_ge.c | 12 + libf2c/libF77/l_gt.c | 12 + libf2c/libF77/l_le.c | 12 + libf2c/libF77/l_lt.c | 12 + libf2c/libF77/lbitbits.c | 62 + libf2c/libF77/lbitshft.c | 11 + libf2c/libF77/main.c | 135 ++ libf2c/libF77/makefile.netlib | 103 ++ libf2c/libF77/pow_ci.c | 20 + libf2c/libF77/pow_dd.c | 13 + libf2c/libF77/pow_di.c | 35 + libf2c/libF77/pow_hh.c | 33 + libf2c/libF77/pow_ii.c | 33 + libf2c/libF77/pow_qq.c | 33 + libf2c/libF77/pow_ri.c | 35 + libf2c/libF77/pow_zi.c | 61 + libf2c/libF77/pow_zz.c | 23 + libf2c/libF77/qbitbits.c | 66 + libf2c/libF77/qbitshft.c | 11 + libf2c/libF77/r_abs.c | 12 + libf2c/libF77/r_acos.c | 13 + libf2c/libF77/r_asin.c | 13 + libf2c/libF77/r_atan.c | 13 + libf2c/libF77/r_atn2.c | 13 + libf2c/libF77/r_cnjg.c | 16 + libf2c/libF77/r_cos.c | 13 + libf2c/libF77/r_cosh.c | 13 + libf2c/libF77/r_dim.c | 10 + libf2c/libF77/r_exp.c | 13 + libf2c/libF77/r_imag.c | 10 + libf2c/libF77/r_int.c | 13 + libf2c/libF77/r_lg10.c | 15 + libf2c/libF77/r_log.c | 13 + libf2c/libF77/r_mod.c | 40 + libf2c/libF77/r_nint.c | 14 + libf2c/libF77/r_sign.c | 12 + libf2c/libF77/r_sin.c | 13 + libf2c/libF77/r_sinh.c | 13 + libf2c/libF77/r_sqrt.c | 13 + libf2c/libF77/r_tan.c | 13 + libf2c/libF77/r_tanh.c | 13 + libf2c/libF77/s_cat.c | 75 + libf2c/libF77/s_cmp.c | 44 + libf2c/libF77/s_copy.c | 51 + libf2c/libF77/s_paus.c | 88 + libf2c/libF77/s_rnge.c | 26 + libf2c/libF77/s_stop.c | 37 + libf2c/libF77/sig_die.c | 45 + libf2c/libF77/signal1.h | 5 + libf2c/libF77/signal1.h0 | 25 + libf2c/libF77/signal_.c | 14 + libf2c/libF77/system_.c | 36 + libf2c/libF77/z_abs.c | 12 + libf2c/libF77/z_cos.c | 19 + libf2c/libF77/z_div.c | 39 + libf2c/libF77/z_exp.c | 21 + libf2c/libF77/z_log.c | 20 + libf2c/libF77/z_sin.c | 19 + libf2c/libF77/z_sqrt.c | 33 + libf2c/libI77/Makefile.in | 119 ++ libf2c/libI77/Notice | 23 + libf2c/libI77/README.netlib | 225 +++ libf2c/libI77/Version.c | 284 ++++ libf2c/libI77/backspace.c | 102 ++ libf2c/libI77/close.c | 103 ++ libf2c/libI77/dfe.c | 156 ++ libf2c/libI77/dolio.c | 20 + libf2c/libI77/due.c | 73 + libf2c/libI77/endfile.c | 195 +++ libf2c/libI77/err.c | 299 ++++ libf2c/libI77/f2ch.add | 162 ++ libf2c/libI77/fio.h | 105 ++ libf2c/libI77/fmt.c | 543 +++++++ libf2c/libI77/fmt.h | 101 ++ libf2c/libI77/fmtlib.c | 45 + libf2c/libI77/fp.h | 28 + libf2c/libI77/ftell_.c | 46 + libf2c/libI77/iio.c | 148 ++ libf2c/libI77/ilnw.c | 82 + libf2c/libI77/inquire.c | 108 ++ libf2c/libI77/lio.h | 74 + libf2c/libI77/lread.c | 686 ++++++++ libf2c/libI77/lwrite.c | 310 ++++ libf2c/libI77/makefile.netlib | 104 ++ libf2c/libI77/open.c | 245 +++ libf2c/libI77/rawio.h | 47 + libf2c/libI77/rdfmt.c | 476 ++++++ libf2c/libI77/rewind.c | 26 + libf2c/libI77/rsfe.c | 80 + libf2c/libI77/rsli.c | 105 ++ libf2c/libI77/rsne.c | 607 +++++++ libf2c/libI77/sfe.c | 44 + libf2c/libI77/sue.c | 87 + libf2c/libI77/typesize.c | 12 + libf2c/libI77/uio.c | 69 + libf2c/libI77/util.c | 51 + libf2c/libI77/wref.c | 276 ++++ libf2c/libI77/wrtfmt.c | 385 +++++ libf2c/libI77/wsfe.c | 85 + libf2c/libI77/wsle.c | 41 + libf2c/libI77/wsne.c | 26 + libf2c/libI77/xwsne.c | 72 + libf2c/libU77/COPYING.LIB | 481 ++++++ libf2c/libU77/Makefile.in | 144 ++ libf2c/libU77/PROJECTS | 10 + libf2c/libU77/README | 40 + libf2c/libU77/Version.c | 12 + libf2c/libU77/access_.c | 80 + libf2c/libU77/acconfig.h | 2 + libf2c/libU77/alarm_.c | 64 + libf2c/libU77/bes.c | 46 + libf2c/libU77/chdir_.c | 57 + libf2c/libU77/chmod_.c | 82 + libf2c/libU77/config.h.in | 103 ++ libf2c/libU77/configure | 1765 ++++++++++++++++++++ libf2c/libU77/configure.in | 113 ++ libf2c/libU77/ctime_.c | 57 + libf2c/libU77/date_.c | 39 + libf2c/libU77/dbes.c | 46 + libf2c/libU77/dtime_.c | 98 ++ libf2c/libU77/etime_.c | 90 ++ libf2c/libU77/fdate_.c | 53 + libf2c/libU77/fgetc_.c | 70 + libf2c/libU77/flush1_.c | 46 + libf2c/libU77/fnum_.c | 38 + libf2c/libU77/fputc_.c | 65 + libf2c/libU77/fstat_.c | 71 + libf2c/libU77/gerror_.c | 49 + libf2c/libU77/getcwd_.c | 99 ++ libf2c/libU77/getgid_.c | 41 + libf2c/libU77/getlog_.c | 71 + libf2c/libU77/getpid_.c | 35 + libf2c/libU77/getuid_.c | 41 + libf2c/libU77/gmtime_.c | 54 + libf2c/libU77/hostnm_.c | 49 + libf2c/libU77/idate_.c | 57 + libf2c/libU77/ierrno_.c | 32 + libf2c/libU77/irand_.c | 57 + libf2c/libU77/isatty_.c | 44 + libf2c/libU77/itime_.c | 51 + libf2c/libU77/kill_.c | 42 + libf2c/libU77/link_.c | 66 + libf2c/libU77/lnblnk_.c | 35 + libf2c/libU77/lstat_.c | 87 + libf2c/libU77/ltime_.c | 54 + libf2c/libU77/mclock_.c | 47 + libf2c/libU77/perror_.c | 48 + libf2c/libU77/rand_.c | 54 + libf2c/libU77/rename_.c | 56 + libf2c/libU77/secnds_.c | 51 + libf2c/libU77/second_.c | 26 + libf2c/libU77/sleep_.c | 37 + libf2c/libU77/srand_.c | 37 + libf2c/libU77/stat_.c | 79 + libf2c/libU77/symlnk_.c | 64 + libf2c/libU77/sys_clock_.c | 74 + libf2c/libU77/time_.c | 46 + libf2c/libU77/ttynam_.c | 64 + libf2c/libU77/u77-test.f | 178 ++ libf2c/libU77/umask_.c | 34 + libf2c/libU77/unlink_.c | 57 + libf2c/libU77/vxtidate_.c | 55 + libf2c/libU77/vxttime_.c | 54 + libf2c/permission.netlib | 23 + libf2c/readme.netlib | 599 +++++++ 246 files changed, 23836 insertions(+) create mode 100644 libf2c/ChangeLog create mode 100644 libf2c/ChangeLog.egcs create mode 100644 libf2c/Makefile.in create mode 100644 libf2c/README create mode 100644 libf2c/TODO create mode 100644 libf2c/changes.netlib create mode 100755 libf2c/configure create mode 100644 libf2c/configure.in create mode 100644 libf2c/disclaimer.netlib create mode 100644 libf2c/f2c.h.in create mode 100644 libf2c/f2cext.c create mode 100644 libf2c/libF77/F77_aloc.c create mode 100644 libf2c/libF77/Makefile.in create mode 100644 libf2c/libF77/Notice create mode 100644 libf2c/libF77/README.netlib create mode 100644 libf2c/libF77/Version.c create mode 100644 libf2c/libF77/abort_.c create mode 100644 libf2c/libF77/c_abs.c create mode 100644 libf2c/libF77/c_cos.c create mode 100644 libf2c/libF77/c_div.c create mode 100644 libf2c/libF77/c_exp.c create mode 100644 libf2c/libF77/c_log.c create mode 100644 libf2c/libF77/c_sin.c create mode 100644 libf2c/libF77/c_sqrt.c create mode 100644 libf2c/libF77/cabs.c create mode 100644 libf2c/libF77/d_abs.c create mode 100644 libf2c/libF77/d_acos.c create mode 100644 libf2c/libF77/d_asin.c create mode 100644 libf2c/libF77/d_atan.c create mode 100644 libf2c/libF77/d_atn2.c create mode 100644 libf2c/libF77/d_cnjg.c create mode 100644 libf2c/libF77/d_cos.c create mode 100644 libf2c/libF77/d_cosh.c create mode 100644 libf2c/libF77/d_dim.c create mode 100644 libf2c/libF77/d_exp.c create mode 100644 libf2c/libF77/d_imag.c create mode 100644 libf2c/libF77/d_int.c create mode 100644 libf2c/libF77/d_lg10.c create mode 100644 libf2c/libF77/d_log.c create mode 100644 libf2c/libF77/d_mod.c create mode 100644 libf2c/libF77/d_nint.c create mode 100644 libf2c/libF77/d_prod.c create mode 100644 libf2c/libF77/d_sign.c create mode 100644 libf2c/libF77/d_sin.c create mode 100644 libf2c/libF77/d_sinh.c create mode 100644 libf2c/libF77/d_sqrt.c create mode 100644 libf2c/libF77/d_tan.c create mode 100644 libf2c/libF77/d_tanh.c create mode 100644 libf2c/libF77/derf_.c create mode 100644 libf2c/libF77/derfc_.c create mode 100644 libf2c/libF77/dtime_.c create mode 100644 libf2c/libF77/ef1asc_.c create mode 100644 libf2c/libF77/ef1cmc_.c create mode 100644 libf2c/libF77/erf_.c create mode 100644 libf2c/libF77/erfc_.c create mode 100644 libf2c/libF77/etime_.c create mode 100644 libf2c/libF77/exit_.c create mode 100644 libf2c/libF77/f2ch.add create mode 100644 libf2c/libF77/getarg_.c create mode 100644 libf2c/libF77/getenv_.c create mode 100644 libf2c/libF77/h_abs.c create mode 100644 libf2c/libF77/h_dim.c create mode 100644 libf2c/libF77/h_dnnt.c create mode 100644 libf2c/libF77/h_indx.c create mode 100644 libf2c/libF77/h_len.c create mode 100644 libf2c/libF77/h_mod.c create mode 100644 libf2c/libF77/h_nint.c create mode 100644 libf2c/libF77/h_sign.c create mode 100644 libf2c/libF77/hl_ge.c create mode 100644 libf2c/libF77/hl_gt.c create mode 100644 libf2c/libF77/hl_le.c create mode 100644 libf2c/libF77/hl_lt.c create mode 100644 libf2c/libF77/i_abs.c create mode 100644 libf2c/libF77/i_dim.c create mode 100644 libf2c/libF77/i_dnnt.c create mode 100644 libf2c/libF77/i_indx.c create mode 100644 libf2c/libF77/i_len.c create mode 100644 libf2c/libF77/i_mod.c create mode 100644 libf2c/libF77/i_nint.c create mode 100644 libf2c/libF77/i_sign.c create mode 100644 libf2c/libF77/iargc_.c create mode 100644 libf2c/libF77/l_ge.c create mode 100644 libf2c/libF77/l_gt.c create mode 100644 libf2c/libF77/l_le.c create mode 100644 libf2c/libF77/l_lt.c create mode 100644 libf2c/libF77/lbitbits.c create mode 100644 libf2c/libF77/lbitshft.c create mode 100644 libf2c/libF77/main.c create mode 100644 libf2c/libF77/makefile.netlib create mode 100644 libf2c/libF77/pow_ci.c create mode 100644 libf2c/libF77/pow_dd.c create mode 100644 libf2c/libF77/pow_di.c create mode 100644 libf2c/libF77/pow_hh.c create mode 100644 libf2c/libF77/pow_ii.c create mode 100644 libf2c/libF77/pow_qq.c create mode 100644 libf2c/libF77/pow_ri.c create mode 100644 libf2c/libF77/pow_zi.c create mode 100644 libf2c/libF77/pow_zz.c create mode 100644 libf2c/libF77/qbitbits.c create mode 100644 libf2c/libF77/qbitshft.c create mode 100644 libf2c/libF77/r_abs.c create mode 100644 libf2c/libF77/r_acos.c create mode 100644 libf2c/libF77/r_asin.c create mode 100644 libf2c/libF77/r_atan.c create mode 100644 libf2c/libF77/r_atn2.c create mode 100644 libf2c/libF77/r_cnjg.c create mode 100644 libf2c/libF77/r_cos.c create mode 100644 libf2c/libF77/r_cosh.c create mode 100644 libf2c/libF77/r_dim.c create mode 100644 libf2c/libF77/r_exp.c create mode 100644 libf2c/libF77/r_imag.c create mode 100644 libf2c/libF77/r_int.c create mode 100644 libf2c/libF77/r_lg10.c create mode 100644 libf2c/libF77/r_log.c create mode 100644 libf2c/libF77/r_mod.c create mode 100644 libf2c/libF77/r_nint.c create mode 100644 libf2c/libF77/r_sign.c create mode 100644 libf2c/libF77/r_sin.c create mode 100644 libf2c/libF77/r_sinh.c create mode 100644 libf2c/libF77/r_sqrt.c create mode 100644 libf2c/libF77/r_tan.c create mode 100644 libf2c/libF77/r_tanh.c create mode 100644 libf2c/libF77/s_cat.c create mode 100644 libf2c/libF77/s_cmp.c create mode 100644 libf2c/libF77/s_copy.c create mode 100644 libf2c/libF77/s_paus.c create mode 100644 libf2c/libF77/s_rnge.c create mode 100644 libf2c/libF77/s_stop.c create mode 100644 libf2c/libF77/sig_die.c create mode 100644 libf2c/libF77/signal1.h create mode 100644 libf2c/libF77/signal1.h0 create mode 100644 libf2c/libF77/signal_.c create mode 100644 libf2c/libF77/system_.c create mode 100644 libf2c/libF77/z_abs.c create mode 100644 libf2c/libF77/z_cos.c create mode 100644 libf2c/libF77/z_div.c create mode 100644 libf2c/libF77/z_exp.c create mode 100644 libf2c/libF77/z_log.c create mode 100644 libf2c/libF77/z_sin.c create mode 100644 libf2c/libF77/z_sqrt.c create mode 100644 libf2c/libI77/Makefile.in create mode 100644 libf2c/libI77/Notice create mode 100644 libf2c/libI77/README.netlib create mode 100644 libf2c/libI77/Version.c create mode 100644 libf2c/libI77/backspace.c create mode 100644 libf2c/libI77/close.c create mode 100644 libf2c/libI77/dfe.c create mode 100644 libf2c/libI77/dolio.c create mode 100644 libf2c/libI77/due.c create mode 100644 libf2c/libI77/endfile.c create mode 100644 libf2c/libI77/err.c create mode 100644 libf2c/libI77/f2ch.add create mode 100644 libf2c/libI77/fio.h create mode 100644 libf2c/libI77/fmt.c create mode 100644 libf2c/libI77/fmt.h create mode 100644 libf2c/libI77/fmtlib.c create mode 100644 libf2c/libI77/fp.h create mode 100644 libf2c/libI77/ftell_.c create mode 100644 libf2c/libI77/iio.c create mode 100644 libf2c/libI77/ilnw.c create mode 100644 libf2c/libI77/inquire.c create mode 100644 libf2c/libI77/lio.h create mode 100644 libf2c/libI77/lread.c create mode 100644 libf2c/libI77/lwrite.c create mode 100644 libf2c/libI77/makefile.netlib create mode 100644 libf2c/libI77/open.c create mode 100644 libf2c/libI77/rawio.h create mode 100644 libf2c/libI77/rdfmt.c create mode 100644 libf2c/libI77/rewind.c create mode 100644 libf2c/libI77/rsfe.c create mode 100644 libf2c/libI77/rsli.c create mode 100644 libf2c/libI77/rsne.c create mode 100644 libf2c/libI77/sfe.c create mode 100644 libf2c/libI77/sue.c create mode 100644 libf2c/libI77/typesize.c create mode 100644 libf2c/libI77/uio.c create mode 100644 libf2c/libI77/util.c create mode 100644 libf2c/libI77/wref.c create mode 100644 libf2c/libI77/wrtfmt.c create mode 100644 libf2c/libI77/wsfe.c create mode 100644 libf2c/libI77/wsle.c create mode 100644 libf2c/libI77/wsne.c create mode 100644 libf2c/libI77/xwsne.c create mode 100644 libf2c/libU77/COPYING.LIB create mode 100644 libf2c/libU77/Makefile.in create mode 100644 libf2c/libU77/PROJECTS create mode 100644 libf2c/libU77/README create mode 100644 libf2c/libU77/Version.c create mode 100644 libf2c/libU77/access_.c create mode 100644 libf2c/libU77/acconfig.h create mode 100644 libf2c/libU77/alarm_.c create mode 100644 libf2c/libU77/bes.c create mode 100644 libf2c/libU77/chdir_.c create mode 100644 libf2c/libU77/chmod_.c create mode 100644 libf2c/libU77/config.h.in create mode 100755 libf2c/libU77/configure create mode 100644 libf2c/libU77/configure.in create mode 100644 libf2c/libU77/ctime_.c create mode 100644 libf2c/libU77/date_.c create mode 100644 libf2c/libU77/dbes.c create mode 100644 libf2c/libU77/dtime_.c create mode 100644 libf2c/libU77/etime_.c create mode 100644 libf2c/libU77/fdate_.c create mode 100644 libf2c/libU77/fgetc_.c create mode 100644 libf2c/libU77/flush1_.c create mode 100644 libf2c/libU77/fnum_.c create mode 100644 libf2c/libU77/fputc_.c create mode 100644 libf2c/libU77/fstat_.c create mode 100644 libf2c/libU77/gerror_.c create mode 100644 libf2c/libU77/getcwd_.c create mode 100644 libf2c/libU77/getgid_.c create mode 100644 libf2c/libU77/getlog_.c create mode 100644 libf2c/libU77/getpid_.c create mode 100644 libf2c/libU77/getuid_.c create mode 100644 libf2c/libU77/gmtime_.c create mode 100644 libf2c/libU77/hostnm_.c create mode 100644 libf2c/libU77/idate_.c create mode 100644 libf2c/libU77/ierrno_.c create mode 100644 libf2c/libU77/irand_.c create mode 100644 libf2c/libU77/isatty_.c create mode 100644 libf2c/libU77/itime_.c create mode 100644 libf2c/libU77/kill_.c create mode 100644 libf2c/libU77/link_.c create mode 100644 libf2c/libU77/lnblnk_.c create mode 100644 libf2c/libU77/lstat_.c create mode 100644 libf2c/libU77/ltime_.c create mode 100644 libf2c/libU77/mclock_.c create mode 100644 libf2c/libU77/perror_.c create mode 100644 libf2c/libU77/rand_.c create mode 100644 libf2c/libU77/rename_.c create mode 100644 libf2c/libU77/secnds_.c create mode 100644 libf2c/libU77/second_.c create mode 100644 libf2c/libU77/sleep_.c create mode 100644 libf2c/libU77/srand_.c create mode 100644 libf2c/libU77/stat_.c create mode 100644 libf2c/libU77/symlnk_.c create mode 100644 libf2c/libU77/sys_clock_.c create mode 100644 libf2c/libU77/time_.c create mode 100644 libf2c/libU77/ttynam_.c create mode 100644 libf2c/libU77/u77-test.f create mode 100644 libf2c/libU77/umask_.c create mode 100644 libf2c/libU77/unlink_.c create mode 100644 libf2c/libU77/vxtidate_.c create mode 100644 libf2c/libU77/vxttime_.c create mode 100644 libf2c/permission.netlib create mode 100644 libf2c/readme.netlib diff --git a/libf2c/ChangeLog b/libf2c/ChangeLog new file mode 100644 index 00000000000..c6c0dd3f11e --- /dev/null +++ b/libf2c/ChangeLog @@ -0,0 +1,787 @@ +Tue Sep 30 00:41:39 1997 Craig Burley + + Do a better job of printing the offending FORMAT string + when producing a diagnostic: + * libI77/err.c (f__fmtlen): New variable to hold operating + length of format string. + (f__fatal): Use new variable to limit length of printed string. + * libI77/fmt.c (f_s): Don't skip spaces after closing paren, + so nicer message results (and nested case already skips them). + (pars_f): Record operating length of format string as indicated + by a successful call to f_s, or ad-hoc-calculate it if failure, + limiting the length to 80 characters (and stopping at NUL). + (do_fio): Use new variable to limit length of printed string. + * libI77/fmt.h (f__fmtlen): Declare new variable. + * libI77/lread.c (c_le): Set new variable to known length. + +Mon Sep 29 16:30:31 1997 Craig Burley + + Update to Netlib version of 1997-09-23: + * libF77/dtime_.c (dtime_), libF77/etime_.c (dtime_): + Return `double' instead of `float' (these are not used + in g77's version of libf2c). + * libI77/fmt.c, libI77/fmt.h, libI77/rdfmt.c, libI77/wrtfmt.c: + Support machines with 64-bit pointers and 32-bit ints (e.g. + Linux on DEC Alpha). + +1997-09-19 Dave Love + + * libU77/dtime_.c (G77_dtime_0): Fix types in HAVE_GETRUSAGE case + so as not to truncate results to integer values. + +Tue Sep 9 00:33:24 1997 Craig Burley + + * Version 0.5.21 released. + +Mon Sep 8 19:39:01 1997 Craig Burley + + * libI77/close.c (f_exit): Fix thinko, inverted test + of whether initialization done, so exiting now closes + open units again. + +Tue Aug 26 01:42:21 1997 Craig Burley + + From Jim Wilson: + * configure.in: Make sure RANLIB_TEST is set also. + + From Robert Lipe : + * libU77/getcwd_.c, libU77/hostnm_.c, libU77/lstat_.c: + Also #include , to define ENOSYS. + +Tue Aug 26 01:25:58 1997 Craig Burley + + * Makefile.in (stamp-lib): Put all f2cext.c objects in + a temp directory named libE77, then `ar' them all at + once into libf2c.a, to get the job done a bit faster. + Still remove the objects (and libE77 directory) afterward. + +Sun Aug 24 05:04:35 1997 Craig Burley + + * libU77/rand_.c (G77_rand_0), libU77/dtime_.c (G77_dtime_0), + libU77/etime_.c (G77_etime_0), libU77/secnds_.c (G77_secnds_0), + libU77/second_.c (G77_second_0): Really return `double', not + `doublereal', since the result is cast to `float'. + * f2cext.c: (rand_, dtime_, etime_, secnds_, second_): Ditto. + (erf_, erfc_, besj0_, besj1_, besjn_, besy0_, besy1_, + besyn_, dbesj0_, dbesj1_, dbesjn_, dbesy0_, dbesy1_, + dbesyn_): All of these return `double', not `doublereal', + as they either have `float' or `double' results. + * libU77/bes.c (besj0_, besj1_, besjn_, besy0_, besy1_, + besyn_): Ditto. + * libU77/dbes.c (dbesj0_, dbesj1_, dbesjn_, dbesy0_, dbesy1_, + dbesyn_): Ditto. + + Update to Netlib version of 1997-08-16: + * libI77/iio.c: Fix bug in internal writes to an array + of character strings. + + * Makefile.in (UOBJ): Restore fixes made by Dan Pettet I + lost, which included the addition of mclock_.o already noted + below, plus adding symlnk_.o. + +Thu Aug 21 03:58:34 1997 Craig Burley + + * Makefile.in (UOBJ): Add mclock_.o, thanks to Mumit Khan! + +1997-08-21 Dave Love + + * libU77/alarm_.c: Fix return type: `integer'. + +Mon Aug 11 20:12:42 1997 Craig Burley + + * Makefile.in ($(lib), stamp-lib): Ensure that library + gets fully updated even if updating was aborted earlier. + + * libU77/hostnm_.c (G77_hostnm_0): Return ENOSYS and stuff + in errno if system has no gethostname() function. + + * libU77/lstat_.c (G77_lstat_0): Return ENOSYS and stuff + in errno if system has no lstat() function. + + * libU77/getcwd_.c (G77_getcwd_0): Return ENOSYS and stuff + in errno if system has no getcwd() or getwd() function. + Test HAVE_GETCWD properly. + + * libU77/symlnk_.c (G77_symlink_0): Return ENOSYS and stuff + in errno if system has no symlink() function. + + * libU77/mclock_.c (G77_mclock_0): Return -1 if system + has no clock() function. + +Mon Aug 11 01:55:36 1997 Craig Burley + + * Makefile.in (F2CEXT): Add `alarm' to this list. + + * f2cext.c (alarm_): Fix some typos in this function. + Delete third `status' argument. + + * libU77/alarm_.c: Delete third `status' argument, + as caller gets this from function result; return + status value as function result for caller. + + * configure.in: Rename `ac_cv_struct_FILE' to + `g77_cv_struct_FILE' according to 1997-06-26 change. + +1997-08-06 Dave Love + + * libU77/vxtidate_.c: Correct day/month argument order. + * f2cext.c: Likewise. + +1997-07-07 Dave Love + + * f2cext.c: Add alarm_. + + * Makefile.in, libU77/Makefile.in: Add alarm_. + + * libU77/alarm_.c: New file. + +1997-06-26 Dave Love + + * configure.in: Generally use prefix `g77_' for cached values + we've invented, not `ac_'. + +Tue Jun 24 18:50:06 1997 Craig Burley + + * libI77/ilnw.c (s_wsni): Call f_init() here. + (s_wsli): Ditto. + (e_wsli): Turn off "doing I/O" flag here. + +1997-06-20 Dave Love + + * runtime/configure.in: Check for cygwin32 after Mumit Khan (but + differently); if cygwin32 define NON_UNIX_STDIO and don't define + NON_ANSI_RW_MODES. + +Tue Jun 01 06:26:29 1997 Craig Burley + + * libI77/rsne.c (nl_init): Don't call f_init() here, + since s_rsne() already does. + (c_lir): Call f_init() here instead. + * libI77/rsli.c (e_rsli): Turn off "doing I/O" flag here. + * libI77/sue.c (e_rsue): Ditto. + +Sun Jun 22 23:27:22 1997 Craig Burley + + * libI77/fio.h (err): Mark I/O as no longer in progress + before returning a non-zero error indicator (since + that tells the caller to jump over the remaining I/O + calls, including the corresponding `e_whatever' call). + * libI77/err.c (endif): Ditto. + * libI77/sfe.c (e_wsfe): Ditto. + * libI77/lread.c (ERR): Ditto. + * libI77/lread.c (l_read): Ditto by having quad case + use ERR, not return, to return non-zero error code. + +Sat Jun 21 12:31:28 1997 Craig Burley + + * libI77/open.c (fk_open): Temporarily turn off + "doing I/O" flag during f_open() call to avoid recursive + I/O error. + +Tue Jun 17 22:40:47 1997 Craig Burley + + * err.c, close.c, rewind.c, inquire.c, backspace.c, endfile.c, + iio.c, open.c, Version.c, sfe.c, wsle.c, rsne.c, sue.c, rsfe.c, + lread.c, wsfe.c, fio.h, due.c, dfe.c: Change f__init from + `flag' to `int' and to signal not just whether initialization + has happened (bit 0), but also whether I/O is in progress + already (bit 1). Consistently produce a clear diagnostic + in cases of recursive I/O. Avoid infinite recursion in + f__fatal, in case sig_die triggers another error. Don't + output info on internals if not initialized in f__fatal. Don't + bother closing units in f_exit if initialization hasn't + happened. + +Tue Jun 10 12:57:44 1997 Craig Burley + + Update to Netlib version of 1997-06-09: + * libI77/err.c, libI77/lread.c, libI77/rdfmt.c, + libI77/wref.c: Move some #include's around. + +Mon Jun 9 18:11:56 1997 Craig Burley + + * libU77/kill_.c (kill_): KR_headers version needed + `*' in front of args in decls. + +Sun May 25 03:16:53 1997 Craig Burley + + Update to Netlib version of 1997-05-24: + * libF77/README, libF77/Version.c, libF77/main.c, + libF77/makefile, libF77/s_paus.c, libF77/signal1.h, + libF77/signal_.c, libF77/z_div.c, libI77/Notice, + libI77/README, libI77/Version.c, libI77/dfe.c, + libI77/err.c, libI77/fmt.c, libI77/makefile, + libI77/rawio.h: Apply many, but not all, of the changes + made to libf2c since last update. + * libF77/Makefile.in (MISC), Makefile.in (MISC): Rename + exit.o to exit_.o to go along with Netlib. + * libF77/signal.c: Make the prologue much simpler than + Netlib has it. + +Sun May 18 20:56:02 1997 Craig Burley + + * libU77/unlink_.c, libU77/stat_.c, libU77/symlnk_.c, + libU77/chmod_.c: g_char first arg is const. + + * libU77/chmod_.c: s_cat expects ftnlen[], not int[] or + integer[], change types of array and variables + accordingly. + +May 7 1997 Daniel Pettet + + * libU77/dbes_.c: Commented out the code in the + same way the bes* routines are commented out. This + was done because corresponding C routines are referenced + directly in com-rt.def. + +Mon May 5 13:56:02 1997 Craig Burley + + * libU77/stat_.c: Reverse KR/ANSI decls of g_char(). + +Apr 18 1997 Daniel Pettet + + * libF77/F77_aloc.c, libF77/abort_.c, libF77/derf_.c, + libF77/derfc_.c, libF77/ef1asc_.c, libF77/ef1cmc_.c, + libF77/erf_.c, libF77/erfc_.c, libF77/exit.c, + libF77/getarg_.c, libF77/getenv_.c, libF77/iargc_.c, + libF77/s_cat.c, libF77/signal_.c, libF77/system_.c, + libI77/close.c, libI77/ftell_.c, libU77/access_.c, + libU77/bes.c, libU77/chdir_.c, libU77/chmod_.c, libU77/ctime_.c, + libU77/date_.c, libU77/dbes.c, libU77/dtime_.c, libU77/etime_.c, + libU77/fdate_.c, libU77/fgetc_.c, libU77/flush1_.c, + libU77/fnum_.c, libU77/fputc_.c, libU77/fstat_.c, + libU77/gerror_.c, libU77/getcwd_.c, libU77/getgid_.c, + libU77/getlog_.c, libU77/getpid_.c, libU77/getuid_.c, + libU77/gmtime_.c, libU77/hostnm_.c, libU77/idate_.c, + libU77/ierrno_.c, libU77/irand_.c, libU77/isatty_.c, + libU77/itime_.c, libU77/kill_.c, libU77/link_.c, + libU77/lnblnk_.c, libU77/ltime_.c, libU77/mclock_.c, + libU77/perror_.c, libU77/rand_.c, libU77/rename_.c, + libU77/secnds_.c, libU77/second_.c, libU77/sleep_.c, + libU77/srand_.c, libU77/stat_.c, libU77/symlnk_.c, + libU77/system_clock_.c, libU77/time_.c, libU77/ttynam_.c, + libU77/umask_.c, libU77/unlink_.c, libU77/vxtidate_.c, + libU77/vxttime_.c: Completed renaming routines that are directly + callable from g77 to internal names of the form + G77_xxxx_0 that are known as intrinsics by g77. + +Apr 8 1997 Daniel Pettet + + * Makefile.in: Add libU77/mclock_.o and libU77/symlnk_.o to UOBJ. + * libU77/Makefile.in: Add mclock_.c to SRCS. + Add mclock_.o and symlnk_.o to OBJS. + Add mclock_.o dependency. + +Apr 8 1997 Daniel Pettet + + * libU77/symlnk_.c: Added a couple of (char*) casts to malloc + to silence the compiler. + +1997-03-17 Dave Love + + * libU77/access_.c, libU77/chdir_.c, libU77/chmod_.c, + libU77/link_.c, libU77/lstat_.c, libU77/rename_.c, libU77/stat_.c, + libU77/symlnk_.c, libU77/u77-test.f, libU77/unlink_.c: Strip + trailing blanks from file names for consistency with other + implementations (notably Sun's). + + * libU77/chmod_.c: Quote the file name given to the shell. + +Mon Mar 10 00:19:17 1997 Craig Burley + + * libI77/uio.c (do_ud) [PAD_UDread]: Add semicolon to err() + invocation when macro not defined (from Mumit Khan + ). + +Fri Feb 28 13:16:50 1997 Craig Burley + + * Version 0.5.20 released. + +Wed Feb 26 20:28:53 1997 Craig Burley + + * Makefile.in: $(MAKE) invocations now explicitly + specify `-f Makefile', just in case the `makefile's + from the netlib distribution would get used instead. + +Mon Feb 24 16:43:39 1997 Craig Burley + + * libU77/Makefile.in (check): Specify driver, and + don't bother enabling already-enabled intrinsic groups. + Also, get the $(srcdir) version of u77-test.f. + +Sat Feb 22 14:08:42 1997 Craig Burley + + * libU77/u77-test.f: Explicitly declare intrinsics, get + rid of useless CHARACTER declarations on intrinsics (maybe + someday appropriate to implement meaning of that in g77 + and restore them?). + Add spin loop just to fatten up the timings a bit. + Clarify ETIME output as having three fields. + Call TIME with CHARACTER*8, not CHARACTER*6, argument. + Call new SECOND intrinsic subroutine, after calling + new DUMDUM subroutine just to ensure the correct value + doesn't get left around in a register or something. + +Thu Feb 20 15:22:42 1997 Craig Burley + + * libU77/bes.c: Comment out all the code, as g77 avoids actually + calling it, going directly to the system's library instead. + +Mon Feb 17 02:27:41 1997 Craig Burley + + * libU77/fgetc_.c (fgetc_): Allow return value to be + CHARACTER*(*), properly handle CHARACTER*0 and blank-pad + CHARACTER*n where n>1. + +Tue Feb 11 14:12:19 1997 Craig Burley + + * Makefile.in: Clarify role of $(srcdir) here. Fix + various targets accordingly. Don't rely at all on + gcc/f/include/ being a link to gcc/include/ -- just + use it directly. + (${srcdir}/configure, ${srcdir}/libU77/configure): + Remove the config.cache files in build directory before + cd'ing to source directory as well. + + * libF77/Makefile.in, libI77/Makefile.in (ALL_CFLAGS): + Include `-I.' to pick up build directory. + Use gcc/include/ directly. + * libU77/Makefile.in (ALL_CFLAGS): Include `-I$(srcdir)' + to pick up source directory. + (OBJS): Fix typo in `chmod_.o' (was `chmod.o'). + +Mon Feb 10 12:54:47 1997 Craig Burley + + * Makefile.in (UOBJ), libU77/Makefile.in (OBJS): Add + libU77/chmod_.o to list of objects. + * libU77/chmod_.c: Fix up headers. + Fix implementation to not prematurely truncate command + string and make room for trailing null. + + * libU77/ctime_.c: Incoming xstime argument is now longint. + * libU77/mclock_.c: Now returns longint. + * libU77/time_.c: Now returns longint. + +1997-02-10 Dave Love + + * etime_.c, dtime_.c: Typo rounded times to seconds. + + * date_.c: Add missing return. + + * hostnm_.c: #include unistd.h. + +Sat Feb 8 03:30:19 1997 Craig Burley + + INTEGER*8 support built in to f2c.h and libf2c (since + gcc will be used to compile relevant code anyway): + * Makefile.in, libF77/Makefile.in: Add pow_qq.o, + qbitbits.o, and qbitshft.o to $POW and $F90BIT macros, + as appropriate. + * f2c.h.in: Define appropriate types and macros. + Place #error directive correctly. + * configure.in: Determine appropriate types for long + integer (F2C_LONGINT). + Meanwhile, quote strings in #error, for consistency. + Fix restoring of ac_cpp macro. + * configure: Regenerated using autoconf-2.12. + + * libF77/Version.c, libI77/Version.c, libU77/Version.c: + Update version numbers. + Change names and code for g77-specific version-printing + routines (shorter names should be safer to link on + weird, 8-char systems). + + * libF77/c_cos.c, libF77/c_div.c, libF77/c_exp.c, + libF77/c_log.c, libF77/c_sin.c, libF77/c_sqrt.c, + libF77/d_cnjg.c, libF77/pow_zi.c, libF77/r_cnjg.c, + libF77/z_cos.c, libF77/z_div.c, libF77/z_exp.c, + libF77/z_log.c, libF77/z_sin.c, libF77/z_sqrt.c: + Changed to work properly even when result is aliased + with any inputs. + + * libF77/makefile, libI77/makefile: Leave these in + the g77 distribution, so it is easier to track changes + to official libf2c. + + * libF77/signal_.c: Eliminate redundant `return 0;'. + + * libI77/fio.h (err, errfl): Fix these so they work + (and must be expressed) as statements. + Fix up many users of err() to include trailing semicolon. + + * Incorporate changes by Bell Labs to libf2c through 1997-02-07. + +1997-02-06 Dave Love + + * libU77/etime_.c, libU77/dtime_.c: Fix getrusage stuff. + + * libU77/config.h.in: Regenerate for HAVE_GETRUSAGE. + + * libU77/Makefile.in, libI77/Makefile.in, libF77/Makefile.in: + Redo *clean targets; distclean and maintainer-clean remove the stage? + and include links. This probably want looking at further. + +Wed Feb 5 00:21:23 1997 Craig Burley + + Add libU77 library from Dave Love : + * Makefile.in: Add libU77 directory, rules, etc. + * configure.in: New libU77 directory, Makefile, etc. + + * Makefile.in, libF77/Makefile.in, libI77/Makefile.in, + libU77/Makefile.in: Reorganize these so $(AR) commands + handled by the top-level Makefile instead of the + subordinates. This permits it to do $(AR) only when + one or more object files actually change, instead of + having to force-update it as was necessary before. + And that had the disadvantage of requiring, e.g., user + root to have access to $(AR) to the library simply to + install g77, which might be problematic on an NFS setup. + (mostlyclean, clean, distclean, maintainer-clean): + Properly handle these rules. + + * Makefile.in: Don't invoke config.status here -- let + compiler-level stuff handle all that. + + * err.c [MISSING_FILE_ELEMS]: Declare malloc in this case + too, so it doesn't end up as an integer. + +Sat Feb 1 02:43:48 1997 Craig Burley + + * libF77/Makefile.in: More fixup for $(F90BIT) -- wasn't + in list for ar command, and it wasn't correctly listed + in the list of things depending on f2c.h. + + * f2c.h.in: Fix up #error directive. + +1997-01-31 Dave Love + + * libF77/Makefile.in ($(lib)): Add $(F90BIT); shouldn't exclude + stuff f2c needs so we can share the library. + +Sat Jan 18 19:39:03 1997 Craig Burley + + * configure.in: No longer define ALWAYS_FLUSH, the + resulting performance is too low. + +Wed Dec 18 12:06:02 1996 Craig Burley + + Patch from Mumit Khan : + * libF77/s_paus.c: Add __CYGWIN32__ to list of macros + controlling how to pause. + +Sun Dec 1 21:25:27 1996 Craig Burley + + * configure: Regenerated using autoconf-2.12. + +Mon Nov 25 21:16:15 1996 Craig Burley + + * configure: Regenerated using autoconf-2.11. + +1996-11-19 Dave Love + + * libI77/backspace.c: Include sys/types.h for size_t. + +Wed Nov 6 14:17:27 1996 Craig Burley + + * f2c.h.in: Properly comment out the unsupported stuff so + we don't get build-time errors. + + * libF77/Version.c, libI77/Version.c: Restore macro definition + of version information. + + * libI77/Makefile.in (OBJ): Add ftell_.o to list of objects. + + * libI77/uio.c (do_ud): Fix up casts in PAD_UDread case just + like they were fixed in the other case. + +Thu Oct 31 22:27:45 1996 Craig Burley + + * libI77/ftell_.c (fseek_): Map incoming whence argument to + system's actual SEEK_CUR, SEEK_SET, or SEEK_END macro for + fseek(), and crash (gracefully) if the argument is invalid. + +1996-10-19 Dave Love + + * configure.in: Add check that we have the tools to cross-compile + if appropriate. + (NO_EOF_CHAR_CHECK,Skip_f2c_Undefs): Define. + + * libF77/Makefile.in (F90BIT): New routines from Netlib. + + * f2c.h.in: + Use more sanitary #error (indented for K&R compliance if necessary) if + f2c_i2 defined. + Sync with Netlib: Add `uninteger'. (Commented out) integer*8 stuff. + bit_{test,clear,set} macros. + +1996-10-19 Dave Love + + Update to Netlib version of 1996-09-26. + + * libI77/Version.c: Use , not "stdio.h". + * libF77/Version.c: Likewise. + +Wed Aug 28 13:25:29 1996 Dave Love + + * libI77/rsne.c (x_rsne): Use size_t instead of int. + + * libI77/endfile.c (copy): Use size_t in place of int. + +Wed Aug 28 13:22:20 1996 Dave Love + + * libI77/backspace.c (f_back): Cast fread arg to size_t. + +Tue Aug 27 19:11:30 1996 Dave Love + + * libI77/Version.c: Supply */ to avoid apparent nested comment. + +Tue Aug 20 09:21:43 1996 Dave Love + + * libF77/Makefile.in (ALL_CFLAGS): Fix missing ../ for include. + * libI77/Makefile.in (ALL_CFLAGS): Likewise. + +Sat Aug 17 13:00:47 1996 Dave Love + + * (libF77/qbitshft.c, libF77/qbitbits.c, libF77/lbitshft.c, + libF77/lbitbits.c): New file from Netlib. qbit... not currently + compiled. + +Sun Jul 7 18:06:33 1996 Dave Love + + * libF77/z_sqrt.c, libF77/z_sin.c, libF77/z_exp.c, libF77/z_log.c, + libF77/system_.c, libF77/z_cos.c, libF77/signal_.c, + libF77/s_stop.c, libF77/sig_die.c, libF77/s_paus.c, + libF77/s_rnge.c, libF77/s_cat.c, libF77/r_tan.c, libF77/r_tanh.c, + libF77/r_sinh.c, libF77/r_sqrt.c, libF77/r_sin.c, libF77/r_mod.c, + libF77/r_nint.c, libF77/r_lg10.c, libF77/r_log.c, libF77/r_exp.c, + libF77/r_int.c, libF77/r_cosh.c, libF77/r_atn2.c, libF77/r_cos.c, + libF77/r_asin.c, libF77/r_atan.c, libF77/r_acos.c, + libF77/pow_dd.c, libF77/pow_zz.c, libF77/main.c, libF77/i_dnnt.c, + libF77/i_nint.c, libF77/h_dnnt.c, libF77/h_nint.c, libF77/exit.c, + libF77/d_tan.c, libF77/d_tanh.c, libF77/d_sqrt.c, libF77/d_sin.c, + libF77/d_sinh.c, libF77/d_mod.c, libF77/d_nint.c, libF77/d_log.c, + libF77/d_int.c, libF77/d_lg10.c, libF77/d_cosh.c, libF77/d_exp.c, + libF77/d_atn2.c, libF77/d_cos.c, libF77/d_atan.c, libF77/d_acos.c, + libF77/d_asin.c, libF77/c_sqrt.c, libF77/cabs.c, libF77/c_sin.c, + libF77/c_exp.c, libF77/c_log.c, libF77/c_cos.c, libF77/F77_aloc.c, + libF77/abort_.c, libI77/xwsne.c, libI77/wref.c, libI77/util.c, + libI77/uio.c, libI77/rsne.c, libI77/rdfmt.c, libI77/rawio.h, + libI77/open.c, libI77/lread.c, libI77/inquire.c, libI77/fio.h, + libI77/err.c, libI77/endfile.c, libI77/close.c: + Use #include <...>, not #include "..." for mkdeps + +Sat Jul 6 21:39:21 1996 Dave Love + + * libI77/ftell_.c: Added from Netlib distribution. + +Sat Mar 30 20:57:24 1996 Dave Love + + * configure.in: Eliminate explicit use of + {RANLIB,AR}_FOR_TARGET. + * Makefile.in: Likewise. + * libF77/Makefile.in: Likewise. + * libI77/Makefile.in: Likewise. + * configure: Regenerated. + +Sat Mar 30 21:02:03 1996 Dave Love + + * Makefile.in: Eliminate explicit use of + {RANLIB,AR}_FOR_TARGET. + +Tue Mar 26 23:39:59 1996 Dave Love + + * Makefile.in: Remove hardwired RANLIB and RANLIB_TEST (unnoted + change). + +Mon Mar 25 21:04:56 1996 Craig Burley + + * Incorporate changes by Bell Labs to libf2c through 1996-03-23, + including changes to dmg and netlib email addresses. + +Tue Mar 19 13:10:02 1996 Craig Burley + + * Incorporate changes by AT&T/Bellcore to libf2c through 1996-03-19. + + * Makefile.in (rebuilt): New target. + + * lib[FI]77/Makefile.in: Use $AR_FOR_TARGET, not $AR. + +Tue Mar 19 12:53:19 1996 Dave Love + + * configure.in (ac_cpp): #include instead + of . + +Tue Mar 19 12:52:09 1996 Mumit Khan + + * configure.in (ac_cpp): For f2c integer type, + add -I$srcdir/../.. to make it work on mips-ultrix4.2. + +Sat Mar 9 17:37:15 1996 Craig Burley + + * libI77/Makefile.in (.c.o): Add -DAllow_TYQUAD, to enable + I/O support for INTEGER*8. + * f2c.h.in: Turn on longint type. + +Fri Dec 29 18:22:01 1995 Craig Burley + + * Makefile.in: Reorganize the *clean rules to more closely + parallel gcc's. + + * lib[FI]77/Makefile.in: Ignore error from $(AR) command, + in case just doing an install and installer has no write + access to library (this is a kludge fix -- perhaps install + targets should never try updating anything?). + +Sat Nov 18 19:37:22 1995 Craig Burley (burley@gnu.ai.mit.edu) + + * Version 0.5.17 released. + +Thu Nov 16 07:20:35 1995 Craig Burley (burley@gnu.ai.mit.edu) + + * Incorporate changes by AT&T/Bellcore to libf2c through 1995-11-15. + +Fri Sep 22 02:19:59 1995 Craig Burley (burley@gnu.ai.mit.edu) + + * libI77/backspace.c, libI77/close.c, libI77/endfile.c, + libI77/fio.h, libI77/inquire.c, libI77/rawio.h, + libF77/s_paus.c: Not an MSDOS system if GO32 + is defined, in the sense that the run-time environment + is thus more UNIX-like. + +Wed Sep 20 02:24:51 1995 Craig Burley (burley@gnu.ai.mit.edu) + + * libF77/Makefile.in, libI77/Makefile.in: Comment out `ld -r -x' + and `mv' line pairs, since `-x' isn't supported on systems + such as Solaris, and these lines don't seem to do anything + useful after all. + +Wed Aug 30 15:58:35 1995 Craig Burley (burley@gnu.ai.mit.edu) + + * Version 0.5.16 released. + + * Incorporate changes by AT&T/Bellcore to libf2c through 950829. + +Mon Aug 28 12:50:34 1995 Craig Burley (burley@gnu.ai.mit.edu) + + * libF77/Makefile.in, libI77/Makefile.in ($(lib)): Force ar'ing + and ranlib'ing of libf2c.a, else after rm'ing libf2c.a and + doing a make, only libI77 or libF77 would be added to + the newly created archive. + Also, instead of `$?' list all targets explicitly so all + objects are updated in libf2c.a even if only one actually + needs recompiling, for similar reason -- we can't easily tell + if a given object is really up-to-date in libf2c.a, or even + present there. + +Sun Aug 27 14:54:24 1995 Craig Burley (burley@gnu.ai.mit.edu) + + * libF77/Makefile.in, libI77/Makefile.in: Fix spacing so + initial tabs are present in all appropriate places. + Move identical $(AR) commands in if then/else clauses + to single command preceding if. + (.c.o, Version[FI].o): Use $@ instead of $* because AIX (RS/6000) + says $@ means source, not object, basename, and $@ seems to work + everywhere. + +Wed Aug 23 15:44:25 1995 Craig Burley (burley@gnu.ai.mit.edu) + + * libF77/system_.c (system_): Declare as returning `ftnint', + consistent with signal_, instead of defaulting to `int'. + Hope dmg@research.att.com agrees, else probably will + change to whatever he determines is correct (and change + g77 accordingly). + +Thu Aug 17 08:46:17 1995 Craig Burley (burley@gnu.ai.mit.edu) + + * libI77/rsne.c (s_rsne): Call f_init if not already done. + +Thu Aug 17 04:35:28 1995 Craig Burley (burley@gnu.ai.mit.edu) + + * Incorporate changes by Bellcore to libf2c through 950817. + And this text is for EMACS: (foo at bar). + +Wed Aug 16 17:33:06 1995 Craig Burley (burley@gnu.ai.mit.edu) + + * libF77/Makefile.in, libI77/Makefile.in (CFLAGS): Put -g1 + after configured CFLAGS but before GCC_CFLAGS, so by default + the libraries are built with minimal debugging information. + +Fri Jul 28 10:30:15 1995 Dave Love + + * libI77/open.c (f_open): Call f_init if not already done. + +Sat Jul 1 19:31:56 1995 Craig Burley (burley@gnu.ai.mit.edu) + + * libF77/system_.c (system_): Make buff one byte bigger so + following byte doesn't get overwritten by call with large + string. + +Tue Jun 27 23:28:16 1995 Craig Burley (burley@gnu.ai.mit.edu) + + * Incorporate changes by Bellcore to libf2c through 950613. + + * libF77/Version.c (__G77_LIBF77_VERSION__): Add this string + to track g77 mods to libf2c. + + * libI77/Version.c (__G77_LIBI77_VERSION__): Add this string + to track g77 mods to libf2c. + + * libI77/rawio.h: #include only conditionally, + using macro intended for that purpose. + +Fri May 19 11:20:00 1995 Craig Burley (burley@gnu.ai.mit.edu) + + * configure.in: Incorporate change made by d.love, + + * configure: Regenerated. + +Wed Apr 26 21:08:57 BST 1995 Dave Love + + * configure.in: Fix quoting problem in atexit check. + + * configure: Regenerated (with current autoconf). + +Wed Mar 15 12:49:58 1995 Craig Burley (burley@gnu.ai.mit.edu) + + * Incorporate changes by Bellcore to libf2c through 950315. + +Sun Mar 5 18:54:29 1995 Craig Burley (burley@gnu.ai.mit.edu) + + * README: Tell people not to read lib[fi]77/README. + +Wed Feb 15 14:30:58 1995 Craig Burley (burley@gnu.ai.mit.edu) + + * configure.in: Update copyright notice at top of file. + + * f2c.h.in (f2c_i2): Make sure defining this crashes compilations. + + * libI77/Makefile.in (F2C_H): Fix typo in definition of this + symbol (was FF2C_H=...). + +Sun Feb 12 13:39:36 1995 Craig Burley (burley@gnu.ai.mit.edu) + + * README: Remove some obsolete items. + Add date. + + * TODO: Add date. + +Sat Feb 11 22:07:54 1995 Craig Burley (burley@gnu.ai.mit.edu) + + * Makefile.in (libf77, libi77): Add rules to .PHONY list. + + * f2c.h.in (flag): Make same type as friends. + + * libF77/Makefile.in (libf77): Rename to $(lib), remove from + .PHONY list. Fix some typos. + + * libI77/Makefile.in (libi77): Rename to $(lib), remove from + .PHONY list. Fix some typos. + +Thu Feb 2 12:22:41 1995 Craig Burley (burley@gnu.ai.mit.edu) + + * Makefile.in (libF77/Makefile): Fix typos in this rule's name + and dependencies. + + * libF77/Makefile.in (libf77): Add rule to .PHONY list. + + * libI77/Makefile.in (libi77): Add rule to .PHONY list. diff --git a/libf2c/ChangeLog.egcs b/libf2c/ChangeLog.egcs new file mode 100644 index 00000000000..a37b6e62265 --- /dev/null +++ b/libf2c/ChangeLog.egcs @@ -0,0 +1,108 @@ +Sun Feb 1 02:36:33 1998 Richard Henderson + + * Previous contents of gcc/f/runtime moved into toplevel + "libf2c" directory. + +Sun Feb 1 01:42:47 1998 Mumit Khan + + * libU77/configure.in (getlogin,getgid,getuid, kill,link,ttyname): + Check. + * libU77/config.h.in (HAVE_GETLOGIN, HAVE_GETGID, HAVE_GETUID, + HAVE_KILL, HAVE_LINK, HAVE_TTYNAME): New defs. + * libU77/getlog_.c: Conditionalize for target platform. Set errno + to ENOSYS if target libc doesn't have the function. + * libU77/getgid_.c: Likewise. + * libU77/getuid_.c: Likewise. + * libU77/kill_.c: Likewise. + * libU77/link_.c: Likewise. + * libU77/ttynam_.c: Likewise. + +Sun Jan 18 20:01:37 1998 Toon Moene + + * libI77/backspace.c: (f_back): Use type `uiolen' to determine size + of record length specifier. + +Sat Jan 17 22:40:31 1998 Mumit Khan + + * libU77/configure.in (sys/param.h,sys/times.h): Check. + (times,alarm): Likewise. + * libU77/config.h.in (HAVE_SYS_PARAM_H, HAVE_SYS_TIMES_H, + HAVE_ALARM, HAVE_TIMES): New defs. + * libU77/alarm_.c: Conditionalize for target platform. Set errno + to ENOSYS if target libc doesn't have the function. + * libU77/dtime_.c: Likewise. + * libU77/etime_.c: Likewise. + * libU77/sys_clock_.c: Likewise. + + * configure.in (NON_UNIX_STDIO): Define if MINGW32. + (NON_ANSI_RW_MODE): Do not define for CYGWIN32 or MINGW32. + + * libI77/rawio.h: Don't providing conflicting declarations for + read() and write(). MINGW32 header files use "const" quals. + + * libF77/s_paus.c: _WIN32 does not have pause(). + +Tue Nov 18 09:49:04 1997 Mumit Khan (khan@xraylith.wisc.edu) + + * libI77/close.c (f_exit): Reset f__init so that f_clos does not + (incorrectly) think there is an I/O recursion when program is + interrupted. + +Sat Nov 1 18:03:42 1997 Jeffrey A Law (law@cygnus.com) + + * libF77/signal_.c: Undo last change until we can fix it right. + +Wed Oct 15 10:06:29 1997 Richard Henderson + + * libF77/signal_.c (G77_signal_0): Make return type sig_pf as well. + * libI77/fio.h: Include if STDC_HEADERS. + * libU77/chmod_.c: Likewise. + +Tue Oct 7 18:22:10 1997 Richard Henderson + + * Makefile.in (CGFLAGS): Don't force -g0. + * libF77/Makefile.in, libI77/Makefile.in, libU77/Makefile.in: Likewise. + +Mon Oct 6 14:16:46 1997 Jeffrey A Law (law@cygnus.com) + + * Makefile.in (distclean): Do a better job at cleaning up. + +Wed Oct 1 01:46:16 1997 Philippe De Muyter + + * libU77/sys_clock_.c: File renamed from system_clock_.c. + libU77/Makefile.in, Makefile.in : Reference sys_clock_.*, not + system_clock_.*. + * libU77/dtime_.c (clk_tck): Try also HZ macro. + * libU77/access.c (G77_access_0): Check malloc return value against 0, + not NULL. + libU77/getlog_.c, libU77/ttynam_.c, libU77/chdir_.c: Ditto. + libU77/chmod_.c, libU77/rename_.c: Ditto. + +1997-09-19 Dave Love + + * libU77/dtime_.c (G77_dtime_0): Fix types in HAVE_GETRUSAGE case + so as not to truncate results to integer values. + * libU77/Version.c: Bump. + +Thu Sep 18 16:58:46 1997 Jeffrey A Law (law@cygnus.com) + + * Makefile.in (stamp-lib): Don't use '$?', explicitly + list the variables containing the object files to include + in libf2c.a + +Fri Sep 5 00:18:17 1997 Jeffrey A Law (law@cygnus.com) + + * Makefile.in (clean): Don't remove config.cache. + (distclean): Do it here instead. + +Tue Aug 26 20:14:08 1997 Robert Lipe (robertl@dgii.com) + + * hostnm_.c: Include errno.h + +Mon Aug 25 23:26:05 1997 H.J. Lu (hjl@gnu.ai.mit.edu) + + * Makefile.in (mostlyclean, clean): Check if Makefile exists + before using it. Remove stamp-*. + (stamp-libi77, stamp-libf77, stamp-libu77): New. + (stamp-lib): Only depend on stamp-libi77 stamp-libf77 + stamp-libu77 diff --git a/libf2c/Makefile.in b/libf2c/Makefile.in new file mode 100644 index 00000000000..709a71866c4 --- /dev/null +++ b/libf2c/Makefile.in @@ -0,0 +1,228 @@ +# Makefile for GNU F77 compiler runtime. +# Copyright (C) 1995-1997 Free Software Foundation, Inc. +# Contributed by Dave Love (d.love@dl.ac.uk). +# +#This file is part of GNU Fortran. +# +#GNU Fortran is free software; you can redistribute it and/or modify +#it under the terms of the GNU General Public License as published by +#the Free Software Foundation; either version 2, or (at your option) +#any later version. +# +#GNU Fortran is distributed in the hope that it will be useful, +#but WITHOUT ANY WARRANTY; without even the implied warranty of +#MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +#GNU General Public License for more details. +# +#You should have received a copy of the GNU General Public License +#along with GNU Fortran; see the file COPYING. If not, write to +#the Free Software Foundation, 59 Temple Place - Suite 330, Boston, MA +#02111-1307, USA. + +SHELL = /bin/sh + +#### Start of system configuration section. #### + +srcdir = @srcdir@ +prefix = @prefix@ +exec_prefix = @exec_prefix@ + +bindir = $(exec_prefix)/bin +libdir = $(exec_prefix)/lib +datadir = $(prefix)/lib +mandir = $(prefix)/man +infodir = $(prefix)/info +includedir = $(prefix)/include +docdir = $(datadir)/doc + +TO_TOPDIR = .. + +INSTALL = $(srcdir)/$(TO_TOPDIR)/install-sh -c +INSTALL_PROGRAM = $(INSTALL) +INSTALL_DATA = $(INSTALL) + +AR = `if test -f $(TO_TOPDIR)/binutils/ar; then \ + echo $(TO_TOPDIR)/binutils/ar; else echo ar; fi` +AR_FLAGS = rc + +RANLIB = `if test -f $(TO_TOPDIR)/binutils/ranlib; then \ + echo $(TO_TOPDIR)/binutils/ranlib; else echo ranlib; fi` + +MAKEINFO = `if test -f $(TO_TOPDIR)/texinfo/C/makeinfo; then \ + echo $(TO_TOPDIR)/texinfo/C/makeinfo; else echo makeinfo; fi` + +CC = gcc +CFLAGS = -g +LIBCFLAGS = $(CFLAGS) + +# List of variables to pass to sub-makes. This should not be needed' +# by GNU make or Sun make (both of which pass command-line variable' +# overrides thouh $(MAKE)) but may be needed by older versions.' + +FLAGS_TO_PASS= \ + "SHELL=$(SHELL)" \ + "INSTALL=$(INSTALL)" \ + "INSTALL_DATA=$(INSTALL_DATA)" \ + "INSTALL_PROGRAM=$(INSTALL_PROGRAM)" \ + "prefix=$(prefix)" \ + "exec_prefix=$(exec_prefix)" \ + "tooldir=$(tooldir)" \ + "AR=$(AR)" \ + "AR_FLAGS=$(AR_FLAGS)" \ + "CC=$(CC)" \ + "CFLAGS=$(CFLAGS)" \ + "RANLIB=$(RANLIB)" \ + "LIBCFLAGS=$(LIBCFLAGS)" \ + "PICFLAG=$(PICFLAG)" \ + "RUNTESTFLAGS=$(RUNTESTFLAGS)" + + +lib = libf2c.a + +MISC = libF77/F77_aloc.o libF77/VersionF.o libF77/main.o libF77/s_rnge.o \ + libF77/abort_.o libF77/getarg_.o libF77/iargc_.o libF77/getenv_.o \ + libF77/signal_.o libF77/s_stop.o libF77/s_paus.o libF77/system_.o \ + libF77/cabs.o libF77/derf_.o libF77/derfc_.o libF77/erf_.o \ + libF77/erfc_.o libF77/sig_die.o libF77/exit_.o +POW = libF77/pow_ci.o libF77/pow_dd.o libF77/pow_di.o libF77/pow_hh.o \ + libF77/pow_ii.o libF77/pow_ri.o libF77/pow_zi.o libF77/pow_zz.o \ + libF77/pow_qq.o +CX = libF77/c_abs.o libF77/c_cos.o libF77/c_div.o libF77/c_exp.o \ + libF77/c_log.o libF77/c_sin.o libF77/c_sqrt.o +DCX = libF77/z_abs.o libF77/z_cos.o libF77/z_div.o libF77/z_exp.o \ + libF77/z_log.o libF77/z_sin.o libF77/z_sqrt.o +REAL = libF77/r_abs.o libF77/r_acos.o libF77/r_asin.o libF77/r_atan.o \ + libF77/r_atn2.o libF77/r_cnjg.o libF77/r_cos.o libF77/r_cosh.o \ + libF77/r_dim.o libF77/r_exp.o libF77/r_imag.o libF77/r_int.o \ + libF77/r_lg10.o libF77/r_log.o libF77/r_mod.o libF77/r_nint.o \ + libF77/r_sign.o libF77/r_sin.o libF77/r_sinh.o libF77/r_sqrt.o \ + libF77/r_tan.o libF77/r_tanh.o +DBL = libF77/d_abs.o libF77/d_acos.o libF77/d_asin.o libF77/d_atan.o \ + libF77/d_atn2.o libF77/d_cnjg.o libF77/d_cos.o libF77/d_cosh.o \ + libF77/d_dim.o libF77/d_exp.o libF77/d_imag.o libF77/d_int.o \ + libF77/d_lg10.o libF77/d_log.o libF77/d_mod.o libF77/d_nint.o \ + libF77/d_prod.o libF77/d_sign.o libF77/d_sin.o libF77/d_sinh.o \ + libF77/d_sqrt.o libF77/d_tan.o libF77/d_tanh.o +INT = libF77/i_abs.o libF77/i_dim.o libF77/i_dnnt.o libF77/i_indx.o \ + libF77/i_len.o libF77/i_mod.o libF77/i_nint.o libF77/i_sign.o +HALF = libF77/h_abs.o libF77/h_dim.o libF77/h_dnnt.o libF77/h_indx.o \ + libF77/h_len.o libF77/h_mod.o libF77/h_nint.o libF77/h_sign.o +CMP = libF77/l_ge.o libF77/l_gt.o libF77/l_le.o libF77/l_lt.o \ + libF77/hl_ge.o libF77/hl_gt.o libF77/hl_le.o libF77/hl_lt.o +EFL = libF77/ef1asc_.o libF77/ef1cmc_.o +CHAR = libF77/s_cat.o libF77/s_cmp.o libF77/s_copy.o +F90BIT = libF77/lbitbits.o libF77/lbitshft.o libF77/qbitbits.o \ + libF77/qbitshft.o +FOBJ = $(MISC) $(POW) $(CX) $(DCX) $(REAL) $(DBL) $(INT) $(HALF) $(CMP) \ + $(EFL) $(CHAR) $(F90BIT) + +IOBJ = libI77/VersionI.o libI77/backspace.o libI77/close.o libI77/dfe.o \ + libI77/dolio.o libI77/due.o libI77/endfile.o libI77/err.o \ + libI77/fmt.o libI77/fmtlib.o libI77/iio.o libI77/ilnw.o \ + libI77/inquire.o libI77/lread.o libI77/lwrite.o libI77/open.o \ + libI77/rdfmt.o libI77/rewind.o libI77/rsfe.o libI77/rsli.o \ + libI77/rsne.o libI77/sfe.o libI77/sue.o libI77/typesize.o \ + libI77/uio.o libI77/util.o libI77/wref.o libI77/wrtfmt.o \ + libI77/wsfe.o libI77/wsle.o libI77/wsne.o libI77/xwsne.o \ + libI77/ftell_.o + +UOBJ = libU77/VersionU.o libU77/gerror_.o libU77/perror_.o libU77/ierrno_.o \ + libU77/itime_.o libU77/time_.o libU77/unlink_.o libU77/fnum_.o \ + libU77/getpid_.o libU77/getuid_.o libU77/getgid_.o libU77/kill_.o \ + libU77/rand_.o libU77/srand_.o libU77/irand_.o libU77/sleep_.o \ + libU77/idate_.o libU77/ctime_.o libU77/etime_.o libU77/dtime_.o \ + libU77/isatty_.o libU77/ltime_.o libU77/fstat_.o libU77/stat_.o \ + libU77/lstat_.o libU77/access_.o libU77/link_.o libU77/getlog_.o \ + libU77/ttynam_.o libU77/getcwd_.o libU77/vxttime_.o \ + libU77/vxtidate_.o libU77/gmtime_.o libU77/fdate_.o libU77/secnds_.o \ + libU77/bes.o libU77/dbes.o libU77/chdir_.o libU77/chmod_.o \ + libU77/lnblnk_.o libU77/hostnm_.o libU77/rename_.o libU77/fgetc_.o \ + libU77/fputc_.o libU77/umask_.o libU77/sys_clock_.o libU77/date_.o \ + libU77/second_.o libU77/flush1_.o libU77/alarm_.o libU77/mclock_.o \ + libU77/symlnk_.o + +F2CEXT = abort derf derfc ef1asc ef1cmc erf erfc exit getarg getenv iargc \ + signal system flush ftell fseek access besj0 besj1 besjn besy0 besy1 \ + besyn chdir chmod ctime date dbesj0 dbesj1 dbesjn dbesy0 dbesy1 dbesyn \ + dtime etime fdate fgetc fget flush1 fnum fputc fput fstat gerror \ + getcwd getgid getlog getpid getuid gmtime hostnm idate ierrno irand \ + isatty itime kill link lnblnk lstat ltime mclock perror rand rename \ + secnds second sleep srand stat symlnk sclock time ttynam umask unlink \ + vxtidt vxttim alarm + +all: f2c.h $(lib) + +$(lib): stamp-libf77 stamp-libi77 stamp-libu77 stamp-libe77 + rm -f $(lib) + $(AR) $(AR_FLAGS) $(lib) $(FOBJ) $(IOBJ) $(UOBJ) $(F2CEXT:%=libE77/L%.o) + $(RANLIB) $(lib) + +stamp-libi77: libI77/Makefile + rm -f stamp-libi77 + cd libI77; $(MAKE) -f Makefile $(FLAGS_TO_PASS) all + touch stamp-libi77 + +stamp-libf77: libF77/Makefile + rm -f stamp-libf77 + cd libF77; $(MAKE) -f Makefile $(FLAGS_TO_PASS) all + touch stamp-libf77 + +stamp-libu77: libU77/Makefile + rm -f stamp-libu77 + cd libU77; $(MAKE) -f Makefile $(FLAGS_TO_PASS) all + touch stamp-libu77 + +stamp-libe77: $(srcdir)/f2cext.c + rm -fr libE77 + mkdir libE77 + for name in $(F2CEXT); \ + do \ + echo $${name}; \ + $(CC) -c -I. -I$(srcdir) -I../../include $(CPPFLAGS) $(CFLAGS) \ + $(CGFLAGS) -DL$${name} $(srcdir)/f2cext.c \ + -o libE77/L$${name}.o; \ + if [ $$? -eq 0 ] ; then true; else exit 1; fi; \ + done + touch stamp-libe77 + +${srcdir}/configure: ${srcdir}/configure.in + rm -f config.cache && cd ${srcdir} && autoconf && rm -f config.cache +${srcdir}/libU77/configure: ${srcdir}/libU77/configure.in + rm -f libU77/config.cache && cd ${srcdir}/libU77 && autoconf && rm -f config.cache + +f2c.h: $(srcdir)/f2c.h.in + +install: + $(INSTALL_DATA) $(lib) $(libdir)/$(lib).n + ( cd $(libdir) ; $(RANLIB) $(lib).n ) + mv -f $(libdir)/$(lib).n $(libdir)/$(lib) + $(INSTALL_DATA) f2c.h $(includedir)/f2c.h + +mostlyclean: + -rm -f stamp-* + for i in libI77 libF77 libU77; do \ + if [ -f $$i/Makefile ]; then \ + cd $$i; $(MAKE) -f Makefile mostlyclean; cd ..; \ + fi; \ + done + rm -fr libE77 + +clean: + -rm -f config.log stamp-* + for i in libI77 libF77 libU77; do \ + if [ -f $$i/Makefile ]; then \ + cd $$i; $(MAKE) -f Makefile clean; cd ..; \ + fi; \ + done + rm -fr libE77 + +distclean: clean + -rm -f Makefile config.cache lib?77/Makefile config.status lib?77/config.status lib?77/config.cache lib?77/config.h f2c.h + +maintainer-clean: distclean + -rm -f $(srcdir)/configure $(srcdir)/libU77/configure + +rebuilt: ${srcdir}/configure ${srcdir}/libU77/configure + +.PHONY: libf77 libi77 libu77 rebuilt mostlyclean clean distclean \ + maintainer-clean all diff --git a/libf2c/README b/libf2c/README new file mode 100644 index 00000000000..9419af77189 --- /dev/null +++ b/libf2c/README @@ -0,0 +1,46 @@ +970811 + +This directory contains the f2c library packaged for use with g77 to configure +and build automatically (in principle!) as part of the top-level configure and +make steps. This depends on the makefile and configure fragments in ../f. + +Some small changes have been made to the f2c distributions of lib[FI]77 which +come from and are maintained (excellently) by +David M. Gay . See the Notice files for copyright +information. I'll try to get the changes rolled into the f2c distribution. + +Files that come directly from netlib are either maintained in the +gcc/f/runtime/ directory under their original names or, if they +are not pertinent for g77's version of libf2c, under their original +names with `.netlib' appended. For example, gcc/f/runtime/permissions.netlib +is a copy of f2c's top-level`permissions' file in the netlib distribution. +In this case, it applies only to the relevant portions of the libF77/ and +libI77/ directories; it does not apply to the libU77/ directory, which is +distributed under different licensing arrangements. Similarly, +the `makefile.netlib' files in libF77/ and libI77/ are copies of +the respective `makefile' files in the netlib distribution, but +are not used when building g77's version of libf2c. + +The `README.netlib' files in libF77/ and libI77/ thus might be +interesting, but should not be taken as guidelines for how to +configure and build libf2c in g77's distribution. + +The packaging for auto-configuration was done by Dave Love . +Minor changes have been made by James Craig Burley , +who probably broke things Dave had working. :-) + +Among the user-visible changes (choices) g77 makes in its +version of libf2c: + +- f2c.h configured to default to padding unformatted direct reads + (#define Pad_UDread), because that's the behavior most users + expect. + +- f2c.h configured to default to outputting leading zeros before + decimal points in formatted and list-directed output, to be compatible + with many other compilers (#define WANT_LEAD_0). Either way is + standard-conforming, however, and you should try to avoid writing + code that assumes one format or another. + +- dtime_() and etime_() are from Dave Love's libU77, not from + netlib's libF77. diff --git a/libf2c/TODO b/libf2c/TODO new file mode 100644 index 00000000000..a44d1ed7f23 --- /dev/null +++ b/libf2c/TODO @@ -0,0 +1,17 @@ +970811 + +TODO list for the g77 library + +* `Makefile.in's should be brought up to standard; I'm not sure they + have a complete set of targets at present. + +* Investigate building shared libraries on systems we know about + (probably in 0.5.22, using libtool-1.0 from the FSF, which looks + quite useful). + +* Test cases. + +* Allow the library to be stripped to save space. + +* An interface to IEEE maths functions from libc where this makes + sense. diff --git a/libf2c/changes.netlib b/libf2c/changes.netlib new file mode 100644 index 00000000000..78dba8653ba --- /dev/null +++ b/libf2c/changes.netlib @@ -0,0 +1,2850 @@ +31 Aug. 1989: + 1. A(min(i,j)) now is translated correctly (where A is an array). + 2. 7 and 8 character variable names are allowed (but elicit a + complaint under -ext). + 3. LOGICAL*1 is treated as LOGICAL, with just one error message + per LOGICAL*1 statement (rather than one per variable declared + in that statement). [Note that LOGICAL*1 is not in Fortran 77.] + Like f77, f2c now allows the format in a read or write statement + to be an integer array. + +5 Sept. 1989: + Fixed botch in argument passing of substrings of equivalenced +variables. + +15 Sept. 1989: + Warn about incorrect code generated when a character-valued +function is not declared external and is passed as a parameter +(in violation of the Fortran 77 standard) before it is invoked. +Example: + + subroutine foo(a,b) + character*10 a,b + call goo(a,b) + b = a(3) + end + +18 Sept. 1989: + Complain about overlapping initializations. + +20 Sept. 1989: + Warn about names declared EXTERNAL but never referenced; +include such names as externs in the generated C (even +though most C compilers will discard them). + +24 Sept. 1989: + New option -w8 to suppress complaint when COMMON or EQUIVALENCE +forces word alignment of a double. + Under -A (for ANSI C), ensure that floating constants (terminated +by 'f') contain either a decimal point or an exponent field. + Repair bugs sometimes encountered with CHAR and ICHAR intrinsic +functions. + Restore f77's optimizations for copying and comparing character +strings of length 1. + Always assume floating-point valued routines in libF77 return +doubles, even under -R. + Repair occasional omission of arguments in routines having multiple +entry points. + Repair bugs in computing offsets of character strings involved +in EQUIVALENCE. + Don't omit structure qualification when COMMON variables are used +as FORMATs or internal files. + +2 Oct. 1989: + Warn about variables that appear only in data stmts; don't emit them. + Fix bugs in character DATA for noncharacter variables +involved in EQUIVALENCE. + Treat noncharacter variables initialized (at least partly) with +character data as though they were equivalenced -- put out a struct +and #define the variables. This eliminates the hideous and nonportable +numeric values that were used to initialize such variables. + Treat IMPLICIT NONE as IMPLICIT UNDEFINED(A-Z) . + Quit when given invalid options. + +8 Oct. 1989: + Modified naming scheme for generated intermediate variables; +more are recycled, fewer distinct ones used. + New option -W nn specifies nn characters/word for Hollerith +data initializing non-character variables. + Bug fix: x(i:min(i+10,j)) used to elicit "Can't handle opcode 31 yet". + Integer expressions of the form (i+const1) - (i+const2), where +i is a scalar integer variable, are now simplified to (const1-const2); +this leads to simpler translation of some substring expressions. + Initialize uninitialized portions of character string arrays to 0 +rather than to blanks. + +9 Oct. 1989: + New option -c to insert comments showing original Fortran source. + New option -g to insert line numbers of original Fortran source. + +10 Oct. 1989: + ! recognized as in-line comment delimiter (a la Fortran 88). + +24 Oct. 1989: + New options to ease coping with systems that want the structs +that result from COMMON blocks to be defined just once: + -E causes uninitialized COMMON blocks to be declared Extern; +if Extern is undefined, f2c.h #defines it to be extern. + -ec causes a separate .c file to be emitted for each +uninitialized COMMON block: COMMON /ABC/ yields abc_com.c; +thus one can compile *_com.c into a library to ensure +precisely one definition. + -e1c is similar to -ec, except that everything goes into +one file, along with comments that give a sed script for +splitting the file into the pieces that -ec would give. +This is for use with netlib's "execute f2c" service (for which +-ec is coerced into -e1c, and the sed script will put everything +but the COMMON definitions into f2c_out.c ). + +28 Oct. 1989: + Convert "i = i op ..." into "i op= ...;" even when i is a +dummy argument. + +13 Nov. 1989: + Name integer constants (passed as arguments) c__... rather +than c_... so + common /c/stuff + call foo(1) + ... +is translated correctly. + +19 Nov. 1989: + Floating-point constants are now kept as strings unless they +are involved in constant expressions that get simplified. The +floating-point constants kept as strings can have arbitrarily +many significant figures and a very large exponent field (as +large as long int allows on the machine on which f2c runs). +Thus, for example, the body of + + subroutine zot(x) + double precision x(6), pi + parameter (pi=3.1415926535897932384626433832795028841972) + x(1) = pi + x(2) = pi+1 + x(3) = 9287349823749272.7429874923740978492734D-298374 + x(4) = .89 + x(5) = 4.0005 + x(6) = 10D7 + end + +now gets translated into + + x[1] = 3.1415926535897932384626433832795028841972; + x[2] = 4.1415926535897931; + x[3] = 9.2873498237492727429874923740978492734e-298359; + x[4] = (float).89; + x[5] = (float)4.0005; + x[6] = 1e8; + +rather than the former + + x[1] = 3.1415926535897931; + x[2] = 4.1415926535897931; + x[3] = 0.; + x[4] = (float)0.89000000000000003; + x[5] = (float)4.0004999999999997; + x[6] = 100000000.; + + Recognition of f77 machine-constant intrinsics deleted, i.e., +epbase, epprec, epemin, epemax, eptiny, ephuge, epmrsp. + +22 Nov. 1989: + Workarounds for glitches on some Sun systems... + libf77: libF77/makefile modified to point out possible need +to compile libF77/main.c with -Donexit=on_exit . + libi77: libI77/wref.c (and libI77/README) modified so non-ANSI +systems can compile with USE_STRLEN defined, which will cause + sprintf(b = buf, "%#.*f", d, x); + n = strlen(b) + d1; +rather than + n = sprintf(b = buf, "%#.*f", d, x) + d1; +to be compiled. + +26 Nov. 1989: + Longer names are now accepted (up to 50 characters); names may +contain underscores (in which case they will have two underscores +appended, to avoid clashes with library names). + +28 Nov. 1989: + libi77 updated: + 1. Allow 3 (or, on Crays, 4) digit exponents under format Ew.d . + 2. Try to get things right on machines where ints have 16 bits. + +29 Nov. 1989: + Supplied missing semicolon in parameterless subroutines that +have multiple entry points (all of them parameterless). + +30 Nov. 1989: + libf77 and libi77 revised to use types from f2c.h. + f2c now types floating-point valued C library routines as "double" +rather than "doublereal" (for use with nonstandard C compilers for +which "double" is IEEE double extended). + +1 Dec. 1989: + f2c.h updated to eliminate #defines rendered unnecessary (and, +indeed, dangerous) by change of 26 Nov. to long names possibly +containing underscores. + libi77 further revised: yesterday's change omitted two tweaks to fmt.h +(tweaks which only matter if float and real or double and doublereal are +different types). + +2 Dec. 1989: + Better error message (than "bad tag") for NAMELIST, which no longer +inhibits C output. + +4 Dec. 1989: + Allow capital letters in hex constants (f77 extension; e.g., +x'a012BCd', X'A012BCD' and x'a012bcd' are all treated as the integer +167848909). + libi77 further revised: lio.c lio.h lread.c wref.c wrtfmt.c tweaked +again to allow float and real or double and doublereal to be different. + +6 Dec. 1989: + Revised f2c.h -- required for the following... + Simpler looking translations for abs, min, max, using #defines in +revised f2c.h . + libi77: more corrections to types; additions for NAMELIST. + Corrected casts in some I/O calls. + Translation of NAMELIST; libi77 must still be revised. Currently +libi77 gives you a run-time error message if you attempt NAMELIST I/O. + +7 Dec. 1989: + Fixed bug that prevented local integer variables that appear in DATA +stmts from being ASSIGNed statement labels. + Fillers (for DATA statements initializing EQUIVALENCEd variables and +variables in COMMON) typed integer rather than doublereal (for slightly +more portability, e.g. to Crays). + libi77: missing return values supplied in a few places; some tests +reordered for better working on the Cray. + libf77: better accuracy for complex divide, complex square root, +real mod function (casts to double; double temporaries). + +9 Dec. 1989: + Fixed bug that caused needless (albeit harmless) empty lines to be +inserted in the C output when a comment line contained trailing blanks. + Further tweak to type of fillers: allow doublereal fillers if the +struct has doublereal data. + +11 Dec. 1989: + Alteration of rule for producing external (C) names from names that +contain underscores. Now the external name is always obtained by +appending a pair of underscores. + +12 Dec. 1989: + C production inhibited after most errors. + +15 Dec. 1989: + Fixed bug in headers for subroutines having two or more character +strings arguments: the length arguments were reversed. + +19 Dec. 1989: + f2c.h libf77 libi77: adjusted so #undefs in f2c.h should not foil +compilation of libF77 and libI77. + libf77: getenv_ adjusted to work with unsorted environments. + libi77: the iostat= specifier should now work right with internal I/O. + +20 Dec. 1989: + f2c bugs fixed: In the absence of an err= specifier, the iostat= +specifier was generally set wrong. Character strings containing +explicit nulls (\0) were truncated at the first null. + Unlabeled DO loops recognized; must be terminated by ENDDO. +(Don't ask for CYCLE, EXIT, named DO loops, or DO WHILE.) + +29 Dec. 1989: + Nested unlabeled DO loops now handled properly; new warning for +extraneous text at end of FORMAT. + +30 Dec. 1989: + Fixed bug in translating dble(real(...)), dble(sngl(...)), and +dble(float(...)), where ... is either of type double complex or +is an expression requiring assignment to intermediate variables (e.g., +dble(real(foo(x+1))), where foo is a function and x is a variable). +Regard nonblank label fields on continuation lines as an error. + +3 Jan. 1990: + New option -C++ yields output that should be understood +by C++ compilers. + +6 Jan. 1989: + -a now excludes variables that appear in a namelist from those +that it makes automatic. (As before, it also excludes variables +that appear in a common, data, equivalence, or save statement.) + The syntactically correct Fortran + read(*,i) x + end +now yields syntactically correct C (even though both the Fortran +and C are buggy -- no FORMAT has not been ASSIGNed to i). + +7 Jan. 1990: + libi77: routines supporting NAMELIST added. Surrounding quotes +made optional when no ambiguity arises in a list or namelist READ +of a character-string value. + +9 Jan. 1990: + f2c.src made available. + +16 Jan. 1990: + New options -P to produce ANSI C or C++ prototypes for procedures +defined. Change to -A and -C++: f2c tries to infer prototypes for +invoked procedures unless the new -!P option is given. New warning +messages for inconsistent calling sequences among procedures within +a single file. Most of f2c/src is affected. + f2c.h: typedefs for procedure arguments added; netlib's f2c service +will insert appropriate typedefs for use with older versions of f2c.h. + +17 Jan. 1990: + f2c/src: defs.h exec.c format.c proc.c putpcc.c version.c xsum0.out +updated. Castargs and protofile made extern in defs.h; exec.c +modified so superfluous else clauses are diagnosed; unused variables +omitted from declarations in format.c proc.c putpcc.c . + +21 Jan. 1990: + No C emitted for procedures declared external but not referenced. + f2c.h: more new types added for use with -P. + New feature: f2c accepts as arguments files ending in .p or .P; +such files are assumed to be prototype files, such as produced by +the -P option. All prototype files are read before any Fortran files +and apply globally to all Fortran files. Suitable prototypes help f2c +warn about calling-sequence errors and can tell f2c how to type +procedures declared external but not explicitly typed; the latter is +mainly of interest for users of the -A and -C++ options. (Prototype +arguments are not available to netlib's "execute f2c" service.) + New option -it tells f2c to try to infer types of untyped external +arguments from their use as parameters to prototyped or previously +defined procedures. + f2c/src: many minor cleanups; most modules changed. Individual +files in f2c/src are now in "bundle" format. The former f2c.1 is +now f2c.1t; "f2c.1t from f2c" and "f2c.1t from f2c/src" are now the +same, as are "f2c.1 from f2c" and "f2c.1 from f2c/src". People who +do not obtain a new copy of "all from f2c/src" should at least add + fclose(sortfp); +after the call on do_init_data(outfile, sortfp) in format_data.c . + +22 Jan. 1990: + Cleaner man page wording (thanks to Doug McIlroy). + -it now also applies to all untyped EXTERNAL procedures, not just +arguments. + +23 Jan. 01:34:00 EST 1990: + Bug fixes: under -A and -C++, incorrect C was generated for +subroutines having multiple entries but no arguments. + Under -A -P, subroutines of no arguments were given prototype +calling sequence () rather than (void). + Character-valued functions elicited erroneous warning messages +about inconsistent calling sequences when referenced by another +procedure in the same file. + f2c.1t: omit first appearance of libF77.a in FILES section; +load order of libraries is -lF77 -lI77, not vice versa (bug +introduced in yesterday's edits); define .F macro for those whose +-man lacks it. (For a while after yesterday's fixes were posted, +f2c.1t was out of date. Sorry!) + +23 Jan. 9:53:24 EST 1990: + Character substring expressions involving function calls having +character arguments (including the intrinsic len function) yielded +incorrect C. + Procedures defined after invocation (in the same file) with +conflicting argument types also got an erroneous message about +the wrong number of arguments. + +24 Jan. 11:44:00 EST 1990: + Bug fixes: -p omitted #undefs; COMMON block names containing +underscores had their C names incorrectly computed; a COMMON block +having the name of a previously defined procedure wreaked havoc; +if all arguments were .P files, f2c tried reading the second as a +Fortran file. + New feature: -P emits comments showing COMMON block lengths, so one +can get warnings of incompatible COMMON block lengths by having f2c +read .P (or .p) files. Now by running f2c twice, first with -P -!c +(or -P!c), then with *.P among the arguments, you can be warned of +inconsistent COMMON usage, and COMMON blocks having inconsistent +lengths will be given the maximum length. (The latter always did +happen within each input file; now -P lets you extend this behavior +across files.) + +26 Jan. 16:44:00 EST 1990: + Option -it made less aggressive: untyped external procedures that +are invoked are now typed by the rules of Fortran, rather than by +previous use of procedures to which they are passed as arguments +before being invoked. + Option -P now includes information about references, i.e., called +procedures, in the prototype files (in the form of special comments). +This allows iterative invocations of f2c to infer more about untyped +external names, particularly when multiple Fortran files are involved. + As usual, there are some obscure bug fixes: +1. Repair of erroneous warning messages about inconsistent number of +arguments that arose when a character dummy parameter was discovered +to be a function or when multiple entry points involved character +variables appearing in a previous entry point. +2. Repair of memory fault after error msg about "adjustable character +function". +3. Under -U, allow MAIN_ as a subroutine name (in the same file as a +main program). +4. Change for consistency: a known function invoked as a subroutine, +then as a function elicits a warning rather than an error. + +26 Jan. 22:32:00 EST 1990: + Fixed two bugs that resulted in incorrect C for substrings, within +the body of a character-valued function, of the function's name, when +those substrings were arguments to another function (even implicitly, +as in character-string assignment). + +28 Jan. 18:32:00 EST 1990: + libf77, libi77: checksum files added; "make check" looks for +transmission errors. NAMELIST read modified to allow $ rather than & +to precede a namelist name, to allow $ rather than / to terminate +input where the name of another variable would otherwise be expected, +and to regard all nonprinting ASCII characters <= ' ' as spaces. + +29 Jan. 02:11:00 EST 1990: + "fc from f2c" added. + -it option made the default; -!it turns it off. Type information is +now updated in a previously missed case. + -P option tweaked again; message about when rerunning f2c may change +prototypes or declarations made more accurate. + New option -Ps implies -P and returns exit status 4 if rerunning +f2c -P with prototype inputs might change prototypes or declarations. +Now you can execute a crude script like + + cat *.f >zap.F + rm -f zap.P + while :; do + f2c -Ps -!c zap.[FP] + case $? in 4) ;; *) break;; esac + done + +to get a file zap.P of the best prototypes f2c can determine for *.f . + +Jan. 29 07:30:21 EST 1990: + Forgot to check for error status when setting return code 4 under -Ps; +error status (1, 2, 3, or, for caught signal, 126) now takes precedence. + +Jan 29 14:17:00 EST 1990: + Incorrect handling of + open(n,'filename') +repaired -- now treated as + open(n,file='filename') +(and, under -ext, given an error message). + New optional source file memset.c for people whose systems don't +provide memset, memcmp, and memcpy; #include in mem.c +changed to #include "string.h" so BSD people can create a local +string.h that simply says #include . + +Jan 30 10:34:00 EST 1990: + Fix erroneous warning at end of definition of a procedure with +character arguments when the procedure had previously been called with +a numeric argument instead of a character argument. (There were two +warnings, the second one incorrectly complaining of a wrong number of +arguments.) + +Jan 30 16:29:41 EST 1990: + Fix case where -P and -Ps erroneously reported another iteration +necessary. (Only harm is the extra iteration.) + +Feb 3 01:40:00 EST 1990: + Supply semicolon occasionally omitted under -c . + Try to force correct alignment when numeric variables are initialized +with character data (a non-standard and non-portable practice). You +must use the -W option if your code has such data statements and is +meant to run on a machine with other than 4 characters/word; e.g., for +code meant to run on a Cray, you would specify -W8 . + Allow parentheses around expressions in output lists (in write and +print statements). + Rename source files so their names are <= 12 characters long +(so there's room to append .Z and still have <= 14 characters); +renamed files: formatdata.c niceprintf.c niceprintf.h safstrncpy.c . + f2c material made available by anonymous ftp from research.att.com +(look in dist/f2c ). + +Feb 3 03:49:00 EST 1990: + Repair memory fault that arose from use (in an assignment or +call) of a non-argument variable declared CHARACTER*(*). + +Feb 9 01:35:43 EST 1990: + Fix erroneous error msg about bad types in + subroutine foo(a,adim) + dimension a(adim) + integer adim + Fix improper passing of character args (and possible memory fault) +in the expression part of a computed goto. + Fix botched calling sequences in array references involving +functions having character args. + Fix memory fault caused by invocation of character-valued functions +of no arguments. + Fix botched calling sequence of a character*1-valued function +assigned to a character*1 variable. + Fix bug in error msg for inconsistent number of args in prototypes. + Allow generation of C output despite inconsistencies in prototypes, +but give exit code 8. + Simplify include logic (by removing some bogus logic); never +prepend "/usr/include/" to file names. + Minor cleanups (that should produce no visible change in f2c's +behavior) in intr.c parse.h main.c defs.h formatdata.c p1output.c . + +Feb 10 00:19:38 EST 1990: + Insert (integer) casts when floating-point expressions are used +as subscripts. + Make SAVE stmt (with no variable list) override -a . + Minor cleanups: change field to Field in struct Addrblock (for the +benefit of buggy C compilers); omit system("/bin/cp ...") in misc.c . + +Feb 13 00:39:00 EST 1990: + Error msg fix in gram.dcl: change "cannot make %s parameter" +to "cannot make into parameter". + +Feb 14 14:02:00 EST 1990: + Various cleanups (invisible on systems with 4-byte ints), thanks +to Dave Regan: vaxx.c eliminated; %d changed to %ld various places; +external names adjusted for the benefit of stupid systems (that ignore +case and recognize only 6 significant characters in external names); +buffer shortened in xsum.c (e.g. for MS-DOS); fopen modes distinguish +text and binary files; several unused functions eliminated; missing +arg supplied to an unlikely fatalstr invocation. + +Thu Feb 15 19:15:53 EST 1990: + More cleanups (invisible on systems with 4 byte ints); casts inserted +so most complaints from cyntax(1) and lint(1) go away; a few (int) +versus (long) casts corrected. + +Fri Feb 16 19:55:00 EST 1990: + Recognize and translate unnamed Fortran 8x do while statements. + Fix bug that occasionally caused improper breaking of character +strings. + New error message for attempts to provide DATA in a type-declaration +statement. + +Sat Feb 17 11:43:00 EST 1990: + Fix infinite loop clf -> Fatal -> done -> clf after I/O error. + Change "if (addrp->vclass = CLPROC)" to "if (addrp->vclass == CLPROC)" +in p1_addr (in p1output.c); this was probably harmless. + Move a misplaced } in lex.c (which slowed initkey()). + Thanks to Gary Word for pointing these things out. + +Sun Feb 18 18:07:00 EST 1990: + Detect overlapping initializations of arrays and scalar variables +in previously missed cases. + Treat logical*2 as logical (after issuing a warning). + Don't pass string literals to p1_comment(). + Correct a cast (introduced 16 Feb.) in gram.expr; this matters e.g. +on a Cray. + Attempt to isolate UNIX-specific things in sysdep.c (a new source +file). Unless sysdep.c is compiled with SYSTEM_SORT defined, the +intermediate files created for DATA statements are now sorted in-core +without invoking system(). + +Tue Feb 20 16:10:35 EST 1990: + Move definition of binread and binwrite from init.c to sysdep.c . + Recognize Fortran 8x tokens < <= == >= > <> as synonyms for +.LT. .LE. .EQ. .GE. .GT. .NE. + Minor cleanup in putpcc.c: fully remove simoffset(). + More discussion of system dependencies added to libI77/README. + +Tue Feb 20 21:44:07 EST 1990: + Minor cleanups for the benefit of EBCDIC machines -- try to remove +the assumption that 'a' through 'z' are contiguous. (Thanks again to +Gary Word.) Also, change log2 to log_2 (shouldn't be necessary). + +Wed Feb 21 06:24:56 EST 1990: + Fix botch in init.c introduced in previous change; only matters +to non-ASCII machines. + +Thu Feb 22 17:29:12 EST 1990: + Allow several entry points to mention the same array. Protect +parameter adjustments with if's (for the case that an array is not +an argument to all entrypoints). + Under -u, allow + subroutine foo(x,n) + real x(n) + integer n + Compute intermediate variables used to evaluate dimension expressions +at the right time. Example previously mistranslated: + subroutine foo(x,k,m,n) + real x(min(k,m,n)) + ... + write(*,*) x + Detect duplicate arguments. (The error msg points to the first +executable stmt -- not wonderful, but not worth fixing.) + Minor cleanup of min/max computation (sometimes slightly simpler). + +Sun Feb 25 09:39:01 EST 1990: + Minor tweak to multiple entry points: protect parameter adjustments +with if's only for (array) args that do not appear in all entry points. + Minor tweaks to format.c and io.c (invisible unless your compiler +complained at the duplicate #defines of IOSUNIT and IOSFMT or at +comparisons of p1gets(...) with NULL). + +Sun Feb 25 18:40:10 EST 1990: + Fix bug introduced Feb. 22: if a subprogram contained DATA and the +first executable statement was labeled, then the label got lost. +(Just change INEXEC to INDATA in p1output.c; it occurs just once.) + +Mon Feb 26 17:45:10 EST 1990: + Fix bug in handling of " and ' in comments. + +Wed Mar 28 01:43:06 EST 1990: +libI77: + 1. Repair nasty I/O bug: opening two files and closing the first +(after possibly reading or writing it), then writing the second caused +the last buffer of the second to be lost. + 2. Formatted reads of logical values treated all letters other than +t or T as f (false). + libI77 files changed: err.c rdfmt.c Version.c + (Request "libi77 from f2c" -- you can't get these files individually.) + +f2c itself: + Repair nasty bug in translation of + ELSE IF (condition involving complicated abs, min, or max) +-- auxiliary statements were emitted at the wrong place. + Supply semicolon previously omitted from the translation of a label +(of a CONTINUE) immediately preceding an ELSE IF or an ELSE. This +bug made f2c produce invalid C. + Correct a memory fault that occurred (on some machines) when the +error message "adjustable dimension on non-argument" should be given. + Minor tweaks to remove some harmless warnings by overly chatty C +compilers. + Argument arays having constant dimensions but a variable lower bound +(e.g., x(n+1:n+3)) had a * omitted from scalar arguments involved in +the array offset computation. + +Wed Mar 28 18:47:59 EST 1990: +libf77: add exit(0) to end of main [return(0) encounters a Cray bug] + +Sun Apr 1 16:20:58 EDT 1990: + Avoid dereferencing null when processing equivalences after an error. + +Fri Apr 6 08:29:49 EDT 1990: + Calls involving alternate return specifiers omitted processing +needed for things like min, max, abs, and // (concatenation). + INTEGER*2 PARAMETERs were treated as INTEGER*4. + Convert some O(n^2) parsing to O(n). + +Tue Apr 10 20:07:02 EDT 1990: + When inconsistent calling sequences involve differing numbers of +arguments, report the first differing argument rather than the numbers +of arguments. + Fix bug under -a: formatted I/O in which either the unit or the +format was a local character variable sometimes resulted in invalid C +(a static struct initialized with an automatic component). + Improve error message for invalid flag after elided -. + Complain when literal table overflows, rather than infinitely +looping. (The complaint mentions the new and otherwise undocumented +-NL option for specifying a larger literal table.) + New option -h for forcing strings to word (or, with -hd, double-word) +boundaries where possible. + Repair a bug that could cause improper splitting of strings. + Fix bug (cast of c to doublereal) in + subroutine foo(c,r) + double complex c + double precision r + c = cmplx(r,real(c)) + end + New include file "sysdep.h" has some things from defs.h (and +elsewhere) that one may need to modify on some systems. + Some large arrays that were previously statically allocated are now +dynamically allocated when f2c starts running. + f2c/src files changed: + README cds.c defs.h f2c.1 f2c.1t format.c formatdata.c init.c + io.c lex.c main.c makefile mem.c misc.c names.c niceprintf.c + output.c parse_args.c pread.c put.c putpcc.c sysdep.h + version.c xsum0.out + +Wed Apr 11 18:27:12 EDT 1990: + Fix bug in argument consistency checking of character, complex, and +double complex valued functions. If the same source file contained a +definition of such a function with arguments not explicitly typed, +then subsequent references to the function might get erroneous +warnings of inconsistent calling sequences. + Tweaks to sysdep.h for partially ANSI systems. + New options -kr and -krd cause f2c to use temporary variables to +enforce Fortran evaluation-order rules with pernicious, old-style C +compilers that apply the associative law to floating-point operations. + +Sat Apr 14 15:50:15 EDT 1990: + libi77: libI77 adjusted to allow list-directed and namelist I/O +of internal files; bug in namelist I/O of logical and character arrays +fixed; list input of complex numbers adjusted to permit d or D to +denote the start of the exponent field of a component. + f2c itself: fix bug in handling complicated lower-bound +expressions for character substrings; e.g., min and max did not work +right, nor did function invocations involving character arguments. + Switch to octal notation, rather than hexadecimal, for nonprinting +characters in character and string constants. + Fix bug (when neither -A nor -C++ was specified) in typing of +external arguments of type complex, double complex, or character: + subroutine foo(c) + external c + complex c +now results in + /* Complex */ int (*c) (); +(as, indeed, it once did) rather than + complex (*c) (); + +Sat Apr 14 22:50:39 EDT 1990: + libI77/makefile: updated "make check" to omit lio.c + lib[FI]77/makefile: trivial change: define CC = cc, reference $(CC). + (Request, e.g., "libi77 from f2c" -- you can't ask for individual +files from lib[FI]77.) + +Wed Apr 18 00:56:37 EDT 1990: + Move declaration of atof() from defs.h to sysdep.h, where it is +now not declared if stdlib.h is included. (NeXT's stdlib.h has a +#define atof that otherwise wreaks havoc.) + Under -u, provide a more intelligible error message (than "bad tag") +for an attempt to define a function without specifying its type. + +Wed Apr 18 17:26:27 EDT 1990: + Recognize \v (vertical tab) in Hollerith as well as quoted strings; +add recognition of \r (carriage return). + New option -!bs turns off recognition of escapes in character strings +(\0, \\, \b, \f, \n, \r, \t, \v). + Move to sysdep.c initialization of some arrays whose initialization +assumed ASCII; #define Table_size in sysdep.h rather than using +hard-coded 256 in allocating arrays of size 1 << (bits/byte). + +Thu Apr 19 08:13:21 EDT 1990: + Warn when escapes would make Hollerith extend beyond statement end. + Omit max() definition from misc.c (should be invisible except on +systems that erroneously #define max in stdlib.h). + +Mon Apr 23 22:24:51 EDT 1990: + When producing default-style C (no -A or -C++), cast switch +expressions to (int). + Move "-lF77 -lI77 -lm -lc" to link_msg, defined in sysdep.c . + Add #define scrub(x) to sysdep.h, with invocations in format.c and +formatdata.c, so that people who have systems like VMS that would +otherwise create multiple versions of intermediate files can +#define scrub(x) unlink(x) + +Tue Apr 24 18:28:36 EDT 1990: + Pass string lengths once rather than twice to a function of character +arguments involved in comparison of character strings of length 1. + +Fri Apr 27 13:11:52 EDT 1990: + Fix bug that made f2c gag on concatenations involving char(...) on +some systems. + +Sat Apr 28 23:20:16 EDT 1990: + Fix control-stack bug in + if(...) then + else if (complicated condition) + else + endif +(where the complicated condition causes assignment to an auxiliary +variable, e.g., max(a*b,c)). + +Mon Apr 30 13:30:10 EDT 1990: + Change fillers for DATA with holes from substructures to arrays +(in an attempt to make things work right with C compilers that have +funny padding rules for substructures, e.g., Sun C compilers). + Minor cleanup of exec.c (should not affect generated C). + +Mon Apr 30 23:13:51 EDT 1990: + Fix bug in handling return values of functions having multiple +entry points of differing return types. + +Sat May 5 01:45:18 EDT 1990: + Fix type inference bug in + subroutine foo(x) + call goo(x) + end + subroutine goo(i) + i = 3 + end +Instead of warning of inconsistent calling sequences for goo, +f2c was simply making i a real variable; now i is correctly +typed as an integer variable, and f2c issues an error message. + Adjust error messages issued at end of declarations so they +don't blame the first executable statement. + +Sun May 6 01:29:07 EDT 1990: + Fix bug in -P and -Ps: warn when the definition of a subprogram adds +information that would change prototypes or previous declarations. + +Thu May 10 18:09:15 EDT 1990: + Fix further obscure bug with (default) -it: inconsistent calling +sequences and I/O statements could interact to cause a memory fault. +Example: + SUBROUTINE FOO + CALL GOO(' Something') ! Forgot integer first arg + END + SUBROUTINE GOO(IUNIT,MSG) + CHARACTER*(*)MSG + WRITE(IUNIT,'(1X,A)') MSG + END + +Fri May 11 16:49:11 EDT 1990: + Under -!c, do not delete any .c files (when there are errors). + Avoid dereferencing 0 when a fatal error occurs while reading +Fortran on stdin. + +Wed May 16 18:24:42 EDT 1990: + f2c.ps made available. + +Mon Jun 4 12:53:08 EDT 1990: + Diagnose I/O units of invalid type. + Add specific error msg about dummy arguments in common. + +Wed Jun 13 12:43:17 EDT 1990: + Under -A, supply a missing "[1]" for CHARACTER*1 variables that appear +both in a DATA statement and in either COMMON or EQUIVALENCE. + +Mon Jun 18 16:58:31 EDT 1990: + Trivial updates to f2c.ps . ("Fortran 8x" --> "Fortran 90"; omit +"(draft)" from "(draft) ANSI C".) + +Tue Jun 19 07:36:32 EDT 1990: + Fix incorrect code generated for ELSE IF(expression involving +function call passing non-constant substring). + Under -h, preserve the property that strings are null-terminated +where possible. + Remove spaces between # and define in lex.c output.c parse.h . + +Mon Jun 25 07:22:59 EDT 1990: + Minor tweak to makefile to reduce unnecessary recompilations. + +Tue Jun 26 11:49:53 EDT 1990: + Fix unintended truncation of some integer constants on machines +where casting a long to (int) may change the value. E.g., when f2c +ran on machines with 16-bit ints, "i = 99999" was being translated +to "i = -31073;". + +Wed Jun 27 11:05:32 EDT 1990: + Arrange for CHARACTER-valued PARAMETERs to honor their length +specifications. Allow CHAR(nn) in expressions defining such PARAMETERs. + +Fri Jul 20 09:17:30 EDT 1990: + Avoid dereferencing 0 when a FORMAT statement has no label. + +Thu Jul 26 11:09:39 EDT 1990: + Remarks about VOID and binread,binwrite added to README. + Tweaks to parse_args: should be invisible unless your compiler +complained at (short)*store. + +Thu Aug 2 02:07:58 EDT 1990: + f2c.ps: change the first line of page 5 from + include stuff +to + include 'stuff' + +Tue Aug 14 13:21:24 EDT 1990: + libi77: libI77 adjusted to treat tabs as spaces in list input. + +Fri Aug 17 07:24:53 EDT 1990: + libi77: libI77 adjusted so a blank='ZERO' clause (upper case Z) +in an open of a currently open file works right. + +Tue Aug 28 01:56:44 EDT 1990: + Fix bug in warnings of inconsistent calling sequences: if an +argument to a subprogram was never referenced, then a previous +invocation of the subprogram (in the same source file) that +passed something of the wrong type for that argument did not +elicit a warning message. + +Thu Aug 30 09:46:12 EDT 1990: + libi77: prevent embedded blanks in list output of complex values; +omit exponent field in list output of values of magnitude between +10 and 1e8; prevent writing stdin and reading stdout or stderr; +don't close stdin, stdout, or stderr when reopening units 5, 6, 0. + +Tue Sep 4 12:30:57 EDT 1990: + Fix bug in C emitted under -I2 or -i2 for INTEGER*4 FUNCTION. + Warn of missing final END even if there are previous errors. + +Fri Sep 7 13:55:34 EDT 1990: + Remark about "make xsum.out" and "make f2c" added to README. + +Tue Sep 18 23:50:01 EDT 1990: + Fix null dereference (and, on some systems, writing of bogus *_com.c +files) under -ec or -e1c when a prototype file (*.p or *.P) describes +COMMON blocks that do not appear in the Fortran source. + libi77: + Add some #ifdef lines (#ifdef MSDOS, #ifndef MSDOS) to avoid +references to stat and fstat on non-UNIX systems. + On UNIX systems, add component udev to unit; decide that old +and new files are the same iff both the uinode and udev components +of unit agree. + When an open stmt specifies STATUS='OLD', use stat rather than +access (on UNIX systems) to check the existence of the file (in case +directories leading to the file have funny permissions and this is +a setuid or setgid program). + +Thu Sep 27 16:04:09 EDT 1990: + Supply missing entry for Impldoblock in blksize array of cpexpr +(in expr.c). No examples are known where this omission caused trouble. + +Tue Oct 2 22:58:09 EDT 1990: + libf77: test signal(...) == SIG_IGN rather than & 01 in main(). + libi77: adjust rewind.c so two successive rewinds after a write +don't clobber the file. + +Thu Oct 11 18:00:14 EDT 1990: + libi77: minor cleanups: add #include "fcntl.h" to endfile.c, err.c, +open.c; adjust g_char in util.c for segmented memories; in f_inqu +(inquire.c), define x appropriately when MSDOS is defined. + +Mon Oct 15 20:02:11 EDT 1990: + Add #ifdef MSDOS pointer adjustments to mem.c; treat NAME= as a +synonym for FILE= in OPEN statements. + +Wed Oct 17 16:40:37 EDT 1990: + libf77, libi77: minor cleanups: _cleanup() and abort() invocations +replaced by invocations of sig_die in main.c; some error messages +previously lost in buffers will now appear. + +Mon Oct 22 16:11:27 EDT 1990: + libf77: separate sig_die from main (for folks who don't want to use +the main in libF77). + libi77: minor tweak to comments in README. + +Fri Nov 2 13:49:35 EST 1990: + Use two underscores rather than one in generated temporary variable +names to avoid conflict with COMMON names. f2c.ps updated to reflect +this change and the NAME= extension introduced 15 Oct. + Repair a rare memory fault in io.c . + +Mon Nov 5 16:43:55 EST 1990: + libi77: changes to open.c (and err.c): complain if an open stmt +specifies new= and the file already exists (as specified by Fortrans 77 +and 90); allow file= to be omitted in open stmts and allow +status='replace' (Fortran 90 extensions). + +Fri Nov 30 10:10:14 EST 1990: + Adjust malloc.c for unusual systems whose sbrk() can return values +not properly aligned for doubles. + Arrange for slightly more helpful and less repetitive warnings for +non-character variables initialized with character data; these warnings +are (still) suppressed by -w66. + +Fri Nov 30 15:57:59 EST 1990: + Minor tweak to README (about changing VOID in f2c.h). + +Mon Dec 3 07:36:20 EST 1990: + Fix spelling of "character" in f2c.1t. + +Tue Dec 4 09:48:56 EST 1990: + Remark about link_msg and libf2c added to f2c/README. + +Thu Dec 6 08:33:24 EST 1990: + Under -U, render label nnn as L_nnn rather than Lnnn. + +Fri Dec 7 18:05:00 EST 1990: + Add more names from f2c.h (e.g. integer, real) to the c_keywords +list of names to which an underscore is appended to avoid confusion. + +Mon Dec 10 19:11:15 EST 1990: + Minor tweaks to makefile (./xsum) and README (binread/binwrite). + libi77: a few modifications for POSIX systems; meant to be invisible +elsewhere. + +Sun Dec 16 23:03:16 EST 1990: + Fix null dereference caused by unusual erroneous input, e.g. + call foo('abc') + end + subroutine foo(msg) + data n/3/ + character*(*) msg + end +(Subroutine foo is illegal because the character statement comes after a +data statement.) + Use decimal rather than hex constants in xsum.c (to prevent +erroneous warning messages about constant overflow). + +Mon Dec 17 12:26:40 EST 1990: + Fix rare extra underscore in character length parameters passed +for multiple entry points. + +Wed Dec 19 17:19:26 EST 1990: + Allow generation of C despite error messages about bad alignment +forced by equivalence. + Allow variable-length concatenations in I/O statements, such as + open(3, file=bletch(1:n) // '.xyz') + +Fri Dec 28 17:08:30 EST 1990: + Fix bug under -p with formats and internal I/O "units" in COMMON, +as in + COMMON /FIGLEA/F + CHARACTER*20 F + F = '(A)' + WRITE (*,FMT=F) 'Hello, world!' + END + +Tue Jan 15 12:00:24 EST 1991: + Fix bug when two equivalence groups are merged, the second with +nonzero offset, and the result is then merged into a common block. +Example: + INTEGER W(3), X(3), Y(3), Z(3) + COMMON /ZOT/ Z + EQUIVALENCE (W(1),X(1)), (X(2),Y(1)), (Z(3),X(1)) +***** W WAS GIVEN THE WRONG OFFSET + Recognize Fortran 90's optional NML= in NAMELIST READs and WRITEs. +(Currently NML= and FMT= are treated as synonyms -- there's no +error message if, e.g., NML= specifies a format.) + libi77: minor adjustment to allow internal READs from character +string constants in read-only memory. + +Fri Jan 18 22:56:15 EST 1991: + Add comment to README about needing to comment out the typedef of +size_t in sysdep.h on some systems, e.g. Sun 4.1. + Fix misspelling of "statement" in an error message in lex.c + +Wed Jan 23 00:38:48 EST 1991: + Allow hex, octal, and binary constants to have the qualifying letter +(z, x, o, or b) either before or after the quoted string containing the +digits. For now this change will not be reflected in f2c.ps . + +Tue Jan 29 16:23:45 EST 1991: + Arrange for character-valued statement functions to give results of +the right length (that of the statement function's name). + +Wed Jan 30 07:05:32 EST 1991: + More tweaks for character-valued statement functions: an error +check and an adjustment so a right-hand side of nonconstant length +(e.g., a substring) is handled right. + +Wed Jan 30 09:49:36 EST 1991: + Fix p1_head to avoid printing (char *)0 with %s. + +Thu Jan 31 13:53:44 EST 1991: + Add a test after the cleanup call generated for I/O statements with +ERR= or END= clauses to catch the unlikely event that the cleanup +routine encounters an error. + +Mon Feb 4 08:00:58 EST 1991: + Minor cleanup: omit unneeded jumps and labels from code generated for +some NAMELIST READs and WRITEs with IOSTAT=, ERR=, and/or END=. + +Tue Feb 5 01:39:36 EST 1991: + Change Mktemp to mktmp (for the benefit of systems so brain-damaged +that they do not distinguish case in external names -- and that for +some reason want to load mktemp). Try to get xsum0.out right this +time (it somehow didn't get updated on 4 Feb. 1991). + Add note to libi77/README about adjusting the interpretation of +RECL= specifiers in OPENs for direct unformatted I/O. + +Thu Feb 7 17:24:42 EST 1991: + New option -r casts values of REAL functions, including intrinsics, +to REAL. This only matters for unportable code like + real r + r = asin(1.) + if (r .eq. asin(1.)) ... +[The behavior of such code varies with the Fortran compiler used -- +and sometimes is affected by compiler options.] For now, the man page +at the end of f2c.ps is the only part of f2c.ps that reflects this new +option. + +Fri Feb 8 18:12:51 EST 1991: + Cast pointer differences passed as arguments to the appropriate type. +This matters, e.g., with MSDOS compilers that yield a long pointer +difference but have int == short. + Disallow nonpositive dimensions. + +Fri Feb 15 12:24:15 EST 1991: + Change %d to %ld in sprintf call in putpower in putpcc.c. + Free more memory (e.g. allowing translation of larger Fortran +files under MS-DOS). + Recognize READ (character expression) and WRITE (character expression) +as formatted I/O with the format given by the character expression. + Update year in Notice. + +Sat Feb 16 00:42:32 EST 1991: + Recant recognizing WRITE(character expression) as formatted output +-- Fortran 77 is not symmetric in its syntax for READ and WRITE. + +Mon Mar 4 15:19:42 EST 1991: + Fix bug in passing the real part of a complex argument to an intrinsic +function. Omit unneeded parentheses in nested calls to intrinsics. +Example: + subroutine foo(x, y) + complex y + x = exp(sin(real(y))) + exp(imag(y)) + end + +Fri Mar 8 15:05:42 EST 1991: + Fix a comment in expr.c; omit safstrncpy.c (which had bugs in +cases not used by f2c). + +Wed Mar 13 02:27:23 EST 1991: + Initialize firstmemblock->next in mem_init in mem.c . [On most +systems it was fortuituously 0, but with System V, -lmalloc could +trip on this missed initialization.] + +Wed Mar 13 11:47:42 EST 1991: + Fix a reference to freed memory. + +Wed Mar 27 00:42:19 EST 1991: + Fix a memory fault caused by such illegal Fortran as + function foo + x = 3 + logical foo ! declaration among executables + foo=.false. ! used to suffer memory fault + end + +Fri Apr 5 08:30:31 EST 1991: + Fix loss of % in some format expressions, e.g. + write(*,'(1h%)') + Fix botch introduced 27 March 1991 that caused subroutines with +multiple entry points to have extraneous declarations of ret_val. + +Fri Apr 5 12:44:02 EST 1991 + Try again to omit extraneous ret_val declarations -- this morning's +fix was sometimes wrong. + +Mon Apr 8 13:47:06 EDT 1991: + Arrange for s_rnge to have the right prototype under -A -C . + +Wed Apr 17 13:36:03 EDT 1991: + New fatal error message for apparent invocation of a recursive +statement function. + +Thu Apr 25 15:13:37 EDT 1991: + F2c and libi77 adjusted so NAMELIST works with -i2. (I forgot +about -i2 when adding NAMELIST.) This required a change to f2c.h +(that only affects NAMELIST I/O under -i2.) Man-page description of +-i2 adjusted to reflect that -i2 stores array lengths in short ints. + +Fri Apr 26 02:54:41 EDT 1991: + Libi77: fix some bugs in NAMELIST reading of multi-dimensional arrays +(file rsne.c). + +Thu May 9 02:13:51 EDT 1991: + Omit a trailing space in expr.c (could cause a false xsum value if +a mailer drops the trailing blank). + +Thu May 16 13:14:59 EDT 1991: + Libi77: increase LEFBL in lio.h to overcome a NeXT bug. + Tweak for compilers that recognize "nested" comments: inside comments, +turn /* into /+ (as well as */ into +/). + +Sat May 25 11:44:25 EDT 1991: + libf77: s_rnge: declare line long int rather than int. + +Fri May 31 07:51:50 EDT 1991: + libf77: system_: officially return status. + +Mon Jun 17 16:52:53 EDT 1991: + Minor tweaks: omit unnecessary declaration of strcmp (that caused +trouble on a system where strcmp was a macro) from misc.c; add +SHELL = /bin/sh to makefiles. + Fix a dereference of null when a CHARACTER*(*) declaration appears +(illegally) after DATA. Complain only once per subroutine about +declarations appearing after DATA. + +Mon Jul 1 00:28:13 EDT 1991: + Add test and error message for illegal use of subroutine names, e.g. + SUBROUTINE ZAP(A) + ZAP = A + END + +Mon Jul 8 21:49:20 EDT 1991: + Issue a warning about things like + integer i + i = 'abc' +(which is treated as i = ichar('a')). [It might be nice to treat 'abc' +as an integer initialized (in a DATA statement) with 'abc', but +other matters have higher priority.] + Render + i = ichar('A') +as + i = 'A'; +rather than + i = 65; +(which assumes ASCII). + +Fri Jul 12 07:41:30 EDT 1991: + Note added to README about erroneous definitions of __STDC__ . + +Sat Jul 13 13:38:54 EDT 1991: + Fix bugs in double type convesions of complex values, e.g. +sngl(real(...)) or dble(real(...)) (where ... is complex). + +Mon Jul 15 13:21:42 EDT 1991: + Fix bug introduced 8 July 1991 that caused erroneous warnings +"ichar([first char. of] char. string) assumed for conversion to numeric" +when a subroutine had an array of character strings as an argument. + +Wed Aug 28 01:12:17 EDT 1991: + Omit an unused function in format.c, an unused variable in proc.c . + Under -r8, promote complex to double complex (as the man page claims). + +Fri Aug 30 17:19:17 EDT 1991: + f2c.ps updated: slightly expand description of intrinsics and,or,xor, +not; add mention of intrinsics lshift, rshift; add note about f2c +accepting Fortran 90 inline comments (starting with !); update Cobalt +Blue address. + +Tue Sep 17 07:17:33 EDT 1991: + libI77: err.c and open.c modified to use modes "rb" and "wb" +when (f)opening unformatted files; README updated to point out +that it may be necessary to change these modes to "r" and "w" +on some non-ANSI systems. + +Tue Oct 15 10:25:49 EDT 1991: + Minor tweaks that make some PC compilers happier: insert some +casts, add args to signal functions. + Change -g to emit uncommented #line lines -- and to emit more of them; +update fc, f2c.1, f2c.1t, f2c.ps to reflect this. + Change uchar to Uchar in xsum.c . + Bring gram.c up to date. + +Thu Oct 17 09:22:05 EDT 1991: + libi77: README, fio.h, sue.c, uio.c changed so the length field +in unformatted sequential records has type long rather than int +(unless UIOLEN_int is #defined). This is for systems where sizeof(int) +can vary, depending on the compiler or compiler options. + +Thu Oct 17 13:42:59 EDT 1991: + libi77: inquire.c: when MSDOS is defined, don't strcmp units[i].ufnm +when it is NULL. + +Fri Oct 18 15:16:00 EDT 1991: + Correct xsum0.out in "all from f2c/src" (somehow botched on 15 Oct.). + +Tue Oct 22 18:12:56 EDT 1991: + Fix memory fault when a character*(*) argument is used (illegally) +as a dummy variable in the definition of a statement function. (The +memory fault occurred when the statement function was invoked.) + Complain about implicit character*(*). + +Thu Nov 14 08:50:42 EST 1991: + libi77: change uint to Uint in fmt.h, rdfmt.c, wrtfmt.c; this change +should be invisible unless you're running a brain-damaged system. + +Mon Nov 25 19:04:40 EST 1991: + libi77: correct botches introduced 17 Oct. 1991 and 14 Nov. 1991 +(change uint to Uint in lwrite.c; other changes that only matter if +sizeof(int) != sizeof(long)). + Add a more meaningful error message when bailing out due to an attempt +to invoke a COMMON variable as a function. + +Sun Dec 1 19:29:24 EST 1991: + libi77: uio.c: add test for read failure (seq. unformatted reads); +adjust an error return from EOF to off end of record. + +Tue Dec 10 17:42:28 EST 1991: + Add tests to prevent memory faults with bad uses of character*(*). + +Thu Dec 12 11:24:41 EST 1991: + libi77: fix bug with internal list input that caused the last +character of each record to be ignored; adjust error message in +internal formatted input from "end-of-file" to "off end of record" +if the format specifies more characters than the record contains. + +Wed Dec 18 17:48:11 EST 1991: + Fix bug in translating nonsensical ichar invocations involving +concatenations. + Fix bug in passing intrinsics lle, llt, lge, lgt as arguments; +hl_le was being passed rather than l_le, etc. + libf77: adjust length parameters from long to ftnlen, for +compiling with f2c_i2 defined. + +Sat Dec 21 15:30:57 EST 1991: + Allow DO nnn ... to end with an END DO statement labelled nnn. + +Tue Dec 31 13:53:47 EST 1991: + Fix bug in handling dimension a(n**3,2) -- pow_ii was called +incorrectly. + Fix bug in translating + subroutine x(abc,n) + character abc(n) + write(abc,'(i10)') 123 + end +(omitted declaration and initialiation of abc_dim1). + Complain about dimension expressions of such invalid types +as complex and logical. + +Fri Jan 17 11:54:20 EST 1992: + Diagnose some illegal uses of main program name (rather than +memory faulting). + libi77: (1) In list and namelist input, treat "r* ," and "r*," +alike (where r is a positive integer constant), and fix a bug in +handling null values following items with repeat counts (e.g., +2*1,,3). (2) For namelist reading of a numeric array, allow a new +name-value subsequence to terminate the current one (as though the +current one ended with the right number of null values). +(3) [lio.h, lwrite.c]: omit insignificant zeros in list and namelist +output. (Compile with -DOld_list_output to get the old behavior.) + +Sat Jan 18 15:58:01 EST 1992: + libi77: make list output consistent with F format by printing .1 +rather than 0.1 (introduced yesterday). + +Wed Jan 22 08:32:43 EST 1992: + libi77: add comment to README pointing out preconnection of +Fortran units 5, 6, 0 to stdin, stdout, stderr (respectively). + +Mon Feb 3 11:57:53 EST 1992: + libi77: fix namelist read bug that caused the character following +a comma to be ignored. + +Fri Feb 28 01:04:26 EST 1992: + libf77: fix buggy z_sqrt.c (double precision square root), which +misbehaved for arguments in the southwest quadrant. + +Thu Mar 19 15:05:18 EST 1992: + Fix bug (introduced 17 Jan 1992) in handling multiple entry points +of differing types (with implicitly typed entries appearing after +the first executable statement). + Fix memory fault in the following illegal Fortran: + double precision foo(i) +* illegal: above should be "double precision function foo(i)" + foo = i * 3.2 + entry moo(i) + end + Note about ANSI_Libraries (relevant, e.g., to IRIX 4.0.1 and AIX) +added to README. + Abort zero divides during constant simplification. + +Sat Mar 21 01:27:09 EST 1992: + Tweak ckalloc (misc.c) for systems where malloc(0) = 0; this matters +for subroutines with multiple entry points but no arguments. + Add "struct memblock;" to init.c (irrelevant to most compilers). + +Wed Mar 25 13:31:05 EST 1992: + Fix bug with IMPLICIT INTEGER*4(...): under -i2 or -I2, the *4 was +ignored. + +Tue May 5 09:53:55 EDT 1992: + Tweaks to README; e.g., ANSI_LIbraries changed to ANSI_Libraries . + +Wed May 6 23:49:07 EDT 1992 + Under -A and -C++, have subroutines return 0 (even if they have +no * arguments). + Adjust libi77 (rsne.c and lread.c) for systems where ungetc is +a macro. Tweak lib[FI]77/makefile to use unique intermediate file +names (for parallel makes). + +Tue May 19 09:03:05 EDT 1992: + Adjust libI77 to make err= work with internal list and formatted I/O. + +Sat May 23 18:17:42 EDT 1992: + Under -A and -C++, supply "return 0;" after the code generated for +a STOP statement -- the C compiler doesn't know that s_stop won't +return. + New (mutually exclusive) options: + -f treats all input lines as free-format lines, + honoring text that appears after column 72 + and not padding lines shorter than 72 characters + with blanks (which matters if a character string + is continued across 2 or more lines). + -72 treats text appearing after column 72 as an error. + +Sun May 24 09:45:37 EDT 1992: + Tweak description of -f in f2c.1 and f2c.1t; update f2c.ps . + +Fri May 29 01:17:15 EDT 1992: + Complain about externals used as variables. Example + subroutine foo(a,b) + external b + a = a*b ! illegal use of b; perhaps should be b() + end + +Mon Jun 15 11:15:27 EDT 1992: + Fix bug in handling namelists with names that have underscores. + +Sat Jun 27 17:30:59 EDT 1992: + Under -A and -C++, end Main program aliases with "return 0;". + Under -A and -C++, use .P files and usage in previous subprograms +in the current file to give prototypes for functions declared EXTERNAL +but not invoked. + Fix memory fault under -d1 -P . + Under -A and -C++, cast arguments to the right types in calling +a function that has been defined in the current file or in a .P file. + Fix bug in handling multi-dimensional arrays with array references +in their leading dimensions. + Fix bug in the intrinsic cmplx function when the first argument +involves an expression for which f2c generates temporary variables, +e.g. cmplx(abs(real(a)),1.) . + +Sat Jul 18 07:36:58 EDT 1992: + Fix buglet with -e1c (invisible on most systems) temporary file +f2c_functions was unlinked before being closed. + libf77: fix bugs in evaluating m**n for integer n < 0 and m an +integer different from 1 or a real or double precision 0. +Catch SIGTRAP (to print "Trace trap" before aborting). Programs +that previously erroneously computed 1 for 0**-1 may now fault. +Relevant routines: main.c pow_di.c pow_hh.c pow_ii.c pow_ri.c . + +Sat Jul 18 08:40:10 EDT 1992: + libi77: allow namelist input to end with & (e.g. &end). + +Thu Jul 23 00:14:43 EDT 1992 + Append two underscores rather than one to C keywords used as +local variables to avoid conflicts with similarly named COMMON blocks. + +Thu Jul 23 11:20:55 EDT 1992: + libf77, libi77 updated to assume ANSI prototypes unless KR_headers +is #defined. + libi77 now recognizes a Z format item as in Fortran 90; +the implementation assumes 8-bit bytes and botches character strings +on little-endian machines (by printing their bytes from right to +left): expect this bug to persist; fixing it would require a +change to the I/O calling sequences. + +Tue Jul 28 15:18:33 EDT 1992: + libi77: insert missed "#ifdef KR_headers" lines around getnum +header in rsne.c. Version not updated. + +NOTE: "index from f2c" now ends with current timestamps of files in +"all from f2c/src", sorted by time. To bring your source up to date, +obtain source files with a timestamp later than the time shown in your +version.c. + +Fri Aug 14 08:07:09 EDT 1992: + libi77: tweak wrt_E in wref.c to avoid signing NaNs. + +Sun Aug 23 19:05:22 EDT 1992: + fc: supply : after O in getopt invocation (for -O1 -O2 -O3). + +Mon Aug 24 18:37:59 EDT 1992: + Recant above tweak to fc: getopt is dumber than I thought; +it's necessary to say -O 1 (etc.). + libF77/README: add comments about ABORT, ERF, DERF, ERFC, DERFC, +GETARG, GETENV, IARGC, SIGNAL, and SYSTEM. + +Tue Oct 27 01:57:42 EST 1992: + libf77, libi77: + 1. Fix botched indirection in signal_.c. + 2. Supply missing l_eof = 0 assignment to s_rsne() in rsne.c (so +end-of-file on other files won't confuse namelist reads of external +files). + 3. Prepend f__ to external names that are only of internal +interest to lib[FI]77. + +Thu Oct 29 12:37:18 EST 1992: + libf77: Fix botch in signal_.c when KR_headers is #defined; +add CFLAGS to makefile. + libi77: trivial change to makefile for consistency with +libF77/makefile. + +Wed Feb 3 02:05:16 EST 1993: + Recognize types INTEGER*1, LOGICAL*1, LOGICAL*2, INTEGER*8. +INTEGER*8 is not well tested and will only work reasonably on +systems where int = 4 bytes, long = 8 bytes; on such systems, +you'll have to modify f2c.h appropriately, changing integer +from long to int and adding typedef long longint. You'll also +have to compile libI77 with Allow_TYQUAD #defined and adjust +libF77/makefile to compile pow_qq.c. In the f2c source, changes +for INTEGER*8 are delimited by #ifdef TYQUAD ... #endif. You +can omit the INTEGER*8 changes by compiling with NO_TYQUAD +#defined. Otherwise, the new command-line option -!i8 +disables recognition of INTEGER*8. + libf77: add pow_qq.c + libi77: add #ifdef Allow_TYQUAD stuff. Changes for INTEGER*1, +LOGICAL*1, and LOGICAL*2 came last 23 July 1992. Fix bug in +backspace (that only bit when the last character of the second +or subsequent buffer read was the previous newline). Guard +against L_tmpnam being too small in endfile.c. For MSDOS, +close and reopen files when copying to truncate. Lengthen +LINTW (buffer size in lwrite.c). + Add \ to the end of #define lines that get broken. + Fix bug in handling NAMELIST of items in EQUIVALENCE. + Under -h (or -hd), convert Hollerith to integer in general expressions +(e.g., assignments), not just when they're passed as arguments, and +blank-pad rather than 0-pad the Hollerith to a multiple of +sizeof(integer) or sizeof(doublereal). + Add command-line option -s, which instructs f2c preserve multi- +dimensional subscripts (by emitting and using appropriate #defines). + Fix glitch (with default type inferences) in examples like + call foo('abc') + end + subroutine foo(goo) + end +This gave two warning messages: + Warning on line 4 of y.f: inconsistent calling sequences for foo: + here 1, previously 2 args and string lengths. + Warning on line 4 of y.f: inconsistent calling sequences for foo: + here 2, previously 1 args and string lengths. +Now the second Warning is suppressed. + Complain about all inconsistent arguments, not just the first. + Switch to automatic creation of "all from f2c/src". For folks +getting f2c source via ftp, this means f2c/src/all.Z is now an +empty file rather than a bundle. + Separate -P and -A: -P no longer implies -A. + +Thu Feb 4 00:32:20 EST 1993: + Fix some glitches (introduced yesterday) with -h . + +Fri Feb 5 01:40:38 EST 1993: + Fix bug in types conveyed for namelists (introduced 3 Feb. 1993). + +Fri Feb 5 21:26:43 EST 1993: + libi77: tweaks to NAMELIST and open (after comments by Harold +Youngren): + 1. Reading a ? instead of &name (the start of a namelist) causes + the namelist being sought to be written to stdout (unit 6); + to omit this feature, compile rsne.c with -DNo_Namelist_Questions. + 2. Reading the wrong namelist name now leads to an error message + and an attempt to skip input until the right namelist name is found; + to omit this feature, compile rsne.c with -DNo_Bad_Namelist_Skip. + 3. Namelist writes now insert newlines before each variable; to omit + this feature, compile xwsne.c with -DNo_Extra_Namelist_Newlines. + 4. For OPEN of sequential files, ACCESS='APPEND' (or + access='anything else starting with "A" or "a"') causes the file to + be positioned at end-of-file, so a write will append to the file. + (This is nonstandard, but does not require modifying data + structures.) + +Mon Feb 8 14:40:37 EST 1993: + Increase number of continuation lines allowed from 19 to 99, +and allow changing this limit with -NC (e.g. -NC200 for 200 lines). + Treat control-Z (at the beginning of a line) as end-of-file: see +the new penultimate paragraph of README. + Fix a rarely seen glitch that could make an error messages to say +"line 0". + +Tue Feb 9 02:05:40 EST 1993 + libi77: change some #ifdef MSDOS lines to #ifdef NON_UNIX_STDIO, +and, in err.c under NON_UNIX_STDIO, avoid close(creat(name,0666)) +when the unit has another file descriptor for name. + +Tue Feb 9 17:12:49 EST 1993 + libi77: more tweaks for NON_UNIX_STDIO: use stdio routines +rather than open, close, creat, seek, fdopen (except for f__isdev). + +Fri Feb 12 15:49:33 EST 1993 + Update src/gram.c (which was forgotten in the recent updates). +Most folks regenerate it anyway (wity yacc or bison). + +Thu Mar 4 17:07:38 EST 1993 + Increase default max labels in computed gotos and alternate returns +to 257, and allow -Nl1234 to specify this number. + Tweak put.c to check p->tag == TADDR in realpart() and imagpart(). + Adjust fc script to allow .r (RATFOR) files and -C (check subscripts). + Avoid declaring strchr in niceprintf.c under -DANSI_Libraries . + gram.c updated again. + libi77: err.c, open.c: take declaration of fdopen from rawio.h. + +Sat Mar 6 07:09:11 EST 1993 + libi77: uio.c: adjust off-end-of-record test for sequential +unformatted reads to respond to err= rather than end= . + +Sat Mar 6 16:12:47 EST 1993 + Treat scalar arguments of the form (v) and v+0, where v is a variable, +as expressions: assign to a temporary variable, and pass the latter. + gram.c updated. + +Mon Mar 8 09:35:38 EST 1993 + "f2c.h from f2c" updated to add types logical1 and integer1 for +LOGICAL*1 and INTEGER*1. ("f2c.h from f2c" is supposed to be the +same as "f2c.h from f2c/src", which was updated 3 Feb. 1993.) + +Mon Mar 8 17:57:55 EST 1993 + Fix rarely seen bug that could cause strange casts in function +invocations (revealed by an example with msdos/f2c.exe). + msdos/f2cx.exe.Z and msdos/f2c.exe.Z updated (ftp access only). + +Fri Mar 12 12:37:01 EST 1993 + Fix bug with -s in handling subscripts involving min, max, and +complicated expressions requiring temporaries. + Fix bug in handling COMMONs that need padding by a char array. + msdos/f2cx.exe.Z and msdos/f2c.exe.Z updated (ftp access only). + +Fri Mar 12 17:16:16 EST 1993 + libf77, libi77: updated for compiling under C++. + +Mon Mar 15 16:21:37 EST 1993 + libi77: more minor tweaks (for -DKR_headers); Version.c not changed. + +Thu Mar 18 12:37:30 EST 1993 + Flag -r (for discarding carriage-returns on systems that end lines +with carriage-return/newline pairs, e.g. PCs) added to xsum, and +xsum.c converted to ANSI/ISO syntax (with K&R syntax available with +-DKR_headers). [When time permits, the f2c source will undergo a +similar conversion.] + libi77: tweaks to #includes in endfile.c, err.c, open.c, rawio.h; +Version.c not changed. + f2c.ps updated (to pick up revision of 2 Feb. 1993 to f2c.1). + +Fri Mar 19 09:19:26 EST 1993 + libi77: add (char *) casts to malloc and realloc invocations +in err.c, open.c; Version.c not changed. + +Tue Mar 30 07:17:15 EST 1993 + Fix bug introduced 6 March 1993: possible memory corruption when +loops in data statements involve constant subscripts, as in + DATA (GUNIT(1,I),I=0,14)/15*-1/ + +Tue Mar 30 16:17:42 EST 1993 + Fix bug with -s: (floating-point array item)*(complex item) +generates an _subscr() reference for the floating-point array, +but a #define for the _subscr() was omitted. + +Tue Apr 6 12:11:22 EDT 1993 + libi77: adjust error returns for formatted inputs to flush the current +input line when err= is specified. To restore the old behavior (input +left mid-line), either adjust the #definition of errfl in fio.h or omit +the invocation of f__doend in err__fl (in err.c). + +Tue Apr 6 13:30:04 EDT 1993 + Fix bug revealed in + subroutine foo(i) + call goo(int(i)) + end +which now passes a copy of i, rather than i itself. + +Sat Apr 17 11:41:02 EDT 1993 + Adjust appending of underscores to conform with f2c.ps ("A Fortran +to C Converter"): names that conflict with C keywords or f2c type +names now have just one underscore appended (rather than two); add +"integer1", "logical1", "longint" to the keyword list. + Append underscores to names that appear in EQUIVALENCE and are +component names in a structure declared in f2c.h, thus avoiding a +problem caused by the #defines emitted for equivalences. Example: + complex a + equivalence (i,j) + a = 1 ! a.i went awry because of #define i + j = 2 + write(*,*) a, i + end + Adjust line-breaking logic to avoid splitting very long constants +(and names). Example: + ! The next line starts with tab and thus is a free-format line. + a=.012345689012345689012345689012345689012345689012345689012345689012345689 + end + Omit extraneous "return 0;" from entry stubs emitted for multiple +entry points of type character, complex, or double complex. + +Sat Apr 17 14:35:05 EDT 1993 + Fix bug (introduced 4 Feb.) in separating -P from -A that kept f2c +from re-reading a .P file written without -A or -C++ describing a +routine with an external argument. [See the just-added note about +separating -P from -A in the changes above for 3 Feb. 1993.] + Fix bug (type UNKNOWN for V in the example below) revealed by + subroutine a() + external c + call b(c) + end + subroutine b(v) + end + +Sun Apr 18 19:55:26 EDT 1993 + Fix wrong calling sequence for mem() in yesterday's addition to +equiv.c . + +Wed Apr 21 17:39:46 EDT 1993 + Fix bug revealed in + + ASSIGN 10 TO L1 + GO TO 20 + 10 ASSIGN 30 TO L2 + STOP 10 + + 20 ASSIGN 10 TO L2 ! Bug here because 10 had been assigned + ! to another label, then defined. + GO TO L2 + 30 END + +Fri Apr 23 18:38:50 EDT 1993 + Fix bug with -h revealed in + CHARACTER*9 FOO + WRITE(FOO,'(I6)') 1 + WRITE(FOO,'(I6)') 2 ! struct icilist io___3 botched + END + +Tue Apr 27 16:08:28 EDT 1993 + Tweak to makefile: remove "size f2c". + +Tue May 4 23:48:20 EDT 1993 + libf77: tweak signal_ line of f2ch.add . + +Tue Jun 1 13:47:13 EDT 1993 + Fix bug introduced 3 Feb. 1993 in handling multiple entry +points with differing return types -- the postfix array in proc.c +needed a new entry for integer*8 (which resulted in wrong +Multitype suffixes for non-integral types). + For (default) K&R C, generate VOID rather than int functions for +functions of Fortran type character, complex, and double complex. + msdos/f2cx.exe.Z and msdos/f2c.exe.Z updated (ftp access only). + +Tue Jun 1 23:11:15 EDT 1993 + f2c.h: add Multitype component g and commented type longint. + proc.c: omit "return 0;" from stubs for complex and double complex +entries (when entries have multiple types); add test to avoid memory +fault with illegal combinations of entry types. + +Mon Jun 7 12:00:47 EDT 1993 + Fix memory fault in + common /c/ m + integer m(1) + data m(1)/1/, m(2)/2/ ! one too many initializers + end + msdos/f2cx.exe.Z and msdos/f2c.exe.Z updated (ftp access only). + +Fri Jun 18 13:55:51 EDT 1993 + libi77: change type of signal_ in f2ch.add; change type of il in +union Uint from long to integer (for machines like the DEC Alpha, +where integer should be the same as int). Version.c not changed. + Tweak gram.dcl and gram.head: add semicolons after some rules that +lacked them, and remove an extraneous semicolon. These changes are +completely transparent to our local yacc programs, but apparently +matter on some VMS systems. + +Wed Jun 23 01:02:56 EDT 1993 + Update "fc" shell script, and bring f2c.1 and f2c.1t up to date: +they're meant to be linked with (i.e., the same as) src/f2c.1 and +src/f2c.1t . [In the last update of f2c.1* (2 Feb. 1993), only +src/f2c.1 and src/f2c.1t got changed -- a mistake.] + +Wed Jun 23 09:04:31 EDT 1993 + libi77: fix bug in format reversions for internal writes. +Example: + character*60 lines(2) + write(lines,"('n =',i3,2(' more text',i3))") 3, 4, 5, 6 + write(*,*) 'lines(1) = ', lines(1) + write(*,*) 'lines(2) = ', lines(2) + end +gave an error message that began "iio: off end of record", rather +than giving the correct output: + + lines(1) = n = 3 more text 4 more text 5 + lines(2) = more text 6 more text + +Thu Aug 5 11:31:14 EDT 1993 + libi77: lread.c: fix bug in handling repetition counts for logical +data (during list or namelist input). Change struct f__syl to +struct syl (for buggy compilers). + +Sat Aug 7 16:05:30 EDT 1993 + libi77: lread.c (again): fix bug in namelist reading of incomplete +logical arrays. + Fix minor calling-sequence errors in format.c, output.c, putpcc.c: +should be invisible. + +Mon Aug 9 09:12:38 EDT 1993 + Fix erroneous cast under -A in translating + character*(*) function getc() + getc(2:3)=' ' !wrong cast in first arg to s_copy + end + libi77: lread.c: fix bug in namelist reading of an incomplete array +of numeric data followed by another namelist item whose name starts +with 'd', 'D', 'e', or 'E'. + +Fri Aug 20 13:22:10 EDT 1993 + Fix bug in do while revealed by + subroutine skdig (line, i) + character line*(*), ch*1 + integer i + logical isdigit + isdigit(ch) = ch.ge.'0' .and. ch.le.'9' + do while (isdigit(line(i:i))) ! ch__1[0] was set before + ! "while(...) {...}" + i = i + 1 + enddo + end + +Fri Aug 27 08:22:54 EDT 1993 + Add #ifdefs to avoid declaring atol when it is a macro; version.c +not updated. + +Wed Sep 8 12:24:26 EDT 1993 + libi77: open.c: protect #include "sys/..." with +#ifndef NON_UNIX_STDIO; Version date not changed. + +Thu Sep 9 08:51:21 EDT 1993 + Adjust "include" to interpret file names relative to the directory +of the file that contains the "include". + +Fri Sep 24 00:56:12 EDT 1993 + Fix offset error resulting from repeating the same equivalence +statement twice. Example: + real a(2), b(2) + equivalence (a(2), b(2)) + equivalence (a(2), b(2)) + end + Increase MAXTOKENLEN (to roughly the largest allowed by ANSI C). + +Mon Sep 27 08:55:09 EDT 1993 + libi77: endfile.c: protect #include "sys/types.h" with +#ifndef NON_UNIX_STDIO; Version.c not changed. + +Fri Oct 15 15:37:26 EDT 1993 + Fix rarely seen parsing bug illustrated by + subroutine foo(xabcdefghij) + character*(*) xabcdefghij + IF (xabcdefghij.NE.'##') GOTO 40 + 40 end +in which the spacing in the IF line is crucial. + +Thu Oct 21 13:55:11 EDT 1993 + Give more meaningful error message (then "unexpected character in +cds") when constant simplification leads to Infinity or NaN. + +Wed Nov 10 15:01:05 EST 1993 + libi77: backspace.c: adjust, under -DMSDOS, to cope with MSDOS +text files, as handled by some popular PC C compilers. Beware: +the (defective) libraries associated with these compilers assume lines +end with \r\n (conventional MS-DOS text files) -- and ftell (and +hence the current implementation of backspace) screws up if lines with +just \n. + +Thu Nov 18 09:37:47 EST 1993 + Give a better error (than "control stack empty") for an extraneous +ENDDO. Example: + enddo + end + Update comments about ftp in "readme from f2c". + +Sun Nov 28 17:26:50 EST 1993 + Change format of time stamp in version.c to yyyymmdd. + Sort parameter adjustments (or complain of impossible dependencies) +so that dummy arguments are referenced only after being adjusted. +Example: + subroutine foo(a,b) + integer a(2) ! a must be adjusted before b + double precision b(a(1),a(2)) + call goo(b(3,4)) + end + Adjust structs for initialized common blocks and equivalence classes +to omit the trailing struct component added to force alignment when +padding already forces the desired alignment. Example: + PROGRAM TEST + COMMON /Z/ A, CC + CHARACTER*4 CC + DATA cc /'a'/ + END +now gives + struct { + integer fill_1[1]; + char e_2[4]; + } z_ = { {0}, {'a', ' ', ' ', ' '} }; +rather than +struct { + integer fill_1[1]; + char e_2[4]; + real e_3; + } z_ = { {0}, {'a', ' ', ' ', ' '}, (float)0. }; + +Wed Dec 8 16:24:43 EST 1993 + Adjust lex.c to recognize # nnn "filename" lines emitted by cpp; +this affects the file names and line numbers in error messages and +the #line lines emitted under -g. + Under -g, arrange for a file that starts with an executable +statement to have the first #line line indicate line 1, rather +than the line number of the END statement ending the main program. + Adjust fc script to run files ending in .F through /lib/cpp. + Fix bug ("Impossible tag 2") in + if (t .eq. (0,2)) write(*,*) 'Bug!' + end + libi77: iio.c: adjust internal formatted reads to treat short records +as though padded with blanks (rather than causing an "off end of record" +error). + +Wed Dec 15 15:19:15 EST 1993 + fc: adjusted for .F files to pass -D and -I options to cpp. + +Fri Dec 17 20:03:38 EST 1993 + Fix botch introduced 28 Nov. 1993 in vax.c; change "version of" +to "version". + +Tue Jan 4 15:39:52 EST 1994 + msdos/f2cx.exe.Z and msdos/f2c.exe.Z updated (ftp access only). + +Wed Jan 19 08:55:19 EST 1994 + Arrange to accept + integer Nx, Ny, Nz + parameter (Nx = 10, Ny = 20) + parameter (Nz = max(Nx, Ny)) + integer c(Nz) + call foo(c) + end +rather than complaining "Declaration error for c: adjustable dimension +on non-argument". The necessary changes cause some hitherto unfolded +constant expressions to be folded. + Accept BYTE as a synonym for INTEGER*1. + +Thu Jan 27 08:57:40 EST 1994 + Fix botch in changes of 19 Jan. 1994 that broke entry points with +multi-dimensional array arguments that did not appear in the subprogram +argument list and whose leading dimensions depend on arguments. + +Mon Feb 7 09:24:30 EST 1994 + Remove artifact in "fc" script that caused -O to be ignored: + 87c87 + < # lcc ignores -O... + --- + > CFLAGS="$CFLAGS $O" + +Sun Feb 20 17:04:58 EST 1994 + Fix bugs reading .P files for routines with arguments of type +INTEGER*1, INTEGER*8, LOGICAL*2. + Fix glitch in reporting inconsistent arguments for routines involving +character arguments: "arg n" had n too large by the number of +character arguments. + +Tue Feb 22 20:50:08 EST 1994 + Trivial changes to data.c format.c main.c niceprintf.c output.h and +sysdep.h (consistency improvements). + libI77: lread.c: check for NULL return from realloc. + +Fri Feb 25 23:56:08 EST 1994 + output.c, sysdep.h: arrange for -DUSE_DTOA to use dtoa.c and g_fmt.c +for correctly rounded decimal values on IEEE-arithmetic machines +(plus machines with VAX and IBM-mainframe arithmetic). These +routines are available from netlib's fp directory. + msdos/f2cx.exe.Z and msdos/f2c.exe.Z updated (ftp access only); the +former uses -DUSE_DTOA to keep 12 from printing as 12.000000000000001. + vax.c: fix wrong arguments to badtag and frchain introduced +28 Nov. 1993. + Source for f2c converted to ANSI/ISO format, with the K&R format +available by compilation with -DKR_headers . + Arrange for (double precision expression) relop (single precision +constant) to retain the single-precision nature of the constant. +Example: + double precision t + if (t .eq. 0.3) ... + +Mon Feb 28 11:40:24 EST 1994 + README updated to reflect a modification just made to netlib's +"dtoa.c from fp": +96a97,105 +> Also add the rule +> +> dtoa.o: dtoa.c +> $(CC) -c $(CFLAGS) -DMALLOC=ckalloc -DIEEE... dtoa.c +> +> (without the initial tab) to the makefile, where IEEE... is one of +> IEEE_MC68k, IEEE_8087, VAX, or IBM, depending on your machine's +> arithmetic. See the comments near the start of dtoa.c. +> + +Sat Mar 5 09:41:52 EST 1994 + Complain about functions with the name of a previously declared +common block (which is illegal). + New option -d specifies the directory for output .c and .P files; +f2c.1 and f2c.1t updated. The former undocumented debug option -dnnn +is now -Dnnn. + +Thu Mar 10 10:21:44 EST 1994 + libf77: add #undef min and #undef max lines to s_paus.c s_stop.c +and system_.c; Version.c not changed. + libi77: add -DPad_UDread lines to uio.c and explanation to README: + Some buggy Fortran programs use unformatted direct I/O to write + an incomplete record and later read more from that record than + they have written. For records other than the last, the unwritten + portion of the record reads as binary zeros. The last record is + a special case: attempting to read more from it than was written + gives end-of-file -- which may help one find a bug. Some other + Fortran I/O libraries treat the last record no differently than + others and thus give no help in finding the bug of reading more + than was written. If you wish to have this behavior, compile + uio.c with -DPad_UDread . +Version.c not changed. + +Tue Mar 29 17:27:54 EST 1994 + Adjust make_param so dimensions involving min, max, and other +complicated constant expressions do not provoke error messages +about adjustable dimensions on non-arguments. + Fix botch introduced 19 Jan 1994: "adjustable dimension on non- +argument" messages could cause some things to be freed twice. + +Tue May 10 07:55:12 EDT 1994 + Trivial changes to exec.c, p1output.c, parse_args.c, proc.c, +and putpcc.c: change arguments from + type foo[] +to + type *foo +for consistency with defs.h. For most compilers, this makes no +difference. + +Thu Jun 2 12:18:18 EDT 1994 + Fix bug in handling FORMAT statements that have adjacent character +(or Hollerith) strings: an extraneous \002 appeared between the +strings. + libf77: under -DNO_ONEXIT, arrange for f_exit to be called just +once; previously, upon abnormal termination (including stop statements), +it was called twice. + +Mon Jun 6 15:52:57 EDT 1994 + libf77: Avoid references to SIGABRT and SIGIOT if neither is defined; +Version.c not changed. + libi77: Add cast to definition of errfl() in fio.h; this only matters +on systems with sizeof(int) < sizeof(long). Under -DNON_UNIX_STDIO, +use binary mode for direct formatted files (to avoid any confusion +connected with \n characters). + +Fri Jun 10 16:47:31 EDT 1994 + Fix bug under -A in handling unreferenced (and undeclared) +external arguments in subroutines with multiple entry points. Example: + subroutine m(fcn,futil) + external fcn,futil + call fcn + entry mintio(i1) ! (D_fp)0 rather than (U_fp)0 for futil + end + +Wed Jun 15 10:38:14 EDT 1994 + Allow char(constant expression) function in parameter declarations. +(This was probably broken in the changes of 29 March 1994.) + +Fri Jul 1 23:54:00 EDT 1994 + Minor adjustments to makefile (rule for f2c.1 commented out) and +sysdep.h (#undef KR_headers if __STDC__ is #defined, and base test +for ANSI_Libraries and ANSI_Prototypes on KR_headers rather than +__STDC__); version.c touched but not changed. + libi77: adjust fp.h so local.h is only needed under -DV10; +Version.c not changed. + +Tue Jul 5 03:05:46 EDT 1994 + Fix segmentation fault in + subroutine foo(a,b,k) + data i/1/ + double precision a(k,1) ! sequence error: must precede data + b = a(i,1) + end + libi77: Fix bug (introduced 6 June 1994?) in reopening files under +NON_UNIX_STDIO. + Fix some error messages caused by illegal Fortran. Examples: +* 1. + x(i) = 0 !Missing declaration for array x + call f(x) !Said Impossible storage class 8 in routine mkaddr + end !Now says invalid use of statement function x +* 2. + f = g !No declaration for g; by default it's a real variable + call g !Said invalid class code 2 for function g + end !Now says g cannot be called +* 3. + intrinsic foo !Invalid intrinsic name + a = foo(b) !Said intrcall: bad intrgroup 0 + end !Now just complains about line 1 + +Tue Jul 5 11:14:26 EDT 1994 + Fix glitch in handling erroneous statement function declarations. +Example: + a(j(i) - i) = a(j(i) - i) + 1 ! bad statement function + call foo(a(3)) ! Said Impossible type 0 in routine mktmpn + end ! Now warns that i and j are not used + +Wed Jul 6 17:31:25 EDT 1994 + Tweak test for statement functions that (illegally) call themselves; +f2c will now proceed to check for other errors, rather than bailing +out at the first recursive statement function reference. + Warn about but retain divisions by 0 (instead of calling them +"compiler errors" and quiting). On IEEE machines, this permits + double precision nan, ninf, pinf + nan = 0.d0/0.d0 + pinf = 1.d0/0.d0 + ninf = -1.d0/0.d0 + write(*,*) 'nan, pinf, ninf = ', nan, pinf, ninf + end +to print + nan, pinf, ninf = NaN Infinity -Infinity + libi77: wref.c: protect with #ifdef GOOD_SPRINTF_EXPONENT an +optimization that requires exponents to have 2 digits when 2 digits +suffice. lwrite.c wsfe.c (list and formatted external output): +omit ' ' carriage-control when compiled with -DOMIT_BLANK_CC . +Off-by-one bug fixed in character count for list output of character +strings. Omit '.' in list-directed printing of Nan, Infinity. + +Mon Jul 11 13:05:33 EDT 1994 + src/gram.c updated. + +Tue Jul 12 10:24:42 EDT 1994 + libi77: wrtfmt.c: under G11.4, write 0. as " .0000 " rather +than " .0000E+00". + +Thu Jul 14 17:55:46 EDT 1994 + Fix glitch in changes of 6 July 1994 that could cause erroneous +"division by zero" warnings (or worse). Example: + subroutine foo(a,b) + y = b + a = a / y ! erroneous warning of division by zero + end + +Mon Aug 1 16:45:17 EDT 1994 + libi77: lread.c rsne.c: for benefit of systems with a buggy stdio.h, +declare ungetc when neither KR_headers nor ungetc is #defined. +Version.c not changed. + +Wed Aug 3 01:53:00 EDT 1994 + libi77: lwrite.c (list output): do not insert a newline when +appending an oversize item to an empty line. + +Mon Aug 8 00:51:01 EDT 1994 + Fix bug (introduced 3 Feb. 1993) that, under -i2, kept LOGICAL*2 +variables from appearing in INQUIRE statements. Under -I2, allow +LOGICAL*4 variables to appear in INQUIRE. Fix intrinsic function +LEN so it returns a short value under -i2, a long value otherwise. + exec.c: fix obscure memory fault possible with bizarre (and highly +erroneous) DO-loop syntax. + +Fri Aug 12 10:45:57 EDT 1994 + libi77: fix glitch that kept ERR= (in list- or format-directed input) +from working after a NAMELIST READ. + +Thu Aug 25 13:58:26 EDT 1994 + Suppress -s when -C is specified. + Give full pathname (netlib@research.att.com) for netlib in readme and +src/README. + +Wed Sep 7 22:13:20 EDT 1994 + libi77: typesize.c: adjust to allow types LOGICAL*1, LOGICAL*2, +INTEGER*1, and (under -DAllow_TYQUAD) INTEGER*8 in NAMELISTs. + +Fri Sep 16 17:50:18 EDT 1994 + Change name adjustment for reserved words: instead of just appending +"_" (a single underscore), append "_a_" to local variable names to avoid +trouble when a common block is named a reserved word and the same +reserved word is also a local variable name. Example: + common /const/ a,b,c + real const(3) + equivalence (const(1),a) + a = 1.234 + end + Arrange for ichar() to treat characters as unsigned. + libf77: s_cmp.c: treat characters as unsigned in comparisons. +These changes for unsignedness only matter for strings that contain +non-ASCII characters. Now ichar() should always be >= 0. + +Sat Sep 17 11:19:32 EDT 1994 + fc: set rc=$? before exit (to get exit code right in trap code). + +Mon Sep 19 17:49:43 EDT 1994 + libf77: s_paus.c: flush stderr after PAUSE; add #ifdef MSDOS stuff. + libi77: README: point out general need for -DMSDOS under MS-DOS. + +Tue Sep 20 11:42:30 EDT 1994 + Fix bug in comparing identically named common blocks, in which +all components have the same names and types, but at least one is +dimensioned (1) and the other is not dimensioned. Example: + subroutine foo + common /ab/ a + a=1. !!! translated correctly to ab_1.a = (float)1.; + end + subroutine goo + common /ab/ a(1) + a(1)=2. !!! translated erroneously to ab_1.a[0] = (float)2. + end + +Tue Sep 27 23:47:34 EDT 1994 + Fix bug introduced 16 Sept. 1994: don't add _a_ to C keywords +used as external names. In fact, return to earlier behavior of +appending __ to C keywords unless they are used as external names, +in which case they get just one underscore appended. + Adjust constant handling so integer and logical PARAMETERs retain +type information, particularly under -I2. Example: + SUBROUTINE FOO + INTEGER I + INTEGER*1 I1 + INTEGER*2 I2 + INTEGER*4 I4 + LOGICAL L + LOGICAL*1 L1 + LOGICAL*2 L2 + LOGICAL*4 L4 + PARAMETER (L=.FALSE., L1=.FALSE., L2=.FALSE., L4=.FALSE.) + PARAMETER (I=0,I1=0,I2=0,I4=0) + CALL DUMMY(I, I1, I2, I4, L, L1, L2, L4) + END + f2c.1t: Change f\^2c to f2c (omit half-narrow space) in line following +".SH NAME" for benefit of systems that cannot cope with troff commands +in this context. + +Wed Sep 28 12:45:19 EDT 1994 + libf77: s_cmp.c fix glitch in -DKR_headers version introduced +12 days ago. + +Thu Oct 6 09:46:53 EDT 1994 + libi77: util.c: omit f__mvgbt (which is never used). + f2c.h: change "long" to "long int" to facilitate the adjustments +by means of sed described above. Comment out unused typedef of Long. + +Fri Oct 21 18:02:24 EDT 1994 + libf77: add s_catow.c and adjust README to point out that changing +"s_cat.o" to "s_catow.o" in the makefile will permit the target of a +concatenation to appear on its right-hand side (contrary to the +Fortran 77 Standard and at the cost of some run-time efficiency). + +Wed Nov 2 00:03:58 EST 1994 + Adjust -g output to contain only one #line line per statement, +inserting \ before the \n ending lines broken because of their +length [this insertion was recanted 10 Dec. 1994]. This change +accommodates an idiocy in the ANSI/ISO C standard, which leaves +undefined the behavior of #line lines that occur within the arguments +to a macro call. + +Wed Nov 2 14:44:27 EST 1994 + libi77: under compilation with -DALWAYS_FLUSH, flush buffers at +the end of each write statement, and test (via the return from +fflush) for write failures, which can be caught with an ERR= +specifier in the write statement. This extra flushing slows +execution, but can abort execution or alter the flow of control +when a disk fills up. + f2c/src/io.c: Add ERR= test to e_wsle invocation (end of +list-directed external output) to catch write failures when libI77 +is compiled with -DALWAYS_FLUSH. + +Thu Nov 3 10:59:13 EST 1994 + Fix bug in handling dimensions involving certain intrinsic +functions of constant expressions: the expressions, rather than +pointers to them, were passed. Example: + subroutine subtest(n,x) + real x(2**n,n) ! pow_ii(2,n) was called; now it's pow_ii(&c__2,n) + x(2,2)=3. + end + +Tue Nov 8 23:56:30 EST 1994 + malloc.c: remove assumption that only malloc calls sbrk. This +appears to make malloc.c useful on RS6000 systems. + +Sun Nov 13 13:09:38 EST 1994 + Turn off constant folding of integers used in floating-point +expressions, so the assignment in + subroutine foo(x) + double precision x + x = x*1000000*500000 + end +is rendered as + *x = *x * 1000000 * 500000; +rather than as + *x *= 1783793664; + +Sat Dec 10 16:31:40 EST 1994 + Supply a better error message (than "Impossible type 14") for + subroutine foo + foo = 3 + end + Under -g, convey name of included files to #line lines. + Recant insertion of \ introduced (under -g) 2 Nov. 1994. + +Thu Dec 15 14:33:55 EST 1994 + New command-line option -Idir specifies directories in which to +look for non-absolute include files (after looking in the directory +of the current input file). There can be several -Idir options, each +specifying one directory. All -Idir options are considered, from +left to right, until a suitably named file is found. The -I2 and -I4 +command-line options have precedence, so directories named 2 or 4 +must be spelled by some circumlocation, such as -I./2 . + f2c.ps updated to mention the new -Idir option, correct a typo, +and bring the man page at the end up to date. + lex.c: fix bug in reading line numbers in #line lines. + fc updated to pass -Idir options to f2c. + +Thu Dec 29 09:48:03 EST 1994 + Fix bug (e.g., addressing fault) in diagnosing inconsistency in +the type of function eta in the following example: + function foo(c1,c2) + double complex foo,c1,c2 + double precision eta + foo = eta(c1,c2) + end + function eta(c1,c2) + double complex eta,c1,c2 + eta = c1*c2 + end + +Mon Jan 2 13:27:26 EST 1995 + Retain casts for SNGL (or FLOAT) that were erroneously optimized +away. Example: + subroutine foo(a,b) + double precision a,b + a = float(b) ! now rendered as *a = (real) (*b); + end + Use float (rather than double) temporaries in certain expressions +of type complex. Example: the temporary for sngl(b) in + complex a + double precision b + a = sngl(b) - (3.,4.) +is now of type float. + +Fri Jan 6 00:00:27 EST 1995 + Adjust intrinsic function cmplx to act as dcmplx (returning +double complex rather than complex) if either of its args is of +type double precision. The double temporaries used prior to 2 Jan. +1995 previously gave it this same behavior. + +Thu Jan 12 12:31:35 EST 1995 + Adjust -krd to use double temporaries in some calculations of +type complex. + libf77: pow_[dhiqrz][hiq].c: adjust x**i to work on machines +that sign-extend right shifts when i is the most negative integer. + +Wed Jan 25 00:14:42 EST 1995 + Fix memory fault in handling overlapping initializations in + block data + common /zot/ d + double precision d(3) + character*6 v(4) + real r(2) + equivalence (d(3),r(1)), (d(1),v(1)) + data v/'abcdef', 'ghijkl', 'mnopqr', 'stuvwx'/ + data r/4.,5./ + end + names.c: add "far", "huge", "near" to c_keywords (causing them +to have __ appended when used as local variables). + libf77: add s_copyow.c, an alternative to s_copy.c for handling +(illegal) character assignments where the right- and left-hand +sides overlap, as in a(2:4) = a(1:3). + +Thu Jan 26 14:21:19 EST 1995 + libf77: roll s_catow.c and s_copyow.c into s_cat.c and s_copy.c, +respectively, allowing the left-hand side of a character assignment +to appear on its right-hand side unless s_cat.c and s_copy.c are +compiled with -DNO_OVERWRITE (which is a bit more efficient). +Fortran 77 forbids the left-hand side from participating in the +right-hand side (of a character assignment), but Fortran 90 allows it. + libi77: wref.c: fix glitch in printing the exponent of 0 when +GOOD_SPRINTF_EXPONENT is not #defined. + +Fri Jan 27 12:25:41 EST 1995 + Under -C++ -ec (or -C++ -e1c), surround struct declarations with + #ifdef __cplusplus + extern "C" { + #endif +and + #ifdef __cplusplus + } + #endif +(This isn't needed with cfront, but apparently is necessary with +some other C++ compilers.) + libf77: minor tweak to s_copy.c: copy forward whenever possible +(for better cache behavior). + +Wed Feb 1 10:26:12 EST 1995 + Complain about parameter statements that assign values to dummy +arguments, as in + subroutine foo(x) + parameter(x = 3.4) + end + +Sat Feb 4 20:22:02 EST 1995 + fc: omit "lib=/lib/num/lib.lo". + +Wed Feb 8 08:41:14 EST 1995 + Minor changes to exec.c, putpcc.c to avoid "bad tag" or "error +in frexpr" with certain invalid Fortran. + +Sat Feb 11 08:57:39 EST 1995 + Complain about integer overflows, both in simplifying integer +expressions, and in converting integers from decimal to binary. + Fix a memory fault in putcx1() associated with invalid input. + +Thu Feb 23 11:20:59 EST 1995 + Omit MAXTOKENLEN; realloc token if necessary (to handle very long +strings). + +Fri Feb 24 11:02:00 EST 1995 + libi77: iio.c: z_getc: insert (unsigned char *) to allow internal +reading of characters with high-bit set (on machines that sign-extend +characters). + +Tue Mar 14 18:22:42 EST 1995 + Fix glitch (in io.c) in handling 0-length strings in format +statements, as in + write(*,10) + 10 format(' ab','','cd') + libi77: lread.c and rsfe.c: adjust s_rsle and s_rsfe to check for +end-of-file (to prevent infinite loops with empty read statements). + +Wed Mar 22 10:01:46 EST 1995 + f2c.ps: adjust discussion of -P on p. 7 to reflect a change made +3 Feb. 1993: -P no longer implies -A. + +Fri Apr 21 18:35:00 EDT 1995 + fc script: remove absolute paths (since PATH specifies only standard +places). On most systems, it's still necessary to adjust the PATH +assignment at the start of fc to fit the local conventions. + +Fri May 26 10:03:17 EDT 1995 + fc script: add recognition of -P and .P files. + libi77: iio.c: z_wnew: fix bug in handling T format items in internal +writes whose last item is written to an earlier position than some +previous item. + +Wed May 31 11:39:48 EDT 1995 + libf77: added subroutine exit(rc) (with integer return code rc), +which works like a stop statement but supplies rc as the program's +return code. + +Fri Jun 2 11:56:50 EDT 1995 + Fix memory fault in + parameter (x=2.) + data x /2./ + end +This now elicits two error messages; the second ("too many +initializers"), though not desirable, seems hard to eliminate +without considerable hassle. + +Mon Jul 17 23:24:20 EDT 1995 + Fix botch in simplifying constants in certain complex +expressions. Example: + subroutine foo(s,z) + double complex z + double precision s, M, P + parameter ( M = 100.d0, P = 2.d0 ) + z = M * M / s * dcmplx (1.d0, P/M) +*** The imaginary part of z was miscomputed *** + end + Under -ext, complain about nonintegral dimensions. + +Fri Jul 21 11:18:36 EDT 1995 + Fix glitch on line 159 of init.c: change + "(shortlogical *)0)", +to + "(shortlogical *)0", +This affects multiple entry points when some but not all have +arguments of type logical*2. + libi77: adjust lwrite.c, wref.c, wrtfmt.c so compiling with +-DWANT_LEAD_0 causes formatted writes of floating-point numbers of +magnitude < 1 to have an explicit 0 before the decimal point (if the +field-width permits it). Note that the Fortran 77 Standard leaves it +up to the implementation whether to supply these superfluous zeros. + +Tue Aug 1 09:25:56 EDT 1995 + Permit real (or double precision) parameters in dimension expressions. + +Mon Aug 7 08:04:00 EDT 1995 + Append "_eqv" rather than just "_" to names that that appear in +EQUIVALENCE statements as well as structs in f2c.h (to avoid a +conflict when these names also name common blocks). + +Tue Aug 8 12:49:02 EDT 1995 + Modify yesterday's change: merge st_fields with c_keywords, to +cope with equivalences introduced to permit initializing numeric +variables with character data. DATA statements causing these +equivalences can appear after executable statements, so the only +safe course is to rename all local variable with names in the +former st_fields list. This has the unfortunate side effect that +the common local variable "i" will henceforth be renamed "i__". + +Wed Aug 30 00:19:32 EDT 1995 + libf77: add F77_aloc, now used in s_cat and system_ (to allocate +memory and check for failure in so doing). + libi77: improve MSDOS logic in backspace.c. + +Wed Sep 6 09:06:19 EDT 1995 + libf77: Fix return type of system_ (integer) under -DKR_headers. + libi77: Move some f_init calls around for people who do not use +libF77's main(); now open and namelist read statements that are the +first I/O statements executed should work right in that context. +Adjust namelist input to treat a subscripted name whose subscripts do +not involve colons similarly to the name without a subscript: accept +several values, stored in successive elements starting at the +indicated subscript. Adjust namelist output to quote character +strings (avoiding confusion with arrays of character strings). + +Thu Sep 7 00:36:04 EDT 1995 + Fix glitch in integer*8 exponentiation function: it's pow_qq, not +pow_qi. + libi77: fix some bugs with -DAllow_TYQUAD (for integer*8); when +looking for the &name that starts NAMELIST input, treat lines whose +first nonblank character is something other than &, $, or ? as +comment lines (i.e., ignore them), unless rsne.c is compiled with +-DNo_Namelist_Comments. + +Thu Sep 7 09:05:40 EDT 1995 + libi77: rdfmt.c: one more tweak for -DAllow_TYQUAD. + +Tue Sep 19 00:03:02 EDT 1995 + Adjust handling of floating-point subscript bounds (a questionable +f2c extension) so subscripts in the generated C are of integral type. + Move #define of roundup to proc.c (where its use is commented out); +version.c left at 19950918. + +Wed Sep 20 17:24:19 EDT 1995 + Fix bug in handling ichar() under -h. + +Thu Oct 5 07:52:56 EDT 1995 + libi77: wrtfmt.c: fix bug with t editing (f__cursor was not always +zeroed in mv_cur). + +Tue Oct 10 10:47:54 EDT 1995 + Under -ext, warn about X**-Y and X**+Y. Following the original f77, +f2c treats these as X**(-Y) and X**(+Y), respectively. (They are not +allowed by the official Fortran 77 Standard.) Some Fortran compilers +give a bizarre interpretation to larger contexts, making multiplication +noncommutative: they treat X**-Y*Z as X**(-Y*Z) rather than X**(-Y)*Z, +which, following the rules of Fortran 77, is the same as (X**(-Y))*Z. + +Wed Oct 11 13:27:05 EDT 1995 + libi77: move defs of f__hiwater, f__svic, f__icptr from wrtfmt.c +to err.c. This should work around a problem with buggy loaders and +sometimes leads to smaller executable programs. + +Sat Oct 21 23:54:22 EDT 1995 + Under -h, fix bug in the treatment of ichar('0') in arithmetic +expressions. + Demote to -dneg (a new command-line option not mentioned in the +man page) imitation of the original f77's treatment of unary minus +applied to a REAL operand (yielding a DOUBLE PRECISION result). +Previously this imitation (which was present for debugging) occurred +under (the default) -!R. It is still suppressed by -R. + +Tue Nov 7 23:52:57 EST 1995 + Adjust assigned GOTOs to honor SAVE declarations. + Add comments about ranlib to lib[FI]77/README and makefile. + +Tue Dec 19 22:54:06 EST 1995 + libf77: s_cat.c: fix bug when 2nd or later arg overlaps lhs. + +Tue Jan 2 17:54:00 EST 1996 + libi77: rdfmt.c: move #include "ctype.h" up before "stdlib.h"; no +change to Version.c. + +Sun Feb 25 22:20:20 EST 1996 + Adjust expr.c to permit raising the integer constants 1 and -1 to +negative constant integral powers. + Avoid faulting when -T and -d are not followed by a directory name +(immediately, without intervening spaces). + +Wed Feb 28 12:49:01 EST 1996 + Fix a glitch in handling complex parameters assigned a "wrong" type. +Example: + complex d, z + parameter(z = (0d0,0d0)) + data d/z/ ! elicited "non-constant initializer" + call foo(d) + end + +Thu Feb 29 00:53:12 EST 1996 + Fix bug in handling character parameters assigned a char() value. +Example: + character*2 b,c + character*1 esc + parameter(esc = char(27)) + integer i + data (b(i:i),i=1,2)/esc,'a'/ + data (c(i:i),i=1,2)/esc,'b'/ ! memory fault + call foo(b,c) + end + +Fri Mar 1 23:44:51 EST 1996 + Fix glitch in evaluating .EQ. and .NE. when both operands are +logical constants (.TRUE. or .FALSE.). + +Fri Mar 15 17:29:54 EST 1996 + libi77: lread.c, rsfe.c: honor END= in READ stmts with empty iolist. + +Tue Mar 19 23:08:32 EST 1996 + lex.c: arrange for a "statement" consisting of a single short bogus +keyword to elicit an error message showing the whole keyword. The +error message formerly omitted the last letter of the bad keyword. + libf77: s_cat.c: supply missing break after overlap detection. + +Mon May 13 23:35:26 EDT 1996 + Recognize Fortran 90's /= as a synonym for .NE.. (<> remains a +synonym for .NE..) + Emit an empty int function of no arguments to supply an external +name to named block data subprograms (so they can be called somewhere +to force them to be loaded from a library). + Fix bug (memory fault) in handling the following illegal Fortran: + parameter(i=1) + equivalence(i,j) + end + Treat cdabs, cdcos, cdexp, cdlog, cdsin, and cdsqrt as synonyms for +the double complex intrinsics zabs, zcos, zexp, zlog, zsin, and zsqrt, +respectively, unless -cd is specified. + Recognize the Fortran 90 bit-manipulation intrinsics btest, iand, +ibclr, ibits, ibset, ieor, ior, ishft, and ishftc, unless -i90 is +specified. Note that iand, ieor, and ior are thus now synonyms for +"and", "xor", and "or", respectively. + Add three macros (bit_test, bit_clear, bit_set) to f2c.h for use +with btest, ibclr, and ibset, respectively. Add new functions +[lq]bit_bits, [lq]bit_shift, and [lq]_bit_cshift to libF77 for +use with ibits, ishft, and ishftc, respectively. + Add integer function ftell(unit) (returning -1 on error) and +subroutine fseek(unit, offset, whence, *) to libI77 (with branch to +label * on error). + +Tue May 14 23:21:12 EDT 1996 + Fix glitch (possible memory fault, or worse) in handling multiple +entry points with names over 28 characters long. + +Mon Jun 10 01:20:16 EDT 1996 + Update netlib E-mail and ftp addresses in f2c/readme and +f2c/src/readme (which are different files) -- to reflect the upcoming +breakup of AT&T. + libf77: trivial tweaks to F77_aloc.c and system_.c; Version.c not +changed. + libi77: Adjust rsli.c and lread.c so internal list input with too +few items in the input string will honor end= . + +Mon Jun 10 22:59:57 EDT 1996 + Add Bits_per_Byte to sysdep.h and adjust definition of Table_size +to depend on Bits_per_Byte (forcing Table_size to be a power of 2); in +lex.c, change "comstart[c & 0xfff]" to "comstart[c & (Table_size-1)]" +to avoid an out-of-range subscript on end-of-file. + +Wed Jun 12 00:24:28 EDT 1996 + Fix bug in output.c (dereferencing a freed pointer) revealed in + print * !np in out_call in output.c clobbered by free + end !during out_expr. + +Wed Jun 19 08:12:47 EDT 1996 + f2c.h: add types uinteger, ulongint (for libF77); add qbit_clear +and qbit_set macros (in a commented-out section) for integer*8. + For integer*8, use qbit_clear and qbit_set for ibclr and ibset. + libf77: add casts to unsigned in [lq]bitshft.c. + +Thu Jun 20 13:30:43 EDT 1996 + Complain at character*(*) in common (rather than faulting). + Fix bug in recognizing hex constants that start with "16#" (e.g., +16#1234abcd, which is a synonym for z'1234abcd'). + Fix bugs in constant folding of expressions involving btest, ibclr, +and ibset. + Fix bug in constant folding of rshift(16#80000000, -31) (on a 32-bit +machine; more generally, the bug was in constant folding of +rshift(ibset(0,NBITS-1), 1-NBITS) when f2c runs on a machine with +long ints having NBITS bits. + +Mon Jun 24 07:58:53 EDT 1996 + Adjust struct Literal and newlabel() function to accommodate huge +source files (with more than 32767 newlabel() invocations). + Omit .c file when the .f file has a missing final end statement. + +Wed Jun 26 14:00:02 EDT 1996 + libi77: Add discussion of MXUNIT (highest allowed Fortran unit number) +to libI77/README. + +Fri Jun 28 14:16:11 EDT 1996 + Fix glitch with -onetrip: the temporary variable used for nonconstant +initial loop variable values was recycled too soon. Example: + do i = j+1, k + call foo(i+1) ! temp for j+1 was reused here + enddo + end + +Tue Jul 2 16:11:27 EDT 1996 + formatdata.c: add a 0 to the end of the basetype array (for TYBLANK) +(an omission that was harmless on most machines). + expr.c: fix a dereference of NULL that was only possible with buggy +input, such as + subroutine $sub(s) ! the '$' is erroneous + character s*(*) + s(1:) = ' ' + end + +Sat Jul 6 00:44:56 EDT 1996 + Fix glitch in the intrinsic "real" function when applied to a +complex (or double complex) variable and passed as an argument to +some intrinsic functions. Example: + complex a + b = sqrt(a) + end + Fix glitch (only visible if you do not use f2c's malloc and the +malloc you do use is defective in the sense that malloc(0) returns 0) +in handling include files that end with another include (perhaps +followed by comments). + Fix glitch with character*(*) arguments named "h" and "i" when +the body of the subroutine invokes the intrinsic LEN function. + Arrange that after a previous "f2c -P foo.f" has produced foo.P, +running "f2c foo.P foo.f" will produce valid C when foo.f contains + call sub('1234') + end + subroutine sub(msg) + end +Specifically, the length argument in "call sub" is now suppressed. +With or without foo.P, it is also now suppressed when the order of +subprograms in file foo.f is reversed: + subroutine sub(msg) + end + call sub('1234') + end + Adjust copyright notices to reflect AT&T breakup. + +Wed Jul 10 09:25:49 EDT 1996 + Fix bug (possible memory fault) in handling erroneously placed +and inconsistent declarations. Example that faulted: + character*1 w(8) + call foo(w) + end + subroutine foo(m) + data h /0.5/ + integer m(2) ! should be before data + end + Fix bug (possible fault) in handling illegal "if" constructions. +Example (that faulted): + subroutine foo(i,j) + if (i) then ! bug: i is integer, not logical + else if (j) then ! bug: j is integer, not logical + endif + end + Fix glitch with character*(*) argument named "ret_len" to a +character*(*) function. + +Wed Jul 10 23:04:16 EDT 1996 + Fix more glitches in the intrinsic "real" function when applied to a +complex (or double complex) variable and passed as an argument to +some intrinsic functions. Example: + complex a, b + r = sqrt(real(conjg(a))) + sqrt(real(a*b)) + end + +Thu Jul 11 17:27:16 EDT 1996 + Fix a memory fault associated with complicated, illegal input. +Example: + subroutine goo + character a + call foo(a) ! inconsistent with subsequent def and call + end + subroutine foo(a) + end + call foo(a) + end + +Wed Jul 17 19:18:28 EDT 1996 + Fix yet another case of intrinsic "real" applied to a complex +argument. Example: + complex a(3) + x = sqrt(real(a(2))) ! gave error message about bad tag + end + +Mon Aug 26 11:28:57 EDT 1996 + Tweak sysdep.c for non-Unix systems in which process ID's can be +over 5 digits long. + +Tue Aug 27 08:31:32 EDT 1996 + Adjust the ishft intrinsic to use unsigned right shifts. (Previously, +a negative constant second operand resulted in a possibly signed shift.) + +Thu Sep 12 14:04:07 EDT 1996 + equiv.c: fix glitch with -DKR_headers. + libi77: fmtlib.c: fix bug in printing the most negative integer. + +Fri Sep 13 08:54:40 EDT 1996 + Diagnose some illegal appearances of substring notation. + +Tue Sep 17 17:48:09 EDT 1996 + Fix fault in handling some complex parameters. Example: + subroutine foo(a) + double complex a, b + parameter(b = (0,1)) + a = b ! f2c faulted here + end + +Thu Sep 26 07:47:10 EDT 1996 + libi77: fmt.h: for formatted writes of negative integer*1 values, +make ic signed on ANSI systems. If formatted writes of integer*1 +values trouble you when using a K&R C compiler, switch to an ANSI +compiler or use a compiler flag that makes characters signed. + +Tue Oct 1 14:41:36 EDT 1996 + Give a better error message when dummy arguments appear in data +statements. + +Thu Oct 17 13:37:22 EDT 1996 + Fix bug in typechecking arguments to character and complex (or +double complex) functions; the bug could cause length arguments +for character arguments to be omitted on invocations appearing +textually after the first invocation. For example, in + subroutine foo + character c + complex zot + call goo(zot(c), zot(c)) + end +the length was omitted from the second invocation of zot, and +there was an erroneous error message about inconsistent calling +sequences. + +Wed Dec 4 13:59:14 EST 1996 + Fix bug revealed by + subroutine test(cdum,rdum) + complex cdum + rdum=cos(real(cdum)) ! "Unexpected tag 3 in opconv_fudge" + end + Fix glitch in parsing "DO 10 D0 = 1, 10". + Fix glitch in parsing + real*8 x + real*8 x ! erroneous "incompatible type" message + call foo(x) + end + +Mon Dec 9 23:15:02 EST 1996 + Fix glitch in parameter adjustments for arrays whose lower +bound depends on a scalar argument. Example: + subroutine bug(p,z,m,n) + integer z(*),m,n + double precision p(z(m):z(m) + n) ! p_offset botched + call foo(p(0), p(n)) + end + libi77: complain about non-positive rec= in direct read and write +statements. + libf77: trivial adjustments; Version.c not changed. + +Wed Feb 12 00:18:03 EST 1997 + output.c: fix (seldom problematic) glitch in out_call: put parens +around the ... in a test of the form "if (q->tag == TADDR && ...)". + vax.c: fix bug revealed in the "psi_offset =" assignment in the +following example: + subroutine foo(psi,m) + integer z(100),m + common /a/ z + double precision psi(z(m):z(m) + 10) + call foo(m+1, psi(0),psi(10)) + end + +Mon Feb 24 23:44:54 EST 1997 + For consistency with f2c's current treatment of adjacent character +strings in FORMAT statements, recognize a Hollerith string following +a string (and merge adjacent strings in FORMAT statements). + +Wed Feb 26 13:41:11 EST 1997 + New libf2c.zip, a combination of the libf77 and libi77 bundles (and +available only by ftp). + libf77: adjust functions with a complex output argument to permit +aliasing it with input arguments. (For now, at least, this is just +for possible benefit of g77.) + libi77: tweak to ftell_.c for systems with strange definitions of +SEEK_SET, etc. + +Tue Apr 8 20:57:08 EDT 1997 + libf77: [cz]_div.c: tweaks invisible on most systems (that may +improve things slightly with optimized compilation on systems that use +gratuitous extra precision). + libi77: fmt.c: adjust to complain at missing numbers in formats +(but still treat missing ".nnn" as ".0"). + +Fri Apr 11 14:05:57 EDT 1997 + libi77: err.c: attempt to make stderr line buffered rather than +fully buffered. (Buffering is needed for format items T and TR.) + +Thu Apr 17 22:42:43 EDT 1997 + libf77: add F77_aloc.o to makefile (and makefile.u in libf2c.zip). + +Fri Apr 25 19:32:09 EDT 1997 + libf77: add [de]time_.c (which may give trouble on some systems). + +Tue May 27 09:18:52 EDT 1997 + libi77: ftell_.c: fix typo that caused the third argument to be +treated as 2 on some systems. + +Mon Jun 9 00:04:37 EDT 1997 + libi77 (and libf2c.zip): adjust include order in err.c lread.c wref.c +rdfmt.c to include fmt.h (etc.) after system includes. Version.c not +changed. + +Mon Jul 21 16:04:54 EDT 1997 + proc.c: fix glitch in logic for "nonpositive dimension" message. + libi77: inquire.c: always include string.h (for possible use with +-DNON_UNIX_STDIO); Version.c not changed. + +Thu Jul 24 17:11:23 EDT 1997 + Tweak "Notice" to reflect the AT&T breakup -- we missed it when +updating the copyright notices in the source files last summer. + Adjust src/makefile so malloc.o is not used by default, but can +be specified with "make MALLOC=malloc.o". + Add comments to src/README about the "CRAY" T3E. + +Tue Aug 5 14:53:25 EDT 1997 + Add definition of calloc to malloc.c; this makes f2c's malloc +work on some systems where trouble hitherto arose because references +to calloc brought in the system's malloc. (On sensible systems, +calloc is defined separately from malloc. To avoid confusion on +other systems, f2c/malloc.c now defines calloc.) + libi77: lread.c: adjust to accord with a change to the Fortran 8X +draft (in 1990 or 1991) that rescinded permission to elide quote marks +in namelist input of character data; to get the old behavior, compile +with F8X_NML_ELIDE_QUOTES #defined. wrtfmt.o: wrt_G: tweak to print +the right number of 0's for zero under G format. + +Sat Aug 16 05:45:32 EDT 1997 + libi77: iio.c: fix bug in internal writes to an array of character +strings that sometimes caused one more array element than required by +the format to be blank-filled. Example: format(1x). + +Wed Sep 17 00:39:29 EDT 1997 + libi77: fmt.[ch] rdfmt.c wrtfmt.c: tweak struct syl for machines +with 64-bit pointers and 32-bit ints that did not 64-bit align +struct syl (e.g., Linux on the DEC Alpha). This change should be +invisible on other machines. + +Sun Sep 21 22:05:19 EDT 1997 + libf77: [de]time_.c (Unix systems only): change return type to double. diff --git a/libf2c/configure b/libf2c/configure new file mode 100755 index 00000000000..1dc6f4cde3c --- /dev/null +++ b/libf2c/configure @@ -0,0 +1,2197 @@ +#! /bin/sh + +# Guess values for system-dependent variables and create Makefiles. +# Generated automatically using autoconf version 2.12 +# Copyright (C) 1992, 93, 94, 95, 96 Free Software Foundation, Inc. +# +# This configure script is free software; the Free Software Foundation +# gives unlimited permission to copy, distribute and modify it. + +# Defaults: +ac_help= +ac_default_prefix=/usr/local +# Any additions from configure.in: + +# Initialize some variables set by options. +# The variables have the same names as the options, with +# dashes changed to underlines. +build=NONE +cache_file=./config.cache +exec_prefix=NONE +host=NONE +no_create= +nonopt=NONE +no_recursion= +prefix=NONE +program_prefix=NONE +program_suffix=NONE +program_transform_name=s,x,x, +silent= +site= +srcdir= +target=NONE +verbose= +x_includes=NONE +x_libraries=NONE +bindir='${exec_prefix}/bin' +sbindir='${exec_prefix}/sbin' +libexecdir='${exec_prefix}/libexec' +datadir='${prefix}/share' +sysconfdir='${prefix}/etc' +sharedstatedir='${prefix}/com' +localstatedir='${prefix}/var' +libdir='${exec_prefix}/lib' +includedir='${prefix}/include' +oldincludedir='/usr/include' +infodir='${prefix}/info' +mandir='${prefix}/man' + +# Initialize some other variables. +subdirs= +MFLAGS= MAKEFLAGS= +# Maximum number of lines to put in a shell here document. +ac_max_here_lines=12 + +ac_prev= +for ac_option +do + + # If the previous option needs an argument, assign it. + if test -n "$ac_prev"; then + eval "$ac_prev=\$ac_option" + ac_prev= + continue + fi + + case "$ac_option" in + -*=*) ac_optarg=`echo "$ac_option" | sed 's/[-_a-zA-Z0-9]*=//'` ;; + *) ac_optarg= ;; + esac + + # Accept the important Cygnus configure options, so we can diagnose typos. + + case "$ac_option" in + + -bindir | --bindir | --bindi | --bind | --bin | --bi) + ac_prev=bindir ;; + -bindir=* | --bindir=* | --bindi=* | --bind=* | --bin=* | --bi=*) + bindir="$ac_optarg" ;; + + -build | --build | --buil | --bui | --bu) + ac_prev=build ;; + -build=* | --build=* | --buil=* | --bui=* | --bu=*) + build="$ac_optarg" ;; + + -cache-file | --cache-file | --cache-fil | --cache-fi \ + | --cache-f | --cache- | --cache | --cach | --cac | --ca | --c) + ac_prev=cache_file ;; + -cache-file=* | --cache-file=* | --cache-fil=* | --cache-fi=* \ + | --cache-f=* | --cache-=* | --cache=* | --cach=* | --cac=* | --ca=* | --c=*) + cache_file="$ac_optarg" ;; + + -datadir | --datadir | --datadi | --datad | --data | --dat | --da) + ac_prev=datadir ;; + -datadir=* | --datadir=* | --datadi=* | --datad=* | --data=* | --dat=* \ + | --da=*) + datadir="$ac_optarg" ;; + + -disable-* | --disable-*) + ac_feature=`echo $ac_option|sed -e 's/-*disable-//'` + # Reject names that are not valid shell variable names. + if test -n "`echo $ac_feature| sed 's/[-a-zA-Z0-9_]//g'`"; then + { echo "configure: error: $ac_feature: invalid feature name" 1>&2; exit 1; } + fi + ac_feature=`echo $ac_feature| sed 's/-/_/g'` + eval "enable_${ac_feature}=no" ;; + + -enable-* | --enable-*) + ac_feature=`echo $ac_option|sed -e 's/-*enable-//' -e 's/=.*//'` + # Reject names that are not valid shell variable names. + if test -n "`echo $ac_feature| sed 's/[-_a-zA-Z0-9]//g'`"; then + { echo "configure: error: $ac_feature: invalid feature name" 1>&2; exit 1; } + fi + ac_feature=`echo $ac_feature| sed 's/-/_/g'` + case "$ac_option" in + *=*) ;; + *) ac_optarg=yes ;; + esac + eval "enable_${ac_feature}='$ac_optarg'" ;; + + -exec-prefix | --exec_prefix | --exec-prefix | --exec-prefi \ + | --exec-pref | --exec-pre | --exec-pr | --exec-p | --exec- \ + | --exec | --exe | --ex) + ac_prev=exec_prefix ;; + -exec-prefix=* | --exec_prefix=* | --exec-prefix=* | --exec-prefi=* \ + | --exec-pref=* | --exec-pre=* | --exec-pr=* | --exec-p=* | --exec-=* \ + | --exec=* | --exe=* | --ex=*) + exec_prefix="$ac_optarg" ;; + + -gas | --gas | --ga | --g) + # Obsolete; use --with-gas. + with_gas=yes ;; + + -help | --help | --hel | --he) + # Omit some internal or obsolete options to make the list less imposing. + # This message is too long to be a string in the A/UX 3.1 sh. + cat << EOF +Usage: configure [options] [host] +Options: [defaults in brackets after descriptions] +Configuration: + --cache-file=FILE cache test results in FILE + --help print this message + --no-create do not create output files + --quiet, --silent do not print \`checking...' messages + --version print the version of autoconf that created configure +Directory and file names: + --prefix=PREFIX install architecture-independent files in PREFIX + [$ac_default_prefix] + --exec-prefix=EPREFIX install architecture-dependent files in EPREFIX + [same as prefix] + --bindir=DIR user executables in DIR [EPREFIX/bin] + --sbindir=DIR system admin executables in DIR [EPREFIX/sbin] + --libexecdir=DIR program executables in DIR [EPREFIX/libexec] + --datadir=DIR read-only architecture-independent data in DIR + [PREFIX/share] + --sysconfdir=DIR read-only single-machine data in DIR [PREFIX/etc] + --sharedstatedir=DIR modifiable architecture-independent data in DIR + [PREFIX/com] + --localstatedir=DIR modifiable single-machine data in DIR [PREFIX/var] + --libdir=DIR object code libraries in DIR [EPREFIX/lib] + --includedir=DIR C header files in DIR [PREFIX/include] + --oldincludedir=DIR C header files for non-gcc in DIR [/usr/include] + --infodir=DIR info documentation in DIR [PREFIX/info] + --mandir=DIR man documentation in DIR [PREFIX/man] + --srcdir=DIR find the sources in DIR [configure dir or ..] + --program-prefix=PREFIX prepend PREFIX to installed program names + --program-suffix=SUFFIX append SUFFIX to installed program names + --program-transform-name=PROGRAM + run sed PROGRAM on installed program names +EOF + cat << EOF +Host type: + --build=BUILD configure for building on BUILD [BUILD=HOST] + --host=HOST configure for HOST [guessed] + --target=TARGET configure for TARGET [TARGET=HOST] +Features and packages: + --disable-FEATURE do not include FEATURE (same as --enable-FEATURE=no) + --enable-FEATURE[=ARG] include FEATURE [ARG=yes] + --with-PACKAGE[=ARG] use PACKAGE [ARG=yes] + --without-PACKAGE do not use PACKAGE (same as --with-PACKAGE=no) + --x-includes=DIR X include files are in DIR + --x-libraries=DIR X library files are in DIR +EOF + if test -n "$ac_help"; then + echo "--enable and --with options recognized:$ac_help" + fi + exit 0 ;; + + -host | --host | --hos | --ho) + ac_prev=host ;; + -host=* | --host=* | --hos=* | --ho=*) + host="$ac_optarg" ;; + + -includedir | --includedir | --includedi | --included | --include \ + | --includ | --inclu | --incl | --inc) + ac_prev=includedir ;; + -includedir=* | --includedir=* | --includedi=* | --included=* | --include=* \ + | --includ=* | --inclu=* | --incl=* | --inc=*) + includedir="$ac_optarg" ;; + + -infodir | --infodir | --infodi | --infod | --info | --inf) + ac_prev=infodir ;; + -infodir=* | --infodir=* | --infodi=* | --infod=* | --info=* | --inf=*) + infodir="$ac_optarg" ;; + + -libdir | --libdir | --libdi | --libd) + ac_prev=libdir ;; + -libdir=* | --libdir=* | --libdi=* | --libd=*) + libdir="$ac_optarg" ;; + + -libexecdir | --libexecdir | --libexecdi | --libexecd | --libexec \ + | --libexe | --libex | --libe) + ac_prev=libexecdir ;; + -libexecdir=* | --libexecdir=* | --libexecdi=* | --libexecd=* | --libexec=* \ + | --libexe=* | --libex=* | --libe=*) + libexecdir="$ac_optarg" ;; + + -localstatedir | --localstatedir | --localstatedi | --localstated \ + | --localstate | --localstat | --localsta | --localst \ + | --locals | --local | --loca | --loc | --lo) + ac_prev=localstatedir ;; + -localstatedir=* | --localstatedir=* | --localstatedi=* | --localstated=* \ + | --localstate=* | --localstat=* | --localsta=* | --localst=* \ + | --locals=* | --local=* | --loca=* | --loc=* | --lo=*) + localstatedir="$ac_optarg" ;; + + -mandir | --mandir | --mandi | --mand | --man | --ma | --m) + ac_prev=mandir ;; + -mandir=* | --mandir=* | --mandi=* | --mand=* | --man=* | --ma=* | --m=*) + mandir="$ac_optarg" ;; + + -nfp | --nfp | --nf) + # Obsolete; use --without-fp. + with_fp=no ;; + + -no-create | --no-create | --no-creat | --no-crea | --no-cre \ + | --no-cr | --no-c) + no_create=yes ;; + + -no-recursion | --no-recursion | --no-recursio | --no-recursi \ + | --no-recurs | --no-recur | --no-recu | --no-rec | --no-re | --no-r) + no_recursion=yes ;; + + -oldincludedir | --oldincludedir | --oldincludedi | --oldincluded \ + | --oldinclude | --oldinclud | --oldinclu | --oldincl | --oldinc \ + | --oldin | --oldi | --old | --ol | --o) + ac_prev=oldincludedir ;; + -oldincludedir=* | --oldincludedir=* | --oldincludedi=* | --oldincluded=* \ + | --oldinclude=* | --oldinclud=* | --oldinclu=* | --oldincl=* | --oldinc=* \ + | --oldin=* | --oldi=* | --old=* | --ol=* | --o=*) + oldincludedir="$ac_optarg" ;; + + -prefix | --prefix | --prefi | --pref | --pre | --pr | --p) + ac_prev=prefix ;; + -prefix=* | --prefix=* | --prefi=* | --pref=* | --pre=* | --pr=* | --p=*) + prefix="$ac_optarg" ;; + + -program-prefix | --program-prefix | --program-prefi | --program-pref \ + | --program-pre | --program-pr | --program-p) + ac_prev=program_prefix ;; + -program-prefix=* | --program-prefix=* | --program-prefi=* \ + | --program-pref=* | --program-pre=* | --program-pr=* | --program-p=*) + program_prefix="$ac_optarg" ;; + + -program-suffix | --program-suffix | --program-suffi | --program-suff \ + | --program-suf | --program-su | --program-s) + ac_prev=program_suffix ;; + -program-suffix=* | --program-suffix=* | --program-suffi=* \ + | --program-suff=* | --program-suf=* | --program-su=* | --program-s=*) + program_suffix="$ac_optarg" ;; + + -program-transform-name | --program-transform-name \ + | --program-transform-nam | --program-transform-na \ + | --program-transform-n | --program-transform- \ + | --program-transform | --program-transfor \ + | --program-transfo | --program-transf \ + | --program-trans | --program-tran \ + | --progr-tra | --program-tr | --program-t) + ac_prev=program_transform_name ;; + -program-transform-name=* | --program-transform-name=* \ + | --program-transform-nam=* | --program-transform-na=* \ + | --program-transform-n=* | --program-transform-=* \ + | --program-transform=* | --program-transfor=* \ + | --program-transfo=* | --program-transf=* \ + | --program-trans=* | --program-tran=* \ + | --progr-tra=* | --program-tr=* | --program-t=*) + program_transform_name="$ac_optarg" ;; + + -q | -quiet | --quiet | --quie | --qui | --qu | --q \ + | -silent | --silent | --silen | --sile | --sil) + silent=yes ;; + + -sbindir | --sbindir | --sbindi | --sbind | --sbin | --sbi | --sb) + ac_prev=sbindir ;; + -sbindir=* | --sbindir=* | --sbindi=* | --sbind=* | --sbin=* \ + | --sbi=* | --sb=*) + sbindir="$ac_optarg" ;; + + -sharedstatedir | --sharedstatedir | --sharedstatedi \ + | --sharedstated | --sharedstate | --sharedstat | --sharedsta \ + | --sharedst | --shareds | --shared | --share | --shar \ + | --sha | --sh) + ac_prev=sharedstatedir ;; + -sharedstatedir=* | --sharedstatedir=* | --sharedstatedi=* \ + | --sharedstated=* | --sharedstate=* | --sharedstat=* | --sharedsta=* \ + | --sharedst=* | --shareds=* | --shared=* | --share=* | --shar=* \ + | --sha=* | --sh=*) + sharedstatedir="$ac_optarg" ;; + + -site | --site | --sit) + ac_prev=site ;; + -site=* | --site=* | --sit=*) + site="$ac_optarg" ;; + + -srcdir | --srcdir | --srcdi | --srcd | --src | --sr) + ac_prev=srcdir ;; + -srcdir=* | --srcdir=* | --srcdi=* | --srcd=* | --src=* | --sr=*) + srcdir="$ac_optarg" ;; + + -sysconfdir | --sysconfdir | --sysconfdi | --sysconfd | --sysconf \ + | --syscon | --sysco | --sysc | --sys | --sy) + ac_prev=sysconfdir ;; + -sysconfdir=* | --sysconfdir=* | --sysconfdi=* | --sysconfd=* | --sysconf=* \ + | --syscon=* | --sysco=* | --sysc=* | --sys=* | --sy=*) + sysconfdir="$ac_optarg" ;; + + -target | --target | --targe | --targ | --tar | --ta | --t) + ac_prev=target ;; + -target=* | --target=* | --targe=* | --targ=* | --tar=* | --ta=* | --t=*) + target="$ac_optarg" ;; + + -v | -verbose | --verbose | --verbos | --verbo | --verb) + verbose=yes ;; + + -version | --version | --versio | --versi | --vers) + echo "configure generated by autoconf version 2.12" + exit 0 ;; + + -with-* | --with-*) + ac_package=`echo $ac_option|sed -e 's/-*with-//' -e 's/=.*//'` + # Reject names that are not valid shell variable names. + if test -n "`echo $ac_package| sed 's/[-_a-zA-Z0-9]//g'`"; then + { echo "configure: error: $ac_package: invalid package name" 1>&2; exit 1; } + fi + ac_package=`echo $ac_package| sed 's/-/_/g'` + case "$ac_option" in + *=*) ;; + *) ac_optarg=yes ;; + esac + eval "with_${ac_package}='$ac_optarg'" ;; + + -without-* | --without-*) + ac_package=`echo $ac_option|sed -e 's/-*without-//'` + # Reject names that are not valid shell variable names. + if test -n "`echo $ac_package| sed 's/[-a-zA-Z0-9_]//g'`"; then + { echo "configure: error: $ac_package: invalid package name" 1>&2; exit 1; } + fi + ac_package=`echo $ac_package| sed 's/-/_/g'` + eval "with_${ac_package}=no" ;; + + --x) + # Obsolete; use --with-x. + with_x=yes ;; + + -x-includes | --x-includes | --x-include | --x-includ | --x-inclu \ + | --x-incl | --x-inc | --x-in | --x-i) + ac_prev=x_includes ;; + -x-includes=* | --x-includes=* | --x-include=* | --x-includ=* | --x-inclu=* \ + | --x-incl=* | --x-inc=* | --x-in=* | --x-i=*) + x_includes="$ac_optarg" ;; + + -x-libraries | --x-libraries | --x-librarie | --x-librari \ + | --x-librar | --x-libra | --x-libr | --x-lib | --x-li | --x-l) + ac_prev=x_libraries ;; + -x-libraries=* | --x-libraries=* | --x-librarie=* | --x-librari=* \ + | --x-librar=* | --x-libra=* | --x-libr=* | --x-lib=* | --x-li=* | --x-l=*) + x_libraries="$ac_optarg" ;; + + -*) { echo "configure: error: $ac_option: invalid option; use --help to show usage" 1>&2; exit 1; } + ;; + + *) + if test -n "`echo $ac_option| sed 's/[-a-z0-9.]//g'`"; then + echo "configure: warning: $ac_option: invalid host type" 1>&2 + fi + if test "x$nonopt" != xNONE; then + { echo "configure: error: can only configure for one host and one target at a time" 1>&2; exit 1; } + fi + nonopt="$ac_option" + ;; + + esac +done + +if test -n "$ac_prev"; then + { echo "configure: error: missing argument to --`echo $ac_prev | sed 's/_/-/g'`" 1>&2; exit 1; } +fi + +trap 'rm -fr conftest* confdefs* core core.* *.core $ac_clean_files; exit 1' 1 2 15 + +# File descriptor usage: +# 0 standard input +# 1 file creation +# 2 errors and warnings +# 3 some systems may open it to /dev/tty +# 4 used on the Kubota Titan +# 6 checking for... messages and results +# 5 compiler messages saved in config.log +if test "$silent" = yes; then + exec 6>/dev/null +else + exec 6>&1 +fi +exec 5>./config.log + +echo "\ +This file contains any messages produced by compilers while +running configure, to aid debugging if configure makes a mistake. +" 1>&5 + +# Strip out --no-create and --no-recursion so they do not pile up. +# Also quote any args containing shell metacharacters. +ac_configure_args= +for ac_arg +do + case "$ac_arg" in + -no-create | --no-create | --no-creat | --no-crea | --no-cre \ + | --no-cr | --no-c) ;; + -no-recursion | --no-recursion | --no-recursio | --no-recursi \ + | --no-recurs | --no-recur | --no-recu | --no-rec | --no-re | --no-r) ;; + *" "*|*" "*|*[\[\]\~\#\$\^\&\*\(\)\{\}\\\|\;\<\>\?]*) + ac_configure_args="$ac_configure_args '$ac_arg'" ;; + *) ac_configure_args="$ac_configure_args $ac_arg" ;; + esac +done + +# NLS nuisances. +# Only set these to C if already set. These must not be set unconditionally +# because not all systems understand e.g. LANG=C (notably SCO). +# Fixing LC_MESSAGES prevents Solaris sh from translating var values in `set'! +# Non-C LC_CTYPE values break the ctype check. +if test "${LANG+set}" = set; then LANG=C; export LANG; fi +if test "${LC_ALL+set}" = set; then LC_ALL=C; export LC_ALL; fi +if test "${LC_MESSAGES+set}" = set; then LC_MESSAGES=C; export LC_MESSAGES; fi +if test "${LC_CTYPE+set}" = set; then LC_CTYPE=C; export LC_CTYPE; fi + +# confdefs.h avoids OS command line length limits that DEFS can exceed. +rm -rf conftest* confdefs.h +# AIX cpp loses on an empty file, so make sure it contains at least a newline. +echo > confdefs.h + +# A filename unique to this package, relative to the directory that +# configure is in, which we can look for to find out if srcdir is correct. +ac_unique_file=libF77/Version.c + +# Find the source files, if location was not specified. +if test -z "$srcdir"; then + ac_srcdir_defaulted=yes + # Try the directory containing this script, then its parent. + ac_prog=$0 + ac_confdir=`echo $ac_prog|sed 's%/[^/][^/]*$%%'` + test "x$ac_confdir" = "x$ac_prog" && ac_confdir=. + srcdir=$ac_confdir + if test ! -r $srcdir/$ac_unique_file; then + srcdir=.. + fi +else + ac_srcdir_defaulted=no +fi +if test ! -r $srcdir/$ac_unique_file; then + if test "$ac_srcdir_defaulted" = yes; then + { echo "configure: error: can not find sources in $ac_confdir or .." 1>&2; exit 1; } + else + { echo "configure: error: can not find sources in $srcdir" 1>&2; exit 1; } + fi +fi +srcdir=`echo "${srcdir}" | sed 's%\([^/]\)/*$%\1%'` + +# Prefer explicitly selected file to automatically selected ones. +if test -z "$CONFIG_SITE"; then + if test "x$prefix" != xNONE; then + CONFIG_SITE="$prefix/share/config.site $prefix/etc/config.site" + else + CONFIG_SITE="$ac_default_prefix/share/config.site $ac_default_prefix/etc/config.site" + fi +fi +for ac_site_file in $CONFIG_SITE; do + if test -r "$ac_site_file"; then + echo "loading site script $ac_site_file" + . "$ac_site_file" + fi +done + +if test -r "$cache_file"; then + echo "loading cache $cache_file" + . $cache_file +else + echo "creating cache $cache_file" + > $cache_file +fi + +ac_ext=c +# CFLAGS is not in ac_cpp because -g, -O, etc. are not valid cpp options. +ac_cpp='$CPP $CPPFLAGS' +ac_compile='${CC-cc} -c $CFLAGS $CPPFLAGS conftest.$ac_ext 1>&5' +ac_link='${CC-cc} -o conftest $CFLAGS $CPPFLAGS $LDFLAGS conftest.$ac_ext $LIBS 1>&5' +cross_compiling=$ac_cv_prog_cc_cross + +if (echo "testing\c"; echo 1,2,3) | grep c >/dev/null; then + # Stardent Vistra SVR4 grep lacks -e, says ghazi@caip.rutgers.edu. + if (echo -n testing; echo 1,2,3) | sed s/-n/xn/ | grep xn >/dev/null; then + ac_n= ac_c=' +' ac_t=' ' + else + ac_n=-n ac_c= ac_t= + fi +else + ac_n= ac_c='\c' ac_t= +fi + + + +# From configure.in 1.10 + +# For g77 we'll set CC to point at the built gcc, but this will get it into +# the makefiles +# Extract the first word of "gcc", so it can be a program name with args. +set dummy gcc; ac_word=$2 +echo $ac_n "checking for $ac_word""... $ac_c" 1>&6 +echo "configure:530: checking for $ac_word" >&5 +if eval "test \"`echo '$''{'ac_cv_prog_CC'+set}'`\" = set"; then + echo $ac_n "(cached) $ac_c" 1>&6 +else + if test -n "$CC"; then + ac_cv_prog_CC="$CC" # Let the user override the test. +else + IFS="${IFS= }"; ac_save_ifs="$IFS"; IFS="${IFS}:" + for ac_dir in $PATH; do + test -z "$ac_dir" && ac_dir=. + if test -f $ac_dir/$ac_word; then + ac_cv_prog_CC="gcc" + break + fi + done + IFS="$ac_save_ifs" +fi +fi +CC="$ac_cv_prog_CC" +if test -n "$CC"; then + echo "$ac_t""$CC" 1>&6 +else + echo "$ac_t""no" 1>&6 +fi + +if test -z "$CC"; then + # Extract the first word of "cc", so it can be a program name with args. +set dummy cc; ac_word=$2 +echo $ac_n "checking for $ac_word""... $ac_c" 1>&6 +echo "configure:559: checking for $ac_word" >&5 +if eval "test \"`echo '$''{'ac_cv_prog_CC'+set}'`\" = set"; then + echo $ac_n "(cached) $ac_c" 1>&6 +else + if test -n "$CC"; then + ac_cv_prog_CC="$CC" # Let the user override the test. +else + IFS="${IFS= }"; ac_save_ifs="$IFS"; IFS="${IFS}:" + ac_prog_rejected=no + for ac_dir in $PATH; do + test -z "$ac_dir" && ac_dir=. + if test -f $ac_dir/$ac_word; then + if test "$ac_dir/$ac_word" = "/usr/ucb/cc"; then + ac_prog_rejected=yes + continue + fi + ac_cv_prog_CC="cc" + break + fi + done + IFS="$ac_save_ifs" +if test $ac_prog_rejected = yes; then + # We found a bogon in the path, so make sure we never use it. + set dummy $ac_cv_prog_CC + shift + if test $# -gt 0; then + # We chose a different compiler from the bogus one. + # However, it has the same basename, so the bogon will be chosen + # first if we set CC to just the basename; use the full file name. + shift + set dummy "$ac_dir/$ac_word" "$@" + shift + ac_cv_prog_CC="$@" + fi +fi +fi +fi +CC="$ac_cv_prog_CC" +if test -n "$CC"; then + echo "$ac_t""$CC" 1>&6 +else + echo "$ac_t""no" 1>&6 +fi + + test -z "$CC" && { echo "configure: error: no acceptable cc found in \$PATH" 1>&2; exit 1; } +fi + +echo $ac_n "checking whether the C compiler ($CC $CFLAGS $LDFLAGS) works""... $ac_c" 1>&6 +echo "configure:607: checking whether the C compiler ($CC $CFLAGS $LDFLAGS) works" >&5 + +ac_ext=c +# CFLAGS is not in ac_cpp because -g, -O, etc. are not valid cpp options. +ac_cpp='$CPP $CPPFLAGS' +ac_compile='${CC-cc} -c $CFLAGS $CPPFLAGS conftest.$ac_ext 1>&5' +ac_link='${CC-cc} -o conftest $CFLAGS $CPPFLAGS $LDFLAGS conftest.$ac_ext $LIBS 1>&5' +cross_compiling=$ac_cv_prog_cc_cross + +cat > conftest.$ac_ext <&5; (eval $ac_link) 2>&5; } && test -s conftest; then + ac_cv_prog_cc_works=yes + # If we can't run a trivial program, we are probably using a cross compiler. + if (./conftest; exit) 2>/dev/null; then + ac_cv_prog_cc_cross=no + else + ac_cv_prog_cc_cross=yes + fi +else + echo "configure: failed program was:" >&5 + cat conftest.$ac_ext >&5 + ac_cv_prog_cc_works=no +fi +rm -fr conftest* + +echo "$ac_t""$ac_cv_prog_cc_works" 1>&6 +if test $ac_cv_prog_cc_works = no; then + { echo "configure: error: installation or configuration problem: C compiler cannot create executables." 1>&2; exit 1; } +fi +echo $ac_n "checking whether the C compiler ($CC $CFLAGS $LDFLAGS) is a cross-compiler""... $ac_c" 1>&6 +echo "configure:641: checking whether the C compiler ($CC $CFLAGS $LDFLAGS) is a cross-compiler" >&5 +echo "$ac_t""$ac_cv_prog_cc_cross" 1>&6 +cross_compiling=$ac_cv_prog_cc_cross + +echo $ac_n "checking whether we are using GNU C""... $ac_c" 1>&6 +echo "configure:646: checking whether we are using GNU C" >&5 +if eval "test \"`echo '$''{'ac_cv_prog_gcc'+set}'`\" = set"; then + echo $ac_n "(cached) $ac_c" 1>&6 +else + cat > conftest.c <&5; (eval $ac_try) 2>&5; }; } | egrep yes >/dev/null 2>&1; then + ac_cv_prog_gcc=yes +else + ac_cv_prog_gcc=no +fi +fi + +echo "$ac_t""$ac_cv_prog_gcc" 1>&6 + +if test $ac_cv_prog_gcc = yes; then + GCC=yes + ac_test_CFLAGS="${CFLAGS+set}" + ac_save_CFLAGS="$CFLAGS" + CFLAGS= + echo $ac_n "checking whether ${CC-cc} accepts -g""... $ac_c" 1>&6 +echo "configure:670: checking whether ${CC-cc} accepts -g" >&5 +if eval "test \"`echo '$''{'ac_cv_prog_cc_g'+set}'`\" = set"; then + echo $ac_n "(cached) $ac_c" 1>&6 +else + echo 'void f(){}' > conftest.c +if test -z "`${CC-cc} -g -c conftest.c 2>&1`"; then + ac_cv_prog_cc_g=yes +else + ac_cv_prog_cc_g=no +fi +rm -f conftest* + +fi + +echo "$ac_t""$ac_cv_prog_cc_g" 1>&6 + if test "$ac_test_CFLAGS" = set; then + CFLAGS="$ac_save_CFLAGS" + elif test $ac_cv_prog_cc_g = yes; then + CFLAGS="-g -O2" + else + CFLAGS="-O2" + fi +else + GCC= + test "${CFLAGS+set}" = set || CFLAGS="-g" +fi + +if test "$CROSS";then + ac_cv_c_cross=yes +else + ac_cv_c_cross=no +fi + +test "$AR" || AR=ar + +if test "$RANLIB"; then : + + if test -z "$RANLIB_TEST"; then + RANLIB_TEST=true + fi +else + RANLIB_TEST=true + # Extract the first word of "ranlib", so it can be a program name with args. +set dummy ranlib; ac_word=$2 +echo $ac_n "checking for $ac_word""... $ac_c" 1>&6 +echo "configure:715: checking for $ac_word" >&5 +if eval "test \"`echo '$''{'ac_cv_prog_RANLIB'+set}'`\" = set"; then + echo $ac_n "(cached) $ac_c" 1>&6 +else + if test -n "$RANLIB"; then + ac_cv_prog_RANLIB="$RANLIB" # Let the user override the test. +else + IFS="${IFS= }"; ac_save_ifs="$IFS"; IFS="${IFS}:" + for ac_dir in $PATH; do + test -z "$ac_dir" && ac_dir=. + if test -f $ac_dir/$ac_word; then + ac_cv_prog_RANLIB="ranlib" + break + fi + done + IFS="$ac_save_ifs" + test -z "$ac_cv_prog_RANLIB" && ac_cv_prog_RANLIB=":" +fi +fi +RANLIB="$ac_cv_prog_RANLIB" +if test -n "$RANLIB"; then + echo "$ac_t""$RANLIB" 1>&6 +else + echo "$ac_t""no" 1>&6 +fi + +fi + + + + +# Sanity check for the cross-compilation case: +echo $ac_n "checking how to run the C preprocessor""... $ac_c" 1>&6 +echo "configure:748: checking how to run the C preprocessor" >&5 +# On Suns, sometimes $CPP names a directory. +if test -n "$CPP" && test -d "$CPP"; then + CPP= +fi +if test -z "$CPP"; then +if eval "test \"`echo '$''{'ac_cv_prog_CPP'+set}'`\" = set"; then + echo $ac_n "(cached) $ac_c" 1>&6 +else + # This must be in double quotes, not single quotes, because CPP may get + # substituted into the Makefile and "${CC-cc}" will confuse make. + CPP="${CC-cc} -E" + # On the NeXT, cc -E runs the code through the compiler's parser, + # not just through cpp. + cat > conftest.$ac_ext < +Syntax Error +EOF +ac_try="$ac_cpp conftest.$ac_ext >/dev/null 2>conftest.out" +{ (eval echo configure:769: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; } +ac_err=`grep -v '^ *+' conftest.out` +if test -z "$ac_err"; then + : +else + echo "$ac_err" >&5 + echo "configure: failed program was:" >&5 + cat conftest.$ac_ext >&5 + rm -rf conftest* + CPP="${CC-cc} -E -traditional-cpp" + cat > conftest.$ac_ext < +Syntax Error +EOF +ac_try="$ac_cpp conftest.$ac_ext >/dev/null 2>conftest.out" +{ (eval echo configure:786: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; } +ac_err=`grep -v '^ *+' conftest.out` +if test -z "$ac_err"; then + : +else + echo "$ac_err" >&5 + echo "configure: failed program was:" >&5 + cat conftest.$ac_ext >&5 + rm -rf conftest* + CPP=/lib/cpp +fi +rm -f conftest* +fi +rm -f conftest* + ac_cv_prog_CPP="$CPP" +fi + CPP="$ac_cv_prog_CPP" +else + ac_cv_prog_CPP="$CPP" +fi +echo "$ac_t""$CPP" 1>&6 + +ac_safe=`echo "stdio.h" | sed 'y%./+-%__p_%'` +echo $ac_n "checking for stdio.h""... $ac_c" 1>&6 +echo "configure:810: checking for stdio.h" >&5 +if eval "test \"`echo '$''{'ac_cv_header_$ac_safe'+set}'`\" = set"; then + echo $ac_n "(cached) $ac_c" 1>&6 +else + cat > conftest.$ac_ext < +EOF +ac_try="$ac_cpp conftest.$ac_ext >/dev/null 2>conftest.out" +{ (eval echo configure:820: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; } +ac_err=`grep -v '^ *+' conftest.out` +if test -z "$ac_err"; then + rm -rf conftest* + eval "ac_cv_header_$ac_safe=yes" +else + echo "$ac_err" >&5 + echo "configure: failed program was:" >&5 + cat conftest.$ac_ext >&5 + rm -rf conftest* + eval "ac_cv_header_$ac_safe=no" +fi +rm -f conftest* +fi +if eval "test \"`echo '$ac_cv_header_'$ac_safe`\" = yes"; then + echo "$ac_t""yes" 1>&6 + : +else + echo "$ac_t""no" 1>&6 +{ echo "configure: error: Can't find stdio.h. +You must have a usable C system for the target already installed, at least +including headers and, preferably, the library, before you can configure +the G77 runtime system. If necessary, install gcc now with \`LANGUAGES=c', +then the target library, then build with \`LANGUAGES=f77'." 1>&2; exit 1; } +fi + + +echo $ac_n "checking for ANSI C header files""... $ac_c" 1>&6 +echo "configure:848: checking for ANSI C header files" >&5 +if eval "test \"`echo '$''{'ac_cv_header_stdc'+set}'`\" = set"; then + echo $ac_n "(cached) $ac_c" 1>&6 +else + cat > conftest.$ac_ext < +#include +#include +#include +EOF +ac_try="$ac_cpp conftest.$ac_ext >/dev/null 2>conftest.out" +{ (eval echo configure:861: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; } +ac_err=`grep -v '^ *+' conftest.out` +if test -z "$ac_err"; then + rm -rf conftest* + ac_cv_header_stdc=yes +else + echo "$ac_err" >&5 + echo "configure: failed program was:" >&5 + cat conftest.$ac_ext >&5 + rm -rf conftest* + ac_cv_header_stdc=no +fi +rm -f conftest* + +if test $ac_cv_header_stdc = yes; then + # SunOS 4.x string.h does not declare mem*, contrary to ANSI. +cat > conftest.$ac_ext < +EOF +if (eval "$ac_cpp conftest.$ac_ext") 2>&5 | + egrep "memchr" >/dev/null 2>&1; then + : +else + rm -rf conftest* + ac_cv_header_stdc=no +fi +rm -f conftest* + +fi + +if test $ac_cv_header_stdc = yes; then + # ISC 2.0.2 stdlib.h does not declare free, contrary to ANSI. +cat > conftest.$ac_ext < +EOF +if (eval "$ac_cpp conftest.$ac_ext") 2>&5 | + egrep "free" >/dev/null 2>&1; then + : +else + rm -rf conftest* + ac_cv_header_stdc=no +fi +rm -f conftest* + +fi + +if test $ac_cv_header_stdc = yes; then + # /bin/cc in Irix-4.0.5 gets non-ANSI ctype macros unless using -ansi. +if test "$cross_compiling" = yes; then + : +else + cat > conftest.$ac_ext < +#define ISLOWER(c) ('a' <= (c) && (c) <= 'z') +#define TOUPPER(c) (ISLOWER(c) ? 'A' + ((c) - 'a') : (c)) +#define XOR(e, f) (((e) && !(f)) || (!(e) && (f))) +int main () { int i; for (i = 0; i < 256; i++) +if (XOR (islower (i), ISLOWER (i)) || toupper (i) != TOUPPER (i)) exit(2); +exit (0); } + +EOF +if { (eval echo configure:928: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest && (./conftest; exit) 2>/dev/null +then + : +else + echo "configure: failed program was:" >&5 + cat conftest.$ac_ext >&5 + rm -fr conftest* + ac_cv_header_stdc=no +fi +rm -fr conftest* +fi + +fi +fi + +echo "$ac_t""$ac_cv_header_stdc" 1>&6 +if test $ac_cv_header_stdc = yes; then + cat >> confdefs.h <<\EOF +#define STDC_HEADERS 1 +EOF + +fi + + + +echo $ac_n "checking for posix""... $ac_c" 1>&6 +echo "configure:954: checking for posix" >&5 +if eval "test \"`echo '$''{'g77_cv_header_posix'+set}'`\" = set"; then + echo $ac_n "(cached) $ac_c" 1>&6 +else + cat > conftest.$ac_ext < +#include +#ifdef _POSIX_VERSION + yes +#endif + +EOF +if (eval "$ac_cpp conftest.$ac_ext") 2>&5 | + egrep "yes" >/dev/null 2>&1; then + rm -rf conftest* + g77_cv_header_posix=yes +else + rm -rf conftest* + g77_cv_header_posix=no +fi +rm -f conftest* + +fi + +echo "$ac_t""$g77_cv_header_posix" 1>&6 + +# We can rely on the GNU library being posix-ish. I guess checking the +# header isn't actually like checking the functions, though... +echo $ac_n "checking for GNU library""... $ac_c" 1>&6 +echo "configure:985: checking for GNU library" >&5 +if eval "test \"`echo '$''{'g77_cv_lib_gnu'+set}'`\" = set"; then + echo $ac_n "(cached) $ac_c" 1>&6 +else + cat > conftest.$ac_ext < +#ifdef __GNU_LIBRARY__ + yes +#endif + +EOF +if (eval "$ac_cpp conftest.$ac_ext") 2>&5 | + egrep "yes" >/dev/null 2>&1; then + rm -rf conftest* + g77_cv_lib_gnu=yes +else + rm -rf conftest* + g77_cv_lib_gnu=no +fi +rm -f conftest* + +fi + +echo "$ac_t""$g77_cv_lib_gnu" 1>&6 + +# Apparently cygwin needs to be special-cased. +echo $ac_n "checking for cyg\`win'32""... $ac_c" 1>&6 +echo "configure:1014: checking for cyg\`win'32" >&5 +if eval "test \"`echo '$''{'g77_cv_sys_cygwin32'+set}'`\" = set"; then + echo $ac_n "(cached) $ac_c" 1>&6 +else + cat > conftest.$ac_ext <&5 | + egrep "yes" >/dev/null 2>&1; then + rm -rf conftest* + g77_cv_sys_cygwin32=yes +else + rm -rf conftest* + g77_cv_sys_cygwin32=no +fi +rm -f conftest* + +fi + +echo "$ac_t""$g77_cv_sys_cygwin32" 1>&6 + +# ditto for mingw32. +echo $ac_n "checking for mingw32""... $ac_c" 1>&6 +echo "configure:1042: checking for mingw32" >&5 +if eval "test \"`echo '$''{'g77_cv_sys_mingw32'+set}'`\" = set"; then + echo $ac_n "(cached) $ac_c" 1>&6 +else + cat > conftest.$ac_ext <&5 | + egrep "yes" >/dev/null 2>&1; then + rm -rf conftest* + g77_cv_sys_mingw32=yes +else + rm -rf conftest* + g77_cv_sys_mingw32=no +fi +rm -f conftest* + +fi + +echo "$ac_t""$g77_cv_sys_mingw32" 1>&6 + + +ac_safe=`echo "fcntl.h" | sed 'y%./+-%__p_%'` +echo $ac_n "checking for fcntl.h""... $ac_c" 1>&6 +echo "configure:1071: checking for fcntl.h" >&5 +if eval "test \"`echo '$''{'ac_cv_header_$ac_safe'+set}'`\" = set"; then + echo $ac_n "(cached) $ac_c" 1>&6 +else + cat > conftest.$ac_ext < +EOF +ac_try="$ac_cpp conftest.$ac_ext >/dev/null 2>conftest.out" +{ (eval echo configure:1081: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; } +ac_err=`grep -v '^ *+' conftest.out` +if test -z "$ac_err"; then + rm -rf conftest* + eval "ac_cv_header_$ac_safe=yes" +else + echo "$ac_err" >&5 + echo "configure: failed program was:" >&5 + cat conftest.$ac_ext >&5 + rm -rf conftest* + eval "ac_cv_header_$ac_safe=no" +fi +rm -f conftest* +fi +if eval "test \"`echo '$ac_cv_header_'$ac_safe`\" = yes"; then + echo "$ac_t""yes" 1>&6 + test $g77_cv_header_posix = yes && cat >> confdefs.h <<\EOF +#define _POSIX_SOURCE 1 +EOF + +else + echo "$ac_t""no" 1>&6 +cat >> confdefs.h <<\EOF +#define NO_FCNTL 1 +EOF + cat >> confdefs.h <<\EOF +#define OPEN_DECL 1 +EOF + +fi + + +echo $ac_n "checking for working const""... $ac_c" 1>&6 +echo "configure:1114: checking for working const" >&5 +if eval "test \"`echo '$''{'ac_cv_c_const'+set}'`\" = set"; then + echo $ac_n "(cached) $ac_c" 1>&6 +else + cat > conftest.$ac_ext <j = 5; +} +{ /* ULTRIX-32 V3.1 (Rev 9) vcc rejects this */ + const int foo = 10; +} + +; return 0; } +EOF +if { (eval echo configure:1168: \"$ac_compile\") 1>&5; (eval $ac_compile) 2>&5; }; then + rm -rf conftest* + ac_cv_c_const=yes +else + echo "configure: failed program was:" >&5 + cat conftest.$ac_ext >&5 + rm -rf conftest* + ac_cv_c_const=no +fi +rm -f conftest* +fi + +echo "$ac_t""$ac_cv_c_const" 1>&6 +if test $ac_cv_c_const = no; then + cat >> confdefs.h <<\EOF +#define const +EOF + +fi + +echo $ac_n "checking for size_t""... $ac_c" 1>&6 +echo "configure:1189: checking for size_t" >&5 +if eval "test \"`echo '$''{'ac_cv_type_size_t'+set}'`\" = set"; then + echo $ac_n "(cached) $ac_c" 1>&6 +else + cat > conftest.$ac_ext < +#if STDC_HEADERS +#include +#include +#endif +EOF +if (eval "$ac_cpp conftest.$ac_ext") 2>&5 | + egrep "size_t[^a-zA-Z_0-9]" >/dev/null 2>&1; then + rm -rf conftest* + ac_cv_type_size_t=yes +else + rm -rf conftest* + ac_cv_type_size_t=no +fi +rm -f conftest* + +fi +echo "$ac_t""$ac_cv_type_size_t" 1>&6 +if test $ac_cv_type_size_t = no; then + cat >> confdefs.h <<\EOF +#define size_t unsigned +EOF + +fi + + +echo $ac_n "checking return type of signal handlers""... $ac_c" 1>&6 +echo "configure:1223: checking return type of signal handlers" >&5 +if eval "test \"`echo '$''{'ac_cv_type_signal'+set}'`\" = set"; then + echo $ac_n "(cached) $ac_c" 1>&6 +else + cat > conftest.$ac_ext < +#include +#ifdef signal +#undef signal +#endif +#ifdef __cplusplus +extern "C" void (*signal (int, void (*)(int)))(int); +#else +void (*signal ()) (); +#endif + +int main() { +int i; +; return 0; } +EOF +if { (eval echo configure:1245: \"$ac_compile\") 1>&5; (eval $ac_compile) 2>&5; }; then + rm -rf conftest* + ac_cv_type_signal=void +else + echo "configure: failed program was:" >&5 + cat conftest.$ac_ext >&5 + rm -rf conftest* + ac_cv_type_signal=int +fi +rm -f conftest* +fi + +echo "$ac_t""$ac_cv_type_signal" 1>&6 +cat >> confdefs.h <&6 +echo "configure:1266: checking for atexit" >&5 +if eval "test \"`echo '$''{'ac_cv_func_atexit'+set}'`\" = set"; then + echo $ac_n "(cached) $ac_c" 1>&6 +else + cat > conftest.$ac_ext < +/* Override any gcc2 internal prototype to avoid an error. */ +/* We use char because int might match the return type of a gcc2 + builtin and then its argument prototype would still apply. */ +char atexit(); + +int main() { + +/* The GNU C library defines this for functions which it implements + to always fail with ENOSYS. Some functions are actually named + something starting with __ and the normal name is an alias. */ +#if defined (__stub_atexit) || defined (__stub___atexit) +choke me +#else +atexit(); +#endif + +; return 0; } +EOF +if { (eval echo configure:1294: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest; then + rm -rf conftest* + eval "ac_cv_func_atexit=yes" +else + echo "configure: failed program was:" >&5 + cat conftest.$ac_ext >&5 + rm -rf conftest* + eval "ac_cv_func_atexit=no" +fi +rm -f conftest* +fi + +if eval "test \"`echo '$ac_cv_func_'atexit`\" = yes"; then + echo "$ac_t""yes" 1>&6 + cat >> confdefs.h <<\EOF +#define onexit atexit +EOF + +else + echo "$ac_t""no" 1>&6 + cat >> confdefs.h <<\EOF +#define NO_ONEXIT 1 +EOF + + echo $ac_n "checking for onexit""... $ac_c" 1>&6 +echo "configure:1319: checking for onexit" >&5 +if eval "test \"`echo '$''{'ac_cv_func_onexit'+set}'`\" = set"; then + echo $ac_n "(cached) $ac_c" 1>&6 +else + cat > conftest.$ac_ext < +/* Override any gcc2 internal prototype to avoid an error. */ +/* We use char because int might match the return type of a gcc2 + builtin and then its argument prototype would still apply. */ +char onexit(); + +int main() { + +/* The GNU C library defines this for functions which it implements + to always fail with ENOSYS. Some functions are actually named + something starting with __ and the normal name is an alias. */ +#if defined (__stub_onexit) || defined (__stub___onexit) +choke me +#else +onexit(); +#endif + +; return 0; } +EOF +if { (eval echo configure:1347: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest; then + rm -rf conftest* + eval "ac_cv_func_onexit=yes" +else + echo "configure: failed program was:" >&5 + cat conftest.$ac_ext >&5 + rm -rf conftest* + eval "ac_cv_func_onexit=no" +fi +rm -f conftest* +fi + +if eval "test \"`echo '$ac_cv_func_'onexit`\" = yes"; then + echo "$ac_t""yes" 1>&6 + : +else + echo "$ac_t""no" 1>&6 +echo $ac_n "checking for on_exit""... $ac_c" 1>&6 +echo "configure:1365: checking for on_exit" >&5 +if eval "test \"`echo '$''{'ac_cv_func_on_exit'+set}'`\" = set"; then + echo $ac_n "(cached) $ac_c" 1>&6 +else + cat > conftest.$ac_ext < +/* Override any gcc2 internal prototype to avoid an error. */ +/* We use char because int might match the return type of a gcc2 + builtin and then its argument prototype would still apply. */ +char on_exit(); + +int main() { + +/* The GNU C library defines this for functions which it implements + to always fail with ENOSYS. Some functions are actually named + something starting with __ and the normal name is an alias. */ +#if defined (__stub_on_exit) || defined (__stub___on_exit) +choke me +#else +on_exit(); +#endif + +; return 0; } +EOF +if { (eval echo configure:1393: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest; then + rm -rf conftest* + eval "ac_cv_func_on_exit=yes" +else + echo "configure: failed program was:" >&5 + cat conftest.$ac_ext >&5 + rm -rf conftest* + eval "ac_cv_func_on_exit=no" +fi +rm -f conftest* +fi + +if eval "test \"`echo '$ac_cv_func_'on_exit`\" = yes"; then + echo "$ac_t""yes" 1>&6 + cat >> confdefs.h <<\EOF +#define onexit on_exit +EOF + +else + echo "$ac_t""no" 1>&6 +fi + +fi + +fi + +else true +fi + +# This should always succeed on unix. +# Apparently positive result on cygwin loses re. NON_UNIX_STDIO +# (as of cygwin b18). Likewise on mingw. +echo $ac_n "checking for fstat""... $ac_c" 1>&6 +echo "configure:1426: checking for fstat" >&5 +if eval "test \"`echo '$''{'ac_cv_func_fstat'+set}'`\" = set"; then + echo $ac_n "(cached) $ac_c" 1>&6 +else + cat > conftest.$ac_ext < +/* Override any gcc2 internal prototype to avoid an error. */ +/* We use char because int might match the return type of a gcc2 + builtin and then its argument prototype would still apply. */ +char fstat(); + +int main() { + +/* The GNU C library defines this for functions which it implements + to always fail with ENOSYS. Some functions are actually named + something starting with __ and the normal name is an alias. */ +#if defined (__stub_fstat) || defined (__stub___fstat) +choke me +#else +fstat(); +#endif + +; return 0; } +EOF +if { (eval echo configure:1454: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest; then + rm -rf conftest* + eval "ac_cv_func_fstat=yes" +else + echo "configure: failed program was:" >&5 + cat conftest.$ac_ext >&5 + rm -rf conftest* + eval "ac_cv_func_fstat=no" +fi +rm -f conftest* +fi + +if eval "test \"`echo '$ac_cv_func_'fstat`\" = yes"; then + echo "$ac_t""yes" 1>&6 + : +else + echo "$ac_t""no" 1>&6 +fi + +echo $ac_n "checking need for NON_UNIX_STDIO""... $ac_c" 1>&6 +echo "configure:1474: checking need for NON_UNIX_STDIO" >&5 +if test $g77_cv_sys_cygwin32 = yes \ + || test $g77_cv_sys_mingw32 = yes \ + || test $ac_cv_func_fstat = no; then + echo "$ac_t""yes" 1>&6 + cat >> confdefs.h <<\EOF +#define NON_UNIX_STDIO 1 +EOF + +else + echo "$ac_t""no" 1>&6 +fi + +# This is necessary for e.g. Linux: +echo $ac_n "checking for necessary members of struct FILE""... $ac_c" 1>&6 +echo "configure:1489: checking for necessary members of struct FILE" >&5 +if eval "test \"`echo '$''{'g77_cv_struct_FILE'+set}'`\" = set"; then + echo $ac_n "(cached) $ac_c" 1>&6 +else + cat > conftest.$ac_ext < +int main() { +FILE s; s._ptr; s._base; s._flag; +; return 0; } +EOF +if { (eval echo configure:1501: \"$ac_compile\") 1>&5; (eval $ac_compile) 2>&5; }; then + rm -rf conftest* + g77_cv_struct_FILE=yes +else + echo "configure: failed program was:" >&5 + cat conftest.$ac_ext >&5 + rm -rf conftest* + g77_cv_struct_FILE=no +fi +rm -f conftest* +fi +echo "$ac_t""$g77_cv_struct_FILE" 1>&6 +if test $g77_cv_struct_FILE = no; then + cat >> confdefs.h <<\EOF +#define MISSING_FILE_ELEMS 1 +EOF + +fi + +echo $ac_n "checking for drem in -lm""... $ac_c" 1>&6 +echo "configure:1521: checking for drem in -lm" >&5 +ac_lib_var=`echo m'_'drem | sed 'y%./+-%__p_%'` +if eval "test \"`echo '$''{'ac_cv_lib_$ac_lib_var'+set}'`\" = set"; then + echo $ac_n "(cached) $ac_c" 1>&6 +else + ac_save_LIBS="$LIBS" +LIBS="-lm $LIBS" +cat > conftest.$ac_ext <&5; (eval $ac_link) 2>&5; } && test -s conftest; then + rm -rf conftest* + eval "ac_cv_lib_$ac_lib_var=yes" +else + echo "configure: failed program was:" >&5 + cat conftest.$ac_ext >&5 + rm -rf conftest* + eval "ac_cv_lib_$ac_lib_var=no" +fi +rm -f conftest* +LIBS="$ac_save_LIBS" + +fi +if eval "test \"`echo '$ac_cv_lib_'$ac_lib_var`\" = yes"; then + echo "$ac_t""yes" 1>&6 + cat >> confdefs.h <<\EOF +#define IEEE_drem 1 +EOF + +else + echo "$ac_t""no" 1>&6 +fi + + + +# posix will guarantee the right behaviour for sprintf, else we can't be +# sure; HEADER_STDC wouldn't be the right check in sunos4, for instance. +# However, on my sunos4/gcc setup unistd.h leads us wrongly to believe +# we're posix-conformant, so always do the test. +echo $ac_n "checking for ansi/posix sprintf result""... $ac_c" 1>&6 +echo "configure:1570: checking for ansi/posix sprintf result" >&5 +if test "$cross_compiling" = yes; then + g77_cv_sys_sprintf_ansi=no +else + cat > conftest.$ac_ext < + /* does sprintf return the number of chars transferred? */ + main () {char foo[2]; (sprintf(foo, "1") == 1) ? exit(0) : exit(1);} + +EOF +if { (eval echo configure:1582: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest && (./conftest; exit) 2>/dev/null +then + g77_cv_sys_sprintf_ansi=yes +else + echo "configure: failed program was:" >&5 + cat conftest.$ac_ext >&5 + rm -fr conftest* + g77_cv_sys_sprintf_ansi=no +fi +rm -fr conftest* +fi + +if eval "test \"`echo '$''{'g77_cv_sys_sprintf_ansi'+set}'`\" = set"; then + echo $ac_n "(cached) $ac_c" 1>&6 +else + g77_cv_sys_sprintf_ansi=$g77_cv_sys_sprintf_ansi +fi + +if test $ac_cv_c_cross = no; then + echo "$ac_t""$g77_cv_sys_sprintf_ansi" 1>&6 +else + echo "$ac_t""can't tell -- assuming no" 1>&6 +fi +# The cygwin patch takes steps to avoid defining USE_STRLEN here -- I don't +# understand why. +if test $g77_cv_sys_sprintf_ansi != yes; then + cat >> confdefs.h <<\EOF +#define USE_STRLEN 1 +EOF + +fi + +# define NON_ANSI_RW_MODES on unix (can't hurt) +echo $ac_n "checking NON_ANSI_RW_MODES""... $ac_c" 1>&6 +echo "configure:1616: checking NON_ANSI_RW_MODES" >&5 +cat > conftest.$ac_ext <&5 | + egrep "yes" >/dev/null 2>&1; then + rm -rf conftest* + is_unix=yes +else + rm -rf conftest* + is_unix=no +fi +rm -f conftest* + +if test $g77_cv_sys_cygwin32 = yes || test $g77_cv_sys_mingw32 = yes; then + echo "$ac_t""no" 1>&6 +else + if test $is_unix = yes; then + cat >> confdefs.h <<\EOF +#define NON_ANSI_RW_MODES 1 +EOF + + echo "$ac_t""yes" 1>&6 + else + echo "$ac_t""no" 1>&6 + fi +fi + +# We have to firkle with the info in hconfig.h to figure out suitable types +# (via com.h). proj.h and com.h are in $srcdir/.., config.h which they need +# is in ../.. and the config files are in $srcdir/../../config. +echo $ac_n "checking f2c integer type""... $ac_c" 1>&6 +echo "configure:1659: checking f2c integer type" >&5 +late_ac_cpp=$ac_cpp +ac_cpp="$late_ac_cpp -I$srcdir/.. -I../.. -I$srcdir/../.. -I$srcdir/../../config" +if eval "test \"`echo '$''{'g77_cv_sys_f2cinteger'+set}'`\" = set"; then + echo $ac_n "(cached) $ac_c" 1>&6 +else + cat > conftest.$ac_ext <&5 | + egrep "F2C_INTEGER=long int" >/dev/null 2>&1; then + rm -rf conftest* + g77_cv_sys_f2cinteger="long int" +fi +rm -f conftest* + +if test "$g77_cv_sys_f2cinteger" = ""; then + cat > conftest.$ac_ext <&5 | + egrep "F2C_INTEGER=int" >/dev/null 2>&1; then + rm -rf conftest* + g77_cv_sys_f2cinteger=int +fi +rm -f conftest* + +fi +if test "$g77_cv_sys_f2cinteger" = ""; then + echo "$ac_t""""" 1>&6 + { echo "configure: error: Can't determine type for f2c integer; config.log may help." 1>&2; exit 1; } +fi + +fi + +echo "$ac_t""$g77_cv_sys_f2cinteger" 1>&6 +F2C_INTEGER=$g77_cv_sys_f2cinteger +ac_cpp=$late_ac_cpp + + +echo $ac_n "checking f2c long int type""... $ac_c" 1>&6 +echo "configure:1724: checking f2c long int type" >&5 +late_ac_cpp=$ac_cpp +ac_cpp="$late_ac_cpp -I$srcdir/.. -I../.. -I$srcdir/../.. -I$srcdir/../../config" +if eval "test \"`echo '$''{'g77_cv_sys_f2clongint'+set}'`\" = set"; then + echo $ac_n "(cached) $ac_c" 1>&6 +else + cat > conftest.$ac_ext <&5 | + egrep "F2C_LONGINT=long int" >/dev/null 2>&1; then + rm -rf conftest* + g77_cv_sys_f2clongint="long int" +fi +rm -f conftest* + +if test "$g77_cv_sys_f2clongint" = ""; then + cat > conftest.$ac_ext <&5 | + egrep "F2C_LONGINT=long long int" >/dev/null 2>&1; then + rm -rf conftest* + g77_cv_sys_f2clongint="long long int" +fi +rm -f conftest* + +fi +if test "$g77_cv_sys_f2clongint" = ""; then + echo "$ac_t""""" 1>&6 + { echo "configure: error: Can't determine type for f2c long int; config.log may help." 1>&2; exit 1; } +fi + +fi + +echo "$ac_t""$g77_cv_sys_f2clongint" 1>&6 +F2C_LONGINT=$g77_cv_sys_f2clongint +ac_cpp=$late_ac_cpp + + + + + + +# This EOF_CHAR is a misfeature on unix. +cat >> confdefs.h <<\EOF +#define NO_EOF_CHAR_CHECK 1 +EOF + + +cat >> confdefs.h <<\EOF +#define Skip_f2c_Undefs 1 +EOF + + + + + +cat >> confdefs.h <<\EOF +#define Pad_UDread 1 +EOF + + + + + +cat >> confdefs.h <<\EOF +#define WANT_LEAD_0 1 +EOF + + +# avoid confusion in case the `makefile's from the f2c distribution have +# got put here +test -f libF77/makefile && mv libF77/makefile libF77/makefile.ori +test -f libI77/makefile && mv libI77/makefile libI77/makefile.ori +test -f libU77/makefile && mv libU77/makefile libU77/makefile.ori + +ac_aux_dir= +for ac_dir in $srcdir $srcdir/.. $srcdir/../..; do + if test -f $ac_dir/install-sh; then + ac_aux_dir=$ac_dir + ac_install_sh="$ac_aux_dir/install-sh -c" + break + elif test -f $ac_dir/install.sh; then + ac_aux_dir=$ac_dir + ac_install_sh="$ac_aux_dir/install.sh -c" + break + fi +done +if test -z "$ac_aux_dir"; then + { echo "configure: error: can not find install-sh or install.sh in $srcdir $srcdir/.. $srcdir/../.." 1>&2; exit 1; } +fi +ac_config_guess=$ac_aux_dir/config.guess +ac_config_sub=$ac_aux_dir/config.sub +ac_configure=$ac_aux_dir/configure # This should be Cygnus configure. + +subdirs="libU77" + +trap '' 1 2 15 +cat > confcache <<\EOF +# This file is a shell script that caches the results of configure +# tests run on this system so they can be shared between configure +# scripts and configure runs. It is not useful on other systems. +# If it contains results you don't want to keep, you may remove or edit it. +# +# By default, configure uses ./config.cache as the cache file, +# creating it if it does not exist already. You can give configure +# the --cache-file=FILE option to use a different cache file; that is +# what configure does when it calls configure scripts in +# subdirectories, so they share the cache. +# Giving --cache-file=/dev/null disables caching, for debugging configure. +# config.status only pays attention to the cache file if you give it the +# --recheck option to rerun configure. +# +EOF +# The following way of writing the cache mishandles newlines in values, +# but we know of no workaround that is simple, portable, and efficient. +# So, don't put newlines in cache variables' values. +# Ultrix sh set writes to stderr and can't be redirected directly, +# and sets the high bit in the cache file unless we assign to the vars. +(set) 2>&1 | + case `(ac_space=' '; set) 2>&1` in + *ac_space=\ *) + # `set' does not quote correctly, so add quotes (double-quote substitution + # turns \\\\ into \\, and sed turns \\ into \). + sed -n \ + -e "s/'/'\\\\''/g" \ + -e "s/^\\([a-zA-Z0-9_]*_cv_[a-zA-Z0-9_]*\\)=\\(.*\\)/\\1=\${\\1='\\2'}/p" + ;; + *) + # `set' quotes correctly as required by POSIX, so do not add quotes. + sed -n -e 's/^\([a-zA-Z0-9_]*_cv_[a-zA-Z0-9_]*\)=\(.*\)/\1=${\1=\2}/p' + ;; + esac >> confcache +if cmp -s $cache_file confcache; then + : +else + if test -w $cache_file; then + echo "updating cache $cache_file" + cat confcache > $cache_file + else + echo "not updating unwritable cache $cache_file" + fi +fi +rm -f confcache + +trap 'rm -fr conftest* confdefs* core core.* *.core $ac_clean_files; exit 1' 1 2 15 + +test "x$prefix" = xNONE && prefix=$ac_default_prefix +# Let make expand exec_prefix. +test "x$exec_prefix" = xNONE && exec_prefix='${prefix}' + +# Any assignment to VPATH causes Sun make to only execute +# the first set of double-colon rules, so remove it if not needed. +# If there is a colon in the path, we need to keep it. +if test "x$srcdir" = x.; then + ac_vpsub='/^[ ]*VPATH[ ]*=[^:]*$/d' +fi + +trap 'rm -f $CONFIG_STATUS conftest*; exit 1' 1 2 15 + +# Transform confdefs.h into DEFS. +# Protect against shell expansion while executing Makefile rules. +# Protect against Makefile macro expansion. +cat > conftest.defs <<\EOF +s%#define \([A-Za-z_][A-Za-z0-9_]*\) *\(.*\)%-D\1=\2%g +s%[ `~#$^&*(){}\\|;'"<>?]%\\&%g +s%\[%\\&%g +s%\]%\\&%g +s%\$%$$%g +EOF +DEFS=`sed -f conftest.defs confdefs.h | tr '\012' ' '` +rm -f conftest.defs + + +# Without the "./", some shells look in PATH for config.status. +: ${CONFIG_STATUS=./config.status} + +echo creating $CONFIG_STATUS +rm -f $CONFIG_STATUS +cat > $CONFIG_STATUS </dev/null | sed 1q`: +# +# $0 $ac_configure_args +# +# Compiler output produced by configure, useful for debugging +# configure, is in ./config.log if it exists. + +ac_cs_usage="Usage: $CONFIG_STATUS [--recheck] [--version] [--help]" +for ac_option +do + case "\$ac_option" in + -recheck | --recheck | --rechec | --reche | --rech | --rec | --re | --r) + echo "running \${CONFIG_SHELL-/bin/sh} $0 $ac_configure_args --no-create --no-recursion" + exec \${CONFIG_SHELL-/bin/sh} $0 $ac_configure_args --no-create --no-recursion ;; + -version | --version | --versio | --versi | --vers | --ver | --ve | --v) + echo "$CONFIG_STATUS generated by autoconf version 2.12" + exit 0 ;; + -help | --help | --hel | --he | --h) + echo "\$ac_cs_usage"; exit 0 ;; + *) echo "\$ac_cs_usage"; exit 1 ;; + esac +done + +ac_given_srcdir=$srcdir + +trap 'rm -fr `echo "Makefile f2c.h libI77/Makefile libF77/Makefile" | sed "s/:[^ ]*//g"` conftest*; exit 1' 1 2 15 +EOF +cat >> $CONFIG_STATUS < conftest.subs <<\\CEOF +$ac_vpsub +$extrasub +s%@CFLAGS@%$CFLAGS%g +s%@CPPFLAGS@%$CPPFLAGS%g +s%@CXXFLAGS@%$CXXFLAGS%g +s%@DEFS@%$DEFS%g +s%@LDFLAGS@%$LDFLAGS%g +s%@LIBS@%$LIBS%g +s%@exec_prefix@%$exec_prefix%g +s%@prefix@%$prefix%g +s%@program_transform_name@%$program_transform_name%g +s%@bindir@%$bindir%g +s%@sbindir@%$sbindir%g +s%@libexecdir@%$libexecdir%g +s%@datadir@%$datadir%g +s%@sysconfdir@%$sysconfdir%g +s%@sharedstatedir@%$sharedstatedir%g +s%@localstatedir@%$localstatedir%g +s%@libdir@%$libdir%g +s%@includedir@%$includedir%g +s%@oldincludedir@%$oldincludedir%g +s%@infodir@%$infodir%g +s%@mandir@%$mandir%g +s%@CC@%$CC%g +s%@AR@%$AR%g +s%@RANLIB@%$RANLIB%g +s%@RANLIB_TEST@%$RANLIB_TEST%g +s%@CPP@%$CPP%g +s%@F2C_INTEGER@%$F2C_INTEGER%g +s%@F2C_LONGINT@%$F2C_LONGINT%g +s%@CROSS@%$CROSS%g +s%@subdirs@%$subdirs%g + +CEOF +EOF + +cat >> $CONFIG_STATUS <<\EOF + +# Split the substitutions into bite-sized pieces for seds with +# small command number limits, like on Digital OSF/1 and HP-UX. +ac_max_sed_cmds=90 # Maximum number of lines to put in a sed script. +ac_file=1 # Number of current file. +ac_beg=1 # First line for current file. +ac_end=$ac_max_sed_cmds # Line after last line for current file. +ac_more_lines=: +ac_sed_cmds="" +while $ac_more_lines; do + if test $ac_beg -gt 1; then + sed "1,${ac_beg}d; ${ac_end}q" conftest.subs > conftest.s$ac_file + else + sed "${ac_end}q" conftest.subs > conftest.s$ac_file + fi + if test ! -s conftest.s$ac_file; then + ac_more_lines=false + rm -f conftest.s$ac_file + else + if test -z "$ac_sed_cmds"; then + ac_sed_cmds="sed -f conftest.s$ac_file" + else + ac_sed_cmds="$ac_sed_cmds | sed -f conftest.s$ac_file" + fi + ac_file=`expr $ac_file + 1` + ac_beg=$ac_end + ac_end=`expr $ac_end + $ac_max_sed_cmds` + fi +done +if test -z "$ac_sed_cmds"; then + ac_sed_cmds=cat +fi +EOF + +cat >> $CONFIG_STATUS <> $CONFIG_STATUS <<\EOF +for ac_file in .. $CONFIG_FILES; do if test "x$ac_file" != x..; then + # Support "outfile[:infile[:infile...]]", defaulting infile="outfile.in". + case "$ac_file" in + *:*) ac_file_in=`echo "$ac_file"|sed 's%[^:]*:%%'` + ac_file=`echo "$ac_file"|sed 's%:.*%%'` ;; + *) ac_file_in="${ac_file}.in" ;; + esac + + # Adjust a relative srcdir, top_srcdir, and INSTALL for subdirectories. + + # Remove last slash and all that follows it. Not all systems have dirname. + ac_dir=`echo $ac_file|sed 's%/[^/][^/]*$%%'` + if test "$ac_dir" != "$ac_file" && test "$ac_dir" != .; then + # The file is in a subdirectory. + test ! -d "$ac_dir" && mkdir "$ac_dir" + ac_dir_suffix="/`echo $ac_dir|sed 's%^\./%%'`" + # A "../" for each directory in $ac_dir_suffix. + ac_dots=`echo $ac_dir_suffix|sed 's%/[^/]*%../%g'` + else + ac_dir_suffix= ac_dots= + fi + + case "$ac_given_srcdir" in + .) srcdir=. + if test -z "$ac_dots"; then top_srcdir=. + else top_srcdir=`echo $ac_dots|sed 's%/$%%'`; fi ;; + /*) srcdir="$ac_given_srcdir$ac_dir_suffix"; top_srcdir="$ac_given_srcdir" ;; + *) # Relative path. + srcdir="$ac_dots$ac_given_srcdir$ac_dir_suffix" + top_srcdir="$ac_dots$ac_given_srcdir" ;; + esac + + + echo creating "$ac_file" + rm -f "$ac_file" + configure_input="Generated automatically from `echo $ac_file_in|sed 's%.*/%%'` by configure." + case "$ac_file" in + *Makefile*) ac_comsub="1i\\ +# $configure_input" ;; + *) ac_comsub= ;; + esac + + ac_file_inputs=`echo $ac_file_in|sed -e "s%^%$ac_given_srcdir/%" -e "s%:% $ac_given_srcdir/%g"` + sed -e "$ac_comsub +s%@configure_input@%$configure_input%g +s%@srcdir@%$srcdir%g +s%@top_srcdir@%$top_srcdir%g +" $ac_file_inputs | (eval "$ac_sed_cmds") > $ac_file +fi; done +rm -f conftest.s* + +EOF +cat >> $CONFIG_STATUS <> $CONFIG_STATUS <<\EOF + +exit 0 +EOF +chmod +x $CONFIG_STATUS +rm -fr confdefs* $ac_clean_files +test "$no_create" = yes || ${CONFIG_SHELL-/bin/sh} $CONFIG_STATUS || exit 1 + +if test "$no_recursion" != yes; then + + # Remove --cache-file and --srcdir arguments so they do not pile up. + ac_sub_configure_args= + ac_prev= + for ac_arg in $ac_configure_args; do + if test -n "$ac_prev"; then + ac_prev= + continue + fi + case "$ac_arg" in + -cache-file | --cache-file | --cache-fil | --cache-fi \ + | --cache-f | --cache- | --cache | --cach | --cac | --ca | --c) + ac_prev=cache_file ;; + -cache-file=* | --cache-file=* | --cache-fil=* | --cache-fi=* \ + | --cache-f=* | --cache-=* | --cache=* | --cach=* | --cac=* | --ca=* | --c=*) + ;; + -srcdir | --srcdir | --srcdi | --srcd | --src | --sr) + ac_prev=srcdir ;; + -srcdir=* | --srcdir=* | --srcdi=* | --srcd=* | --src=* | --sr=*) + ;; + *) ac_sub_configure_args="$ac_sub_configure_args $ac_arg" ;; + esac + done + + for ac_config_dir in libU77; do + + # Do not complain, so a configure script can configure whichever + # parts of a large source tree are present. + if test ! -d $srcdir/$ac_config_dir; then + continue + fi + + echo configuring in $ac_config_dir + + case "$srcdir" in + .) ;; + *) + if test -d ./$ac_config_dir || mkdir ./$ac_config_dir; then :; + else + { echo "configure: error: can not create `pwd`/$ac_config_dir" 1>&2; exit 1; } + fi + ;; + esac + + ac_popdir=`pwd` + cd $ac_config_dir + + # A "../" for each directory in /$ac_config_dir. + ac_dots=`echo $ac_config_dir|sed -e 's%^\./%%' -e 's%[^/]$%&/%' -e 's%[^/]*/%../%g'` + + case "$srcdir" in + .) # No --srcdir option. We are building in place. + ac_sub_srcdir=$srcdir ;; + /*) # Absolute path. + ac_sub_srcdir=$srcdir/$ac_config_dir ;; + *) # Relative path. + ac_sub_srcdir=$ac_dots$srcdir/$ac_config_dir ;; + esac + + # Check for guested configure; otherwise get Cygnus style configure. + if test -f $ac_sub_srcdir/configure; then + ac_sub_configure=$ac_sub_srcdir/configure + elif test -f $ac_sub_srcdir/configure.in; then + ac_sub_configure=$ac_configure + else + echo "configure: warning: no configuration information is in $ac_config_dir" 1>&2 + ac_sub_configure= + fi + + # The recursion is here. + if test -n "$ac_sub_configure"; then + + # Make the cache file name correct relative to the subdirectory. + case "$cache_file" in + /*) ac_sub_cache_file=$cache_file ;; + *) # Relative path. + ac_sub_cache_file="$ac_dots$cache_file" ;; + esac + + echo "running ${CONFIG_SHELL-/bin/sh} $ac_sub_configure $ac_sub_configure_args --cache-file=$ac_sub_cache_file --srcdir=$ac_sub_srcdir" + # The eval makes quoting arguments work. + if eval ${CONFIG_SHELL-/bin/sh} $ac_sub_configure $ac_sub_configure_args --cache-file=$ac_sub_cache_file --srcdir=$ac_sub_srcdir + then : + else + { echo "configure: error: $ac_sub_configure failed for $ac_config_dir" 1>&2; exit 1; } + fi + fi + + cd $ac_popdir + done +fi + + + diff --git a/libf2c/configure.in b/libf2c/configure.in new file mode 100644 index 00000000000..1c93ff32489 --- /dev/null +++ b/libf2c/configure.in @@ -0,0 +1,391 @@ +# Process this file with autoconf to produce a configure script. +# Copyright (C) 1995, 1997 Free Software Foundation, Inc. +# Contributed by Dave Love (d.love@dl.ac.uk). +# +#This file is part of GNU Fortran. +# +#GNU Fortran is free software; you can redistribute it and/or modify +#it under the terms of the GNU General Public License as published by +#the Free Software Foundation; either version 2, or (at your option) +#any later version. +# +#GNU Fortran is distributed in the hope that it will be useful, +#but WITHOUT ANY WARRANTY; without even the implied warranty of +#MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +#GNU General Public License for more details. +# +#You should have received a copy of the GNU General Public License +#along with GNU Fortran; see the file COPYING. If not, write to +#the Free Software Foundation, 59 Temple Place - Suite 330, Boston, MA +#02111-1307, USA. + +AC_INIT(libF77/Version.c) + +AC_REVISION(1.10) + +dnl Checks for programs. +# For g77 we'll set CC to point at the built gcc, but this will get it into +# the makefiles +AC_PROG_CC +dnl AC_C_CROSS +dnl Gives misleading `(cached)' message from the check. +if test "$CROSS";then + ac_cv_c_cross=yes +else + ac_cv_c_cross=no +fi + +dnl These should be inherited in the recursive make, but ensure they are +dnl defined: +test "$AR" || AR=ar +AC_SUBST(AR) +if test "$RANLIB"; then : + AC_SUBST(RANLIB) +dnl Make sure that RANLIB_TEST is set also. + if test -z "$RANLIB_TEST"; then + RANLIB_TEST=true + fi +else + RANLIB_TEST=true + AC_PROG_RANLIB +fi +AC_SUBST(RANLIB_TEST) + +dnl not needed for g77? +dnl AC_PROG_MAKE_SET + +dnl Checks for libraries. + +dnl Checks for header files. +# Sanity check for the cross-compilation case: +AC_CHECK_HEADER(stdio.h,:, + [AC_MSG_ERROR([Can't find stdio.h. +You must have a usable C system for the target already installed, at least +including headers and, preferably, the library, before you can configure +the G77 runtime system. If necessary, install gcc now with \`LANGUAGES=c', +then the target library, then build with \`LANGUAGES=f77'.])]) + +AC_HEADER_STDC +dnl We could do this if we didn't know we were using gcc +dnl AC_MSG_CHECKING(for prototype-savvy compiler) +dnl AC_CACHE_VAL(g77_cv_sys_proto, +dnl [AC_TRY_LINK(, +dnl dnl looks screwy because TRY_LINK expects a function body +dnl [return 0;} int foo (int * bar) {], +dnl g77_cv_sys_proto=yes, +dnl [g77_cv_sys_proto=no +dnl AC_DEFINE(KR_headers)])]) +dnl AC_MSG_RESULT($g77_cv_sys_proto) + +dnl for U77 +dnl AC_CHECK_HEADERS(unistd.h) + +AC_MSG_CHECKING(for posix) +AC_CACHE_VAL(g77_cv_header_posix, + AC_EGREP_CPP(yes, + [#include +#include +#ifdef _POSIX_VERSION + yes +#endif +], + g77_cv_header_posix=yes, + g77_cv_header_posix=no)) +AC_MSG_RESULT($g77_cv_header_posix) + +# We can rely on the GNU library being posix-ish. I guess checking the +# header isn't actually like checking the functions, though... +AC_MSG_CHECKING(for GNU library) +AC_CACHE_VAL(g77_cv_lib_gnu, + AC_EGREP_CPP(yes, + [#include +#ifdef __GNU_LIBRARY__ + yes +#endif +], + g77_cv_lib_gnu=yes, g77_cv_lib_gnu=no)) +AC_MSG_RESULT($g77_cv_lib_gnu) + +# Apparently cygwin needs to be special-cased. +AC_MSG_CHECKING([for cyg\`win'32]) +AC_CACHE_VAL(g77_cv_sys_cygwin32, + AC_EGREP_CPP(yes, + [#ifdef __CYGWIN32__ + yes +#endif +], + g77_cv_sys_cygwin32=yes, + g77_cv_sys_cygwin32=no)) +AC_MSG_RESULT($g77_cv_sys_cygwin32) + +# ditto for mingw32. +AC_MSG_CHECKING([for mingw32]) +AC_CACHE_VAL(g77_cv_sys_mingw32, + AC_EGREP_CPP(yes, + [#ifdef __MINGW32__ + yes +#endif +], + g77_cv_sys_mingw32=yes, + g77_cv_sys_mingw32=no)) +AC_MSG_RESULT($g77_cv_sys_mingw32) + + +AC_CHECK_HEADER(fcntl.h, + test $g77_cv_header_posix = yes && AC_DEFINE(_POSIX_SOURCE), + AC_DEFINE(NO_FCNTL) AC_DEFINE(OPEN_DECL)) + +dnl Checks for typedefs, structures, and compiler characteristics. +AC_C_CONST +AC_TYPE_SIZE_T + +dnl Checks for library functions. +AC_TYPE_SIGNAL +# we'll get atexit by default +if test $ac_cv_header_stdc != yes; then +AC_CHECK_FUNC(atexit, + AC_DEFINE(onexit,atexit),dnl just in case + [AC_DEFINE(NO_ONEXIT) + AC_CHECK_FUNC(onexit,, + [AC_CHECK_FUNC(on_exit, + AC_DEFINE(onexit,on_exit),)])]) +else true +fi + +# This should always succeed on unix. +# Apparently positive result on cygwin loses re. NON_UNIX_STDIO +# (as of cygwin b18). Likewise on mingw. +AC_CHECK_FUNC(fstat) +AC_MSG_CHECKING([need for NON_UNIX_STDIO]) +if test $g77_cv_sys_cygwin32 = yes \ + || test $g77_cv_sys_mingw32 = yes \ + || test $ac_cv_func_fstat = no; then + AC_MSG_RESULT(yes) + AC_DEFINE(NON_UNIX_STDIO) +else + AC_MSG_RESULT(no) +fi + +# This is necessary for e.g. Linux: +AC_MSG_CHECKING([for necessary members of struct FILE]) +AC_CACHE_VAL(g77_cv_struct_FILE, +[AC_TRY_COMPILE([#include ], + [FILE s; s._ptr; s._base; s._flag;],g77_cv_struct_FILE=yes, + g77_cv_struct_FILE=no)])dnl +AC_MSG_RESULT($g77_cv_struct_FILE) +if test $g77_cv_struct_FILE = no; then + AC_DEFINE(MISSING_FILE_ELEMS) +fi + +dnl perhaps should check also for remainder +dnl Unfortunately, the message implies we're just checking for -lm... +AC_CHECK_LIB(m,drem,AC_DEFINE(IEEE_drem)) + +dnl for U77: +dnl AC_CHECK_FUNCS(symlink getcwd lstat) +dnl test $ac_cv_func_symlink = yes && SYMLNK=symlnk_.o +dnl test $ac_cv_func_lstat = yes && SYMLNK="$SYMLNK lstat_.o" +dnl AC_SUBST(SYMLNK) + +# posix will guarantee the right behaviour for sprintf, else we can't be +# sure; HEADER_STDC wouldn't be the right check in sunos4, for instance. +# However, on my sunos4/gcc setup unistd.h leads us wrongly to believe +# we're posix-conformant, so always do the test. +AC_MSG_CHECKING(for ansi/posix sprintf result) +dnl This loses if included as an argument to AC_CACHE_VAL because the +dnl changequote doesn't take effect and the [] vanish. +dnl fixme: use cached value +AC_TRY_RUN(changequote(<<, >>)dnl + <<#include + /* does sprintf return the number of chars transferred? */ + main () {char foo[2]; (sprintf(foo, "1") == 1) ? exit(0) : exit(1);} +>>changequote([, ]), + g77_cv_sys_sprintf_ansi=yes, + g77_cv_sys_sprintf_ansi=no, + g77_cv_sys_sprintf_ansi=no) +AC_CACHE_VAL(g77_cv_sys_sprintf_ansi, + g77_cv_sys_sprintf_ansi=$g77_cv_sys_sprintf_ansi) +dnl We get a misleading `(cached)' message... +if test $ac_cv_c_cross = no; then + AC_MSG_RESULT($g77_cv_sys_sprintf_ansi) +else + AC_MSG_RESULT([can't tell -- assuming no]) +fi +# The cygwin patch takes steps to avoid defining USE_STRLEN here -- I don't +# understand why. +if test $g77_cv_sys_sprintf_ansi != yes; then + AC_DEFINE(USE_STRLEN) +fi + +# define NON_ANSI_RW_MODES on unix (can't hurt) +AC_MSG_CHECKING(NON_ANSI_RW_MODES) +AC_EGREP_CPP(yes, +[#ifdef unix + yes +#endif +#ifdef __unix + yes +#endif +#ifdef __unix__ + yes +#endif +], is_unix=yes, is_unix=no) +if test $g77_cv_sys_cygwin32 = yes || test $g77_cv_sys_mingw32 = yes; then + AC_MSG_RESULT(no) +else + if test $is_unix = yes; then + AC_DEFINE(NON_ANSI_RW_MODES) + AC_MSG_RESULT(yes) + else + AC_MSG_RESULT(no) + fi +fi + +# We have to firkle with the info in hconfig.h to figure out suitable types +# (via com.h). proj.h and com.h are in $srcdir/.., config.h which they need +# is in ../.. and the config files are in $srcdir/../../config. +AC_MSG_CHECKING(f2c integer type) +late_ac_cpp=$ac_cpp +ac_cpp="$late_ac_cpp -I$srcdir/.. -I../.. -I$srcdir/../.. -I$srcdir/../../config" +AC_CACHE_VAL(g77_cv_sys_f2cinteger, +AC_EGREP_CPP(F2C_INTEGER=long int, +[#include "proj.h" +#define FFECOM_DETERMINE_TYPES 1 +#include "com.h" +#if FFECOM_f2cINTEGER == FFECOM_f2ccodeLONG +F2C_INTEGER=long int +#elif FFECOM_f2cINTEGER == FFECOM_f2ccodeINT +F2C_INTEGER=int +#else +# error "Cannot find a suitable type for F2C_INTEGER" +#endif +], + g77_cv_sys_f2cinteger="long int",) +if test "$g77_cv_sys_f2cinteger" = ""; then + AC_EGREP_CPP(F2C_INTEGER=int, +[#include "proj.h" +#define FFECOM_DETERMINE_TYPES 1 +#include "com.h" +#if FFECOM_f2cINTEGER == FFECOM_f2ccodeLONG +F2C_INTEGER=long int +#elif FFECOM_f2cINTEGER == FFECOM_f2ccodeINT +F2C_INTEGER=int +#else +# error "Cannot find a suitable type for F2C_INTEGER" +#endif +], + g77_cv_sys_f2cinteger=int,) +fi +if test "$g77_cv_sys_f2cinteger" = ""; then + AC_MSG_RESULT("") + AC_MSG_ERROR([Can't determine type for f2c integer; config.log may help.]) +fi +) +AC_MSG_RESULT($g77_cv_sys_f2cinteger) +F2C_INTEGER=$g77_cv_sys_f2cinteger +ac_cpp=$late_ac_cpp +AC_SUBST(F2C_INTEGER) + +AC_MSG_CHECKING(f2c long int type) +late_ac_cpp=$ac_cpp +ac_cpp="$late_ac_cpp -I$srcdir/.. -I../.. -I$srcdir/../.. -I$srcdir/../../config" +AC_CACHE_VAL(g77_cv_sys_f2clongint, +AC_EGREP_CPP(F2C_LONGINT=long int, +[#include "proj.h" +#define FFECOM_DETERMINE_TYPES 1 +#include "com.h" +#if FFECOM_f2cLONGINT == FFECOM_f2ccodeLONG +F2C_LONGINT=long int +#elif FFECOM_f2cLONGINT == FFECOM_f2ccodeLONGLONG +F2C_LONGINT=long long int +#else +# error "Cannot find a suitable type for F2C_LONGINT" +#endif +], + g77_cv_sys_f2clongint="long int",) +if test "$g77_cv_sys_f2clongint" = ""; then + AC_EGREP_CPP(F2C_LONGINT=long long int, +[#include "proj.h" +#define FFECOM_DETERMINE_TYPES 1 +#include "com.h" +#if FFECOM_f2cLONGINT == FFECOM_f2ccodeLONG +F2C_LONGINT=long int +#elif FFECOM_f2cLONGINT == FFECOM_f2ccodeLONGLONG +F2C_LONGINT=long long int +#else +# error "Cannot find a suitable type for F2C_LONGINT" +#endif +], + g77_cv_sys_f2clongint="long long int",) +fi +if test "$g77_cv_sys_f2clongint" = ""; then + AC_MSG_RESULT("") + AC_MSG_ERROR([Can't determine type for f2c long int; config.log may help.]) +fi +) +AC_MSG_RESULT($g77_cv_sys_f2clongint) +F2C_LONGINT=$g77_cv_sys_f2clongint +ac_cpp=$late_ac_cpp +AC_SUBST(F2C_LONGINT) + +dnl maybe check for drem/remainder + +AC_SUBST(CROSS) + + +# This EOF_CHAR is a misfeature on unix. +AC_DEFINE(NO_EOF_CHAR_CHECK) + +AC_DEFINE(Skip_f2c_Undefs) + +dnl Craig had these in f2c.h, but they're only relevant for building libf2c +dnl anyway. + +dnl For GNU Fortran (g77), we always enable the following behaviors for +dnl libf2c, to make things easy on the programmer. The alternate +dnl behaviors have their uses, and g77 might provide them as compiler, +dnl rather than library, options, so only a single copy of a shared libf2c +dnl need be built for a system. + +dnl This makes unformatted I/O more consistent in relation to other +dnl systems. It is not required by the F77 standard. + +AC_DEFINE(Pad_UDread) + +dnl This makes ERR= and IOSTAT= returns work properly in disk-full +dnl situations, making things work more as expected. It slows things +dnl down, so g77 will probably someday choose the original implementation +dnl on a case-by-case basis when it can be shown to not be necessary +dnl (e.g. no ERR= or IOSTAT=) or when it is given the appropriate +dnl compile-time option or, perhaps, source-code directive. + +dnl AC_DEFINE(ALWAYS_FLUSH) + +dnl Most Fortran implementations do this, so to make it easier +dnl to compare the output of g77-compiled programs to those compiled +dnl by most other compilers, tell libf2c to put leading zeros in +dnl appropriate places on output + +AC_DEFINE(WANT_LEAD_0) + +# avoid confusion in case the `makefile's from the f2c distribution have +# got put here +test -f libF77/makefile && mv libF77/makefile libF77/makefile.ori +test -f libI77/makefile && mv libI77/makefile libI77/makefile.ori +test -f libU77/makefile && mv libU77/makefile libU77/makefile.ori + +AC_CONFIG_SUBDIRS(libU77) +AC_OUTPUT(Makefile f2c.h libI77/Makefile libF77/Makefile) + +dnl We might have configuration options to: +dnl * allow non-standard string concatenation (use libF77 s_catow.o, +dnl not s_cat.o) +dnl * change unit preconnexion in libI77/err.c (f_init.c) +dnl * -DALWAYS_FLUSH in libI77 +dnl * -DOMIT_BLANK_CC in libI77 + +dnl Local Variables: +dnl comment-start: "dnl " +dnl comment-end: "" +dnl comment-start-skip: "\\bdnl\\b\\s *" +dnl End: diff --git a/libf2c/disclaimer.netlib b/libf2c/disclaimer.netlib new file mode 100644 index 00000000000..a11108f83db --- /dev/null +++ b/libf2c/disclaimer.netlib @@ -0,0 +1,15 @@ +f2c is a Fortran to C converter under development since 1990 by + David M. Gay (then AT&T Bell Labs, now Bell Labs, Lucent Technologies) + Stu Feldman (then at Bellcore, now at IBM) + Mark Maimone (Carnegie-Mellon University) + Norm Schryer (then AT&T Bell Labs, now AT&T Labs) +Please send bug reports to dmg@research.bell-labs.com . + +AT&T, Bellcore and Lucent disclaim all warranties with regard to this +software, including all implied warranties of merchantability +and fitness. In no event shall AT&T, Bellcore or Lucent be liable for +any special, indirect or consequential damages or any damages +whatsoever resulting from loss of use, data or profits, whether +in an action of contract, negligence or other tortious action, +arising out of or in connection with the use or performance of +this software. diff --git a/libf2c/f2c.h.in b/libf2c/f2c.h.in new file mode 100644 index 00000000000..90374678100 --- /dev/null +++ b/libf2c/f2c.h.in @@ -0,0 +1,227 @@ +/* f2c.h -- Standard Fortran to C header file */ + +/** barf [ba:rf] 2. "He suggested using FORTRAN, and everybody barfed." + + - From The Shogakukan DICTIONARY OF NEW ENGLISH (Second edition) */ + +#ifndef F2C_INCLUDE +#define F2C_INCLUDE + +/* F2C_INTEGER will normally be `int' but would be `long' on 16-bit systems */ +/* we assume short, float are OK */ +typedef @F2C_INTEGER@ /* long int */ integer; +typedef unsigned @F2C_INTEGER@ /* long */ uinteger; +typedef char *address; +typedef short int shortint; +typedef float real; +typedef double doublereal; +typedef struct { real r, i; } complex; +typedef struct { doublereal r, i; } doublecomplex; +typedef @F2C_INTEGER@ /* long int */ logical; +typedef short int shortlogical; +typedef char logical1; +typedef char integer1; +typedef @F2C_LONGINT@ /* long long */ longint; /* system-dependent */ +typedef unsigned @F2C_LONGINT@ /* long long */ ulongint; /* system-dependent */ +#define qbit_clear(a,b) ((a) & ~((ulongint)1 << (b))) +#define qbit_set(a,b) ((a) | ((ulongint)1 << (b))) + +#define TRUE_ (1) +#define FALSE_ (0) + +/* Extern is for use with -E */ +#ifndef Extern +#define Extern extern +#endif + +/* I/O stuff */ + +#ifdef f2c_i2 +#error "f2c_i2 will not work with g77!!!!" +/* for -i2 */ +typedef short flag; +typedef short ftnlen; +typedef short ftnint; +#else +typedef @F2C_INTEGER@ /* long int */ flag; +typedef @F2C_INTEGER@ /* long int */ ftnlen; +typedef @F2C_INTEGER@ /* long int */ ftnint; +#endif + +/*external read, write*/ +typedef struct +{ flag cierr; + ftnint ciunit; + flag ciend; + char *cifmt; + ftnint cirec; +} cilist; + +/*internal read, write*/ +typedef struct +{ flag icierr; + char *iciunit; + flag iciend; + char *icifmt; + ftnint icirlen; + ftnint icirnum; +} icilist; + +/*open*/ +typedef struct +{ flag oerr; + ftnint ounit; + char *ofnm; + ftnlen ofnmlen; + char *osta; + char *oacc; + char *ofm; + ftnint orl; + char *oblnk; +} olist; + +/*close*/ +typedef struct +{ flag cerr; + ftnint cunit; + char *csta; +} cllist; + +/*rewind, backspace, endfile*/ +typedef struct +{ flag aerr; + ftnint aunit; +} alist; + +/* inquire */ +typedef struct +{ flag inerr; + ftnint inunit; + char *infile; + ftnlen infilen; + ftnint *inex; /*parameters in standard's order*/ + ftnint *inopen; + ftnint *innum; + ftnint *innamed; + char *inname; + ftnlen innamlen; + char *inacc; + ftnlen inacclen; + char *inseq; + ftnlen inseqlen; + char *indir; + ftnlen indirlen; + char *infmt; + ftnlen infmtlen; + char *inform; + ftnint informlen; + char *inunf; + ftnlen inunflen; + ftnint *inrecl; + ftnint *innrec; + char *inblank; + ftnlen inblanklen; +} inlist; + +#define VOID void + +union Multitype { /* for multiple entry points */ + integer1 g; + shortint h; + integer i; + /* longint j; */ + real r; + doublereal d; + complex c; + doublecomplex z; + }; + +typedef union Multitype Multitype; + +/*typedef long int Long;*/ /* No longer used; formerly in Namelist */ + +struct Vardesc { /* for Namelist */ + char *name; + char *addr; + ftnlen *dims; + int type; + }; +typedef struct Vardesc Vardesc; + +struct Namelist { + char *name; + Vardesc **vars; + int nvars; + }; +typedef struct Namelist Namelist; + +#define abs(x) ((x) >= 0 ? (x) : -(x)) +#define dabs(x) (doublereal)abs(x) +#define min(a,b) ((a) <= (b) ? (a) : (b)) +#define max(a,b) ((a) >= (b) ? (a) : (b)) +#define dmin(a,b) (doublereal)min(a,b) +#define dmax(a,b) (doublereal)max(a,b) +#define bit_test(a,b) ((a) >> (b) & 1) +#define bit_clear(a,b) ((a) & ~((uinteger)1 << (b))) +#define bit_set(a,b) ((a) | ((uinteger)1 << (b))) + +/* procedure parameter types for -A and -C++ */ + +#define F2C_proc_par_types 1 +#ifdef __cplusplus +typedef int /* Unknown procedure type */ (*U_fp)(...); +typedef shortint (*J_fp)(...); +typedef integer (*I_fp)(...); +typedef real (*R_fp)(...); +typedef doublereal (*D_fp)(...), (*E_fp)(...); +typedef /* Complex */ VOID (*C_fp)(...); +typedef /* Double Complex */ VOID (*Z_fp)(...); +typedef logical (*L_fp)(...); +typedef shortlogical (*K_fp)(...); +typedef /* Character */ VOID (*H_fp)(...); +typedef /* Subroutine */ int (*S_fp)(...); +#else +typedef int /* Unknown procedure type */ (*U_fp)(); +typedef shortint (*J_fp)(); +typedef integer (*I_fp)(); +typedef real (*R_fp)(); +typedef doublereal (*D_fp)(), (*E_fp)(); +typedef /* Complex */ VOID (*C_fp)(); +typedef /* Double Complex */ VOID (*Z_fp)(); +typedef logical (*L_fp)(); +typedef shortlogical (*K_fp)(); +typedef /* Character */ VOID (*H_fp)(); +typedef /* Subroutine */ int (*S_fp)(); +#endif +/* E_fp is for real functions when -R is not specified */ +typedef VOID C_f; /* complex function */ +typedef VOID H_f; /* character function */ +typedef VOID Z_f; /* double complex function */ +typedef doublereal E_f; /* real function with -R not specified */ + +/* undef any lower-case symbols that your C compiler predefines, e.g.: */ + +#ifndef Skip_f2c_Undefs +/* (No such symbols should be defined in a strict ANSI C compiler. + We can avoid trouble with f2c-translated code by using + gcc -ansi [-traditional].) */ +#undef cray +#undef gcos +#undef mc68010 +#undef mc68020 +#undef mips +#undef pdp11 +#undef sgi +#undef sparc +#undef sun +#undef sun2 +#undef sun3 +#undef sun4 +#undef u370 +#undef u3b +#undef u3b2 +#undef u3b5 +#undef unix +#undef vax +#endif +#endif diff --git a/libf2c/f2cext.c b/libf2c/f2cext.c new file mode 100644 index 00000000000..d5ac815c9b4 --- /dev/null +++ b/libf2c/f2cext.c @@ -0,0 +1,562 @@ +/* Copyright (C) 1997 Free Software Foundation, Inc. +This file is part of GNU Fortran run-time library. + +This library is free software; you can redistribute it and/or modify it +under the terms of the GNU Library General Public License as published +by the Free Software Foundation; either version 2 of the License, or +(at your option) any later version. + +GNU Fortran is distributed in the hope that it will be useful, +but WITHOUT ANY WARRANTY; without even the implied warranty of +MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +Library General Public License for more details. + +You should have received a copy of the GNU Library General Public +License along with GNU Fortran; see the file COPYING.LIB. If +not, write to the Free Software Foundation, Inc., 59 Temple Place - Suite 330, +Boston, MA 02111-1307, USA. */ + + +#include +typedef int (*sig_proc)(int); + +#ifdef Labort +int abort_ (void) { + extern int G77_abort_0 (void); + return G77_abort_0 (); +} +#endif + +#ifdef Lderf +double derf_ (doublereal *x) { + extern double G77_derf_0 (doublereal *x); + return G77_derf_0 (x); +} +#endif + +#ifdef Lderfc +double derfc_ (doublereal *x) { + extern double G77_derfc_0 (doublereal *x); + return G77_derfc_0 (x); +} +#endif + +#ifdef Lef1asc +int ef1asc_ (ftnint *a, ftnlen *la, ftnint *b, ftnlen *lb) { + extern int G77_ef1asc_0 (ftnint *a, ftnlen *la, ftnint *b, ftnlen *lb); + return G77_ef1asc_0 (a, la, b, lb); +} +#endif + +#ifdef Lef1cmc +integer ef1cmc_ (ftnint *a, ftnlen *la, ftnint *b, ftnlen *lb) { + extern integer G77_ef1cmc_0 (ftnint *a, ftnlen *la, ftnint *b, ftnlen *lb); + return G77_ef1cmc_0 (a, la, b, lb); +} +#endif + +#ifdef Lerf +double erf_ (real *x) { + extern double G77_erf_0 (real *x); + return G77_erf_0 (x); +} +#endif + +#ifdef Lerfc +double erfc_ (real *x) { + extern double G77_erfc_0 (real *x); + return G77_erfc_0 (x); +} +#endif + +#ifdef Lexit +void exit_ (integer *rc) { + extern void G77_exit_0 (integer *rc); + G77_exit_0 (rc); +} +#endif + +#ifdef Lgetarg +void getarg_ (ftnint *n, char *s, ftnlen ls) { + extern void G77_getarg_0 (ftnint *n, char *s, ftnlen ls); + G77_getarg_0 (n, s, ls); +} +#endif + +#ifdef Lgetenv +void getenv_ (char *fname, char *value, ftnlen flen, ftnlen vlen) { + extern void G77_getenv_0 (char *fname, char *value, ftnlen flen, ftnlen vlen); + G77_getenv_0 (fname, value, flen, vlen); +} +#endif + +#ifdef Liargc +ftnint iargc_ (void) { + extern ftnint G77_iargc_0 (void); + return G77_iargc_0 (); +} +#endif + +#ifdef Lsignal +ftnint signal_ (integer *sigp, sig_proc proc) { + extern ftnint G77_signal_0 (integer *sigp, sig_proc proc); + return G77_signal_0 (sigp, proc); +} +#endif + +#ifdef Lsystem +integer system_ (char *s, ftnlen n) { + extern integer G77_system_0 (char *s, ftnlen n); + return G77_system_0 (s, n); +} +#endif + +#ifdef Lflush +int flush_ (void) { + extern int G77_flush_0 (void); + return G77_flush_0 (); +} +#endif + +#ifdef Lftell +integer ftell_ (integer *Unit) { + extern integer G77_ftell_0 (integer *Unit); + return G77_ftell_0 (Unit); +} +#endif + +#ifdef Lfseek +integer fseek_ (integer *Unit, integer *offset, integer *xwhence) { + extern integer G77_fseek_0 (integer *Unit, integer *offset, integer *xwhence); + return G77_fseek_0 (Unit, offset, xwhence); +} +#endif + +#ifdef Laccess +integer access_ (const char *name, const char *mode, ftnlen Lname, ftnlen Lmode) { + extern integer G77_access_0 (const char *name, const char *mode, ftnlen Lname, ftnlen Lmode); + return G77_access_0 (name, mode, Lname, Lmode); +} +#endif + +#ifdef Lalarm +integer alarm_ (integer *seconds, sig_proc proc, integer *status) { + extern integer G77_alarm_0 (integer *seconds, sig_proc proc); + return G77_alarm_0 (seconds, proc); +} +#endif + +#ifdef Lbesj0 +double besj0_ (const real *x) { + return j0 (*x); +} +#endif + +#ifdef Lbesj1 +double besj1_ (const real *x) { + return j1 (*x); +} +#endif + +#ifdef Lbesjn +double besjn_ (const integer *n, real *x) { + return jn (*n, *x); +} +#endif + +#ifdef Lbesy0 +double besy0_ (const real *x) { + return y0 (*x); +} +#endif + +#ifdef Lbesy1 +double besy1_ (const real *x) { + return y1 (*x); +} +#endif + +#ifdef Lbesyn +double besyn_ (const integer *n, real *x) { + return yn (*n, *x); +} +#endif + +#ifdef Lchdir +integer chdir_ (const char *name, const ftnlen Lname) { + extern integer G77_chdir_0 (const char *name, const ftnlen Lname); + return G77_chdir_0 (name, Lname); +} +#endif + +#ifdef Lchmod +integer chmod_ (const char *name, const char *mode, const ftnlen Lname, const ftnlen Lmode) { + extern integer G77_chmod_0 (const char *name, const char *mode, const ftnlen Lname, const ftnlen Lmode); + return G77_chmod_0 (name, mode, Lname, Lmode); +} +#endif + +#ifdef Lctime +void ctime_ (char *chtime, const ftnlen Lchtime, longint *xstime) { + extern void G77_ctime_0 (char *chtime, const ftnlen Lchtime, longint *xstime); + G77_ctime_0 (chtime, Lchtime, xstime); +} +#endif + +#ifdef Ldate +int date_ (char *buf, ftnlen buf_len) { + extern int G77_date_0 (char *buf, ftnlen buf_len); + return G77_date_0 (buf, buf_len); +} +#endif + +#ifdef Ldbesj0 +double dbesj0_ (const double *x) { + return j0 (*x); +} +#endif + +#ifdef Ldbesj1 +double dbesj1_ (const double *x) { + return j1 (*x); +} +#endif + +#ifdef Ldbesjn +double dbesjn_ (const integer *n, double *x) { + return jn (*n, *x); +} +#endif + +#ifdef Ldbesy0 +double dbesy0_ (const double *x) { + return y0 (*x); +} +#endif + +#ifdef Ldbesy1 +double dbesy1_ (const double *x) { + return y1 (*x); +} +#endif + +#ifdef Ldbesyn +double dbesyn_ (const integer *n, double *x) { + return yn (*n, *x); +} +#endif + +#ifdef Ldtime +double dtime_ (real tarray[2]) { + extern double G77_dtime_0 (real tarray[2]); + return G77_dtime_0 (tarray); +} +#endif + +#ifdef Letime +double etime_ (real tarray[2]) { + extern double G77_etime_0 (real tarray[2]); + return G77_etime_0 (tarray); +} +#endif + +#ifdef Lfdate +void fdate_ (char *ret_val, ftnlen ret_val_len) { + extern void G77_fdate_0 (char *ret_val, ftnlen ret_val_len); + G77_fdate_0 (ret_val, ret_val_len); +} +#endif + +#ifdef Lfgetc +integer fgetc_ (const integer *lunit, char *c, ftnlen Lc) { + extern integer G77_fgetc_0 (const integer *lunit, char *c, ftnlen Lc); + return G77_fgetc_0 (lunit, c, Lc); +} +#endif + +#ifdef Lfget +integer fget_ (char *c, const ftnlen Lc) { + extern integer G77_fget_0 (char *c, const ftnlen Lc); + return G77_fget_0 (c, Lc); +} +#endif + +#ifdef Lflush1 +int flush1_ (const integer *lunit) { + extern int G77_flush1_0 (const integer *lunit); + return G77_flush1_0 (lunit); +} +#endif + +#ifdef Lfnum +integer fnum_ (integer *lunit) { + extern integer G77_fnum_0 (integer *lunit); + return G77_fnum_0 (lunit); +} +#endif + +#ifdef Lfputc +integer fputc_ (const integer *lunit, const char *c, const ftnlen Lc) { + extern integer G77_fputc_0 (const integer *lunit, const char *c, const ftnlen Lc); + return G77_fputc_0 (lunit, c, Lc); +} +#endif + +#ifdef Lfput +integer fput_ (const char *c, const ftnlen Lc) { + extern integer G77_fput_0 (const char *c, const ftnlen Lc); + return G77_fput_0 (c, Lc); +} +#endif + +#ifdef Lfstat +integer fstat_ (const integer *lunit, integer statb[13]) { + extern integer G77_fstat_0 (const integer *lunit, integer statb[13]); + return G77_fstat_0 (lunit, statb); +} +#endif + +#ifdef Lgerror +int gerror_ (char *str, ftnlen Lstr) { + extern int G77_gerror_0 (char *str, ftnlen Lstr); + return G77_gerror_0 (str, Lstr); +} +#endif + +#ifdef Lgetcwd +integer getcwd_ (char *str, const ftnlen Lstr) { + extern integer G77_getcwd_0 (char *str, const ftnlen Lstr); + return G77_getcwd_0 (str, Lstr); +} +#endif + +#ifdef Lgetgid +integer getgid_ (void) { + extern integer G77_getgid_0 (void); + return G77_getgid_0 (); +} +#endif + +#ifdef Lgetlog +int getlog_ (char *str, const ftnlen Lstr) { + extern int G77_getlog_0 (char *str, const ftnlen Lstr); + return G77_getlog_0 (str, Lstr); +} +#endif + +#ifdef Lgetpid +integer getpid_ (void) { + extern integer G77_getpid_0 (void); + return G77_getpid_0 (); +} +#endif + +#ifdef Lgetuid +integer getuid_ (void) { + extern integer G77_getuid_0 (void); + return G77_getuid_0 (); +} +#endif + +#ifdef Lgmtime +int gmtime_ (const integer *stime, integer tarray[9]) { + extern int G77_gmtime_0 (const integer *stime, integer tarray[9]); + return G77_gmtime_0 (stime, tarray); +} +#endif + +#ifdef Lhostnm +integer hostnm_ (char *name, ftnlen Lname) { + extern integer G77_hostnm_0 (char *name, ftnlen Lname); + return G77_hostnm_0 (name, Lname); +} +#endif + +#ifdef Lidate +int idate_ (int iarray[3]) { + extern int G77_idate_0 (int iarray[3]); + return G77_idate_0 (iarray); +} +#endif + +#ifdef Lierrno +integer ierrno_ (void) { + extern integer G77_ierrno_0 (void); + return G77_ierrno_0 (); +} +#endif + +#ifdef Lirand +integer irand_ (integer *flag) { + extern integer G77_irand_0 (integer *flag); + return G77_irand_0 (flag); +} +#endif + +#ifdef Lisatty +logical isatty_ (integer *lunit) { + extern logical G77_isatty_0 (integer *lunit); + return G77_isatty_0 (lunit); +} +#endif + +#ifdef Litime +int itime_ (integer tarray[3]) { + extern int G77_itime_0 (integer tarray[3]); + return G77_itime_0 (tarray); +} +#endif + +#ifdef Lkill +integer kill_ (const integer *pid, const integer *signum) { + extern integer G77_kill_0 (const integer *pid, const integer *signum); + return G77_kill_0 (pid, signum); +} +#endif + +#ifdef Llink +integer link_ (const char *path1, const char *path2, const ftnlen Lpath1, const ftnlen Lpath2) { + extern integer G77_link_0 (const char *path1, const char *path2, const ftnlen Lpath1, const ftnlen Lpath2); + return G77_link_0 (path1, path2, Lpath1, Lpath2); +} +#endif + +#ifdef Llnblnk +integer lnblnk_ (char *str, ftnlen str_len) { + extern integer G77_lnblnk_0 (char *str, ftnlen str_len); + return G77_lnblnk_0 (str, str_len); +} +#endif + +#ifdef Llstat +integer lstat_ (const char *name, integer statb[13], const ftnlen Lname) { + extern integer G77_lstat_0 (const char *name, integer statb[13], const ftnlen Lname); + return G77_lstat_0 (name, statb, Lname); +} +#endif + +#ifdef Lltime +int ltime_ (const integer *stime, integer tarray[9]) { + extern int G77_ltime_0 (const integer *stime, integer tarray[9]); + return G77_ltime_0 (stime, tarray); +} +#endif + +#ifdef Lmclock +longint mclock_ (void) { + extern longint G77_mclock_0 (void); + return G77_mclock_0 (); +} +#endif + +#ifdef Lperror +int perror_ (const char *str, const ftnlen Lstr) { + extern int G77_perror_0 (const char *str, const ftnlen Lstr); + return G77_perror_0 (str, Lstr); +} +#endif + +#ifdef Lrand +double rand_ (integer *flag) { + extern double G77_rand_0 (integer *flag); + return G77_rand_0 (flag); +} +#endif + +#ifdef Lrename +integer rename_ (const char *path1, const char *path2, const ftnlen Lpath1, const ftnlen Lpath2) { + extern integer G77_rename_0 (const char *path1, const char *path2, const ftnlen Lpath1, const ftnlen Lpath2); + return G77_rename_0 (path1, path2, Lpath1, Lpath2); +} +#endif + +#ifdef Lsecnds +double secnds_ (real *r) { + extern double G77_secnds_0 (real *r); + return G77_secnds_0 (r); +} +#endif + +#ifdef Lsecond +double second_ () { + extern double G77_second_0 (); + return G77_second_0 (); +} +#endif + +#ifdef Lsleep +int sleep_ (const integer *seconds) { + extern int G77_sleep_0 (const integer *seconds); + return G77_sleep_0 (seconds); +} +#endif + +#ifdef Lsrand +int srand_ (const integer *seed) { + extern int G77_srand_0 (const integer *seed); + return G77_srand_0 (seed); +} +#endif + +#ifdef Lstat +integer stat_ (const char *name, integer statb[13], const ftnlen Lname) { + extern integer G77_stat_0 (const char *name, integer statb[13], const ftnlen Lname); + return G77_stat_0 (name, statb, Lname); +} +#endif + +#ifdef Lsymlnk +integer symlnk_ (const char *path1, const char *path2, const ftnlen Lpath1, const ftnlen Lpath2) { + extern integer G77_symlnk_0 (const char *path1, const char *path2, const ftnlen Lpath1, const ftnlen Lpath2); + return G77_symlnk_0 (path1, path2, Lpath1, Lpath2); +} +#endif + +#ifdef Lsclock +int system_clock_ (integer *count, integer *count_rate, integer *count_max) { + extern int G77_system_clock_0 (integer *count, integer *count_rate, integer *count_max); + return G77_system_clock_0 (count, count_rate, count_max); +} +#endif + +#ifdef Ltime +longint time_ (void) { + extern longint G77_time_0 (void); + return G77_time_0 (); +} +#endif + +#ifdef Lttynam +void ttynam_ (char *ret_val, ftnlen ret_val_len, integer *lunit) { + extern void G77_ttynam_0 (char *ret_val, ftnlen ret_val_len, integer *lunit); + G77_ttynam_0 (ret_val, ret_val_len, lunit); +} +#endif + +#ifdef Lumask +integer umask_ (integer *mask) { + extern integer G77_umask_0 (integer *mask); + return G77_umask_0 (mask); +} +#endif + +#ifdef Lunlink +integer unlink_ (const char *str, const ftnlen Lstr) { + extern integer G77_unlink_0 (const char *str, const ftnlen Lstr); + return G77_unlink_0 (str, Lstr); +} +#endif + +#ifdef Lvxtidt +int vxtidate_ (integer *m, integer *d, integer *y) { + extern int G77_vxtidate_0 (integer *m, integer *d, integer *y); + return G77_vxtidate_0 (m, d, y); +} +#endif + +#ifdef Lvxttim +void vxttime_ (char chtime[8], const ftnlen Lchtime) { + extern void G77_vxttime_0 (char chtime[8], const ftnlen Lchtime); + G77_vxttime_0 (chtime, Lchtime); +} +#endif diff --git a/libf2c/libF77/F77_aloc.c b/libf2c/libF77/F77_aloc.c new file mode 100644 index 00000000000..8754fe2ef70 --- /dev/null +++ b/libf2c/libF77/F77_aloc.c @@ -0,0 +1,32 @@ +#include "f2c.h" +#undef abs +#undef min +#undef max +#include + +static integer memfailure = 3; + +#ifdef KR_headers +extern char *malloc(); +extern void G77_exit_0 (); + + char * +F77_aloc(Len, whence) integer Len; char *whence; +#else +#include +extern void G77_exit_0 (integer*); + + char * +F77_aloc(integer Len, char *whence) +#endif +{ + char *rv; + unsigned int uLen = (unsigned int) Len; /* for K&R C */ + + if (!(rv = (char*)malloc(uLen))) { + fprintf(stderr, "malloc(%u) failure in %s\n", + uLen, whence); + G77_exit_0 (&memfailure); + } + return rv; + } diff --git a/libf2c/libF77/Makefile.in b/libf2c/libF77/Makefile.in new file mode 100644 index 00000000000..266e22b72cf --- /dev/null +++ b/libf2c/libF77/Makefile.in @@ -0,0 +1,76 @@ +# Makefile for GNU F77 compiler runtime. +# Copyright 1990 - 1994 by AT&T Bell Laboratories and Bellcore (see the +# file `Notice'). +# Portions of this file Copyright (C) 1995, 1996 Free Software Foundation, Inc. +# Contributed by Dave Love (d.love@dl.ac.uk). +# +#This file is part of GNU Fortran. +# +#GNU Fortran is free software; you can redistribute it and/or modify +#it under the terms of the GNU General Public License as published by +#the Free Software Foundation; either version 2, or (at your option) +#any later version. +# +#GNU Fortran is distributed in the hope that it will be useful, +#but WITHOUT ANY WARRANTY; without even the implied warranty of +#MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +#GNU General Public License for more details. +# +#You should have received a copy of the GNU General Public License +#along with GNU Fortran; see the file COPYING. If not, write to +#the Free Software Foundation, 59 Temple Place - Suite 330, Boston, MA +#02111-1307, USA. + +SHELL = /bin/sh + +srcdir = @srcdir@ +VPATH = @srcdir@ + +#### Start of system configuration section. #### + + +.c.o: + $(CC) -c -DSkip_f2c_Undefs -I../ $(CFLAGS) $< + +MISC = F77_aloc.o VersionF.o main.o s_rnge.o abort_.o getarg_.o iargc_.o\ + getenv_.o signal_.o s_stop.o s_paus.o system_.o cabs.o\ + derf_.o derfc_.o erf_.o erfc_.o sig_die.o exit_.o +POW = pow_ci.o pow_dd.o pow_di.o pow_hh.o pow_ii.o pow_ri.o pow_zi.o pow_zz.o \ + pow_qq.o +CX = c_abs.o c_cos.o c_div.o c_exp.o c_log.o c_sin.o c_sqrt.o +DCX = z_abs.o z_cos.o z_div.o z_exp.o z_log.o z_sin.o z_sqrt.o +REAL = r_abs.o r_acos.o r_asin.o r_atan.o r_atn2.o r_cnjg.o r_cos.o\ + r_cosh.o r_dim.o r_exp.o r_imag.o r_int.o\ + r_lg10.o r_log.o r_mod.o r_nint.o r_sign.o\ + r_sin.o r_sinh.o r_sqrt.o r_tan.o r_tanh.o +DBL = d_abs.o d_acos.o d_asin.o d_atan.o d_atn2.o\ + d_cnjg.o d_cos.o d_cosh.o d_dim.o d_exp.o\ + d_imag.o d_int.o d_lg10.o d_log.o d_mod.o\ + d_nint.o d_prod.o d_sign.o d_sin.o d_sinh.o\ + d_sqrt.o d_tan.o d_tanh.o +INT = i_abs.o i_dim.o i_dnnt.o i_indx.o i_len.o i_mod.o i_nint.o i_sign.o +HALF = h_abs.o h_dim.o h_dnnt.o h_indx.o h_len.o h_mod.o h_nint.o h_sign.o +CMP = l_ge.o l_gt.o l_le.o l_lt.o hl_ge.o hl_gt.o hl_le.o hl_lt.o +EFL = ef1asc_.o ef1cmc_.o +CHAR = s_cat.o s_cmp.o s_copy.o +F90BIT = lbitbits.o lbitshft.o qbitbits.o qbitshft.o + +F2C_H = ../f2c.h + +all: $(MISC) $(POW) $(CX) $(DCX) $(REAL) $(DBL) $(INT) \ + $(HALF) $(CMP) $(EFL) $(CHAR) $(F90BIT) + +VersionF.o: Version.c + $(CC) -c $(CFLAGS) -o $@ $(srcdir)/Version.c + +mostlyclean clean: + -rm -f *.o + +distclean maintainer-clean: clean + -rm -f stage? include Makefile + +# Not quite all these actually do depend on f2c.h... +$(MISC) $(POW) $(CX) $(DCX) $(REAL) $(DBL) $(INT) \ + $(HALF) $(CMP) $(EFL) $(CHAR) $(F90BIT): $(F2C_H) + +.PHONY: mostlyclean clean distclean maintainer-clean all diff --git a/libf2c/libF77/Notice b/libf2c/libF77/Notice new file mode 100644 index 00000000000..261b719bc57 --- /dev/null +++ b/libf2c/libF77/Notice @@ -0,0 +1,23 @@ +/**************************************************************** +Copyright 1990 - 1997 by AT&T, Lucent Technologies and Bellcore. + +Permission to use, copy, modify, and distribute this software +and its documentation for any purpose and without fee is hereby +granted, provided that the above copyright notice appear in all +copies and that both that the copyright notice and this +permission notice and warranty disclaimer appear in supporting +documentation, and that the names of AT&T, Bell Laboratories, +Lucent or Bellcore or any of their entities not be used in +advertising or publicity pertaining to distribution of the +software without specific, written prior permission. + +AT&T, Lucent and Bellcore disclaim all warranties with regard to +this software, including all implied warranties of +merchantability and fitness. In no event shall AT&T, Lucent or +Bellcore be liable for any special, indirect or consequential +damages or any damages whatsoever resulting from loss of use, +data or profits, whether in an action of contract, negligence or +other tortious action, arising out of or in connection with the +use or performance of this software. +****************************************************************/ + diff --git a/libf2c/libF77/README.netlib b/libf2c/libF77/README.netlib new file mode 100644 index 00000000000..76682152551 --- /dev/null +++ b/libf2c/libF77/README.netlib @@ -0,0 +1,108 @@ +If your compiler does not recognize ANSI C headers, +compile with KR_headers defined: either add -DKR_headers +to the definition of CFLAGS in the makefile, or insert + +#define KR_headers + +at the top of f2c.h , cabs.c , main.c , and sig_die.c . + +Under MS-DOS, compile s_paus.c with -DMSDOS. + +If you have a really ancient K&R C compiler that does not understand +void, add -Dvoid=int to the definition of CFLAGS in the makefile. + +If you use a C++ compiler, first create a local f2c.h by appending +f2ch.add to the usual f2c.h, e.g., by issuing the command + make f2c.h +which assumes f2c.h is installed in /usr/include . + +If your system lacks onexit() and you are not using an ANSI C +compiler, then you should compile main.c, s_paus.c, s_stop.c, and +sig_die.c with NO_ONEXIT defined. See the comments about onexit in +the makefile. + +If your system has a double drem() function such that drem(a,b) +is the IEEE remainder function (with double a, b), then you may +wish to compile r_mod.c and d_mod.c with IEEE_drem defined. +On some systems, you may also need to compile with -Ddrem=remainder . + +To check for transmission errors, issue the command + make check +This assumes you have the xsum program whose source, xsum.c, +is distributed as part of "all from f2c/src". If you do not +have xsum, you can obtain xsum.c by sending the following E-mail +message to netlib@netlib.bell-labs.com + send xsum.c from f2c/src + +The makefile assumes you have installed f2c.h in a standard +place (and does not cause recompilation when f2c.h is changed); +f2c.h comes with "all from f2c" (the source for f2c) and is +available separately ("f2c.h from f2c"). + +Most of the routines in libF77 are support routines for Fortran +intrinsic functions or for operations that f2c chooses not +to do "in line". There are a few exceptions, summarized below -- +functions and subroutines that appear to your program as ordinary +external Fortran routines. + +1. CALL ABORT prints a message and causes a core dump. + +2. ERF(r) and DERF(d) and the REAL and DOUBLE PRECISION + error functions (with x REAL and d DOUBLE PRECISION); + DERF must be declared DOUBLE PRECISION in your program. + Both ERF and DERF assume your C library provides the + underlying erf() function (which not all systems do). + +3. ERFC(r) and DERFC(d) are the complementary error functions: + ERFC(r) = 1 - ERF(r) and DERFC(d) = 1.d0 - DERFC(d) + (except that their results may be more accurate than + explicitly evaluating the above formulae would give). + Again, ERFC and r are REAL, and DERFC and d are DOUBLE + PRECISION (and must be declared as such in your program), + and ERFC and DERFC rely on your system's erfc(). + +4. CALL GETARG(n,s), where n is an INTEGER and s is a CHARACTER + variable, sets s to the n-th command-line argument (or to + all blanks if there are fewer than n command-line arguments); + CALL GETARG(0,s) sets s to the name of the program (on systems + that support this feature). See IARGC below. + +5. CALL GETENV(name, value), where name and value are of type + CHARACTER, sets value to the environment value, $name, of + name (or to blanks if $name has not been set). + +6. NARGS = IARGC() sets NARGS to the number of command-line + arguments (an INTEGER value). + +7. CALL SIGNAL(n,func), where n is an INTEGER and func is an + EXTERNAL procedure, arranges for func to be invoked when + signal n occurs (on systems where this makes sense). + +8. CALL SYSTEM(cmd), where cmd is of type CHARACTER, passes + cmd to the system's command processor (on systems where + this can be done). + +The makefile does not attempt to compile pow_qq.c, qbitbits.c, +and qbitshft.c, which are meant for use with INTEGER*8. To use +INTEGER*8, you must modify f2c.h to declare longint and ulongint +appropriately; then add pow_qq.o to the POW = line in the makefile, +and add " qbitbits.o qbitshft.o" to the makefile's F90BIT = line. + +Following Fortran 90, s_cat.c and s_copy.c allow the target of a +(character string) assignment to be appear on its right-hand, at +the cost of some extra overhead for all run-time concatenations. +If you prefer the extra efficiency that comes with the Fortran 77 +requirement that the left-hand side of a character assignment not +be involved in the right-hand side, compile s_cat.c and s_copy.c +with -DNO_OVERWRITE . + +If your system lacks a ranlib command, you don't need it. +Either comment out the makefile's ranlib invocation, or install +a harmless "ranlib" command somewhere in your PATH, such as the +one-line shell script + + exit 0 + +or (on some systems) + + exec /usr/bin/ar lts $1 >/dev/null diff --git a/libf2c/libF77/Version.c b/libf2c/libF77/Version.c new file mode 100644 index 00000000000..7bb09729c47 --- /dev/null +++ b/libf2c/libF77/Version.c @@ -0,0 +1,67 @@ +static char junk[] = "\n@(#)LIBF77 VERSION 19970919\n"; + +/* +*/ + +char __G77_LIBF77_VERSION__[] = "0.5.21"; + +/* +2.00 11 June 1980. File version.c added to library. +2.01 31 May 1988. s_paus() flushes stderr; names of hl_* fixed + [ d]erf[c ] added + 8 Aug. 1989: #ifdefs for f2c -i2 added to s_cat.c + 29 Nov. 1989: s_cmp returns long (for f2c) + 30 Nov. 1989: arg types from f2c.h + 12 Dec. 1989: s_rnge allows long names + 19 Dec. 1989: getenv_ allows unsorted environment + 28 Mar. 1990: add exit(0) to end of main() + 2 Oct. 1990: test signal(...) == SIG_IGN rather than & 01 in main + 17 Oct. 1990: abort() calls changed to sig_die(...,1) + 22 Oct. 1990: separate sig_die from main + 25 Apr. 1991: minor, theoretically invisible tweaks to s_cat, sig_die + 31 May 1991: make system_ return status + 18 Dec. 1991: change long to ftnlen (for -i2) many places + 28 Feb. 1992: repair z_sqrt.c (scribbled on input, gave wrong answer) + 18 July 1992: for n < 0, repair handling of 0**n in pow_[dr]i.c + and m**n in pow_hh.c and pow_ii.c; + catch SIGTRAP in main() for error msg before abort + 23 July 1992: switch to ANSI prototypes unless KR_headers is #defined + 23 Oct. 1992: fix botch in signal_.c (erroneous deref of 2nd arg); + change Cabs to f__cabs. + 12 March 1993: various tweaks for C++ + 2 June 1994: adjust so abnormal terminations invoke f_exit just once + 16 Sept. 1994: s_cmp: treat characters as unsigned in comparisons. + 19 Sept. 1994: s_paus: flush after end of PAUSE; add -DMSDOS + 12 Jan. 1995: pow_[dhiqrz][hiq]: adjust x**i to work on machines + that sign-extend right shifts when i is the most + negative integer. + 26 Jan. 1995: adjust s_cat.c, s_copy.c to permit the left-hand side + of character assignments to appear on the right-hand + side (unless compiled with -DNO_OVERWRITE). + 27 Jan. 1995: minor tweak to s_copy.c: copy forward whenever + possible (for better cache behavior). + 30 May 1995: added subroutine exit(rc) integer rc. Version not changed. + 29 Aug. 1995: add F77_aloc.c; use it in s_cat.c and system_.c. + 6 Sept. 1995: fix return type of system_ under -DKR_headers. + 19 Dec. 1995: s_cat.c: fix bug when 2nd or later arg overlaps lhs. + 19 Mar. 1996: s_cat.c: supply missing break after overlap detection. + 13 May 1996: add [lq]bitbits.c and [lq]bitshft.c (f90 bit intrinsics). + 19 June 1996: add casts to unsigned in [lq]bitshft.c. + 26 Feb. 1997: adjust functions with a complex output argument + to permit aliasing it with input arguments. + (For now, at least, this is just for possible + benefit of g77.) + 4 April 1997: [cz]_div.c: tweaks invisible on most systems (that may + affect systems using gratuitous extra precision). + 19 Sept. 1997: [de]time_.c (Unix systems only): change return + type to double. +*/ + +#include + +void +g77__fvers__ () +{ + fprintf (stderr, "__G77_LIBF77_VERSION__: %s", __G77_LIBF77_VERSION__); + fputs (junk, stderr); +} diff --git a/libf2c/libF77/abort_.c b/libf2c/libF77/abort_.c new file mode 100644 index 00000000000..8efdc42f970 --- /dev/null +++ b/libf2c/libF77/abort_.c @@ -0,0 +1,18 @@ +#include +#include "f2c.h" + +#ifdef KR_headers +extern VOID sig_die(); + +int G77_abort_0 () +#else +extern void sig_die(char*,int); + +int G77_abort_0 (void) +#endif +{ +sig_die("Fortran abort routine called", 1); +#ifdef __cplusplus +return 0; +#endif +} diff --git a/libf2c/libF77/c_abs.c b/libf2c/libF77/c_abs.c new file mode 100644 index 00000000000..041fbd3d8bb --- /dev/null +++ b/libf2c/libF77/c_abs.c @@ -0,0 +1,14 @@ +#include "f2c.h" + +#ifdef KR_headers +extern double f__cabs(); + +double c_abs(z) complex *z; +#else +extern double f__cabs(double, double); + +double c_abs(complex *z) +#endif +{ +return( f__cabs( z->r, z->i ) ); +} diff --git a/libf2c/libF77/c_cos.c b/libf2c/libF77/c_cos.c new file mode 100644 index 00000000000..9e833c168b3 --- /dev/null +++ b/libf2c/libF77/c_cos.c @@ -0,0 +1,21 @@ +#include "f2c.h" + +#ifdef KR_headers +extern double sin(), cos(), sinh(), cosh(); + +VOID c_cos(resx, z) complex *resx, *z; +#else +#undef abs +#include + +void c_cos(complex *resx, complex *z) +#endif +{ +complex res; + +res.r = cos(z->r) * cosh(z->i); +res.i = - sin(z->r) * sinh(z->i); + +resx->r = res.r; +resx->i = res.i; +} diff --git a/libf2c/libF77/c_div.c b/libf2c/libF77/c_div.c new file mode 100644 index 00000000000..9568354bd53 --- /dev/null +++ b/libf2c/libF77/c_div.c @@ -0,0 +1,40 @@ +#include "f2c.h" + +#ifdef KR_headers +extern VOID sig_die(); +VOID c_div(resx, a, b) +complex *a, *b, *resx; +#else +extern void sig_die(char*,int); +void c_div(complex *resx, complex *a, complex *b) +#endif +{ +double ratio, den; +double abr, abi; +complex res; + +if( (abr = b->r) < 0.) + abr = - abr; +if( (abi = b->i) < 0.) + abi = - abi; +if( abr <= abi ) + { + if(abi == 0) + sig_die("complex division by zero", 1); + ratio = (double)b->r / b->i ; + den = b->i * (1 + ratio*ratio); + res.r = (a->r*ratio + a->i) / den; + res.i = (a->i*ratio - a->r) / den; + } + +else + { + ratio = (double)b->i / b->r ; + den = b->r * (1 + ratio*ratio); + res.r = (a->r + a->i*ratio) / den; + res.i = (a->i - a->r*ratio) / den; + } + +resx->r = res.r; +resx->i = res.i; +} diff --git a/libf2c/libF77/c_exp.c b/libf2c/libF77/c_exp.c new file mode 100644 index 00000000000..8d3d33d0fe3 --- /dev/null +++ b/libf2c/libF77/c_exp.c @@ -0,0 +1,23 @@ +#include "f2c.h" + +#ifdef KR_headers +extern double exp(), cos(), sin(); + + VOID c_exp(resx, z) complex *resx, *z; +#else +#undef abs +#include + +void c_exp(complex *resx, complex *z) +#endif +{ +double expx; +complex res; + +expx = exp(z->r); +res.r = expx * cos(z->i); +res.i = expx * sin(z->i); + +resx->r = res.r; +resx->i = res.i; +} diff --git a/libf2c/libF77/c_log.c b/libf2c/libF77/c_log.c new file mode 100644 index 00000000000..6715131ad1d --- /dev/null +++ b/libf2c/libF77/c_log.c @@ -0,0 +1,21 @@ +#include "f2c.h" + +#ifdef KR_headers +extern double log(), f__cabs(), atan2(); +VOID c_log(resx, z) complex *resx, *z; +#else +#undef abs +#include +extern double f__cabs(double, double); + +void c_log(complex *resx, complex *z) +#endif +{ +complex res; + +res.i = atan2(z->i, z->r); +res.r = log( f__cabs(z->r, z->i) ); + +resx->r = res.r; +resx->i = res.i; +} diff --git a/libf2c/libF77/c_sin.c b/libf2c/libF77/c_sin.c new file mode 100644 index 00000000000..7bf3e392bed --- /dev/null +++ b/libf2c/libF77/c_sin.c @@ -0,0 +1,21 @@ +#include "f2c.h" + +#ifdef KR_headers +extern double sin(), cos(), sinh(), cosh(); + +VOID c_sin(resx, z) complex *resx, *z; +#else +#undef abs +#include + +void c_sin(complex *resx, complex *z) +#endif +{ +complex res; + +res.r = sin(z->r) * cosh(z->i); +res.i = cos(z->r) * sinh(z->i); + +resx->r = res.r; +resx->i = res.i; +} diff --git a/libf2c/libF77/c_sqrt.c b/libf2c/libF77/c_sqrt.c new file mode 100644 index 00000000000..775977a87f7 --- /dev/null +++ b/libf2c/libF77/c_sqrt.c @@ -0,0 +1,38 @@ +#include "f2c.h" + +#ifdef KR_headers +extern double sqrt(), f__cabs(); + +VOID c_sqrt(resx, z) complex *resx, *z; +#else +#undef abs +#include +extern double f__cabs(double, double); + +void c_sqrt(complex *resx, complex *z) +#endif +{ +double mag, t; +complex res; + +if( (mag = f__cabs(z->r, z->i)) == 0.) + res.r = res.i = 0.; +else if(z->r > 0) + { + res.r = t = sqrt(0.5 * (mag + z->r) ); + t = z->i / t; + res.i = 0.5 * t; + } +else + { + t = sqrt(0.5 * (mag - z->r) ); + if(z->i < 0) + t = -t; + res.i = t; + t = z->i / t; + res.r = 0.5 * t; + } + +resx->r = res.r; +resx->i = res.i; +} diff --git a/libf2c/libF77/cabs.c b/libf2c/libF77/cabs.c new file mode 100644 index 00000000000..2fad044e884 --- /dev/null +++ b/libf2c/libF77/cabs.c @@ -0,0 +1,27 @@ +#ifdef KR_headers +extern double sqrt(); +double f__cabs(real, imag) double real, imag; +#else +#undef abs +#include +double f__cabs(double real, double imag) +#endif +{ +double temp; + +if(real < 0) + real = -real; +if(imag < 0) + imag = -imag; +if(imag > real){ + temp = real; + real = imag; + imag = temp; +} +if((real+imag) == real) + return(real); + +temp = imag/real; +temp = real*sqrt(1.0 + temp*temp); /*overflow!!*/ +return(temp); +} diff --git a/libf2c/libF77/d_abs.c b/libf2c/libF77/d_abs.c new file mode 100644 index 00000000000..cb157e067b7 --- /dev/null +++ b/libf2c/libF77/d_abs.c @@ -0,0 +1,12 @@ +#include "f2c.h" + +#ifdef KR_headers +double d_abs(x) doublereal *x; +#else +double d_abs(doublereal *x) +#endif +{ +if(*x >= 0) + return(*x); +return(- *x); +} diff --git a/libf2c/libF77/d_acos.c b/libf2c/libF77/d_acos.c new file mode 100644 index 00000000000..33da5369db2 --- /dev/null +++ b/libf2c/libF77/d_acos.c @@ -0,0 +1,13 @@ +#include "f2c.h" + +#ifdef KR_headers +double acos(); +double d_acos(x) doublereal *x; +#else +#undef abs +#include +double d_acos(doublereal *x) +#endif +{ +return( acos(*x) ); +} diff --git a/libf2c/libF77/d_asin.c b/libf2c/libF77/d_asin.c new file mode 100644 index 00000000000..79b33ca1bd6 --- /dev/null +++ b/libf2c/libF77/d_asin.c @@ -0,0 +1,13 @@ +#include "f2c.h" + +#ifdef KR_headers +double asin(); +double d_asin(x) doublereal *x; +#else +#undef abs +#include +double d_asin(doublereal *x) +#endif +{ +return( asin(*x) ); +} diff --git a/libf2c/libF77/d_atan.c b/libf2c/libF77/d_atan.c new file mode 100644 index 00000000000..caea4a406e0 --- /dev/null +++ b/libf2c/libF77/d_atan.c @@ -0,0 +1,13 @@ +#include "f2c.h" + +#ifdef KR_headers +double atan(); +double d_atan(x) doublereal *x; +#else +#undef abs +#include +double d_atan(doublereal *x) +#endif +{ +return( atan(*x) ); +} diff --git a/libf2c/libF77/d_atn2.c b/libf2c/libF77/d_atn2.c new file mode 100644 index 00000000000..6748a55d56f --- /dev/null +++ b/libf2c/libF77/d_atn2.c @@ -0,0 +1,13 @@ +#include "f2c.h" + +#ifdef KR_headers +double atan2(); +double d_atn2(x,y) doublereal *x, *y; +#else +#undef abs +#include +double d_atn2(doublereal *x, doublereal *y) +#endif +{ +return( atan2(*x,*y) ); +} diff --git a/libf2c/libF77/d_cnjg.c b/libf2c/libF77/d_cnjg.c new file mode 100644 index 00000000000..1afa3bc4061 --- /dev/null +++ b/libf2c/libF77/d_cnjg.c @@ -0,0 +1,17 @@ +#include "f2c.h" + + VOID +#ifdef KR_headers +d_cnjg(resx, z) doublecomplex *resx, *z; +#else +d_cnjg(doublecomplex *resx, doublecomplex *z) +#endif +{ +doublecomplex res; + +res.r = z->r; +res.i = - z->i; + +resx->r = res.r; +resx->i = res.i; +} diff --git a/libf2c/libF77/d_cos.c b/libf2c/libF77/d_cos.c new file mode 100644 index 00000000000..fa4d6ca406f --- /dev/null +++ b/libf2c/libF77/d_cos.c @@ -0,0 +1,13 @@ +#include "f2c.h" + +#ifdef KR_headers +double cos(); +double d_cos(x) doublereal *x; +#else +#undef abs +#include +double d_cos(doublereal *x) +#endif +{ +return( cos(*x) ); +} diff --git a/libf2c/libF77/d_cosh.c b/libf2c/libF77/d_cosh.c new file mode 100644 index 00000000000..edc0ebc1092 --- /dev/null +++ b/libf2c/libF77/d_cosh.c @@ -0,0 +1,13 @@ +#include "f2c.h" + +#ifdef KR_headers +double cosh(); +double d_cosh(x) doublereal *x; +#else +#undef abs +#include +double d_cosh(doublereal *x) +#endif +{ +return( cosh(*x) ); +} diff --git a/libf2c/libF77/d_dim.c b/libf2c/libF77/d_dim.c new file mode 100644 index 00000000000..1d0ecb7bbb6 --- /dev/null +++ b/libf2c/libF77/d_dim.c @@ -0,0 +1,10 @@ +#include "f2c.h" + +#ifdef KR_headers +double d_dim(a,b) doublereal *a, *b; +#else +double d_dim(doublereal *a, doublereal *b) +#endif +{ +return( *a > *b ? *a - *b : 0); +} diff --git a/libf2c/libF77/d_exp.c b/libf2c/libF77/d_exp.c new file mode 100644 index 00000000000..be12fd70551 --- /dev/null +++ b/libf2c/libF77/d_exp.c @@ -0,0 +1,13 @@ +#include "f2c.h" + +#ifdef KR_headers +double exp(); +double d_exp(x) doublereal *x; +#else +#undef abs +#include +double d_exp(doublereal *x) +#endif +{ +return( exp(*x) ); +} diff --git a/libf2c/libF77/d_imag.c b/libf2c/libF77/d_imag.c new file mode 100644 index 00000000000..793a3f9c405 --- /dev/null +++ b/libf2c/libF77/d_imag.c @@ -0,0 +1,10 @@ +#include "f2c.h" + +#ifdef KR_headers +double d_imag(z) doublecomplex *z; +#else +double d_imag(doublecomplex *z) +#endif +{ +return(z->i); +} diff --git a/libf2c/libF77/d_int.c b/libf2c/libF77/d_int.c new file mode 100644 index 00000000000..beff1e7d378 --- /dev/null +++ b/libf2c/libF77/d_int.c @@ -0,0 +1,13 @@ +#include "f2c.h" + +#ifdef KR_headers +double floor(); +double d_int(x) doublereal *x; +#else +#undef abs +#include +double d_int(doublereal *x) +#endif +{ +return( (*x>0) ? floor(*x) : -floor(- *x) ); +} diff --git a/libf2c/libF77/d_lg10.c b/libf2c/libF77/d_lg10.c new file mode 100644 index 00000000000..c0892bd512a --- /dev/null +++ b/libf2c/libF77/d_lg10.c @@ -0,0 +1,15 @@ +#include "f2c.h" + +#define log10e 0.43429448190325182765 + +#ifdef KR_headers +double log(); +double d_lg10(x) doublereal *x; +#else +#undef abs +#include +double d_lg10(doublereal *x) +#endif +{ +return( log10e * log(*x) ); +} diff --git a/libf2c/libF77/d_log.c b/libf2c/libF77/d_log.c new file mode 100644 index 00000000000..592015b2821 --- /dev/null +++ b/libf2c/libF77/d_log.c @@ -0,0 +1,13 @@ +#include "f2c.h" + +#ifdef KR_headers +double log(); +double d_log(x) doublereal *x; +#else +#undef abs +#include +double d_log(doublereal *x) +#endif +{ +return( log(*x) ); +} diff --git a/libf2c/libF77/d_mod.c b/libf2c/libF77/d_mod.c new file mode 100644 index 00000000000..23f19299168 --- /dev/null +++ b/libf2c/libF77/d_mod.c @@ -0,0 +1,40 @@ +#include "f2c.h" + +#ifdef KR_headers +#ifdef IEEE_drem +double drem(); +#else +double floor(); +#endif +double d_mod(x,y) doublereal *x, *y; +#else +#ifdef IEEE_drem +double drem(double, double); +#else +#undef abs +#include +#endif +double d_mod(doublereal *x, doublereal *y) +#endif +{ +#ifdef IEEE_drem + double xa, ya, z; + if ((ya = *y) < 0.) + ya = -ya; + z = drem(xa = *x, ya); + if (xa > 0) { + if (z < 0) + z += ya; + } + else if (z > 0) + z -= ya; + return z; +#else + double quotient; + if( (quotient = *x / *y) >= 0) + quotient = floor(quotient); + else + quotient = -floor(-quotient); + return(*x - (*y) * quotient ); +#endif +} diff --git a/libf2c/libF77/d_nint.c b/libf2c/libF77/d_nint.c new file mode 100644 index 00000000000..064beff669c --- /dev/null +++ b/libf2c/libF77/d_nint.c @@ -0,0 +1,14 @@ +#include "f2c.h" + +#ifdef KR_headers +double floor(); +double d_nint(x) doublereal *x; +#else +#undef abs +#include +double d_nint(doublereal *x) +#endif +{ +return( (*x)>=0 ? + floor(*x + .5) : -floor(.5 - *x) ); +} diff --git a/libf2c/libF77/d_prod.c b/libf2c/libF77/d_prod.c new file mode 100644 index 00000000000..3d4cef7835c --- /dev/null +++ b/libf2c/libF77/d_prod.c @@ -0,0 +1,10 @@ +#include "f2c.h" + +#ifdef KR_headers +double d_prod(x,y) real *x, *y; +#else +double d_prod(real *x, real *y) +#endif +{ +return( (*x) * (*y) ); +} diff --git a/libf2c/libF77/d_sign.c b/libf2c/libF77/d_sign.c new file mode 100644 index 00000000000..514ff0bbff8 --- /dev/null +++ b/libf2c/libF77/d_sign.c @@ -0,0 +1,12 @@ +#include "f2c.h" + +#ifdef KR_headers +double d_sign(a,b) doublereal *a, *b; +#else +double d_sign(doublereal *a, doublereal *b) +#endif +{ +double x; +x = (*a >= 0 ? *a : - *a); +return( *b >= 0 ? x : -x); +} diff --git a/libf2c/libF77/d_sin.c b/libf2c/libF77/d_sin.c new file mode 100644 index 00000000000..fdd699eede5 --- /dev/null +++ b/libf2c/libF77/d_sin.c @@ -0,0 +1,13 @@ +#include "f2c.h" + +#ifdef KR_headers +double sin(); +double d_sin(x) doublereal *x; +#else +#undef abs +#include +double d_sin(doublereal *x) +#endif +{ +return( sin(*x) ); +} diff --git a/libf2c/libF77/d_sinh.c b/libf2c/libF77/d_sinh.c new file mode 100644 index 00000000000..77f36904f8e --- /dev/null +++ b/libf2c/libF77/d_sinh.c @@ -0,0 +1,13 @@ +#include "f2c.h" + +#ifdef KR_headers +double sinh(); +double d_sinh(x) doublereal *x; +#else +#undef abs +#include +double d_sinh(doublereal *x) +#endif +{ +return( sinh(*x) ); +} diff --git a/libf2c/libF77/d_sqrt.c b/libf2c/libF77/d_sqrt.c new file mode 100644 index 00000000000..b5cf83b946f --- /dev/null +++ b/libf2c/libF77/d_sqrt.c @@ -0,0 +1,13 @@ +#include "f2c.h" + +#ifdef KR_headers +double sqrt(); +double d_sqrt(x) doublereal *x; +#else +#undef abs +#include +double d_sqrt(doublereal *x) +#endif +{ +return( sqrt(*x) ); +} diff --git a/libf2c/libF77/d_tan.c b/libf2c/libF77/d_tan.c new file mode 100644 index 00000000000..af94a053223 --- /dev/null +++ b/libf2c/libF77/d_tan.c @@ -0,0 +1,13 @@ +#include "f2c.h" + +#ifdef KR_headers +double tan(); +double d_tan(x) doublereal *x; +#else +#undef abs +#include +double d_tan(doublereal *x) +#endif +{ +return( tan(*x) ); +} diff --git a/libf2c/libF77/d_tanh.c b/libf2c/libF77/d_tanh.c new file mode 100644 index 00000000000..92a02d4fd6b --- /dev/null +++ b/libf2c/libF77/d_tanh.c @@ -0,0 +1,13 @@ +#include "f2c.h" + +#ifdef KR_headers +double tanh(); +double d_tanh(x) doublereal *x; +#else +#undef abs +#include +double d_tanh(doublereal *x) +#endif +{ +return( tanh(*x) ); +} diff --git a/libf2c/libF77/derf_.c b/libf2c/libF77/derf_.c new file mode 100644 index 00000000000..fba6b6b11f3 --- /dev/null +++ b/libf2c/libF77/derf_.c @@ -0,0 +1,12 @@ +#include "f2c.h" + +#ifdef KR_headers +double erf(); +double G77_derf_0 (x) doublereal *x; +#else +extern double erf(double); +double G77_derf_0 (doublereal *x) +#endif +{ +return( erf(*x) ); +} diff --git a/libf2c/libF77/derfc_.c b/libf2c/libF77/derfc_.c new file mode 100644 index 00000000000..ae1ac740302 --- /dev/null +++ b/libf2c/libF77/derfc_.c @@ -0,0 +1,14 @@ +#include "f2c.h" + +#ifdef KR_headers +extern double erfc(); + +double G77_derfc_0 (x) doublereal *x; +#else +extern double erfc(double); + +double G77_derfc_0 (doublereal *x) +#endif +{ +return( erfc(*x) ); +} diff --git a/libf2c/libF77/dtime_.c b/libf2c/libF77/dtime_.c new file mode 100644 index 00000000000..79b6735b13b --- /dev/null +++ b/libf2c/libF77/dtime_.c @@ -0,0 +1,45 @@ +#include "time.h" +#ifndef USE_CLOCK +#include "sys/types.h" +#include "sys/times.h" +#endif + +#undef Hz +#ifdef CLK_TCK +#define Hz CLK_TCK +#else +#ifdef HZ +#define Hz HZ +#else +#define Hz 60 +#endif +#endif + + double +#ifdef KR_headers +dtime_(tarray) float *tarray; +#else +dtime_(float *tarray) +#endif +{ +#ifdef USE_CLOCK +#ifndef CLOCKS_PER_SECOND +#define CLOCKS_PER_SECOND Hz +#endif + static double t0; + double t = clock(); + tarray[1] = 0; + tarray[0] = (t - t0) / CLOCKS_PER_SECOND; + t0 = t; + return tarray[0]; +#else + struct tms t; + static struct tms t0; + + times(&t); + tarray[0] = (t.tms_utime - t0.tms_utime) / Hz; + tarray[1] = (t.tms_stime - t0.tms_stime) / Hz; + t0 = t; + return tarray[0] + tarray[1]; +#endif + } diff --git a/libf2c/libF77/ef1asc_.c b/libf2c/libF77/ef1asc_.c new file mode 100644 index 00000000000..a922a1d9ba9 --- /dev/null +++ b/libf2c/libF77/ef1asc_.c @@ -0,0 +1,21 @@ +/* EFL support routine to copy string b to string a */ + +#include "f2c.h" + + +#define M ( (long) (sizeof(long) - 1) ) +#define EVEN(x) ( ( (x)+ M) & (~M) ) + +#ifdef KR_headers +extern VOID s_copy(); +G77_ef1asc_0 (a, la, b, lb) ftnint *a, *b; ftnlen *la, *lb; +#else +extern void s_copy(char*,char*,ftnlen,ftnlen); +int G77_ef1asc_0 (ftnint *a, ftnlen *la, ftnint *b, ftnlen *lb) +#endif +{ +s_copy( (char *)a, (char *)b, EVEN(*la), *lb ); +#ifdef __cplusplus +return 0; +#endif +} diff --git a/libf2c/libF77/ef1cmc_.c b/libf2c/libF77/ef1cmc_.c new file mode 100644 index 00000000000..f471172935f --- /dev/null +++ b/libf2c/libF77/ef1cmc_.c @@ -0,0 +1,14 @@ +/* EFL support routine to compare two character strings */ + +#include "f2c.h" + +#ifdef KR_headers +extern integer s_cmp(); +integer G77_ef1cmc_0 (a, la, b, lb) ftnint *a, *b; ftnlen *la, *lb; +#else +extern integer s_cmp(char*,char*,ftnlen,ftnlen); +integer G77_ef1cmc_0 (ftnint *a, ftnlen *la, ftnint *b, ftnlen *lb) +#endif +{ +return( s_cmp( (char *)a, (char *)b, *la, *lb) ); +} diff --git a/libf2c/libF77/erf_.c b/libf2c/libF77/erf_.c new file mode 100644 index 00000000000..1ba4350ad05 --- /dev/null +++ b/libf2c/libF77/erf_.c @@ -0,0 +1,12 @@ +#include "f2c.h" + +#ifdef KR_headers +double erf(); +double G77_erf_0 (x) real *x; +#else +extern double erf(double); +double G77_erf_0 (real *x) +#endif +{ +return( erf(*x) ); +} diff --git a/libf2c/libF77/erfc_.c b/libf2c/libF77/erfc_.c new file mode 100644 index 00000000000..f44b1d49d84 --- /dev/null +++ b/libf2c/libF77/erfc_.c @@ -0,0 +1,12 @@ +#include "f2c.h" + +#ifdef KR_headers +double erfc(); +double G77_erfc_0 (x) real *x; +#else +extern double erfc(double); +double G77_erfc_0 (real *x) +#endif +{ +return( erfc(*x) ); +} diff --git a/libf2c/libF77/etime_.c b/libf2c/libF77/etime_.c new file mode 100644 index 00000000000..04528b50bb8 --- /dev/null +++ b/libf2c/libF77/etime_.c @@ -0,0 +1,38 @@ +#include "time.h" +#ifndef USE_CLOCK +#include "sys/types.h" +#include "sys/times.h" +#endif + +#undef Hz +#ifdef CLK_TCK +#define Hz CLK_TCK +#else +#ifdef HZ +#define Hz HZ +#else +#define Hz 60 +#endif +#endif + + double +#ifdef KR_headers +etime_(tarray) float *tarray; +#else +etime_(float *tarray) +#endif +{ +#ifdef USE_CLOCK +#ifndef CLOCKS_PER_SECOND +#define CLOCKS_PER_SECOND Hz +#endif + double t = clock(); + tarray[1] = 0; + return tarray[0] = t / CLOCKS_PER_SECOND; +#else + struct tms t; + + times(&t); + return (tarray[0] = t.tms_utime/Hz) + (tarray[1] = t.tms_stime/Hz); +#endif + } diff --git a/libf2c/libF77/exit_.c b/libf2c/libF77/exit_.c new file mode 100644 index 00000000000..4c0582add12 --- /dev/null +++ b/libf2c/libF77/exit_.c @@ -0,0 +1,37 @@ +/* This gives the effect of + + subroutine exit(rc) + integer*4 rc + stop + end + + * with the added side effect of supplying rc as the program's exit code. + */ + +#include "f2c.h" +#undef abs +#undef min +#undef max +#ifndef KR_headers +#include +#ifdef __cplusplus +extern "C" { +#endif +extern void f_exit(void); +#endif + + void +#ifdef KR_headers +G77_exit_0 (rc) integer *rc; +#else +G77_exit_0 (integer *rc) +#endif +{ +#ifdef NO_ONEXIT + f_exit(); +#endif + exit(*rc); + } +#ifdef __cplusplus +} +#endif diff --git a/libf2c/libF77/f2ch.add b/libf2c/libF77/f2ch.add new file mode 100644 index 00000000000..a2acc17a159 --- /dev/null +++ b/libf2c/libF77/f2ch.add @@ -0,0 +1,162 @@ +/* If you are using a C++ compiler, append the following to f2c.h + for compiling libF77 and libI77. */ + +#ifdef __cplusplus +extern "C" { +extern int abort_(void); +extern double c_abs(complex *); +extern void c_cos(complex *, complex *); +extern void c_div(complex *, complex *, complex *); +extern void c_exp(complex *, complex *); +extern void c_log(complex *, complex *); +extern void c_sin(complex *, complex *); +extern void c_sqrt(complex *, complex *); +extern double d_abs(double *); +extern double d_acos(double *); +extern double d_asin(double *); +extern double d_atan(double *); +extern double d_atn2(double *, double *); +extern void d_cnjg(doublecomplex *, doublecomplex *); +extern double d_cos(double *); +extern double d_cosh(double *); +extern double d_dim(double *, double *); +extern double d_exp(double *); +extern double d_imag(doublecomplex *); +extern double d_int(double *); +extern double d_lg10(double *); +extern double d_log(double *); +extern double d_mod(double *, double *); +extern double d_nint(double *); +extern double d_prod(float *, float *); +extern double d_sign(double *, double *); +extern double d_sin(double *); +extern double d_sinh(double *); +extern double d_sqrt(double *); +extern double d_tan(double *); +extern double d_tanh(double *); +extern double derf_(double *); +extern double derfc_(double *); +extern integer do_fio(ftnint *, char *, ftnlen); +extern integer do_lio(ftnint *, ftnint *, char *, ftnlen); +extern integer do_uio(ftnint *, char *, ftnlen); +extern integer e_rdfe(void); +extern integer e_rdue(void); +extern integer e_rsfe(void); +extern integer e_rsfi(void); +extern integer e_rsle(void); +extern integer e_rsli(void); +extern integer e_rsue(void); +extern integer e_wdfe(void); +extern integer e_wdue(void); +extern integer e_wsfe(void); +extern integer e_wsfi(void); +extern integer e_wsle(void); +extern integer e_wsli(void); +extern integer e_wsue(void); +extern int ef1asc_(ftnint *, ftnlen *, ftnint *, ftnlen *); +extern integer ef1cmc_(ftnint *, ftnlen *, ftnint *, ftnlen *); +extern double erf(double); +extern double erf_(float *); +extern double erfc(double); +extern double erfc_(float *); +extern integer f_back(alist *); +extern integer f_clos(cllist *); +extern integer f_end(alist *); +extern void f_exit(void); +extern integer f_inqu(inlist *); +extern integer f_open(olist *); +extern integer f_rew(alist *); +extern int flush_(void); +extern void getarg_(integer *, char *, ftnlen); +extern void getenv_(char *, char *, ftnlen, ftnlen); +extern short h_abs(short *); +extern short h_dim(short *, short *); +extern short h_dnnt(double *); +extern short h_indx(char *, char *, ftnlen, ftnlen); +extern short h_len(char *, ftnlen); +extern short h_mod(short *, short *); +extern short h_nint(float *); +extern short h_sign(short *, short *); +extern short hl_ge(char *, char *, ftnlen, ftnlen); +extern short hl_gt(char *, char *, ftnlen, ftnlen); +extern short hl_le(char *, char *, ftnlen, ftnlen); +extern short hl_lt(char *, char *, ftnlen, ftnlen); +extern integer i_abs(integer *); +extern integer i_dim(integer *, integer *); +extern integer i_dnnt(double *); +extern integer i_indx(char *, char *, ftnlen, ftnlen); +extern integer i_len(char *, ftnlen); +extern integer i_mod(integer *, integer *); +extern integer i_nint(float *); +extern integer i_sign(integer *, integer *); +extern integer iargc_(void); +extern ftnlen l_ge(char *, char *, ftnlen, ftnlen); +extern ftnlen l_gt(char *, char *, ftnlen, ftnlen); +extern ftnlen l_le(char *, char *, ftnlen, ftnlen); +extern ftnlen l_lt(char *, char *, ftnlen, ftnlen); +extern void pow_ci(complex *, complex *, integer *); +extern double pow_dd(double *, double *); +extern double pow_di(double *, integer *); +extern short pow_hh(short *, shortint *); +extern integer pow_ii(integer *, integer *); +extern double pow_ri(float *, integer *); +extern void pow_zi(doublecomplex *, doublecomplex *, integer *); +extern void pow_zz(doublecomplex *, doublecomplex *, doublecomplex *); +extern double r_abs(float *); +extern double r_acos(float *); +extern double r_asin(float *); +extern double r_atan(float *); +extern double r_atn2(float *, float *); +extern void r_cnjg(complex *, complex *); +extern double r_cos(float *); +extern double r_cosh(float *); +extern double r_dim(float *, float *); +extern double r_exp(float *); +extern double r_imag(complex *); +extern double r_int(float *); +extern double r_lg10(float *); +extern double r_log(float *); +extern double r_mod(float *, float *); +extern double r_nint(float *); +extern double r_sign(float *, float *); +extern double r_sin(float *); +extern double r_sinh(float *); +extern double r_sqrt(float *); +extern double r_tan(float *); +extern double r_tanh(float *); +extern void s_cat(char *, char **, integer *, integer *, ftnlen); +extern integer s_cmp(char *, char *, ftnlen, ftnlen); +extern void s_copy(char *, char *, ftnlen, ftnlen); +extern int s_paus(char *, ftnlen); +extern integer s_rdfe(cilist *); +extern integer s_rdue(cilist *); +extern integer s_rnge(char *, integer, char *, integer); +extern integer s_rsfe(cilist *); +extern integer s_rsfi(icilist *); +extern integer s_rsle(cilist *); +extern integer s_rsli(icilist *); +extern integer s_rsne(cilist *); +extern integer s_rsni(icilist *); +extern integer s_rsue(cilist *); +extern int s_stop(char *, ftnlen); +extern integer s_wdfe(cilist *); +extern integer s_wdue(cilist *); +extern integer s_wsfe(cilist *); +extern integer s_wsfi(icilist *); +extern integer s_wsle(cilist *); +extern integer s_wsli(icilist *); +extern integer s_wsne(cilist *); +extern integer s_wsni(icilist *); +extern integer s_wsue(cilist *); +extern void sig_die(char *, int); +extern integer signal_(integer *, void (*)(int)); +extern integer system_(char *, ftnlen); +extern double z_abs(doublecomplex *); +extern void z_cos(doublecomplex *, doublecomplex *); +extern void z_div(doublecomplex *, doublecomplex *, doublecomplex *); +extern void z_exp(doublecomplex *, doublecomplex *); +extern void z_log(doublecomplex *, doublecomplex *); +extern void z_sin(doublecomplex *, doublecomplex *); +extern void z_sqrt(doublecomplex *, doublecomplex *); + } +#endif diff --git a/libf2c/libF77/getarg_.c b/libf2c/libF77/getarg_.c new file mode 100644 index 00000000000..eaded2e4c9b --- /dev/null +++ b/libf2c/libF77/getarg_.c @@ -0,0 +1,28 @@ +#include "f2c.h" + +/* + * subroutine getarg(k, c) + * returns the kth unix command argument in fortran character + * variable argument c +*/ + +#ifdef KR_headers +VOID G77_getarg_0 (n, s, ls) ftnint *n; register char *s; ftnlen ls; +#else +void G77_getarg_0 (ftnint *n, register char *s, ftnlen ls) +#endif +{ +extern int xargc; +extern char **xargv; +register char *t; +register int i; + +if(*n>=0 && *n= 0) + return(*x); +return(- *x); +} diff --git a/libf2c/libF77/h_dim.c b/libf2c/libF77/h_dim.c new file mode 100644 index 00000000000..ceff660e26c --- /dev/null +++ b/libf2c/libF77/h_dim.c @@ -0,0 +1,10 @@ +#include "f2c.h" + +#ifdef KR_headers +shortint h_dim(a,b) shortint *a, *b; +#else +shortint h_dim(shortint *a, shortint *b) +#endif +{ +return( *a > *b ? *a - *b : 0); +} diff --git a/libf2c/libF77/h_dnnt.c b/libf2c/libF77/h_dnnt.c new file mode 100644 index 00000000000..9d0aa25f1d3 --- /dev/null +++ b/libf2c/libF77/h_dnnt.c @@ -0,0 +1,14 @@ +#include "f2c.h" + +#ifdef KR_headers +double floor(); +shortint h_dnnt(x) doublereal *x; +#else +#undef abs +#include +shortint h_dnnt(doublereal *x) +#endif +{ +return( (*x)>=0 ? + floor(*x + .5) : -floor(.5 - *x) ); +} diff --git a/libf2c/libF77/h_indx.c b/libf2c/libF77/h_indx.c new file mode 100644 index 00000000000..a211cc7fa0f --- /dev/null +++ b/libf2c/libF77/h_indx.c @@ -0,0 +1,26 @@ +#include "f2c.h" + +#ifdef KR_headers +shortint h_indx(a, b, la, lb) char *a, *b; ftnlen la, lb; +#else +shortint h_indx(char *a, char *b, ftnlen la, ftnlen lb) +#endif +{ +ftnlen i, n; +char *s, *t, *bend; + +n = la - lb + 1; +bend = b + lb; + +for(i = 0 ; i < n ; ++i) + { + s = a + i; + t = b; + while(t < bend) + if(*s++ != *t++) + goto no; + return((shortint)i+1); + no: ; + } +return(0); +} diff --git a/libf2c/libF77/h_len.c b/libf2c/libF77/h_len.c new file mode 100644 index 00000000000..00a2151bfa1 --- /dev/null +++ b/libf2c/libF77/h_len.c @@ -0,0 +1,10 @@ +#include "f2c.h" + +#ifdef KR_headers +shortint h_len(s, n) char *s; ftnlen n; +#else +shortint h_len(char *s, ftnlen n) +#endif +{ +return(n); +} diff --git a/libf2c/libF77/h_mod.c b/libf2c/libF77/h_mod.c new file mode 100644 index 00000000000..43431c1c503 --- /dev/null +++ b/libf2c/libF77/h_mod.c @@ -0,0 +1,10 @@ +#include "f2c.h" + +#ifdef KR_headers +shortint h_mod(a,b) short *a, *b; +#else +shortint h_mod(short *a, short *b) +#endif +{ +return( *a % *b); +} diff --git a/libf2c/libF77/h_nint.c b/libf2c/libF77/h_nint.c new file mode 100644 index 00000000000..0af3735da42 --- /dev/null +++ b/libf2c/libF77/h_nint.c @@ -0,0 +1,14 @@ +#include "f2c.h" + +#ifdef KR_headers +double floor(); +shortint h_nint(x) real *x; +#else +#undef abs +#include +shortint h_nint(real *x) +#endif +{ +return( (*x)>=0 ? + floor(*x + .5) : -floor(.5 - *x) ); +} diff --git a/libf2c/libF77/h_sign.c b/libf2c/libF77/h_sign.c new file mode 100644 index 00000000000..7b06c157a74 --- /dev/null +++ b/libf2c/libF77/h_sign.c @@ -0,0 +1,12 @@ +#include "f2c.h" + +#ifdef KR_headers +shortint h_sign(a,b) shortint *a, *b; +#else +shortint h_sign(shortint *a, shortint *b) +#endif +{ +shortint x; +x = (*a >= 0 ? *a : - *a); +return( *b >= 0 ? x : -x); +} diff --git a/libf2c/libF77/hl_ge.c b/libf2c/libF77/hl_ge.c new file mode 100644 index 00000000000..4c29527065a --- /dev/null +++ b/libf2c/libF77/hl_ge.c @@ -0,0 +1,12 @@ +#include "f2c.h" + +#ifdef KR_headers +extern integer s_cmp(); +shortlogical hl_ge(a,b,la,lb) char *a, *b; ftnlen la, lb; +#else +extern integer s_cmp(char *, char *, ftnlen, ftnlen); +shortlogical hl_ge(char *a, char *b, ftnlen la, ftnlen lb) +#endif +{ +return(s_cmp(a,b,la,lb) >= 0); +} diff --git a/libf2c/libF77/hl_gt.c b/libf2c/libF77/hl_gt.c new file mode 100644 index 00000000000..c4f345a0859 --- /dev/null +++ b/libf2c/libF77/hl_gt.c @@ -0,0 +1,12 @@ +#include "f2c.h" + +#ifdef KR_headers +extern integer s_cmp(); +shortlogical hl_gt(a,b,la,lb) char *a, *b; ftnlen la, lb; +#else +extern integer s_cmp(char *, char *, ftnlen, ftnlen); +shortlogical hl_gt(char *a, char *b, ftnlen la, ftnlen lb) +#endif +{ +return(s_cmp(a,b,la,lb) > 0); +} diff --git a/libf2c/libF77/hl_le.c b/libf2c/libF77/hl_le.c new file mode 100644 index 00000000000..a9cce596c71 --- /dev/null +++ b/libf2c/libF77/hl_le.c @@ -0,0 +1,12 @@ +#include "f2c.h" + +#ifdef KR_headers +extern integer s_cmp(); +shortlogical hl_le(a,b,la,lb) char *a, *b; ftnlen la, lb; +#else +extern integer s_cmp(char *, char *, ftnlen, ftnlen); +shortlogical hl_le(char *a, char *b, ftnlen la, ftnlen lb) +#endif +{ +return(s_cmp(a,b,la,lb) <= 0); +} diff --git a/libf2c/libF77/hl_lt.c b/libf2c/libF77/hl_lt.c new file mode 100644 index 00000000000..162d919c3b4 --- /dev/null +++ b/libf2c/libF77/hl_lt.c @@ -0,0 +1,12 @@ +#include "f2c.h" + +#ifdef KR_headers +extern integer s_cmp(); +shortlogical hl_lt(a,b,la,lb) char *a, *b; ftnlen la, lb; +#else +extern integer s_cmp(char *, char *, ftnlen, ftnlen); +shortlogical hl_lt(char *a, char *b, ftnlen la, ftnlen lb) +#endif +{ +return(s_cmp(a,b,la,lb) < 0); +} diff --git a/libf2c/libF77/i_abs.c b/libf2c/libF77/i_abs.c new file mode 100644 index 00000000000..be21295aaa1 --- /dev/null +++ b/libf2c/libF77/i_abs.c @@ -0,0 +1,12 @@ +#include "f2c.h" + +#ifdef KR_headers +integer i_abs(x) integer *x; +#else +integer i_abs(integer *x) +#endif +{ +if(*x >= 0) + return(*x); +return(- *x); +} diff --git a/libf2c/libF77/i_dim.c b/libf2c/libF77/i_dim.c new file mode 100644 index 00000000000..6e1b1707b55 --- /dev/null +++ b/libf2c/libF77/i_dim.c @@ -0,0 +1,10 @@ +#include "f2c.h" + +#ifdef KR_headers +integer i_dim(a,b) integer *a, *b; +#else +integer i_dim(integer *a, integer *b) +#endif +{ +return( *a > *b ? *a - *b : 0); +} diff --git a/libf2c/libF77/i_dnnt.c b/libf2c/libF77/i_dnnt.c new file mode 100644 index 00000000000..8fcecb68200 --- /dev/null +++ b/libf2c/libF77/i_dnnt.c @@ -0,0 +1,14 @@ +#include "f2c.h" + +#ifdef KR_headers +double floor(); +integer i_dnnt(x) doublereal *x; +#else +#undef abs +#include +integer i_dnnt(doublereal *x) +#endif +{ +return( (*x)>=0 ? + floor(*x + .5) : -floor(.5 - *x) ); +} diff --git a/libf2c/libF77/i_indx.c b/libf2c/libF77/i_indx.c new file mode 100644 index 00000000000..96e7bc51ba8 --- /dev/null +++ b/libf2c/libF77/i_indx.c @@ -0,0 +1,26 @@ +#include "f2c.h" + +#ifdef KR_headers +integer i_indx(a, b, la, lb) char *a, *b; ftnlen la, lb; +#else +integer i_indx(char *a, char *b, ftnlen la, ftnlen lb) +#endif +{ +ftnlen i, n; +char *s, *t, *bend; + +n = la - lb + 1; +bend = b + lb; + +for(i = 0 ; i < n ; ++i) + { + s = a + i; + t = b; + while(t < bend) + if(*s++ != *t++) + goto no; + return(i+1); + no: ; + } +return(0); +} diff --git a/libf2c/libF77/i_len.c b/libf2c/libF77/i_len.c new file mode 100644 index 00000000000..4020fee4618 --- /dev/null +++ b/libf2c/libF77/i_len.c @@ -0,0 +1,10 @@ +#include "f2c.h" + +#ifdef KR_headers +integer i_len(s, n) char *s; ftnlen n; +#else +integer i_len(char *s, ftnlen n) +#endif +{ +return(n); +} diff --git a/libf2c/libF77/i_mod.c b/libf2c/libF77/i_mod.c new file mode 100644 index 00000000000..6937c421357 --- /dev/null +++ b/libf2c/libF77/i_mod.c @@ -0,0 +1,10 @@ +#include "f2c.h" + +#ifdef KR_headers +integer i_mod(a,b) integer *a, *b; +#else +integer i_mod(integer *a, integer *b) +#endif +{ +return( *a % *b); +} diff --git a/libf2c/libF77/i_nint.c b/libf2c/libF77/i_nint.c new file mode 100644 index 00000000000..c0f6795171f --- /dev/null +++ b/libf2c/libF77/i_nint.c @@ -0,0 +1,14 @@ +#include "f2c.h" + +#ifdef KR_headers +double floor(); +integer i_nint(x) real *x; +#else +#undef abs +#include +integer i_nint(real *x) +#endif +{ +return( (*x)>=0 ? + floor(*x + .5) : -floor(.5 - *x) ); +} diff --git a/libf2c/libF77/i_sign.c b/libf2c/libF77/i_sign.c new file mode 100644 index 00000000000..94009b86e6f --- /dev/null +++ b/libf2c/libF77/i_sign.c @@ -0,0 +1,12 @@ +#include "f2c.h" + +#ifdef KR_headers +integer i_sign(a,b) integer *a, *b; +#else +integer i_sign(integer *a, integer *b) +#endif +{ +integer x; +x = (*a >= 0 ? *a : - *a); +return( *b >= 0 ? x : -x); +} diff --git a/libf2c/libF77/iargc_.c b/libf2c/libF77/iargc_.c new file mode 100644 index 00000000000..7ce5e08d306 --- /dev/null +++ b/libf2c/libF77/iargc_.c @@ -0,0 +1,11 @@ +#include "f2c.h" + +#ifdef KR_headers +ftnint G77_iargc_0 () +#else +ftnint G77_iargc_0 (void) +#endif +{ +extern int xargc; +return ( xargc - 1 ); +} diff --git a/libf2c/libF77/l_ge.c b/libf2c/libF77/l_ge.c new file mode 100644 index 00000000000..86b4a1f5a7f --- /dev/null +++ b/libf2c/libF77/l_ge.c @@ -0,0 +1,12 @@ +#include "f2c.h" + +#ifdef KR_headers +extern integer s_cmp(); +logical l_ge(a,b,la,lb) char *a, *b; ftnlen la, lb; +#else +extern integer s_cmp(char *, char *, ftnlen, ftnlen); +logical l_ge(char *a, char *b, ftnlen la, ftnlen lb) +#endif +{ +return(s_cmp(a,b,la,lb) >= 0); +} diff --git a/libf2c/libF77/l_gt.c b/libf2c/libF77/l_gt.c new file mode 100644 index 00000000000..c4b52f5bf7d --- /dev/null +++ b/libf2c/libF77/l_gt.c @@ -0,0 +1,12 @@ +#include "f2c.h" + +#ifdef KR_headers +extern integer s_cmp(); +logical l_gt(a,b,la,lb) char *a, *b; ftnlen la, lb; +#else +extern integer s_cmp(char *, char *, ftnlen, ftnlen); +logical l_gt(char *a, char *b, ftnlen la, ftnlen lb) +#endif +{ +return(s_cmp(a,b,la,lb) > 0); +} diff --git a/libf2c/libF77/l_le.c b/libf2c/libF77/l_le.c new file mode 100644 index 00000000000..f2740a23814 --- /dev/null +++ b/libf2c/libF77/l_le.c @@ -0,0 +1,12 @@ +#include "f2c.h" + +#ifdef KR_headers +extern integer s_cmp(); +logical l_le(a,b,la,lb) char *a, *b; ftnlen la, lb; +#else +extern integer s_cmp(char *, char *, ftnlen, ftnlen); +logical l_le(char *a, char *b, ftnlen la, ftnlen lb) +#endif +{ +return(s_cmp(a,b,la,lb) <= 0); +} diff --git a/libf2c/libF77/l_lt.c b/libf2c/libF77/l_lt.c new file mode 100644 index 00000000000..c48dc946f9a --- /dev/null +++ b/libf2c/libF77/l_lt.c @@ -0,0 +1,12 @@ +#include "f2c.h" + +#ifdef KR_headers +extern integer s_cmp(); +logical l_lt(a,b,la,lb) char *a, *b; ftnlen la, lb; +#else +extern integer s_cmp(char *, char *, ftnlen, ftnlen); +logical l_lt(char *a, char *b, ftnlen la, ftnlen lb) +#endif +{ +return(s_cmp(a,b,la,lb) < 0); +} diff --git a/libf2c/libF77/lbitbits.c b/libf2c/libF77/lbitbits.c new file mode 100644 index 00000000000..75e9f9c603f --- /dev/null +++ b/libf2c/libF77/lbitbits.c @@ -0,0 +1,62 @@ +#include "f2c.h" + +#ifndef LONGBITS +#define LONGBITS 32 +#endif + + integer +#ifdef KR_headers +lbit_bits(a, b, len) integer a, b, len; +#else +lbit_bits(integer a, integer b, integer len) +#endif +{ + /* Assume 2's complement arithmetic */ + + unsigned long x, y; + + x = (unsigned long) a; + y = (unsigned long)-1L; + x >>= b; + y <<= len; + return (integer)(x & ~y); + } + + integer +#ifdef KR_headers +lbit_cshift(a, b, len) integer a, b, len; +#else +lbit_cshift(integer a, integer b, integer len) +#endif +{ + unsigned long x, y, z; + + x = (unsigned long)a; + if (len <= 0) { + if (len == 0) + return 0; + goto full_len; + } + if (len >= LONGBITS) { + full_len: + if (b >= 0) { + b %= LONGBITS; + return (integer)(x << b | x >> LONGBITS -b ); + } + b = -b; + b %= LONGBITS; + return (integer)(x << LONGBITS - b | x >> b); + } + y = z = (unsigned long)-1; + y <<= len; + z &= ~y; + y &= x; + x &= z; + if (b >= 0) { + b %= len; + return (integer)(y | z & (x << b | x >> len - b)); + } + b = -b; + b %= len; + return (integer)(y | z & (x >> b | x << len - b)); + } diff --git a/libf2c/libF77/lbitshft.c b/libf2c/libF77/lbitshft.c new file mode 100644 index 00000000000..81b0fdbeaba --- /dev/null +++ b/libf2c/libF77/lbitshft.c @@ -0,0 +1,11 @@ +#include "f2c.h" + + integer +#ifdef KR_headers +lbit_shift(a, b) integer a; integer b; +#else +lbit_shift(integer a, integer b) +#endif +{ + return b >= 0 ? a << b : (integer)((uinteger)a >> -b); + } diff --git a/libf2c/libF77/main.c b/libf2c/libF77/main.c new file mode 100644 index 00000000000..469a64bdcb3 --- /dev/null +++ b/libf2c/libF77/main.c @@ -0,0 +1,135 @@ +/* STARTUP PROCEDURE FOR UNIX FORTRAN PROGRAMS */ + +#include +#include "signal1.h" + +#ifndef SIGIOT +#ifdef SIGABRT +#define SIGIOT SIGABRT +#endif +#endif + +#ifndef KR_headers +#undef VOID +#include +#endif + +#ifndef VOID +#define VOID void +#endif + +#ifdef __cplusplus +extern "C" { +#endif + +#ifdef NO__STDC +#define ONEXIT onexit +extern VOID f_exit(); +#else +#ifndef KR_headers +extern void f_exit(void); +#ifndef NO_ONEXIT +#define ONEXIT atexit +extern int atexit(void (*)(void)); +#endif +#else +#ifndef NO_ONEXIT +#define ONEXIT onexit +extern VOID f_exit(); +#endif +#endif +#endif + +#ifdef KR_headers +extern VOID f_init(), sig_die(); +extern int MAIN__(); +#define Int /* int */ +#else +extern void f_init(void), sig_die(char*, int); +extern int MAIN__(void); +#define Int int +#endif + +static VOID sigfdie(Int n) +{ +sig_die("Floating Exception", 1); +} + + +static VOID sigidie(Int n) +{ +sig_die("IOT Trap", 1); +} + +#ifdef SIGQUIT +static VOID sigqdie(Int n) +{ +sig_die("Quit signal", 1); +} +#endif + + +static VOID sigindie(Int n) +{ +sig_die("Interrupt", 0); +} + +static VOID sigtdie(Int n) +{ +sig_die("Killed", 0); +} + +#ifdef SIGTRAP +static VOID sigtrdie(Int n) +{ +sig_die("Trace trap", 1); +} +#endif + + +int xargc; +char **xargv; + +#ifdef __cplusplus + } +#endif + +#ifdef KR_headers +main(argc, argv) int argc; char **argv; +#else +main(int argc, char **argv) +#endif +{ +xargc = argc; +xargv = argv; +signal1(SIGFPE, sigfdie); /* ignore underflow, enable overflow */ +#ifdef SIGIOT +signal1(SIGIOT, sigidie); +#endif +#ifdef SIGTRAP +signal1(SIGTRAP, sigtrdie); +#endif +#ifdef SIGQUIT +if(signal1(SIGQUIT,sigqdie) == SIG_IGN) + signal1(SIGQUIT, SIG_IGN); +#endif +if(signal1(SIGINT, sigindie) == SIG_IGN) + signal1(SIGINT, SIG_IGN); +signal1(SIGTERM,sigtdie); + +#ifdef pdp11 + ldfps(01200); /* detect overflow as an exception */ +#endif + +f_init(); +#ifndef NO_ONEXIT +ONEXIT(f_exit); +#endif +MAIN__(); +#ifdef NO_ONEXIT +f_exit(); +#endif +exit(0); /* exit(0) rather than return(0) to bypass Cray bug */ +return 0; /* For compilers that complain of missing return values; */ + /* others will complain that this is unreachable code. */ +} diff --git a/libf2c/libF77/makefile.netlib b/libf2c/libF77/makefile.netlib new file mode 100644 index 00000000000..230ca7e9f93 --- /dev/null +++ b/libf2c/libF77/makefile.netlib @@ -0,0 +1,103 @@ +.SUFFIXES: .c .o +CC = cc +SHELL = /bin/sh +CFLAGS = -O + +# If your system lacks onexit() and you are not using an +# ANSI C compiler, then you should add -DNO_ONEXIT to CFLAGS, +# e.g., by changing the above "CFLAGS =" line to +# CFLAGS = -O -DNO_ONEXIT + +# On at least some Sun systems, it is more appropriate to change the +# "CFLAGS =" line to +# CFLAGS = -O -Donexit=on_exit + +# compile, then strip unnecessary symbols +.c.o: + $(CC) -c -DSkip_f2c_Undefs $(CFLAGS) $*.c + ld -r -x -o $*.xxx $*.o + mv $*.xxx $*.o +## Under Solaris (and other systems that do not understand ld -x), +## omit -x in the ld line above. +## If your system does not have the ld command, comment out +## or remove both the ld and mv lines above. + +MISC = F77_aloc.o Version.o main.o s_rnge.o abort_.o getarg_.o iargc_.o \ + getenv_.o signal_.o s_stop.o s_paus.o system_.o cabs.o\ + derf_.o derfc_.o erf_.o erfc_.o sig_die.o exit_.o +POW = pow_ci.o pow_dd.o pow_di.o pow_hh.o pow_ii.o pow_ri.o pow_zi.o pow_zz.o +CX = c_abs.o c_cos.o c_div.o c_exp.o c_log.o c_sin.o c_sqrt.o +DCX = z_abs.o z_cos.o z_div.o z_exp.o z_log.o z_sin.o z_sqrt.o +REAL = r_abs.o r_acos.o r_asin.o r_atan.o r_atn2.o r_cnjg.o r_cos.o\ + r_cosh.o r_dim.o r_exp.o r_imag.o r_int.o\ + r_lg10.o r_log.o r_mod.o r_nint.o r_sign.o\ + r_sin.o r_sinh.o r_sqrt.o r_tan.o r_tanh.o +DBL = d_abs.o d_acos.o d_asin.o d_atan.o d_atn2.o\ + d_cnjg.o d_cos.o d_cosh.o d_dim.o d_exp.o\ + d_imag.o d_int.o d_lg10.o d_log.o d_mod.o\ + d_nint.o d_prod.o d_sign.o d_sin.o d_sinh.o\ + d_sqrt.o d_tan.o d_tanh.o +INT = i_abs.o i_dim.o i_dnnt.o i_indx.o i_len.o i_mod.o i_nint.o i_sign.o +HALF = h_abs.o h_dim.o h_dnnt.o h_indx.o h_len.o h_mod.o h_nint.o h_sign.o +CMP = l_ge.o l_gt.o l_le.o l_lt.o hl_ge.o hl_gt.o hl_le.o hl_lt.o +EFL = ef1asc_.o ef1cmc_.o +CHAR = F77_aloc.o s_cat.o s_cmp.o s_copy.o +F90BIT = lbitbits.o lbitshft.o +QINT = pow_qq.o qbitbits.o qbitshft.o +TIME = dtime_.o etime_.o + +all: signal1.h libF77.a + +# You may need to adjust signal1.h suitably for your system... +signal1.h: signal1.h0 + cp signal1.h0 signal1.h + +# If you get an error compiling dtime_.c or etime_.c, try adding +# -DUSE_CLOCK to the CFLAGS assignment above; if that does not work, +# omit $(TIME) from the dependency list for libF77.a below. + +# For INTEGER*8 support (which requires system-dependent adjustments to +# f2c.h), add $(QINT) to the libf2c.a dependency list below... + +libF77.a : $(MISC) $(POW) $(CX) $(DCX) $(REAL) $(DBL) $(INT) \ + $(HALF) $(CMP) $(EFL) $(CHAR) $(F90BIT) $(TIME) + ar r libF77.a $? + -ranlib libF77.a + +### If your system lacks ranlib, you don't need it; see README. + +Version.o: Version.c + $(CC) -c Version.c + +# To compile with C++, first "make f2c.h" +f2c.h: f2ch.add + cat /usr/include/f2c.h f2ch.add >f2c.h + +install: libF77.a + mv libF77.a /usr/lib + ranlib /usr/lib/libF77.a + +clean: + rm -f libF77.a *.o + +check: + xsum F77_aloc.c Notice README Version.c abort_.c c_abs.c c_cos.c \ + c_div.c c_exp.c c_log.c c_sin.c c_sqrt.c cabs.c d_abs.c d_acos.c \ + d_asin.c d_atan.c d_atn2.c d_cnjg.c d_cos.c d_cosh.c d_dim.c \ + d_exp.c d_imag.c d_int.c d_lg10.c d_log.c d_mod.c d_nint.c \ + d_prod.c d_sign.c d_sin.c d_sinh.c d_sqrt.c d_tan.c d_tanh.c \ + derf_.c derfc_.c dtime_.c \ + ef1asc_.c ef1cmc_.c erf_.c erfc_.c etime_.c exit_.c f2ch.add \ + getarg_.c getenv_.c h_abs.c h_dim.c h_dnnt.c h_indx.c h_len.c \ + h_mod.c h_nint.c h_sign.c hl_ge.c hl_gt.c hl_le.c hl_lt.c \ + i_abs.c i_dim.c i_dnnt.c i_indx.c i_len.c i_mod.c i_nint.c \ + i_sign.c iargc_.c l_ge.c l_gt.c l_le.c l_lt.c lbitbits.c lbitshft.c \ + main.c makefile pow_ci.c pow_dd.c pow_di.c pow_hh.c pow_ii.c \ + pow_qq.c pow_ri.c pow_zi.c pow_zz.c qbitbits.c qbitshft.c \ + r_abs.c r_acos.c r_asin.c r_atan.c r_atn2.c \ + r_cnjg.c r_cos.c r_cosh.c r_dim.c r_exp.c r_imag.c r_int.c r_lg10.c \ + r_log.c r_mod.c r_nint.c r_sign.c r_sin.c r_sinh.c r_sqrt.c \ + r_tan.c r_tanh.c s_cat.c s_cmp.c s_copy.c \ + s_paus.c s_rnge.c s_stop.c sig_die.c signal1.h0 signal_.c system_.c \ + z_abs.c z_cos.c z_div.c z_exp.c z_log.c z_sin.c z_sqrt.c >zap + cmp zap libF77.xsum && rm zap || diff libF77.xsum zap diff --git a/libf2c/libF77/pow_ci.c b/libf2c/libF77/pow_ci.c new file mode 100644 index 00000000000..37e2ce0f2eb --- /dev/null +++ b/libf2c/libF77/pow_ci.c @@ -0,0 +1,20 @@ +#include "f2c.h" + +#ifdef KR_headers +VOID pow_ci(p, a, b) /* p = a**b */ + complex *p, *a; integer *b; +#else +extern void pow_zi(doublecomplex*, doublecomplex*, integer*); +void pow_ci(complex *p, complex *a, integer *b) /* p = a**b */ +#endif +{ +doublecomplex p1, a1; + +a1.r = a->r; +a1.i = a->i; + +pow_zi(&p1, &a1, b); + +p->r = p1.r; +p->i = p1.i; +} diff --git a/libf2c/libF77/pow_dd.c b/libf2c/libF77/pow_dd.c new file mode 100644 index 00000000000..d0dd0ff2744 --- /dev/null +++ b/libf2c/libF77/pow_dd.c @@ -0,0 +1,13 @@ +#include "f2c.h" + +#ifdef KR_headers +double pow(); +double pow_dd(ap, bp) doublereal *ap, *bp; +#else +#undef abs +#include +double pow_dd(doublereal *ap, doublereal *bp) +#endif +{ +return(pow(*ap, *bp) ); +} diff --git a/libf2c/libF77/pow_di.c b/libf2c/libF77/pow_di.c new file mode 100644 index 00000000000..affed625a91 --- /dev/null +++ b/libf2c/libF77/pow_di.c @@ -0,0 +1,35 @@ +#include "f2c.h" + +#ifdef KR_headers +double pow_di(ap, bp) doublereal *ap; integer *bp; +#else +double pow_di(doublereal *ap, integer *bp) +#endif +{ +double pow, x; +integer n; +unsigned long u; + +pow = 1; +x = *ap; +n = *bp; + +if(n != 0) + { + if(n < 0) + { + n = -n; + x = 1/x; + } + for(u = n; ; ) + { + if(u & 01) + pow *= x; + if(u >>= 1) + x *= x; + else + break; + } + } +return(pow); +} diff --git a/libf2c/libF77/pow_hh.c b/libf2c/libF77/pow_hh.c new file mode 100644 index 00000000000..24a019734da --- /dev/null +++ b/libf2c/libF77/pow_hh.c @@ -0,0 +1,33 @@ +#include "f2c.h" + +#ifdef KR_headers +shortint pow_hh(ap, bp) shortint *ap, *bp; +#else +shortint pow_hh(shortint *ap, shortint *bp) +#endif +{ + shortint pow, x, n; + unsigned u; + + x = *ap; + n = *bp; + + if (n <= 0) { + if (n == 0 || x == 1) + return 1; + if (x != -1) + return x == 0 ? 1/x : 0; + n = -n; + } + u = n; + for(pow = 1; ; ) + { + if(u & 01) + pow *= x; + if(u >>= 1) + x *= x; + else + break; + } + return(pow); + } diff --git a/libf2c/libF77/pow_ii.c b/libf2c/libF77/pow_ii.c new file mode 100644 index 00000000000..84d1c7e0b5e --- /dev/null +++ b/libf2c/libF77/pow_ii.c @@ -0,0 +1,33 @@ +#include "f2c.h" + +#ifdef KR_headers +integer pow_ii(ap, bp) integer *ap, *bp; +#else +integer pow_ii(integer *ap, integer *bp) +#endif +{ + integer pow, x, n; + unsigned long u; + + x = *ap; + n = *bp; + + if (n <= 0) { + if (n == 0 || x == 1) + return 1; + if (x != -1) + return x == 0 ? 1/x : 0; + n = -n; + } + u = n; + for(pow = 1; ; ) + { + if(u & 01) + pow *= x; + if(u >>= 1) + x *= x; + else + break; + } + return(pow); + } diff --git a/libf2c/libF77/pow_qq.c b/libf2c/libF77/pow_qq.c new file mode 100644 index 00000000000..3bc80e05f7f --- /dev/null +++ b/libf2c/libF77/pow_qq.c @@ -0,0 +1,33 @@ +#include "f2c.h" + +#ifdef KR_headers +longint pow_qq(ap, bp) longint *ap, *bp; +#else +longint pow_qq(longint *ap, longint *bp) +#endif +{ + longint pow, x, n; + unsigned long long u; /* system-dependent */ + + x = *ap; + n = *bp; + + if (n <= 0) { + if (n == 0 || x == 1) + return 1; + if (x != -1) + return x == 0 ? 1/x : 0; + n = -n; + } + u = n; + for(pow = 1; ; ) + { + if(u & 01) + pow *= x; + if(u >>= 1) + x *= x; + else + break; + } + return(pow); + } diff --git a/libf2c/libF77/pow_ri.c b/libf2c/libF77/pow_ri.c new file mode 100644 index 00000000000..6e5816bbf10 --- /dev/null +++ b/libf2c/libF77/pow_ri.c @@ -0,0 +1,35 @@ +#include "f2c.h" + +#ifdef KR_headers +double pow_ri(ap, bp) real *ap; integer *bp; +#else +double pow_ri(real *ap, integer *bp) +#endif +{ +double pow, x; +integer n; +unsigned long u; + +pow = 1; +x = *ap; +n = *bp; + +if(n != 0) + { + if(n < 0) + { + n = -n; + x = 1/x; + } + for(u = n; ; ) + { + if(u & 01) + pow *= x; + if(u >>= 1) + x *= x; + else + break; + } + } +return(pow); +} diff --git a/libf2c/libF77/pow_zi.c b/libf2c/libF77/pow_zi.c new file mode 100644 index 00000000000..898ea6be917 --- /dev/null +++ b/libf2c/libF77/pow_zi.c @@ -0,0 +1,61 @@ +#include "f2c.h" + +#ifdef KR_headers +VOID pow_zi(resx, a, b) /* p = a**b */ + doublecomplex *resx, *a; integer *b; +#else +extern void z_div(doublecomplex*, doublecomplex*, doublecomplex*); +void pow_zi(doublecomplex *resx, doublecomplex *a, integer *b) /* p = a**b */ +#endif +{ +integer n; +unsigned long u; +double t; +doublecomplex x; +doublecomplex res; +static doublecomplex one = {1.0, 0.0}; + +n = *b; + +if(n == 0) + { + resx->r = 1; + resx->i = 0; + return; + } + +res.r = 1; +res.i = 0; + +if(n < 0) + { + n = -n; + z_div(&x, &one, a); + } +else + { + x.r = a->r; + x.i = a->i; + } + +for(u = n; ; ) + { + if(u & 01) + { + t = res.r * x.r - res.i * x.i; + res.i = res.r * x.i + res.i * x.r; + res.r = t; + } + if(u >>= 1) + { + t = x.r * x.r - x.i * x.i; + x.i = 2 * x.r * x.i; + x.r = t; + } + else + break; + } + +resx->r = res.r; +resx->i = res.i; +} diff --git a/libf2c/libF77/pow_zz.c b/libf2c/libF77/pow_zz.c new file mode 100644 index 00000000000..20faf29cfb8 --- /dev/null +++ b/libf2c/libF77/pow_zz.c @@ -0,0 +1,23 @@ +#include "f2c.h" + +#ifdef KR_headers +double log(), exp(), cos(), sin(), atan2(), f__cabs(); +VOID pow_zz(r,a,b) doublecomplex *r, *a, *b; +#else +#undef abs +#include +extern double f__cabs(double,double); +void pow_zz(doublecomplex *r, doublecomplex *a, doublecomplex *b) +#endif +{ +double logr, logi, x, y; + +logr = log( f__cabs(a->r, a->i) ); +logi = atan2(a->i, a->r); + +x = exp( logr * b->r - logi * b->i ); +y = logr * b->i + logi * b->r; + +r->r = x * cos(y); +r->i = x * sin(y); +} diff --git a/libf2c/libF77/qbitbits.c b/libf2c/libF77/qbitbits.c new file mode 100644 index 00000000000..ad4ac963ce2 --- /dev/null +++ b/libf2c/libF77/qbitbits.c @@ -0,0 +1,66 @@ +#include "f2c.h" + +#ifndef LONGBITS +#define LONGBITS 32 +#endif + +#ifndef LONG8BITS +#define LONG8BITS (2*LONGBITS) +#endif + + integer +#ifdef KR_headers +qbit_bits(a, b, len) longint a; integer b, len; +#else +qbit_bits(longint a, integer b, integer len) +#endif +{ + /* Assume 2's complement arithmetic */ + + ulongint x, y; + + x = (ulongint) a; + y = (ulongint)-1L; + x >>= b; + y <<= len; + return (longint)(x & y); + } + + longint +#ifdef KR_headers +qbit_cshift(a, b, len) longint a; integer b, len; +#else +qbit_cshift(longint a, integer b, integer len) +#endif +{ + ulongint x, y, z; + + x = (ulongint)a; + if (len <= 0) { + if (len == 0) + return 0; + goto full_len; + } + if (len >= LONG8BITS) { + full_len: + if (b >= 0) { + b %= LONG8BITS; + return (longint)(x << b | x >> LONG8BITS - b ); + } + b = -b; + b %= LONG8BITS; + return (longint)(x << LONG8BITS - b | x >> b); + } + y = z = (unsigned long)-1; + y <<= len; + z &= ~y; + y &= x; + x &= z; + if (b >= 0) { + b %= len; + return (longint)(y | z & (x << b | x >> len - b)); + } + b = -b; + b %= len; + return (longint)(y | z & (x >> b | x << len - b)); + } diff --git a/libf2c/libF77/qbitshft.c b/libf2c/libF77/qbitshft.c new file mode 100644 index 00000000000..87fffb91ff8 --- /dev/null +++ b/libf2c/libF77/qbitshft.c @@ -0,0 +1,11 @@ +#include "f2c.h" + + longint +#ifdef KR_headers +qbit_shift(a, b) longint a; integer b; +#else +qbit_shift(longint a, integer b) +#endif +{ + return b >= 0 ? a << b : (longint)((ulongint)a >> -b); + } diff --git a/libf2c/libF77/r_abs.c b/libf2c/libF77/r_abs.c new file mode 100644 index 00000000000..7b222961d16 --- /dev/null +++ b/libf2c/libF77/r_abs.c @@ -0,0 +1,12 @@ +#include "f2c.h" + +#ifdef KR_headers +double r_abs(x) real *x; +#else +double r_abs(real *x) +#endif +{ +if(*x >= 0) + return(*x); +return(- *x); +} diff --git a/libf2c/libF77/r_acos.c b/libf2c/libF77/r_acos.c new file mode 100644 index 00000000000..330f88a3092 --- /dev/null +++ b/libf2c/libF77/r_acos.c @@ -0,0 +1,13 @@ +#include "f2c.h" + +#ifdef KR_headers +double acos(); +double r_acos(x) real *x; +#else +#undef abs +#include +double r_acos(real *x) +#endif +{ +return( acos(*x) ); +} diff --git a/libf2c/libF77/r_asin.c b/libf2c/libF77/r_asin.c new file mode 100644 index 00000000000..45ece4b749e --- /dev/null +++ b/libf2c/libF77/r_asin.c @@ -0,0 +1,13 @@ +#include "f2c.h" + +#ifdef KR_headers +double asin(); +double r_asin(x) real *x; +#else +#undef abs +#include +double r_asin(real *x) +#endif +{ +return( asin(*x) ); +} diff --git a/libf2c/libF77/r_atan.c b/libf2c/libF77/r_atan.c new file mode 100644 index 00000000000..36479c915b0 --- /dev/null +++ b/libf2c/libF77/r_atan.c @@ -0,0 +1,13 @@ +#include "f2c.h" + +#ifdef KR_headers +double atan(); +double r_atan(x) real *x; +#else +#undef abs +#include +double r_atan(real *x) +#endif +{ +return( atan(*x) ); +} diff --git a/libf2c/libF77/r_atn2.c b/libf2c/libF77/r_atn2.c new file mode 100644 index 00000000000..9347e1f13a9 --- /dev/null +++ b/libf2c/libF77/r_atn2.c @@ -0,0 +1,13 @@ +#include "f2c.h" + +#ifdef KR_headers +double atan2(); +double r_atn2(x,y) real *x, *y; +#else +#undef abs +#include +double r_atn2(real *x, real *y) +#endif +{ +return( atan2(*x,*y) ); +} diff --git a/libf2c/libF77/r_cnjg.c b/libf2c/libF77/r_cnjg.c new file mode 100644 index 00000000000..b6175eedfd7 --- /dev/null +++ b/libf2c/libF77/r_cnjg.c @@ -0,0 +1,16 @@ +#include "f2c.h" + +#ifdef KR_headers +VOID r_cnjg(resx, z) complex *resx, *z; +#else +VOID r_cnjg(complex *resx, complex *z) +#endif +{ +complex res; + +res.r = z->r; +res.i = - z->i; + +resx->r = res.r; +resx->i = res.i; +} diff --git a/libf2c/libF77/r_cos.c b/libf2c/libF77/r_cos.c new file mode 100644 index 00000000000..5bda158cee9 --- /dev/null +++ b/libf2c/libF77/r_cos.c @@ -0,0 +1,13 @@ +#include "f2c.h" + +#ifdef KR_headers +double cos(); +double r_cos(x) real *x; +#else +#undef abs +#include +double r_cos(real *x) +#endif +{ +return( cos(*x) ); +} diff --git a/libf2c/libF77/r_cosh.c b/libf2c/libF77/r_cosh.c new file mode 100644 index 00000000000..7ae72cc0cef --- /dev/null +++ b/libf2c/libF77/r_cosh.c @@ -0,0 +1,13 @@ +#include "f2c.h" + +#ifdef KR_headers +double cosh(); +double r_cosh(x) real *x; +#else +#undef abs +#include +double r_cosh(real *x) +#endif +{ +return( cosh(*x) ); +} diff --git a/libf2c/libF77/r_dim.c b/libf2c/libF77/r_dim.c new file mode 100644 index 00000000000..baca95cd9e4 --- /dev/null +++ b/libf2c/libF77/r_dim.c @@ -0,0 +1,10 @@ +#include "f2c.h" + +#ifdef KR_headers +double r_dim(a,b) real *a, *b; +#else +double r_dim(real *a, real *b) +#endif +{ +return( *a > *b ? *a - *b : 0); +} diff --git a/libf2c/libF77/r_exp.c b/libf2c/libF77/r_exp.c new file mode 100644 index 00000000000..d1dea75563f --- /dev/null +++ b/libf2c/libF77/r_exp.c @@ -0,0 +1,13 @@ +#include "f2c.h" + +#ifdef KR_headers +double exp(); +double r_exp(x) real *x; +#else +#undef abs +#include +double r_exp(real *x) +#endif +{ +return( exp(*x) ); +} diff --git a/libf2c/libF77/r_imag.c b/libf2c/libF77/r_imag.c new file mode 100644 index 00000000000..d51252bbb79 --- /dev/null +++ b/libf2c/libF77/r_imag.c @@ -0,0 +1,10 @@ +#include "f2c.h" + +#ifdef KR_headers +double r_imag(z) complex *z; +#else +double r_imag(complex *z) +#endif +{ +return(z->i); +} diff --git a/libf2c/libF77/r_int.c b/libf2c/libF77/r_int.c new file mode 100644 index 00000000000..8378e775726 --- /dev/null +++ b/libf2c/libF77/r_int.c @@ -0,0 +1,13 @@ +#include "f2c.h" + +#ifdef KR_headers +double floor(); +double r_int(x) real *x; +#else +#undef abs +#include +double r_int(real *x) +#endif +{ +return( (*x>0) ? floor(*x) : -floor(- *x) ); +} diff --git a/libf2c/libF77/r_lg10.c b/libf2c/libF77/r_lg10.c new file mode 100644 index 00000000000..51f84201711 --- /dev/null +++ b/libf2c/libF77/r_lg10.c @@ -0,0 +1,15 @@ +#include "f2c.h" + +#define log10e 0.43429448190325182765 + +#ifdef KR_headers +double log(); +double r_lg10(x) real *x; +#else +#undef abs +#include +double r_lg10(real *x) +#endif +{ +return( log10e * log(*x) ); +} diff --git a/libf2c/libF77/r_log.c b/libf2c/libF77/r_log.c new file mode 100644 index 00000000000..4873fb418e8 --- /dev/null +++ b/libf2c/libF77/r_log.c @@ -0,0 +1,13 @@ +#include "f2c.h" + +#ifdef KR_headers +double log(); +double r_log(x) real *x; +#else +#undef abs +#include +double r_log(real *x) +#endif +{ +return( log(*x) ); +} diff --git a/libf2c/libF77/r_mod.c b/libf2c/libF77/r_mod.c new file mode 100644 index 00000000000..faea344a7b7 --- /dev/null +++ b/libf2c/libF77/r_mod.c @@ -0,0 +1,40 @@ +#include "f2c.h" + +#ifdef KR_headers +#ifdef IEEE_drem +double drem(); +#else +double floor(); +#endif +double r_mod(x,y) real *x, *y; +#else +#ifdef IEEE_drem +double drem(double, double); +#else +#undef abs +#include +#endif +double r_mod(real *x, real *y) +#endif +{ +#ifdef IEEE_drem + double xa, ya, z; + if ((ya = *y) < 0.) + ya = -ya; + z = drem(xa = *x, ya); + if (xa > 0) { + if (z < 0) + z += ya; + } + else if (z > 0) + z -= ya; + return z; +#else + double quotient; + if( (quotient = (double)*x / *y) >= 0) + quotient = floor(quotient); + else + quotient = -floor(-quotient); + return(*x - (*y) * quotient ); +#endif +} diff --git a/libf2c/libF77/r_nint.c b/libf2c/libF77/r_nint.c new file mode 100644 index 00000000000..f5382af660a --- /dev/null +++ b/libf2c/libF77/r_nint.c @@ -0,0 +1,14 @@ +#include "f2c.h" + +#ifdef KR_headers +double floor(); +double r_nint(x) real *x; +#else +#undef abs +#include +double r_nint(real *x) +#endif +{ +return( (*x)>=0 ? + floor(*x + .5) : -floor(.5 - *x) ); +} diff --git a/libf2c/libF77/r_sign.c b/libf2c/libF77/r_sign.c new file mode 100644 index 00000000000..df6d02af00a --- /dev/null +++ b/libf2c/libF77/r_sign.c @@ -0,0 +1,12 @@ +#include "f2c.h" + +#ifdef KR_headers +double r_sign(a,b) real *a, *b; +#else +double r_sign(real *a, real *b) +#endif +{ +double x; +x = (*a >= 0 ? *a : - *a); +return( *b >= 0 ? x : -x); +} diff --git a/libf2c/libF77/r_sin.c b/libf2c/libF77/r_sin.c new file mode 100644 index 00000000000..095b9510de9 --- /dev/null +++ b/libf2c/libF77/r_sin.c @@ -0,0 +1,13 @@ +#include "f2c.h" + +#ifdef KR_headers +double sin(); +double r_sin(x) real *x; +#else +#undef abs +#include +double r_sin(real *x) +#endif +{ +return( sin(*x) ); +} diff --git a/libf2c/libF77/r_sinh.c b/libf2c/libF77/r_sinh.c new file mode 100644 index 00000000000..3bf4bb138be --- /dev/null +++ b/libf2c/libF77/r_sinh.c @@ -0,0 +1,13 @@ +#include "f2c.h" + +#ifdef KR_headers +double sinh(); +double r_sinh(x) real *x; +#else +#undef abs +#include +double r_sinh(real *x) +#endif +{ +return( sinh(*x) ); +} diff --git a/libf2c/libF77/r_sqrt.c b/libf2c/libF77/r_sqrt.c new file mode 100644 index 00000000000..d0203d3d19b --- /dev/null +++ b/libf2c/libF77/r_sqrt.c @@ -0,0 +1,13 @@ +#include "f2c.h" + +#ifdef KR_headers +double sqrt(); +double r_sqrt(x) real *x; +#else +#undef abs +#include +double r_sqrt(real *x) +#endif +{ +return( sqrt(*x) ); +} diff --git a/libf2c/libF77/r_tan.c b/libf2c/libF77/r_tan.c new file mode 100644 index 00000000000..fc0009e4774 --- /dev/null +++ b/libf2c/libF77/r_tan.c @@ -0,0 +1,13 @@ +#include "f2c.h" + +#ifdef KR_headers +double tan(); +double r_tan(x) real *x; +#else +#undef abs +#include +double r_tan(real *x) +#endif +{ +return( tan(*x) ); +} diff --git a/libf2c/libF77/r_tanh.c b/libf2c/libF77/r_tanh.c new file mode 100644 index 00000000000..818c6a8451b --- /dev/null +++ b/libf2c/libF77/r_tanh.c @@ -0,0 +1,13 @@ +#include "f2c.h" + +#ifdef KR_headers +double tanh(); +double r_tanh(x) real *x; +#else +#undef abs +#include +double r_tanh(real *x) +#endif +{ +return( tanh(*x) ); +} diff --git a/libf2c/libF77/s_cat.c b/libf2c/libF77/s_cat.c new file mode 100644 index 00000000000..f462fd24945 --- /dev/null +++ b/libf2c/libF77/s_cat.c @@ -0,0 +1,75 @@ +/* Unless compiled with -DNO_OVERWRITE, this variant of s_cat allows the + * target of a concatenation to appear on its right-hand side (contrary + * to the Fortran 77 Standard, but in accordance with Fortran 90). + */ + +#include "f2c.h" +#ifndef NO_OVERWRITE +#include +#undef abs +#ifdef KR_headers + extern char *F77_aloc(); + extern void free(); + extern void G77_exit_0 (); +#else +#undef min +#undef max +#include + extern char *F77_aloc(ftnlen, char*); +#endif +#include +#endif /* NO_OVERWRITE */ + + VOID +#ifdef KR_headers +s_cat(lp, rpp, rnp, np, ll) char *lp, *rpp[]; ftnlen rnp[], *np, ll; +#else +s_cat(char *lp, char *rpp[], ftnlen rnp[], ftnlen *np, ftnlen ll) +#endif +{ + ftnlen i, nc; + char *rp; + ftnlen n = *np; +#ifndef NO_OVERWRITE + ftnlen L, m; + char *lp0, *lp1; + + lp0 = 0; + lp1 = lp; + L = ll; + i = 0; + while(i < n) { + rp = rpp[i]; + m = rnp[i++]; + if (rp >= lp1 || rp + m <= lp) { + if ((L -= m) <= 0) { + n = i; + break; + } + lp1 += m; + continue; + } + lp0 = lp; + lp = lp1 = F77_aloc(L = ll, "s_cat"); + break; + } + lp1 = lp; +#endif /* NO_OVERWRITE */ + for(i = 0 ; i < n ; ++i) { + nc = ll; + if(rnp[i] < nc) + nc = rnp[i]; + ll -= nc; + rp = rpp[i]; + while(--nc >= 0) + *lp++ = *rp++; + } + while(--ll >= 0) + *lp++ = ' '; +#ifndef NO_OVERWRITE + if (lp0) { + memcpy(lp0, lp1, L); + free(lp1); + } +#endif + } diff --git a/libf2c/libF77/s_cmp.c b/libf2c/libF77/s_cmp.c new file mode 100644 index 00000000000..1e052f28642 --- /dev/null +++ b/libf2c/libF77/s_cmp.c @@ -0,0 +1,44 @@ +#include "f2c.h" + +/* compare two strings */ + +#ifdef KR_headers +integer s_cmp(a0, b0, la, lb) char *a0, *b0; ftnlen la, lb; +#else +integer s_cmp(char *a0, char *b0, ftnlen la, ftnlen lb) +#endif +{ +register unsigned char *a, *aend, *b, *bend; +a = (unsigned char *)a0; +b = (unsigned char *)b0; +aend = a + la; +bend = b + lb; + +if(la <= lb) + { + while(a < aend) + if(*a != *b) + return( *a - *b ); + else + { ++a; ++b; } + + while(b < bend) + if(*b != ' ') + return( ' ' - *b ); + else ++b; + } + +else + { + while(b < bend) + if(*a == *b) + { ++a; ++b; } + else + return( *a - *b ); + while(a < aend) + if(*a != ' ') + return(*a - ' '); + else ++a; + } +return(0); +} diff --git a/libf2c/libF77/s_copy.c b/libf2c/libF77/s_copy.c new file mode 100644 index 00000000000..d1673510c62 --- /dev/null +++ b/libf2c/libF77/s_copy.c @@ -0,0 +1,51 @@ +/* Unless compiled with -DNO_OVERWRITE, this variant of s_copy allows the + * target of an assignment to appear on its right-hand side (contrary + * to the Fortran 77 Standard, but in accordance with Fortran 90), + * as in a(2:5) = a(4:7) . + */ + +#include "f2c.h" + +/* assign strings: a = b */ + +#ifdef KR_headers +VOID s_copy(a, b, la, lb) register char *a, *b; ftnlen la, lb; +#else +void s_copy(register char *a, register char *b, ftnlen la, ftnlen lb) +#endif +{ + register char *aend, *bend; + + aend = a + la; + + if(la <= lb) +#ifndef NO_OVERWRITE + if (a <= b || a >= b + la) +#endif + while(a < aend) + *a++ = *b++; +#ifndef NO_OVERWRITE + else + for(b += la; a < aend; ) + *--aend = *--b; +#endif + + else { + bend = b + lb; +#ifndef NO_OVERWRITE + if (a <= b || a >= bend) +#endif + while(b < bend) + *a++ = *b++; +#ifndef NO_OVERWRITE + else { + a += lb; + while(b < bend) + *--a = *--bend; + a += lb; + } +#endif + while(a < aend) + *a++ = ' '; + } + } diff --git a/libf2c/libF77/s_paus.c b/libf2c/libF77/s_paus.c new file mode 100644 index 00000000000..ee2a0ee6bf5 --- /dev/null +++ b/libf2c/libF77/s_paus.c @@ -0,0 +1,88 @@ +#include +#include "f2c.h" +#define PAUSESIG 15 + +#ifdef KR_headers +#define Void /* void */ +#define Int /* int */ +#else +#define Void void +#define Int int +#undef abs +#undef min +#undef max +#include +#include "signal1.h" +#ifdef __cplusplus +extern "C" { +#endif +extern int getpid(void), isatty(int), pause(void); +#endif + +extern VOID f_exit(Void); + + static VOID +waitpause(Int n) +{ n = n; /* shut up compiler warning */ + return; + } + + static VOID +#ifdef KR_headers +s_1paus(fin) FILE *fin; +#else +s_1paus(FILE *fin) +#endif +{ + fprintf(stderr, + "To resume execution, type go. Other input will terminate the job.\n"); + fflush(stderr); + if( getc(fin)!='g' || getc(fin)!='o' || getc(fin)!='\n' ) { + fprintf(stderr, "STOP\n"); +#ifdef NO_ONEXIT + f_exit(); +#endif + exit(0); + } + } + + int +#ifdef KR_headers +s_paus(s, n) char *s; ftnlen n; +#else +s_paus(char *s, ftnlen n) +#endif +{ + fprintf(stderr, "PAUSE "); + if(n > 0) + fprintf(stderr, " %.*s", (int)n, s); + fprintf(stderr, " statement executed\n"); + if( isatty(fileno(stdin)) ) + s_1paus(stdin); + else { +#if (defined (MSDOS) && !defined (GO32)) || defined (_WIN32) + FILE *fin; + fin = fopen("con", "r"); + if (!fin) { + fprintf(stderr, "s_paus: can't open con!\n"); + fflush(stderr); + exit(1); + } + s_1paus(fin); + fclose(fin); +#else + fprintf(stderr, + "To resume execution, execute a kill -%d %d command\n", + PAUSESIG, getpid() ); + signal1(PAUSESIG, waitpause); + fflush(stderr); + pause(); +#endif + } + fprintf(stderr, "Execution resumes after PAUSE.\n"); + fflush(stderr); + return 0; /* NOT REACHED */ +#ifdef __cplusplus + } +#endif +} diff --git a/libf2c/libF77/s_rnge.c b/libf2c/libF77/s_rnge.c new file mode 100644 index 00000000000..189b5247ced --- /dev/null +++ b/libf2c/libF77/s_rnge.c @@ -0,0 +1,26 @@ +#include +#include "f2c.h" + +/* called when a subscript is out of range */ + +#ifdef KR_headers +extern VOID sig_die(); +integer s_rnge(varn, offset, procn, line) char *varn, *procn; ftnint offset, line; +#else +extern VOID sig_die(char*,int); +integer s_rnge(char *varn, ftnint offset, char *procn, ftnint line) +#endif +{ +register int i; + +fprintf(stderr, "Subscript out of range on file line %ld, procedure ", line); +while((i = *procn) && i != '_' && i != ' ') + putc(*procn++, stderr); +fprintf(stderr, ".\nAttempt to access the %ld-th element of variable ", offset+1); +while((i = *varn) && i != ' ') + putc(*varn++, stderr); +sig_die(".", 1); +#ifdef __cplusplus +return 0; +#endif +} diff --git a/libf2c/libF77/s_stop.c b/libf2c/libF77/s_stop.c new file mode 100644 index 00000000000..2e3f1035b30 --- /dev/null +++ b/libf2c/libF77/s_stop.c @@ -0,0 +1,37 @@ +#include +#include "f2c.h" + +#ifdef KR_headers +extern void f_exit(); +VOID s_stop(s, n) char *s; ftnlen n; +#else +#undef abs +#undef min +#undef max +#include +#ifdef __cplusplus +extern "C" { +#endif +void f_exit(void); + +int s_stop(char *s, ftnlen n) +#endif +{ +int i; + +if(n > 0) + { + fprintf(stderr, "STOP "); + for(i = 0; i +#include + +#ifndef SIGIOT +#ifdef SIGABRT +#define SIGIOT SIGABRT +#endif +#endif + +#ifdef KR_headers +void sig_die(s, kill) register char *s; int kill; +#else +#include +#ifdef __cplusplus +extern "C" { +#endif + extern void f_exit(void); + +void sig_die(register char *s, int kill) +#endif +{ + /* print error message, then clear buffers */ + fprintf(stderr, "%s\n", s); + + if(kill) + { + fflush(stderr); + f_exit(); + fflush(stderr); + /* now get a core */ +#ifdef SIGIOT + signal(SIGIOT, SIG_DFL); +#endif + abort(); + } + else { +#ifdef NO_ONEXIT + f_exit(); +#endif + exit(1); + } + } +#ifdef __cplusplus +} +#endif diff --git a/libf2c/libF77/signal1.h b/libf2c/libF77/signal1.h new file mode 100644 index 00000000000..b559211e8e4 --- /dev/null +++ b/libf2c/libF77/signal1.h @@ -0,0 +1,5 @@ +/* The g77 implementation of libf2c directly includes signal1.h0, + instead of copying it to signal1.h, since that seems easier to + cope with at this point. */ + +#include "signal1.h0" diff --git a/libf2c/libF77/signal1.h0 b/libf2c/libF77/signal1.h0 new file mode 100644 index 00000000000..8800a18d77b --- /dev/null +++ b/libf2c/libF77/signal1.h0 @@ -0,0 +1,25 @@ +/* You may need to adjust the definition of signal1 to supply a */ +/* cast to the correct argument type. This detail is system- and */ +/* compiler-dependent. The #define below assumes signal.h declares */ +/* type SIG_PF for the signal function's second argument. */ + +#include + +#ifndef Sigret_t +#define Sigret_t void +#endif +#ifndef Sigarg_t +#ifdef KR_headers +#define Sigarg_t +#else +#define Sigarg_t int +#endif +#endif /*Sigarg_t*/ + +#ifdef USE_SIG_PF /* compile with -DUSE_SIG_PF under IRIX */ +#define sig_pf SIG_PF +#else +typedef Sigret_t (*sig_pf)(Sigarg_t); +#endif + +#define signal1(a,b) signal(a,(sig_pf)b) diff --git a/libf2c/libF77/signal_.c b/libf2c/libF77/signal_.c new file mode 100644 index 00000000000..1ac81391aef --- /dev/null +++ b/libf2c/libF77/signal_.c @@ -0,0 +1,14 @@ +#include "f2c.h" +#include "signal1.h" + +#ifdef KR_headers +ftnint G77_signal_0 (sigp, proc) integer *sigp; sig_pf proc; +#else +ftnint G77_signal_0 (integer *sigp, sig_pf proc) +#endif +{ + int sig; + sig = (int)*sigp; + + return (ftnint)signal(sig, proc); + } diff --git a/libf2c/libF77/system_.c b/libf2c/libF77/system_.c new file mode 100644 index 00000000000..ed024a14ded --- /dev/null +++ b/libf2c/libF77/system_.c @@ -0,0 +1,36 @@ +/* f77 interface to system routine */ + +#include "f2c.h" + +#ifdef KR_headers +extern char *F77_aloc(); + + integer +G77_system_0 (s, n) register char *s; ftnlen n; +#else +#undef abs +#undef min +#undef max +#include +extern char *F77_aloc(ftnlen, char*); + + integer +G77_system_0 (register char *s, ftnlen n) +#endif +{ + char buff0[256], *buff; + register char *bp, *blast; + integer rv; + + buff = bp = n < sizeof(buff0) + ? buff0 : F77_aloc(n+1, "system_"); + blast = bp + n; + + while(bp < blast && *s) + *bp++ = *s++; + *bp = 0; + rv = system(buff); + if (buff != buff0) + free(buff); + return rv; + } diff --git a/libf2c/libF77/z_abs.c b/libf2c/libF77/z_abs.c new file mode 100644 index 00000000000..7e67ad2957f --- /dev/null +++ b/libf2c/libF77/z_abs.c @@ -0,0 +1,12 @@ +#include "f2c.h" + +#ifdef KR_headers +double f__cabs(); +double z_abs(z) doublecomplex *z; +#else +double f__cabs(double, double); +double z_abs(doublecomplex *z) +#endif +{ +return( f__cabs( z->r, z->i ) ); +} diff --git a/libf2c/libF77/z_cos.c b/libf2c/libF77/z_cos.c new file mode 100644 index 00000000000..a811bbecc65 --- /dev/null +++ b/libf2c/libF77/z_cos.c @@ -0,0 +1,19 @@ +#include "f2c.h" + +#ifdef KR_headers +double sin(), cos(), sinh(), cosh(); +VOID z_cos(resx, z) doublecomplex *resx, *z; +#else +#undef abs +#include +void z_cos(doublecomplex *resx, doublecomplex *z) +#endif +{ +doublecomplex res; + +res.r = cos(z->r) * cosh(z->i); +res.i = - sin(z->r) * sinh(z->i); + +resx->r = res.r; +resx->i = res.i; +} diff --git a/libf2c/libF77/z_div.c b/libf2c/libF77/z_div.c new file mode 100644 index 00000000000..4a987ab255a --- /dev/null +++ b/libf2c/libF77/z_div.c @@ -0,0 +1,39 @@ +#include "f2c.h" + +#ifdef KR_headers +extern VOID sig_die(); +VOID z_div(resx, a, b) doublecomplex *a, *b, *resx; +#else +extern void sig_die(char*, int); +void z_div(doublecomplex *resx, doublecomplex *a, doublecomplex *b) +#endif +{ +double ratio, den; +double abr, abi; +doublecomplex res; + +if( (abr = b->r) < 0.) + abr = - abr; +if( (abi = b->i) < 0.) + abi = - abi; +if( abr <= abi ) + { + if(abi == 0) + sig_die("complex division by zero", 1); + ratio = b->r / b->i ; + den = b->i * (1 + ratio*ratio); + res.r = (a->r*ratio + a->i) / den; + res.i = (a->i*ratio - a->r) / den; + } + +else + { + ratio = b->i / b->r ; + den = b->r * (1 + ratio*ratio); + res.r = (a->r + a->i*ratio) / den; + res.i = (a->i - a->r*ratio) / den; + } + +resx->r = res.r; +resx->i = res.i; +} diff --git a/libf2c/libF77/z_exp.c b/libf2c/libF77/z_exp.c new file mode 100644 index 00000000000..85fb63e4209 --- /dev/null +++ b/libf2c/libF77/z_exp.c @@ -0,0 +1,21 @@ +#include "f2c.h" + +#ifdef KR_headers +double exp(), cos(), sin(); +VOID z_exp(resx, z) doublecomplex *resx, *z; +#else +#undef abs +#include +void z_exp(doublecomplex *resx, doublecomplex *z) +#endif +{ +double expx; +doublecomplex res; + +expx = exp(z->r); +res.r = expx * cos(z->i); +res.i = expx * sin(z->i); + +resx->r = res.r; +resx->i = res.i; +} diff --git a/libf2c/libF77/z_log.c b/libf2c/libF77/z_log.c new file mode 100644 index 00000000000..48afca63d6d --- /dev/null +++ b/libf2c/libF77/z_log.c @@ -0,0 +1,20 @@ +#include "f2c.h" + +#ifdef KR_headers +double log(), f__cabs(), atan2(); +VOID z_log(resx, z) doublecomplex *resx, *z; +#else +#undef abs +#include +extern double f__cabs(double, double); +void z_log(doublecomplex *resx, doublecomplex *z) +#endif +{ +doublecomplex res; + +res.i = atan2(z->i, z->r); +res.r = log( f__cabs( z->r, z->i ) ); + +resx->r = res.r; +resx->i = res.i; +} diff --git a/libf2c/libF77/z_sin.c b/libf2c/libF77/z_sin.c new file mode 100644 index 00000000000..94456c9c30a --- /dev/null +++ b/libf2c/libF77/z_sin.c @@ -0,0 +1,19 @@ +#include "f2c.h" + +#ifdef KR_headers +double sin(), cos(), sinh(), cosh(); +VOID z_sin(resx, z) doublecomplex *resx, *z; +#else +#undef abs +#include +void z_sin(doublecomplex *resx, doublecomplex *z) +#endif +{ +doublecomplex res; + +res.r = sin(z->r) * cosh(z->i); +res.i = cos(z->r) * sinh(z->i); + +resx->r = res.r; +resx->i = res.i; +} diff --git a/libf2c/libF77/z_sqrt.c b/libf2c/libF77/z_sqrt.c new file mode 100644 index 00000000000..f5db5651991 --- /dev/null +++ b/libf2c/libF77/z_sqrt.c @@ -0,0 +1,33 @@ +#include "f2c.h" + +#ifdef KR_headers +double sqrt(), f__cabs(); +VOID z_sqrt(resx, z) doublecomplex *resx, *z; +#else +#undef abs +#include +extern double f__cabs(double, double); +void z_sqrt(doublecomplex *resx, doublecomplex *z) +#endif +{ +double mag; +doublecomplex res; + +if( (mag = f__cabs(z->r, z->i)) == 0.) + res.r = res.i = 0.; +else if(z->r > 0) + { + res.r = sqrt(0.5 * (mag + z->r) ); + res.i = z->i / res.r / 2; + } +else + { + res.i = sqrt(0.5 * (mag - z->r) ); + if(z->i < 0) + res.i = - res.i; + res.r = z->i / res.i / 2; + } + +resx->r = res.r; +resx->i = res.i; +} diff --git a/libf2c/libI77/Makefile.in b/libf2c/libI77/Makefile.in new file mode 100644 index 00000000000..ec6f6970985 --- /dev/null +++ b/libf2c/libI77/Makefile.in @@ -0,0 +1,119 @@ +# Makefile for GNU F77 compiler runtime. +# Copyright 1990 - 1994 by AT&T Bell Laboratories and Bellcore (see the +# file `Notice'). +# Portions of this file Copyright (C) 1995, 1996 Free Software Foundation, Inc. +# Contributed by Dave Love (d.love@dl.ac.uk). +# +#This file is part of GNU Fortran. +# +#GNU Fortran is free software; you can redistribute it and/or modify +#it under the terms of the GNU General Public License as published by +#the Free Software Foundation; either version 2, or (at your option) +#any later version. +# +#GNU Fortran is distributed in the hope that it will be useful, +#but WITHOUT ANY WARRANTY; without even the implied warranty of +#MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +#GNU General Public License for more details. +# +#You should have received a copy of the GNU General Public License +#along with GNU Fortran; see the file COPYING. If not, write to +#the Free Software Foundation, 59 Temple Place - Suite 330, Boston, MA +#02111-1307, USA. + +SHELL = /bin/sh + +srcdir = @srcdir@ +VPATH = @srcdir@ + +#### Start of system configuration section. #### + +CPPFLAGS = @CPPFLAGS@ +DEFS = @DEFS@ +# f2c.h should already be installed in xgcc's include directory but add that +# to -I anyhow in case not using xgcc. +ALL_CFLAGS = -I. -I$(srcdir) -I.. $(CPPFLAGS) $(DEFS) $(CFLAGS) +CROSS = @CROSS@ + +.SUFFIXES: +.SUFFIXES: .c .o + +.c.o: + $(CC) -c -DSkip_f2c_Undefs -DAllow_TYQUAD $(ALL_CFLAGS) $< + +OBJ = VersionI.o backspace.o close.o dfe.o dolio.o due.o endfile.o err.o \ + fmt.o fmtlib.o iio.o ilnw.o inquire.o lread.o lwrite.o open.o \ + rdfmt.o rewind.o rsfe.o rsli.o rsne.o sfe.o sue.o typesize.o uio.o \ + util.o wref.o wrtfmt.o wsfe.o wsle.o wsne.o xwsne.o \ + ftell_.o + +F2C_H = ../f2c.h + +all: $(OBJ) + +VersionI.o: Version.c + $(CC) -c $(CGFLAGS) -o $@ $(srcdir)/Version.c + +mostlyclean clean: + -rm -f $(OBJ) + +distclean maintainer-clean: mostlyclean + -rm -f stage? include Makefile + +backspace.o: fio.h +close.o: fio.h +dfe.o: fio.h +dfe.o: fmt.h +due.o: fio.h +endfile.o: fio.h rawio.h +err.o: fio.h rawio.h +fmt.o: fio.h +fmt.o: fmt.h +ftell_.o: fio.h +iio.o: fio.h +iio.o: fmt.h +ilnw.o: fio.h +ilnw.o: lio.h +inquire.o: fio.h +lread.o: fio.h +lread.o: fmt.h +lread.o: lio.h +lread.o: fp.h +lwrite.o: fio.h +lwrite.o: fmt.h +lwrite.o: lio.h +open.o: fio.h rawio.h +rdfmt.o: fio.h +rdfmt.o: fmt.h +rdfmt.o: fp.h +rewind.o: fio.h +rsfe.o: fio.h +rsfe.o: fmt.h +rsli.o: fio.h +rsli.o: lio.h +rsne.o: fio.h +rsne.o: lio.h +sfe.o: fio.h +sue.o: fio.h +uio.o: fio.h +util.o: fio.h +wref.o: fio.h +wref.o: fmt.h +wref.o: fp.h +wrtfmt.o: fio.h +wrtfmt.o: fmt.h +wsfe.o: fio.h +wsfe.o: fmt.h +wsle.o: fio.h +wsle.o: fmt.h +wsle.o: lio.h +wsne.o: fio.h +wsne.o: lio.h +xwsne.o: fio.h +xwsne.o: lio.h +xwsne.o: fmt.h + +# May be pessimistic: +$(OBJ): $(F2C_H) + +.PHONY: mostlyclean clean distclean maintainer-clean all diff --git a/libf2c/libI77/Notice b/libf2c/libI77/Notice new file mode 100644 index 00000000000..261b719bc57 --- /dev/null +++ b/libf2c/libI77/Notice @@ -0,0 +1,23 @@ +/**************************************************************** +Copyright 1990 - 1997 by AT&T, Lucent Technologies and Bellcore. + +Permission to use, copy, modify, and distribute this software +and its documentation for any purpose and without fee is hereby +granted, provided that the above copyright notice appear in all +copies and that both that the copyright notice and this +permission notice and warranty disclaimer appear in supporting +documentation, and that the names of AT&T, Bell Laboratories, +Lucent or Bellcore or any of their entities not be used in +advertising or publicity pertaining to distribution of the +software without specific, written prior permission. + +AT&T, Lucent and Bellcore disclaim all warranties with regard to +this software, including all implied warranties of +merchantability and fitness. In no event shall AT&T, Lucent or +Bellcore be liable for any special, indirect or consequential +damages or any damages whatsoever resulting from loss of use, +data or profits, whether in an action of contract, negligence or +other tortious action, arising out of or in connection with the +use or performance of this software. +****************************************************************/ + diff --git a/libf2c/libI77/README.netlib b/libf2c/libI77/README.netlib new file mode 100644 index 00000000000..30dd5b5223d --- /dev/null +++ b/libf2c/libI77/README.netlib @@ -0,0 +1,225 @@ +If your compiler does not recognize ANSI C headers, +compile with KR_headers defined: either add -DKR_headers +to the definition of CFLAGS in the makefile, or insert + +#define KR_headers + +at the top of f2c.h and fmtlib.c . + + +If you have a really ancient K&R C compiler that does not understand +void, add -Dvoid=int to the definition of CFLAGS in the makefile. + +If you use a C++ compiler, first create a local f2c.h by appending +f2ch.add to the usual f2c.h, e.g., by issuing the command + make f2c.h +which assumes f2c.h is installed in /usr/include . + +If your system lacks /usr/include/fcntl.h , then you +should simply create an empty fcntl.h in this directory. +If your compiler then complains about creat and open not +having a prototype, compile with OPEN_DECL defined. +On many systems, open and creat are declared in fcntl.h . + +If your system has /usr/include/fcntl.h, you may need to add +-D_POSIX_SOURCE to the makefile's definition of CFLAGS. + +If your system's sprintf does not work the way ANSI C +specifies -- specifically, if it does not return the +number of characters transmitted -- then insert the line + +#define USE_STRLEN + +at the end of fmt.h . This is necessary with +at least some versions of Sun and DEC software. +In particular, if you get a warning about an improper +pointer/integer combination in compiling wref.c, then +you need to compile with -DUSE_STRLEN . + +If your system's fopen does not like the ANSI binary +reading and writing modes "rb" and "wb", then you should +compile open.c with NON_ANSI_RW_MODES #defined. + +If you get error messages about references to cf->_ptr +and cf->_base when compiling wrtfmt.c and wsfe.c or to +stderr->_flag when compiling err.c, then insert the line + +#define NON_UNIX_STDIO + +at the beginning of fio.h, and recompile everything (or +at least those modules that contain NON_UNIX_STDIO). + +Unformatted sequential records consist of a length of record +contents, the record contents themselves, and the length of +record contents again (for backspace). Prior to 17 Oct. 1991, +the length was of type int; now it is of type long, but you +can change it back to int by inserting + +#define UIOLEN_int + +at the beginning of fio.h. This affects only sue.c and uio.c . + +On VAX, Cray, or Research Tenth-Edition Unix systems, you may +need to add -DVAX, -DCRAY, or -DV10 (respectively) to CFLAGS +to make fp.h work correctly. Alternatively, you may need to +edit fp.h to suit your machine. + +You may need to supply the following non-ANSI routines: + + fstat(int fileds, struct stat *buf) is similar +to stat(char *name, struct stat *buf), except that +the first argument, fileds, is the file descriptor +returned by open rather than the name of the file. +fstat is used in the system-dependent routine +canseek (in the libI77 source file err.c), which +is supposed to return 1 if it's possible to issue +seeks on the file in question, 0 if it's not; you may +need to suitably modify err.c . On non-UNIX systems, +you can avoid references to fstat and stat by compiling +with NON_UNIX_STDIO defined; in that case, you may need +to supply access(char *Name,0), which is supposed to +return 0 if file Name exists, nonzero otherwise. + + char * mktemp(char *buf) is supposed to replace the +6 trailing X's in buf with a unique number and then +return buf. The idea is to get a unique name for +a temporary file. + +On non-UNIX systems, you may need to change a few other, +e.g.: the form of name computed by mktemp() in endfile.c and +open.c; the use of the open(), close(), and creat() system +calls in endfile.c, err.c, open.c; and the modes in calls on +fopen() and fdopen() (and perhaps the use of fdopen() itself +-- it's supposed to return a FILE* corresponding to a given +an integer file descriptor) in err.c and open.c (component ufmt +of struct unit is 1 for formatted I/O -- text mode on some systems +-- and 0 for unformatted I/O -- binary mode on some systems). +Compiling with -DNON_UNIX_STDIO omits all references to creat() +and almost all references to open() and close(), the exception +being in the function f__isdev() (in open.c). + +For MS-DOS, compile all of libI77 with -DMSDOS (which implies +-DNON_UNIX_STDIO). You may need to make other compiler-dependent +adjustments; for example, for Turbo C++ you need to adjust the mktemp +invocations and to #undef ungetc in lread.c and rsne.c . + +If you want to be able to load against libI77 but not libF77, +then you will need to add sig_die.o (from libF77) to libI77. + +If you wish to use translated Fortran that has funny notions +of record length for direct unformatted I/O (i.e., that assumes +RECL= values in OPEN statements are not bytes but rather counts +of some other units -- e.g., 4-character words for VMS), then you +should insert an appropriate #define for url_Adjust at the +beginning of open.c . For VMS Fortran, for example, +#define url_Adjust(x) x *= 4 +would suffice. + +To check for transmission errors, issue the command + make check +This assumes you have the xsum program whose source, xsum.c, +is distributed as part of "all from f2c/src". If you do not +have xsum, you can obtain xsum.c by sending the following E-mail +message to netlib@netlib.bell-labs.com + send xsum.c from f2c/src + +The makefile assumes you have installed f2c.h in a standard +place (and does not cause recompilation when f2c.h is changed); +f2c.h comes with "all from f2c" (the source for f2c) and is +available separately ("f2c.h from f2c"). + +By default, Fortran I/O units 5, 6, and 0 are pre-connected to +stdin, stdout, and stderr, respectively. You can change this +behavior by changing f_init() in err.c to suit your needs. +Note that f2c assumes READ(*... means READ(5... and WRITE(*... +means WRITE(6... . Moreover, an OPEN(n,... statement that does +not specify a file name (and does not specify STATUS='SCRATCH') +assumes FILE='fort.n' . You can change this by editing open.c +and endfile.c suitably. + +Unless you adjust the "#define MXUNIT" line in fio.h, Fortran units +0, 1, ..., 99 are available, i.e., the highest allowed unit number +is MXUNIT - 1. + +Lines protected from compilation by #ifdef Allow_TYQUAD +are for a possible extension to 64-bit integers in which +integer = int = 32 bits and longint = long = 64 bits. + +Extensions (Feb. 1993) to NAMELIST processing: + 1. Reading a ? instead of &name (the start of a namelist) causes +the namelist being sought to be written to stdout (unit 6); +to omit this feature, compile rsne.c with -DNo_Namelist_Questions. + 2. Reading the wrong namelist name now leads to an error message +and an attempt to skip input until the right namelist name is found; +to omit this feature, compile rsne.c with -DNo_Bad_Namelist_Skip. + 3. Namelist writes now insert newlines before each variable; to omit +this feature, compile xwsne.c with -DNo_Extra_Namelist_Newlines. + 4. (Sept. 1995) When looking for the &name that starts namelist +input, lines whose first non-blank character is something other +than &, $, or ? are treated as comment lines and ignored, unless +rsne.c is compiled with -DNo_Namelist_Comments. + +Nonstandard extension (Feb. 1993) to open: for sequential files, +ACCESS='APPEND' (or access='anything else starting with "A" or "a"') +causes the file to be positioned at end-of-file, so a write will +append to the file. + +Some buggy Fortran programs use unformatted direct I/O to write +an incomplete record and later read more from that record than +they have written. For records other than the last, the unwritten +portion of the record reads as binary zeros. The last record is +a special case: attempting to read more from it than was written +gives end-of-file -- which may help one find a bug. Some other +Fortran I/O libraries treat the last record no differently than +others and thus give no help in finding the bug of reading more +than was written. If you wish to have this behavior, compile +uio.c with -DPad_UDread . + +If you want to be able to catch write failures (e.g., due to a +disk being full) with an ERR= specifier, compile dfe.c, due.c, +sfe.c, sue.c, and wsle.c with -DALWAYS_FLUSH. This will lead to +slower execution and more I/O, but should make ERR= work as +expected, provided fflush returns an error return when its +physical write fails. + +Carriage controls are meant to be interpreted by the UNIX col +program (or a similar program). Sometimes it's convenient to use +only ' ' as the carriage control character (normal single spacing). +If you compile lwrite.c and wsfe.c with -DOMIT_BLANK_CC, formatted +external output lines will have an initial ' ' quietly omitted, +making use of the col program unnecessary with output that only +has ' ' for carriage control. + +The Fortran 77 Standard leaves it up to the implementation whether +formatted writes of floating-point numbers of absolute value < 1 have +a zero before the decimal point. By default, libI77 omits such +superfluous zeros, but you can cause them to appear by compiling +lwrite.c, wref.c, and wrtfmt.c with -DWANT_LEAD_0 . + +If your system lacks a ranlib command, you don't need it. +Either comment out the makefile's ranlib invocation, or install +a harmless "ranlib" command somewhere in your PATH, such as the +one-line shell script + + exit 0 + +or (on some systems) + + exec /usr/bin/ar lts $1 >/dev/null + +Most of the routines in libI77 are support routines for Fortran +I/O. There are a few exceptions, summarized below -- I/O related +functions and subroutines that appear to your program as ordinary +external Fortran routines. + +1. CALL FLUSH flushes all buffers. + +2. FTELL(i) is an INTEGER function that returns the current + offset of Fortran unit i (or -1 if unit i is not open). + +3. CALL FSEEK(i, offset, whence, *errlab) attemps to move + Fortran unit i to the specified offset: absolute offset + if whence = 0; relative to the current offset if whence = 1; + relative to the end of the file if whence = 2. It branches + to label errlab if unit i is not open or if the call + otherwise fails. diff --git a/libf2c/libI77/Version.c b/libf2c/libI77/Version.c new file mode 100644 index 00000000000..d80ea39de8d --- /dev/null +++ b/libf2c/libI77/Version.c @@ -0,0 +1,284 @@ +static char junk[] = "\n@(#) LIBI77 VERSION pjw,dmg-mods 19970916\n"; + +/* +*/ + +char __G77_LIBI77_VERSION__[] = "0.5.22-19970930"; + +/* +2.01 $ format added +2.02 Coding bug in open.c repaired +2.03 fixed bugs in lread.c (read * with negative f-format) and lio.c + and lio.h (e-format conforming to spec) +2.04 changed open.c and err.c (fopen and freopen respectively) to + update to new c-library (append mode) +2.05 added namelist capability +2.06 allow internal list and namelist I/O +*/ + +/* +close.c: + allow upper-case STATUS= values +endfile.c + create fort.nnn if unit nnn not open; + else if (file length == 0) use creat() rather than copy; + use local copy() rather than forking /bin/cp; + rewind, fseek to clear buffer (for no reading past EOF) +err.c + use neither setbuf nor setvbuf; make stderr buffered +fio.h + #define _bufend +inquire.c + upper case responses; + omit byfile test from SEQUENTIAL= + answer "YES" to DIRECT= for unopened file (open to debate) +lio.c + flush stderr, stdout at end of each stmt + space before character strings in list output only at line start +lio.h + adjust LEW, LED consistent with old libI77 +lread.c + use atof() + allow "nnn*," when reading complex constants +open.c + try opening for writing when open for read fails, with + special uwrt value (2) delaying creat() to first write; + set curunit so error messages don't drop core; + no file name ==> fort.nnn except for STATUS='SCRATCH' +rdfmt.c + use atof(); trust EOF == end-of-file (so don't read past + end-of-file after endfile stmt) +sfe.c + flush stderr, stdout at end of each stmt +wrtfmt.c: + use upper case + put wrt_E and wrt_F into wref.c, use sprintf() + rather than ecvt() and fcvt() [more accurate on VAX] +*/ + +/* 16 Oct. 1988: uwrt = 3 after write, rewind, so close won't zap the file. */ + +/* 10 July 1989: change _bufend to buf_end in fio.h, wsfe.c, wrtfmt.c */ + +/* 28 Nov. 1989: corrections for IEEE and Cray arithmetic */ +/* 29 Nov. 1989: change various int return types to long for f2c */ +/* 30 Nov. 1989: various types from f2c.h */ +/* 6 Dec. 1989: types corrected various places */ +/* 19 Dec. 1989: make iostat= work right for internal I/O */ +/* 8 Jan. 1990: add rsne, wsne -- routines for handling NAMELIST */ +/* 28 Jan. 1990: have NAMELIST read treat $ as &, general white + space as blank */ +/* 27 Mar. 1990: change an = to == in rd_L(rdfmt.c) so formatted reads + of logical values reject letters other than fFtT; + have nowwriting reset cf */ +/* 14 Aug. 1990: adjust lread.c to treat tabs as spaces in list input */ +/* 17 Aug. 1990: adjust open.c to recognize blank='Z...' as well as + blank='z...' when reopening an open file */ +/* 30 Aug. 1990: prevent embedded blanks in list output of complex values; + omit exponent field in list output of values of + magnitude between 10 and 1e8; prevent writing stdin + and reading stdout or stderr; don't close stdin, stdout, + or stderr when reopening units 5, 6, 0. */ +/* 18 Sep. 1990: add component udev to unit and consider old == new file + iff uinode and udev values agree; use stat rather than + access to check existence of file (when STATUS='OLD')*/ +/* 2 Oct. 1990: adjust rewind.c so two successive rewinds after a write + don't clobber the file. */ +/* 9 Oct. 1990: add #include "fcntl.h" to endfile.c, err.c, open.c; + adjust g_char in util.c for segmented memories. */ +/* 17 Oct. 1990: replace abort() and _cleanup() with calls on + sig_die(...,1) (defined in main.c). */ +/* 5 Nov. 1990: changes to open.c: complain if new= is specified and the + file already exists; allow file= to be omitted in open stmts + and allow status='replace' (Fortran 90 extensions). */ +/* 11 Dec. 1990: adjustments for POSIX. */ +/* 15 Jan. 1991: tweak i_ungetc in rsli.c to allow reading from + strings in read-only memory. */ +/* 25 Apr. 1991: adjust namelist stuff to work with f2c -i2 */ +/* 26 Apr. 1991: fix some bugs with NAMELIST read of multi-dim. arrays */ +/* 16 May 1991: increase LEFBL in lio.h to bypass NeXT bug */ +/* 17 Oct. 1991: change type of length field in sequential unformatted + records from int to long (for systems where sizeof(int) + can vary, depending on the compiler or compiler options). */ +/* 14 Nov. 1991: change uint to Uint in fmt.h, rdfmt.c, wrtfmt.c. */ +/* 25 Nov. 1991: change uint to Uint in lwrite.c; change sizeof(int) to + sizeof(uioint) in fseeks in sue.c (missed on 17 Oct.). */ +/* 1 Dec. 1991: uio.c: add test for read failure (seq. unformatted reads); + adjust an error return from EOF to off end of record */ +/* 12 Dec. 1991: rsli.c: fix bug with internal list input that caused + the last character of each record to be ignored. + iio.c: adjust error message in internal formatted + input from "end-of-file" to "off end of record" if + the format specifies more characters than the + record contains. */ +/* 17 Jan. 1992: lread.c, rsne.c: in list and namelist input, + treat "r* ," and "r*," alike (where r is a + positive integer constant), and fix a bug in + handling null values following items with repeat + counts (e.g., 2*1,,3); for namelist reading + of a numeric array, allow a new name-value subsequence + to terminate the current one (as though the current + one ended with the right number of null values). + lio.h, lwrite.c: omit insignificant zeros in + list and namelist output. To get the old + behavior, compile with -DOld_list_output . */ +/* 18 Jan. 1992: make list output consistent with F format by + printing .1 rather than 0.1 (introduced yesterday). */ +/* 3 Feb. 1992: rsne.c: fix namelist read bug that caused the + character following a comma to be ignored. */ +/* 19 May 1992: adjust iio.c, ilnw.c, rdfmt.c and rsli.c to make err= + work with internal list and formatted I/O. */ +/* 18 July 1992: adjust rsne.c to allow namelist input to stop at + an & (e.g. &end). */ +/* 23 July 1992: switch to ANSI prototypes unless KR_headers is #defined ; + recognize Z format (assuming 8-bit bytes). */ +/* 14 Aug. 1992: tweak wrt_E in wref.c to avoid -NaN */ +/* 23 Oct. 1992: Supply missing l_eof = 0 assignment to s_rsne() in rsne.c + (so end-of-file on other files won't confuse namelist + reads of external files). Prepend f__ to external + names that are only of internal interest to lib[FI]77. */ +/* 1 Feb. 1993: backspace.c: fix bug that bit when last char of 2nd + buffer == '\n'. + endfile.c: guard against tiny L_tmpnam; close and reopen + files in t_runc(). + lio.h: lengthen LINTW (buffer size in lwrite.c). + err.c, open.c: more prepending of f__ (to [rw]_mode). */ +/* 5 Feb. 1993: tweaks to NAMELIST: rsne.c: ? prints the namelist being + sought; namelists of the wrong name are skipped (after + an error message; xwsne.c: namelist writes have a + newline before each new variable. + open.c: ACCESS='APPEND' positions sequential files + at EOF (nonstandard extension -- that doesn't require + changing data structures). */ +/* 9 Feb. 1993: Change some #ifdef MSDOS lines to #ifdef NON_UNIX_STDIO. + err.c: under NON_UNIX_STDIO, avoid close(creat(name,0666)) + when the unit has another file descriptor for name. */ +/* 4 March 1993: err.c, open.c: take declaration of fdopen from rawio.h; + open.c: always give f__w_mode[] 4 elements for use + in t_runc (in endfile.c -- for change of 1 Feb. 1993). */ +/* 6 March 1993: uio.c: adjust off-end-of-record test for sequential + unformatted reads to respond to err= rather than end=. */ +/* 12 March 1993: various tweaks for C++ */ +/* 6 April 1993: adjust error returns for formatted inputs to flush + the current input line when err=label is specified. + To restore the old behavior (input left mid-line), + either adjust the #definition of errfl in fio.h or + omit the invocation of f__doend in err__fl (in err.c). */ +/* 23 June 1993: iio.c: fix bug in format reversions for internal writes. */ +/* 5 Aug. 1993: lread.c: fix bug in handling repetition counts for + logical data (during list or namelist input). + Change struct f__syl to struct syl (for buggy compilers). */ +/* 7 Aug. 1993: lread.c: fix bug in namelist reading of incomplete + logical arrays. */ +/* 9 Aug. 1993: lread.c: fix bug in namelist reading of an incomplete + array of numeric data followed by another namelist + item whose name starts with 'd', 'D', 'e', or 'E'. */ +/* 8 Sept. 1993: open.c: protect #include "sys/..." with + #ifndef NON_UNIX_STDIO; Version date not changed. */ +/* 10 Nov. 1993: backspace.c: add nonsense for #ifdef MSDOS */ +/* 8 Dec. 1993: iio.c: adjust internal formatted reads to treat + short records as though padded with blanks + (rather than causing an "off end of record" error). */ +/* 22 Feb. 1994: lread.c: check that realloc did not return NULL. */ +/* 6 June 1994: Under NON_UNIX_STDIO, use binary mode for direct + formatted files (avoiding any confusion regarding \n). */ +/* 5 July 1994: Fix bug (introduced 6 June 1994?) in reopening files + under NON_UNIX_STDIO. */ +/* 6 July 1994: wref.c: protect with #ifdef GOOD_SPRINTF_EXPONENT an + optimization that requires exponents to have 2 digits + when 2 digits suffice. + lwrite.c wsfe.c (list and formatted external output): + omit ' ' carriage-control when compiled with + -DOMIT_BLANK_CC . Off-by-one bug fixed in character + count for list output of character strings. + Omit '.' in list-directed printing of Nan, Infinity. */ +/* 12 July 1994: wrtfmt.c: under G11.4, write 0. as " .0000 " rather + than " .0000E+00". */ +/* 3 Aug. 1994: lwrite.c: do not insert a newline when appending an + oversize item to an empty line. */ +/* 12 Aug. 1994: rsli.c rsne.c: fix glitch (reset nml_read) that kept + ERR= (in list- or format-directed input) from working + after a NAMELIST READ. */ +/* 7 Sept. 1994: typesize.c: adjust to allow types LOGICAL*1, LOGICAL*2, + INTEGER*1, and (under -DAllow_TYQUAD) INTEGER*8 + in NAMELISTs. */ +/* 6 Oct. 1994: util.c: omit f__mvgbt, as it is never used. */ +/* 2 Nov. 1994: add #ifdef ALWAYS_FLUSH logic. */ +/* 26 Jan. 1995: wref.c: fix glitch in printing the exponent of 0 when + GOOD_SPRINTF_EXPONENT is not #defined. */ +/* 24 Feb. 1995: iio.c: z_getc: insert (unsigned char *) to allow + internal reading of characters with high-bit set + (on machines that sign-extend characters). */ +/* 14 March 1995:lread.c and rsfe.c: adjust s_rsle and s_rsfe to + check for end-of-file (to prevent infinite loops + with empty read statements). */ +/* 26 May 1995: iio.c: z_wnew: fix bug in handling T format items + in internal writes whose last item is written to + an earlier position than some previous item. */ +/* 29 Aug. 1995: backspace.c: adjust MSDOS logic. */ +/* 6 Sept. 1995: Adjust namelist input to treat a subscripted name + whose subscripts do not involve colons similarly + to the name without a subscript: accept several + values, stored in successive elements starting at + the indicated subscript. Adjust namelist output + to quote character strings (avoiding confusion with + arrays of character strings). Adjust f_init calls + for people who don't use libF77's main(); now open and + namelist read statements invoke f_init if needed. */ +/* 7 Sept. 1995: Fix some bugs with -DAllow_TYQUAD (for integer*8). + Add -DNo_Namelist_Comments lines to rsne.c. */ +/* 5 Oct. 1995: wrtfmt.c: fix bug with t editing (f__cursor was not + always zeroed in mv_cur). */ +/* 11 Oct. 1995: move defs of f__hiwater, f__svic, f__icptr from wrtfmt.c + to err.c */ +/* 15 Mar. 1996: lread.c, rsfe.c: honor END= in READ stmt with empty iolist */ + +/* 13 May 1996: add ftell_.c and fseek_.c */ +/* 9 June 1996: Adjust rsli.c and lread.c so internal list input with + too few items in the input string will honor end= . */ +/* 12 Sept. 1995:fmtlib.c: fix glitch in printing the most negative integer. */ +/* 25 Sept. 1995:fmt.h: for formatted writes of negative integer*1 values, + make ic signed on ANSI systems. If formatted writes of + integer*1 values trouble you when using a K&R C compiler, + switch to an ANSI compiler or use a compiler flag that + makes characters signed. */ +/* 9 Dec. 1996: d[fu]e.c, err.c: complain about non-positive rec= + in direct read and write statements. + ftell_.c: change param "unit" to "Unit" for -DKR_headers. */ +/* 26 Feb. 1997: ftell_.c: on systems that define SEEK_SET, etc., use + SEEK_SET, SEEK_CUR, SEEK_END for *whence = 0, 1, 2. */ +/* 7 Apr. 1997: fmt.c: adjust to complain at missing numbers in formats + (but still treat missing ".nnn" as ".0"). */ +/* 11 Apr. 1997: err.c: attempt to make stderr line buffered rather + than fully buffered. (Buffering is needed for format + items T and TR.) */ +/* 27 May 1997: ftell_.c: fix typo (that caused the third argument to be + treated as 2 on some systems). */ +/* 5 Aug. 1997: lread.c: adjust to accord with a change to the Fortran 8X + draft (in 1990 or 1991) that rescinded permission to elide + quote marks in namelist input of character data; compile + with -DF8X_NML_ELIDE_QUOTES to get the old behavior. + wrtfmt.o: wrt_G: tweak to print the right number of 0's + for zero under G format. */ +/* 16 Aug. 1997: iio.c: fix bug in internal writes to an array of character + strings that sometimes caused one more array element than + required by the format to be blank-filled. Example: + format(1x). */ +/* 16 Sept. 1997:fmt.[ch] rdfmt.c wrtfmt.c: tweak struct syl for machines + with 64-bit pointers and 32-bit ints that did not 64-bit + align struct syl (e.g., Linux on the DEC Alpha). */ + + + +/* Changes for GNU Fortran (g77) version of libf2c: */ + +/* 17 June 1997: detect recursive I/O and call f__fatal explaining it. */ + +#include + +void +g77__ivers__ () +{ + fprintf (stderr, "__G77_LIBI77_VERSION__: %s", __G77_LIBI77_VERSION__); + fputs (junk, stderr); +} diff --git a/libf2c/libI77/backspace.c b/libf2c/libI77/backspace.c new file mode 100644 index 00000000000..b806d1ec49d --- /dev/null +++ b/libf2c/libI77/backspace.c @@ -0,0 +1,102 @@ +#include +#include "f2c.h" +#include "fio.h" +#ifdef KR_headers +integer f_back(a) alist *a; +#else +integer f_back(alist *a) +#endif +{ unit *b; + int i, ndec; + uiolen n; +#if defined (MSDOS) && !defined (GO32) + int j, k; + long w, z; +#endif + long x, y; + char buf[32]; + if (f__init & 2) + f__fatal (131, "I/O recursion"); + if(a->aunit >= MXUNIT || a->aunit < 0) + err(a->aerr,101,"backspace"); + b= &f__units[a->aunit]; + if(b->useek==0) err(a->aerr,106,"backspace"); + if(b->ufd==NULL) { + fk_open(1, 1, a->aunit); + return(0); + } + if(b->uend==1) + { b->uend=0; + return(0); + } + if(b->uwrt) { + (void) t_runc(a); + if (f__nowreading(b)) + err(a->aerr,errno,"backspace"); + } + if(b->url>0) + { + x=ftell(b->ufd); + y = x % b->url; + if(y == 0) x--; + x /= b->url; + x *= b->url; + (void) fseek(b->ufd,x,SEEK_SET); + return(0); + } + + if(b->ufmt==0) + { (void) fseek(b->ufd,-(long)sizeof(uiolen),SEEK_CUR); + (void) fread((char *)&n,sizeof(uiolen),1,b->ufd); + (void) fseek(b->ufd,-(long)n-2*sizeof(uiolen),SEEK_CUR); + return(0); + } +#if defined (MSDOS) && !defined (GO32) + w = -1; +#endif + for(ndec = 1;; ndec = 0) + { + y = x = ftell(b->ufd); + if(x < sizeof(buf)) + x = 0; + else + x -= sizeof(buf); + (void) fseek(b->ufd,x,SEEK_SET); + n=fread(buf,1,(size_t)(y-x), b->ufd); + for(i = n - ndec; --i >= 0; ) + { + if(buf[i]!='\n') continue; +#if defined (MSDOS) && !defined (GO32) + for(j = k = 0; j <= i; j++) + if (buf[j] == '\n') + k++; + fseek(b->ufd,x,SEEK_SET); + for(;;) + if (getc(b->ufd) == '\n') { + if ((z = ftell(b->ufd)) >= y && ndec) { + if (w == -1) + goto break2; + break; + } + if (--k <= 0) + return 0; + w = z; + } + fseek(b->ufd, w, SEEK_SET); +#else + fseek(b->ufd,(long)(i+1-n),SEEK_CUR); +#endif + return(0); + } +#if defined (MSDOS) && !defined (GO32) + break2: +#endif + if(x==0) + { + (void) fseek(b->ufd, 0L, SEEK_SET); + return(0); + } + else if(n<=0) err(a->aerr,(EOF),"backspace"); + (void) fseek(b->ufd, x, SEEK_SET); + } +} diff --git a/libf2c/libI77/close.c b/libf2c/libI77/close.c new file mode 100644 index 00000000000..93e9198ed0b --- /dev/null +++ b/libf2c/libI77/close.c @@ -0,0 +1,103 @@ +#include "f2c.h" +#include "fio.h" +#ifdef KR_headers +integer f_clos(a) cllist *a; +#else +#undef abs +#undef min +#undef max +#include +#ifdef NON_UNIX_STDIO +#ifndef unlink +#define unlink remove +#endif +#else +#if defined (MSDOS) && !defined (GO32) +#include "io.h" +#else +#ifdef __cplusplus +extern "C" int unlink(const char*); +#else +extern int unlink(const char*); +#endif +#endif +#endif + +integer f_clos(cllist *a) +#endif +{ unit *b; + + if (f__init & 2) + f__fatal (131, "I/O recursion"); + if(a->cunit >= MXUNIT) return(0); + b= &f__units[a->cunit]; + if(b->ufd==NULL) + goto done; + if (!a->csta) + if (b->uscrtch == 1) + goto Delete; + else + goto Keep; + switch(*a->csta) { + default: + Keep: + case 'k': + case 'K': + if(b->uwrt == 1) + t_runc((alist *)a); + if(b->ufnm) { + fclose(b->ufd); + free(b->ufnm); + } + break; + case 'd': + case 'D': + Delete: + if(b->ufnm) { + fclose(b->ufd); + unlink(b->ufnm); /*SYSDEP*/ + free(b->ufnm); + } + } + b->ufd=NULL; + done: + b->uend=0; + b->ufnm=NULL; + return(0); + } + void +#ifdef KR_headers +f_exit() +#else +f_exit(void) +#endif +{ int i; + static cllist xx; + if (! (f__init & 1)) + return; /* Not initialized, so no open units. */ + /* no more I/O to be done. If this is not done, then if the + program is interrupted during I/O, f_clos thinks, incorrectly, + that there is an I/O recursion. */ + f__init &= ~2; + if (!xx.cerr) { + xx.cerr=1; + xx.csta=NULL; + for(i=0;iuend || f__curunit->url <= f__recpos + || f__curunit->url == 1) return 0; + do { + getc(f__cf); + } while(++f__recpos < f__curunit->url); + return 0; +} +y_getc(Void) +{ + int ch; + if(f__curunit->uend) return(-1); + if((ch=getc(f__cf))!=EOF) + { + f__recpos++; + if(f__curunit->url>=f__recpos || + f__curunit->url==1) + return(ch); + else return(' '); + } + if(feof(f__cf)) + { + f__curunit->uend=1; + errno=0; + return(-1); + } + err(f__elist->cierr,errno,"readingd"); +} +#ifdef KR_headers +y_putc(c) +#else +y_putc(int c) +#endif +{ + f__recpos++; + if(f__recpos <= f__curunit->url || f__curunit->url==1) + putc(c,f__cf); + else + err(f__elist->cierr,110,"dout"); + return(0); +} +y_rev(Void) +{ /*what about work done?*/ + if(f__curunit->url==1 || f__recpos==f__curunit->url) + return(0); + while(f__recposurl) + (*f__putn)(' '); + f__recpos=0; + return(0); +} +y_err(Void) +{ + err(f__elist->cierr, 110, "dfe"); +} + +y_newrec(Void) +{ + if(f__curunit->url == 1 || f__recpos == f__curunit->url) { + f__hiwater = f__recpos = f__cursor = 0; + return(1); + } + if(f__hiwater > f__recpos) + f__recpos = f__hiwater; + y_rev(); + f__hiwater = f__cursor = 0; + return(1); +} + +#ifdef KR_headers +c_dfe(a) cilist *a; +#else +c_dfe(cilist *a) +#endif +{ + f__sequential=0; + f__formatted=f__external=1; + f__elist=a; + f__cursor=f__scale=f__recpos=0; + if(a->ciunit>MXUNIT || a->ciunit<0) + err(a->cierr,101,"startchk"); + f__curunit = &f__units[a->ciunit]; + if(f__curunit->ufd==NULL && fk_open(DIR,FMT,a->ciunit)) + err(a->cierr,104,"dfe"); + f__cf=f__curunit->ufd; + if(!f__curunit->ufmt) err(a->cierr,102,"dfe"); + if(!f__curunit->useek) err(a->cierr,104,"dfe"); + f__fmtbuf=a->cifmt; + if(a->cirec <= 0) + err(a->cierr,130,"dfe"); + (void) fseek(f__cf,(long)f__curunit->url * (a->cirec-1),SEEK_SET); + f__curunit->uend = 0; + return(0); +} +#ifdef KR_headers +integer s_rdfe(a) cilist *a; +#else +integer s_rdfe(cilist *a) +#endif +{ + int n; + if(f__init != 1) f_init(); + f__init = 3; + f__reading=1; + if(n=c_dfe(a))return(n); + if(f__curunit->uwrt && f__nowreading(f__curunit)) + err(a->cierr,errno,"read start"); + f__getn = y_getc; + f__doed = rd_ed; + f__doned = rd_ned; + f__dorevert = f__donewrec = y_err; + f__doend = y_rsk; + if(pars_f(f__fmtbuf)<0) + err(a->cierr,100,"read start"); + fmt_bg(); + return(0); +} +#ifdef KR_headers +integer s_wdfe(a) cilist *a; +#else +integer s_wdfe(cilist *a) +#endif +{ + int n; + if(f__init != 1) f_init(); + f__init = 3; + f__reading=0; + if(n=c_dfe(a)) return(n); + if(f__curunit->uwrt != 1 && f__nowwriting(f__curunit)) + err(a->cierr,errno,"startwrt"); + f__putn = y_putc; + f__doed = w_ed; + f__doned= w_ned; + f__dorevert = y_err; + f__donewrec = y_newrec; + f__doend = y_rev; + if(pars_f(f__fmtbuf)<0) + err(a->cierr,100,"startwrt"); + fmt_bg(); + return(0); +} +integer e_rdfe(Void) +{ + f__init = 1; + (void) en_fio(); + return(0); +} +integer e_wdfe(Void) +{ + f__init = 1; + return en_fio(); +} diff --git a/libf2c/libI77/dolio.c b/libf2c/libI77/dolio.c new file mode 100644 index 00000000000..4b5a2ca6588 --- /dev/null +++ b/libf2c/libI77/dolio.c @@ -0,0 +1,20 @@ +#include "f2c.h" + +#ifdef __cplusplus +extern "C" { +#endif +#ifdef KR_headers +extern int (*f__lioproc)(); + +integer do_lio(type,number,ptr,len) ftnint *number,*type; char *ptr; ftnlen len; +#else +extern int (*f__lioproc)(ftnint*, char*, ftnlen, ftnint); + +integer do_lio(ftnint *type, ftnint *number, char *ptr, ftnlen len) +#endif +{ + return((*f__lioproc)(number,ptr,len,*type)); +} +#ifdef __cplusplus + } +#endif diff --git a/libf2c/libI77/due.c b/libf2c/libI77/due.c new file mode 100644 index 00000000000..dec58657b50 --- /dev/null +++ b/libf2c/libI77/due.c @@ -0,0 +1,73 @@ +#include "f2c.h" +#include "fio.h" + +#ifdef KR_headers +c_due(a) cilist *a; +#else +c_due(cilist *a) +#endif +{ + if(f__init != 1) f_init(); + f__init = 3; + if(a->ciunit>=MXUNIT || a->ciunit<0) + err(a->cierr,101,"startio"); + f__sequential=f__formatted=f__recpos=0; + f__external=1; + f__curunit = &f__units[a->ciunit]; + f__elist=a; + if(f__curunit->ufd==NULL && fk_open(DIR,UNF,a->ciunit) ) err(a->cierr,104,"due"); + f__cf=f__curunit->ufd; + if(f__curunit->ufmt) err(a->cierr,102,"cdue"); + if(!f__curunit->useek) err(a->cierr,104,"cdue"); + if(f__curunit->ufd==NULL) err(a->cierr,114,"cdue"); + if(a->cirec <= 0) + err(a->cierr,130,"due"); + (void) fseek(f__cf,(long)(a->cirec-1)*f__curunit->url,SEEK_SET); + f__curunit->uend = 0; + return(0); +} +#ifdef KR_headers +integer s_rdue(a) cilist *a; +#else +integer s_rdue(cilist *a) +#endif +{ + int n; + f__reading=1; + if(n=c_due(a)) return(n); + if(f__curunit->uwrt && f__nowreading(f__curunit)) + err(a->cierr,errno,"read start"); + return(0); +} +#ifdef KR_headers +integer s_wdue(a) cilist *a; +#else +integer s_wdue(cilist *a) +#endif +{ + int n; + f__reading=0; + if(n=c_due(a)) return(n); + if(f__curunit->uwrt != 1 && f__nowwriting(f__curunit)) + err(a->cierr,errno,"write start"); + return(0); +} +integer e_rdue(Void) +{ + f__init = 1; + if(f__curunit->url==1 || f__recpos==f__curunit->url) + return(0); + (void) fseek(f__cf,(long)(f__curunit->url-f__recpos),SEEK_CUR); + if(ftell(f__cf)%f__curunit->url) + err(f__elist->cierr,200,"syserr"); + return(0); +} +integer e_wdue(Void) +{ + f__init = 1; +#ifdef ALWAYS_FLUSH + if (fflush(f__cf)) + err(f__elist->cierr,errno,"write end"); +#endif + return(e_rdue()); +} diff --git a/libf2c/libI77/endfile.c b/libf2c/libI77/endfile.c new file mode 100644 index 00000000000..6050d1e3b30 --- /dev/null +++ b/libf2c/libI77/endfile.c @@ -0,0 +1,195 @@ +#include "f2c.h" +#include "fio.h" +#include +#include "rawio.h" + +#ifdef KR_headers +extern char *strcpy(); +#else +#undef abs +#undef min +#undef max +#include +#include +#endif + +#ifdef NON_UNIX_STDIO +#ifndef unlink +#define unlink remove +#endif +#else +#if defined (MSDOS) && !defined (GO32) +#include "io.h" +#endif +#endif + +#ifdef NON_UNIX_STDIO +extern char *f__r_mode[], *f__w_mode[]; +#endif + +#ifdef KR_headers +integer f_end(a) alist *a; +#else +integer f_end(alist *a) +#endif +{ + unit *b; + if (f__init & 2) + f__fatal (131, "I/O recursion"); + if(a->aunit>=MXUNIT || a->aunit<0) err(a->aerr,101,"endfile"); + b = &f__units[a->aunit]; + if(b->ufd==NULL) { + char nbuf[10]; + (void) sprintf(nbuf,"fort.%ld",a->aunit); +#ifdef NON_UNIX_STDIO + { FILE *tf; + if (tf = fopen(nbuf, f__w_mode[0])) + fclose(tf); + } +#else + close(creat(nbuf, 0666)); +#endif + return(0); + } + b->uend=1; + return(b->useek ? t_runc(a) : 0); +} + + static int +#ifdef NON_UNIX_STDIO +#ifdef KR_headers +copy(from, len, to) char *from, *to; register long len; +#else +copy(FILE *from, register long len, FILE *to) +#endif +{ + int k, len1; + char buf[BUFSIZ]; + + while(fread(buf, len1 = len > BUFSIZ ? BUFSIZ : (int)len, 1, from)) { + if (!fwrite(buf, len1, 1, to)) + return 1; + if ((len -= len1) <= 0) + break; + } + return 0; + } +#else +#ifdef KR_headers +copy(from, len, to) char *from, *to; register long len; +#else +copy(char *from, register long len, char *to) +#endif +{ + register size_t n; + int k, rc = 0, tmp; + char buf[BUFSIZ]; + + if ((k = open(from, O_RDONLY)) < 0) + return 1; + if ((tmp = creat(to,0666)) < 0) + return 1; + while((n = read(k, buf, (size_t) (len > BUFSIZ ? BUFSIZ : (int)len))) > 0) { + if (write(tmp, buf, n) != n) + { rc = 1; break; } + if ((len -= n) <= 0) + break; + } + close(k); + close(tmp); + return n < 0 ? 1 : rc; + } +#endif + +#ifndef L_tmpnam +#define L_tmpnam 16 +#endif + + int +#ifdef KR_headers +t_runc(a) alist *a; +#else +t_runc(alist *a) +#endif +{ + char nm[L_tmpnam+12]; /* extra space in case L_tmpnam is tiny */ + long loc, len; + unit *b; +#ifdef NON_UNIX_STDIO + FILE *bf, *tf; +#else + FILE *bf; +#endif + int rc = 0; + + b = &f__units[a->aunit]; + if(b->url) + return(0); /*don't truncate direct files*/ + loc=ftell(bf = b->ufd); + fseek(bf,0L,SEEK_END); + len=ftell(bf); + if (loc >= len || b->useek == 0 || b->ufnm == NULL) + return(0); +#ifdef NON_UNIX_STDIO + fclose(b->ufd); +#else + rewind(b->ufd); /* empty buffer */ +#endif + if (!loc) { +#ifdef NON_UNIX_STDIO + if (!(bf = fopen(b->ufnm, f__w_mode[b->ufmt]))) +#else + if (close(creat(b->ufnm,0666))) +#endif + rc = 1; + if (b->uwrt) + b->uwrt = 1; + goto done; + } +#ifdef _POSIX_SOURCE + tmpnam(nm); +#else + strcpy(nm,"tmp.FXXXXXX"); + mktemp(nm); +#endif +#ifdef NON_UNIX_STDIO + if (!(bf = fopen(b->ufnm, f__r_mode[0]))) { + bad: + rc = 1; + goto done; + } + if (!(tf = fopen(nm, f__w_mode[0]))) + goto bad; + if (copy(bf, loc, tf)) { + bad1: + rc = 1; + goto done1; + } + if (!(bf = freopen(b->ufnm, f__w_mode[0], bf))) + goto bad1; + if (!(tf = freopen(nm, f__r_mode[0], tf))) + goto bad1; + if (copy(tf, loc, bf)) + goto bad1; + if (f__w_mode[0] != f__w_mode[b->ufmt]) { + if (!(bf = freopen(b->ufnm, f__w_mode[b->ufmt|2], bf))) + goto bad1; + fseek(bf, loc, SEEK_SET); + } +done1: + fclose(tf); + unlink(nm); +done: + f__cf = b->ufd = bf; +#else + if (copy(b->ufnm, loc, nm) + || copy(nm, loc, b->ufnm)) + rc = 1; + unlink(nm); + fseek(b->ufd, loc, SEEK_SET); +done: +#endif + if (rc) + err(a->aerr,111,"endfile"); + return 0; + } diff --git a/libf2c/libI77/err.c b/libf2c/libI77/err.c new file mode 100644 index 00000000000..12eb9eed9d6 --- /dev/null +++ b/libf2c/libI77/err.c @@ -0,0 +1,299 @@ +#ifndef NON_UNIX_STDIO +#include +#include +#endif +#include "f2c.h" +#if defined (NON_UNIX_STDIO) || defined (MISSING_FILE_ELEMS) +#ifdef KR_headers +extern char *malloc(); +#else +#undef abs +#undef min +#undef max +#include +#endif +#endif +#include "fio.h" +#include "fmt.h" /* for struct syl */ +#include "rawio.h" /* for fcntl.h, fdopen */ + +/*global definitions*/ +unit f__units[MXUNIT]; /*unit table*/ +int f__init; /*bit 0: set after initializations; + bit 1: set during I/O involving returns to + caller of library (or calls to user code)*/ +cilist *f__elist; /*active external io list*/ +icilist *f__svic; /*active internal io list*/ +flag f__reading; /*1 if reading, 0 if writing*/ +flag f__cplus,f__cblank; +char *f__fmtbuf; +int f__fmtlen; +flag f__external; /*1 if external io, 0 if internal */ +#ifdef KR_headers +int (*f__doed)(),(*f__doned)(); +int (*f__doend)(),(*f__donewrec)(),(*f__dorevert)(); +int (*f__getn)(),(*f__putn)(); /*for formatted io*/ +#else +int (*f__getn)(void),(*f__putn)(int); /*for formatted io*/ +int (*f__doed)(struct syl*, char*, ftnlen),(*f__doned)(struct syl*); +int (*f__dorevert)(void),(*f__donewrec)(void),(*f__doend)(void); +#endif +flag f__sequential; /*1 if sequential io, 0 if direct*/ +flag f__formatted; /*1 if formatted io, 0 if unformatted*/ +FILE *f__cf; /*current file*/ +unit *f__curunit; /*current unit*/ +int f__recpos; /*place in current record*/ +int f__cursor, f__hiwater, f__scale; +char *f__icptr; + +/*error messages*/ +char *F_err[] = +{ + "error in format", /* 100 */ + "illegal unit number", /* 101 */ + "formatted io not allowed", /* 102 */ + "unformatted io not allowed", /* 103 */ + "direct io not allowed", /* 104 */ + "sequential io not allowed", /* 105 */ + "can't backspace file", /* 106 */ + "null file name", /* 107 */ + "can't stat file", /* 108 */ + "unit not connected", /* 109 */ + "off end of record", /* 110 */ + "truncation failed in endfile", /* 111 */ + "incomprehensible list input", /* 112 */ + "out of free space", /* 113 */ + "unit not connected", /* 114 */ + "read unexpected character", /* 115 */ + "bad logical input field", /* 116 */ + "bad variable type", /* 117 */ + "bad namelist name", /* 118 */ + "variable not in namelist", /* 119 */ + "no end record", /* 120 */ + "variable count incorrect", /* 121 */ + "subscript for scalar variable", /* 122 */ + "invalid array section", /* 123 */ + "substring out of bounds", /* 124 */ + "subscript out of bounds", /* 125 */ + "can't read file", /* 126 */ + "can't write file", /* 127 */ + "'new' file exists", /* 128 */ + "can't append to file", /* 129 */ + "non-positive record number", /* 130 */ + "I/O started while already doing I/O" /* 131 */ +}; +#define MAXERR (sizeof(F_err)/sizeof(char *)+100) + +#ifdef KR_headers +f__canseek(f) FILE *f; /*SYSDEP*/ +#else +f__canseek(FILE *f) /*SYSDEP*/ +#endif +{ +#ifdef NON_UNIX_STDIO + return !isatty(fileno(f)); +#else + struct stat x; + + if (fstat(fileno(f),&x) < 0) + return(0); +#ifdef S_IFMT + switch(x.st_mode & S_IFMT) { + case S_IFDIR: + case S_IFREG: + if(x.st_nlink > 0) /* !pipe */ + return(1); + else + return(0); + case S_IFCHR: + if(isatty(fileno(f))) + return(0); + return(1); +#ifdef S_IFBLK + case S_IFBLK: + return(1); +#endif + } +#else +#ifdef S_ISDIR + /* POSIX version */ + if (S_ISREG(x.st_mode) || S_ISDIR(x.st_mode)) { + if(x.st_nlink > 0) /* !pipe */ + return(1); + else + return(0); + } + if (S_ISCHR(x.st_mode)) { + if(isatty(fileno(f))) + return(0); + return(1); + } + if (S_ISBLK(x.st_mode)) + return(1); +#else + Help! How does fstat work on this system? +#endif +#endif + return(0); /* who knows what it is? */ +#endif +} + + void +#ifdef KR_headers +f__fatal(n,s) char *s; +#else +f__fatal(int n, char *s) +#endif +{ + static int dead = 0; + + if(n<100 && n>=0) perror(s); /*SYSDEP*/ + else if(n >= (int)MAXERR || n < -1) + { fprintf(stderr,"%s: illegal error number %d\n",s,n); + } + else if(n == -1) fprintf(stderr,"%s: end of file\n",s); + else + fprintf(stderr,"%s: %s\n",s,F_err[n-100]); + if (dead) { + fprintf (stderr, "(libf2c f__fatal already called, aborting.)"); + abort(); + } + dead = 1; + if (f__init & 1) { + if (f__curunit) { + fprintf(stderr,"apparent state: unit %d ",f__curunit-f__units); + fprintf(stderr, f__curunit->ufnm ? "named %s\n" : "(unnamed)\n", + f__curunit->ufnm); + } + else + fprintf(stderr,"apparent state: internal I/O\n"); + if (f__fmtbuf) + fprintf(stderr,"last format: %.*s\n",f__fmtlen,f__fmtbuf); + fprintf(stderr,"lately %s %s %s %s",f__reading?"reading":"writing", + f__sequential?"sequential":"direct",f__formatted?"formatted":"unformatted", + f__external?"external":"internal"); + } + f__init &= ~2; /* No longer doing I/O (no more user code to be called). */ + sig_die(" IO", 1); +} +/*initialization routine*/ + VOID +f_init(Void) +{ unit *p; + + if (f__init & 2) + f__fatal (131, "I/O recursion"); + f__init = 1; + p= &f__units[0]; + p->ufd=stderr; + p->useek=f__canseek(stderr); +#ifdef _IOLBF + setvbuf(stderr, (char*)malloc(BUFSIZ+8), _IOLBF, BUFSIZ+8); +#else +#if defined (NON_UNIX_STDIO) || defined (MISSING_FILE_ELEMS) + setbuf(stderr, (char *)malloc(BUFSIZ+8)); +#else + stderr->_flag &= ~_IONBF; +#endif +#endif + p->ufmt=1; + p->uwrt=1; + p = &f__units[5]; + p->ufd=stdin; + p->useek=f__canseek(stdin); + p->ufmt=1; + p->uwrt=0; + p= &f__units[6]; + p->ufd=stdout; + p->useek=f__canseek(stdout); + p->ufmt=1; + p->uwrt=1; +} +#ifdef KR_headers +f__nowreading(x) unit *x; +#else +f__nowreading(unit *x) +#endif +{ + long loc; + int ufmt; + extern char *f__r_mode[]; + + if (!x->ufnm) + goto cantread; + ufmt = x->ufmt; + loc=ftell(x->ufd); + if(freopen(x->ufnm,f__r_mode[ufmt],x->ufd) == NULL) { + cantread: + errno = 126; + return(1); + } + x->uwrt=0; + (void) fseek(x->ufd,loc,SEEK_SET); + return(0); +} +#ifdef KR_headers +f__nowwriting(x) unit *x; +#else +f__nowwriting(unit *x) +#endif +{ + long loc; + int ufmt; + extern char *f__w_mode[]; +#ifndef NON_UNIX_STDIO + int k; +#endif + + if (!x->ufnm) + goto cantwrite; + ufmt = x->ufmt; +#ifdef NON_UNIX_STDIO + ufmt |= 2; +#endif + if (x->uwrt == 3) { /* just did write, rewind */ +#ifdef NON_UNIX_STDIO + if (!(f__cf = x->ufd = + freopen(x->ufnm,f__w_mode[ufmt],x->ufd))) +#else + if (close(creat(x->ufnm,0666))) +#endif + goto cantwrite; + } + else { + loc=ftell(x->ufd); +#ifdef NON_UNIX_STDIO + if (!(f__cf = x->ufd = + freopen(x->ufnm, f__w_mode[ufmt], x->ufd))) +#else + if (fclose(x->ufd) < 0 + || (k = x->uwrt == 2 ? creat(x->ufnm,0666) + : open(x->ufnm,O_WRONLY)) < 0 + || (f__cf = x->ufd = fdopen(k,f__w_mode[ufmt])) == NULL) +#endif + { + x->ufd = NULL; + cantwrite: + errno = 127; + return(1); + } + (void) fseek(x->ufd,loc,SEEK_SET); + } + x->uwrt = 1; + return(0); +} + + int +#ifdef KR_headers +err__fl(f, m, s) int f, m; char *s; +#else +err__fl(int f, int m, char *s) +#endif +{ + if (!f) + f__fatal(m, s); + if (f__doend) + (*f__doend)(); + f__init &= ~2; + return errno = m; + } diff --git a/libf2c/libI77/f2ch.add b/libf2c/libI77/f2ch.add new file mode 100644 index 00000000000..a2acc17a159 --- /dev/null +++ b/libf2c/libI77/f2ch.add @@ -0,0 +1,162 @@ +/* If you are using a C++ compiler, append the following to f2c.h + for compiling libF77 and libI77. */ + +#ifdef __cplusplus +extern "C" { +extern int abort_(void); +extern double c_abs(complex *); +extern void c_cos(complex *, complex *); +extern void c_div(complex *, complex *, complex *); +extern void c_exp(complex *, complex *); +extern void c_log(complex *, complex *); +extern void c_sin(complex *, complex *); +extern void c_sqrt(complex *, complex *); +extern double d_abs(double *); +extern double d_acos(double *); +extern double d_asin(double *); +extern double d_atan(double *); +extern double d_atn2(double *, double *); +extern void d_cnjg(doublecomplex *, doublecomplex *); +extern double d_cos(double *); +extern double d_cosh(double *); +extern double d_dim(double *, double *); +extern double d_exp(double *); +extern double d_imag(doublecomplex *); +extern double d_int(double *); +extern double d_lg10(double *); +extern double d_log(double *); +extern double d_mod(double *, double *); +extern double d_nint(double *); +extern double d_prod(float *, float *); +extern double d_sign(double *, double *); +extern double d_sin(double *); +extern double d_sinh(double *); +extern double d_sqrt(double *); +extern double d_tan(double *); +extern double d_tanh(double *); +extern double derf_(double *); +extern double derfc_(double *); +extern integer do_fio(ftnint *, char *, ftnlen); +extern integer do_lio(ftnint *, ftnint *, char *, ftnlen); +extern integer do_uio(ftnint *, char *, ftnlen); +extern integer e_rdfe(void); +extern integer e_rdue(void); +extern integer e_rsfe(void); +extern integer e_rsfi(void); +extern integer e_rsle(void); +extern integer e_rsli(void); +extern integer e_rsue(void); +extern integer e_wdfe(void); +extern integer e_wdue(void); +extern integer e_wsfe(void); +extern integer e_wsfi(void); +extern integer e_wsle(void); +extern integer e_wsli(void); +extern integer e_wsue(void); +extern int ef1asc_(ftnint *, ftnlen *, ftnint *, ftnlen *); +extern integer ef1cmc_(ftnint *, ftnlen *, ftnint *, ftnlen *); +extern double erf(double); +extern double erf_(float *); +extern double erfc(double); +extern double erfc_(float *); +extern integer f_back(alist *); +extern integer f_clos(cllist *); +extern integer f_end(alist *); +extern void f_exit(void); +extern integer f_inqu(inlist *); +extern integer f_open(olist *); +extern integer f_rew(alist *); +extern int flush_(void); +extern void getarg_(integer *, char *, ftnlen); +extern void getenv_(char *, char *, ftnlen, ftnlen); +extern short h_abs(short *); +extern short h_dim(short *, short *); +extern short h_dnnt(double *); +extern short h_indx(char *, char *, ftnlen, ftnlen); +extern short h_len(char *, ftnlen); +extern short h_mod(short *, short *); +extern short h_nint(float *); +extern short h_sign(short *, short *); +extern short hl_ge(char *, char *, ftnlen, ftnlen); +extern short hl_gt(char *, char *, ftnlen, ftnlen); +extern short hl_le(char *, char *, ftnlen, ftnlen); +extern short hl_lt(char *, char *, ftnlen, ftnlen); +extern integer i_abs(integer *); +extern integer i_dim(integer *, integer *); +extern integer i_dnnt(double *); +extern integer i_indx(char *, char *, ftnlen, ftnlen); +extern integer i_len(char *, ftnlen); +extern integer i_mod(integer *, integer *); +extern integer i_nint(float *); +extern integer i_sign(integer *, integer *); +extern integer iargc_(void); +extern ftnlen l_ge(char *, char *, ftnlen, ftnlen); +extern ftnlen l_gt(char *, char *, ftnlen, ftnlen); +extern ftnlen l_le(char *, char *, ftnlen, ftnlen); +extern ftnlen l_lt(char *, char *, ftnlen, ftnlen); +extern void pow_ci(complex *, complex *, integer *); +extern double pow_dd(double *, double *); +extern double pow_di(double *, integer *); +extern short pow_hh(short *, shortint *); +extern integer pow_ii(integer *, integer *); +extern double pow_ri(float *, integer *); +extern void pow_zi(doublecomplex *, doublecomplex *, integer *); +extern void pow_zz(doublecomplex *, doublecomplex *, doublecomplex *); +extern double r_abs(float *); +extern double r_acos(float *); +extern double r_asin(float *); +extern double r_atan(float *); +extern double r_atn2(float *, float *); +extern void r_cnjg(complex *, complex *); +extern double r_cos(float *); +extern double r_cosh(float *); +extern double r_dim(float *, float *); +extern double r_exp(float *); +extern double r_imag(complex *); +extern double r_int(float *); +extern double r_lg10(float *); +extern double r_log(float *); +extern double r_mod(float *, float *); +extern double r_nint(float *); +extern double r_sign(float *, float *); +extern double r_sin(float *); +extern double r_sinh(float *); +extern double r_sqrt(float *); +extern double r_tan(float *); +extern double r_tanh(float *); +extern void s_cat(char *, char **, integer *, integer *, ftnlen); +extern integer s_cmp(char *, char *, ftnlen, ftnlen); +extern void s_copy(char *, char *, ftnlen, ftnlen); +extern int s_paus(char *, ftnlen); +extern integer s_rdfe(cilist *); +extern integer s_rdue(cilist *); +extern integer s_rnge(char *, integer, char *, integer); +extern integer s_rsfe(cilist *); +extern integer s_rsfi(icilist *); +extern integer s_rsle(cilist *); +extern integer s_rsli(icilist *); +extern integer s_rsne(cilist *); +extern integer s_rsni(icilist *); +extern integer s_rsue(cilist *); +extern int s_stop(char *, ftnlen); +extern integer s_wdfe(cilist *); +extern integer s_wdue(cilist *); +extern integer s_wsfe(cilist *); +extern integer s_wsfi(icilist *); +extern integer s_wsle(cilist *); +extern integer s_wsli(icilist *); +extern integer s_wsne(cilist *); +extern integer s_wsni(icilist *); +extern integer s_wsue(cilist *); +extern void sig_die(char *, int); +extern integer signal_(integer *, void (*)(int)); +extern integer system_(char *, ftnlen); +extern double z_abs(doublecomplex *); +extern void z_cos(doublecomplex *, doublecomplex *); +extern void z_div(doublecomplex *, doublecomplex *, doublecomplex *); +extern void z_exp(doublecomplex *, doublecomplex *); +extern void z_log(doublecomplex *, doublecomplex *); +extern void z_sin(doublecomplex *, doublecomplex *); +extern void z_sqrt(doublecomplex *, doublecomplex *); + } +#endif diff --git a/libf2c/libI77/fio.h b/libf2c/libI77/fio.h new file mode 100644 index 00000000000..e9e3b391407 --- /dev/null +++ b/libf2c/libI77/fio.h @@ -0,0 +1,105 @@ +#include +#include +#ifndef NULL +/* ANSI C */ +#include +#endif +#ifdef STDC_HEADERS +#include +#endif + +#ifndef SEEK_SET +#define SEEK_SET 0 +#define SEEK_CUR 1 +#define SEEK_END 2 +#endif + +#if defined (MSDOS) && !defined (GO32) +#ifndef NON_UNIX_STDIO +#define NON_UNIX_STDIO +#endif +#endif + +#ifdef UIOLEN_int +typedef int uiolen; +#else +typedef long uiolen; +#endif + +/*units*/ +typedef struct +{ FILE *ufd; /*0=unconnected*/ + char *ufnm; +#if !(defined (MSDOS) && !defined (GO32)) + long uinode; + int udev; +#endif + int url; /*0=sequential*/ + flag useek; /*true=can backspace, use dir, ...*/ + flag ufmt; + flag uprnt; + flag ublnk; + flag uend; + flag uwrt; /*last io was write*/ + flag uscrtch; +} unit; + +extern int f__init; +extern cilist *f__elist; /*active external io list*/ +extern flag f__reading,f__external,f__sequential,f__formatted; +#undef Void +#ifdef KR_headers +#define Void /*void*/ +extern int (*f__getn)(),(*f__putn)(); /*for formatted io*/ +extern long f__inode(); +extern VOID sig_die(); +extern int (*f__donewrec)(), t_putc(), x_wSL(); +extern int c_sfe(), err__fl(), xrd_SL(); +#else +#define Void void +#ifdef __cplusplus +extern "C" { +#endif +extern int (*f__getn)(void),(*f__putn)(int); /*for formatted io*/ +extern long f__inode(char*,int*); +extern void sig_die(char*,int); +extern void f__fatal(int,char*); +extern int t_runc(alist*); +extern int f__nowreading(unit*), f__nowwriting(unit*); +extern int fk_open(int,int,ftnint); +extern int en_fio(void); +extern void f_init(void); +extern int (*f__donewrec)(void), t_putc(int), x_wSL(void); +extern void b_char(char*,char*,ftnlen), g_char(char*,ftnlen,char*); +extern int c_sfe(cilist*), z_rnew(void); +extern int isatty(int); +extern int err__fl(int,int,char*); +extern int xrd_SL(void); +#ifdef __cplusplus + } +#endif +#endif +extern int (*f__doend)(Void); +extern FILE *f__cf; /*current file*/ +extern unit *f__curunit; /*current unit*/ +extern unit f__units[]; +#define err(f,m,s) do {if(f) {f__init &= ~2; errno= m;} else f__fatal(m,s); return(m);} while(0) +#define errfl(f,m,s) do {return err__fl((int)f,m,s);} while(0) + +/*Table sizes*/ +#define MXUNIT 100 + +extern int f__recpos; /*position in current record*/ +extern int f__cursor; /* offset to move to */ +extern int f__hiwater; /* so TL doesn't confuse us */ + +#define WRITE 1 +#define READ 2 +#define SEQ 3 +#define DIR 4 +#define FMT 5 +#define UNF 6 +#define EXT 7 +#define INT 8 + +#define buf_end(x) (x->_flag & _IONBF ? x->_ptr : x->_base + BUFSIZ) diff --git a/libf2c/libI77/fmt.c b/libf2c/libI77/fmt.c new file mode 100644 index 00000000000..8f08952ed45 --- /dev/null +++ b/libf2c/libI77/fmt.c @@ -0,0 +1,543 @@ +#include "f2c.h" +#include "fio.h" +#include "fmt.h" +#define skip(s) while(*s==' ') s++ +#ifdef interdata +#define SYLMX 300 +#endif +#ifdef pdp11 +#define SYLMX 300 +#endif +#ifdef vax +#define SYLMX 300 +#endif +#ifndef SYLMX +#define SYLMX 300 +#endif +#define GLITCH '\2' + /* special quote character for stu */ +extern int f__cursor,f__scale; +extern flag f__cblank,f__cplus; /*blanks in I and compulsory plus*/ +static struct syl f__syl[SYLMX]; +int f__parenlvl,f__pc,f__revloc; + + static +#ifdef KR_headers +char *ap_end(s) char *s; +#else +char *ap_end(char *s) +#endif +{ char quote; + quote= *s++; + for(;*s;s++) + { if(*s!=quote) continue; + if(*++s!=quote) return(s); + } + if(f__elist->cierr) { + errno = 100; + return(NULL); + } + f__fatal(100, "bad string"); + /*NOTREACHED*/ return 0; +} + static +#ifdef KR_headers +op_gen(a,b,c,d) +#else +op_gen(int a, int b, int c, int d) +#endif +{ struct syl *p= &f__syl[f__pc]; + if(f__pc>=SYLMX) + { fprintf(stderr,"format too complicated:\n"); + sig_die(f__fmtbuf, 1); + } + p->op=a; + p->p1=b; + p->p2.i[0]=c; + p->p2.i[1]=d; + return(f__pc++); +} +#ifdef KR_headers +static char *f_list(); +static char *gt_num(s,n,n1) char *s; int *n, n1; +#else +static char *f_list(char*); +static char *gt_num(char *s, int *n, int n1) +#endif +{ int m=0,f__cnt=0; + char c; + for(c= *s;;c = *s) + { if(c==' ') + { s++; + continue; + } + if(c>'9' || c<'0') break; + m=10*m+c-'0'; + f__cnt++; + s++; + } + if(f__cnt==0) { + if (!n1) + s = 0; + *n=n1; + } + else *n=m; + return(s); +} + + static +#ifdef KR_headers +char *f_s(s,curloc) char *s; +#else +char *f_s(char *s, int curloc) +#endif +{ + skip(s); + if(*s++!='(') + { + return(NULL); + } + if(f__parenlvl++ ==1) f__revloc=curloc; + if(op_gen(RET1,curloc,0,0)<0 || + (s=f_list(s))==NULL) + { + return(NULL); + } + return(s); +} + + static +#ifdef KR_headers +ne_d(s,p) char *s,**p; +#else +ne_d(char *s, char **p) +#endif +{ int n,x,sign=0; + struct syl *sp; + switch(*s) + { + default: + return(0); + case ':': (void) op_gen(COLON,0,0,0); break; + case '$': + (void) op_gen(NONL, 0, 0, 0); break; + case 'B': + case 'b': + if(*++s=='z' || *s == 'Z') (void) op_gen(BZ,0,0,0); + else (void) op_gen(BN,0,0,0); + break; + case 'S': + case 's': + if(*(s+1)=='s' || *(s+1) == 'S') + { x=SS; + s++; + } + else if(*(s+1)=='p' || *(s+1) == 'P') + { x=SP; + s++; + } + else x=S; + (void) op_gen(x,0,0,0); + break; + case '/': (void) op_gen(SLASH,0,0,0); break; + case '-': sign=1; + case '+': s++; /*OUTRAGEOUS CODING TRICK*/ + case '0': case '1': case '2': case '3': case '4': + case '5': case '6': case '7': case '8': case '9': + if (!(s=gt_num(s,&n,0))) { + bad: *p = 0; + return 1; + } + switch(*s) + { + default: + return(0); + case 'P': + case 'p': if(sign) n= -n; (void) op_gen(P,n,0,0); break; + case 'X': + case 'x': (void) op_gen(X,n,0,0); break; + case 'H': + case 'h': + sp = &f__syl[op_gen(H,n,0,0)]; + sp->p2.s = s + 1; + s+=n; + break; + } + break; + case GLITCH: + case '"': + case '\'': + sp = &f__syl[op_gen(APOS,0,0,0)]; + sp->p2.s = s; + if((*p = ap_end(s)) == NULL) + return(0); + return(1); + case 'T': + case 't': + if(*(s+1)=='l' || *(s+1) == 'L') + { x=TL; + s++; + } + else if(*(s+1)=='r'|| *(s+1) == 'R') + { x=TR; + s++; + } + else x=T; + if (!(s=gt_num(s+1,&n,0))) + goto bad; + s--; + (void) op_gen(x,n,0,0); + break; + case 'X': + case 'x': (void) op_gen(X,1,0,0); break; + case 'P': + case 'p': (void) op_gen(P,1,0,0); break; + } + s++; + *p=s; + return(1); +} + + static +#ifdef KR_headers +e_d(s,p) char *s,**p; +#else +e_d(char *s, char **p) +#endif +{ int i,im,n,w,d,e,found=0,x=0; + char *sv=s; + s=gt_num(s,&n,1); + (void) op_gen(STACK,n,0,0); + switch(*s++) + { + default: break; + case 'E': + case 'e': x=1; + case 'G': + case 'g': + found=1; + if (!(s=gt_num(s,&w,0))) { + bad: + *p = 0; + return 1; + } + if(w==0) break; + if(*s=='.') { + if (!(s=gt_num(s+1,&d,0))) + goto bad; + } + else d=0; + if(*s!='E' && *s != 'e') + (void) op_gen(x==1?E:G,w,d,0); /* default is Ew.dE2 */ + else { + if (!(s=gt_num(s+1,&e,0))) + goto bad; + (void) op_gen(x==1?EE:GE,w,d,e); + } + break; + case 'O': + case 'o': + i = O; + im = OM; + goto finish_I; + case 'Z': + case 'z': + i = Z; + im = ZM; + goto finish_I; + case 'L': + case 'l': + found=1; + if (!(s=gt_num(s,&w,0))) + goto bad; + if(w==0) break; + (void) op_gen(L,w,0,0); + break; + case 'A': + case 'a': + found=1; + skip(s); + if(*s>='0' && *s<='9') + { s=gt_num(s,&w,1); + if(w==0) break; + (void) op_gen(AW,w,0,0); + break; + } + (void) op_gen(A,0,0,0); + break; + case 'F': + case 'f': + if (!(s=gt_num(s,&w,0))) + goto bad; + found=1; + if(w==0) break; + if(*s=='.') { + if (!(s=gt_num(s+1,&d,0))) + goto bad; + } + else d=0; + (void) op_gen(F,w,d,0); + break; + case 'D': + case 'd': + found=1; + if (!(s=gt_num(s,&w,0))) + goto bad; + if(w==0) break; + if(*s=='.') { + if (!(s=gt_num(s+1,&d,0))) + goto bad; + } + else d=0; + (void) op_gen(D,w,d,0); + break; + case 'I': + case 'i': + i = I; + im = IM; + finish_I: + if (!(s=gt_num(s,&w,0))) + goto bad; + found=1; + if(w==0) break; + if(*s!='.') + { (void) op_gen(i,w,0,0); + break; + } + if (!(s=gt_num(s+1,&d,0))) + goto bad; + (void) op_gen(im,w,d,0); + break; + } + if(found==0) + { f__pc--; /*unSTACK*/ + *p=sv; + return(0); + } + *p=s; + return(1); +} + static +#ifdef KR_headers +char *i_tem(s) char *s; +#else +char *i_tem(char *s) +#endif +{ char *t; + int n,curloc; + if(*s==')') return(s); + if(ne_d(s,&t)) return(t); + if(e_d(s,&t)) return(t); + s=gt_num(s,&n,1); + if((curloc=op_gen(STACK,n,0,0))<0) return(NULL); + return(f_s(s,curloc)); +} + + static +#ifdef KR_headers +char *f_list(s) char *s; +#else +char *f_list(char *s) +#endif +{ + for(;*s!=0;) + { skip(s); + if((s=i_tem(s))==NULL) return(NULL); + skip(s); + if(*s==',') s++; + else if(*s==')') + { if(--f__parenlvl==0) + { + (void) op_gen(REVERT,f__revloc,0,0); + return(++s); + } + (void) op_gen(GOTO,0,0,0); + return(++s); + } + } + return(NULL); +} + +#ifdef KR_headers +pars_f(s) char *s; +#else +pars_f(char *s) +#endif +{ + char *e; + + f__parenlvl=f__revloc=f__pc=0; + if((e=f_s(s,0)) == NULL) + { + /* Try and delimit the format string. Parens within + hollerith and quoted strings have to match for this + to work, but it's probably adequate for most needs. + Note that this is needed because a valid CHARACTER + variable passed for FMT= can contain '(I)garbage', + where `garbage' is billions and billions of junk + characters, and it's up to the run-time library to + know where the format string ends by counting parens. + Meanwhile, still treat NUL byte as "hard stop", since + f2c still appends that at end of FORMAT-statement + strings. */ + + int level=0; + + for (f__fmtlen=0; + ((*s!=')') || (--level > 0)) + && (*s!='\0') + && (f__fmtlen<80); + ++s, ++f__fmtlen) + { + if (*s=='(') + ++level; + } + if (*s==')') + ++f__fmtlen; + return(-1); + } + f__fmtlen = e - s; + return(0); +} +#define STKSZ 10 +int f__cnt[STKSZ],f__ret[STKSZ],f__cp,f__rp; +flag f__workdone, f__nonl; + + static +#ifdef KR_headers +type_f(n) +#else +type_f(int n) +#endif +{ + switch(n) + { + default: + return(n); + case RET1: + return(RET1); + case REVERT: return(REVERT); + case GOTO: return(GOTO); + case STACK: return(STACK); + case X: + case SLASH: + case APOS: case H: + case T: case TL: case TR: + return(NED); + case F: + case I: + case IM: + case A: case AW: + case O: case OM: + case L: + case E: case EE: case D: + case G: case GE: + case Z: case ZM: + return(ED); + } +} +#ifdef KR_headers +integer do_fio(number,ptr,len) ftnint *number; ftnlen len; char *ptr; +#else +integer do_fio(ftnint *number, char *ptr, ftnlen len) +#endif +{ struct syl *p; + int n,i; + for(i=0;i<*number;i++,ptr+=len) + { +loop: switch(type_f((p= &f__syl[f__pc])->op)) + { + default: + fprintf(stderr,"unknown code in do_fio: %d\n%.*s\n", + p->op,f__fmtlen,f__fmtbuf); + err(f__elist->cierr,100,"do_fio"); + case NED: + if((*f__doned)(p)) + { f__pc++; + goto loop; + } + f__pc++; + continue; + case ED: + if(f__cnt[f__cp]<=0) + { f__cp--; + f__pc++; + goto loop; + } + if(ptr==NULL) + return((*f__doend)()); + f__cnt[f__cp]--; + f__workdone=1; + if((n=(*f__doed)(p,ptr,len))>0) + errfl(f__elist->cierr,errno,"fmt"); + if(n<0) + err(f__elist->ciend,(EOF),"fmt"); + continue; + case STACK: + f__cnt[++f__cp]=p->p1; + f__pc++; + goto loop; + case RET1: + f__ret[++f__rp]=p->p1; + f__pc++; + goto loop; + case GOTO: + if(--f__cnt[f__cp]<=0) + { f__cp--; + f__rp--; + f__pc++; + goto loop; + } + f__pc=1+f__ret[f__rp--]; + goto loop; + case REVERT: + f__rp=f__cp=0; + f__pc = p->p1; + if(ptr==NULL) + return((*f__doend)()); + if(!f__workdone) return(0); + if((n=(*f__dorevert)()) != 0) return(n); + goto loop; + case COLON: + if(ptr==NULL) + return((*f__doend)()); + f__pc++; + goto loop; + case NONL: + f__nonl = 1; + f__pc++; + goto loop; + case S: + case SS: + f__cplus=0; + f__pc++; + goto loop; + case SP: + f__cplus = 1; + f__pc++; + goto loop; + case P: f__scale=p->p1; + f__pc++; + goto loop; + case BN: + f__cblank=0; + f__pc++; + goto loop; + case BZ: + f__cblank=1; + f__pc++; + goto loop; + } + } + return(0); +} +en_fio(Void) +{ ftnint one=1; + return(do_fio(&one,(char *)NULL,(ftnint)0)); +} + VOID +fmt_bg(Void) +{ + f__workdone=f__cp=f__rp=f__pc=f__cursor=0; + f__cnt[0]=f__ret[0]=0; +} diff --git a/libf2c/libI77/fmt.h b/libf2c/libI77/fmt.h new file mode 100644 index 00000000000..6197e76ed5a --- /dev/null +++ b/libf2c/libI77/fmt.h @@ -0,0 +1,101 @@ +struct syl +{ int op; + int p1; + union { int i[2]; char *s;} p2; + }; +#define RET1 1 +#define REVERT 2 +#define GOTO 3 +#define X 4 +#define SLASH 5 +#define STACK 6 +#define I 7 +#define ED 8 +#define NED 9 +#define IM 10 +#define APOS 11 +#define H 12 +#define TL 13 +#define TR 14 +#define T 15 +#define COLON 16 +#define S 17 +#define SP 18 +#define SS 19 +#define P 20 +#define BN 21 +#define BZ 22 +#define F 23 +#define E 24 +#define EE 25 +#define D 26 +#define G 27 +#define GE 28 +#define L 29 +#define A 30 +#define AW 31 +#define O 32 +#define NONL 33 +#define OM 34 +#define Z 35 +#define ZM 36 +extern int f__pc,f__parenlvl,f__revloc; +typedef union +{ real pf; + doublereal pd; +} ufloat; +typedef union +{ short is; +#ifndef KR_headers + signed +#endif + char ic; + integer il; +#ifdef Allow_TYQUAD + longint ili; +#endif +} Uint; +#ifdef KR_headers +extern int (*f__doed)(),(*f__doned)(); +extern int (*f__dorevert)(); +extern int rd_ed(),rd_ned(); +extern int w_ed(),w_ned(); +#else +#ifdef __cplusplus +extern "C" { +#endif +extern int (*f__doed)(struct syl*, char*, ftnlen),(*f__doned)(struct syl*); +extern int (*f__dorevert)(void); +extern void fmt_bg(void); +extern int pars_f(char*); +extern int rd_ed(struct syl*, char*, ftnlen),rd_ned(struct syl*); +extern int w_ed(struct syl*, char*, ftnlen),w_ned(struct syl*); +extern int wrt_E(ufloat*, int, int, int, ftnlen); +extern int wrt_F(ufloat*, int, int, ftnlen); +extern int wrt_L(Uint*, int, ftnlen); +#ifdef __cplusplus + } +#endif +#endif +extern flag f__cblank,f__cplus,f__workdone, f__nonl; +extern char *f__fmtbuf; +extern int f__fmtlen; +extern int f__scale; +#define GET(x) if((x=(*f__getn)())<0) return(x) +#define VAL(x) (x!='\n'?x:' ') +#define PUT(x) (*f__putn)(x) +extern int f__cursor; + +#undef TYQUAD +#ifndef Allow_TYQUAD +#undef longint +#define longint long +#else +#define TYQUAD 14 +#endif + +#ifdef KR_headers +extern char *f__icvt(); +#else +extern char *f__icvt(longint, int*, int*, int); +#endif diff --git a/libf2c/libI77/fmtlib.c b/libf2c/libI77/fmtlib.c new file mode 100644 index 00000000000..91483fc5290 --- /dev/null +++ b/libf2c/libI77/fmtlib.c @@ -0,0 +1,45 @@ +/* @(#)fmtlib.c 1.2 */ +#define MAXINTLENGTH 23 + +#include "f2c.h" +#ifndef Allow_TYQUAD +#undef longint +#define longint long +#undef ulongint +#define ulongint unsigned long +#endif + +#ifdef KR_headers +char *f__icvt(value,ndigit,sign, base) longint value; int *ndigit,*sign; + register int base; +#else +char *f__icvt(longint value, int *ndigit, int *sign, int base) +#endif +{ + static char buf[MAXINTLENGTH+1]; + register int i; + ulongint uvalue; + + if(value > 0) { + uvalue = value; + *sign = 0; + } + else if (value < 0) { + uvalue = -value; + *sign = 1; + } + else { + *sign = 0; + *ndigit = 1; + buf[MAXINTLENGTH-1] = '0'; + return &buf[MAXINTLENGTH-1]; + } + i = MAXINTLENGTH; + do { + buf[--i] = (uvalue%base) + '0'; + uvalue /= base; + } + while(uvalue > 0); + *ndigit = MAXINTLENGTH - i; + return &buf[i]; + } diff --git a/libf2c/libI77/fp.h b/libf2c/libI77/fp.h new file mode 100644 index 00000000000..40743d79f74 --- /dev/null +++ b/libf2c/libI77/fp.h @@ -0,0 +1,28 @@ +#define FMAX 40 +#define EXPMAXDIGS 8 +#define EXPMAX 99999999 +/* FMAX = max number of nonzero digits passed to atof() */ +/* EXPMAX = 10^EXPMAXDIGS - 1 = largest allowed exponent absolute value */ + +#ifdef V10 /* Research Tenth-Edition Unix */ +#include "local.h" +#endif + +/* MAXFRACDIGS and MAXINTDIGS are for wrt_F -- bounds (not necessarily + tight) on the maximum number of digits to the right and left of + * the decimal point. + */ + +#ifdef VAX +#define MAXFRACDIGS 56 +#define MAXINTDIGS 38 +#else +#ifdef CRAY +#define MAXFRACDIGS 9880 +#define MAXINTDIGS 9864 +#else +/* values that suffice for IEEE double */ +#define MAXFRACDIGS 344 +#define MAXINTDIGS 308 +#endif +#endif diff --git a/libf2c/libI77/ftell_.c b/libf2c/libI77/ftell_.c new file mode 100644 index 00000000000..1bd03be325a --- /dev/null +++ b/libf2c/libI77/ftell_.c @@ -0,0 +1,46 @@ +#include "f2c.h" +#include "fio.h" + + static FILE * +#ifdef KR_headers +unit_chk(Unit, who) integer Unit; char *who; +#else +unit_chk(integer Unit, char *who) +#endif +{ + if (Unit >= MXUNIT || Unit < 0) + f__fatal(101, who); + return f__units[Unit].ufd; + } + + integer +#ifdef KR_headers +G77_ftell_0 (Unit) integer *Unit; +#else +G77_ftell_0 (integer *Unit) +#endif +{ + FILE *f; + return (f = unit_chk(*Unit, "ftell")) ? ftell(f) : -1L; + } + + integer +#ifdef KR_headers +G77_fseek_0 (Unit, offset, xwhence) integer *Unit, *offset, *xwhence; +#else +G77_fseek_0 (integer *Unit, integer *offset, integer *xwhence) +#endif +{ + FILE *f; + int w = (int)*xwhence; +#ifdef SEEK_SET + static int wohin[3] = { SEEK_SET, SEEK_CUR, SEEK_END }; +#endif + if (w < 0 || w > 2) + w = 0; +#ifdef SEEK_SET + w = wohin[w]; +#endif + return !(f = unit_chk(*Unit, "fseek")) + || fseek(f, *offset, w) ? 1 : 0; + } diff --git a/libf2c/libI77/iio.c b/libf2c/libI77/iio.c new file mode 100644 index 00000000000..22eae3f433d --- /dev/null +++ b/libf2c/libI77/iio.c @@ -0,0 +1,148 @@ +#include "f2c.h" +#include "fio.h" +#include "fmt.h" +extern char *f__icptr; +char *f__icend; +extern icilist *f__svic; +int f__icnum; +extern int f__hiwater; +z_getc(Void) +{ + if(f__recpos++ < f__svic->icirlen) { + if(f__icptr >= f__icend) err(f__svic->iciend,(EOF),"endfile"); + return(*(unsigned char *)f__icptr++); + } + return '\n'; +} +#ifdef KR_headers +z_putc(c) +#else +z_putc(int c) +#endif +{ + if(f__icptr >= f__icend) err(f__svic->icierr,110,"inwrite"); + if(f__recpos++ < f__svic->icirlen) + *f__icptr++ = c; + else err(f__svic->icierr,110,"recend"); + return 0; +} +z_rnew(Void) +{ + f__icptr = f__svic->iciunit + (++f__icnum)*f__svic->icirlen; + f__recpos = 0; + f__cursor = 0; + f__hiwater = 0; + return 1; +} + + static int +z_endp(Void) +{ + (*f__donewrec)(); + return 0; + } + +#ifdef KR_headers +c_si(a) icilist *a; +#else +c_si(icilist *a) +#endif +{ + if (f__init & 2) + f__fatal (131, "I/O recursion"); + f__init |= 2; + f__elist = (cilist *)a; + f__fmtbuf=a->icifmt; + if(pars_f(f__fmtbuf)<0) + err(a->icierr,100,"startint"); + fmt_bg(); + f__sequential=f__formatted=1; + f__external=0; + f__cblank=f__cplus=f__scale=0; + f__svic=a; + f__icnum=f__recpos=0; + f__cursor = 0; + f__hiwater = 0; + f__icptr = a->iciunit; + f__icend = f__icptr + a->icirlen*a->icirnum; + f__curunit = 0; + f__cf = 0; + return(0); +} + + int +iw_rev(Void) +{ + if(f__workdone) + z_endp(); + f__hiwater = f__recpos = f__cursor = 0; + return(f__workdone=0); + } + +#ifdef KR_headers +integer s_rsfi(a) icilist *a; +#else +integer s_rsfi(icilist *a) +#endif +{ int n; + if(n=c_si(a)) return(n); + f__reading=1; + f__doed=rd_ed; + f__doned=rd_ned; + f__getn=z_getc; + f__dorevert = z_endp; + f__donewrec = z_rnew; + f__doend = z_endp; + return(0); +} + +z_wnew(Void) +{ + if (f__recpos < f__hiwater) { + f__icptr += f__hiwater - f__recpos; + f__recpos = f__hiwater; + } + while(f__recpos++ < f__svic->icirlen) + *f__icptr++ = ' '; + f__recpos = 0; + f__cursor = 0; + f__hiwater = 0; + f__icnum++; + return 1; +} +#ifdef KR_headers +integer s_wsfi(a) icilist *a; +#else +integer s_wsfi(icilist *a) +#endif +{ int n; + if(n=c_si(a)) return(n); + f__reading=0; + f__doed=w_ed; + f__doned=w_ned; + f__putn=z_putc; + f__dorevert = iw_rev; + f__donewrec = z_wnew; + f__doend = z_endp; + return(0); +} +integer e_rsfi(Void) +{ int n; + f__init &= ~2; + n = en_fio(); + f__fmtbuf = NULL; + return(n); +} +integer e_wsfi(Void) +{ + int n; + f__init &= ~2; + n = en_fio(); + f__fmtbuf = NULL; + if(f__icnum >= f__svic->icirnum + || !f__recpos && f__icnum) + return(n); + while(f__recpos++ < f__svic->icirlen) + *f__icptr++ = ' '; + return(n); +} diff --git a/libf2c/libI77/ilnw.c b/libf2c/libI77/ilnw.c new file mode 100644 index 00000000000..08ea2be7831 --- /dev/null +++ b/libf2c/libI77/ilnw.c @@ -0,0 +1,82 @@ +#include "f2c.h" +#include "fio.h" +#include "lio.h" +extern char *f__icptr; +extern char *f__icend; +extern icilist *f__svic; +extern int f__icnum; +#ifdef KR_headers +extern int z_putc(); +#else +extern int z_putc(int); +#endif + + static int +z_wSL(Void) +{ + while(f__recpos < f__svic->icirlen) + z_putc(' '); + return z_rnew(); + } + + VOID +#ifdef KR_headers +c_liw(a) icilist *a; +#else +c_liw(icilist *a) +#endif +{ + f__reading = 0; + f__external = 0; + f__formatted = 1; + f__putn = z_putc; + L_len = a->icirlen; + f__donewrec = z_wSL; + f__svic = a; + f__icnum = f__recpos = 0; + f__cursor = 0; + f__cf = 0; + f__curunit = 0; + f__icptr = a->iciunit; + f__icend = f__icptr + a->icirlen*a->icirnum; + f__elist = (cilist *)a; + } + + integer +#ifdef KR_headers +s_wsni(a) icilist *a; +#else +s_wsni(icilist *a) +#endif +{ + cilist ca; + + if(f__init != 1) f_init(); + f__init = 3; + c_liw(a); + ca.cifmt = a->icifmt; + x_wsne(&ca); + z_wSL(); + return 0; + } + + integer +#ifdef KR_headers +s_wsli(a) icilist *a; +#else +s_wsli(icilist *a) +#endif +{ + if(f__init != 1) f_init(); + f__init = 3; + f__lioproc = l_write; + c_liw(a); + return(0); + } + +integer e_wsli(Void) +{ + f__init = 1; + z_wSL(); + return(0); + } diff --git a/libf2c/libI77/inquire.c b/libf2c/libI77/inquire.c new file mode 100644 index 00000000000..963d4c3e5e8 --- /dev/null +++ b/libf2c/libI77/inquire.c @@ -0,0 +1,108 @@ +#include "f2c.h" +#include "fio.h" +#include +#ifdef KR_headers +integer f_inqu(a) inlist *a; +#else +#if defined (MSDOS) && !defined (GO32) +#undef abs +#undef min +#undef max +#include "io.h" +#endif +integer f_inqu(inlist *a) +#endif +{ flag byfile; + int i, n; + unit *p; + char buf[256]; + long x; + if (f__init & 2) + f__fatal (131, "I/O recursion"); + if(a->infile!=NULL) + { byfile=1; + g_char(a->infile,a->infilen,buf); +#ifdef NON_UNIX_STDIO + x = access(buf,0) ? -1 : 0; + for(i=0,p=NULL;iinunitinunit>=0) + { + p= &f__units[a->inunit]; + } + else + { + p=NULL; + } + } + if(a->inex!=NULL) + if(byfile && x != -1 || !byfile && p!=NULL) + *a->inex=1; + else *a->inex=0; + if(a->inopen!=NULL) + if(byfile) *a->inopen=(p!=NULL); + else *a->inopen=(p!=NULL && p->ufd!=NULL); + if(a->innum!=NULL) *a->innum= p-f__units; + if(a->innamed!=NULL) + if(byfile || p!=NULL && p->ufnm!=NULL) + *a->innamed=1; + else *a->innamed=0; + if(a->inname!=NULL) + if(byfile) + b_char(buf,a->inname,a->innamlen); + else if(p!=NULL && p->ufnm!=NULL) + b_char(p->ufnm,a->inname,a->innamlen); + if(a->inacc!=NULL && p!=NULL && p->ufd!=NULL) + if(p->url) + b_char("DIRECT",a->inacc,a->inacclen); + else b_char("SEQUENTIAL",a->inacc,a->inacclen); + if(a->inseq!=NULL) + if(p!=NULL && p->url) + b_char("NO",a->inseq,a->inseqlen); + else b_char("YES",a->inseq,a->inseqlen); + if(a->indir!=NULL) + if(p==NULL || p->url) + b_char("YES",a->indir,a->indirlen); + else b_char("NO",a->indir,a->indirlen); + if(a->infmt!=NULL) + if(p!=NULL && p->ufmt==0) + b_char("UNFORMATTED",a->infmt,a->infmtlen); + else b_char("FORMATTED",a->infmt,a->infmtlen); + if(a->inform!=NULL) + if(p!=NULL && p->ufmt==0) + b_char("NO",a->inform,a->informlen); + else b_char("YES",a->inform,a->informlen); + if(a->inunf) + if(p!=NULL && p->ufmt==0) + b_char("YES",a->inunf,a->inunflen); + else if (p!=NULL) b_char("NO",a->inunf,a->inunflen); + else b_char("UNKNOWN",a->inunf,a->inunflen); + if(a->inrecl!=NULL && p!=NULL) + *a->inrecl=p->url; + if(a->innrec!=NULL && p!=NULL && p->url>0) + *a->innrec=ftell(p->ufd)/p->url+1; + if(a->inblank && p!=NULL && p->ufmt) + if(p->ublnk) + b_char("ZERO",a->inblank,a->inblanklen); + else b_char("NULL",a->inblank,a->inblanklen); + return(0); +} diff --git a/libf2c/libI77/lio.h b/libf2c/libI77/lio.h new file mode 100644 index 00000000000..012317206aa --- /dev/null +++ b/libf2c/libI77/lio.h @@ -0,0 +1,74 @@ +/* copy of ftypes from the compiler */ +/* variable types + * numeric assumptions: + * int < reals < complexes + * TYDREAL-TYREAL = TYDCOMPLEX-TYCOMPLEX + */ + +/* 0-10 retain their old (pre LOGICAL*1, etc.) */ +/* values to allow mixing old and new objects. */ + +#define TYUNKNOWN 0 +#define TYADDR 1 +#define TYSHORT 2 +#define TYLONG 3 +#define TYREAL 4 +#define TYDREAL 5 +#define TYCOMPLEX 6 +#define TYDCOMPLEX 7 +#define TYLOGICAL 8 +#define TYCHAR 9 +#define TYSUBR 10 +#define TYINT1 11 +#define TYLOGICAL1 12 +#define TYLOGICAL2 13 +#ifdef Allow_TYQUAD +#undef TYQUAD +#define TYQUAD 14 +#endif + +#define LINTW 24 +#define LINE 80 +#define LLOGW 2 +#ifdef Old_list_output +#define LLOW 1.0 +#define LHIGH 1.e9 +#define LEFMT " %# .8E" +#define LFFMT " %# .9g" +#else +#define LGFMT "%.9G" +#endif +/* LEFBL 20 should suffice; 24 overcomes a NeXT bug. */ +#define LEFBL 24 + +typedef union +{ + char flchar; + short flshort; + ftnint flint; +#ifdef Allow_TYQUAD + longint fllongint; +#endif + real flreal; + doublereal fldouble; +} flex; +extern int f__scale; +#ifdef KR_headers +extern int (*f__lioproc)(), (*l_getc)(), (*l_ungetc)(); +extern int l_read(), l_write(); +#else +#ifdef __cplusplus +extern "C" { +#endif +extern int (*f__lioproc)(ftnint*, char*, ftnlen, ftnint); +extern int l_write(ftnint*, char*, ftnlen, ftnint); +extern void x_wsne(cilist*); +extern int c_le(cilist*), (*l_getc)(void), (*l_ungetc)(int,FILE*); +extern int l_read(ftnint*,char*,ftnlen,ftnint); +extern integer e_rsle(void), e_wsle(void), s_wsne(cilist*); +extern int z_rnew(void); +#ifdef __cplusplus + } +#endif +#endif +extern ftnint L_len; diff --git a/libf2c/libI77/lread.c b/libf2c/libI77/lread.c new file mode 100644 index 00000000000..4fb14eed29e --- /dev/null +++ b/libf2c/libI77/lread.c @@ -0,0 +1,686 @@ +#include +#include "f2c.h" +#include "fio.h" + +/* Compile with -DF8X_NML_ELIDE_QUOTES to permit eliding quotation */ +/* marks in namelist input a la the Fortran 8X Draft published in */ +/* the May 1989 issue of Fortran Forum. */ + + +extern char *f__fmtbuf; +extern int f__fmtlen; + +#ifdef Allow_TYQUAD +static longint f__llx; +static int quad_read; +#endif + +#ifdef KR_headers +extern double atof(); +extern char *malloc(), *realloc(); +int (*f__lioproc)(), (*l_getc)(), (*l_ungetc)(); +#else +#undef abs +#undef min +#undef max +#include +int (*f__lioproc)(ftnint*, char*, ftnlen, ftnint), (*l_getc)(void), + (*l_ungetc)(int,FILE*); +#endif + +#include "fmt.h" +#include "lio.h" +#include "fp.h" + +int l_eof; + +#define isblnk(x) (f__ltab[x+1]&B) +#define issep(x) (f__ltab[x+1]&SX) +#define isapos(x) (f__ltab[x+1]&AX) +#define isexp(x) (f__ltab[x+1]&EX) +#define issign(x) (f__ltab[x+1]&SG) +#define iswhit(x) (f__ltab[x+1]&WH) +#define SX 1 +#define B 2 +#define AX 4 +#define EX 8 +#define SG 16 +#define WH 32 +char f__ltab[128+1] = { /* offset one for EOF */ + 0, + 0,0,AX,0,0,0,0,0,0,WH|B,SX|WH,0,0,0,0,0, + 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0, + SX|B|WH,0,AX,0,0,0,0,AX,0,0,0,SG,SX,SG,0,SX, + 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0, + 0,0,0,0,EX,EX,0,0,0,0,0,0,0,0,0,0, + 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0, + AX,0,0,0,EX,EX,0,0,0,0,0,0,0,0,0,0, + 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0 +}; + +#ifdef ungetc + static int +#ifdef KR_headers +un_getc(x,f__cf) int x; FILE *f__cf; +#else +un_getc(int x, FILE *f__cf) +#endif +{ return ungetc(x,f__cf); } +#else +#define un_getc ungetc +#ifdef KR_headers + extern int ungetc(); +#else +extern int ungetc(int, FILE*); /* for systems with a buggy stdio.h */ +#endif +#endif + +t_getc(Void) +{ int ch; + if(f__curunit->uend) return(EOF); + if((ch=getc(f__cf))!=EOF) return(ch); + if(feof(f__cf)) + f__curunit->uend = l_eof = 1; + return(EOF); +} +integer e_rsle(Void) +{ + int ch; + f__init = 1; + if(f__curunit->uend) return(0); + while((ch=t_getc())!='\n') + if (ch == EOF) { + if(feof(f__cf)) + f__curunit->uend = l_eof = 1; + return EOF; + } + return(0); +} + +flag f__lquit; +int f__lcount,f__ltype,nml_read; +char *f__lchar; +double f__lx,f__ly; +#define ERR(x) if(n=(x)) {f__init &= ~2; return(n);} +#define GETC(x) (x=(*l_getc)()) +#define Ungetc(x,y) (*l_ungetc)(x,y) + +#ifdef KR_headers +l_R(poststar) int poststar; +#else +l_R(int poststar) +#endif +{ + char s[FMAX+EXPMAXDIGS+4]; + register int ch; + register char *sp, *spe, *sp1; + long e, exp; + int havenum, havestar, se; + + if (!poststar) { + if (f__lcount > 0) + return(0); + f__lcount = 1; + } +#ifdef Allow_TYQUAD + f__llx = 0; +#endif + f__ltype = 0; + exp = 0; + havestar = 0; +retry: + sp1 = sp = s; + spe = sp + FMAX; + havenum = 0; + + switch(GETC(ch)) { + case '-': *sp++ = ch; sp1++; spe++; + case '+': + GETC(ch); + } + while(ch == '0') { + ++havenum; + GETC(ch); + } + while(isdigit(ch)) { + if (sp < spe) *sp++ = ch; + else ++exp; + GETC(ch); + } + if (ch == '*' && !poststar) { + if (sp == sp1 || exp || *s == '-') { + errfl(f__elist->cierr,112,"bad repetition count"); + } + poststar = havestar = 1; + *sp = 0; + f__lcount = atoi(s); + goto retry; + } + if (ch == '.') { + GETC(ch); + if (sp == sp1) + while(ch == '0') { + ++havenum; + --exp; + GETC(ch); + } + while(isdigit(ch)) { + if (sp < spe) + { *sp++ = ch; --exp; } + GETC(ch); + } + } + havenum += sp - sp1; + se = 0; + if (issign(ch)) + goto signonly; + if (havenum && isexp(ch)) { + GETC(ch); + if (issign(ch)) { +signonly: + if (ch == '-') se = 1; + GETC(ch); + } + if (!isdigit(ch)) { +bad: + errfl(f__elist->cierr,112,"exponent field"); + } + + e = ch - '0'; + while(isdigit(GETC(ch))) { + e = 10*e + ch - '0'; + if (e > EXPMAX) + goto bad; + } + if (se) + exp -= e; + else + exp += e; + } + (void) Ungetc(ch, f__cf); + if (sp > sp1) { + ++havenum; + while(*--sp == '0') + ++exp; + if (exp) + sprintf(sp+1, "e%ld", exp); + else + sp[1] = 0; + f__lx = atof(s); +#ifdef Allow_TYQUAD + if (quad_read && (se = sp - sp1 + exp) > 14 && se < 20) { + /* Assuming 64-bit longint and 32-bit long. */ + if (exp < 0) + sp += exp; + if (sp1 <= sp) { + f__llx = *sp1 - '0'; + while(++sp1 <= sp) + f__llx = 10*f__llx + (*sp1 - '0'); + } + while(--exp >= 0) + f__llx *= 10; + if (*s == '-') + f__llx = -f__llx; + } +#endif + } + else + f__lx = 0.; + if (havenum) + f__ltype = TYLONG; + else + switch(ch) { + case ',': + case '/': + break; + default: + if (havestar && ( ch == ' ' + ||ch == '\t' + ||ch == '\n')) + break; + if (nml_read > 1) { + f__lquit = 2; + return 0; + } + errfl(f__elist->cierr,112,"invalid number"); + } + return 0; + } + + static int +#ifdef KR_headers +rd_count(ch) register int ch; +#else +rd_count(register int ch) +#endif +{ + if (ch < '0' || ch > '9') + return 1; + f__lcount = ch - '0'; + while(GETC(ch) >= '0' && ch <= '9') + f__lcount = 10*f__lcount + ch - '0'; + Ungetc(ch,f__cf); + return f__lcount <= 0; + } + +l_C(Void) +{ int ch, nml_save; + double lz; + if(f__lcount>0) return(0); + f__ltype=0; + GETC(ch); + if(ch!='(') + { + if (nml_read > 1 && (ch < '0' || ch > '9')) { + Ungetc(ch,f__cf); + f__lquit = 2; + return 0; + } + if (rd_count(ch)) + if(!f__cf || !feof(f__cf)) + errfl(f__elist->cierr,112,"complex format"); + else + err(f__elist->cierr,(EOF),"lread"); + if(GETC(ch)!='*') + { + if(!f__cf || !feof(f__cf)) + errfl(f__elist->cierr,112,"no star"); + else + err(f__elist->cierr,(EOF),"lread"); + } + if(GETC(ch)!='(') + { Ungetc(ch,f__cf); + return(0); + } + } + else + f__lcount = 1; + while(iswhit(GETC(ch))); + Ungetc(ch,f__cf); + nml_save = nml_read; + nml_read = 0; + if (ch = l_R(1)) + return ch; + if (!f__ltype) + errfl(f__elist->cierr,112,"no real part"); + lz = f__lx; + while(iswhit(GETC(ch))); + if(ch!=',') + { (void) Ungetc(ch,f__cf); + errfl(f__elist->cierr,112,"no comma"); + } + while(iswhit(GETC(ch))); + (void) Ungetc(ch,f__cf); + if (ch = l_R(1)) + return ch; + if (!f__ltype) + errfl(f__elist->cierr,112,"no imaginary part"); + while(iswhit(GETC(ch))); + if(ch!=')') errfl(f__elist->cierr,112,"no )"); + f__ly = f__lx; + f__lx = lz; +#ifdef Allow_TYQUAD + f__llx = 0; +#endif + nml_read = nml_save; + return(0); +} +l_L(Void) +{ + int ch; + if(f__lcount>0) return(0); + f__lcount = 1; + f__ltype=0; + GETC(ch); + if(isdigit(ch)) + { + rd_count(ch); + if(GETC(ch)!='*') + if(!f__cf || !feof(f__cf)) + errfl(f__elist->cierr,112,"no star"); + else + err(f__elist->cierr,(EOF),"lread"); + GETC(ch); + } + if(ch == '.') GETC(ch); + switch(ch) + { + case 't': + case 'T': + f__lx=1; + break; + case 'f': + case 'F': + f__lx=0; + break; + default: + if(isblnk(ch) || issep(ch) || ch==EOF) + { (void) Ungetc(ch,f__cf); + return(0); + } + if (nml_read > 1) { + Ungetc(ch,f__cf); + f__lquit = 2; + return 0; + } + errfl(f__elist->cierr,112,"logical"); + } + f__ltype=TYLONG; + while(!issep(GETC(ch)) && ch!=EOF); + (void) Ungetc(ch, f__cf); + return(0); +} +#define BUFSIZE 128 +l_CHAR(Void) +{ int ch,size,i; + static char rafail[] = "realloc failure"; + char quote,*p; + if(f__lcount>0) return(0); + f__ltype=0; + if(f__lchar!=NULL) free(f__lchar); + size=BUFSIZE; + p=f__lchar = (char *)malloc((unsigned int)size); + if(f__lchar == NULL) + errfl(f__elist->cierr,113,"no space"); + + GETC(ch); + if(isdigit(ch)) { + /* allow Fortran 8x-style unquoted string... */ + /* either find a repetition count or the string */ + f__lcount = ch - '0'; + *p++ = ch; + for(i = 1;;) { + switch(GETC(ch)) { + case '*': + if (f__lcount == 0) { + f__lcount = 1; +#ifndef F8X_NML_ELIDE_QUOTES + if (nml_read) + goto no_quote; +#endif + goto noquote; + } + p = f__lchar; + goto have_lcount; + case ',': + case ' ': + case '\t': + case '\n': + case '/': + Ungetc(ch,f__cf); + /* no break */ + case EOF: + f__lcount = 1; + f__ltype = TYCHAR; + return *p = 0; + } + if (!isdigit(ch)) { + f__lcount = 1; +#ifndef F8X_NML_ELIDE_QUOTES + if (nml_read) { + no_quote: + errfl(f__elist->cierr,112, + "undelimited character string"); + } +#endif + goto noquote; + } + *p++ = ch; + f__lcount = 10*f__lcount + ch - '0'; + if (++i == size) { + f__lchar = (char *)realloc(f__lchar, + (unsigned int)(size += BUFSIZE)); + if(f__lchar == NULL) + errfl(f__elist->cierr,113,rafail); + p = f__lchar + i; + } + } + } + else (void) Ungetc(ch,f__cf); + have_lcount: + if(GETC(ch)=='\'' || ch=='"') quote=ch; + else if(isblnk(ch) || (issep(ch) && ch != '\n') || ch==EOF) { + Ungetc(ch,f__cf); + return 0; + } +#ifndef F8X_NML_ELIDE_QUOTES + else if (nml_read > 1) { + Ungetc(ch,f__cf); + f__lquit = 2; + return 0; + } +#endif + else { + /* Fortran 8x-style unquoted string */ + *p++ = ch; + for(i = 1;;) { + switch(GETC(ch)) { + case ',': + case ' ': + case '\t': + case '\n': + case '/': + Ungetc(ch,f__cf); + /* no break */ + case EOF: + f__ltype = TYCHAR; + return *p = 0; + } + noquote: + *p++ = ch; + if (++i == size) { + f__lchar = (char *)realloc(f__lchar, + (unsigned int)(size += BUFSIZE)); + if(f__lchar == NULL) + errfl(f__elist->cierr,113,rafail); + p = f__lchar + i; + } + } + } + f__ltype=TYCHAR; + for(i=0;;) + { while(GETC(ch)!=quote && ch!='\n' + && ch!=EOF && ++icierr,113,rafail); + p=f__lchar+i-1; + *p++ = ch; + } + else if(ch==EOF) return(EOF); + else if(ch=='\n') + { if(*(p-1) != '\\') continue; + i--; + p--; + if(++iciunit>=MXUNIT || a->ciunit<0) + err(a->cierr,101,"stler"); + f__scale=f__recpos=0; + f__elist=a; + f__curunit = &f__units[a->ciunit]; + if(f__curunit->ufd==NULL && fk_open(SEQ,FMT,a->ciunit)) + err(a->cierr,102,"lio"); + f__cf=f__curunit->ufd; + if(!f__curunit->ufmt) err(a->cierr,103,"lio"); + return(0); +} +#ifdef KR_headers +l_read(number,ptr,len,type) ftnint *number,type; char *ptr; ftnlen len; +#else +l_read(ftnint *number, char *ptr, ftnlen len, ftnint type) +#endif +{ +#define Ptr ((flex *)ptr) + int i,n,ch; + doublereal *yy; + real *xx; + for(i=0;i<*number;i++) + { + if(f__lquit) return(0); + if(l_eof) + err(f__elist->ciend, EOF, "list in"); + if(f__lcount == 0) { + f__ltype = 0; + for(;;) { + GETC(ch); + switch(ch) { + case EOF: + err(f__elist->ciend,(EOF),"list in"); + case ' ': + case '\t': + case '\n': + continue; + case '/': + f__lquit = 1; + goto loopend; + case ',': + f__lcount = 1; + goto loopend; + default: + (void) Ungetc(ch, f__cf); + goto rddata; + } + } + } + rddata: + switch((int)type) + { + case TYINT1: + case TYSHORT: + case TYLONG: + case TYREAL: + case TYDREAL: + ERR(l_R(0)); + break; +#ifdef TYQUAD + case TYQUAD: + quad_read = 1; + n = l_R(0); + quad_read = 0; + ERR(n); + break; +#endif + case TYCOMPLEX: + case TYDCOMPLEX: + ERR(l_C()); + break; + case TYLOGICAL1: + case TYLOGICAL2: + case TYLOGICAL: + ERR(l_L()); + break; + case TYCHAR: + ERR(l_CHAR()); + break; + } + while (GETC(ch) == ' ' || ch == '\t'); + if (ch != ',' || f__lcount > 1) + Ungetc(ch,f__cf); + loopend: + if(f__lquit) return(0); + if(f__cf && ferror(f__cf)) { + clearerr(f__cf); + errfl(f__elist->cierr,errno,"list in"); + } + if(f__ltype==0) goto bump; + switch((int)type) + { + case TYINT1: + case TYLOGICAL1: + Ptr->flchar = (char)f__lx; + break; + case TYLOGICAL2: + case TYSHORT: + Ptr->flshort = (short)f__lx; + break; + case TYLOGICAL: + case TYLONG: + Ptr->flint=f__lx; + break; +#ifdef Allow_TYQUAD + case TYQUAD: + if (!(Ptr->fllongint = f__llx)) + Ptr->fllongint = f__lx; + break; +#endif + case TYREAL: + Ptr->flreal=f__lx; + break; + case TYDREAL: + Ptr->fldouble=f__lx; + break; + case TYCOMPLEX: + xx=(real *)ptr; + *xx++ = f__lx; + *xx = f__ly; + break; + case TYDCOMPLEX: + yy=(doublereal *)ptr; + *yy++ = f__lx; + *yy = f__ly; + break; + case TYCHAR: + b_char(f__lchar,ptr,len); + break; + } + bump: + if(f__lcount>0) f__lcount--; + ptr += len; + if (nml_read) + nml_read++; + } + return(0); +#undef Ptr +} +#ifdef KR_headers +integer s_rsle(a) cilist *a; +#else +integer s_rsle(cilist *a) +#endif +{ + int n; + + if(n=c_le(a)) return(n); + f__reading=1; + f__external=1; + f__formatted=1; + f__lioproc = l_read; + f__lquit = 0; + f__lcount = 0; + l_eof = 0; + if(f__curunit->uwrt && f__nowreading(f__curunit)) + err(a->cierr,errno,"read start"); + if(f__curunit->uend) + err(f__elist->ciend,(EOF),"read start"); + l_getc = t_getc; + l_ungetc = un_getc; + f__doend = xrd_SL; + return(0); +} diff --git a/libf2c/libI77/lwrite.c b/libf2c/libI77/lwrite.c new file mode 100644 index 00000000000..5da7dfbb972 --- /dev/null +++ b/libf2c/libI77/lwrite.c @@ -0,0 +1,310 @@ +#include "f2c.h" +#include "fio.h" +#include "fmt.h" +#include "lio.h" + +ftnint L_len; +int f__Aquote; + + static VOID +donewrec(Void) +{ + if (f__recpos) + (*f__donewrec)(); + } + +#ifdef KR_headers +t_putc(c) +#else +t_putc(int c) +#endif +{ + f__recpos++; + putc(c,f__cf); + return(0); +} + static VOID +#ifdef KR_headers +lwrt_I(n) longint n; +#else +lwrt_I(longint n) +#endif +{ + char *p; + int ndigit, sign; + + p = f__icvt(n, &ndigit, &sign, 10); + if(f__recpos + ndigit >= L_len) + donewrec(); + PUT(' '); + if (sign) + PUT('-'); + while(*p) + PUT(*p++); +} + static VOID +#ifdef KR_headers +lwrt_L(n, len) ftnint n; ftnlen len; +#else +lwrt_L(ftnint n, ftnlen len) +#endif +{ + if(f__recpos+LLOGW>=L_len) + donewrec(); + wrt_L((Uint *)&n,LLOGW, len); +} + static VOID +#ifdef KR_headers +lwrt_A(p,len) char *p; ftnlen len; +#else +lwrt_A(char *p, ftnlen len) +#endif +{ + int a; + char *p1, *pe; + + a = 0; + pe = p + len; + if (f__Aquote) { + a = 3; + if (len > 1 && p[len-1] == ' ') { + while(--len > 1 && p[len-1] == ' '); + pe = p + len; + } + p1 = p; + while(p1 < pe) + if (*p1++ == '\'') + a++; + } + if(f__recpos+len+a >= L_len) + donewrec(); + if (a +#ifndef OMIT_BLANK_CC + || !f__recpos +#endif + ) + PUT(' '); + if (a) { + PUT('\''); + while(p < pe) { + if (*p == '\'') + PUT('\''); + PUT(*p++); + } + PUT('\''); + } + else + while(p < pe) + PUT(*p++); +} + + static int +#ifdef KR_headers +l_g(buf, n) char *buf; double n; +#else +l_g(char *buf, double n) +#endif +{ +#ifdef Old_list_output + doublereal absn; + char *fmt; + + absn = n; + if (absn < 0) + absn = -absn; + fmt = LLOW <= absn && absn < LHIGH ? LFFMT : LEFMT; +#ifdef USE_STRLEN + sprintf(buf, fmt, n); + return strlen(buf); +#else + return sprintf(buf, fmt, n); +#endif + +#else + register char *b, c, c1; + + b = buf; + *b++ = ' '; + if (n < 0) { + *b++ = '-'; + n = -n; + } + else + *b++ = ' '; + if (n == 0) { + *b++ = '0'; + *b++ = '.'; + *b = 0; + goto f__ret; + } + sprintf(b, LGFMT, n); + switch(*b) { +#ifndef WANT_LEAD_0 + case '0': + while(b[0] = b[1]) + b++; + break; +#endif + case 'i': + case 'I': + /* Infinity */ + case 'n': + case 'N': + /* NaN */ + while(*++b); + break; + + default: + /* Fortran 77 insists on having a decimal point... */ + for(;; b++) + switch(*b) { + case 0: + *b++ = '.'; + *b = 0; + goto f__ret; + case '.': + while(*++b); + goto f__ret; + case 'E': + for(c1 = '.', c = 'E'; *b = c1; + c1 = c, c = *++b); + goto f__ret; + } + } + f__ret: + return b - buf; +#endif + } + + static VOID +#ifdef KR_headers +l_put(s) register char *s; +#else +l_put(register char *s) +#endif +{ +#ifdef KR_headers + register int c, (*pn)() = f__putn; +#else + register int c, (*pn)(int) = f__putn; +#endif + while(c = *s++) + (*pn)(c); + } + + static VOID +#ifdef KR_headers +lwrt_F(n) double n; +#else +lwrt_F(double n) +#endif +{ + char buf[LEFBL]; + + if(f__recpos + l_g(buf,n) >= L_len) + donewrec(); + l_put(buf); +} + static VOID +#ifdef KR_headers +lwrt_C(a,b) double a,b; +#else +lwrt_C(double a, double b) +#endif +{ + char *ba, *bb, bufa[LEFBL], bufb[LEFBL]; + int al, bl; + + al = l_g(bufa, a); + for(ba = bufa; *ba == ' '; ba++) + --al; + bl = l_g(bufb, b) + 1; /* intentionally high by 1 */ + for(bb = bufb; *bb == ' '; bb++) + --bl; + if(f__recpos + al + bl + 3 >= L_len) + donewrec(); +#ifdef OMIT_BLANK_CC + else +#endif + PUT(' '); + PUT('('); + l_put(ba); + PUT(','); + if (f__recpos + bl >= L_len) { + (*f__donewrec)(); +#ifndef OMIT_BLANK_CC + PUT(' '); +#endif + } + l_put(bb); + PUT(')'); +} +#ifdef KR_headers +l_write(number,ptr,len,type) ftnint *number,type; char *ptr; ftnlen len; +#else +l_write(ftnint *number, char *ptr, ftnlen len, ftnint type) +#endif +{ +#define Ptr ((flex *)ptr) + int i; + longint x; + double y,z; + real *xx; + doublereal *yy; + for(i=0;i< *number; i++) + { + switch((int)type) + { + default: f__fatal(204,"unknown type in lio"); + case TYINT1: + x = Ptr->flchar; + goto xint; + case TYSHORT: + x=Ptr->flshort; + goto xint; +#ifdef Allow_TYQUAD + case TYQUAD: + x = Ptr->fllongint; + goto xint; +#endif + case TYLONG: + x=Ptr->flint; + xint: lwrt_I(x); + break; + case TYREAL: + y=Ptr->flreal; + goto xfloat; + case TYDREAL: + y=Ptr->fldouble; + xfloat: lwrt_F(y); + break; + case TYCOMPLEX: + xx= &Ptr->flreal; + y = *xx++; + z = *xx; + goto xcomplex; + case TYDCOMPLEX: + yy = &Ptr->fldouble; + y= *yy++; + z = *yy; + xcomplex: + lwrt_C(y,z); + break; + case TYLOGICAL1: + x = Ptr->flchar; + goto xlog; + case TYLOGICAL2: + x = Ptr->flshort; + goto xlog; + case TYLOGICAL: + x = Ptr->flint; + xlog: lwrt_L(Ptr->flint, len); + break; + case TYCHAR: + lwrt_A(ptr,len); + break; + } + ptr += len; + } + return(0); +} diff --git a/libf2c/libI77/makefile.netlib b/libf2c/libI77/makefile.netlib new file mode 100644 index 00000000000..edba1fe8569 --- /dev/null +++ b/libf2c/libI77/makefile.netlib @@ -0,0 +1,104 @@ +.SUFFIXES: .c .o +CC = cc +CFLAGS = -O +SHELL = /bin/sh + +# compile, then strip unnecessary symbols +.c.o: + $(CC) -c -DSkip_f2c_Undefs $(CFLAGS) $*.c + ld -r -x -o $*.xxx $*.o + mv $*.xxx $*.o +## Under Solaris (and other systems that do not understand ld -x), +## omit -x in the ld line above. +## If your system does not have the ld command, comment out +## or remove both the ld and mv lines above. + +OBJ = Version.o backspace.o close.o dfe.o dolio.o due.o endfile.o err.o \ + fmt.o fmtlib.o ftell_.o iio.o ilnw.o inquire.o lread.o lwrite.o \ + open.o rdfmt.o rewind.o rsfe.o rsli.o rsne.o sfe.o sue.o typesize.o \ + uio.o util.o wref.o wrtfmt.o wsfe.o wsle.o wsne.o xwsne.o +libI77.a: $(OBJ) + ar r libI77.a $? + -ranlib libI77.a + +### If your system lacks ranlib, you don't need it; see README. + +install: libI77.a + cp libI77.a /usr/lib/libI77.a + ranlib /usr/lib/libI77.a + +Version.o: Version.c + $(CC) -c Version.c + +# To compile with C++, first "make f2c.h" +f2c.h: f2ch.add + cat /usr/include/f2c.h f2ch.add >f2c.h + + +clean: + rm -f $(OBJ) libI77.a + +clobber: clean + rm -f libI77.a + +backspace.o: fio.h +close.o: fio.h +dfe.o: fio.h +dfe.o: fmt.h +due.o: fio.h +endfile.o: fio.h rawio.h +err.o: fio.h rawio.h +fmt.o: fio.h +fmt.o: fmt.h +ftell_.o: fio.h +iio.o: fio.h +iio.o: fmt.h +ilnw.o: fio.h +ilnw.o: lio.h +inquire.o: fio.h +lread.o: fio.h +lread.o: fmt.h +lread.o: lio.h +lread.o: fp.h +lwrite.o: fio.h +lwrite.o: fmt.h +lwrite.o: lio.h +open.o: fio.h rawio.h +rdfmt.o: fio.h +rdfmt.o: fmt.h +rdfmt.o: fp.h +rewind.o: fio.h +rsfe.o: fio.h +rsfe.o: fmt.h +rsli.o: fio.h +rsli.o: lio.h +rsne.o: fio.h +rsne.o: lio.h +sfe.o: fio.h +sue.o: fio.h +uio.o: fio.h +util.o: fio.h +wref.o: fio.h +wref.o: fmt.h +wref.o: fp.h +wrtfmt.o: fio.h +wrtfmt.o: fmt.h +wsfe.o: fio.h +wsfe.o: fmt.h +wsle.o: fio.h +wsle.o: fmt.h +wsle.o: lio.h +wsne.o: fio.h +wsne.o: lio.h +xwsne.o: fio.h +xwsne.o: lio.h +xwsne.o: fmt.h + +check: + xsum Notice README Version.c backspace.c close.c dfe.c dolio.c \ + due.c endfile.c err.c f2ch.add fio.h fmt.c fmt.h fmtlib.c fp.h \ + ftell_.c iio.c ilnw.c inquire.c lio.h lread.c lwrite.c makefile \ + open.c rawio.h rdfmt.c rewind.c rsfe.c rsli.c rsne.c sfe.c sue.c \ + typesize.c uio.c util.c wref.c wrtfmt.c wsfe.c wsle.c wsne.c \ + xwsne.c >zap + cmp zap libI77.xsum && rm zap || diff libI77.xsum zap diff --git a/libf2c/libI77/open.c b/libf2c/libI77/open.c new file mode 100644 index 00000000000..b08302b5b2c --- /dev/null +++ b/libf2c/libI77/open.c @@ -0,0 +1,245 @@ +#ifndef NON_UNIX_STDIO +#include +#include +#endif +#include "f2c.h" +#include "fio.h" +#include +#include "rawio.h" + +#ifdef KR_headers +extern char *malloc(), *mktemp(); +extern integer f_clos(); +#else +#undef abs +#undef min +#undef max +#include +extern int f__canseek(FILE*); +extern integer f_clos(cllist*); +#endif + +#ifdef NON_ANSI_RW_MODES +char *f__r_mode[2] = {"r", "r"}; +char *f__w_mode[4] = {"w", "w", "r+w", "r+w"}; +#else +char *f__r_mode[2] = {"rb", "r"}; +char *f__w_mode[4] = {"wb", "w", "r+b", "r+"}; +#endif + +#ifdef KR_headers +f__isdev(s) char *s; +#else +f__isdev(char *s) +#endif +{ +#ifdef NON_UNIX_STDIO + int i, j; + + i = open(s,O_RDONLY); + if (i == -1) + return 0; + j = isatty(i); + close(i); + return j; +#else + struct stat x; + + if(stat(s, &x) == -1) return(0); +#ifdef S_IFMT + switch(x.st_mode&S_IFMT) { + case S_IFREG: + case S_IFDIR: + return(0); + } +#else +#ifdef S_ISREG + /* POSIX version */ + if(S_ISREG(x.st_mode) || S_ISDIR(x.st_mode)) + return(0); + else +#else + Help! How does stat work on this system? +#endif +#endif + return(1); +#endif +} +#ifdef KR_headers +integer f_open(a) olist *a; +#else +integer f_open(olist *a) +#endif +{ unit *b; + integer rv; + char buf[256], *s; + cllist x; + int ufmt; +#ifdef NON_UNIX_STDIO + FILE *tf; +#else + int n; + struct stat stb; +#endif + if(f__init != 1) f_init(); + if(a->ounit>=MXUNIT || a->ounit<0) + err(a->oerr,101,"open"); + f__curunit = b = &f__units[a->ounit]; + if(b->ufd) { + if(a->ofnm==0) + { + same: if (a->oblnk) + b->ublnk = *a->oblnk == 'z' || *a->oblnk == 'Z'; + return(0); + } +#ifdef NON_UNIX_STDIO + if (b->ufnm + && strlen(b->ufnm) == a->ofnmlen + && !strncmp(b->ufnm, b->ufnm, (unsigned)a->ofnmlen)) + goto same; +#else + g_char(a->ofnm,a->ofnmlen,buf); + if (f__inode(buf,&n) == b->uinode && n == b->udev) + goto same; +#endif + x.cunit=a->ounit; + x.csta=0; + x.cerr=a->oerr; + if ((rv = f_clos(&x)) != 0) + return rv; + } + b->url = (int)a->orl; + b->ublnk = a->oblnk && (*a->oblnk == 'z' || *a->oblnk == 'Z'); + if(a->ofm==0) + { if(b->url>0) b->ufmt=0; + else b->ufmt=1; + } + else if(*a->ofm=='f' || *a->ofm == 'F') b->ufmt=1; + else b->ufmt=0; + ufmt = b->ufmt; +#ifdef url_Adjust + if (b->url && !ufmt) + url_Adjust(b->url); +#endif + if (a->ofnm) { + g_char(a->ofnm,a->ofnmlen,buf); + if (!buf[0]) + err(a->oerr,107,"open"); + } + else + sprintf(buf, "fort.%ld", a->ounit); + b->uscrtch = 0; + switch(a->osta ? *a->osta : 'u') + { + case 'o': + case 'O': +#ifdef NON_UNIX_STDIO + if(access(buf,0)) +#else + if(stat(buf,&stb)) +#endif + err(a->oerr,errno,"open"); + break; + case 's': + case 'S': + b->uscrtch=1; +#ifdef _POSIX_SOURCE + tmpnam(buf); +#else + (void) strcpy(buf,"tmp.FXXXXXX"); + (void) mktemp(buf); +#endif + goto replace; + case 'n': + case 'N': +#ifdef NON_UNIX_STDIO + if(!access(buf,0)) +#else + if(!stat(buf,&stb)) +#endif + err(a->oerr,128,"open"); + /* no break */ + case 'r': /* Fortran 90 replace option */ + case 'R': + replace: +#ifdef NON_UNIX_STDIO + if (tf = fopen(buf,f__w_mode[0])) + fclose(tf); +#else + (void) close(creat(buf, 0666)); +#endif + } + + b->ufnm=(char *) malloc((unsigned int)(strlen(buf)+1)); + if(b->ufnm==NULL) err(a->oerr,113,"no space"); + (void) strcpy(b->ufnm,buf); + b->uend=0; + b->uwrt = 0; +#ifdef NON_UNIX_STDIO + if ((s = a->oacc) && (*s == 'd' || *s == 'D')) + ufmt = 0; +#endif + if(f__isdev(buf)) + { b->ufd = fopen(buf,f__r_mode[ufmt]); + if(b->ufd==NULL) err(a->oerr,errno,buf); + } + else { + if(!(b->ufd = fopen(buf, f__r_mode[ufmt]))) { +#ifdef NON_UNIX_STDIO + if (b->ufd = fopen(buf, f__w_mode[ufmt|2])) + b->uwrt = 2; + else if (b->ufd = fopen(buf, f__w_mode[ufmt])) + b->uwrt = 1; + else +#else + if ((n = open(buf,O_WRONLY)) >= 0) + b->uwrt = 2; + else { + n = creat(buf, 0666); + b->uwrt = 1; + } + if (n < 0 + || (b->ufd = fdopen(n, f__w_mode[ufmt])) == NULL) +#endif + err(a->oerr, errno, "open"); + } + } + b->useek=f__canseek(b->ufd); +#ifndef NON_UNIX_STDIO + if((b->uinode=f__inode(buf,&b->udev))==-1) + err(a->oerr,108,"open"); +#endif + if(b->useek) + if (a->orl) + rewind(b->ufd); + else if ((s = a->oacc) && (*s == 'a' || *s == 'A') + && fseek(b->ufd, 0L, SEEK_END)) + err(a->oerr,129,"open"); + return(0); +} +#ifdef KR_headers +fk_open(seq,fmt,n) ftnint n; +#else +fk_open(int seq, int fmt, ftnint n) +#endif +{ char nbuf[10]; + olist a; + int rtn; + int save_init; + + (void) sprintf(nbuf,"fort.%ld",n); + a.oerr=1; + a.ounit=n; + a.ofnm=nbuf; + a.ofnmlen=strlen(nbuf); + a.osta=NULL; + a.oacc= seq==SEQ?"s":"d"; + a.ofm = fmt==FMT?"f":"u"; + a.orl = seq==DIR?1:0; + a.oblnk=NULL; + save_init = f__init; + f__init &= ~2; + rtn = f_open(&a); + f__init = save_init | 1; + return rtn; +} diff --git a/libf2c/libI77/rawio.h b/libf2c/libI77/rawio.h new file mode 100644 index 00000000000..1c165458494 --- /dev/null +++ b/libf2c/libI77/rawio.h @@ -0,0 +1,47 @@ +#ifdef KR_headers +extern FILE *fdopen(); +#else +#if defined (MSDOS) && !defined (GO32) +#include "io.h" +#ifndef WATCOM +#define close _close +#define creat _creat +#define open _open +#define read _read +#define write _write +#endif /*WATCOM*/ +#endif /*MSDOS*/ +#ifdef __cplusplus +extern "C" { +#endif +#if !(defined (MSDOS) && !defined (GO32)) +#ifdef OPEN_DECL +extern int creat(const char*,int), open(const char*,int); +#endif +extern int close(int); +#if !(defined(_WIN32) && !defined(__CYGWIN32__)) +extern int read(int,void*,size_t), write(int,void*,size_t); +#endif +extern int unlink(const char*); +#ifndef _POSIX_SOURCE +#ifndef NON_UNIX_STDIO +extern FILE *fdopen(int, const char*); +#endif +#endif +#endif /*KR_HEADERS*/ + +extern char *mktemp(char*); + +#ifdef __cplusplus + } +#endif +#endif + +#ifndef NO_FCNTL +#include +#endif + +#ifndef O_WRONLY +#define O_RDONLY 0 +#define O_WRONLY 1 +#endif diff --git a/libf2c/libI77/rdfmt.c b/libf2c/libI77/rdfmt.c new file mode 100644 index 00000000000..b03bcc5dbf6 --- /dev/null +++ b/libf2c/libI77/rdfmt.c @@ -0,0 +1,476 @@ +#include +#include "f2c.h" +#include "fio.h" + +extern int f__cursor; +#ifdef KR_headers +extern double atof(); +#else +#undef abs +#undef min +#undef max +#include +#endif + +#include "fmt.h" +#include "fp.h" + + static int +#ifdef KR_headers +rd_Z(n,w,len) Uint *n; ftnlen len; +#else +rd_Z(Uint *n, int w, ftnlen len) +#endif +{ + long x[9]; + char *s, *s0, *s1, *se, *t; + int ch, i, w1, w2; + static char hex[256]; + static int one = 1; + int bad = 0; + + if (!hex['0']) { + s = "0123456789"; + while(ch = *s++) + hex[ch] = ch - '0' + 1; + s = "ABCDEF"; + while(ch = *s++) + hex[ch] = hex[ch + 'a' - 'A'] = ch - 'A' + 11; + } + s = s0 = (char *)x; + s1 = (char *)&x[4]; + se = (char *)&x[8]; + if (len > 4*sizeof(long)) + return errno = 117; + while (w) { + GET(ch); + if (ch==',' || ch=='\n') + break; + w--; + if (ch > ' ') { + if (!hex[ch & 0xff]) + bad++; + *s++ = ch; + if (s == se) { + /* discard excess characters */ + for(t = s0, s = s1; t < s1;) + *t++ = *s++; + s = s1; + } + } + } + if (bad) + return errno = 115; + w = (int)len; + w1 = s - s0; + w2 = w1+1 >> 1; + t = (char *)n; + if (*(char *)&one) { + /* little endian */ + t += w - 1; + i = -1; + } + else + i = 1; + for(; w > w2; t += i, --w) + *t = 0; + if (!w) + return 0; + if (w < w2) + s0 = s - (w << 1); + else if (w1 & 1) { + *t = hex[*s0++ & 0xff] - 1; + if (!--w) + return 0; + t += i; + } + do { + *t = hex[*s0 & 0xff]-1 << 4 | hex[s0[1] & 0xff]-1; + t += i; + s0 += 2; + } + while(--w); + return 0; + } + + static int +#ifdef KR_headers +rd_I(n,w,len, base) Uint *n; int w; ftnlen len; register int base; +#else +rd_I(Uint *n, int w, ftnlen len, register int base) +#endif +{ longint x; + int sign,ch; + char s[84], *ps; + ps=s; x=0; + while (w) + { + GET(ch); + if (ch==',' || ch=='\n') break; + *ps=ch; ps++; w--; + } + *ps='\0'; + ps=s; + while (*ps==' ') ps++; + if (*ps=='-') { sign=1; ps++; } + else { sign=0; if (*ps=='+') ps++; } +loop: while (*ps>='0' && *ps<='9') { x=x*base+(*ps-'0'); ps++; } + if (*ps==' ') {if (f__cblank) x *= base; ps++; goto loop;} + if(sign) x = -x; + if(len==sizeof(integer)) n->il=x; + else if(len == sizeof(char)) n->ic = (char)x; +#ifdef Allow_TYQUAD + else if (len == sizeof(longint)) n->ili = x; +#endif + else n->is = (short)x; + if (*ps) return(errno=115); else return(0); +} + static int +#ifdef KR_headers +rd_L(n,w,len) ftnint *n; ftnlen len; +#else +rd_L(ftnint *n, int w, ftnlen len) +#endif +{ int ch, lv; + char s[84], *ps; + ps=s; + while (w) { + GET(ch); + if (ch==','||ch=='\n') break; + *ps=ch; + ps++; w--; + } + *ps='\0'; + ps=s; while (*ps==' ') ps++; + if (*ps=='.') ps++; + if (*ps=='t' || *ps == 'T') + lv = 1; + else if (*ps == 'f' || *ps == 'F') + lv = 0; + else return(errno=116); + switch(len) { + case sizeof(char): *(char *)n = (char)lv; break; + case sizeof(short): *(short *)n = (short)lv; break; + default: *n = lv; + } + return 0; +} + + static int +#ifdef KR_headers +rd_F(p, w, d, len) ufloat *p; ftnlen len; +#else +rd_F(ufloat *p, int w, int d, ftnlen len) +#endif +{ + char s[FMAX+EXPMAXDIGS+4]; + register int ch; + register char *sp, *spe, *sp1; + double x; + int scale1, se; + long e, exp; + + sp1 = sp = s; + spe = sp + FMAX; + exp = -d; + x = 0.; + + do { + GET(ch); + w--; + } while (ch == ' ' && w); + switch(ch) { + case '-': *sp++ = ch; sp1++; spe++; + case '+': + if (!w) goto zero; + --w; + GET(ch); + } + while(ch == ' ') { +blankdrop: + if (!w--) goto zero; GET(ch); } + while(ch == '0') + { if (!w--) goto zero; GET(ch); } + if (ch == ' ' && f__cblank) + goto blankdrop; + scale1 = f__scale; + while(isdigit(ch)) { +digloop1: + if (sp < spe) *sp++ = ch; + else ++exp; +digloop1e: + if (!w--) goto done; + GET(ch); + } + if (ch == ' ') { + if (f__cblank) + { ch = '0'; goto digloop1; } + goto digloop1e; + } + if (ch == '.') { + exp += d; + if (!w--) goto done; + GET(ch); + if (sp == sp1) { /* no digits yet */ + while(ch == '0') { +skip01: + --exp; +skip0: + if (!w--) goto done; + GET(ch); + } + if (ch == ' ') { + if (f__cblank) goto skip01; + goto skip0; + } + } + while(isdigit(ch)) { +digloop2: + if (sp < spe) + { *sp++ = ch; --exp; } +digloop2e: + if (!w--) goto done; + GET(ch); + } + if (ch == ' ') { + if (f__cblank) + { ch = '0'; goto digloop2; } + goto digloop2e; + } + } + switch(ch) { + default: + break; + case '-': se = 1; goto signonly; + case '+': se = 0; goto signonly; + case 'e': + case 'E': + case 'd': + case 'D': + if (!w--) + goto bad; + GET(ch); + while(ch == ' ') { + if (!w--) + goto bad; + GET(ch); + } + se = 0; + switch(ch) { + case '-': se = 1; + case '+': +signonly: + if (!w--) + goto bad; + GET(ch); + } + while(ch == ' ') { + if (!w--) + goto bad; + GET(ch); + } + if (!isdigit(ch)) + goto bad; + + e = ch - '0'; + for(;;) { + if (!w--) + { ch = '\n'; break; } + GET(ch); + if (!isdigit(ch)) { + if (ch == ' ') { + if (f__cblank) + ch = '0'; + else continue; + } + else + break; + } + e = 10*e + ch - '0'; + if (e > EXPMAX && sp > sp1) + goto bad; + } + if (se) + exp -= e; + else + exp += e; + scale1 = 0; + } + switch(ch) { + case '\n': + case ',': + break; + default: +bad: + return (errno = 115); + } +done: + if (sp > sp1) { + while(*--sp == '0') + ++exp; + if (exp -= scale1) + sprintf(sp+1, "e%ld", exp); + else + sp[1] = 0; + x = atof(s); + } +zero: + if (len == sizeof(real)) + p->pf = x; + else + p->pd = x; + return(0); + } + + + static int +#ifdef KR_headers +rd_A(p,len) char *p; ftnlen len; +#else +rd_A(char *p, ftnlen len) +#endif +{ int i,ch; + for(i=0;i=len) + { for(i=0;i0;f__cursor--) if((ch=(*f__getn)())<0) return(ch); + if(f__cursor<0) + { if(f__recpos+f__cursor < 0) /*err(elist->cierr,110,"fmt")*/ + f__cursor = -f__recpos; /* is this in the standard? */ + if(f__external == 0) { + extern char *f__icptr; + f__icptr += f__cursor; + } + else if(f__curunit && f__curunit->useek) + (void) fseek(f__cf,(long) f__cursor,SEEK_CUR); + else + err(f__elist->cierr,106,"fmt"); + f__recpos += f__cursor; + f__cursor=0; + } + switch(p->op) + { + default: fprintf(stderr,"rd_ed, unexpected code: %d\n", p->op); + sig_die(f__fmtbuf, 1); + case IM: + case I: ch = rd_I((Uint *)ptr,p->p1,len, 10); + break; + + /* O and OM don't work right for character, double, complex, */ + /* or doublecomplex, and they differ from Fortran 90 in */ + /* showing a minus sign for negative values. */ + + case OM: + case O: ch = rd_I((Uint *)ptr, p->p1, len, 8); + break; + case L: ch = rd_L((ftnint *)ptr,p->p1,len); + break; + case A: ch = rd_A(ptr,len); + break; + case AW: + ch = rd_AW(ptr,p->p1,len); + break; + case E: case EE: + case D: + case G: + case GE: + case F: ch = rd_F((ufloat *)ptr,p->p1,p->p2.i[0],len); + break; + + /* Z and ZM assume 8-bit bytes. */ + + case ZM: + case Z: + ch = rd_Z((Uint *)ptr, p->p1, len); + break; + } + if(ch == 0) return(ch); + else if(ch == EOF) return(EOF); + if (f__cf) + clearerr(f__cf); + return(errno); +} +#ifdef KR_headers +rd_ned(p) struct syl *p; +#else +rd_ned(struct syl *p) +#endif +{ + switch(p->op) + { + default: fprintf(stderr,"rd_ned, unexpected code: %d\n", p->op); + sig_die(f__fmtbuf, 1); + case APOS: + return(rd_POS(p->p2.s)); + case H: return(rd_H(p->p1,p->p2.s)); + case SLASH: return((*f__donewrec)()); + case TR: + case X: f__cursor += p->p1; + return(1); + case T: f__cursor=p->p1-f__recpos - 1; + return(1); + case TL: f__cursor -= p->p1; + if(f__cursor < -f__recpos) /* TL1000, 1X */ + f__cursor = -f__recpos; + return(1); + } +} diff --git a/libf2c/libI77/rewind.c b/libf2c/libI77/rewind.c new file mode 100644 index 00000000000..9ba4b239f32 --- /dev/null +++ b/libf2c/libI77/rewind.c @@ -0,0 +1,26 @@ +#include "f2c.h" +#include "fio.h" +#ifdef KR_headers +integer f_rew(a) alist *a; +#else +integer f_rew(alist *a) +#endif +{ + unit *b; + if (f__init & 2) + f__fatal (131, "I/O recursion"); + if(a->aunit>=MXUNIT || a->aunit<0) + err(a->aerr,101,"rewind"); + b = &f__units[a->aunit]; + if(b->ufd == NULL || b->uwrt == 3) + return(0); + if(!b->useek) + err(a->aerr,106,"rewind"); + if(b->uwrt) { + (void) t_runc(a); + b->uwrt = 3; + } + rewind(b->ufd); + b->uend=0; + return(0); +} diff --git a/libf2c/libI77/rsfe.c b/libf2c/libI77/rsfe.c new file mode 100644 index 00000000000..02a9e6d4680 --- /dev/null +++ b/libf2c/libI77/rsfe.c @@ -0,0 +1,80 @@ +/* read sequential formatted external */ +#include "f2c.h" +#include "fio.h" +#include "fmt.h" + +xrd_SL(Void) +{ int ch; + if(!f__curunit->uend) + while((ch=getc(f__cf))!='\n') + if (ch == EOF) { + f__curunit->uend = 1; + break; + } + f__cursor=f__recpos=0; + return(1); +} +x_getc(Void) +{ int ch; + if(f__curunit->uend) return(EOF); + ch = getc(f__cf); + if(ch!=EOF && ch!='\n') + { f__recpos++; + return(ch); + } + if(ch=='\n') + { (void) ungetc(ch,f__cf); + return(ch); + } + if(f__curunit->uend || feof(f__cf)) + { errno=0; + f__curunit->uend=1; + return(-1); + } + return(-1); +} +x_endp(Void) +{ + xrd_SL(); + return f__curunit->uend == 1 ? EOF : 0; +} +x_rev(Void) +{ + (void) xrd_SL(); + return(0); +} +#ifdef KR_headers +integer s_rsfe(a) cilist *a; /* start */ +#else +integer s_rsfe(cilist *a) /* start */ +#endif +{ int n; + if(f__init != 1) f_init(); + f__init = 3; + if(n=c_sfe(a)) return(n); + f__reading=1; + f__sequential=1; + f__formatted=1; + f__external=1; + f__elist=a; + f__cursor=f__recpos=0; + f__scale=0; + f__fmtbuf=a->cifmt; + f__curunit= &f__units[a->ciunit]; + f__cf=f__curunit->ufd; + if(pars_f(f__fmtbuf)<0) err(a->cierr,100,"startio"); + f__getn= x_getc; + f__doed= rd_ed; + f__doned= rd_ned; + fmt_bg(); + f__doend=x_endp; + f__donewrec=xrd_SL; + f__dorevert=x_rev; + f__cblank=f__curunit->ublnk; + f__cplus=0; + if(f__curunit->uwrt && f__nowreading(f__curunit)) + err(a->cierr,errno,"read start"); + if(f__curunit->uend) + err(f__elist->ciend,(EOF),"read start"); + return(0); +} diff --git a/libf2c/libI77/rsli.c b/libf2c/libI77/rsli.c new file mode 100644 index 00000000000..baf2ba54873 --- /dev/null +++ b/libf2c/libI77/rsli.c @@ -0,0 +1,105 @@ +#include "f2c.h" +#include "fio.h" +#include "lio.h" +#include "fmt.h" /* for f__doend */ + +extern flag f__lquit; +extern int f__lcount; +extern char *f__icptr; +extern char *f__icend; +extern icilist *f__svic; +extern int f__icnum, f__recpos; + +static int i_getc(Void) +{ + if(f__recpos >= f__svic->icirlen) { + if (f__recpos++ == f__svic->icirlen) + return '\n'; + z_rnew(); + } + f__recpos++; + if(f__icptr >= f__icend) + return EOF; + return(*f__icptr++); + } + + static +#ifdef KR_headers +int i_ungetc(ch, f) int ch; FILE *f; +#else +int i_ungetc(int ch, FILE *f) +#endif +{ + if (--f__recpos == f__svic->icirlen) + return '\n'; + if (f__recpos < -1) + err(f__svic->icierr,110,"recend"); + /* *--icptr == ch, and icptr may point to read-only memory */ + return *--f__icptr /* = ch */; + } + + static void +#ifdef KR_headers +c_lir(a) icilist *a; +#else +c_lir(icilist *a) +#endif +{ + extern int l_eof; + if(f__init != 1) f_init(); + f__init = 3; + f__reading = 1; + f__external = 0; + f__formatted = 1; + f__svic = a; + L_len = a->icirlen; + f__recpos = -1; + f__icnum = f__recpos = 0; + f__cursor = 0; + l_getc = i_getc; + l_ungetc = i_ungetc; + l_eof = 0; + f__icptr = a->iciunit; + f__icend = f__icptr + a->icirlen*a->icirnum; + f__cf = 0; + f__curunit = 0; + f__elist = (cilist *)a; + } + + +#ifdef KR_headers +integer s_rsli(a) icilist *a; +#else +integer s_rsli(icilist *a) +#endif +{ + f__lioproc = l_read; + f__lquit = 0; + f__lcount = 0; + c_lir(a); + f__doend = 0; + return(0); + } + +integer e_rsli(Void) +{ f__init = 1; return 0; } + +#ifdef KR_headers +integer s_rsni(a) icilist *a; +#else +extern int x_rsne(cilist*); + +integer s_rsni(icilist *a) +#endif +{ + extern int nml_read; + integer rv; + cilist ca; + ca.ciend = a->iciend; + ca.cierr = a->icierr; + ca.cifmt = a->icifmt; + c_lir(a); + rv = x_rsne(&ca); + nml_read = 0; + return rv; + } diff --git a/libf2c/libI77/rsne.c b/libf2c/libI77/rsne.c new file mode 100644 index 00000000000..86bb2164f12 --- /dev/null +++ b/libf2c/libI77/rsne.c @@ -0,0 +1,607 @@ +#include "f2c.h" +#include "fio.h" +#include "lio.h" + +#define MAX_NL_CACHE 3 /* maximum number of namelist hash tables to cache */ +#define MAXDIM 20 /* maximum number of subscripts */ + + struct dimen { + ftnlen extent; + ftnlen curval; + ftnlen delta; + ftnlen stride; + }; + typedef struct dimen dimen; + + struct hashentry { + struct hashentry *next; + char *name; + Vardesc *vd; + }; + typedef struct hashentry hashentry; + + struct hashtab { + struct hashtab *next; + Namelist *nl; + int htsize; + hashentry *tab[1]; + }; + typedef struct hashtab hashtab; + + static hashtab *nl_cache; + static int n_nlcache; + static hashentry **zot; + static int colonseen; + extern ftnlen f__typesize[]; + + extern flag f__lquit; + extern int f__lcount, nml_read; + extern t_getc(Void); + +#ifdef KR_headers + extern char *malloc(), *memset(); + +#ifdef ungetc + static int +un_getc(x,f__cf) int x; FILE *f__cf; +{ return ungetc(x,f__cf); } +#else +#define un_getc ungetc + extern int ungetc(); +#endif + +#else +#undef abs +#undef min +#undef max +#include +#include + +#ifdef ungetc + static int +un_getc(int x, FILE *f__cf) +{ return ungetc(x,f__cf); } +#else +#define un_getc ungetc +extern int ungetc(int, FILE*); /* for systems with a buggy stdio.h */ +#endif +#endif + + static Vardesc * +#ifdef KR_headers +hash(ht, s) hashtab *ht; register char *s; +#else +hash(hashtab *ht, register char *s) +#endif +{ + register int c, x; + register hashentry *h; + char *s0 = s; + + for(x = 0; c = *s++; x = x & 0x4000 ? ((x << 1) & 0x7fff) + 1 : x << 1) + x += c; + for(h = *(zot = ht->tab + x % ht->htsize); h; h = h->next) + if (!strcmp(s0, h->name)) + return h->vd; + return 0; + } + + hashtab * +#ifdef KR_headers +mk_hashtab(nl) Namelist *nl; +#else +mk_hashtab(Namelist *nl) +#endif +{ + int nht, nv; + hashtab *ht; + Vardesc *v, **vd, **vde; + hashentry *he; + + hashtab **x, **x0, *y; + for(x = &nl_cache; y = *x; x0 = x, x = &y->next) + if (nl == y->nl) + return y; + if (n_nlcache >= MAX_NL_CACHE) { + /* discard least recently used namelist hash table */ + y = *x0; + free((char *)y->next); + y->next = 0; + } + else + n_nlcache++; + nv = nl->nvars; + if (nv >= 0x4000) + nht = 0x7fff; + else { + for(nht = 1; nht < nv; nht <<= 1); + nht += nht - 1; + } + ht = (hashtab *)malloc(sizeof(hashtab) + (nht-1)*sizeof(hashentry *) + + nv*sizeof(hashentry)); + if (!ht) + return 0; + he = (hashentry *)&ht->tab[nht]; + ht->nl = nl; + ht->htsize = nht; + ht->next = nl_cache; + nl_cache = ht; + memset((char *)ht->tab, 0, nht*sizeof(hashentry *)); + vd = nl->vars; + vde = vd + nv; + while(vd < vde) { + v = *vd++; + if (!hash(ht, v->name)) { + he->next = *zot; + *zot = he; + he->name = v->name; + he->vd = v; + he++; + } + } + return ht; + } + +static char Alpha[256], Alphanum[256]; + + static VOID +nl_init(Void) { + register char *s; + register int c; + + for(s = "ABCDEFGHIJKLMNOPQRSTUVWXYZ"; c = *s++; ) + Alpha[c] + = Alphanum[c] + = Alpha[c + 'a' - 'A'] + = Alphanum[c + 'a' - 'A'] + = c; + for(s = "0123456789_"; c = *s++; ) + Alphanum[c] = c; + } + +#define GETC(x) (x=(*l_getc)()) +#define Ungetc(x,y) (*l_ungetc)(x,y) + + static int +#ifdef KR_headers +getname(s, slen) register char *s; int slen; +#else +getname(register char *s, int slen) +#endif +{ + register char *se = s + slen - 1; + register int ch; + + GETC(ch); + if (!(*s++ = Alpha[ch & 0xff])) { + if (ch != EOF) + ch = 115; + errfl(f__elist->cierr, ch, "namelist read"); + } + while(*s = Alphanum[GETC(ch) & 0xff]) + if (s < se) + s++; + if (ch == EOF) + err(f__elist->cierr, EOF, "namelist read"); + if (ch > ' ') + Ungetc(ch,f__cf); + return *s = 0; + } + + static int +#ifdef KR_headers +getnum(chp, val) int *chp; ftnlen *val; +#else +getnum(int *chp, ftnlen *val) +#endif +{ + register int ch, sign; + register ftnlen x; + + while(GETC(ch) <= ' ' && ch >= 0); + if (ch == '-') { + sign = 1; + GETC(ch); + } + else { + sign = 0; + if (ch == '+') + GETC(ch); + } + x = ch - '0'; + if (x < 0 || x > 9) + return 115; + while(GETC(ch) >= '0' && ch <= '9') + x = 10*x + ch - '0'; + while(ch <= ' ' && ch >= 0) + GETC(ch); + if (ch == EOF) + return EOF; + *val = sign ? -x : x; + *chp = ch; + return 0; + } + + static int +#ifdef KR_headers +getdimen(chp, d, delta, extent, x1) + int *chp; dimen *d; ftnlen delta, extent, *x1; +#else +getdimen(int *chp, dimen *d, ftnlen delta, ftnlen extent, ftnlen *x1) +#endif +{ + register int k; + ftnlen x2, x3; + + if (k = getnum(chp, x1)) + return k; + x3 = 1; + if (*chp == ':') { + if (k = getnum(chp, &x2)) + return k; + x2 -= *x1; + if (*chp == ':') { + if (k = getnum(chp, &x3)) + return k; + if (!x3) + return 123; + x2 /= x3; + colonseen = 1; + } + if (x2 < 0 || x2 >= extent) + return 123; + d->extent = x2 + 1; + } + else + d->extent = 1; + d->curval = 0; + d->delta = delta; + d->stride = x3; + return 0; + } + +#ifndef No_Namelist_Questions + static Void +#ifdef KR_headers +print_ne(a) cilist *a; +#else +print_ne(cilist *a) +#endif +{ + flag intext = f__external; + int rpsave = f__recpos; + FILE *cfsave = f__cf; + unit *usave = f__curunit; + cilist t; + t = *a; + t.ciunit = 6; + s_wsne(&t); + fflush(f__cf); + f__external = intext; + f__reading = 1; + f__recpos = rpsave; + f__cf = cfsave; + f__curunit = usave; + f__elist = a; + } +#endif + + static char where0[] = "namelist read start "; + +#ifdef KR_headers +x_rsne(a) cilist *a; +#else +x_rsne(cilist *a) +#endif +{ + int ch, got1, k, n, nd, quote, readall; + Namelist *nl; + static char where[] = "namelist read"; + char buf[64]; + hashtab *ht; + Vardesc *v; + dimen *dn, *dn0, *dn1; + ftnlen *dims, *dims1; + ftnlen b, b0, b1, ex, no, no1, nomax, size, span; + ftnint type; + char *vaddr; + long iva, ivae; + dimen dimens[MAXDIM], substr; + + if (!Alpha['a']) + nl_init(); + f__reading=1; + f__formatted=1; + got1 = 0; + top: + for(;;) switch(GETC(ch)) { + case EOF: + eof: + err(a->ciend,(EOF),where0); + case '&': + case '$': + goto have_amp; +#ifndef No_Namelist_Questions + case '?': + print_ne(a); + continue; +#endif + default: + if (ch <= ' ' && ch >= 0) + continue; +#ifndef No_Namelist_Comments + while(GETC(ch) != '\n') + if (ch == EOF) + goto eof; +#else + errfl(a->cierr, 115, where0); +#endif + } + have_amp: + if (ch = getname(buf,(int) sizeof(buf))) + return ch; + nl = (Namelist *)a->cifmt; + if (strcmp(buf, nl->name)) +#ifdef No_Bad_Namelist_Skip + errfl(a->cierr, 118, where0); +#else + { + fprintf(stderr, + "Skipping namelist \"%s\": seeking namelist \"%s\".\n", + buf, nl->name); + fflush(stderr); + for(;;) switch(GETC(ch)) { + case EOF: + err(a->ciend, EOF, where0); + case '/': + case '&': + case '$': + if (f__external) + e_rsle(); + else + z_rnew(); + goto top; + case '"': + case '\'': + quote = ch; + more_quoted: + while(GETC(ch) != quote) + if (ch == EOF) + err(a->ciend, EOF, where0); + if (GETC(ch) == quote) + goto more_quoted; + Ungetc(ch,f__cf); + default: + continue; + } + } +#endif + ht = mk_hashtab(nl); + if (!ht) + errfl(f__elist->cierr, 113, where0); + for(;;) { + for(;;) switch(GETC(ch)) { + case EOF: + if (got1) + return 0; + err(a->ciend, EOF, where0); + case '/': + case '$': + case '&': + return 0; + default: + if (ch <= ' ' && ch >= 0 || ch == ',') + continue; + Ungetc(ch,f__cf); + if (ch = getname(buf,(int) sizeof(buf))) + return ch; + goto havename; + } + havename: + v = hash(ht,buf); + if (!v) + errfl(a->cierr, 119, where); + while(GETC(ch) <= ' ' && ch >= 0); + vaddr = v->addr; + type = v->type; + if (type < 0) { + size = -type; + type = TYCHAR; + } + else + size = f__typesize[type]; + ivae = size; + iva = readall = 0; + if (ch == '(' /*)*/ ) { + dn = dimens; + if (!(dims = v->dims)) { + if (type != TYCHAR) + errfl(a->cierr, 122, where); + if (k = getdimen(&ch, dn, (ftnlen)size, + (ftnlen)size, &b)) + errfl(a->cierr, k, where); + if (ch != ')') + errfl(a->cierr, 115, where); + b1 = dn->extent; + if (--b < 0 || b + b1 > size) + return 124; + iva += b; + size = b1; + while(GETC(ch) <= ' ' && ch >= 0); + goto scalar; + } + nd = (int)dims[0]; + nomax = span = dims[1]; + ivae = iva + size*nomax; + colonseen = 0; + if (k = getdimen(&ch, dn, size, nomax, &b)) + errfl(a->cierr, k, where); + no = dn->extent; + b0 = dims[2]; + dims1 = dims += 3; + ex = 1; + for(n = 1; n++ < nd; dims++) { + if (ch != ',') + errfl(a->cierr, 115, where); + dn1 = dn + 1; + span /= *dims; + if (k = getdimen(&ch, dn1, dn->delta**dims, + span, &b1)) + errfl(a->cierr, k, where); + ex *= *dims; + b += b1*ex; + no *= dn1->extent; + dn = dn1; + } + if (ch != ')') + errfl(a->cierr, 115, where); + readall = 1 - colonseen; + b -= b0; + if (b < 0 || b >= nomax) + errfl(a->cierr, 125, where); + iva += size * b; + dims = dims1; + while(GETC(ch) <= ' ' && ch >= 0); + no1 = 1; + dn0 = dimens; + if (type == TYCHAR && ch == '(' /*)*/) { + if (k = getdimen(&ch, &substr, size, size, &b)) + errfl(a->cierr, k, where); + if (ch != ')') + errfl(a->cierr, 115, where); + b1 = substr.extent; + if (--b < 0 || b + b1 > size) + return 124; + iva += b; + b0 = size; + size = b1; + while(GETC(ch) <= ' ' && ch >= 0); + if (b1 < b0) + goto delta_adj; + } + if (readall) + goto delta_adj; + for(; dn0 < dn; dn0++) { + if (dn0->extent != *dims++ || dn0->stride != 1) + break; + no1 *= dn0->extent; + } + if (dn0 == dimens && dimens[0].stride == 1) { + no1 = dimens[0].extent; + dn0++; + } + delta_adj: + ex = 0; + for(dn1 = dn0; dn1 <= dn; dn1++) + ex += (dn1->extent-1) + * (dn1->delta *= dn1->stride); + for(dn1 = dn; dn1 > dn0; dn1--) { + ex -= (dn1->extent - 1) * dn1->delta; + dn1->delta -= ex; + } + } + else if (dims = v->dims) { + no = no1 = dims[1]; + ivae = iva + no*size; + } + else + scalar: + no = no1 = 1; + if (ch != '=') + errfl(a->cierr, 115, where); + got1 = nml_read = 1; + f__lcount = 0; + readloop: + for(;;) { + if (iva >= ivae || iva < 0) { + f__lquit = 1; + goto mustend; + } + else if (iva + no1*size > ivae) + no1 = (ivae - iva)/size; + f__lquit = 0; + if (k = l_read(&no1, vaddr + iva, size, type)) + return k; + if (f__lquit == 1) + return 0; + if (readall) { + iva += dn0->delta; + if (f__lcount > 0) { + no1 = (ivae - iva)/size; + if (no1 > f__lcount) + no1 = f__lcount; + iva += no1 * dn0->delta; + if (k = l_read(&no1, vaddr + iva, + size, type)) + return k; + } + } + mustend: + GETC(ch); + if (readall) + if (iva >= ivae) + readall = 0; + else for(;;) { + switch(ch) { + case ' ': + case '\t': + case '\n': + GETC(ch); + continue; + } + break; + } + if (ch == '/' || ch == '$' || ch == '&') { + f__lquit = 1; + return 0; + } + else if (f__lquit) { + while(ch <= ' ' && ch >= 0) + GETC(ch); + Ungetc(ch,f__cf); + if (!Alpha[ch & 0xff] && ch >= 0) + errfl(a->cierr, 125, where); + break; + } + Ungetc(ch,f__cf); + if (readall && !Alpha[ch & 0xff]) + goto readloop; + if ((no -= no1) <= 0) + break; + for(dn1 = dn0; dn1 <= dn; dn1++) { + if (++dn1->curval < dn1->extent) { + iva += dn1->delta; + goto readloop; + } + dn1->curval = 0; + } + break; + } + } + } + + integer +#ifdef KR_headers +s_rsne(a) cilist *a; +#else +s_rsne(cilist *a) +#endif +{ + extern int l_eof; + int n; + + f__external=1; + l_eof = 0; + if(n = c_le(a)) + return n; + if(f__curunit->uwrt && f__nowreading(f__curunit)) + err(a->cierr,errno,where0); + l_getc = t_getc; + l_ungetc = un_getc; + f__doend = xrd_SL; + n = x_rsne(a); + nml_read = 0; + if (n) + return n; + return e_rsle(); + } diff --git a/libf2c/libI77/sfe.c b/libf2c/libI77/sfe.c new file mode 100644 index 00000000000..1bb10d9052d --- /dev/null +++ b/libf2c/libI77/sfe.c @@ -0,0 +1,44 @@ +/* sequential formatted external common routines*/ +#include "f2c.h" +#include "fio.h" + +extern char *f__fmtbuf; + +integer e_rsfe(Void) +{ int n; + f__init = 1; + n=en_fio(); + if (f__cf == stdout) + fflush(stdout); + else if (f__cf == stderr) + fflush(stderr); + f__fmtbuf=NULL; + return(n); +} +#ifdef KR_headers +c_sfe(a) cilist *a; /* check */ +#else +c_sfe(cilist *a) /* check */ +#endif +{ unit *p; + if(a->ciunit >= MXUNIT || a->ciunit<0) + err(a->cierr,101,"startio"); + p = &f__units[a->ciunit]; + if(p->ufd==NULL && fk_open(SEQ,FMT,a->ciunit)) err(a->cierr,114,"sfe"); + if(!p->ufmt) err(a->cierr,102,"sfe"); + return(0); +} +integer e_wsfe(Void) +{ +#ifdef ALWAYS_FLUSH + int n; + f__init = 1; + n = en_fio(); + f__fmtbuf=NULL; + if (!n && fflush(f__cf)) + err(f__elist->cierr, errno, "write end"); + return n; +#else + return(e_rsfe()); +#endif +} diff --git a/libf2c/libI77/sue.c b/libf2c/libI77/sue.c new file mode 100644 index 00000000000..8f2ea314f30 --- /dev/null +++ b/libf2c/libI77/sue.c @@ -0,0 +1,87 @@ +#include "f2c.h" +#include "fio.h" +extern uiolen f__reclen; +long f__recloc; + +#ifdef KR_headers +c_sue(a) cilist *a; +#else +c_sue(cilist *a) +#endif +{ + if(a->ciunit >= MXUNIT || a->ciunit < 0) + err(a->cierr,101,"startio"); + f__external=f__sequential=1; + f__formatted=0; + f__curunit = &f__units[a->ciunit]; + f__elist=a; + if(f__curunit->ufd==NULL && fk_open(SEQ,UNF,a->ciunit)) + err(a->cierr,114,"sue"); + f__cf=f__curunit->ufd; + if(f__curunit->ufmt) err(a->cierr,103,"sue"); + if(!f__curunit->useek) err(a->cierr,103,"sue"); + return(0); +} +#ifdef KR_headers +integer s_rsue(a) cilist *a; +#else +integer s_rsue(cilist *a) +#endif +{ + int n; + if(f__init != 1) f_init(); + f__init = 3; + f__reading=1; + if(n=c_sue(a)) return(n); + f__recpos=0; + if(f__curunit->uwrt && f__nowreading(f__curunit)) + err(a->cierr, errno, "read start"); + if(fread((char *)&f__reclen,sizeof(uiolen),1,f__cf) + != 1) + { if(feof(f__cf)) + { f__curunit->uend = 1; + err(a->ciend, EOF, "start"); + } + clearerr(f__cf); + err(a->cierr, errno, "start"); + } + return(0); +} +#ifdef KR_headers +integer s_wsue(a) cilist *a; +#else +integer s_wsue(cilist *a) +#endif +{ + int n; + if(f__init != 1) f_init(); + f__init = 3; + if(n=c_sue(a)) return(n); + f__reading=0; + f__reclen=0; + if(f__curunit->uwrt != 1 && f__nowwriting(f__curunit)) + err(a->cierr, errno, "write start"); + f__recloc=ftell(f__cf); + (void) fseek(f__cf,(long)sizeof(uiolen),SEEK_CUR); + return(0); +} +integer e_wsue(Void) +{ long loc; + f__init = 1; + fwrite((char *)&f__reclen,sizeof(uiolen),1,f__cf); +#ifdef ALWAYS_FLUSH + if (fflush(f__cf)) + err(f__elist->cierr, errno, "write end"); +#endif + loc=ftell(f__cf); + fseek(f__cf,f__recloc,SEEK_SET); + fwrite((char *)&f__reclen,sizeof(uiolen),1,f__cf); + fseek(f__cf,loc,SEEK_SET); + return(0); +} +integer e_rsue(Void) +{ + f__init = 1; + (void) fseek(f__cf,(long)(f__reclen-f__recpos+sizeof(uiolen)),SEEK_CUR); + return(0); +} diff --git a/libf2c/libI77/typesize.c b/libf2c/libI77/typesize.c new file mode 100644 index 00000000000..1cb20ff2863 --- /dev/null +++ b/libf2c/libI77/typesize.c @@ -0,0 +1,12 @@ +#include "f2c.h" + +ftnlen f__typesize[] = { 0, 0, sizeof(shortint), sizeof(integer), + sizeof(real), sizeof(doublereal), + sizeof(complex), sizeof(doublecomplex), + sizeof(logical), sizeof(char), + 0, sizeof(integer1), + sizeof(logical1), sizeof(shortlogical), +#ifdef Allow_TYQUAD + sizeof(longint), +#endif + 0}; diff --git a/libf2c/libI77/uio.c b/libf2c/libI77/uio.c new file mode 100644 index 00000000000..ea733cec06c --- /dev/null +++ b/libf2c/libI77/uio.c @@ -0,0 +1,69 @@ +#include "f2c.h" +#include "fio.h" +#include +uiolen f__reclen; + +#ifdef KR_headers +do_us(number,ptr,len) ftnint *number; char *ptr; ftnlen len; +#else +do_us(ftnint *number, char *ptr, ftnlen len) +#endif +{ + if(f__reading) + { + f__recpos += (int)(*number * len); + if(f__recpos>f__reclen) + err(f__elist->cierr, 110, "do_us"); + if (fread(ptr,(size_t)len,(size_t)(*number),f__cf) != *number) + err(f__elist->ciend, EOF, "do_us"); + return(0); + } + else + { + f__reclen += *number * len; + (void) fwrite(ptr,(size_t)len,(size_t)(*number),f__cf); + return(0); + } +} +#ifdef KR_headers +integer do_ud(number,ptr,len) ftnint *number; char *ptr; ftnlen len; +#else +integer do_ud(ftnint *number, char *ptr, ftnlen len) +#endif +{ + f__recpos += (int)(*number * len); + if(f__recpos > f__curunit->url && f__curunit->url!=1) + err(f__elist->cierr,110,"do_ud"); + if(f__reading) + { +#ifdef Pad_UDread +#ifdef KR_headers + int i; +#else + size_t i; +#endif + if (!(i = fread(ptr,(size_t)len,(size_t)(*number),f__cf)) + && !(f__recpos - *number*len)) + err(f__elist->cierr,EOF,"do_ud"); + if (i < *number) + memset(ptr + i*len, 0, (*number - i)*len); + return 0; +#else + if(fread(ptr,(size_t)len,(size_t)(*number),f__cf) != *number) + err(f__elist->cierr,EOF,"do_ud"); + else return(0); +#endif + } + (void) fwrite(ptr,(size_t)len,(size_t)(*number),f__cf); + return(0); +} +#ifdef KR_headers +integer do_uio(number,ptr,len) ftnint *number; char *ptr; ftnlen len; +#else +integer do_uio(ftnint *number, char *ptr, ftnlen len) +#endif +{ + if(f__sequential) + return(do_us(number,ptr,len)); + else return(do_ud(number,ptr,len)); +} diff --git a/libf2c/libI77/util.c b/libf2c/libI77/util.c new file mode 100644 index 00000000000..a24932533c1 --- /dev/null +++ b/libf2c/libI77/util.c @@ -0,0 +1,51 @@ +#ifndef NON_UNIX_STDIO +#include +#include +#endif +#include "f2c.h" +#include "fio.h" + + VOID +#ifdef KR_headers +g_char(a,alen,b) char *a,*b; ftnlen alen; +#else +g_char(char *a, ftnlen alen, char *b) +#endif +{ + char *x = a + alen, *y = b + alen; + + for(;; y--) { + if (x <= a) { + *b = 0; + return; + } + if (*--x != ' ') + break; + } + *y-- = 0; + do *y-- = *x; + while(x-- > a); + } + + VOID +#ifdef KR_headers +b_char(a,b,blen) char *a,*b; ftnlen blen; +#else +b_char(char *a, char *b, ftnlen blen) +#endif +{ int i; + for(i=0;i +#endif + +#ifndef KR_headers +#undef abs +#undef min +#undef max +#include +#include +#endif + +#include "fmt.h" +#include "fp.h" + +#ifdef KR_headers +wrt_E(p,w,d,e,len) ufloat *p; ftnlen len; +#else +wrt_E(ufloat *p, int w, int d, int e, ftnlen len) +#endif +{ + char buf[FMAX+EXPMAXDIGS+4], *s, *se; + int d1, delta, e1, i, sign, signspace; + double dd; +#ifdef WANT_LEAD_0 + int insert0 = 0; +#endif +#ifndef VAX + int e0 = e; +#endif + + if(e <= 0) + e = 2; + if(f__scale) { + if(f__scale >= d + 2 || f__scale <= -d) + goto nogood; + } + if(f__scale <= 0) + --d; + if (len == sizeof(real)) + dd = p->pf; + else + dd = p->pd; + if (dd < 0.) { + signspace = sign = 1; + dd = -dd; + } + else { + sign = 0; + signspace = (int)f__cplus; +#ifndef VAX + if (!dd) + dd = 0.; /* avoid -0 */ +#endif + } + delta = w - (2 /* for the . and the d adjustment above */ + + 2 /* for the E+ */ + signspace + d + e); +#ifdef WANT_LEAD_0 + if (f__scale <= 0 && delta > 0) { + delta--; + insert0 = 1; + } + else +#endif + if (delta < 0) { +nogood: + while(--w >= 0) + PUT('*'); + return(0); + } + if (f__scale < 0) + d += f__scale; + if (d > FMAX) { + d1 = d - FMAX; + d = FMAX; + } + else + d1 = 0; + sprintf(buf,"%#.*E", d, dd); +#ifndef VAX + /* check for NaN, Infinity */ + if (!isdigit(buf[0])) { + switch(buf[0]) { + case 'n': + case 'N': + signspace = 0; /* no sign for NaNs */ + } + delta = w - strlen(buf) - signspace; + if (delta < 0) + goto nogood; + while(--delta >= 0) + PUT(' '); + if (signspace) + PUT(sign ? '-' : '+'); + for(s = buf; *s; s++) + PUT(*s); + return 0; + } +#endif + se = buf + d + 3; +#ifdef GOOD_SPRINTF_EXPONENT /* When possible, exponent has 2 digits. */ + if (f__scale != 1 && dd) + sprintf(se, "%+.2d", atoi(se) + 1 - f__scale); +#else + if (dd) + sprintf(se, "%+.2d", atoi(se) + 1 - f__scale); + else + strcpy(se, "+00"); +#endif + s = ++se; + if (e < 2) { + if (*s != '0') + goto nogood; + } +#ifndef VAX + /* accommodate 3 significant digits in exponent */ + if (s[2]) { +#ifdef Pedantic + if (!e0 && !s[3]) + for(s -= 2, e1 = 2; s[0] = s[1]; s++); + + /* Pedantic gives the behavior that Fortran 77 specifies, */ + /* i.e., requires that E be specified for exponent fields */ + /* of more than 3 digits. With Pedantic undefined, we get */ + /* the behavior that Cray displays -- you get a bigger */ + /* exponent field if it fits. */ +#else + if (!e0) { + for(s -= 2, e1 = 2; s[0] = s[1]; s++) +#ifdef CRAY + delta--; + if ((delta += 4) < 0) + goto nogood +#endif + ; + } +#endif + else if (e0 >= 0) + goto shift; + else + e1 = e; + } + else + shift: +#endif + for(s += 2, e1 = 2; *s; ++e1, ++s) + if (e1 >= e) + goto nogood; + while(--delta >= 0) + PUT(' '); + if (signspace) + PUT(sign ? '-' : '+'); + s = buf; + i = f__scale; + if (f__scale <= 0) { +#ifdef WANT_LEAD_0 + if (insert0) + PUT('0'); +#endif + PUT('.'); + for(; i < 0; ++i) + PUT('0'); + PUT(*s); + s += 2; + } + else if (f__scale > 1) { + PUT(*s); + s += 2; + while(--i > 0) + PUT(*s++); + PUT('.'); + } + if (d1) { + se -= 2; + while(s < se) PUT(*s++); + se += 2; + do PUT('0'); while(--d1 > 0); + } + while(s < se) + PUT(*s++); + if (e < 2) + PUT(s[1]); + else { + while(++e1 <= e) + PUT('0'); + while(*s) + PUT(*s++); + } + return 0; + } + +#ifdef KR_headers +wrt_F(p,w,d,len) ufloat *p; ftnlen len; +#else +wrt_F(ufloat *p, int w, int d, ftnlen len) +#endif +{ + int d1, sign, n; + double x; + char *b, buf[MAXINTDIGS+MAXFRACDIGS+4], *s; + + x= (len==sizeof(real)?p->pf:p->pd); + if (d < MAXFRACDIGS) + d1 = 0; + else { + d1 = d - MAXFRACDIGS; + d = MAXFRACDIGS; + } + if (x < 0.) + { x = -x; sign = 1; } + else { + sign = 0; +#ifndef VAX + if (!x) + x = 0.; +#endif + } + + if (n = f__scale) + if (n > 0) + do x *= 10.; while(--n > 0); + else + do x *= 0.1; while(++n < 0); + +#ifdef USE_STRLEN + sprintf(b = buf, "%#.*f", d, x); + n = strlen(b) + d1; +#else + n = sprintf(b = buf, "%#.*f", d, x) + d1; +#endif + +#ifndef WANT_LEAD_0 + if (buf[0] == '0' && d) + { ++b; --n; } +#endif + if (sign) { + /* check for all zeros */ + for(s = b;;) { + while(*s == '0') s++; + switch(*s) { + case '.': + s++; continue; + case 0: + sign = 0; + } + break; + } + } + if (sign || f__cplus) + ++n; + if (n > w) { +#ifdef WANT_LEAD_0 + if (buf[0] == '0' && --n == w) + ++b; + else +#endif + { + while(--w >= 0) + PUT('*'); + return 0; + } + } + for(w -= n; --w >= 0; ) + PUT(' '); + if (sign) + PUT('-'); + else if (f__cplus) + PUT('+'); + while(n = *b++) + PUT(n); + while(--d1 >= 0) + PUT('0'); + return 0; + } diff --git a/libf2c/libI77/wrtfmt.c b/libf2c/libI77/wrtfmt.c new file mode 100644 index 00000000000..4350fc984f6 --- /dev/null +++ b/libf2c/libI77/wrtfmt.c @@ -0,0 +1,385 @@ +#include "f2c.h" +#include "fio.h" +#include "fmt.h" + +extern icilist *f__svic; +extern char *f__icptr; + + static int +mv_cur(Void) /* shouldn't use fseek because it insists on calling fflush */ + /* instead we know too much about stdio */ +{ + int cursor = f__cursor; + f__cursor = 0; + if(f__external == 0) { + if(cursor < 0) { + if(f__hiwater < f__recpos) + f__hiwater = f__recpos; + f__recpos += cursor; + f__icptr += cursor; + if(f__recpos < 0) + err(f__elist->cierr, 110, "left off"); + } + else if(cursor > 0) { + if(f__recpos + cursor >= f__svic->icirlen) + err(f__elist->cierr, 110, "recend"); + if(f__hiwater <= f__recpos) + for(; cursor > 0; cursor--) + (*f__putn)(' '); + else if(f__hiwater <= f__recpos + cursor) { + cursor -= f__hiwater - f__recpos; + f__icptr += f__hiwater - f__recpos; + f__recpos = f__hiwater; + for(; cursor > 0; cursor--) + (*f__putn)(' '); + } + else { + f__icptr += cursor; + f__recpos += cursor; + } + } + return(0); + } + if(cursor > 0) { + if(f__hiwater <= f__recpos) + for(;cursor>0;cursor--) (*f__putn)(' '); + else if(f__hiwater <= f__recpos + cursor) { +#if ! defined (NON_UNIX_STDIO) && ! defined (MISSING_FILE_ELEMS) + if(f__cf->_ptr + f__hiwater - f__recpos < buf_end(f__cf)) + f__cf->_ptr += f__hiwater - f__recpos; + else +#endif + (void) fseek(f__cf, (long) (f__hiwater - f__recpos), SEEK_CUR); + cursor -= f__hiwater - f__recpos; + f__recpos = f__hiwater; + for(; cursor > 0; cursor--) + (*f__putn)(' '); + } + else { +#if ! defined (NON_UNIX_STDIO) && ! defined (MISSING_FILE_ELEMS) + if(f__cf->_ptr + cursor < buf_end(f__cf)) + f__cf->_ptr += cursor; + else +#endif + (void) fseek(f__cf, (long)cursor, SEEK_CUR); + f__recpos += cursor; + } + } + if(cursor<0) + { + if(cursor+f__recpos<0) err(f__elist->cierr,110,"left off"); +#if ! defined (NON_UNIX_STDIO) && ! defined (MISSING_FILE_ELEMS) + if(f__cf->_ptr + cursor >= f__cf->_base) + f__cf->_ptr += cursor; + else +#endif + if(f__curunit && f__curunit->useek) + (void) fseek(f__cf,(long)cursor,SEEK_CUR); + else + err(f__elist->cierr,106,"fmt"); + if(f__hiwater < f__recpos) + f__hiwater = f__recpos; + f__recpos += cursor; + } + return(0); +} + + static int +#ifdef KR_headers +wrt_Z(n,w,minlen,len) Uint *n; int w, minlen; ftnlen len; +#else +wrt_Z(Uint *n, int w, int minlen, ftnlen len) +#endif +{ + register char *s, *se; + register int i, w1; + static int one = 1; + static char hex[] = "0123456789ABCDEF"; + s = (char *)n; + --len; + if (*(char *)&one) { + /* little endian */ + se = s; + s += len; + i = -1; + } + else { + se = s + len; + i = 1; + } + for(;; s += i) + if (s == se || *s) + break; + w1 = (i*(se-s) << 1) + 1; + if (*s & 0xf0) + w1++; + if (w1 > w) + for(i = 0; i < w; i++) + (*f__putn)('*'); + else { + if ((minlen -= w1) > 0) + w1 += minlen; + while(--w >= w1) + (*f__putn)(' '); + while(--minlen >= 0) + (*f__putn)('0'); + if (!(*s & 0xf0)) { + (*f__putn)(hex[*s & 0xf]); + if (s == se) + return 0; + s += i; + } + for(;; s += i) { + (*f__putn)(hex[*s >> 4 & 0xf]); + (*f__putn)(hex[*s & 0xf]); + if (s == se) + break; + } + } + return 0; + } + + static int +#ifdef KR_headers +wrt_I(n,w,len, base) Uint *n; ftnlen len; register int base; +#else +wrt_I(Uint *n, int w, ftnlen len, register int base) +#endif +{ int ndigit,sign,spare,i; + longint x; + char *ans; + if(len==sizeof(integer)) x=n->il; + else if(len == sizeof(char)) x = n->ic; +#ifdef Allow_TYQUAD + else if (len == sizeof(longint)) x = n->ili; +#endif + else x=n->is; + ans=f__icvt(x,&ndigit,&sign, base); + spare=w-ndigit; + if(sign || f__cplus) spare--; + if(spare<0) + for(i=0;iil; + else if(len == sizeof(char)) x = n->ic; +#ifdef Allow_TYQUAD + else if (len == sizeof(longint)) x = n->ili; +#endif + else x=n->is; + ans=f__icvt(x,&ndigit,&sign, base); + if(sign || f__cplus) xsign=1; + else xsign=0; + if(ndigit+xsign>w || m+xsign>w) + { for(i=0;i=m) + spare=w-ndigit-xsign; + else + spare=w-m-xsign; + for(i=0;iil; + else if(sz == sizeof(char)) x = n->ic; + else x=n->is; + for(i=0;i 0) (*f__putn)(*p++); + return(0); +} + static int +#ifdef KR_headers +wrt_AW(p,w,len) char * p; ftnlen len; +#else +wrt_AW(char * p, int w, ftnlen len) +#endif +{ + while(w>len) + { w--; + (*f__putn)(' '); + } + while(w-- > 0) + (*f__putn)(*p++); + return(0); +} + + static int +#ifdef KR_headers +wrt_G(p,w,d,e,len) ufloat *p; ftnlen len; +#else +wrt_G(ufloat *p, int w, int d, int e, ftnlen len) +#endif +{ double up = 1,x; + int i=0,oldscale,n,j; + x = len==sizeof(real)?p->pf:p->pd; + if(x < 0 ) x = -x; + if(x<.1) { + if (x != 0.) + return(wrt_E(p,w,d,e,len)); + i = 1; + goto have_i; + } + for(;i<=d;i++,up*=10) + { if(x>=up) continue; + have_i: + oldscale = f__scale; + f__scale = 0; + if(e==0) n=4; + else n=e+2; + i=wrt_F(p,w-n,d-i,len); + for(j=0;jop) + { + default: + fprintf(stderr,"w_ed, unexpected code: %d\n", p->op); + sig_die(f__fmtbuf, 1); + case I: return(wrt_I((Uint *)ptr,p->p1,len, 10)); + case IM: + return(wrt_IM((Uint *)ptr,p->p1,p->p2.i[0],len,10)); + + /* O and OM don't work right for character, double, complex, */ + /* or doublecomplex, and they differ from Fortran 90 in */ + /* showing a minus sign for negative values. */ + + case O: return(wrt_I((Uint *)ptr, p->p1, len, 8)); + case OM: + return(wrt_IM((Uint *)ptr,p->p1,p->p2.i[0],len,8)); + case L: return(wrt_L((Uint *)ptr,p->p1, len)); + case A: return(wrt_A(ptr,len)); + case AW: + return(wrt_AW(ptr,p->p1,len)); + case D: + case E: + case EE: + return(wrt_E((ufloat *)ptr,p->p1,p->p2.i[0],p->p2.i[1],len)); + case G: + case GE: + return(wrt_G((ufloat *)ptr,p->p1,p->p2.i[0],p->p2.i[1],len)); + case F: return(wrt_F((ufloat *)ptr,p->p1,p->p2.i[0],len)); + + /* Z and ZM assume 8-bit bytes. */ + + case Z: return(wrt_Z((Uint *)ptr,p->p1,0,len)); + case ZM: + return(wrt_Z((Uint *)ptr,p->p1,p->p2.i[0],len)); + } +} +#ifdef KR_headers +w_ned(p) struct syl *p; +#else +w_ned(struct syl *p) +#endif +{ + switch(p->op) + { + default: fprintf(stderr,"w_ned, unexpected code: %d\n", p->op); + sig_die(f__fmtbuf, 1); + case SLASH: + return((*f__donewrec)()); + case T: f__cursor = p->p1-f__recpos - 1; + return(1); + case TL: f__cursor -= p->p1; + if(f__cursor < -f__recpos) /* TL1000, 1X */ + f__cursor = -f__recpos; + return(1); + case TR: + case X: + f__cursor += p->p1; + return(1); + case APOS: + return(wrt_AP(p->p2.s)); + case H: + return(wrt_H(p->p1,p->p2.s)); + } +} diff --git a/libf2c/libI77/wsfe.c b/libf2c/libI77/wsfe.c new file mode 100644 index 00000000000..5adb1a49f08 --- /dev/null +++ b/libf2c/libI77/wsfe.c @@ -0,0 +1,85 @@ +/*write sequential formatted external*/ +#include "f2c.h" +#include "fio.h" +#include "fmt.h" +extern int f__hiwater; + +#ifdef KR_headers +x_putc(c) +#else +x_putc(int c) +#endif +{ + /* this uses \n as an indicator of record-end */ + if(c == '\n' && f__recpos < f__hiwater) { /* fseek calls fflush, a loss */ +#if ! defined (NON_UNIX_STDIO) && ! defined (MISSING_FILE_ELEMS) + if(f__cf->_ptr + f__hiwater - f__recpos < buf_end(f__cf)) + f__cf->_ptr += f__hiwater - f__recpos; + else +#endif + (void) fseek(f__cf, (long)(f__hiwater - f__recpos), SEEK_CUR); + } +#ifdef OMIT_BLANK_CC + if (!f__recpos++ && c == ' ') + return c; +#else + f__recpos++; +#endif + return putc(c,f__cf); +} +x_wSL(Void) +{ + (*f__putn)('\n'); + f__recpos=0; + f__cursor = 0; + f__hiwater = 0; + return(1); +} +xw_end(Void) +{ + if(f__nonl == 0) + (*f__putn)('\n'); + f__hiwater = f__recpos = f__cursor = 0; + return(0); +} +xw_rev(Void) +{ + if(f__workdone) (*f__putn)('\n'); + f__hiwater = f__recpos = f__cursor = 0; + return(f__workdone=0); +} + +#ifdef KR_headers +integer s_wsfe(a) cilist *a; /*start*/ +#else +integer s_wsfe(cilist *a) /*start*/ +#endif +{ int n; + if(f__init != 1) f_init(); + f__init = 3; + if(n=c_sfe(a)) return(n); + f__reading=0; + f__sequential=1; + f__formatted=1; + f__external=1; + f__elist=a; + f__hiwater = f__cursor=f__recpos=0; + f__nonl = 0; + f__scale=0; + f__fmtbuf=a->cifmt; + f__curunit = &f__units[a->ciunit]; + f__cf=f__curunit->ufd; + if(pars_f(f__fmtbuf)<0) err(a->cierr,100,"startio"); + f__putn= x_putc; + f__doed= w_ed; + f__doned= w_ned; + f__doend=xw_end; + f__dorevert=xw_rev; + f__donewrec=x_wSL; + fmt_bg(); + f__cplus=0; + f__cblank=f__curunit->ublnk; + if(f__curunit->uwrt != 1 && f__nowwriting(f__curunit)) + err(a->cierr,errno,"write start"); + return(0); +} diff --git a/libf2c/libI77/wsle.c b/libf2c/libI77/wsle.c new file mode 100644 index 00000000000..d13f78f650b --- /dev/null +++ b/libf2c/libI77/wsle.c @@ -0,0 +1,41 @@ +#include "f2c.h" +#include "fio.h" +#include "fmt.h" +#include "lio.h" + +#ifdef KR_headers +integer s_wsle(a) cilist *a; +#else +integer s_wsle(cilist *a) +#endif +{ + int n; + if(n=c_le(a)) return(n); + f__reading=0; + f__external=1; + f__formatted=1; + f__putn = t_putc; + f__lioproc = l_write; + L_len = LINE; + f__donewrec = x_wSL; + if(f__curunit->uwrt != 1 && f__nowwriting(f__curunit)) + err(a->cierr, errno, "list output start"); + return(0); + } + +integer e_wsle(Void) +{ + f__init = 1; + t_putc('\n'); + f__recpos=0; +#ifdef ALWAYS_FLUSH + if (fflush(f__cf)) + err(f__elist->cierr, errno, "write end"); +#else + if (f__cf == stdout) + fflush(stdout); + else if (f__cf == stderr) + fflush(stderr); +#endif + return(0); + } diff --git a/libf2c/libI77/wsne.c b/libf2c/libI77/wsne.c new file mode 100644 index 00000000000..0febd52634f --- /dev/null +++ b/libf2c/libI77/wsne.c @@ -0,0 +1,26 @@ +#include "f2c.h" +#include "fio.h" +#include "lio.h" + + integer +#ifdef KR_headers +s_wsne(a) cilist *a; +#else +s_wsne(cilist *a) +#endif +{ + int n; + + if(n=c_le(a)) + return(n); + f__reading=0; + f__external=1; + f__formatted=1; + f__putn = t_putc; + L_len = LINE; + f__donewrec = x_wSL; + if(f__curunit->uwrt != 1 && f__nowwriting(f__curunit)) + err(a->cierr, errno, "namelist output start"); + x_wsne(a); + return e_wsle(); + } diff --git a/libf2c/libI77/xwsne.c b/libf2c/libI77/xwsne.c new file mode 100644 index 00000000000..71f6f1d5da5 --- /dev/null +++ b/libf2c/libI77/xwsne.c @@ -0,0 +1,72 @@ +#include "f2c.h" +#include "fio.h" +#include "lio.h" +#include "fmt.h" + +extern int f__Aquote; + + static VOID +nl_donewrec(Void) +{ + (*f__donewrec)(); + PUT(' '); + } + +#ifdef KR_headers +x_wsne(a) cilist *a; +#else +#include + + VOID +x_wsne(cilist *a) +#endif +{ + Namelist *nl; + char *s; + Vardesc *v, **vd, **vde; + ftnint *number, type; + ftnlen *dims; + ftnlen size; + static ftnint one = 1; + extern ftnlen f__typesize[]; + + nl = (Namelist *)a->cifmt; + PUT('&'); + for(s = nl->name; *s; s++) + PUT(*s); + PUT(' '); + f__Aquote = 1; + vd = nl->vars; + vde = vd + nl->nvars; + while(vd < vde) { + v = *vd++; + s = v->name; +#ifdef No_Extra_Namelist_Newlines + if (f__recpos+strlen(s)+2 >= L_len) +#endif + nl_donewrec(); + while(*s) + PUT(*s++); + PUT(' '); + PUT('='); + number = (dims = v->dims) ? dims + 1 : &one; + type = v->type; + if (type < 0) { + size = -type; + type = TYCHAR; + } + else + size = f__typesize[type]; + l_write(number, v->addr, size, type); + if (vd < vde) { + if (f__recpos+2 >= L_len) + nl_donewrec(); + PUT(','); + PUT(' '); + } + else if (f__recpos+1 >= L_len) + nl_donewrec(); + } + f__Aquote = 0; + PUT('/'); + } diff --git a/libf2c/libU77/COPYING.LIB b/libf2c/libU77/COPYING.LIB new file mode 100644 index 00000000000..eb685a5ec98 --- /dev/null +++ b/libf2c/libU77/COPYING.LIB @@ -0,0 +1,481 @@ + GNU LIBRARY GENERAL PUBLIC LICENSE + Version 2, June 1991 + + Copyright (C) 1991 Free Software Foundation, Inc. + 675 Mass Ave, Cambridge, MA 02139, USA + Everyone is permitted to copy and distribute verbatim copies + of this license document, but changing it is not allowed. + +[This is the first released version of the library GPL. It is + numbered 2 because it goes with version 2 of the ordinary GPL.] + + Preamble + + The licenses for most software are designed to take away your +freedom to share and change it. By contrast, the GNU General Public +Licenses are intended to guarantee your freedom to share and change +free software--to make sure the software is free for all its users. + + This license, the Library General Public License, applies to some +specially designated Free Software Foundation software, and to any +other libraries whose authors decide to use it. You can use it for +your libraries, too. + + When we speak of free software, we are referring to freedom, not +price. Our General Public Licenses are designed to make sure that you +have the freedom to distribute copies of free software (and charge for +this service if you wish), that you receive source code or can get it +if you want it, that you can change the software or use pieces of it +in new free programs; and that you know you can do these things. + + To protect your rights, we need to make restrictions that forbid +anyone to deny you these rights or to ask you to surrender the rights. +These restrictions translate to certain responsibilities for you if +you distribute copies of the library, or if you modify it. + + For example, if you distribute copies of the library, whether gratis +or for a fee, you must give the recipients all the rights that we gave +you. You must make sure that they, too, receive or can get the source +code. If you link a program with the library, you must provide +complete object files to the recipients so that they can relink them +with the library, after making changes to the library and recompiling +it. And you must show them these terms so they know their rights. + + Our method of protecting your rights has two steps: (1) copyright +the library, and (2) offer you this license which gives you legal +permission to copy, distribute and/or modify the library. + + Also, for each distributor's protection, we want to make certain +that everyone understands that there is no warranty for this free +library. If the library is modified by someone else and passed on, we +want its recipients to know that what they have is not the original +version, so that any problems introduced by others will not reflect on +the original authors' reputations. + + Finally, any free program is threatened constantly by software +patents. We wish to avoid the danger that companies distributing free +software will individually obtain patent licenses, thus in effect +transforming the program into proprietary software. To prevent this, +we have made it clear that any patent must be licensed for everyone's +free use or not licensed at all. + + Most GNU software, including some libraries, is covered by the ordinary +GNU General Public License, which was designed for utility programs. This +license, the GNU Library General Public License, applies to certain +designated libraries. This license is quite different from the ordinary +one; be sure to read it in full, and don't assume that anything in it is +the same as in the ordinary license. + + The reason we have a separate public license for some libraries is that +they blur the distinction we usually make between modifying or adding to a +program and simply using it. Linking a program with a library, without +changing the library, is in some sense simply using the library, and is +analogous to running a utility program or application program. However, in +a textual and legal sense, the linked executable is a combined work, a +derivative of the original library, and the ordinary General Public License +treats it as such. + + Because of this blurred distinction, using the ordinary General +Public License for libraries did not effectively promote software +sharing, because most developers did not use the libraries. We +concluded that weaker conditions might promote sharing better. + + However, unrestricted linking of non-free programs would deprive the +users of those programs of all benefit from the free status of the +libraries themselves. This Library General Public License is intended to +permit developers of non-free programs to use free libraries, while +preserving your freedom as a user of such programs to change the free +libraries that are incorporated in them. (We have not seen how to achieve +this as regards changes in header files, but we have achieved it as regards +changes in the actual functions of the Library.) The hope is that this +will lead to faster development of free libraries. + + The precise terms and conditions for copying, distribution and +modification follow. Pay close attention to the difference between a +"work based on the library" and a "work that uses the library". The +former contains code derived from the library, while the latter only +works together with the library. + + Note that it is possible for a library to be covered by the ordinary +General Public License rather than by this special one. + + GNU LIBRARY GENERAL PUBLIC LICENSE + TERMS AND CONDITIONS FOR COPYING, DISTRIBUTION AND MODIFICATION + + 0. This License Agreement applies to any software library which +contains a notice placed by the copyright holder or other authorized +party saying it may be distributed under the terms of this Library +General Public License (also called "this License"). Each licensee is +addressed as "you". + + A "library" means a collection of software functions and/or data +prepared so as to be conveniently linked with application programs +(which use some of those functions and data) to form executables. + + The "Library", below, refers to any such software library or work +which has been distributed under these terms. A "work based on the +Library" means either the Library or any derivative work under +copyright law: that is to say, a work containing the Library or a +portion of it, either verbatim or with modifications and/or translated +straightforwardly into another language. (Hereinafter, translation is +included without limitation in the term "modification".) + + "Source code" for a work means the preferred form of the work for +making modifications to it. For a library, complete source code means +all the source code for all modules it contains, plus any associated +interface definition files, plus the scripts used to control compilation +and installation of the library. + + Activities other than copying, distribution and modification are not +covered by this License; they are outside its scope. The act of +running a program using the Library is not restricted, and output from +such a program is covered only if its contents constitute a work based +on the Library (independent of the use of the Library in a tool for +writing it). Whether that is true depends on what the Library does +and what the program that uses the Library does. + + 1. You may copy and distribute verbatim copies of the Library's +complete source code as you receive it, in any medium, provided that +you conspicuously and appropriately publish on each copy an +appropriate copyright notice and disclaimer of warranty; keep intact +all the notices that refer to this License and to the absence of any +warranty; and distribute a copy of this License along with the +Library. + + You may charge a fee for the physical act of transferring a copy, +and you may at your option offer warranty protection in exchange for a +fee. + + 2. You may modify your copy or copies of the Library or any portion +of it, thus forming a work based on the Library, and copy and +distribute such modifications or work under the terms of Section 1 +above, provided that you also meet all of these conditions: + + a) The modified work must itself be a software library. + + b) You must cause the files modified to carry prominent notices + stating that you changed the files and the date of any change. + + c) You must cause the whole of the work to be licensed at no + charge to all third parties under the terms of this License. + + d) If a facility in the modified Library refers to a function or a + table of data to be supplied by an application program that uses + the facility, other than as an argument passed when the facility + is invoked, then you must make a good faith effort to ensure that, + in the event an application does not supply such function or + table, the facility still operates, and performs whatever part of + its purpose remains meaningful. + + (For example, a function in a library to compute square roots has + a purpose that is entirely well-defined independent of the + application. Therefore, Subsection 2d requires that any + application-supplied function or table used by this function must + be optional: if the application does not supply it, the square + root function must still compute square roots.) + +These requirements apply to the modified work as a whole. If +identifiable sections of that work are not derived from the Library, +and can be reasonably considered independent and separate works in +themselves, then this License, and its terms, do not apply to those +sections when you distribute them as separate works. But when you +distribute the same sections as part of a whole which is a work based +on the Library, the distribution of the whole must be on the terms of +this License, whose permissions for other licensees extend to the +entire whole, and thus to each and every part regardless of who wrote +it. + +Thus, it is not the intent of this section to claim rights or contest +your rights to work written entirely by you; rather, the intent is to +exercise the right to control the distribution of derivative or +collective works based on the Library. + +In addition, mere aggregation of another work not based on the Library +with the Library (or with a work based on the Library) on a volume of +a storage or distribution medium does not bring the other work under +the scope of this License. + + 3. You may opt to apply the terms of the ordinary GNU General Public +License instead of this License to a given copy of the Library. To do +this, you must alter all the notices that refer to this License, so +that they refer to the ordinary GNU General Public License, version 2, +instead of to this License. (If a newer version than version 2 of the +ordinary GNU General Public License has appeared, then you can specify +that version instead if you wish.) Do not make any other change in +these notices. + + Once this change is made in a given copy, it is irreversible for +that copy, so the ordinary GNU General Public License applies to all +subsequent copies and derivative works made from that copy. + + This option is useful when you wish to copy part of the code of +the Library into a program that is not a library. + + 4. You may copy and distribute the Library (or a portion or +derivative of it, under Section 2) in object code or executable form +under the terms of Sections 1 and 2 above provided that you accompany +it with the complete corresponding machine-readable source code, which +must be distributed under the terms of Sections 1 and 2 above on a +medium customarily used for software interchange. + + If distribution of object code is made by offering access to copy +from a designated place, then offering equivalent access to copy the +source code from the same place satisfies the requirement to +distribute the source code, even though third parties are not +compelled to copy the source along with the object code. + + 5. A program that contains no derivative of any portion of the +Library, but is designed to work with the Library by being compiled or +linked with it, is called a "work that uses the Library". Such a +work, in isolation, is not a derivative work of the Library, and +therefore falls outside the scope of this License. + + However, linking a "work that uses the Library" with the Library +creates an executable that is a derivative of the Library (because it +contains portions of the Library), rather than a "work that uses the +library". The executable is therefore covered by this License. +Section 6 states terms for distribution of such executables. + + When a "work that uses the Library" uses material from a header file +that is part of the Library, the object code for the work may be a +derivative work of the Library even though the source code is not. +Whether this is true is especially significant if the work can be +linked without the Library, or if the work is itself a library. The +threshold for this to be true is not precisely defined by law. + + If such an object file uses only numerical parameters, data +structure layouts and accessors, and small macros and small inline +functions (ten lines or less in length), then the use of the object +file is unrestricted, regardless of whether it is legally a derivative +work. (Executables containing this object code plus portions of the +Library will still fall under Section 6.) + + Otherwise, if the work is a derivative of the Library, you may +distribute the object code for the work under the terms of Section 6. +Any executables containing that work also fall under Section 6, +whether or not they are linked directly with the Library itself. + + 6. As an exception to the Sections above, you may also compile or +link a "work that uses the Library" with the Library to produce a +work containing portions of the Library, and distribute that work +under terms of your choice, provided that the terms permit +modification of the work for the customer's own use and reverse +engineering for debugging such modifications. + + You must give prominent notice with each copy of the work that the +Library is used in it and that the Library and its use are covered by +this License. You must supply a copy of this License. If the work +during execution displays copyright notices, you must include the +copyright notice for the Library among them, as well as a reference +directing the user to the copy of this License. Also, you must do one +of these things: + + a) Accompany the work with the complete corresponding + machine-readable source code for the Library including whatever + changes were used in the work (which must be distributed under + Sections 1 and 2 above); and, if the work is an executable linked + with the Library, with the complete machine-readable "work that + uses the Library", as object code and/or source code, so that the + user can modify the Library and then relink to produce a modified + executable containing the modified Library. (It is understood + that the user who changes the contents of definitions files in the + Library will not necessarily be able to recompile the application + to use the modified definitions.) + + b) Accompany the work with a written offer, valid for at + least three years, to give the same user the materials + specified in Subsection 6a, above, for a charge no more + than the cost of performing this distribution. + + c) If distribution of the work is made by offering access to copy + from a designated place, offer equivalent access to copy the above + specified materials from the same place. + + d) Verify that the user has already received a copy of these + materials or that you have already sent this user a copy. + + For an executable, the required form of the "work that uses the +Library" must include any data and utility programs needed for +reproducing the executable from it. However, as a special exception, +the source code distributed need not include anything that is normally +distributed (in either source or binary form) with the major +components (compiler, kernel, and so on) of the operating system on +which the executable runs, unless that component itself accompanies +the executable. + + It may happen that this requirement contradicts the license +restrictions of other proprietary libraries that do not normally +accompany the operating system. Such a contradiction means you cannot +use both them and the Library together in an executable that you +distribute. + + 7. You may place library facilities that are a work based on the +Library side-by-side in a single library together with other library +facilities not covered by this License, and distribute such a combined +library, provided that the separate distribution of the work based on +the Library and of the other library facilities is otherwise +permitted, and provided that you do these two things: + + a) Accompany the combined library with a copy of the same work + based on the Library, uncombined with any other library + facilities. This must be distributed under the terms of the + Sections above. + + b) Give prominent notice with the combined library of the fact + that part of it is a work based on the Library, and explaining + where to find the accompanying uncombined form of the same work. + + 8. You may not copy, modify, sublicense, link with, or distribute +the Library except as expressly provided under this License. Any +attempt otherwise to copy, modify, sublicense, link with, or +distribute the Library is void, and will automatically terminate your +rights under this License. However, parties who have received copies, +or rights, from you under this License will not have their licenses +terminated so long as such parties remain in full compliance. + + 9. You are not required to accept this License, since you have not +signed it. However, nothing else grants you permission to modify or +distribute the Library or its derivative works. These actions are +prohibited by law if you do not accept this License. Therefore, by +modifying or distributing the Library (or any work based on the +Library), you indicate your acceptance of this License to do so, and +all its terms and conditions for copying, distributing or modifying +the Library or works based on it. + + 10. Each time you redistribute the Library (or any work based on the +Library), the recipient automatically receives a license from the +original licensor to copy, distribute, link with or modify the Library +subject to these terms and conditions. You may not impose any further +restrictions on the recipients' exercise of the rights granted herein. +You are not responsible for enforcing compliance by third parties to +this License. + + 11. If, as a consequence of a court judgment or allegation of patent +infringement or for any other reason (not limited to patent issues), +conditions are imposed on you (whether by court order, agreement or +otherwise) that contradict the conditions of this License, they do not +excuse you from the conditions of this License. If you cannot +distribute so as to satisfy simultaneously your obligations under this +License and any other pertinent obligations, then as a consequence you +may not distribute the Library at all. For example, if a patent +license would not permit royalty-free redistribution of the Library by +all those who receive copies directly or indirectly through you, then +the only way you could satisfy both it and this License would be to +refrain entirely from distribution of the Library. + +If any portion of this section is held invalid or unenforceable under any +particular circumstance, the balance of the section is intended to apply, +and the section as a whole is intended to apply in other circumstances. + +It is not the purpose of this section to induce you to infringe any +patents or other property right claims or to contest validity of any +such claims; this section has the sole purpose of protecting the +integrity of the free software distribution system which is +implemented by public license practices. Many people have made +generous contributions to the wide range of software distributed +through that system in reliance on consistent application of that +system; it is up to the author/donor to decide if he or she is willing +to distribute software through any other system and a licensee cannot +impose that choice. + +This section is intended to make thoroughly clear what is believed to +be a consequence of the rest of this License. + + 12. If the distribution and/or use of the Library is restricted in +certain countries either by patents or by copyrighted interfaces, the +original copyright holder who places the Library under this License may add +an explicit geographical distribution limitation excluding those countries, +so that distribution is permitted only in or among countries not thus +excluded. In such case, this License incorporates the limitation as if +written in the body of this License. + + 13. The Free Software Foundation may publish revised and/or new +versions of the Library General Public License from time to time. +Such new versions will be similar in spirit to the present version, +but may differ in detail to address new problems or concerns. + +Each version is given a distinguishing version number. If the Library +specifies a version number of this License which applies to it and +"any later version", you have the option of following the terms and +conditions either of that version or of any later version published by +the Free Software Foundation. If the Library does not specify a +license version number, you may choose any version ever published by +the Free Software Foundation. + + 14. If you wish to incorporate parts of the Library into other free +programs whose distribution conditions are incompatible with these, +write to the author to ask for permission. For software which is +copyrighted by the Free Software Foundation, write to the Free +Software Foundation; we sometimes make exceptions for this. Our +decision will be guided by the two goals of preserving the free status +of all derivatives of our free software and of promoting the sharing +and reuse of software generally. + + NO WARRANTY + + 15. BECAUSE THE LIBRARY IS LICENSED FREE OF CHARGE, THERE IS NO +WARRANTY FOR THE LIBRARY, TO THE EXTENT PERMITTED BY APPLICABLE LAW. +EXCEPT WHEN OTHERWISE STATED IN WRITING THE COPYRIGHT HOLDERS AND/OR +OTHER PARTIES PROVIDE THE LIBRARY "AS IS" WITHOUT WARRANTY OF ANY +KIND, EITHER EXPRESSED OR IMPLIED, INCLUDING, BUT NOT LIMITED TO, THE +IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR +PURPOSE. THE ENTIRE RISK AS TO THE QUALITY AND PERFORMANCE OF THE +LIBRARY IS WITH YOU. SHOULD THE LIBRARY PROVE DEFECTIVE, YOU ASSUME +THE COST OF ALL NECESSARY SERVICING, REPAIR OR CORRECTION. + + 16. IN NO EVENT UNLESS REQUIRED BY APPLICABLE LAW OR AGREED TO IN +WRITING WILL ANY COPYRIGHT HOLDER, OR ANY OTHER PARTY WHO MAY MODIFY +AND/OR REDISTRIBUTE THE LIBRARY AS PERMITTED ABOVE, BE LIABLE TO YOU +FOR DAMAGES, INCLUDING ANY GENERAL, SPECIAL, INCIDENTAL OR +CONSEQUENTIAL DAMAGES ARISING OUT OF THE USE OR INABILITY TO USE THE +LIBRARY (INCLUDING BUT NOT LIMITED TO LOSS OF DATA OR DATA BEING +RENDERED INACCURATE OR LOSSES SUSTAINED BY YOU OR THIRD PARTIES OR A +FAILURE OF THE LIBRARY TO OPERATE WITH ANY OTHER SOFTWARE), EVEN IF +SUCH HOLDER OR OTHER PARTY HAS BEEN ADVISED OF THE POSSIBILITY OF SUCH +DAMAGES. + + END OF TERMS AND CONDITIONS + + Appendix: How to Apply These Terms to Your New Libraries + + If you develop a new library, and you want it to be of the greatest +possible use to the public, we recommend making it free software that +everyone can redistribute and change. You can do so by permitting +redistribution under these terms (or, alternatively, under the terms of the +ordinary General Public License). + + To apply these terms, attach the following notices to the library. It is +safest to attach them to the start of each source file to most effectively +convey the exclusion of warranty; and each file should have at least the +"copyright" line and a pointer to where the full notice is found. + + + Copyright (C) + + This library is free software; you can redistribute it and/or + modify it under the terms of the GNU Library General Public + License as published by the Free Software Foundation; either + version 2 of the License, or (at your option) any later version. + + This library is distributed in the hope that it will be useful, + but WITHOUT ANY WARRANTY; without even the implied warranty of + MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU + Library General Public License for more details. + + You should have received a copy of the GNU Library General Public + License along with this library; if not, write to the Free + Software Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. + +Also add information on how to contact you by electronic and paper mail. + +You should also get your employer (if you work as a programmer) or your +school, if any, to sign a "copyright disclaimer" for the library, if +necessary. Here is a sample; alter the names: + + Yoyodyne, Inc., hereby disclaims all copyright interest in the + library `Frob' (a library for tweaking knobs) written by James Random Hacker. + + , 1 April 1990 + Ty Coon, President of Vice + +That's all there is to it! diff --git a/libf2c/libU77/Makefile.in b/libf2c/libU77/Makefile.in new file mode 100644 index 00000000000..bb101710d0c --- /dev/null +++ b/libf2c/libU77/Makefile.in @@ -0,0 +1,144 @@ +# Makefile for GNU F77 compiler runtime, libc interface. +# Copyright (C) 1995-1997 Free Software Foundation, Inc. +# Contributed by Dave Love (d.love@dl.ac.uk). +# +#This file is part of GNU Fortran libU77 library. +# +#This library is free software; you can redistribute it and/or modify +#it under the terms of the GNU Library General Public License as +#published by the Free Software Foundation; either version 2, or (at +#your option) any later version. +# +#GNU Fortran is distributed in the hope that it will be useful, but +#WITHOUT ANY WARRANTY; without even the implied warranty of +#MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +#Library General Public License for more details. +# +#You should have received a copy of the GNU General Public License +#along with GNU Fortran; see the file COPYING. If not, write to +#Software Foundation, 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. + +SHELL = /bin/sh + +srcdir = @srcdir@ +VPATH = @srcdir@ + +#### Start of system configuration section. #### + +CPPFLAGS = @CPPFLAGS@ +DEFS = @DEFS@ +# f2c.h should already be installed in xgcc's include directory but add that +# to -I anyhow in case not using xgcc. fio.h is in libI77. We need config.h +# from `.'. +ALL_CFLAGS = -I. -I$(srcdir) -I$(srcdir)/../libI77 -I.. $(CPPFLAGS) $(DEFS) $(CFLAGS) +CROSS = @CROSS@ + +.SUFFIXES: +.SUFFIXES: .c .o + +.c.o: + $(CC) -c -DSkip_f2c_Undefs $(ALL_CFLAGS) $< + +OBJS = VersionU.o gerror_.o perror_.o ierrno_.o itime_.o time_.o \ + unlink_.o fnum_.o getpid_.o getuid_.o getgid_.o kill_.o rand_.o \ + srand_.o irand_.o sleep_.o idate_.o ctime_.o etime_.o \ + dtime_.o isatty_.o ltime_.o fstat_.o stat_.o \ + lstat_.o access_.o link_.o getlog_.o ttynam_.o getcwd_.o symlnk_.o \ + vxttime_.o vxtidate_.o gmtime_.o fdate_.o secnds_.o \ + bes.o dbes.o \ + chdir_.o chmod_.o lnblnk_.o hostnm_.o rename_.o fgetc_.o fputc_.o \ + umask_.o sys_clock_.o date_.o second_.o flush1_.o mclock_.o \ + alarm_.o +SRCS = Version.c gerror_.c perror_.c ierrno_.c itime_.c time_.c \ + unlink_.c fnum_.c getpid_.c getuid_.c getgid_.c kill_.c rand_.c \ + srand_.c irand_.c sleep_.c idate_.c ctime_.c etime_.c \ + dtime_.c isatty_.c ltime_.c fstat_.c stat_.c \ + lstat_.c access_.c link_.c getlog_.c ttynam_.c getcwd_.c symlnk_.c \ + vxttime_.c vxtidate_.c gmtime_.c fdate_.c secnds_.c \ + bes.c dbes.c \ + chdir_.c chmod_.c lnblnk_.c hostnm_.c rename_.c fgetc_.c fputc_.c \ + umask_.c sys_clock_.c date_.c second_.c flush1_.c mclock_.c \ + alarm_.c + +F2C_H = ../f2c.h + +all: $(OBJS) + +VersionU.o: Version.c + $(CC) -c $(CGFLAGS) -o $@ $(srcdir)/Version.c + +lint: + lint $(CFLAGS) $(SRCS) + +mostlyclean: + -rm -f $(OBJS) + +clean: mostlyclean + -rm -f config.log a.out + +distclean realclean maintainer-clean: clean + -rm -f config.h Makefile config.status config.cache stage? include + +$(OBJS): $(F2C_H) config.h + +check: + -$(G77DIR)g77 -B$(G77DIR) -g $(srcdir)/u77-test.f $(lib) && ./a.out + rm -f a.out + +access_.o: access_.c +ctime_.o: ctime_.c +dtime_.o: dtime_.c +etime_.o: etime_.c +fnum_.o: fnum_.c $(srcdir)/../libI77/fio.h +fstat_.o: fstat_.c +gerror_.o: gerror_.c +getcwd_.o: getcwd_.c +getgid_.o: getgid_.c +getlog_.o: getlog_.c +getpid_.o: getpid_.c +getuid_.o: getuid_.c +idate_.o: idate_.c +ierrno_.o: ierrno_.c +irand_.o: irand_.c +isatty_.o: isatty_.c $(srcdir)/../libI77/fio.h +itime_.o: itime_.c +kill_.o: kill_.c +link_.o: link_.c +loc_.o: loc_.c +lstat_.o: lstat_.c +ltime_.o: ltime_.c +perror_.o: perror_.c +qsort.o: qsort.c +qsort_.o: qsort_.c +rand_.o: rand_.c +rename_.o: rename_.c +second_.o: second_.c +sleep_.o: sleep_.c +srand_.o: srand_.c +stat_.o: stat_.c +symlnk_.o: symlnk_.c +time_.o: time_.c +ttynam_.o: ttynam_.c +unlink_.o: unlink_.c +wait_.o: wait_.c +vxttime_.o: vxttime_.c +vtxidate_.o: vxtidate_.c +fdate_.o: fdate_.c +gmtime_.o: gmtime_.c +secnds_.o: secnds_.c +bes.o: bes.c +dbes.o: dbes.c +lnblnk_.o: lnblnk_.c +chmod_.o: chmod_.c +chdir_.o: chdir_.c +hostnm_.o: hostnm_.c +rename_.o: rename_.c +fputc_.o: fputc_.c +fgetc_.o: fgetc_.c +sys_clock_.o: sys_clock_.c +umask_.o: umask_.c +flush1_.o: flush1_.c +mclock_.o: mclock_.c +alarm_.o: alarm_.c + +.PHONY: mostlyclean clean distclean maintainer-clean lint check all diff --git a/libf2c/libU77/PROJECTS b/libf2c/libU77/PROJECTS new file mode 100644 index 00000000000..0cf1383cbf9 --- /dev/null +++ b/libf2c/libU77/PROJECTS @@ -0,0 +1,10 @@ + -*- indented-text-*- + +* Interface to strget + +* Non-blocking (`asynchronous') i/o (per c.l.f. discussion) + +* `ioinit'-type routine for various i/o options + +* IEEE/VAX/... number format conversion (or XDR interface). This + might be made optionally transparent per logical unit a la DECtran. diff --git a/libf2c/libU77/README b/libf2c/libU77/README new file mode 100644 index 00000000000..9033a495f1b --- /dev/null +++ b/libf2c/libU77/README @@ -0,0 +1,40 @@ +19970811 -*-text-*- + +g77 libU77 +---------- + +This directory contains an implementation of most of the `traditional' +Unix libU77 routines, mostly an interface to libc and libm routines +and some extra ones for time and date etc. It's intended for use with +g77, to whose configuration procedure it's currently tied, but should +be compatible with f2c otherwise, if using the same f2c.h. + +The contents of libU77 and its interfaces aren't consistent across +implementations. This one is mostly taken from documentation for (an +old version of) the Convex implementation and the v2 SunPro one. +As of g77 version 0.5.20, most of these routines have been made +into g77 intrinsics. Some routines have a version with a name prefixed +by `vxt', corresponding to the VMS Fortran versions, and these should +be integrated with g77's intrinsics visibility control. + +A few routines are currently missing; in the case of `fork', for +instance, because they're probably not useful, and in the case of +`qsort' and those for stream-based i/o handling, because they need +more effort/research. The configuration should weed out those few +which correspond to facilities which may not be present on some Unix +systems, such as symbolic links. It's unclear whether the interfaces +to the native library random number routines should be retained, since +their implementation is likely to be something one should avoid +assiduously. + +This library has been tested it under SunOS4.1.3 and Irix5.2 and there +has been some feedback from Linux; presumably potential problems lie +mainly with systems with impoverished native C library support which +haven't been properly taken care of with autoconf. + +There's another GPL'd implementation of this stuff which I only found +out about recently (despite having looked) and I haven't yet checked +how they should be amalgamated. + +Dave Love Aug '95 +(minor changes by Craig Burley Aug '97) diff --git a/libf2c/libU77/Version.c b/libf2c/libU77/Version.c new file mode 100644 index 00000000000..0a278382f51 --- /dev/null +++ b/libf2c/libU77/Version.c @@ -0,0 +1,12 @@ +static char junk[] = "\n@(#) LIBU77 VERSION 19970919\n"; + +char __G77_LIBU77_VERSION__[] = "0.5.22-970919"; + +#include + +void +g77__uvers__ () +{ + fprintf (stderr, "__G77_LIBU77_VERSION__: %s", __G77_LIBU77_VERSION__); + fputs (junk, stderr); +} diff --git a/libf2c/libU77/access_.c b/libf2c/libU77/access_.c new file mode 100644 index 00000000000..fefdebb0d8d --- /dev/null +++ b/libf2c/libU77/access_.c @@ -0,0 +1,80 @@ +/* Copyright (C) 1995, 1997 Free Software Foundation, Inc. +This file is part of GNU Fortran libU77 library. + +This library is free software; you can redistribute it and/or modify it +under the terms of the GNU Library General Public License as published +by the Free Software Foundation; either version 2 of the License, or +(at your option) any later version. + +GNU Fortran is distributed in the hope that it will be useful, +but WITHOUT ANY WARRANTY; without even the implied warranty of +MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +Library General Public License for more details. + +You should have received a copy of the GNU Library General Public +License along with GNU Fortran; see the file COPYING.LIB. If +not, write to the Free Software Foundation, Inc., 59 Temple Place - Suite 330, +Boston, MA 02111-1307, USA. */ + +#ifdef HAVE_CONFIG_H +#include "config.h" +#endif +#if HAVE_UNISTD_H +# include +#endif +#if HAVE_STDLIB_H +# include +#else +# include +#endif + +#include +#include +#include "f2c.h" + +#ifndef R_OK /* for SVR1-2 */ +# define R_OK 4 +#endif +#ifndef W_OK +# define W_OK 2 +#endif +#ifndef X_OK +# define X_OK 1 +#endif +#ifndef F_OK +# define F_OK 0 +#endif + +#ifdef KR_headers +void g_char (); + +integer G77_access_0 (name, mode, Lname, Lmode) + char *name, *mode; + ftnlen Lname, Lmode; +#else +void g_char(const char *a, ftnlen alen, char *b); + +integer G77_access_0 (const char *name, const char *mode, ftnlen Lname, ftnlen Lmode) +#endif +{ + char *buff; + char *bp, *blast; + int amode, i; + + buff = malloc (Lname+1); + if (!buff) return -1; + g_char (name, Lname, buff); + amode = 0; + for (i=0;i +#endif + +#include /* for ENOSYS */ +#include "f2c.h" + +#ifndef RETSIGTYPE +/* we shouldn't rely on this... */ +#ifdef KR_headers +#define RETSIGTYPE int +#else +#define RETSIGTYPE void +#endif +#endif +typedef RETSIGTYPE (*sig_type)(); + +#ifdef KR_headers +extern sig_type signal(); + +integer G77_alarm_0 (seconds, proc) + integer *seconds; + sig_type proc; +#else +#include +typedef int (*sig_proc)(int); + +integer G77_alarm_0 (integer *seconds, sig_proc proc) +#endif +{ + int status; +#if defined (HAVE_ALARM) && defined (SIGALRM) + if (signal(SIGALRM, (sig_type)proc) == SIG_ERR) + status = -1; + else + status = alarm (*seconds); +#else /* ! HAVE_ALARM || ! SIGALRM */ + errno = ENOSYS; + status = -1; +#endif + return status; +} diff --git a/libf2c/libU77/bes.c b/libf2c/libU77/bes.c new file mode 100644 index 00000000000..442337fd77a --- /dev/null +++ b/libf2c/libU77/bes.c @@ -0,0 +1,46 @@ +/* Copyright (C) 1995, 1996 Free Software Foundation, Inc. +This file is part of GNU Fortran libU77 library. + +This library is free software; you can redistribute it and/or modify it +under the terms of the GNU Library General Public License as published +by the Free Software Foundation; either version 2 of the License, or +(at your option) any later version. + +GNU Fortran is distributed in the hope that it will be useful, +but WITHOUT ANY WARRANTY; without even the implied warranty of +MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +Library General Public License for more details. + +You should have received a copy of the GNU Library General Public +License along with GNU Fortran; see the file COPYING.LIB. If +not, write to the Free Software Foundation, Inc., 59 Temple Place - Suite 330, +Boston, MA 02111-1307, USA. */ + +#if 0 /* Don't include these unless necessary -- jcb. */ +#include "f2c.h" +#include + +double G77_besj0_0 (const real *x) { + return j0 (*x); +} + +double G77_besj1_0 (const real *x) { + return j1 (*x); +} + +double G77_besjn_0 (const integer *n, real *x) { + return jn (*n, *x); + } + +double G77_besy0_0 (const real *x) { + return y0 (*x); +} + +double G77_besy1_0 (const real *x) { + return y1 (*x); +} + +double G77_besyn_0 (const integer *n, real *x) { + return yn (*n, *x); +} +#endif diff --git a/libf2c/libU77/chdir_.c b/libf2c/libU77/chdir_.c new file mode 100644 index 00000000000..9bd53fb95d7 --- /dev/null +++ b/libf2c/libU77/chdir_.c @@ -0,0 +1,57 @@ +/* Copyright (C) 1995, 1997 Free Software Foundation, Inc. +This file is part of GNU Fortran libU77 library. + +This library is free software; you can redistribute it and/or modify it +under the terms of the GNU Library General Public License as published +by the Free Software Foundation; either version 2 of the License, or +(at your option) any later version. + +GNU Fortran is distributed in the hope that it will be useful, +but WITHOUT ANY WARRANTY; without even the implied warranty of +MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +Library General Public License for more details. + +You should have received a copy of the GNU Library General Public +License along with GNU Fortran; see the file COPYING.LIB. If +not, write to the Free Software Foundation, Inc., 59 Temple Place - Suite 330, +Boston, MA 02111-1307, USA. */ + +#ifdef HAVE_CONFIG_H +#include "config.h" +#endif +#if HAVE_UNISTD_H +# include +#endif +#if HAVE_STDLIB_H +# include +#else +# include +#endif + +#include +#include "f2c.h" + + +#ifdef KR_headers +void g_char (); + +integer G77_chdir_0 (name, Lname) + char *name; + ftnlen Lname; +#else +void g_char(const char *a, ftnlen alen, char *b); + +integer G77_chdir_0 (const char *name, const ftnlen Lname) +#endif +{ + char *buff; + char *bp, *blast; + int i; + + buff = malloc (Lname+1); + if (!buff) return -1; + g_char (name, Lname, buff); + i = chdir (buff); + free (buff); + return i ? errno : 0; +} diff --git a/libf2c/libU77/chmod_.c b/libf2c/libU77/chmod_.c new file mode 100644 index 00000000000..d482d9ed828 --- /dev/null +++ b/libf2c/libU77/chmod_.c @@ -0,0 +1,82 @@ +/* Copyright (C) 1995, 1997 Free Software Foundation, Inc. +This file is part of GNU Fortran libU77 library. + +This library is free software; you can redistribute it and/or modify it +under the terms of the GNU Library General Public License as published +by the Free Software Foundation; either version 2 of the License, or +(at your option) any later version. + +GNU Fortran is distributed in the hope that it will be useful, +but WITHOUT ANY WARRANTY; without even the implied warranty of +MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +Library General Public License for more details. + +You should have received a copy of the GNU Library General Public +License along with GNU Fortran; see the file COPYING.LIB. If +not, write to the Free Software Foundation, Inc., 59 Temple Place - Suite 330, +Boston, MA 02111-1307, USA. */ + + +/* This definitely shouldn't be done this way -- should canibalise + chmod(1) from GNU or BSD. */ + +#ifdef HAVE_CONFIG_H +#include "config.h" +#endif +#if HAVE_UNISTD_H +# include +#endif +#if HAVE_STDLIB_H +# include +#else +# include +#endif +#if STDC_HEADERS +# include +#endif + +#include "f2c.h" + +#ifndef CHMOD_PATH +#define CHMOD_PATH "/bin/chmod" +#endif + +#ifdef KR_headers +extern void s_cat (); +void g_char (); + +integer G77_chmod_0 (name, mode, Lname, Lmode) + char *name, *mode; + ftnlen Lname, Lmode; +#else +extern void s_cat(char *lp, char *rpp[], ftnlen rnp[], ftnlen *np, ftnlen ll); +void g_char(const char *a, ftnlen alen, char *b); + +integer G77_chmod_0 (/* const */ char *name, /* const */ char *mode, const ftnlen Lname, const ftnlen Lmode) +#endif +{ + char *buff; + char *bp, *blast; + int i; + ftnlen l, l2; + ftnlen six = 6; + address a[6]; + ftnlen ii[6]; + char chmod_path [] = CHMOD_PATH; + l = strlen (chmod_path); + buff = malloc (Lname+Lmode+l+3+13+1); + if (!buff) return -1; + ii[0] = l; a[0] = chmod_path; + ii[1] = 1; a[1] = " "; + ii[2] = Lmode; a[2] = mode; + ii[3] = 2; a[3] = " '"; + for (l2=Lname; (l2 > 1) && (name[l2-1] == ' '); ) + l2--; + ii[4] = l2; a[4] = name; + ii[5] = 13; a[5] = "' 2>/dev/null"; + s_cat (buff, a, ii, &six, Lname+Lmode+l+3+13); + buff[Lname+Lmode+l+3+13] = '\0'; + i = system (buff); + free (buff); + return i; +} diff --git a/libf2c/libU77/config.h.in b/libf2c/libU77/config.h.in new file mode 100644 index 00000000000..c967b25f21d --- /dev/null +++ b/libf2c/libU77/config.h.in @@ -0,0 +1,103 @@ +/* config.h.in. Generated automatically from configure.in by autoheader. */ + +/* Define to empty if the keyword does not work. */ +#undef const + +/* Define if your struct stat has st_blksize. */ +#undef HAVE_ST_BLKSIZE + +/* Define if your struct stat has st_blocks. */ +#undef HAVE_ST_BLOCKS + +/* Define if your struct stat has st_rdev. */ +#undef HAVE_ST_RDEV + +/* Define to `int' if doesn't define. */ +#undef mode_t + +/* Define to `int' if doesn't define. */ +#undef pid_t + +/* Define to `unsigned' if doesn't define. */ +#undef size_t + +/* Define if you have the ANSI C header files. */ +#undef STDC_HEADERS + +/* Define if you can safely include both and . */ +#undef TIME_WITH_SYS_TIME + +/* Define if your declares struct tm. */ +#undef TM_IN_SYS_TIME + +/* Define as the path of the `chmod' program. */ +#undef CHMOD_PATH + +/* Define if you have the clock function. */ +#undef HAVE_CLOCK + +/* Define if you have the getcwd function. */ +#undef HAVE_GETCWD + +/* Define if you have the gethostname function. */ +#undef HAVE_GETHOSTNAME + +/* Define if you have the getrusage function. */ +#undef HAVE_GETRUSAGE + +/* Define if you have the getwd function. */ +#undef HAVE_GETWD + +/* Define if you have the lstat function. */ +#undef HAVE_LSTAT + +/* Define if you have the strerror function. */ +#undef HAVE_STRERROR + +/* Define if you have the symlink function. */ +#undef HAVE_SYMLINK + +/* Define if you have the header file. */ +#undef HAVE_LIMITS_H + +/* Define if you have the header file. */ +#undef HAVE_STDLIB_H + +/* Define if you have the header file. */ +#undef HAVE_STRING_H + +/* Define if you have the header file. */ +#undef HAVE_SYS_TIME_H + +/* Define if you have the header file. */ +#undef HAVE_UNISTD_H + +/* Define if you have the header file. */ +#undef HAVE_SYS_PARAM_H + +/* Define if you have the header file. */ +#undef HAVE_SYS_TIMES_H + +/* Define if you have the alarm function. */ +#undef HAVE_ALARM + +/* Define if you have the times function. */ +#undef HAVE_TIMES + +/* Define if you have the getlogin function. */ +#undef HAVE_GETLOGIN + +/* Define if you have the getgid function. */ +#undef HAVE_GETGID + +/* Define if you have the getuid function. */ +#undef HAVE_GETUID + +/* Define if you have the kill function. */ +#undef HAVE_KILL + +/* Define if you have the link function. */ +#undef HAVE_LINK + +/* Define if you have the ttyname function. */ +#undef HAVE_TTYNAME diff --git a/libf2c/libU77/configure b/libf2c/libU77/configure new file mode 100755 index 00000000000..339e8681e52 --- /dev/null +++ b/libf2c/libU77/configure @@ -0,0 +1,1765 @@ +#! /bin/sh + +# Guess values for system-dependent variables and create Makefiles. +# Generated automatically using autoconf version 2.12.1 +# Copyright (C) 1992, 93, 94, 95, 96 Free Software Foundation, Inc. +# +# This configure script is free software; the Free Software Foundation +# gives unlimited permission to copy, distribute and modify it. + +# Defaults: +ac_help= +ac_default_prefix=/usr/local +# Any additions from configure.in: + +# Initialize some variables set by options. +# The variables have the same names as the options, with +# dashes changed to underlines. +build=NONE +cache_file=./config.cache +exec_prefix=NONE +host=NONE +no_create= +nonopt=NONE +no_recursion= +prefix=NONE +program_prefix=NONE +program_suffix=NONE +program_transform_name=s,x,x, +silent= +site= +srcdir= +target=NONE +verbose= +x_includes=NONE +x_libraries=NONE +bindir='${exec_prefix}/bin' +sbindir='${exec_prefix}/sbin' +libexecdir='${exec_prefix}/libexec' +datadir='${prefix}/share' +sysconfdir='${prefix}/etc' +sharedstatedir='${prefix}/com' +localstatedir='${prefix}/var' +libdir='${exec_prefix}/lib' +includedir='${prefix}/include' +oldincludedir='/usr/include' +infodir='${prefix}/info' +mandir='${prefix}/man' + +# Initialize some other variables. +subdirs= +MFLAGS= MAKEFLAGS= +SHELL=${CONFIG_SHELL-/bin/sh} +# Maximum number of lines to put in a shell here document. +ac_max_here_lines=12 + +ac_prev= +for ac_option +do + + # If the previous option needs an argument, assign it. + if test -n "$ac_prev"; then + eval "$ac_prev=\$ac_option" + ac_prev= + continue + fi + + case "$ac_option" in + -*=*) ac_optarg=`echo "$ac_option" | sed 's/[-_a-zA-Z0-9]*=//'` ;; + *) ac_optarg= ;; + esac + + # Accept the important Cygnus configure options, so we can diagnose typos. + + case "$ac_option" in + + -bindir | --bindir | --bindi | --bind | --bin | --bi) + ac_prev=bindir ;; + -bindir=* | --bindir=* | --bindi=* | --bind=* | --bin=* | --bi=*) + bindir="$ac_optarg" ;; + + -build | --build | --buil | --bui | --bu) + ac_prev=build ;; + -build=* | --build=* | --buil=* | --bui=* | --bu=*) + build="$ac_optarg" ;; + + -cache-file | --cache-file | --cache-fil | --cache-fi \ + | --cache-f | --cache- | --cache | --cach | --cac | --ca | --c) + ac_prev=cache_file ;; + -cache-file=* | --cache-file=* | --cache-fil=* | --cache-fi=* \ + | --cache-f=* | --cache-=* | --cache=* | --cach=* | --cac=* | --ca=* | --c=*) + cache_file="$ac_optarg" ;; + + -datadir | --datadir | --datadi | --datad | --data | --dat | --da) + ac_prev=datadir ;; + -datadir=* | --datadir=* | --datadi=* | --datad=* | --data=* | --dat=* \ + | --da=*) + datadir="$ac_optarg" ;; + + -disable-* | --disable-*) + ac_feature=`echo $ac_option|sed -e 's/-*disable-//'` + # Reject names that are not valid shell variable names. + if test -n "`echo $ac_feature| sed 's/[-a-zA-Z0-9_]//g'`"; then + { echo "configure: error: $ac_feature: invalid feature name" 1>&2; exit 1; } + fi + ac_feature=`echo $ac_feature| sed 's/-/_/g'` + eval "enable_${ac_feature}=no" ;; + + -enable-* | --enable-*) + ac_feature=`echo $ac_option|sed -e 's/-*enable-//' -e 's/=.*//'` + # Reject names that are not valid shell variable names. + if test -n "`echo $ac_feature| sed 's/[-_a-zA-Z0-9]//g'`"; then + { echo "configure: error: $ac_feature: invalid feature name" 1>&2; exit 1; } + fi + ac_feature=`echo $ac_feature| sed 's/-/_/g'` + case "$ac_option" in + *=*) ;; + *) ac_optarg=yes ;; + esac + eval "enable_${ac_feature}='$ac_optarg'" ;; + + -exec-prefix | --exec_prefix | --exec-prefix | --exec-prefi \ + | --exec-pref | --exec-pre | --exec-pr | --exec-p | --exec- \ + | --exec | --exe | --ex) + ac_prev=exec_prefix ;; + -exec-prefix=* | --exec_prefix=* | --exec-prefix=* | --exec-prefi=* \ + | --exec-pref=* | --exec-pre=* | --exec-pr=* | --exec-p=* | --exec-=* \ + | --exec=* | --exe=* | --ex=*) + exec_prefix="$ac_optarg" ;; + + -gas | --gas | --ga | --g) + # Obsolete; use --with-gas. + with_gas=yes ;; + + -help | --help | --hel | --he) + # Omit some internal or obsolete options to make the list less imposing. + # This message is too long to be a string in the A/UX 3.1 sh. + cat << EOF +Usage: configure [options] [host] +Options: [defaults in brackets after descriptions] +Configuration: + --cache-file=FILE cache test results in FILE + --help print this message + --no-create do not create output files + --quiet, --silent do not print \`checking...' messages + --version print the version of autoconf that created configure +Directory and file names: + --prefix=PREFIX install architecture-independent files in PREFIX + [$ac_default_prefix] + --exec-prefix=EPREFIX install architecture-dependent files in EPREFIX + [same as prefix] + --bindir=DIR user executables in DIR [EPREFIX/bin] + --sbindir=DIR system admin executables in DIR [EPREFIX/sbin] + --libexecdir=DIR program executables in DIR [EPREFIX/libexec] + --datadir=DIR read-only architecture-independent data in DIR + [PREFIX/share] + --sysconfdir=DIR read-only single-machine data in DIR [PREFIX/etc] + --sharedstatedir=DIR modifiable architecture-independent data in DIR + [PREFIX/com] + --localstatedir=DIR modifiable single-machine data in DIR [PREFIX/var] + --libdir=DIR object code libraries in DIR [EPREFIX/lib] + --includedir=DIR C header files in DIR [PREFIX/include] + --oldincludedir=DIR C header files for non-gcc in DIR [/usr/include] + --infodir=DIR info documentation in DIR [PREFIX/info] + --mandir=DIR man documentation in DIR [PREFIX/man] + --srcdir=DIR find the sources in DIR [configure dir or ..] + --program-prefix=PREFIX prepend PREFIX to installed program names + --program-suffix=SUFFIX append SUFFIX to installed program names + --program-transform-name=PROGRAM + run sed PROGRAM on installed program names +EOF + cat << EOF +Host type: + --build=BUILD configure for building on BUILD [BUILD=HOST] + --host=HOST configure for HOST [guessed] + --target=TARGET configure for TARGET [TARGET=HOST] +Features and packages: + --disable-FEATURE do not include FEATURE (same as --enable-FEATURE=no) + --enable-FEATURE[=ARG] include FEATURE [ARG=yes] + --with-PACKAGE[=ARG] use PACKAGE [ARG=yes] + --without-PACKAGE do not use PACKAGE (same as --with-PACKAGE=no) + --x-includes=DIR X include files are in DIR + --x-libraries=DIR X library files are in DIR +EOF + if test -n "$ac_help"; then + echo "--enable and --with options recognized:$ac_help" + fi + exit 0 ;; + + -host | --host | --hos | --ho) + ac_prev=host ;; + -host=* | --host=* | --hos=* | --ho=*) + host="$ac_optarg" ;; + + -includedir | --includedir | --includedi | --included | --include \ + | --includ | --inclu | --incl | --inc) + ac_prev=includedir ;; + -includedir=* | --includedir=* | --includedi=* | --included=* | --include=* \ + | --includ=* | --inclu=* | --incl=* | --inc=*) + includedir="$ac_optarg" ;; + + -infodir | --infodir | --infodi | --infod | --info | --inf) + ac_prev=infodir ;; + -infodir=* | --infodir=* | --infodi=* | --infod=* | --info=* | --inf=*) + infodir="$ac_optarg" ;; + + -libdir | --libdir | --libdi | --libd) + ac_prev=libdir ;; + -libdir=* | --libdir=* | --libdi=* | --libd=*) + libdir="$ac_optarg" ;; + + -libexecdir | --libexecdir | --libexecdi | --libexecd | --libexec \ + | --libexe | --libex | --libe) + ac_prev=libexecdir ;; + -libexecdir=* | --libexecdir=* | --libexecdi=* | --libexecd=* | --libexec=* \ + | --libexe=* | --libex=* | --libe=*) + libexecdir="$ac_optarg" ;; + + -localstatedir | --localstatedir | --localstatedi | --localstated \ + | --localstate | --localstat | --localsta | --localst \ + | --locals | --local | --loca | --loc | --lo) + ac_prev=localstatedir ;; + -localstatedir=* | --localstatedir=* | --localstatedi=* | --localstated=* \ + | --localstate=* | --localstat=* | --localsta=* | --localst=* \ + | --locals=* | --local=* | --loca=* | --loc=* | --lo=*) + localstatedir="$ac_optarg" ;; + + -mandir | --mandir | --mandi | --mand | --man | --ma | --m) + ac_prev=mandir ;; + -mandir=* | --mandir=* | --mandi=* | --mand=* | --man=* | --ma=* | --m=*) + mandir="$ac_optarg" ;; + + -nfp | --nfp | --nf) + # Obsolete; use --without-fp. + with_fp=no ;; + + -no-create | --no-create | --no-creat | --no-crea | --no-cre \ + | --no-cr | --no-c) + no_create=yes ;; + + -no-recursion | --no-recursion | --no-recursio | --no-recursi \ + | --no-recurs | --no-recur | --no-recu | --no-rec | --no-re | --no-r) + no_recursion=yes ;; + + -oldincludedir | --oldincludedir | --oldincludedi | --oldincluded \ + | --oldinclude | --oldinclud | --oldinclu | --oldincl | --oldinc \ + | --oldin | --oldi | --old | --ol | --o) + ac_prev=oldincludedir ;; + -oldincludedir=* | --oldincludedir=* | --oldincludedi=* | --oldincluded=* \ + | --oldinclude=* | --oldinclud=* | --oldinclu=* | --oldincl=* | --oldinc=* \ + | --oldin=* | --oldi=* | --old=* | --ol=* | --o=*) + oldincludedir="$ac_optarg" ;; + + -prefix | --prefix | --prefi | --pref | --pre | --pr | --p) + ac_prev=prefix ;; + -prefix=* | --prefix=* | --prefi=* | --pref=* | --pre=* | --pr=* | --p=*) + prefix="$ac_optarg" ;; + + -program-prefix | --program-prefix | --program-prefi | --program-pref \ + | --program-pre | --program-pr | --program-p) + ac_prev=program_prefix ;; + -program-prefix=* | --program-prefix=* | --program-prefi=* \ + | --program-pref=* | --program-pre=* | --program-pr=* | --program-p=*) + program_prefix="$ac_optarg" ;; + + -program-suffix | --program-suffix | --program-suffi | --program-suff \ + | --program-suf | --program-su | --program-s) + ac_prev=program_suffix ;; + -program-suffix=* | --program-suffix=* | --program-suffi=* \ + | --program-suff=* | --program-suf=* | --program-su=* | --program-s=*) + program_suffix="$ac_optarg" ;; + + -program-transform-name | --program-transform-name \ + | --program-transform-nam | --program-transform-na \ + | --program-transform-n | --program-transform- \ + | --program-transform | --program-transfor \ + | --program-transfo | --program-transf \ + | --program-trans | --program-tran \ + | --progr-tra | --program-tr | --program-t) + ac_prev=program_transform_name ;; + -program-transform-name=* | --program-transform-name=* \ + | --program-transform-nam=* | --program-transform-na=* \ + | --program-transform-n=* | --program-transform-=* \ + | --program-transform=* | --program-transfor=* \ + | --program-transfo=* | --program-transf=* \ + | --program-trans=* | --program-tran=* \ + | --progr-tra=* | --program-tr=* | --program-t=*) + program_transform_name="$ac_optarg" ;; + + -q | -quiet | --quiet | --quie | --qui | --qu | --q \ + | -silent | --silent | --silen | --sile | --sil) + silent=yes ;; + + -sbindir | --sbindir | --sbindi | --sbind | --sbin | --sbi | --sb) + ac_prev=sbindir ;; + -sbindir=* | --sbindir=* | --sbindi=* | --sbind=* | --sbin=* \ + | --sbi=* | --sb=*) + sbindir="$ac_optarg" ;; + + -sharedstatedir | --sharedstatedir | --sharedstatedi \ + | --sharedstated | --sharedstate | --sharedstat | --sharedsta \ + | --sharedst | --shareds | --shared | --share | --shar \ + | --sha | --sh) + ac_prev=sharedstatedir ;; + -sharedstatedir=* | --sharedstatedir=* | --sharedstatedi=* \ + | --sharedstated=* | --sharedstate=* | --sharedstat=* | --sharedsta=* \ + | --sharedst=* | --shareds=* | --shared=* | --share=* | --shar=* \ + | --sha=* | --sh=*) + sharedstatedir="$ac_optarg" ;; + + -site | --site | --sit) + ac_prev=site ;; + -site=* | --site=* | --sit=*) + site="$ac_optarg" ;; + + -srcdir | --srcdir | --srcdi | --srcd | --src | --sr) + ac_prev=srcdir ;; + -srcdir=* | --srcdir=* | --srcdi=* | --srcd=* | --src=* | --sr=*) + srcdir="$ac_optarg" ;; + + -sysconfdir | --sysconfdir | --sysconfdi | --sysconfd | --sysconf \ + | --syscon | --sysco | --sysc | --sys | --sy) + ac_prev=sysconfdir ;; + -sysconfdir=* | --sysconfdir=* | --sysconfdi=* | --sysconfd=* | --sysconf=* \ + | --syscon=* | --sysco=* | --sysc=* | --sys=* | --sy=*) + sysconfdir="$ac_optarg" ;; + + -target | --target | --targe | --targ | --tar | --ta | --t) + ac_prev=target ;; + -target=* | --target=* | --targe=* | --targ=* | --tar=* | --ta=* | --t=*) + target="$ac_optarg" ;; + + -v | -verbose | --verbose | --verbos | --verbo | --verb) + verbose=yes ;; + + -version | --version | --versio | --versi | --vers) + echo "configure generated by autoconf version 2.12.1" + exit 0 ;; + + -with-* | --with-*) + ac_package=`echo $ac_option|sed -e 's/-*with-//' -e 's/=.*//'` + # Reject names that are not valid shell variable names. + if test -n "`echo $ac_package| sed 's/[-_a-zA-Z0-9]//g'`"; then + { echo "configure: error: $ac_package: invalid package name" 1>&2; exit 1; } + fi + ac_package=`echo $ac_package| sed 's/-/_/g'` + case "$ac_option" in + *=*) ;; + *) ac_optarg=yes ;; + esac + eval "with_${ac_package}='$ac_optarg'" ;; + + -without-* | --without-*) + ac_package=`echo $ac_option|sed -e 's/-*without-//'` + # Reject names that are not valid shell variable names. + if test -n "`echo $ac_package| sed 's/[-a-zA-Z0-9_]//g'`"; then + { echo "configure: error: $ac_package: invalid package name" 1>&2; exit 1; } + fi + ac_package=`echo $ac_package| sed 's/-/_/g'` + eval "with_${ac_package}=no" ;; + + --x) + # Obsolete; use --with-x. + with_x=yes ;; + + -x-includes | --x-includes | --x-include | --x-includ | --x-inclu \ + | --x-incl | --x-inc | --x-in | --x-i) + ac_prev=x_includes ;; + -x-includes=* | --x-includes=* | --x-include=* | --x-includ=* | --x-inclu=* \ + | --x-incl=* | --x-inc=* | --x-in=* | --x-i=*) + x_includes="$ac_optarg" ;; + + -x-libraries | --x-libraries | --x-librarie | --x-librari \ + | --x-librar | --x-libra | --x-libr | --x-lib | --x-li | --x-l) + ac_prev=x_libraries ;; + -x-libraries=* | --x-libraries=* | --x-librarie=* | --x-librari=* \ + | --x-librar=* | --x-libra=* | --x-libr=* | --x-lib=* | --x-li=* | --x-l=*) + x_libraries="$ac_optarg" ;; + + -*) { echo "configure: error: $ac_option: invalid option; use --help to show usage" 1>&2; exit 1; } + ;; + + *) + if test -n "`echo $ac_option| sed 's/[-a-z0-9.]//g'`"; then + echo "configure: warning: $ac_option: invalid host type" 1>&2 + fi + if test "x$nonopt" != xNONE; then + { echo "configure: error: can only configure for one host and one target at a time" 1>&2; exit 1; } + fi + nonopt="$ac_option" + ;; + + esac +done + +if test -n "$ac_prev"; then + { echo "configure: error: missing argument to --`echo $ac_prev | sed 's/_/-/g'`" 1>&2; exit 1; } +fi + +trap 'rm -fr conftest* confdefs* core core.* *.core $ac_clean_files; exit 1' 1 2 15 + +# File descriptor usage: +# 0 standard input +# 1 file creation +# 2 errors and warnings +# 3 some systems may open it to /dev/tty +# 4 used on the Kubota Titan +# 6 checking for... messages and results +# 5 compiler messages saved in config.log +if test "$silent" = yes; then + exec 6>/dev/null +else + exec 6>&1 +fi +exec 5>./config.log + +echo "\ +This file contains any messages produced by compilers while +running configure, to aid debugging if configure makes a mistake. +" 1>&5 + +# Strip out --no-create and --no-recursion so they do not pile up. +# Also quote any args containing shell metacharacters. +ac_configure_args= +for ac_arg +do + case "$ac_arg" in + -no-create | --no-create | --no-creat | --no-crea | --no-cre \ + | --no-cr | --no-c) ;; + -no-recursion | --no-recursion | --no-recursio | --no-recursi \ + | --no-recurs | --no-recur | --no-recu | --no-rec | --no-re | --no-r) ;; + *" "*|*" "*|*[\[\]\~\#\$\^\&\*\(\)\{\}\\\|\;\<\>\?]*) + ac_configure_args="$ac_configure_args '$ac_arg'" ;; + *) ac_configure_args="$ac_configure_args $ac_arg" ;; + esac +done + +# NLS nuisances. +# Only set these to C if already set. These must not be set unconditionally +# because not all systems understand e.g. LANG=C (notably SCO). +# Fixing LC_MESSAGES prevents Solaris sh from translating var values in `set'! +# Non-C LC_CTYPE values break the ctype check. +if test "${LANG+set}" = set; then LANG=C; export LANG; fi +if test "${LC_ALL+set}" = set; then LC_ALL=C; export LC_ALL; fi +if test "${LC_MESSAGES+set}" = set; then LC_MESSAGES=C; export LC_MESSAGES; fi +if test "${LC_CTYPE+set}" = set; then LC_CTYPE=C; export LC_CTYPE; fi + +# confdefs.h avoids OS command line length limits that DEFS can exceed. +rm -rf conftest* confdefs.h +# AIX cpp loses on an empty file, so make sure it contains at least a newline. +echo > confdefs.h + +# A filename unique to this package, relative to the directory that +# configure is in, which we can look for to find out if srcdir is correct. +ac_unique_file=access_.c + +# Find the source files, if location was not specified. +if test -z "$srcdir"; then + ac_srcdir_defaulted=yes + # Try the directory containing this script, then its parent. + ac_prog=$0 + ac_confdir=`echo $ac_prog|sed 's%/[^/][^/]*$%%'` + test "x$ac_confdir" = "x$ac_prog" && ac_confdir=. + srcdir=$ac_confdir + if test ! -r $srcdir/$ac_unique_file; then + srcdir=.. + fi +else + ac_srcdir_defaulted=no +fi +if test ! -r $srcdir/$ac_unique_file; then + if test "$ac_srcdir_defaulted" = yes; then + { echo "configure: error: can not find sources in $ac_confdir or .." 1>&2; exit 1; } + else + { echo "configure: error: can not find sources in $srcdir" 1>&2; exit 1; } + fi +fi +srcdir=`echo "${srcdir}" | sed 's%\([^/]\)/*$%\1%'` + +# Prefer explicitly selected file to automatically selected ones. +if test -z "$CONFIG_SITE"; then + if test "x$prefix" != xNONE; then + CONFIG_SITE="$prefix/share/config.site $prefix/etc/config.site" + else + CONFIG_SITE="$ac_default_prefix/share/config.site $ac_default_prefix/etc/config.site" + fi +fi +for ac_site_file in $CONFIG_SITE; do + if test -r "$ac_site_file"; then + echo "loading site script $ac_site_file" + . "$ac_site_file" + fi +done + +if test -r "$cache_file"; then + echo "loading cache $cache_file" + . $cache_file +else + echo "creating cache $cache_file" + > $cache_file +fi + +ac_ext=c +# CFLAGS is not in ac_cpp because -g, -O, etc. are not valid cpp options. +ac_cpp='$CPP $CPPFLAGS' +ac_compile='${CC-cc} -c $CFLAGS $CPPFLAGS conftest.$ac_ext 1>&5' +ac_link='${CC-cc} -o conftest $CFLAGS $CPPFLAGS $LDFLAGS conftest.$ac_ext $LIBS 1>&5' +cross_compiling=$ac_cv_prog_cc_cross + +if (echo "testing\c"; echo 1,2,3) | grep c >/dev/null; then + # Stardent Vistra SVR4 grep lacks -e, says ghazi@caip.rutgers.edu. + if (echo -n testing; echo 1,2,3) | sed s/-n/xn/ | grep xn >/dev/null; then + ac_n= ac_c=' +' ac_t=' ' + else + ac_n=-n ac_c= ac_t= + fi +else + ac_n= ac_c='\c' ac_t= +fi + + + + +# For g77 we'll set CC to point at the built gcc, but this will get it into +# the makefiles +# Extract the first word of "gcc", so it can be a program name with args. +set dummy gcc; ac_word=$2 +echo $ac_n "checking for $ac_word""... $ac_c" 1>&6 +echo "configure:530: checking for $ac_word" >&5 +if eval "test \"`echo '$''{'ac_cv_prog_CC'+set}'`\" = set"; then + echo $ac_n "(cached) $ac_c" 1>&6 +else + if test -n "$CC"; then + ac_cv_prog_CC="$CC" # Let the user override the test. +else + IFS="${IFS= }"; ac_save_ifs="$IFS"; IFS="${IFS}:" + for ac_dir in $PATH; do + test -z "$ac_dir" && ac_dir=. + if test -f $ac_dir/$ac_word; then + ac_cv_prog_CC="gcc" + break + fi + done + IFS="$ac_save_ifs" +fi +fi +CC="$ac_cv_prog_CC" +if test -n "$CC"; then + echo "$ac_t""$CC" 1>&6 +else + echo "$ac_t""no" 1>&6 +fi + +if test -z "$CC"; then + # Extract the first word of "cc", so it can be a program name with args. +set dummy cc; ac_word=$2 +echo $ac_n "checking for $ac_word""... $ac_c" 1>&6 +echo "configure:559: checking for $ac_word" >&5 +if eval "test \"`echo '$''{'ac_cv_prog_CC'+set}'`\" = set"; then + echo $ac_n "(cached) $ac_c" 1>&6 +else + if test -n "$CC"; then + ac_cv_prog_CC="$CC" # Let the user override the test. +else + IFS="${IFS= }"; ac_save_ifs="$IFS"; IFS="${IFS}:" + ac_prog_rejected=no + for ac_dir in $PATH; do + test -z "$ac_dir" && ac_dir=. + if test -f $ac_dir/$ac_word; then + if test "$ac_dir/$ac_word" = "/usr/ucb/cc"; then + ac_prog_rejected=yes + continue + fi + ac_cv_prog_CC="cc" + break + fi + done + IFS="$ac_save_ifs" +if test $ac_prog_rejected = yes; then + # We found a bogon in the path, so make sure we never use it. + set dummy $ac_cv_prog_CC + shift + if test $# -gt 0; then + # We chose a different compiler from the bogus one. + # However, it has the same basename, so the bogon will be chosen + # first if we set CC to just the basename; use the full file name. + shift + set dummy "$ac_dir/$ac_word" "$@" + shift + ac_cv_prog_CC="$@" + fi +fi +fi +fi +CC="$ac_cv_prog_CC" +if test -n "$CC"; then + echo "$ac_t""$CC" 1>&6 +else + echo "$ac_t""no" 1>&6 +fi + + test -z "$CC" && { echo "configure: error: no acceptable cc found in \$PATH" 1>&2; exit 1; } +fi + +echo $ac_n "checking whether the C compiler ($CC $CFLAGS $LDFLAGS) works""... $ac_c" 1>&6 +echo "configure:607: checking whether the C compiler ($CC $CFLAGS $LDFLAGS) works" >&5 + +ac_ext=c +# CFLAGS is not in ac_cpp because -g, -O, etc. are not valid cpp options. +ac_cpp='$CPP $CPPFLAGS' +ac_compile='${CC-cc} -c $CFLAGS $CPPFLAGS conftest.$ac_ext 1>&5' +ac_link='${CC-cc} -o conftest $CFLAGS $CPPFLAGS $LDFLAGS conftest.$ac_ext $LIBS 1>&5' +cross_compiling=$ac_cv_prog_cc_cross + +cat > conftest.$ac_ext <&5; (eval $ac_link) 2>&5; } && test -s conftest; then + ac_cv_prog_cc_works=yes + # If we can't run a trivial program, we are probably using a cross compiler. + if (./conftest; exit) 2>/dev/null; then + ac_cv_prog_cc_cross=no + else + ac_cv_prog_cc_cross=yes + fi +else + echo "configure: failed program was:" >&5 + cat conftest.$ac_ext >&5 + ac_cv_prog_cc_works=no +fi +rm -fr conftest* + +echo "$ac_t""$ac_cv_prog_cc_works" 1>&6 +if test $ac_cv_prog_cc_works = no; then + { echo "configure: error: installation or configuration problem: C compiler cannot create executables." 1>&2; exit 1; } +fi +echo $ac_n "checking whether the C compiler ($CC $CFLAGS $LDFLAGS) is a cross-compiler""... $ac_c" 1>&6 +echo "configure:641: checking whether the C compiler ($CC $CFLAGS $LDFLAGS) is a cross-compiler" >&5 +echo "$ac_t""$ac_cv_prog_cc_cross" 1>&6 +cross_compiling=$ac_cv_prog_cc_cross + +echo $ac_n "checking whether we are using GNU C""... $ac_c" 1>&6 +echo "configure:646: checking whether we are using GNU C" >&5 +if eval "test \"`echo '$''{'ac_cv_prog_gcc'+set}'`\" = set"; then + echo $ac_n "(cached) $ac_c" 1>&6 +else + cat > conftest.c <&5; (eval $ac_try) 2>&5; }; } | egrep yes >/dev/null 2>&1; then + ac_cv_prog_gcc=yes +else + ac_cv_prog_gcc=no +fi +fi + +echo "$ac_t""$ac_cv_prog_gcc" 1>&6 + +if test $ac_cv_prog_gcc = yes; then + GCC=yes + ac_test_CFLAGS="${CFLAGS+set}" + ac_save_CFLAGS="$CFLAGS" + CFLAGS= + echo $ac_n "checking whether ${CC-cc} accepts -g""... $ac_c" 1>&6 +echo "configure:670: checking whether ${CC-cc} accepts -g" >&5 +if eval "test \"`echo '$''{'ac_cv_prog_cc_g'+set}'`\" = set"; then + echo $ac_n "(cached) $ac_c" 1>&6 +else + echo 'void f(){}' > conftest.c +if test -z "`${CC-cc} -g -c conftest.c 2>&1`"; then + ac_cv_prog_cc_g=yes +else + ac_cv_prog_cc_g=no +fi +rm -f conftest* + +fi + +echo "$ac_t""$ac_cv_prog_cc_g" 1>&6 + if test "$ac_test_CFLAGS" = set; then + CFLAGS="$ac_save_CFLAGS" + elif test $ac_cv_prog_cc_g = yes; then + CFLAGS="-g -O2" + else + CFLAGS="-O2" + fi +else + GCC= + test "${CFLAGS+set}" = set || CFLAGS="-g" +fi + +if test "$CROSS";then + ac_cv_c_cross=yes +else + ac_cv_c_cross=no +fi + +# Extract the first word of "chmod", so it can be a program name with args. +set dummy chmod; ac_word=$2 +echo $ac_n "checking for $ac_word""... $ac_c" 1>&6 +echo "configure:706: checking for $ac_word" >&5 +if eval "test \"`echo '$''{'ac_cv_path_ac_cv_prog_chmod'+set}'`\" = set"; then + echo $ac_n "(cached) $ac_c" 1>&6 +else + case "$ac_cv_prog_chmod" in + /*) + ac_cv_path_ac_cv_prog_chmod="$ac_cv_prog_chmod" # Let the user override the test with a path. + ;; + ?:/*) + ac_cv_path_ac_cv_prog_chmod="$ac_cv_prog_chmod" # Let the user override the test with a dos path. + ;; + *) + IFS="${IFS= }"; ac_save_ifs="$IFS"; IFS="${IFS}:" + for ac_dir in $PATH; do + test -z "$ac_dir" && ac_dir=. + if test -f $ac_dir/$ac_word; then + ac_cv_path_ac_cv_prog_chmod="$ac_dir/$ac_word" + break + fi + done + IFS="$ac_save_ifs" + test -z "$ac_cv_path_ac_cv_prog_chmod" && ac_cv_path_ac_cv_prog_chmod="no" + ;; +esac +fi +ac_cv_prog_chmod="$ac_cv_path_ac_cv_prog_chmod" +if test -n "$ac_cv_prog_chmod"; then + echo "$ac_t""$ac_cv_prog_chmod" 1>&6 +else + echo "$ac_t""no" 1>&6 +fi + +if test "$ac_cv_prog_chmod" != no || test "$CROSS"; then + MAYBES=chmod_.o + cat >> confdefs.h <&6 +echo "configure:756: checking for $ac_word" >&5 +if eval "test \"`echo '$''{'ac_cv_prog_RANLIB'+set}'`\" = set"; then + echo $ac_n "(cached) $ac_c" 1>&6 +else + if test -n "$RANLIB"; then + ac_cv_prog_RANLIB="$RANLIB" # Let the user override the test. +else + IFS="${IFS= }"; ac_save_ifs="$IFS"; IFS="${IFS}:" + for ac_dir in $PATH; do + test -z "$ac_dir" && ac_dir=. + if test -f $ac_dir/$ac_word; then + ac_cv_prog_RANLIB="ranlib" + break + fi + done + IFS="$ac_save_ifs" + test -z "$ac_cv_prog_RANLIB" && ac_cv_prog_RANLIB=":" +fi +fi +RANLIB="$ac_cv_prog_RANLIB" +if test -n "$RANLIB"; then + echo "$ac_t""$RANLIB" 1>&6 +else + echo "$ac_t""no" 1>&6 +fi + + AR=ar + RANLIB_TEST=true +fi + + + +echo $ac_n "checking how to run the C preprocessor""... $ac_c" 1>&6 +echo "configure:789: checking how to run the C preprocessor" >&5 +# On Suns, sometimes $CPP names a directory. +if test -n "$CPP" && test -d "$CPP"; then + CPP= +fi +if test -z "$CPP"; then +if eval "test \"`echo '$''{'ac_cv_prog_CPP'+set}'`\" = set"; then + echo $ac_n "(cached) $ac_c" 1>&6 +else + # This must be in double quotes, not single quotes, because CPP may get + # substituted into the Makefile and "${CC-cc}" will confuse make. + CPP="${CC-cc} -E" + # On the NeXT, cc -E runs the code through the compiler's parser, + # not just through cpp. + cat > conftest.$ac_ext < +Syntax Error +EOF +ac_try="$ac_cpp conftest.$ac_ext >/dev/null 2>conftest.out" +{ (eval echo configure:810: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; } +ac_err=`grep -v '^ *+' conftest.out` +if test -z "$ac_err"; then + : +else + echo "$ac_err" >&5 + echo "configure: failed program was:" >&5 + cat conftest.$ac_ext >&5 + rm -rf conftest* + CPP="${CC-cc} -E -traditional-cpp" + cat > conftest.$ac_ext < +Syntax Error +EOF +ac_try="$ac_cpp conftest.$ac_ext >/dev/null 2>conftest.out" +{ (eval echo configure:827: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; } +ac_err=`grep -v '^ *+' conftest.out` +if test -z "$ac_err"; then + : +else + echo "$ac_err" >&5 + echo "configure: failed program was:" >&5 + cat conftest.$ac_ext >&5 + rm -rf conftest* + CPP=/lib/cpp +fi +rm -f conftest* +fi +rm -f conftest* + ac_cv_prog_CPP="$CPP" +fi + CPP="$ac_cv_prog_CPP" +else + ac_cv_prog_CPP="$CPP" +fi +echo "$ac_t""$CPP" 1>&6 + +echo $ac_n "checking for ANSI C header files""... $ac_c" 1>&6 +echo "configure:850: checking for ANSI C header files" >&5 +if eval "test \"`echo '$''{'ac_cv_header_stdc'+set}'`\" = set"; then + echo $ac_n "(cached) $ac_c" 1>&6 +else + cat > conftest.$ac_ext < +#include +#include +#include +EOF +ac_try="$ac_cpp conftest.$ac_ext >/dev/null 2>conftest.out" +{ (eval echo configure:863: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; } +ac_err=`grep -v '^ *+' conftest.out` +if test -z "$ac_err"; then + rm -rf conftest* + ac_cv_header_stdc=yes +else + echo "$ac_err" >&5 + echo "configure: failed program was:" >&5 + cat conftest.$ac_ext >&5 + rm -rf conftest* + ac_cv_header_stdc=no +fi +rm -f conftest* + +if test $ac_cv_header_stdc = yes; then + # SunOS 4.x string.h does not declare mem*, contrary to ANSI. +cat > conftest.$ac_ext < +EOF +if (eval "$ac_cpp conftest.$ac_ext") 2>&5 | + egrep "memchr" >/dev/null 2>&1; then + : +else + rm -rf conftest* + ac_cv_header_stdc=no +fi +rm -f conftest* + +fi + +if test $ac_cv_header_stdc = yes; then + # ISC 2.0.2 stdlib.h does not declare free, contrary to ANSI. +cat > conftest.$ac_ext < +EOF +if (eval "$ac_cpp conftest.$ac_ext") 2>&5 | + egrep "free" >/dev/null 2>&1; then + : +else + rm -rf conftest* + ac_cv_header_stdc=no +fi +rm -f conftest* + +fi + +if test $ac_cv_header_stdc = yes; then + # /bin/cc in Irix-4.0.5 gets non-ANSI ctype macros unless using -ansi. +if test "$cross_compiling" = yes; then + : +else + cat > conftest.$ac_ext < +#define ISLOWER(c) ('a' <= (c) && (c) <= 'z') +#define TOUPPER(c) (ISLOWER(c) ? 'A' + ((c) - 'a') : (c)) +#define XOR(e, f) (((e) && !(f)) || (!(e) && (f))) +int main () { int i; for (i = 0; i < 256; i++) +if (XOR (islower (i), ISLOWER (i)) || toupper (i) != TOUPPER (i)) exit(2); +exit (0); } + +EOF +if { (eval echo configure:930: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest && (./conftest; exit) 2>/dev/null +then + : +else + echo "configure: failed program was:" >&5 + cat conftest.$ac_ext >&5 + rm -fr conftest* + ac_cv_header_stdc=no +fi +rm -fr conftest* +fi + +fi +fi + +echo "$ac_t""$ac_cv_header_stdc" 1>&6 +if test $ac_cv_header_stdc = yes; then + cat >> confdefs.h <<\EOF +#define STDC_HEADERS 1 +EOF + +fi + + +echo $ac_n "checking whether time.h and sys/time.h may both be included""... $ac_c" 1>&6 +echo "configure:955: checking whether time.h and sys/time.h may both be included" >&5 +if eval "test \"`echo '$''{'ac_cv_header_time'+set}'`\" = set"; then + echo $ac_n "(cached) $ac_c" 1>&6 +else + cat > conftest.$ac_ext < +#include +#include +int main() { +struct tm *tp; +; return 0; } +EOF +if { (eval echo configure:969: \"$ac_compile\") 1>&5; (eval $ac_compile) 2>&5; }; then + rm -rf conftest* + ac_cv_header_time=yes +else + echo "configure: failed program was:" >&5 + cat conftest.$ac_ext >&5 + rm -rf conftest* + ac_cv_header_time=no +fi +rm -f conftest* +fi + +echo "$ac_t""$ac_cv_header_time" 1>&6 +if test $ac_cv_header_time = yes; then + cat >> confdefs.h <<\EOF +#define TIME_WITH_SYS_TIME 1 +EOF + +fi + +for ac_hdr in limits.h unistd.h sys/time.h string.h stdlib.h \ + sys/param.h sys/times.h +do +ac_safe=`echo "$ac_hdr" | sed 'y%./+-%__p_%'` +echo $ac_n "checking for $ac_hdr""... $ac_c" 1>&6 +echo "configure:994: checking for $ac_hdr" >&5 +if eval "test \"`echo '$''{'ac_cv_header_$ac_safe'+set}'`\" = set"; then + echo $ac_n "(cached) $ac_c" 1>&6 +else + cat > conftest.$ac_ext < +EOF +ac_try="$ac_cpp conftest.$ac_ext >/dev/null 2>conftest.out" +{ (eval echo configure:1004: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; } +ac_err=`grep -v '^ *+' conftest.out` +if test -z "$ac_err"; then + rm -rf conftest* + eval "ac_cv_header_$ac_safe=yes" +else + echo "$ac_err" >&5 + echo "configure: failed program was:" >&5 + cat conftest.$ac_ext >&5 + rm -rf conftest* + eval "ac_cv_header_$ac_safe=no" +fi +rm -f conftest* +fi +if eval "test \"`echo '$ac_cv_header_'$ac_safe`\" = yes"; then + echo "$ac_t""yes" 1>&6 + ac_tr_hdr=HAVE_`echo $ac_hdr | sed 'y%abcdefghijklmnopqrstuvwxyz./-%ABCDEFGHIJKLMNOPQRSTUVWXYZ___%'` + cat >> confdefs.h <&6 +fi +done + + +echo $ac_n "checking for working const""... $ac_c" 1>&6 +echo "configure:1032: checking for working const" >&5 +if eval "test \"`echo '$''{'ac_cv_c_const'+set}'`\" = set"; then + echo $ac_n "(cached) $ac_c" 1>&6 +else + cat > conftest.$ac_ext <j = 5; +} +{ /* ULTRIX-32 V3.1 (Rev 9) vcc rejects this */ + const int foo = 10; +} + +; return 0; } +EOF +if { (eval echo configure:1086: \"$ac_compile\") 1>&5; (eval $ac_compile) 2>&5; }; then + rm -rf conftest* + ac_cv_c_const=yes +else + echo "configure: failed program was:" >&5 + cat conftest.$ac_ext >&5 + rm -rf conftest* + ac_cv_c_const=no +fi +rm -f conftest* +fi + +echo "$ac_t""$ac_cv_c_const" 1>&6 +if test $ac_cv_c_const = no; then + cat >> confdefs.h <<\EOF +#define const +EOF + +fi + +echo $ac_n "checking for size_t""... $ac_c" 1>&6 +echo "configure:1107: checking for size_t" >&5 +if eval "test \"`echo '$''{'ac_cv_type_size_t'+set}'`\" = set"; then + echo $ac_n "(cached) $ac_c" 1>&6 +else + cat > conftest.$ac_ext < +#if STDC_HEADERS +#include +#include +#endif +EOF +if (eval "$ac_cpp conftest.$ac_ext") 2>&5 | + egrep "size_t[^a-zA-Z_0-9]" >/dev/null 2>&1; then + rm -rf conftest* + ac_cv_type_size_t=yes +else + rm -rf conftest* + ac_cv_type_size_t=no +fi +rm -f conftest* + +fi +echo "$ac_t""$ac_cv_type_size_t" 1>&6 +if test $ac_cv_type_size_t = no; then + cat >> confdefs.h <<\EOF +#define size_t unsigned +EOF + +fi + +echo $ac_n "checking for mode_t""... $ac_c" 1>&6 +echo "configure:1140: checking for mode_t" >&5 +if eval "test \"`echo '$''{'ac_cv_type_mode_t'+set}'`\" = set"; then + echo $ac_n "(cached) $ac_c" 1>&6 +else + cat > conftest.$ac_ext < +#if STDC_HEADERS +#include +#include +#endif +EOF +if (eval "$ac_cpp conftest.$ac_ext") 2>&5 | + egrep "mode_t[^a-zA-Z_0-9]" >/dev/null 2>&1; then + rm -rf conftest* + ac_cv_type_mode_t=yes +else + rm -rf conftest* + ac_cv_type_mode_t=no +fi +rm -f conftest* + +fi +echo "$ac_t""$ac_cv_type_mode_t" 1>&6 +if test $ac_cv_type_mode_t = no; then + cat >> confdefs.h <<\EOF +#define mode_t int +EOF + +fi + + +echo $ac_n "checking for pid_t""... $ac_c" 1>&6 +echo "configure:1174: checking for pid_t" >&5 +if eval "test \"`echo '$''{'ac_cv_type_pid_t'+set}'`\" = set"; then + echo $ac_n "(cached) $ac_c" 1>&6 +else + cat > conftest.$ac_ext < +#if STDC_HEADERS +#include +#include +#endif +EOF +if (eval "$ac_cpp conftest.$ac_ext") 2>&5 | + egrep "pid_t[^a-zA-Z_0-9]" >/dev/null 2>&1; then + rm -rf conftest* + ac_cv_type_pid_t=yes +else + rm -rf conftest* + ac_cv_type_pid_t=no +fi +rm -f conftest* + +fi +echo "$ac_t""$ac_cv_type_pid_t" 1>&6 +if test $ac_cv_type_pid_t = no; then + cat >> confdefs.h <<\EOF +#define pid_t int +EOF + +fi + +echo $ac_n "checking for st_blksize in struct stat""... $ac_c" 1>&6 +echo "configure:1207: checking for st_blksize in struct stat" >&5 +if eval "test \"`echo '$''{'ac_cv_struct_st_blksize'+set}'`\" = set"; then + echo $ac_n "(cached) $ac_c" 1>&6 +else + cat > conftest.$ac_ext < +#include +int main() { +struct stat s; s.st_blksize; +; return 0; } +EOF +if { (eval echo configure:1220: \"$ac_compile\") 1>&5; (eval $ac_compile) 2>&5; }; then + rm -rf conftest* + ac_cv_struct_st_blksize=yes +else + echo "configure: failed program was:" >&5 + cat conftest.$ac_ext >&5 + rm -rf conftest* + ac_cv_struct_st_blksize=no +fi +rm -f conftest* +fi + +echo "$ac_t""$ac_cv_struct_st_blksize" 1>&6 +if test $ac_cv_struct_st_blksize = yes; then + cat >> confdefs.h <<\EOF +#define HAVE_ST_BLKSIZE 1 +EOF + +fi + +echo $ac_n "checking for st_blocks in struct stat""... $ac_c" 1>&6 +echo "configure:1241: checking for st_blocks in struct stat" >&5 +if eval "test \"`echo '$''{'ac_cv_struct_st_blocks'+set}'`\" = set"; then + echo $ac_n "(cached) $ac_c" 1>&6 +else + cat > conftest.$ac_ext < +#include +int main() { +struct stat s; s.st_blocks; +; return 0; } +EOF +if { (eval echo configure:1254: \"$ac_compile\") 1>&5; (eval $ac_compile) 2>&5; }; then + rm -rf conftest* + ac_cv_struct_st_blocks=yes +else + echo "configure: failed program was:" >&5 + cat conftest.$ac_ext >&5 + rm -rf conftest* + ac_cv_struct_st_blocks=no +fi +rm -f conftest* +fi + +echo "$ac_t""$ac_cv_struct_st_blocks" 1>&6 +if test $ac_cv_struct_st_blocks = yes; then + cat >> confdefs.h <<\EOF +#define HAVE_ST_BLOCKS 1 +EOF + +else + LIBOBJS="$LIBOBJS fileblocks.o" +fi + +echo $ac_n "checking for st_rdev in struct stat""... $ac_c" 1>&6 +echo "configure:1277: checking for st_rdev in struct stat" >&5 +if eval "test \"`echo '$''{'ac_cv_struct_st_rdev'+set}'`\" = set"; then + echo $ac_n "(cached) $ac_c" 1>&6 +else + cat > conftest.$ac_ext < +#include +int main() { +struct stat s; s.st_rdev; +; return 0; } +EOF +if { (eval echo configure:1290: \"$ac_compile\") 1>&5; (eval $ac_compile) 2>&5; }; then + rm -rf conftest* + ac_cv_struct_st_rdev=yes +else + echo "configure: failed program was:" >&5 + cat conftest.$ac_ext >&5 + rm -rf conftest* + ac_cv_struct_st_rdev=no +fi +rm -f conftest* +fi + +echo "$ac_t""$ac_cv_struct_st_rdev" 1>&6 +if test $ac_cv_struct_st_rdev = yes; then + cat >> confdefs.h <<\EOF +#define HAVE_ST_RDEV 1 +EOF + +fi + +echo $ac_n "checking whether struct tm is in sys/time.h or time.h""... $ac_c" 1>&6 +echo "configure:1311: checking whether struct tm is in sys/time.h or time.h" >&5 +if eval "test \"`echo '$''{'ac_cv_struct_tm'+set}'`\" = set"; then + echo $ac_n "(cached) $ac_c" 1>&6 +else + cat > conftest.$ac_ext < +#include +int main() { +struct tm *tp; tp->tm_sec; +; return 0; } +EOF +if { (eval echo configure:1324: \"$ac_compile\") 1>&5; (eval $ac_compile) 2>&5; }; then + rm -rf conftest* + ac_cv_struct_tm=time.h +else + echo "configure: failed program was:" >&5 + cat conftest.$ac_ext >&5 + rm -rf conftest* + ac_cv_struct_tm=sys/time.h +fi +rm -f conftest* +fi + +echo "$ac_t""$ac_cv_struct_tm" 1>&6 +if test $ac_cv_struct_tm = sys/time.h; then + cat >> confdefs.h <<\EOF +#define TM_IN_SYS_TIME 1 +EOF + +fi + + + +for ac_func in symlink getcwd getwd lstat gethostname strerror clock \ + getrusage times alarm +do +echo $ac_n "checking for $ac_func""... $ac_c" 1>&6 +echo "configure:1350: checking for $ac_func" >&5 +if eval "test \"`echo '$''{'ac_cv_func_$ac_func'+set}'`\" = set"; then + echo $ac_n "(cached) $ac_c" 1>&6 +else + cat > conftest.$ac_ext < +/* Override any gcc2 internal prototype to avoid an error. */ +/* We use char because int might match the return type of a gcc2 + builtin and then its argument prototype would still apply. */ +char $ac_func(); + +int main() { + +/* The GNU C library defines this for functions which it implements + to always fail with ENOSYS. Some functions are actually named + something starting with __ and the normal name is an alias. */ +#if defined (__stub_$ac_func) || defined (__stub___$ac_func) +choke me +#else +$ac_func(); +#endif + +; return 0; } +EOF +if { (eval echo configure:1378: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest; then + rm -rf conftest* + eval "ac_cv_func_$ac_func=yes" +else + echo "configure: failed program was:" >&5 + cat conftest.$ac_ext >&5 + rm -rf conftest* + eval "ac_cv_func_$ac_func=no" +fi +rm -f conftest* +fi + +if eval "test \"`echo '$ac_cv_func_'$ac_func`\" = yes"; then + echo "$ac_t""yes" 1>&6 + ac_tr_func=HAVE_`echo $ac_func | tr 'abcdefghijklmnopqrstuvwxyz' 'ABCDEFGHIJKLMNOPQRSTUVWXYZ'` + cat >> confdefs.h <&6 +fi +done + +test $ac_cv_func_symlink = yes && MAYBES="$MAYBES symlnk_.o" +test $ac_cv_func_lstat = yes && MAYBES="$MAYBES lstat_.o" +test $ac_cv_func_gethostname = yes && MAYBES="$MAYBES hostnm_.o" +test $ac_cv_func_clock = yes && MAYBES="$MAYBES mclock_.o" + + + + + + + +trap '' 1 2 15 +cat > confcache <<\EOF +# This file is a shell script that caches the results of configure +# tests run on this system so they can be shared between configure +# scripts and configure runs. It is not useful on other systems. +# If it contains results you don't want to keep, you may remove or edit it. +# +# By default, configure uses ./config.cache as the cache file, +# creating it if it does not exist already. You can give configure +# the --cache-file=FILE option to use a different cache file; that is +# what configure does when it calls configure scripts in +# subdirectories, so they share the cache. +# Giving --cache-file=/dev/null disables caching, for debugging configure. +# config.status only pays attention to the cache file if you give it the +# --recheck option to rerun configure. +# +EOF +# The following way of writing the cache mishandles newlines in values, +# but we know of no workaround that is simple, portable, and efficient. +# So, don't put newlines in cache variables' values. +# Ultrix sh set writes to stderr and can't be redirected directly, +# and sets the high bit in the cache file unless we assign to the vars. +(set) 2>&1 | + case `(ac_space=' '; set) 2>&1 | grep ac_space` in + *ac_space=\ *) + # `set' does not quote correctly, so add quotes (double-quote substitution + # turns \\\\ into \\, and sed turns \\ into \). + sed -n \ + -e "s/'/'\\\\''/g" \ + -e "s/^\\([a-zA-Z0-9_]*_cv_[a-zA-Z0-9_]*\\)=\\(.*\\)/\\1=\${\\1='\\2'}/p" + ;; + *) + # `set' quotes correctly as required by POSIX, so do not add quotes. + sed -n -e 's/^\([a-zA-Z0-9_]*_cv_[a-zA-Z0-9_]*\)=\(.*\)/\1=${\1=\2}/p' + ;; + esac >> confcache +if cmp -s $cache_file confcache; then + : +else + if test -w $cache_file; then + echo "updating cache $cache_file" + cat confcache > $cache_file + else + echo "not updating unwritable cache $cache_file" + fi +fi +rm -f confcache + +trap 'rm -fr conftest* confdefs* core core.* *.core $ac_clean_files; exit 1' 1 2 15 + +test "x$prefix" = xNONE && prefix=$ac_default_prefix +# Let make expand exec_prefix. +test "x$exec_prefix" = xNONE && exec_prefix='${prefix}' + +# Any assignment to VPATH causes Sun make to only execute +# the first set of double-colon rules, so remove it if not needed. +# If there is a colon in the path, we need to keep it. +if test "x$srcdir" = x.; then + ac_vpsub='/^[ ]*VPATH[ ]*=[^:]*$/d' +fi + +trap 'rm -f $CONFIG_STATUS conftest*; exit 1' 1 2 15 + +DEFS=-DHAVE_CONFIG_H + +# Without the "./", some shells look in PATH for config.status. +: ${CONFIG_STATUS=./config.status} + +echo creating $CONFIG_STATUS +rm -f $CONFIG_STATUS +cat > $CONFIG_STATUS </dev/null | sed 1q`: +# +# $0 $ac_configure_args +# +# Compiler output produced by configure, useful for debugging +# configure, is in ./config.log if it exists. + +ac_cs_usage="Usage: $CONFIG_STATUS [--recheck] [--version] [--help]" +for ac_option +do + case "\$ac_option" in + -recheck | --recheck | --rechec | --reche | --rech | --rec | --re | --r) + echo "running \${CONFIG_SHELL-/bin/sh} $0 $ac_configure_args --no-create --no-recursion" + exec \${CONFIG_SHELL-/bin/sh} $0 $ac_configure_args --no-create --no-recursion ;; + -version | --version | --versio | --versi | --vers | --ver | --ve | --v) + echo "$CONFIG_STATUS generated by autoconf version 2.12.1" + exit 0 ;; + -help | --help | --hel | --he | --h) + echo "\$ac_cs_usage"; exit 0 ;; + *) echo "\$ac_cs_usage"; exit 1 ;; + esac +done + +ac_given_srcdir=$srcdir + +trap 'rm -fr `echo "Makefile config.h" | sed "s/:[^ ]*//g"` conftest*; exit 1' 1 2 15 +EOF +cat >> $CONFIG_STATUS < conftest.subs <<\\CEOF +$ac_vpsub +$extrasub +s%@SHELL@%$SHELL%g +s%@CFLAGS@%$CFLAGS%g +s%@CPPFLAGS@%$CPPFLAGS%g +s%@CXXFLAGS@%$CXXFLAGS%g +s%@DEFS@%$DEFS%g +s%@LDFLAGS@%$LDFLAGS%g +s%@LIBS@%$LIBS%g +s%@exec_prefix@%$exec_prefix%g +s%@prefix@%$prefix%g +s%@program_transform_name@%$program_transform_name%g +s%@bindir@%$bindir%g +s%@sbindir@%$sbindir%g +s%@libexecdir@%$libexecdir%g +s%@datadir@%$datadir%g +s%@sysconfdir@%$sysconfdir%g +s%@sharedstatedir@%$sharedstatedir%g +s%@localstatedir@%$localstatedir%g +s%@libdir@%$libdir%g +s%@includedir@%$includedir%g +s%@oldincludedir@%$oldincludedir%g +s%@infodir@%$infodir%g +s%@mandir@%$mandir%g +s%@CC@%$CC%g +s%@ac_cv_prog_chmod@%$ac_cv_prog_chmod%g +s%@RANLIB@%$RANLIB%g +s%@AR@%$AR%g +s%@CPP@%$CPP%g +s%@LIBOBJS@%$LIBOBJS%g +s%@MAYBES@%$MAYBES%g +s%@CROSS@%$CROSS%g +s%@RANLIB_TEST@%$RANLIB_TEST%g + +CEOF +EOF + +cat >> $CONFIG_STATUS <<\EOF + +# Split the substitutions into bite-sized pieces for seds with +# small command number limits, like on Digital OSF/1 and HP-UX. +ac_max_sed_cmds=90 # Maximum number of lines to put in a sed script. +ac_file=1 # Number of current file. +ac_beg=1 # First line for current file. +ac_end=$ac_max_sed_cmds # Line after last line for current file. +ac_more_lines=: +ac_sed_cmds="" +while $ac_more_lines; do + if test $ac_beg -gt 1; then + sed "1,${ac_beg}d; ${ac_end}q" conftest.subs > conftest.s$ac_file + else + sed "${ac_end}q" conftest.subs > conftest.s$ac_file + fi + if test ! -s conftest.s$ac_file; then + ac_more_lines=false + rm -f conftest.s$ac_file + else + if test -z "$ac_sed_cmds"; then + ac_sed_cmds="sed -f conftest.s$ac_file" + else + ac_sed_cmds="$ac_sed_cmds | sed -f conftest.s$ac_file" + fi + ac_file=`expr $ac_file + 1` + ac_beg=$ac_end + ac_end=`expr $ac_end + $ac_max_sed_cmds` + fi +done +if test -z "$ac_sed_cmds"; then + ac_sed_cmds=cat +fi +EOF + +cat >> $CONFIG_STATUS <> $CONFIG_STATUS <<\EOF +for ac_file in .. $CONFIG_FILES; do if test "x$ac_file" != x..; then + # Support "outfile[:infile[:infile...]]", defaulting infile="outfile.in". + case "$ac_file" in + *:*) ac_file_in=`echo "$ac_file"|sed 's%[^:]*:%%'` + ac_file=`echo "$ac_file"|sed 's%:.*%%'` ;; + *) ac_file_in="${ac_file}.in" ;; + esac + + # Adjust a relative srcdir, top_srcdir, and INSTALL for subdirectories. + + # Remove last slash and all that follows it. Not all systems have dirname. + ac_dir=`echo $ac_file|sed 's%/[^/][^/]*$%%'` + if test "$ac_dir" != "$ac_file" && test "$ac_dir" != .; then + # The file is in a subdirectory. + test ! -d "$ac_dir" && mkdir "$ac_dir" + ac_dir_suffix="/`echo $ac_dir|sed 's%^\./%%'`" + # A "../" for each directory in $ac_dir_suffix. + ac_dots=`echo $ac_dir_suffix|sed 's%/[^/]*%../%g'` + else + ac_dir_suffix= ac_dots= + fi + + case "$ac_given_srcdir" in + .) srcdir=. + if test -z "$ac_dots"; then top_srcdir=. + else top_srcdir=`echo $ac_dots|sed 's%/$%%'`; fi ;; + /*) srcdir="$ac_given_srcdir$ac_dir_suffix"; top_srcdir="$ac_given_srcdir" ;; + *) # Relative path. + srcdir="$ac_dots$ac_given_srcdir$ac_dir_suffix" + top_srcdir="$ac_dots$ac_given_srcdir" ;; + esac + + + echo creating "$ac_file" + rm -f "$ac_file" + configure_input="Generated automatically from `echo $ac_file_in|sed 's%.*/%%'` by configure." + case "$ac_file" in + *Makefile*) ac_comsub="1i\\ +# $configure_input" ;; + *) ac_comsub= ;; + esac + + ac_file_inputs=`echo $ac_file_in|sed -e "s%^%$ac_given_srcdir/%" -e "s%:% $ac_given_srcdir/%g"` + sed -e "$ac_comsub +s%@configure_input@%$configure_input%g +s%@srcdir@%$srcdir%g +s%@top_srcdir@%$top_srcdir%g +" $ac_file_inputs | (eval "$ac_sed_cmds") > $ac_file +fi; done +rm -f conftest.s* + +# These sed commands are passed to sed as "A NAME B NAME C VALUE D", where +# NAME is the cpp macro being defined and VALUE is the value it is being given. +# +# ac_d sets the value in "#define NAME VALUE" lines. +ac_dA='s%^\([ ]*\)#\([ ]*define[ ][ ]*\)' +ac_dB='\([ ][ ]*\)[^ ]*%\1#\2' +ac_dC='\3' +ac_dD='%g' +# ac_u turns "#undef NAME" with trailing blanks into "#define NAME VALUE". +ac_uA='s%^\([ ]*\)#\([ ]*\)undef\([ ][ ]*\)' +ac_uB='\([ ]\)%\1#\2define\3' +ac_uC=' ' +ac_uD='\4%g' +# ac_e turns "#undef NAME" without trailing blanks into "#define NAME VALUE". +ac_eA='s%^\([ ]*\)#\([ ]*\)undef\([ ][ ]*\)' +ac_eB='$%\1#\2define\3' +ac_eC=' ' +ac_eD='%g' + +if test "${CONFIG_HEADERS+set}" != set; then +EOF +cat >> $CONFIG_STATUS <> $CONFIG_STATUS <<\EOF +fi +for ac_file in .. $CONFIG_HEADERS; do if test "x$ac_file" != x..; then + # Support "outfile[:infile[:infile...]]", defaulting infile="outfile.in". + case "$ac_file" in + *:*) ac_file_in=`echo "$ac_file"|sed 's%[^:]*:%%'` + ac_file=`echo "$ac_file"|sed 's%:.*%%'` ;; + *) ac_file_in="${ac_file}.in" ;; + esac + + echo creating $ac_file + + rm -f conftest.frag conftest.in conftest.out + ac_file_inputs=`echo $ac_file_in|sed -e "s%^%$ac_given_srcdir/%" -e "s%:% $ac_given_srcdir/%g"` + cat $ac_file_inputs > conftest.in + +EOF + +# Transform confdefs.h into a sed script conftest.vals that substitutes +# the proper values into config.h.in to produce config.h. And first: +# Protect against being on the right side of a sed subst in config.status. +# Protect against being in an unquoted here document in config.status. +rm -f conftest.vals +cat > conftest.hdr <<\EOF +s/[\\&%]/\\&/g +s%[\\$`]%\\&%g +s%#define \([A-Za-z_][A-Za-z0-9_]*\) *\(.*\)%${ac_dA}\1${ac_dB}\1${ac_dC}\2${ac_dD}%gp +s%ac_d%ac_u%gp +s%ac_u%ac_e%gp +EOF +sed -n -f conftest.hdr confdefs.h > conftest.vals +rm -f conftest.hdr + +# This sed command replaces #undef with comments. This is necessary, for +# example, in the case of _POSIX_SOURCE, which is predefined and required +# on some systems where configure will not decide to define it. +cat >> conftest.vals <<\EOF +s%^[ ]*#[ ]*undef[ ][ ]*[a-zA-Z_][a-zA-Z_0-9]*%/* & */% +EOF + +# Break up conftest.vals because some shells have a limit on +# the size of here documents, and old seds have small limits too. + +rm -f conftest.tail +while : +do + ac_lines=`grep -c . conftest.vals` + # grep -c gives empty output for an empty file on some AIX systems. + if test -z "$ac_lines" || test "$ac_lines" -eq 0; then break; fi + # Write a limited-size here document to conftest.frag. + echo ' cat > conftest.frag <> $CONFIG_STATUS + sed ${ac_max_here_lines}q conftest.vals >> $CONFIG_STATUS + echo 'CEOF + sed -f conftest.frag conftest.in > conftest.out + rm -f conftest.in + mv conftest.out conftest.in +' >> $CONFIG_STATUS + sed 1,${ac_max_here_lines}d conftest.vals > conftest.tail + rm -f conftest.vals + mv conftest.tail conftest.vals +done +rm -f conftest.vals + +cat >> $CONFIG_STATUS <<\EOF + rm -f conftest.frag conftest.h + echo "/* $ac_file. Generated automatically by configure. */" > conftest.h + cat conftest.in >> conftest.h + rm -f conftest.in + if cmp -s $ac_file conftest.h 2>/dev/null; then + echo "$ac_file is unchanged" + rm -f conftest.h + else + # Remove last slash and all that follows it. Not all systems have dirname. + ac_dir=`echo $ac_file|sed 's%/[^/][^/]*$%%'` + if test "$ac_dir" != "$ac_file" && test "$ac_dir" != .; then + # The file is in a subdirectory. + test ! -d "$ac_dir" && mkdir "$ac_dir" + fi + rm -f $ac_file + mv conftest.h $ac_file + fi +fi; done + +EOF +cat >> $CONFIG_STATUS <> $CONFIG_STATUS <<\EOF + +exit 0 +EOF +chmod +x $CONFIG_STATUS +rm -fr confdefs* $ac_clean_files +test "$no_create" = yes || ${CONFIG_SHELL-/bin/sh} $CONFIG_STATUS || exit 1 + diff --git a/libf2c/libU77/configure.in b/libf2c/libU77/configure.in new file mode 100644 index 00000000000..6caf4e31a39 --- /dev/null +++ b/libf2c/libU77/configure.in @@ -0,0 +1,113 @@ +# Process this file with autoconf to produce a configure script. +# Copyright (C) 1995 Free Software Foundation, Inc. +# Contributed by Dave Love (d.love@dl.ac.uk). +# +#This file is part of the GNU Fortran libU77 library. +# +#This library is free software; you can redistribute it and/or modify +#it under the terms of the GNU General Public License as published by +#the Free Software Foundation; either version 2, or (at your option) +#any later version. +# +#GNU Fortran is distributed in the hope that it will be useful, +#but WITHOUT ANY WARRANTY; without even the implied warranty of +#MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +#GNU Library General Public License for more details. +# +#You should have received a copy of the GNU Library General Public +#License along with GNU Fortran; see the file COPYING. If not, write +#to Software Foundation, 59 Temple Place - Suite 330, Boston, MA 02111-1307, +#USA. + +AC_INIT(access_.c) +AC_CONFIG_HEADER(config.h) + +dnl Checks for programs. +# For g77 we'll set CC to point at the built gcc, but this will get it into +# the makefiles +AC_PROG_CC +dnl AC_C_CROSS +dnl Gives misleading `(cached)' message from the check. +if test "$CROSS";then + ac_cv_c_cross=yes +else + ac_cv_c_cross=no +fi + +dnl This is only because we (horribly) punt the chmod job to the program at +dnl present. Note that the result of this test could be wrong in the cross +dnl case. +AC_PATH_PROG(ac_cv_prog_chmod, chmod, no) +if test "$ac_cv_prog_chmod" != no || test "$CROSS"; then + MAYBES=chmod_.o + AC_DEFINE_UNQUOTED(CHMOD_PATH,"$ac_cv_prog_chmod") +else + MAYBES="" +fi + +dnl for g77 build maybe use $(RANLIB_FOR_TARGET) always (like wise AR) +if test "$ac_cv_c_cross" = yes; then + RANLIB=$RANLIB_FOR_TARGET + AR=$AR_FOR_TARGET + AC_SUBST(RANLIB) +else + AC_PROG_RANLIB + AR=ar + RANLIB_TEST=true +fi +AC_SUBST(AR) +dnl not needed for g77 +dnl AC_SUBST(AR_FOR_TARGET) +dnl AC_SUBST(RANLIB_FOR_TARGET) +dnl AC_SUBST(RANLIB_TEST_FOR_TARGET) +dnl not needed for g77? +dnl AC_PROG_MAKE_SET + +dnl Checks for libraries. + +dnl Checks for header files. +AC_HEADER_STDC +dnl We could do this if we didn't know we were using gcc +dnl AC_MSG_CHECKING(for prototype-savvy compiler) +dnl AC_CACHE_VAL(ac_cv_sys_proto, +dnl [AC_TRY_LINK(, +dnl dnl looks screwy because TRY_LINK expects a function body +dnl [return 0;} int foo (int * bar) {], +dnl ac_cv_sys_proto=yes, +dnl [ac_cv_sys_proto=no +dnl AC_DEFINE(KR_headers)])]) +dnl AC_MSG_RESULT($ac_cv_sys_proto) + +AC_HEADER_TIME +AC_CHECK_HEADERS(limits.h unistd.h sys/time.h string.h stdlib.h \ + sys/param.h sys/times.h) + +dnl Checks for typedefs, structures, and compiler characteristics. +AC_C_CONST +AC_TYPE_SIZE_T +AC_TYPE_MODE_T + +AC_TYPE_PID_T +dnl The next 3 demand a dummy fileblocks.o (added to LIBOJS). We don't use +dnl LIBOJS, though. +AC_STRUCT_ST_BLKSIZE +AC_STRUCT_ST_BLOCKS +AC_STRUCT_ST_RDEV +AC_STRUCT_TM + +dnl Checks for library functions. + +AC_CHECK_FUNCS(symlink getcwd getwd lstat gethostname strerror clock \ + getrusage times alarm getlogin getgid getuid kill link ttyname) +test $ac_cv_func_symlink = yes && MAYBES="$MAYBES symlnk_.o" +test $ac_cv_func_lstat = yes && MAYBES="$MAYBES lstat_.o" +test $ac_cv_func_gethostname = yes && MAYBES="$MAYBES hostnm_.o" +test $ac_cv_func_clock = yes && MAYBES="$MAYBES mclock_.o" +AC_SUBST(MAYBES) + + +AC_SUBST(CROSS) +AC_SUBST(RANLIB) +AC_SUBST(RANLIB_TEST) + +AC_OUTPUT(Makefile) diff --git a/libf2c/libU77/ctime_.c b/libf2c/libU77/ctime_.c new file mode 100644 index 00000000000..af5813772af --- /dev/null +++ b/libf2c/libU77/ctime_.c @@ -0,0 +1,57 @@ +/* Copyright (C) 1995, 1996 Free Software Foundation, Inc. +This file is part of GNU Fortran libU77 library. + +This library is free software; you can redistribute it and/or modify it +under the terms of the GNU Library General Public License as published +by the Free Software Foundation; either version 2 of the License, or +(at your option) any later version. + +GNU Fortran is distributed in the hope that it will be useful, +but WITHOUT ANY WARRANTY; without even the implied warranty of +MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +Library General Public License for more details. + +You should have received a copy of the GNU Library General Public +License along with GNU Fortran; see the file COPYING.LIB. If +not, write to the Free Software Foundation, Inc., 59 Temple Place - Suite 330, +Boston, MA 02111-1307, USA. */ + +#ifdef HAVE_CONFIG_H +#include "config.h" +#endif +#if TIME_WITH_SYS_TIME +# include +# include +#else +# if HAVE_SYS_TIME_H +# include +# else +# include +# endif +#endif +#if HAVE_STRING_H +# include +#else +# include +#endif +#include "f2c.h" + +/* may need sys/time.h & long arg for stime (bsd, svr1-3) */ + +#ifdef KR_headers +/* Character */ void G77_ctime_0 (chtime, Lchtime, xstime) + char *chtime; + longint * xstime; + ftnlen Lchtime; +#else +/* Character */ void G77_ctime_0 (char *chtime, const ftnlen Lchtime, longint * xstime) +#endif +{ + int i, l; + int s_copy (); + time_t stime = *xstime; + + /* Allow a length other than 24 for compatibility with what other + systems do, despite it being documented as 24. */ + s_copy (chtime, ctime (&stime), Lchtime, 24); +} diff --git a/libf2c/libU77/date_.c b/libf2c/libU77/date_.c new file mode 100644 index 00000000000..8426edc4fb0 --- /dev/null +++ b/libf2c/libU77/date_.c @@ -0,0 +1,39 @@ +/* date_.f -- translated by f2c (version 19961001). + You must link the resulting object file with the libraries: + -lf2c -lm (in that order) +*/ + +#include "f2c.h" + +/* Table of constant values */ + +static integer c__5 = 5; + +/* Subroutine */ int G77_date_0 (char *buf, ftnlen buf_len) +{ + /* System generated locals */ + address a__1[5]; + integer i__1, i__2[5]; + char ch__1[24]; + + /* Builtin functions */ + /* Subroutine */ int s_copy(), s_cat(); + + /* Local variables */ + static char cbuf[24]; + extern integer G77_time_0 (); + extern /* Character */ VOID G77_ctime_0 (); + + i__1 = G77_time_0 (); + G77_ctime_0 (ch__1, 24L, &i__1); + s_copy(cbuf, ch__1, 24L, 24L); +/* Writing concatenation */ + i__2[0] = 2, a__1[0] = cbuf + 8; + i__2[1] = 1, a__1[1] = "-"; + i__2[2] = 3, a__1[2] = cbuf + 4; + i__2[3] = 1, a__1[3] = "-"; + i__2[4] = 2, a__1[4] = cbuf + 22; + s_cat(buf, a__1, i__2, &c__5, buf_len); + return 0; +} /* date_ */ + diff --git a/libf2c/libU77/dbes.c b/libf2c/libU77/dbes.c new file mode 100644 index 00000000000..8c245cf3c25 --- /dev/null +++ b/libf2c/libU77/dbes.c @@ -0,0 +1,46 @@ +/* Copyright (C) 1995, 1996 Free Software Foundation, Inc. +This file is part of GNU Fortran libU77 library. + +This library is free software; you can redistribute it and/or modify it +under the terms of the GNU Library General Public License as published +by the Free Software Foundation; either version 2 of the License, or +(at your option) any later version. + +GNU Fortran is distributed in the hope that it will be useful, +but WITHOUT ANY WARRANTY; without even the implied warranty of +MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +Library General Public License for more details. + +You should have received a copy of the GNU Library General Public +License along with GNU Fortran; see the file COPYING.LIB. If +not, write to the Free Software Foundation, Inc., 59 Temple Place - Suite 330, +Boston, MA 02111-1307, USA. */ + +#include "f2c.h" +#include + +#if 0 /* Don't include these unless necessary -- dnp. */ +double G77_dbesj0_0 (const double *x) { + return j0 (*x); +} + +double G77_dbesj1_0 (const double *x) { + return j1 (*x); +} + +double G77_dbesjn_0 (const integer *n, double *x) { + return jn (*n, *x); + } + +double G77_dbesy0_0 (const double *x) { + return y0 (*x); +} + +double G77_dbesy1_0 (const double *x) { + return y1 (*x); +} + +double G77_dbesyn_0 (const integer *n, double *x) { + return yn (*n, *x); +} +#endif diff --git a/libf2c/libU77/dtime_.c b/libf2c/libU77/dtime_.c new file mode 100644 index 00000000000..8bcfde8cb39 --- /dev/null +++ b/libf2c/libU77/dtime_.c @@ -0,0 +1,98 @@ +/* Copyright (C) 1995, 1996 Free Software Foundation, Inc. +This file is part of GNU Fortran libU77 library. + +This library is free software; you can redistribute it and/or modify it +under the terms of the GNU Library General Public License as published +by the Free Software Foundation; either version 2 of the License, or +(at your option) any later version. + +GNU Fortran is distributed in the hope that it will be useful, +but WITHOUT ANY WARRANTY; without even the implied warranty of +MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +Library General Public License for more details. + +You should have received a copy of the GNU Library General Public +License along with GNU Fortran; see the file COPYING.LIB. If +not, write to the Free Software Foundation, Inc., 59 Temple Place - Suite 330, +Boston, MA 02111-1307, USA. */ + +#ifdef HAVE_CONFIG_H +#include "config.h" +#endif +#if HAVE_UNISTD_H +# include +#endif +#include +#if HAVE_SYS_TIMES_H +# include +#endif +#if HAVE_SYS_PARAM_H +# include +#endif +#if HAVE_GETRUSAGE +# include +# include +#endif +#include /* for ENOSYS */ +#include "f2c.h" + +/* For dtime, etime we store the clock tick parameter (clk_tck) the + first time either of them is invoked rather than each time. This + approach probably speeds up each invocation by avoiding a system + call each time, but means that the overhead of the first call is + different to all others. */ +static long clk_tck = 0; + +#ifdef KR_headers +double G77_dtime_0 (tarray) + real tarray[2]; +#else +double G77_dtime_0 (real tarray[2]) +#endif +{ +#if defined (HAVE_GETRUSAGE) || defined (HAVE_TIMES) + /* The getrusage version is only the default for convenience. */ +#ifdef HAVE_GETRUSAGE + float utime, stime; + static float old_utime = 0.0, old_stime = 0.0; + struct rusage rbuff; + + if (getrusage (RUSAGE_SELF, &rbuff) != 0) + abort (); + utime = (float) (rbuff.ru_utime).tv_sec + + (float) (rbuff.ru_utime).tv_usec/1000000.0; + tarray[0] = utime - (float) old_utime; + stime = (float) (rbuff.ru_stime).tv_sec + + (float) (rbuff.ru_stime).tv_usec/1000000.0; + tarray[1] = stime - old_stime; +#else /* HAVE_GETRUSAGE */ + time_t utime, stime; + static time_t old_utime = 0, old_stime = 0; + struct tms buffer; + +/* NeXTStep seems to define _SC_CLK_TCK but not to have sysconf; + fixme: does using _POSIX_VERSION help? */ +# if defined _SC_CLK_TCK && defined _POSIX_VERSION + if (! clk_tck) clk_tck = sysconf(_SC_CLK_TCK); +# elif defined CLOCKS_PER_SECOND + if (! clk_tck) clk_tck = CLOCKS_PER_SECOND; +# elif defined CLK_TCK + if (! clk_tck) clk_tck = CLK_TCK; +# elif defined HZ + if (! clk_tck) clk_tck = HZ; +# elif defined HAVE_GETRUSAGE +# else + #error Dont know clock tick length +# endif + if (times(&buffer) < 0) return -1.0; + utime = buffer.tms_utime; stime = buffer.tms_stime; + tarray[0] = ((float)(utime - old_utime)) / (float)clk_tck; + tarray[1] = ((float)(stime - old_stime)) / (float)clk_tck; +#endif /* HAVE_GETRUSAGE */ + old_utime = utime; old_stime = stime; + return (tarray[0]+tarray[1]); +#else /* ! HAVE_GETRUSAGE && ! HAVE_TIMES */ + errno = ENOSYS; + return 0.0; +#endif /* ! HAVE_GETRUSAGE && ! HAVE_TIMES */ +} diff --git a/libf2c/libU77/etime_.c b/libf2c/libU77/etime_.c new file mode 100644 index 00000000000..269d964c75b --- /dev/null +++ b/libf2c/libU77/etime_.c @@ -0,0 +1,90 @@ +/* Copyright (C) 1995, 1996 Free Software Foundation, Inc. +This file is part of GNU Fortran libU77 library. + +This library is free software; you can redistribute it and/or modify it +under the terms of the GNU Library General Public License as published +by the Free Software Foundation; either version 2 of the License, or +(at your option) any later version. + +GNU Fortran is distributed in the hope that it will be useful, +but WITHOUT ANY WARRANTY; without even the implied warranty of +MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +Library General Public License for more details. + +You should have received a copy of the GNU Library General Public +License along with GNU Fortran; see the file COPYING.LIB. If +not, write to the Free Software Foundation, Inc., 59 Temple Place - Suite 330, +Boston, MA 02111-1307, USA. */ + +#ifdef HAVE_CONFIG_H +#include "config.h" +#endif +#if HAVE_UNISTD_H +# include +#endif +#include +#if HAVE_SYS_TIMES_H +# include +#endif +#if HAVE_SYS_PARAM_H +# include +#endif +#if HAVE_GETRUSAGE +# include +# include +#endif +#include /* for ENOSYS */ +#include "f2c.h" + +/* For dtime, etime we store the clock tick parameter (clk_tck) the + first time either of them is invoked rather than each time. This + approach probably speeds up each invocation by avoiding a system + call each time, but means that the overhead of the first call is + different to all others. */ +static long clk_tck = 0; + +#ifdef KR_headers +double G77_etime_0 (tarray) + real tarray[2]; +#else +double G77_etime_0 (real tarray[2]) +#endif +{ +#if defined (HAVE_GETRUSAGE) || defined (HAVE_TIMES) + /* The getrusage version is only the default for convenience. */ +#ifdef HAVE_GETRUSAGE + struct rusage rbuff; + + if (getrusage (RUSAGE_SELF, &rbuff) != 0) + abort (); + tarray[0] = ((float) (rbuff.ru_utime).tv_sec + + (float) (rbuff.ru_utime).tv_usec/1000000.0); + tarray[1] = ((float) (rbuff.ru_stime).tv_sec + + (float) (rbuff.ru_stime).tv_usec/1000000.0); +#else /* HAVE_GETRUSAGE */ + struct tms buffer; + +/* NeXTStep seems to define _SC_CLK_TCK but not to have sysconf; + fixme: does using _POSIX_VERSION help? */ +# if defined _SC_CLK_TCK && defined _POSIX_VERSION + if (! clk_tck) clk_tck = sysconf(_SC_CLK_TCK); +# elif defined CLOCKS_PER_SECOND + if (! clk_tck) clk_tck = CLOCKS_PER_SECOND; +# elif defined CLK_TCK + if (! clk_tck) clk_tck = CLK_TCK; +# elif defined HZ + if (! clk_tck) clk_tck = HZ; +# elif defined HAVE_GETRUSAGE +# else + #error Dont know clock tick length +# endif + if (times(&buffer) < 0) return -1.0; + tarray[0] = (float) buffer.tms_utime / (float)clk_tck; + tarray[1] = (float) buffer.tms_stime / (float)clk_tck; +#endif /* HAVE_GETRUSAGE */ + return (tarray[0]+tarray[1]); +#else /* ! HAVE_GETRUSAGE && ! HAVE_TIMES */ + errno = ENOSYS; + return 0.0; +#endif /* ! HAVE_GETRUSAGE && ! HAVE_TIMES */ +} diff --git a/libf2c/libU77/fdate_.c b/libf2c/libU77/fdate_.c new file mode 100644 index 00000000000..afe8b24fc44 --- /dev/null +++ b/libf2c/libU77/fdate_.c @@ -0,0 +1,53 @@ +/* Copyright (C) 1995, 1996 Free Software Foundation, Inc. +This file is part of GNU Fortran libU77 library. + +This library is free software; you can redistribute it and/or modify it +under the terms of the GNU Library General Public License as published +by the Free Software Foundation; either version 2 of the License, or +(at your option) any later version. + +GNU Fortran is distributed in the hope that it will be useful, +but WITHOUT ANY WARRANTY; without even the implied warranty of +MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +Library General Public License for more details. + +You should have received a copy of the GNU Library General Public +License along with GNU Fortran; see the file COPYING.LIB. If +not, write to the Free Software Foundation, Inc., 59 Temple Place - Suite 330, +Boston, MA 02111-1307, USA. */ + +#ifdef HAVE_CONFIG_H +#include "config.h" +#endif +#include +#if TIME_WITH_SYS_TIME +# include +# include +#else +# if HAVE_SYS_TIME_H +# include +# else +# include +# endif +#endif +#if HAVE_STRING_H +# include +#else +# include +#endif + +#include "f2c.h" + +/* NB. this implementation is for a character*24 function. There's + also a subroutine version. Of course, the calling convention is + essentially the same for both. */ + +/* Character *24 */ void G77_fdate_0 (char *ret_val, ftnlen ret_val_len) +{ + int s_copy (); + time_t tloc; + tloc = time (NULL); + /* Allow a length other than 24 for compatibility with what other + systems do, despite it being documented as 24. */ + s_copy (ret_val, ctime ((time_t *) &tloc), ret_val_len, 24); +} diff --git a/libf2c/libU77/fgetc_.c b/libf2c/libU77/fgetc_.c new file mode 100644 index 00000000000..49f39830d2c --- /dev/null +++ b/libf2c/libU77/fgetc_.c @@ -0,0 +1,70 @@ +/* Copyright (C) 1996 Free Software Foundation, Inc. +This file is part of GNU Fortran libU77 library. + +This library is free software; you can redistribute it and/or modify it +under the terms of the GNU Library General Public License as published +by the Free Software Foundation; either version 2 of the License, or +(at your option) any later version. + +GNU Fortran is distributed in the hope that it will be useful, +but WITHOUT ANY WARRANTY; without even the implied warranty of +MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +Library General Public License for more details. + +You should have received a copy of the GNU Library General Public +License along with GNU Fortran; see the file COPYING.LIB. If +not, write to the Free Software Foundation, Inc., 59 Temple Place - Suite 330, +Boston, MA 02111-1307, USA. */ + +#ifdef HAVE_CONFIG_H +#include "config.h" +#endif +#ifdef HAVE_CONFIG_H +#include "config.h" +#endif +#include +#include "f2c.h" +#include "fio.h" + +#ifdef KR_headers +integer G77_fgetc_0 (lunit, c, Lc) + integer *lunit; + ftnlen Lc; /* should be 1 */ + char *c; +#else +integer G77_fgetc_0 (const integer *lunit, char *c, ftnlen Lc) +#endif +{ + int err; + FILE *f = f__units[*lunit].ufd; + + if (*lunit>=MXUNIT || *lunit<0) + return 101; /* bad unit error */ + err = getc (f); + if (err == EOF) { + if (feof (f)) + return -1; + else + return ferror (f); } + else { + if (Lc == 0) + return 0; + + c[0] = err; + while (--Lc) + *++c = ' '; + return 0; } +} + +#ifdef KR_headers +integer G77_fget_0 (c, Lc) + ftnlen Lc; /* should be 1 */ + char *c; +#else +integer G77_fget_0 (char *c, const ftnlen Lc) +#endif +{ + integer five = 5; + + return G77_fgetc_0 (&five, c, Lc); +} diff --git a/libf2c/libU77/flush1_.c b/libf2c/libU77/flush1_.c new file mode 100644 index 00000000000..451915debac --- /dev/null +++ b/libf2c/libU77/flush1_.c @@ -0,0 +1,46 @@ +/* Copyright (C) 1995 Free Software Foundation, Inc. +This file is part of GNU Fortran libU77 library. + +This library is free software; you can redistribute it and/or modify it +under the terms of the GNU Library General Public License as published +by the Free Software Foundation; either version 2 of the License, or +(at your option) any later version. + +GNU Fortran is distributed in the hope that it will be useful, +but WITHOUT ANY WARRANTY; without even the implied warranty of +MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +Library General Public License for more details. + +You should have received a copy of the GNU Library General Public +License along with GNU Fortran; see the file COPYING.LIB. If +not, write to the Free Software Foundation, Inc., 59 Temple Place - Suite 330, +Boston, MA 02111-1307, USA. */ + +#ifdef HAVE_CONFIG_H +#include "config.h" +#endif +#include +#include "f2c.h" +#include "fio.h" + +/* This flushes a single unit, c.f. libI77 version. */ + +#ifdef KR_headers +extern integer G77_fnum_0 (); + +/* Subroutine */ int G77_flush1_0 (lunit) + integer *lunit; +#else +extern integer G77_fnum_0 (integer *); + +/* Subroutine */ int G77_flush1_0 (const integer *lunit) +#endif +{ + if (*lunit>=MXUNIT || *lunit<0) + err(1,101,"flush"); + /* f__units is a table of descriptions for the unit numbers (defined + in io.h) with file descriptors rather than streams */ + if (f__units[*lunit].ufd != NULL && f__units[*lunit].uwrt) + fflush(f__units[*lunit].ufd); + return 0; +} diff --git a/libf2c/libU77/fnum_.c b/libf2c/libU77/fnum_.c new file mode 100644 index 00000000000..0a3ba013e06 --- /dev/null +++ b/libf2c/libU77/fnum_.c @@ -0,0 +1,38 @@ +/* Copyright (C) 1995 Free Software Foundation, Inc. +This file is part of GNU Fortran libU77 library. + +This library is free software; you can redistribute it and/or modify it +under the terms of the GNU Library General Public License as published +by the Free Software Foundation; either version 2 of the License, or +(at your option) any later version. + +GNU Fortran is distributed in the hope that it will be useful, +but WITHOUT ANY WARRANTY; without even the implied warranty of +MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +Library General Public License for more details. + +You should have received a copy of the GNU Library General Public +License along with GNU Fortran; see the file COPYING.LIB. If +not, write to the Free Software Foundation, Inc., 59 Temple Place - Suite 330, +Boston, MA 02111-1307, USA. */ + +#ifdef HAVE_CONFIG_H +#include "config.h" +#endif +#include "f2c.h" +#include "fio.h" + +#ifdef KR_headers +integer G77_fnum_0 (lunit) + integer *lunit; +#else +integer G77_fnum_0 (integer *lunit) +#endif +{ + if (*lunit>=MXUNIT || *lunit<0) + err(1,101,"fnum"); + /* f__units is a table of descriptions for the unit numbers (defined + in io.h). Use file descriptor (ufd) and fileno rather than udev + field since udev is unix specific */ + return fileno(f__units[*lunit].ufd); +} diff --git a/libf2c/libU77/fputc_.c b/libf2c/libU77/fputc_.c new file mode 100644 index 00000000000..5a1109e8d4f --- /dev/null +++ b/libf2c/libU77/fputc_.c @@ -0,0 +1,65 @@ +/* Copyright (C) 1996 Free Software Foundation, Inc. +This file is part of GNU Fortran libU77 library. + +This library is free software; you can redistribute it and/or modify it +under the terms of the GNU Library General Public License as published +by the Free Software Foundation; either version 2 of the License, or +(at your option) any later version. + +GNU Fortran is distributed in the hope that it will be useful, +but WITHOUT ANY WARRANTY; without even the implied warranty of +MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +Library General Public License for more details. + +You should have received a copy of the GNU Library General Public +License along with GNU Fortran; see the file COPYING.LIB. If +not, write to the Free Software Foundation, Inc., 59 Temple Place - Suite 330, +Boston, MA 02111-1307, USA. */ + +#ifdef HAVE_CONFIG_H +#include "config.h" +#endif +#ifdef HAVE_CONFIG_H +#include "config.h" +#endif +#include +#include "f2c.h" +#include "fio.h" + +#ifdef KR_headers +integer G77_fputc_0 (lunit, c, Lc) + integer *lunit; + ftnlen Lc; /* should be 1 */ + char *c; +#else +integer G77_fputc_0 (const integer *lunit, const char *c, const ftnlen Lc) +#endif +{ + int err; + FILE *f = f__units[*lunit].ufd; + + if (*lunit>=MXUNIT || *lunit<0) + return 101; /* bad unit error */ + err = putc (c[0], f); + if (err == EOF) { + if (feof (f)) + return -1; + else + return ferror (f); + } + else + return 0; +} + +#ifdef KR_headers +integer G77_fput_0 (c, Lc) + ftnlen Lc; /* should be 1 */ + char *c; +#else +integer G77_fput_0 (const char *c, const ftnlen Lc) +#endif +{ + integer six = 6; + + return G77_fputc_0 (&six, c, Lc); +} diff --git a/libf2c/libU77/fstat_.c b/libf2c/libU77/fstat_.c new file mode 100644 index 00000000000..da5434ad0b7 --- /dev/null +++ b/libf2c/libU77/fstat_.c @@ -0,0 +1,71 @@ +/* Copyright (C) 1995 Free Software Foundation, Inc. +This file is part of GNU Fortran libU77 library. + +This library is free software; you can redistribute it and/or modify it +under the terms of the GNU Library General Public License as published +by the Free Software Foundation; either version 2 of the License, or +(at your option) any later version. + +GNU Fortran is distributed in the hope that it will be useful, +but WITHOUT ANY WARRANTY; without even the implied warranty of +MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +Library General Public License for more details. + +You should have received a copy of the GNU Library General Public +License along with GNU Fortran; see the file COPYING.LIB. If +not, write to the Free Software Foundation, Inc., 59 Temple Place - Suite 330, +Boston, MA 02111-1307, USA. */ + +#ifdef HAVE_CONFIG_H +#include "config.h" +#endif +#ifdef HAVE_CONFIG_H +#include "config.h" +#endif +#include "f2c.h" +#include +#include + +#ifdef KR_headers +extern integer G77_fnum_0 (); + +integer G77_fstat_0 (lunit, statb) + integer *lunit; + integer statb[13]; +#else +extern integer G77_fnum_0 (const integer *); + +integer G77_fstat_0 (const integer *lunit, integer statb[13]) +#endif +{ + int err; + struct stat buf; + + err = fstat (G77_fnum_0 (lunit), &buf); + statb[0] = buf.st_dev; + statb[1] = buf.st_ino; + statb[2] = buf.st_mode; + statb[3] = buf.st_nlink; + statb[4] = buf.st_uid; + statb[5] = buf.st_gid; +#if HAVE_ST_RDEV + statb[6] = buf.st_rdev; /* not posix */ +#else + statb[6] = 0; +#endif + statb[7] = buf.st_size; + statb[8] = buf.st_atime; + statb[9] = buf.st_mtime; + statb[10] = buf.st_ctime; +#if HAVE_ST_BLKSIZE + statb[11] = buf.st_blksize; /* not posix */ +#else + statb[11] = -1; +#endif +#if HAVE_ST_BLOCKS + statb[12] = buf.st_blocks; /* not posix */ +#else + statb[12] = -1; +#endif + return err; +} diff --git a/libf2c/libU77/gerror_.c b/libf2c/libU77/gerror_.c new file mode 100644 index 00000000000..6f5943c1dce --- /dev/null +++ b/libf2c/libU77/gerror_.c @@ -0,0 +1,49 @@ +/* Copyright (C) 1995 Free Software Foundation, Inc. +This file is part of GNU Fortran libU77 library. + +This library is free software; you can redistribute it and/or modify it +under the terms of the GNU Library General Public License as published +by the Free Software Foundation; either version 2 of the License, or +(at your option) any later version. + +GNU Fortran is distributed in the hope that it will be useful, +but WITHOUT ANY WARRANTY; without even the implied warranty of +MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +Library General Public License for more details. + +You should have received a copy of the GNU Library General Public +License along with GNU Fortran; see the file COPYING.LIB. If +not, write to the Free Software Foundation, Inc., 59 Temple Place - Suite 330, +Boston, MA 02111-1307, USA. */ + +#ifdef HAVE_CONFIG_H +#include "config.h" +#endif +#include +#include +#if HAVE_STRING_H +# include +#else +# include +#endif +#include "f2c.h" + +#ifndef HAVE_STRERROR + extern char *sys_errlist []; +# define strerror(i) (sys_errlist[i]) +#endif +#ifdef KR_headers +extern void s_copy (); +/* Subroutine */ int G77_gerror_0 (str, Lstr) + char *str; ftnlen Lstr; +#else +extern void s_copy(register char *a, register char *b, ftnlen la, ftnlen lb); +/* Subroutine */ int G77_gerror_0 (char *str, ftnlen Lstr) +#endif +{ + char * s; + + s = strerror(errno); + s_copy (str, s, Lstr, strlen (s)); + return 0; +} diff --git a/libf2c/libU77/getcwd_.c b/libf2c/libU77/getcwd_.c new file mode 100644 index 00000000000..e757803896a --- /dev/null +++ b/libf2c/libU77/getcwd_.c @@ -0,0 +1,99 @@ +/* Copyright (C) 1995, 1996 Free Software Foundation, Inc. +This file is part of GNU Fortran libU77 library. + +This library is free software; you can redistribute it and/or modify it +under the terms of the GNU Library General Public License as published +by the Free Software Foundation; either version 2 of the License, or +(at your option) any later version. + +GNU Fortran is distributed in the hope that it will be useful, +but WITHOUT ANY WARRANTY; without even the implied warranty of +MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +Library General Public License for more details. + +You should have received a copy of the GNU Library General Public +License along with GNU Fortran; see the file COPYING.LIB. If +not, write to the Free Software Foundation, Inc., 59 Temple Place - Suite 330, +Boston, MA 02111-1307, USA. */ + +#ifdef HAVE_CONFIG_H +#include "config.h" +#endif +#include +#if HAVE_STRING_H +# include +#else +# include +#endif +#include /* for NULL */ +#include /* for ENOSYS */ +#include "f2c.h" + +#if HAVE_GETCWD + +#ifdef HAVE_UNISTD_H +# include +#else + extern char *getcwd (); +#endif + +#ifdef KR_headers +extern void s_copy (); +integer G77_getcwd_0 (str, Lstr) + char *str; ftnlen Lstr; +#else +extern void s_copy(register char *a, register char *b, ftnlen la, ftnlen lb); +integer G77_getcwd_0 (char *str, const ftnlen Lstr) +#endif +{ + int i; + char *ret; + + ret = getcwd (str, Lstr); + if (ret == NULL) return errno; + for (i=strlen(str); i + extern char *getwd (); +#ifdef KR_headers +extern VOID s_copy (); +integer G77_getcwd_0 (str, Lstr) + char *str; ftnlen Lstr; +#else +extern void s_copy(register char *a, register char *b, ftnlen la, ftnlen lb); +integer G77_getcwd_0 (char *str, const ftnlen Lstr) +#endif +{ + char pathname[MAXPATHLEN]; + size_t l; + + if (getwd (pathname) == NULL) { + return errno; + } else { + s_copy (str, pathname, Lstr, strlen (str)); + return 0; + } +} + +#else /* !HAVE_GETWD && !HAVE_GETCWD */ + +#ifdef KR_headers +extern VOID s_copy (); +integer G77_getcwd_0 (str, Lstr) + char *str; ftnlen Lstr; +#else +extern void s_copy(register char *a, register char *b, ftnlen la, ftnlen lb); +integer G77_getcwd_0 (char *str, const ftnlen Lstr) +#endif +{ + return errno = ENOSYS; +} + +#endif diff --git a/libf2c/libU77/getgid_.c b/libf2c/libU77/getgid_.c new file mode 100644 index 00000000000..b489bacc6ed --- /dev/null +++ b/libf2c/libU77/getgid_.c @@ -0,0 +1,41 @@ +/* Copyright (C) 1995 Free Software Foundation, Inc. +This file is part of GNU Fortran libU77 library. + +This library is free software; you can redistribute it and/or modify it +under the terms of the GNU Library General Public License as published +by the Free Software Foundation; either version 2 of the License, or +(at your option) any later version. + +GNU Fortran is distributed in the hope that it will be useful, +but WITHOUT ANY WARRANTY; without even the implied warranty of +MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +Library General Public License for more details. + +You should have received a copy of the GNU Library General Public +License along with GNU Fortran; see the file COPYING.LIB. If +not, write to the Free Software Foundation, Inc., 59 Temple Place - Suite 330, +Boston, MA 02111-1307, USA. */ + +#ifdef HAVE_CONFIG_H +#include "config.h" +#endif +#if HAVE_UNISTD_H +#include +#endif +#include +#include /* for ENOSYS */ +#include "f2c.h" + +#ifdef KR_headers +integer G77_getgid_0 () +#else +integer G77_getgid_0 (void) +#endif +{ +#if defined (HAVE_GETGID) + return getgid (); +#else + errno = ENOSYS; + return -1; +#endif +} diff --git a/libf2c/libU77/getlog_.c b/libf2c/libU77/getlog_.c new file mode 100644 index 00000000000..82cb564a67a --- /dev/null +++ b/libf2c/libU77/getlog_.c @@ -0,0 +1,71 @@ +/* Copyright (C) 1995 Free Software Foundation, Inc. +This file is part of GNU Fortran libU77 library. + +This library is free software; you can redistribute it and/or modify it +under the terms of the GNU Library General Public License as published +by the Free Software Foundation; either version 2 of the License, or +(at your option) any later version. + +GNU Fortran is distributed in the hope that it will be useful, +but WITHOUT ANY WARRANTY; without even the implied warranty of +MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +Library General Public License for more details. + +You should have received a copy of the GNU Library General Public +License along with GNU Fortran; see the file COPYING.LIB. If +not, write to the Free Software Foundation, Inc., 59 Temple Place - Suite 330, +Boston, MA 02111-1307, USA. */ + +#ifdef HAVE_CONFIG_H +#include "config.h" +#endif +#include +#if HAVE_STDLIB_H +# include +#else +# include +#endif +#include +#if HAVE_UNISTD_H +# include +#endif +#if HAVE_STRING_H +# include +#else +# include +#endif +#include /* for ENOSYS */ +#include "f2c.h" + +/* getlogin not in svr1-3 */ + +/* SGI also has character*(*) function getlog() */ + +#ifdef KR_headers +extern VOID s_copy (); +/* Subroutine */ int G77_getlog_0 (str, Lstr) + char *str; ftnlen Lstr; +#else +extern void s_copy(register char *a, register char *b, ftnlen la, ftnlen lb); +/* Subroutine */ int G77_getlog_0 (char *str, const ftnlen Lstr) +#endif +{ + size_t i; + char *p; + int status; + +#if defined (HAVE_GETLOGIN) + p = getlogin (); + if (p != NULL) { + i = strlen (p); + s_copy (str, p, Lstr, i); + } else { + s_copy (str, " ", Lstr, 1); + } + status = 0; +#else + errno = ENOSYS; + status = -1; +#endif + return status; +} diff --git a/libf2c/libU77/getpid_.c b/libf2c/libU77/getpid_.c new file mode 100644 index 00000000000..fa484785957 --- /dev/null +++ b/libf2c/libU77/getpid_.c @@ -0,0 +1,35 @@ +/* Copyright (C) 1995 Free Software Foundation, Inc. +This file is part of GNU Fortran libU77 library. + +This library is free software; you can redistribute it and/or modify it +under the terms of the GNU Library General Public License as published +by the Free Software Foundation; either version 2 of the License, or +(at your option) any later version. + +GNU Fortran is distributed in the hope that it will be useful, +but WITHOUT ANY WARRANTY; without even the implied warranty of +MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +Library General Public License for more details. + +You should have received a copy of the GNU Library General Public +License along with GNU Fortran; see the file COPYING.LIB. If +not, write to the Free Software Foundation, Inc., 59 Temple Place - Suite 330, +Boston, MA 02111-1307, USA. */ + +#ifdef HAVE_CONFIG_H +#include "config.h" +#endif +#if HAVE_UNISTD_H +#include +#endif +#include +#include "f2c.h" + +#ifdef KR_headers +integer G77_getpid_0 () +#else +integer G77_getpid_0 (void) +#endif +{ + return getpid (); +} diff --git a/libf2c/libU77/getuid_.c b/libf2c/libU77/getuid_.c new file mode 100644 index 00000000000..408ff0ab600 --- /dev/null +++ b/libf2c/libU77/getuid_.c @@ -0,0 +1,41 @@ +/* Copyright (C) 1995 Free Software Foundation, Inc. +This file is part of GNU Fortran libU77 library. + +This library is free software; you can redistribute it and/or modify it +under the terms of the GNU Library General Public License as published +by the Free Software Foundation; either version 2 of the License, or +(at your option) any later version. + +GNU Fortran is distributed in the hope that it will be useful, +but WITHOUT ANY WARRANTY; without even the implied warranty of +MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +Library General Public License for more details. + +You should have received a copy of the GNU Library General Public +License along with GNU Fortran; see the file COPYING.LIB. If +not, write to the Free Software Foundation, Inc., 59 Temple Place - Suite 330, +Boston, MA 02111-1307, USA. */ + +#ifdef HAVE_CONFIG_H +#include "config.h" +#endif +#if HAVE_UNISTD_H +#include +#endif +#include +#include /* for ENOSYS */ +#include "f2c.h" + +#ifdef KR_headers +integer G77_getuid_0 () +#else +integer G77_getuid_0 (void) +#endif +{ +#if defined (HAVE_GETUID) + return getuid (); +#else + errno = ENOSYS; + return -1; +#endif +} diff --git a/libf2c/libU77/gmtime_.c b/libf2c/libU77/gmtime_.c new file mode 100644 index 00000000000..5f6f8ec6a0b --- /dev/null +++ b/libf2c/libU77/gmtime_.c @@ -0,0 +1,54 @@ +/* Copyright (C) 1995 Free Software Foundation, Inc. +This file is part of GNU Fortran libU77 library. + +This library is free software; you can redistribute it and/or modify it +under the terms of the GNU Library General Public License as published +by the Free Software Foundation; either version 2 of the License, or +(at your option) any later version. + +GNU Fortran is distributed in the hope that it will be useful, +but WITHOUT ANY WARRANTY; without even the implied warranty of +MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +Library General Public License for more details. + +You should have received a copy of the GNU Library General Public +License along with GNU Fortran; see the file COPYING.LIB. If +not, write to the Free Software Foundation, Inc., 59 Temple Place - Suite 330, +Boston, MA 02111-1307, USA. */ + +#ifdef HAVE_CONFIG_H +#include "config.h" +#endif +/* fixme: do we need to use TM_IN_SYS_TIME? */ +#if TIME_WITH_SYS_TIME +# include +# include +#else +# if HAVE_SYS_TIME_H +# include +# else +# include +# endif +#endif +#include "f2c.h" + +#ifdef KR_headers +/* Subroutine */ int G77_gmtime_0 (stime, tarray) + integer *stime, tarray[9]; +#else +/* Subroutine */ int G77_gmtime_0 (const integer * stime, integer tarray[9]) +#endif +{ + struct tm *lt; + lt = gmtime ((time_t *) stime); + tarray[0] = lt->tm_sec; + tarray[1] = lt->tm_min; + tarray[2] = lt->tm_hour; + tarray[3] = lt->tm_mday; + tarray[4] = lt->tm_mon; + tarray[5] = lt->tm_year; + tarray[6] = lt->tm_wday; + tarray[7] = lt->tm_yday; + tarray[8] = lt->tm_isdst; + return 0; +} diff --git a/libf2c/libU77/hostnm_.c b/libf2c/libU77/hostnm_.c new file mode 100644 index 00000000000..8229e09e727 --- /dev/null +++ b/libf2c/libU77/hostnm_.c @@ -0,0 +1,49 @@ +/* Copyright (C) 1995 Free Software Foundation, Inc. +This file is part of GNU Fortran libU77 library. + +This library is free software; you can redistribute it and/or modify it +under the terms of the GNU Library General Public License as published +by the Free Software Foundation; either version 2 of the License, or +(at your option) any later version. + +GNU Fortran is distributed in the hope that it will be useful, +but WITHOUT ANY WARRANTY; without even the implied warranty of +MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +Library General Public License for more details. + +You should have received a copy of the GNU Library General Public +License along with GNU Fortran; see the file COPYING.LIB. If +not, write to the Free Software Foundation, Inc., 59 Temple Place - Suite 330, +Boston, MA 02111-1307, USA. */ + +#ifdef HAVE_CONFIG_H +#include "config.h" +#endif +#if HAVE_STRING_H +# include +#else +# include +#endif +#if HAVE_UNISTD_H +# include +#endif +#include /* for ENOSYS */ +#include "f2c.h" + +integer G77_hostnm_0 (char *name, ftnlen Lname) +{ + int ret, i; + +#if HAVE_GETHOSTNAME + ret = gethostname (name, Lname); + if (ret==0) { + /* Pad with blanks (assuming gethostname will make an error + return if it can't fit in the null). */ + for (i=strlen(name); i<=Lname; i++) + name[i] = ' '; + } + return ret; +#else + return errno = ENOSYS; +#endif +} diff --git a/libf2c/libU77/idate_.c b/libf2c/libU77/idate_.c new file mode 100644 index 00000000000..c4075767a4c --- /dev/null +++ b/libf2c/libU77/idate_.c @@ -0,0 +1,57 @@ +/* Copyright (C) 1995, 1996 Free Software Foundation, Inc. +This file is part of GNU Fortran libU77 library. + +This library is free software; you can redistribute it and/or modify it +under the terms of the GNU Library General Public License as published +by the Free Software Foundation; either version 2 of the License, or +(at your option) any later version. + +GNU Fortran is distributed in the hope that it will be useful, +but WITHOUT ANY WARRANTY; without even the implied warranty of +MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +Library General Public License for more details. + +You should have received a copy of the GNU Library General Public +License along with GNU Fortran; see the file COPYING.LIB. If +not, write to the Free Software Foundation, Inc., 59 Temple Place - Suite 330, +Boston, MA 02111-1307, USA. */ + +#ifdef HAVE_CONFIG_H +#include "config.h" +#endif +#include +#if TIME_WITH_SYS_TIME +# include +# include +#else +# if HAVE_SYS_TIME_H +# include +# else +# include +# endif +#endif +#include "f2c.h" + +/* VMS and Irix versions (at least) differ from libU77 elsewhere */ + +/* libU77 one: */ + +#ifdef KR_headers +/* Subroutine */ int G77_idate_0 (iarray) + int iarray[3]; +#else +/* Subroutine */ int G77_idate_0 (int iarray[3]) +#endif +{ + struct tm *lt; + time_t tim; + tim = time(NULL); + lt = localtime(&tim); + iarray[0] = lt->tm_mday; + iarray[1] = lt->tm_mon + 1; /* in range 1-12 in SunOS (experimentally) */ + /* The `+1900' is consistent with SunOS and Irix, but they don't say + it's added. I think I've seen a system where tm_year was since + 1970, but can't now verify that, so assume the ANSI definition. */ + iarray[2] = lt->tm_year + 1900; + return 0; +} diff --git a/libf2c/libU77/ierrno_.c b/libf2c/libU77/ierrno_.c new file mode 100644 index 00000000000..557b53a4664 --- /dev/null +++ b/libf2c/libU77/ierrno_.c @@ -0,0 +1,32 @@ +/* Copyright (C) 1995 Free Software Foundation, Inc. +This file is part of GNU Fortran libU77 library. + +This library is free software; you can redistribute it and/or modify it +under the terms of the GNU Library General Public License as published +by the Free Software Foundation; either version 2 of the License, or +(at your option) any later version. + +GNU Fortran is distributed in the hope that it will be useful, +but WITHOUT ANY WARRANTY; without even the implied warranty of +MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +Library General Public License for more details. + +You should have received a copy of the GNU Library General Public +License along with GNU Fortran; see the file COPYING.LIB. If +not, write to the Free Software Foundation, Inc., 59 Temple Place - Suite 330, +Boston, MA 02111-1307, USA. */ + +#ifdef HAVE_CONFIG_H +#include "config.h" +#endif +#include +#include "f2c.h" + +#ifdef KR_headers +integer G77_ierrno_0 () +#else +integer G77_ierrno_0 (void) +#endif +{ + return errno; +} diff --git a/libf2c/libU77/irand_.c b/libf2c/libU77/irand_.c new file mode 100644 index 00000000000..2bf14ccee26 --- /dev/null +++ b/libf2c/libU77/irand_.c @@ -0,0 +1,57 @@ +/* Copyright (C) 1995 Free Software Foundation, Inc. +This file is part of GNU Fortran libU77 library. + +This library is free software; you can redistribute it and/or modify it +under the terms of the GNU Library General Public License as published +by the Free Software Foundation; either version 2 of the License, or +(at your option) any later version. + +GNU Fortran is distributed in the hope that it will be useful, +but WITHOUT ANY WARRANTY; without even the implied warranty of +MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +Library General Public License for more details. + +You should have received a copy of the GNU Library General Public +License along with GNU Fortran; see the file COPYING.LIB. If +not, write to the Free Software Foundation, Inc., 59 Temple Place - Suite 330, +Boston, MA 02111-1307, USA. */ + +#ifdef HAVE_CONFIG_H +#include "config.h" +#endif +#if HAVE_STDLIB_H +# include +#endif +#include "f2c.h" + +/* We could presumably do much better than the traditional libc + version, though at least the glibc one is reasonable, it seems. + For the sake of the innocent, I'm not sure we should really do + this... */ + +/* Note this is per SunOS -- other s may have no arg. */ + +#ifdef KR_headers +integer G77_irand_0 (flag) + integer *flag; +#else +integer G77_irand_0 (integer *flag) +#endif +{ + switch (*flag) { + case 0: + break; + case 1: + srand (0); /* Arbitrary choice of initialiser. */ + break; + default: + srand (*flag); + } + return rand (); +} + + + + + + diff --git a/libf2c/libU77/isatty_.c b/libf2c/libU77/isatty_.c new file mode 100644 index 00000000000..92c33468f53 --- /dev/null +++ b/libf2c/libU77/isatty_.c @@ -0,0 +1,44 @@ +/* Copyright (C) 1995 Free Software Foundation, Inc. +This file is part of GNU Fortran libU77 library. + +This library is free software; you can redistribute it and/or modify it +under the terms of the GNU Library General Public License as published +by the Free Software Foundation; either version 2 of the License, or +(at your option) any later version. + +GNU Fortran is distributed in the hope that it will be useful, +but WITHOUT ANY WARRANTY; without even the implied warranty of +MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +Library General Public License for more details. + +You should have received a copy of the GNU Library General Public +License along with GNU Fortran; see the file COPYING.LIB. If +not, write to the Free Software Foundation, Inc., 59 Temple Place - Suite 330, +Boston, MA 02111-1307, USA. */ + +#ifdef HAVE_CONFIG_H +#include "config.h" +#endif +#if HAVE_UNISTD_H +# include +#endif +#include "f2c.h" +#include "fio.h" + +#ifdef KR_headers +extern integer G77_fnum_0 (); + +logical G77_isatty_0 (lunit) + integer *lunit; +#else +extern integer G77_fnum_0 (integer *); + +logical G77_isatty_0 (integer *lunit) +#endif +{ + if (*lunit>=MXUNIT || *lunit<0) + err(1,101,"isatty"); + /* f__units is a table of descriptions for the unit numbers (defined + in io.h) with file descriptors rather than streams */ + return (isatty(G77_fnum_0 (lunit)) ? TRUE_ : FALSE_); +} diff --git a/libf2c/libU77/itime_.c b/libf2c/libU77/itime_.c new file mode 100644 index 00000000000..50378d54426 --- /dev/null +++ b/libf2c/libU77/itime_.c @@ -0,0 +1,51 @@ +/* Copyright (C) 1995 Free Software Foundation, Inc. +This file is part of GNU Fortran libU77 library. + +This library is free software; you can redistribute it and/or modify it +under the terms of the GNU Library General Public License as published +by the Free Software Foundation; either version 2 of the License, or +(at your option) any later version. + +GNU Fortran is distributed in the hope that it will be useful, +but WITHOUT ANY WARRANTY; without even the implied warranty of +MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +Library General Public License for more details. + +You should have received a copy of the GNU Library General Public +License along with GNU Fortran; see the file COPYING.LIB. If +not, write to the Free Software Foundation, Inc., 59 Temple Place - Suite 330, +Boston, MA 02111-1307, USA. */ + +#ifdef HAVE_CONFIG_H +#include "config.h" +#endif +#include +#if TIME_WITH_SYS_TIME +# include +# include +#else +# if HAVE_SYS_TIME_H +# include +# else +# include +# endif +#endif +#include "f2c.h" + +#ifdef KR_headers +/* Subroutine */ int G77_itime_0 (tarray) + integer tarray[3]; +#else +/* Subroutine */ int G77_itime_0 (integer tarray[3]) +#endif +{ + struct tm *lt; + time_t tim; + + tim = time(NULL); + lt = localtime(&tim); + tarray[0] = lt->tm_hour; + tarray[1] = lt->tm_min; + tarray[2] = lt->tm_sec; + return 0; +} diff --git a/libf2c/libU77/kill_.c b/libf2c/libU77/kill_.c new file mode 100644 index 00000000000..99197bd02e7 --- /dev/null +++ b/libf2c/libU77/kill_.c @@ -0,0 +1,42 @@ +/* Copyright (C) 1995 Free Software Foundation, Inc. +This file is part of GNU Fortran libU77 library. + +This library is free software; you can redistribute it and/or modify it +under the terms of the GNU Library General Public License as published +by the Free Software Foundation; either version 2 of the License, or +(at your option) any later version. + +GNU Fortran is distributed in the hope that it will be useful, +but WITHOUT ANY WARRANTY; without even the implied warranty of +MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +Library General Public License for more details. + +You should have received a copy of the GNU Library General Public +License along with GNU Fortran; see the file COPYING.LIB. If +not, write to the Free Software Foundation, Inc., 59 Temple Place - Suite 330, +Boston, MA 02111-1307, USA. */ + +#ifdef HAVE_CONFIG_H +#include "config.h" +#endif +#include +#include +#include +#include "f2c.h" + +/* fixme: bsd, svr1-3 use int, not pid_t */ + +#ifdef KR_headers +integer G77_kill_0 (pid, signum) + integer *pid, *signum; +#else +integer G77_kill_0 (const integer *pid, const integer *signum) +#endif +{ +#if defined (HAVE_KILL) + return kill ((pid_t) *pid, *signum) ? errno : 0; +#else + errno = ENOSYS; + return -1; +#endif +} diff --git a/libf2c/libU77/link_.c b/libf2c/libU77/link_.c new file mode 100644 index 00000000000..003fac8ffe2 --- /dev/null +++ b/libf2c/libU77/link_.c @@ -0,0 +1,66 @@ +/* Copyright (C) 1995, 1997 Free Software Foundation, Inc. +This file is part of GNU Fortran libU77 library. + +This library is free software; you can redistribute it and/or modify it +under the terms of the GNU Library General Public License as published +by the Free Software Foundation; either version 2 of the License, or +(at your option) any later version. + +GNU Fortran is distributed in the hope that it will be useful, +but WITHOUT ANY WARRANTY; without even the implied warranty of +MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +Library General Public License for more details. + +You should have received a copy of the GNU Library General Public +License along with GNU Fortran; see the file COPYING.LIB. If +not, write to the Free Software Foundation, Inc., 59 Temple Place - Suite 330, +Boston, MA 02111-1307, USA. */ + +#ifdef HAVE_CONFIG_H +#include "config.h" +#endif +#if HAVE_STDLIB_H +# include +#else +# include +#endif +#if HAVE_UNISTD_H +# include +#endif +#include +#if HAVE_SYS_PARAM_H +# include +#endif +#include /* for ENOSYS */ +#include "f2c.h" + +#ifdef KR_headers +void g_char (); + +integer G77_link_0 (path1, path2, Lpath1, Lpath2) + char *path1, *path2; ftnlen Lpath1, Lpath2; +#else +void g_char(const char *a, ftnlen alen, char *b); + +integer G77_link_0 (const char *path1, const char *path2, const ftnlen Lpath1, const ftnlen Lpath2) +#endif +{ +#if defined (HAVE_LINK) + char *buff1, *buff2; + char *bp, *blast; + int i; + + buff1 = malloc (Lpath1+1); + if (buff1 == NULL) return -1; + g_char (path1, Lpath1, buff1); + buff2 = malloc (Lpath2+1); + if (buff2 == NULL) return -1; + g_char (path2, Lpath2, buff2); + i = link (buff1, buff2); + free (buff1); free (buff2); + return i ? errno : 0; +#else /* ! HAVE_LINK */ + errno = ENOSYS; + return -1; +#endif +} diff --git a/libf2c/libU77/lnblnk_.c b/libf2c/libU77/lnblnk_.c new file mode 100644 index 00000000000..806eca293f1 --- /dev/null +++ b/libf2c/libU77/lnblnk_.c @@ -0,0 +1,35 @@ +/* Copyright (C) 1995, 1997 Free Software Foundation, Inc. +This file is part of GNU Fortran libU77 library. + +This library is free software; you can redistribute it and/or modify it +under the terms of the GNU Library General Public License as published +by the Free Software Foundation; either version 2 of the License, or +(at your option) any later version. + +GNU Fortran is distributed in the hope that it will be useful, +but WITHOUT ANY WARRANTY; without even the implied warranty of +MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +Library General Public License for more details. + +You should have received a copy of the GNU Library General Public +License along with GNU Fortran; see the file COPYING.LIB. If +not, write to the Free Software Foundation, Inc., 59 Temple Place - Suite 330, +Boston, MA 02111-1307, USA. */ + + +/* via f2c from Fortran */ + +#include "f2c.h" + +integer G77_lnblnk_0 (char *str, ftnlen str_len) +{ + integer ret_val; + integer i_len(); + + for (ret_val = str_len; ret_val >= 1; --ret_val) { + if (*(unsigned char *)&str[ret_val - 1] != ' ') { + return ret_val; + } + } + return ret_val; +} diff --git a/libf2c/libU77/lstat_.c b/libf2c/libU77/lstat_.c new file mode 100644 index 00000000000..e3efce7c55b --- /dev/null +++ b/libf2c/libU77/lstat_.c @@ -0,0 +1,87 @@ +/* Copyright (C) 1995, 1997 Free Software Foundation, Inc. +This file is part of GNU Fortran libU77 library. + +This library is free software; you can redistribute it and/or modify it +under the terms of the GNU Library General Public License as published +by the Free Software Foundation; either version 2 of the License, or +(at your option) any later version. + +GNU Fortran is distributed in the hope that it will be useful, +but WITHOUT ANY WARRANTY; without even the implied warranty of +MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +Library General Public License for more details. + +You should have received a copy of the GNU Library General Public +License along with GNU Fortran; see the file COPYING.LIB. If +not, write to the Free Software Foundation, Inc., 59 Temple Place - Suite 330, +Boston, MA 02111-1307, USA. */ + +#ifdef HAVE_CONFIG_H +#include "config.h" +#endif +#include +#if HAVE_STDLIB_H +# include +#endif +#include +#include +#include /* for ENOSYS */ +#include "f2c.h" + +/* lstat isn't posix */ + +#ifdef KR_headers +void g_char(); + +integer G77_lstat_0 (name, statb, Lname) + char *name; + integer statb[13]; + ftnlen Lname; +#else +void g_char(const char *a, ftnlen alen, char *b); + +integer G77_lstat_0 (const char *name, integer statb[13], const ftnlen Lname) +#endif +{ +#if HAVE_LSTAT + char *buff; + char *bp, *blast; + int err; + struct stat buf; + + buff = malloc (Lname+1); + if (buff == NULL) return -1; + g_char (name, Lname, buff); + err = lstat (buff, &buf); + free (buff); + statb[0] = buf.st_dev; + statb[1] = buf.st_ino; + statb[2] = buf.st_mode; + statb[3] = buf.st_nlink; + statb[4] = buf.st_uid; + statb[5] = buf.st_gid; +#if HAVE_ST_RDEV + statb[6] = buf.st_rdev; +#else + statb[6] = 0; +#endif + statb[7] = buf.st_size; + statb[8] = buf.st_atime; + statb[9] = buf.st_mtime; + statb[10] = buf.st_ctime; + statb[6] = 0; +#if HAVE_ST_BLKSIZE + statb[11] = buf.st_blksize; +#else + statb[11] = -1; +#endif +#if HAVE_ST_BLOCKS + statb[12] = buf.st_blocks; +#else + statb[12] = -1; +#endif + return err; +#else /* !HAVE_LSTAT */ + return errno = ENOSYS; +#endif /* !HAVE_LSTAT */ +} diff --git a/libf2c/libU77/ltime_.c b/libf2c/libU77/ltime_.c new file mode 100644 index 00000000000..151ac6c9b55 --- /dev/null +++ b/libf2c/libU77/ltime_.c @@ -0,0 +1,54 @@ +/* Copyright (C) 1995 Free Software Foundation, Inc. +This file is part of GNU Fortran libU77 library. + +This library is free software; you can redistribute it and/or modify it +under the terms of the GNU Library General Public License as published +by the Free Software Foundation; either version 2 of the License, or +(at your option) any later version. + +GNU Fortran is distributed in the hope that it will be useful, +but WITHOUT ANY WARRANTY; without even the implied warranty of +MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +Library General Public License for more details. + +You should have received a copy of the GNU Library General Public +License along with GNU Fortran; see the file COPYING.LIB. If +not, write to the Free Software Foundation, Inc., 59 Temple Place - Suite 330, +Boston, MA 02111-1307, USA. */ + +#ifdef HAVE_CONFIG_H +#include "config.h" +#endif +/* fixme: do we need to use TM_IN_SYS_TIME? */ +#if TIME_WITH_SYS_TIME +# include +# include +#else +# if HAVE_SYS_TIME_H +# include +# else +# include +# endif +#endif +#include "f2c.h" + +#ifdef KR_headers +/* Subroutine */ int G77_ltime_0 (stime, tarray) + integer *stime, tarray[9]; +#else +/* Subroutine */ int G77_ltime_0 (const integer * stime, integer tarray[9]) +#endif +{ + struct tm *lt; + lt = localtime ((time_t *) stime); + tarray[0] = lt->tm_sec; + tarray[1] = lt->tm_min; + tarray[2] = lt->tm_hour; + tarray[3] = lt->tm_mday; + tarray[4] = lt->tm_mon; + tarray[5] = lt->tm_year; + tarray[6] = lt->tm_wday; + tarray[7] = lt->tm_yday; + tarray[8] = lt->tm_isdst; + return 0; +} diff --git a/libf2c/libU77/mclock_.c b/libf2c/libU77/mclock_.c new file mode 100644 index 00000000000..6b7e81b1e04 --- /dev/null +++ b/libf2c/libU77/mclock_.c @@ -0,0 +1,47 @@ +/* Copyright (C) 1996 Free Software Foundation, Inc. +This file is part of GNU Fortran libU77 library. + +This library is free software; you can redistribute it and/or modify it +under the terms of the GNU Library General Public License as published +by the Free Software Foundation; either version 2 of the License, or +(at your option) any later version. + +GNU Fortran is distributed in the hope that it will be useful, +but WITHOUT ANY WARRANTY; without even the implied warranty of +MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +Library General Public License for more details. + +You should have received a copy of the GNU Library General Public +License along with GNU Fortran; see the file COPYING.LIB. If +not, write to the Free Software Foundation, Inc., 59 Temple Place - Suite 330, +Boston, MA 02111-1307, USA. */ + +#ifdef HAVE_CONFIG_H +#include "config.h" +#endif +#if TIME_WITH_SYS_TIME +# include +# include +#else +# if HAVE_SYS_TIME_H +# include +# else +# include +# endif +#endif +#include "f2c.h" + +/* Reported by wd42ej@sgi83.wwb.noaa.gov (Russ Jones AUTO-Sun3) on AIX. */ + +#ifdef KR_headers +longint G77_mclock_0 () +#else +longint G77_mclock_0 (void) +#endif +{ +#if HAVE_CLOCK + return clock (); +#else + return -1; +#endif +} diff --git a/libf2c/libU77/perror_.c b/libf2c/libU77/perror_.c new file mode 100644 index 00000000000..26d8582dbcc --- /dev/null +++ b/libf2c/libU77/perror_.c @@ -0,0 +1,48 @@ +/* Copyright (C) 1995 Free Software Foundation, Inc. +This file is part of GNU Fortran libU77 library. + +This library is free software; you can redistribute it and/or modify it +under the terms of the GNU Library General Public License as published +by the Free Software Foundation; either version 2 of the License, or +(at your option) any later version. + +GNU Fortran is distributed in the hope that it will be useful, +but WITHOUT ANY WARRANTY; without even the implied warranty of +MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +Library General Public License for more details. + +You should have received a copy of the GNU Library General Public +License along with GNU Fortran; see the file COPYING.LIB. If +not, write to the Free Software Foundation, Inc., 59 Temple Place - Suite 330, +Boston, MA 02111-1307, USA. */ + +#ifdef HAVE_CONFIG_H +#include "config.h" +#endif +#include +#include +#if HAVE_STRING_H +# include +#else +# include +#endif +#include "f2c.h" + +#ifdef KR_headers +/* Subroutine */ int G77_perror_0 (str, Lstr) + char *str; ftnlen Lstr; +#else +/* Subroutine */ int G77_perror_0 (const char *str, const ftnlen Lstr) +#endif +{ + char buff[1000]; + char *bp, *blast; + + /* same technique as `system' -- what's wrong with malloc? */ + blast = buff + (Lstr < 1000 ? Lstr : 1000); + for (bp = buff ; bp +#endif +#include "f2c.h" +#ifndef RAND_MAX +# define RAND_MAX 2147483647 /* from SunOS */ +#endif + +/* We could presumably do much better than the traditional libc + version, though at least the glibc one is reasonable, it seems. + For the sake of the innocent, I'm not sure we should really do + this... */ + +/* Note this is per SunOS -- other s may have no arg. */ + +#ifdef KR_headers +double G77_rand_0 (flag) + integer *flag; +#else +double G77_rand_0 (integer *flag) +#endif +{ + switch (*flag) { + case 0: + break; + case 1: + srand (0); /* Arbitrary choice of initialiser. */ + break; + default: + srand (*flag); + } + return (float) rand () / RAND_MAX; +} diff --git a/libf2c/libU77/rename_.c b/libf2c/libU77/rename_.c new file mode 100644 index 00000000000..9583001c421 --- /dev/null +++ b/libf2c/libU77/rename_.c @@ -0,0 +1,56 @@ +/* Copyright (C) 1995, 1997 Free Software Foundation, Inc. +This file is part of GNU Fortran libU77 library. + +This library is free software; you can redistribute it and/or modify it +under the terms of the GNU Library General Public License as published +by the Free Software Foundation; either version 2 of the License, or +(at your option) any later version. + +GNU Fortran is distributed in the hope that it will be useful, +but WITHOUT ANY WARRANTY; without even the implied warranty of +MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +Library General Public License for more details. + +You should have received a copy of the GNU Library General Public +License along with GNU Fortran; see the file COPYING.LIB. If +not, write to the Free Software Foundation, Inc., 59 Temple Place - Suite 330, +Boston, MA 02111-1307, USA. */ + +#ifdef HAVE_CONFIG_H +#include "config.h" +#endif +#if HAVE_UNISTD_H +# include +#endif +#if HAVE_STDLIB_H +# include +#endif +#include +#include +#include "f2c.h" + +#ifdef KR_headers +void g_char (); + +integer G77_rename_0 (path1, path2, Lpath1, Lpath2) + char *path1, *path2; ftnlen Lpath1, Lpath2; +#else +void g_char(const char *a, ftnlen alen, char *b); + +integer G77_rename_0 (const char *path1, const char *path2, const ftnlen Lpath1, const ftnlen Lpath2) +#endif +{ + char *buff1, *buff2; + char *bp, *blast; + int i; + + buff1 = malloc (Lpath1+1); + if (buff1 == NULL) return -1; + g_char (path1, Lpath1, buff1); + buff2 = malloc (Lpath2+1); + if (buff2 == NULL) return -1; + g_char (path2, Lpath2, buff2); + i = rename (buff1, buff2); + free (buff1); free (buff2); + return i ? errno : 0; +} diff --git a/libf2c/libU77/secnds_.c b/libf2c/libU77/secnds_.c new file mode 100644 index 00000000000..1942528530f --- /dev/null +++ b/libf2c/libU77/secnds_.c @@ -0,0 +1,51 @@ +/* Copyright (C) 1995 Free Software Foundation, Inc. +This file is part of GNU Fortran libU77 library. + +This library is free software; you can redistribute it and/or modify it +under the terms of the GNU Library General Public License as published +by the Free Software Foundation; either version 2 of the License, or +(at your option) any later version. + +GNU Fortran is distributed in the hope that it will be useful, +but WITHOUT ANY WARRANTY; without even the implied warranty of +MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +Library General Public License for more details. + +You should have received a copy of the GNU Library General Public +License along with GNU Fortran; see the file COPYING.LIB. If +not, write to the Free Software Foundation, Inc., 59 Temple Place - Suite 330, +Boston, MA 02111-1307, USA. */ + +#ifdef HAVE_CONFIG_H +#include "config.h" +#endif +#include +#if TIME_WITH_SYS_TIME +# include +# include +#else +# if HAVE_SYS_TIME_H +# include +# else +# include +# endif +#endif +#include + +#include "f2c.h" + +/* This is a VMS intrinsic. */ + +double G77_secnds_0 (real *r) +{ + struct tm *lt; + time_t clock; + float f; + + clock = time (NULL); + lt = localtime (&clock); + f= (3600.0*((real)lt->tm_hour) + 60.0*((real)lt->tm_min) + + (real)lt->tm_sec - *r); + return f; +} + diff --git a/libf2c/libU77/second_.c b/libf2c/libU77/second_.c new file mode 100644 index 00000000000..41bb5a90a92 --- /dev/null +++ b/libf2c/libU77/second_.c @@ -0,0 +1,26 @@ +/* Copyright (C) 1996 Free Software Foundation, Inc. +This file is part of GNU Fortran libU77 library. + +This library is free software; you can redistribute it and/or modify it +under the terms of the GNU Library General Public License as published +by the Free Software Foundation; either version 2 of the License, or +(at your option) any later version. + +GNU Fortran is distributed in the hope that it will be useful, +but WITHOUT ANY WARRANTY; without even the implied warranty of +MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +Library General Public License for more details. + +You should have received a copy of the GNU Library General Public +License along with GNU Fortran; see the file COPYING.LIB. If +not, write to the Free Software Foundation, Inc., 59 Temple Place - Suite 330, +Boston, MA 02111-1307, USA. */ + +#include "f2c.h" + +double G77_second_0 () { + extern double G77_etime_0 (); + real tarray[2]; + + return G77_etime_0 (tarray); +} diff --git a/libf2c/libU77/sleep_.c b/libf2c/libU77/sleep_.c new file mode 100644 index 00000000000..36e1b8d9a7b --- /dev/null +++ b/libf2c/libU77/sleep_.c @@ -0,0 +1,37 @@ +/* Copyright (C) 1995 Free Software Foundation, Inc. +This file is part of GNU Fortran libU77 library. + +This library is free software; you can redistribute it and/or modify it +under the terms of the GNU Library General Public License as published +by the Free Software Foundation; either version 2 of the License, or +(at your option) any later version. + +GNU Fortran is distributed in the hope that it will be useful, +but WITHOUT ANY WARRANTY; without even the implied warranty of +MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +Library General Public License for more details. + +You should have received a copy of the GNU Library General Public +License along with GNU Fortran; see the file COPYING.LIB. If +not, write to the Free Software Foundation, Inc., 59 Temple Place - Suite 330, +Boston, MA 02111-1307, USA. */ + +#ifdef HAVE_CONFIG_H +#include "config.h" +#endif +#if HAVE_UNISTD_H +# include +#endif +#include "f2c.h" + +/* Subroutine */ +#ifdef KR_headers +int G77_sleep_0 (seconds) + integer *seconds; +#else +int G77_sleep_0 (const integer *seconds) +#endif +{ + (void) sleep ((unsigned int) *seconds); + return 0; +} diff --git a/libf2c/libU77/srand_.c b/libf2c/libU77/srand_.c new file mode 100644 index 00000000000..8edc62e4fe0 --- /dev/null +++ b/libf2c/libU77/srand_.c @@ -0,0 +1,37 @@ +/* Copyright (C) 1995 Free Software Foundation, Inc. +This file is part of GNU Fortran libU77 library. + +This library is free software; you can redistribute it and/or modify it +under the terms of the GNU Library General Public License as published +by the Free Software Foundation; either version 2 of the License, or +(at your option) any later version. + +GNU Fortran is distributed in the hope that it will be useful, +but WITHOUT ANY WARRANTY; without even the implied warranty of +MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +Library General Public License for more details. + +You should have received a copy of the GNU Library General Public +License along with GNU Fortran; see the file COPYING.LIB. If +not, write to the Free Software Foundation, Inc., 59 Temple Place - Suite 330, +Boston, MA 02111-1307, USA. */ + +#ifdef HAVE_CONFIG_H +#include "config.h" +#endif +#if STDC_HEADERS +# include +#endif +#include "f2c.h" + +/* Subroutine */ +#ifdef KR_headers +int G77_srand_0 (seed) + integer *seed; +#else +int G77_srand_0 (const integer *seed) +#endif +{ + srand ((unsigned int) *seed); + return 0; +} diff --git a/libf2c/libU77/stat_.c b/libf2c/libU77/stat_.c new file mode 100644 index 00000000000..b24f3892221 --- /dev/null +++ b/libf2c/libU77/stat_.c @@ -0,0 +1,79 @@ +/* Copyright (C) 1995, 1997 Free Software Foundation, Inc. +This file is part of GNU Fortran libU77 library. + +This library is free software; you can redistribute it and/or modify it +under the terms of the GNU Library General Public License as published +by the Free Software Foundation; either version 2 of the License, or +(at your option) any later version. + +GNU Fortran is distributed in the hope that it will be useful, +but WITHOUT ANY WARRANTY; without even the implied warranty of +MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +Library General Public License for more details. + +You should have received a copy of the GNU Library General Public +License along with GNU Fortran; see the file COPYING.LIB. If +not, write to the Free Software Foundation, Inc., 59 Temple Place - Suite 330, +Boston, MA 02111-1307, USA. */ + +#ifdef HAVE_CONFIG_H +#include "config.h" +#endif +#include +#if HAVE_STDLIB_H +# include +#endif +#include +#include +#include "f2c.h" + +#ifdef KR_headers +void g_char (); + +integer G77_stat_0 (name, statb, Lname) + char *name; + integer statb[13]; + ftnlen Lname; +#else +void g_char(const char *a, ftnlen alen, char *b); + +integer G77_stat_0 (const char *name, integer statb[13], const ftnlen Lname) +#endif +{ + char *buff; + char *bp, *blast; + int err; + struct stat buf; + + buff = malloc (Lname+1); + if (buff == NULL) return -1; + g_char (name, Lname, buff); + err = stat (buff, &buf); + free (buff); + statb[0] = buf.st_dev; + statb[1] = buf.st_ino; + statb[2] = buf.st_mode; + statb[3] = buf.st_nlink; + statb[4] = buf.st_uid; + statb[5] = buf.st_gid; +#if HAVE_ST_RDEV + statb[6] = buf.st_rdev; /* not posix */ +#else + statb[6] = 0; +#endif + statb[7] = buf.st_size; + statb[8] = buf.st_atime; + statb[9] = buf.st_mtime; + statb[10] = buf.st_ctime; +#if HAVE_ST_BLKSIZE + statb[11] = buf.st_blksize; /* not posix */ +#else + statb[11] = -1; +#endif +#if HAVE_ST_BLOCKS + statb[12] = buf.st_blocks; /* not posix */ +#else + statb[12] = -1; +#endif + return err; +} diff --git a/libf2c/libU77/symlnk_.c b/libf2c/libU77/symlnk_.c new file mode 100644 index 00000000000..4b0bf24541d --- /dev/null +++ b/libf2c/libU77/symlnk_.c @@ -0,0 +1,64 @@ +/* Copyright (C) 1995, 1997 Free Software Foundation, Inc. +This file is part of GNU Fortran. + +GNU Fortran is free software; you can redistribute it and/or modify it +under the terms of the GNU Library General Public License as published +by the Free Software Foundation; either version 2 of the License, or +(at your option) any later version. + +GNU Fortran is distributed in the hope that it will be useful, +but WITHOUT ANY WARRANTY; without even the implied warranty of +MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +Library General Public License for more details. + +You should have received a copy of the GNU Library General Public +License along with GNU Fortran; see the file COPYING.LIB. If +not, write to the Free Software Foundation, Inc., 59 Temple Place - Suite 330, +Boston, MA 02111-1307, USA. */ + +#ifdef HAVE_CONFIG_H +#include "config.h" +#endif +#if HAVE_STDLIB_H +# include +#else +# include +#endif +#if HAVE_UNISTD_H +# include +#endif +#include +#if HAVE_SYS_PARAM_H +# include +#endif +#include "f2c.h" + +#ifdef KR_headers +void g_char (); + +integer G77_symlnk_0 (path1, path2, Lpath1, Lpath2) + char *path1, *path2; ftnlen Lpath1, Lpath2; +#else +void g_char(const char *a, ftnlen alen, char *b); + +integer G77_symlnk_0 (const char *path1, const char *path2, const ftnlen Lpath1, const ftnlen Lpath2) +#endif +{ +#if HAVE_SYMLINK + char *buff1, *buff2; + char *bp, *blast; + int i; + + buff1 = (char *) malloc (Lpath1+1); + if (buff1 == NULL) return -1; + g_char (path1, Lpath1, buff1); + buff2 = (char *) malloc (Lpath2+1); + if (buff2 == NULL) return -1; + g_char (path2, Lpath2, buff2); + i = symlink (buff1, buff2); + free (buff1); free (buff2); + return i ? errno : 0; +#else /* !HAVE_SYMLINK */ + return errno = ENOSYS; +#endif /* !HAVE_SYMLINK */ +} diff --git a/libf2c/libU77/sys_clock_.c b/libf2c/libU77/sys_clock_.c new file mode 100644 index 00000000000..47436ddd6b5 --- /dev/null +++ b/libf2c/libU77/sys_clock_.c @@ -0,0 +1,74 @@ +/* Copyright (C) 1996 Free Software Foundation, Inc. +This file is part of GNU Fortran libU77 library. + +This library is free software; you can redistribute it and/or modify it +under the terms of the GNU Library General Public License as published +by the Free Software Foundation; either version 2 of the License, or +(at your option) any later version. + +GNU Fortran is distributed in the hope that it will be useful, +but WITHOUT ANY WARRANTY; without even the implied warranty of +MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +Library General Public License for more details. + +You should have received a copy of the GNU Library General Public +License along with GNU Fortran; see the file COPYING.LIB. If +not, write to the Free Software Foundation, Inc., 59 Temple Place - Suite 330, +Boston, MA 02111-1307, USA. */ + +#ifdef HAVE_CONFIG_H +#include "config.h" +#endif +#if TIME_WITH_SYS_TIME +# include +# include +#else +# if HAVE_SYS_TIME_H +# include +# else +# include +# endif +#endif +#if HAVE_SYS_TIMES_H +# include +#endif +#include +#if HAVE_UNISTD_H +# include +#endif +#include /* for ENOSYS */ +#include "f2c.h" + +#ifdef KR_headers +int G77_system_clock_0 (count, count_rate, count_max) + integer *count, *count_rate, *count_max; +#else +int G77_system_clock_0 (integer *count, integer *count_rate, integer *count_max) +#endif +{ +#if defined (HAVE_TIMES) + struct tms buffer; + unsigned long cnt; +#ifdef _SC_CLK_TCK + *count_rate = sysconf(_SC_CLK_TCK); +#elif defined CLOCKS_PER_SECOND + *count_rate = CLOCKS_PER_SECOND; +#elif defined CLK_TCK + *count_rate = CLK_TCK; +#elif defined HZ + *count_rate = HZ; +#else + #error Dont know clock tick length +#endif + *count_max = INT_MAX; /* dubious */ + cnt = times (&buffer); + if (cnt > (unsigned long) (*count_max)) + *count = *count_max; /* also dubious */ + else + *count = cnt; + return 0; +#else /* ! HAVE_TIMES */ + errno = ENOSYS; + return -1; +#endif /* ! HAVE_TIMES */ +} diff --git a/libf2c/libU77/time_.c b/libf2c/libU77/time_.c new file mode 100644 index 00000000000..73894b0b413 --- /dev/null +++ b/libf2c/libU77/time_.c @@ -0,0 +1,46 @@ +/* Copyright (C) 1995 Free Software Foundation, Inc. +This file is part of GNU Fortran libU77 library. + +This library is free software; you can redistribute it and/or modify it +under the terms of the GNU Library General Public License as published +by the Free Software Foundation; either version 2 of the License, or +(at your option) any later version. + +GNU Fortran is distributed in the hope that it will be useful, +but WITHOUT ANY WARRANTY; without even the implied warranty of +MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +Library General Public License for more details. + +You should have received a copy of the GNU Library General Public +License along with GNU Fortran; see the file COPYING.LIB. If +not, write to the Free Software Foundation, Inc., 59 Temple Place - Suite 330, +Boston, MA 02111-1307, USA. */ + +#ifdef HAVE_CONFIG_H +#include "config.h" +#endif +#include +#if TIME_WITH_SYS_TIME +# include +# include +#else +# if HAVE_SYS_TIME_H +# include +# else +# include +# endif +#endif +#include "f2c.h" + +/* As well as this external function some compilers have an intrinsic + subroutine which fills a character argument (which is the VMS way) + -- caveat emptor. */ +#ifdef KR_headers +longint G77_time_0 () +#else +longint G77_time_0 (void) +#endif +{ + /* There are potential problems with the cast of the time_t here. */ + return time (NULL); +} diff --git a/libf2c/libU77/ttynam_.c b/libf2c/libU77/ttynam_.c new file mode 100644 index 00000000000..cb1d1e9a35c --- /dev/null +++ b/libf2c/libU77/ttynam_.c @@ -0,0 +1,64 @@ +/* Copyright (C) 1995, 1996 Free Software Foundation, Inc. +This file is part of GNU Fortran libU77 library. + +This library is free software; you can redistribute it and/or modify it +under the terms of the GNU Library General Public License as published +by the Free Software Foundation; either version 2 of the License, or +(at your option) any later version. + +GNU Fortran is distributed in the hope that it will be useful, +but WITHOUT ANY WARRANTY; without even the implied warranty of +MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +Library General Public License for more details. + +You should have received a copy of the GNU Library General Public +License along with GNU Fortran; see the file COPYING.LIB. If +not, write to the Free Software Foundation, Inc., 59 Temple Place - Suite 330, +Boston, MA 02111-1307, USA. */ + +#ifdef HAVE_CONFIG_H +#include "config.h" +#endif +#include +#if STDC_HEADERS +# include +#endif +#if HAVE_UNISTD_H +# include /* POSIX for ttyname */ +#endif +#include +#if HAVE_STRING_H +# include +#else +# include +#endif +#include /* for ENOSYS */ +#include "f2c.h" + +#ifdef KR_headers +extern void s_copy (); +extern integer G77_fnum_0 (); +/* Character */ void G77_ttynam_0 (ret_val, ret_val_len, lunit) + char *ret_val; ftnlen ret_val_len; integer *lunit +#else +extern integer G77_fnum_0 (integer *lunit); +extern void s_copy(register char *a, register char *b, ftnlen la, ftnlen lb); +/* Character */ void G77_ttynam_0 (char *ret_val, ftnlen ret_val_len, integer *lunit) +#endif +{ +#if defined (HAVE_TTYNAME) + size_t i; + char *p; + + p = ttyname (G77_fnum_0 (lunit)); + if (p != NULL) { + i = strlen (p); + s_copy (ret_val, p, ret_val_len, i); + } else { + s_copy (ret_val, " ", ret_val_len, 1); + } +#else + errno = ENOSYS; + return -1; +#endif +} diff --git a/libf2c/libU77/u77-test.f b/libf2c/libU77/u77-test.f new file mode 100644 index 00000000000..11c5ecae449 --- /dev/null +++ b/libf2c/libU77/u77-test.f @@ -0,0 +1,178 @@ +*** Some random stuff for testing libU77. Should be done better. It's +* hard to test things where you can't guarantee the result. Have a +* good squint at what it prints, though detected errors will cause +* starred messages. + + integer i, j, k, ltarray (9), idat (3), count, rate, count_max, + + pid + real tarray1(2), tarray2(2), r1, r2, etime + intrinsic getpid, getuid, getgid, ierrno, gerror, + + fnum, isatty, getarg, access, unlink, fstat, + + stat, lstat, getcwd, gmtime, hostnm, etime, chmod, + + chdir, fgetc, fputc, system_clock, second, idate, secnds, + + time, ctime, fdate, ttynam + external lenstr + logical l + character gerr*80, c*1 + character ctim*25, line*80, lognam*20, wd*100, line2*80 + integer fstatb (13), statb (13) + integer *2 i2zero + + ctim = ctime(time()) + WRITE (6,'(A/)') '1 GNU libU77 test at: ' // ctim + write (6,'(A,I3,'', '',I3)') + + ' Logical units 5 and 6 correspond (FNUM) to' + + // ' Unix i/o units ', fnum(5), fnum(6) + if (lnblnk('foo ').ne.3 .or. len_trim('foo ').ne.3) then + print *, 'LNBLNK or LEN_TRIM failed' + call exit(1) + end if + l= isatty(6) + line2 = ttynam(6) + if (l) then + line = 'and 6 is a tty device (ISATTY) named '//line2 + else + line = 'and 6 isn''t a tty device (ISATTY)' + end if + write (6,'(1X,A)') line(:lenstr(line)) + pid = getpid() + WRITE (6,'(A,I10)') ' Process id (GETPID): ', pid + WRITE (6,'(A,I10)') ' User id (GETUID): ', GETUID () + WRITE (6,'(A,I10)') ' Group id (GETGID): ', GETGID () + WRITE (6,*) 'If you have the `id'' program, the following call of' + + // ' SYSTEM should agree with the above' + call flush(6) + CALL SYSTEM ('echo " " `id`') + call flush + call getlog (lognam) + write (6,*) 'Login name (GETLOG): ', lognam + call umask(0, mask) + write(6,*) 'UMASK returns', mask + call umask(mask) + ctim = fdate() + write (6,*) 'FDATE returns: ', ctim + j=time() + call ltime (j, ltarray) + write (6,'(1x,a,9i4)') 'LTIME returns:', ltarray + call gmtime (j, ltarray) + write (6,'(1x,a,9i4)') 'GMTIME returns:', ltarray + call system_clock(count, rate, count_max) + write(6,*) 'SYSTEM_CLOCK returns: ', count, rate, count_max + write (6,*) 'Sleeping for 1 second (SLEEP) ...' + call sleep (1) + write (6,*) 'Looping 10,000,000 times ...' + do i=1,10*1000*1000 + end do + r1= etime (tarray1) + if (r1.ne.tarray1(1)+tarray1(2)) + + write (6,*) '*** ETIME didn''t return sum of the array: ', + + r1, ' /= ', tarray1 + r2= dtime (tarray2) + if (abs (r1-r2).gt.1.0) write (6,*) + + 'Results of ETIME and DTIME differ by more than a second:', + + i, j + write (6,'(A,3F10.3)') + + ' Elapsed total, user, system time (ETIME): ', + + r1, tarray1 + call idate(i,j,k) + call idate (idat) + write (6,*) 'IDATE d,m,y: ',idat + print *, '... and the VXT version: ', i,j,k + call time(line(:8)) + print *, line(:8) + write (6,*) 'SECNDS(0.0) returns: ',secnds(0.0) + write (6,*) 'SECOND returns: ', second() + call dumdum(r1) + call second(r1) + write (6,*) 'CALL SECOND returns: ', r1 + i = getcwd(wd) + if (i.ne.0) then + call perror ('*** getcwd') + else + write (6,*) 'Current directory is "'//wd(:lenstr(wd))//'"' + end if + call chdir ('.',i) + if (i.ne.0) write (6,*) '***CHDIR to ".": ', i + i=hostnm(wd) + if(i.ne.0) then + call perror ('*** hostnm') + else + write (6,*) 'Host name is ', wd(:lenstr(wd)) + end if + i = access('/dev/null ', 'rw') + if (i.ne.0) write (6,*) '***Read/write ACCESS to /dev/null: ', i + write (6,*) 'Creating file "foo" for testing...' + open (3,file='foo',status='UNKNOWN') + rewind 3 + call fputc(3, 'c',i) + call fputc(3, 'd',j) + if (i+j.ne.0) write(6,*) '***FPUTC: ', i +C why is it necessary to reopen? + close(3) + open(3,file='foo',status='old') + call fseek(3,0,0,*10) + go to 20 + 10 write(6,*) '***FSEEK failed' + 20 call fgetc(3, c,i) + if (i.ne.0) write(6,*) '***FGETC: ', i + if (c.ne.'c') write(6,*) '***FGETC read the wrong thing: ', + + ichar(c) + i= ftell(3) + if (i.ne.1) write(6,*) '***FTELL offset: ', i + call chmod ('foo', 'a+w',i) + if (i.ne.0) write (6,*) '***CHMOD of "foo": ', i + i = fstat (3, fstatb) + if (i.ne.0) write (6,*) '***FSTAT of "foo": ', i + i = stat ('foo', statb) + if (i.ne.0) write (6,*) '***STAT of "foo": ', i + write (6,*) ' with stat array ', statb + if (statb(5).ne.getuid () .or. statb(6).ne.getgid() .or. statb(4) + + .ne. 1) write (6,*) '*** FSTAT uid, gid or nlink is wrong' + do i=1,13 + if (fstatb (i) .ne. statb (i)) + + write (6,*) '*** FSTAT and STAT don''t agree on '// ' + + array element ', i, ' value ', fstatb (i), statb (i) + end do + i = lstat ('foo', fstatb) + do i=1,13 + if (fstatb (i) .ne. statb (i)) + + write (6,*) '*** LSTAT and STAT don''t agree on '// ' + + array element ', i, ' value ', fstatb (i), statb (i) + end do + +C in case it exists already: + call unlink ('bar',i) + call link ('foo ', 'bar ',i) + if (i.ne.0) + + write (6,*) '***LINK "foo" to "bar" failed: ', i + call unlink ('foo',i) + if (i.ne.0) write (6,*) '***UNLINK "foo" failed: ', i + call unlink ('foo',i) + if (i.eq.0) write (6,*) '***UNLINK "foo" again: ', i + call gerror (gerr) + i = ierrno() + write (6,'(A,I3,A/1X,A)') ' The current error number is: ', + + i, + + ' and the corresponding message is:', gerr(:lenstr(gerr)) + write (6,*) 'This is sent to stderr prefixed by the program name' + call getarg (0, line) + call perror (line (:lenstr (line))) + call unlink ('bar') + WRITE (6,*) 'You should see exit status 1' + CALL EXIT(1) + 99 END + + integer function lenstr (str) +C return length of STR not including trailing blanks, but always +C return >0 + character *(*) str + if (str.eq.' ') then + lenstr=1 + else + lenstr = lnblnk (str) + end if + end +* just make sure SECOND() doesn't "magically" work the second time. + subroutine dumdum(r) + r = 3.14159 + end diff --git a/libf2c/libU77/umask_.c b/libf2c/libU77/umask_.c new file mode 100644 index 00000000000..203acfa916f --- /dev/null +++ b/libf2c/libU77/umask_.c @@ -0,0 +1,34 @@ +/* Copyright (C) 1996 Free Software Foundation, Inc. +This file is part of GNU Fortran libU77 library. + +This library is free software; you can redistribute it and/or modify it +under the terms of the GNU Library General Public License as published +by the Free Software Foundation; either version 2 of the License, or +(at your option) any later version. + +GNU Fortran is distributed in the hope that it will be useful, +but WITHOUT ANY WARRANTY; without even the implied warranty of +MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +Library General Public License for more details. + +You should have received a copy of the GNU Library General Public +License along with GNU Fortran; see the file COPYING.LIB. If +not, write to the Free Software Foundation, Inc., 59 Temple Place - Suite 330, +Boston, MA 02111-1307, USA. */ + +#ifdef HAVE_CONFIG_H +#include "config.h" +#endif +#include +#include +#include "f2c.h" + +#ifdef KR_headers +integer G77_umask_0 (mask) + integer *mask; +#else +integer G77_umask_0 (integer *mask) +#endif +{ + return umask ((mode_t) *mask); +} diff --git a/libf2c/libU77/unlink_.c b/libf2c/libU77/unlink_.c new file mode 100644 index 00000000000..cd00559b29a --- /dev/null +++ b/libf2c/libU77/unlink_.c @@ -0,0 +1,57 @@ +/* Copyright (C) 1995, 1997 Free Software Foundation, Inc. +This file is part of GNU Fortran libU77 library. + +This library is free software; you can redistribute it and/or modify it +under the terms of the GNU Library General Public License as published +by the Free Software Foundation; either version 2 of the License, or +(at your option) any later version. + +GNU Fortran is distributed in the hope that it will be useful, +but WITHOUT ANY WARRANTY; without even the implied warranty of +MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +Library General Public License for more details. + +You should have received a copy of the GNU Library General Public +License along with GNU Fortran; see the file COPYING.LIB. If +not, write to the Free Software Foundation, Inc., 59 Temple Place - Suite 330, +Boston, MA 02111-1307, USA. */ + +#ifdef HAVE_CONFIG_H +#include "config.h" +#endif +#if HAVE_STDLIB_H +# include +#else +# include +#endif +#if HAVE_UNISTD_H +# include +#endif +#include +#if HAVE_SYS_PARAM_H +# include +#endif +#include "f2c.h" + +#ifdef KR_headers +void g_char (); + +integer G77_unlink_0 (str, Lstr) + char *str; ftnlen Lstr; +#else +void g_char(const char *a, ftnlen alen, char *b); + +integer G77_unlink_0 (const char *str, const ftnlen Lstr) +#endif +{ + char *buff; + char *bp, *blast; + int i; + + buff = malloc (Lstr+1); + if (buff == NULL) return -1; + g_char (str, Lstr, buff); + i = unlink (buff); + free (buff); + return i ? errno : 0; /* SGI version returns -1 on failure. */ +} diff --git a/libf2c/libU77/vxtidate_.c b/libf2c/libU77/vxtidate_.c new file mode 100644 index 00000000000..c517f29419e --- /dev/null +++ b/libf2c/libU77/vxtidate_.c @@ -0,0 +1,55 @@ +/* Copyright (C) 1995, 1996 Free Software Foundation, Inc. +This file is part of GNU Fortran libU77 library. + +This library is free software; you can redistribute it and/or modify it +under the terms of the GNU Library General Public License as published +by the Free Software Foundation; either version 2 of the License, or +(at your option) any later version. + +GNU Fortran is distributed in the hope that it will be useful, +but WITHOUT ANY WARRANTY; without even the implied warranty of +MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +Library General Public License for more details. + +You should have received a copy of the GNU Library General Public +License along with GNU Fortran; see the file COPYING.LIB. If +not, write to the Free Software Foundation, Inc., 59 Temple Place - Suite 330, +Boston, MA 02111-1307, USA. */ + +#ifdef HAVE_CONFIG_H +#include "config.h" +#endif +#include +#if TIME_WITH_SYS_TIME +# include +# include +#else +# if HAVE_SYS_TIME_H +# include +# else +# include +# endif +#endif +#include "f2c.h" + +/* VMS and Irix versions (at least) differ from libU77 elsewhere */ + +/* VMS style: */ + +/* Subroutine */ +#ifdef KR_headers +int G77_vxtidate_0 (m, d, y) + integer *y, *m, *d; +#else +int G77_vxtidate_0 (integer *m, integer *d, integer *y) +#endif +{ + struct tm *lt; + time_t tim; + tim = time(NULL); + lt = localtime(&tim); + *y = lt->tm_year; + *m = lt->tm_mon+1; + *d = lt->tm_mday; + return 0; +} diff --git a/libf2c/libU77/vxttime_.c b/libf2c/libU77/vxttime_.c new file mode 100644 index 00000000000..054bb45a89a --- /dev/null +++ b/libf2c/libU77/vxttime_.c @@ -0,0 +1,54 @@ +/* Copyright (C) 1995 Free Software Foundation, Inc. +This file is part of GNU Fortran libU77 library. + +This library is free software; you can redistribute it and/or modify it +under the terms of the GNU Library General Public License as published +by the Free Software Foundation; either version 2 of the License, or +(at your option) any later version. + +GNU Fortran is distributed in the hope that it will be useful, +but WITHOUT ANY WARRANTY; without even the implied warranty of +MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +Library General Public License for more details. + +You should have received a copy of the GNU Library General Public +License along with GNU Fortran; see the file COPYING.LIB. If +not, write to the Free Software Foundation, Inc., 59 Temple Place - Suite 330, +Boston, MA 02111-1307, USA. */ + +#ifdef HAVE_CONFIG_H +#include "config.h" +#endif +#include +#if TIME_WITH_SYS_TIME +# include +# include +#else +# if HAVE_SYS_TIME_H +# include +# else +# include +# endif +#endif +#if HAVE_STRING_H +# include +#else +# include +#endif +#include "f2c.h" + +/* Subroutine */ +#ifdef KR_headers +void G77_vxttime_0 (chtime, Lchtime) + char chtime[8]; + ftnlen Lchtime; +#else +void G77_vxttime_0 (char chtime[8], const ftnlen Lchtime) +#endif +{ + time_t tim; + char *ctim; + tim = time(NULL); + ctim = ctime (&tim); + strncpy (chtime, ctim+11, 8); +} diff --git a/libf2c/permission.netlib b/libf2c/permission.netlib new file mode 100644 index 00000000000..261b719bc57 --- /dev/null +++ b/libf2c/permission.netlib @@ -0,0 +1,23 @@ +/**************************************************************** +Copyright 1990 - 1997 by AT&T, Lucent Technologies and Bellcore. + +Permission to use, copy, modify, and distribute this software +and its documentation for any purpose and without fee is hereby +granted, provided that the above copyright notice appear in all +copies and that both that the copyright notice and this +permission notice and warranty disclaimer appear in supporting +documentation, and that the names of AT&T, Bell Laboratories, +Lucent or Bellcore or any of their entities not be used in +advertising or publicity pertaining to distribution of the +software without specific, written prior permission. + +AT&T, Lucent and Bellcore disclaim all warranties with regard to +this software, including all implied warranties of +merchantability and fitness. In no event shall AT&T, Lucent or +Bellcore be liable for any special, indirect or consequential +damages or any damages whatsoever resulting from loss of use, +data or profits, whether in an action of contract, negligence or +other tortious action, arising out of or in connection with the +use or performance of this software. +****************************************************************/ + diff --git a/libf2c/readme.netlib b/libf2c/readme.netlib new file mode 100644 index 00000000000..e74898762e9 --- /dev/null +++ b/libf2c/readme.netlib @@ -0,0 +1,599 @@ + +====== old index for f2c, now "readme from f2c" ============ + +FILES: + +f2c.h Include file necessary for compiling output of the converter. + See the second NOTE below. + +f2c.1 Man page for f2c. + +f2c.1t Source for f2c.1 (to be processed by troff -man or nroff -man). + +libf77 Library of non I/O support routines the generated C may need. + Fortran main programs result in a C function named MAIN__ that + is meant to be invoked by the main() in libf77. + +libi77 Library of Fortran I/O routines the generated C may need. + Note that some vendors (e.g., BSD, Sun and MIPS) provide a + libF77 and libI77 that are incompatible with f2c -- they + provide some differently named routines or routines with the + names that f2c expects, but with different calling sequences. + On such systems, the recommended procedure is to merge + libf77 and libi77 into a single library, say libf2c, and to + install it where you can access it by specifying -lf2c . The + definition of link_msg in sysdep.c assumes this arrangement. + + Both libf77 and libi77 are bundles, meant to be unpacked by the + Bourne (or Korn) shell. MS-DOS users can use the MKS Toolkit + to unpack libf77 and libi77. + +libf2c.zip + Only available by ftp: combination of libf77 and libi77, with + Unix and PC makefiles. + +f2c.ps Postscript for a technical report on f2c. After you strip the + mail header, the first line should be "%!PS". + +fixes The complete change log, reporting bug fixes and other changes. + (Some recent change-log entries are given below). + +fc A shell script that uses f2c and imitates much of the behavior + of commonly found f77 commands. You will almost certainly + need to adjust some of the shell-variable assignments to make + this script work on your system. + + +SUBDIRECTORY: + +f2c/src Source for the converter itself, including a file of checksums + and source for a program to compute the checksums (to verify + correct transmission of the source), is available: ask netlib + (e.g., netlib@netlib.bell-labs.com) to + send all from f2c/src + If the checksums show damage to just a few source files, or if + the change log file (see "fixes" below) reports corrections to + some source files, you can request those files individually + "from f2c/src". For example, to get defs.h and xsum0.out, you + would ask netlib to + send defs.h xsum0.out from f2c/src + "all from f2c/src" is about 640 kilobytes long; for convenience + (and checksums), it includes copies of f2c.h, f2c.1, and f2c.1t. + + Tip: if asked to send over 99,000 bytes in one request, netlib + breaks the shipment into 1000 line pieces and sends each piece + separately (since otherwise some mailers might gag). To avoid + the hassle of reassembling the pieces, try to keep each request + under 99,000 bytes long. The final number in each line of + xsum0.out gives the length of each file in f2c/src. For + example, + send exec.c expr.c from f2c/src + send format.c format_data.c from f2c/src + will give you slightly less hassle than + send exec.c expr.c format.c format_data.c from f2c/src + Alternatively, if all the mailers in your return path allow + long messages, you can supply an appropriate mailsize line in + your netlib request, e.g. + mailsize 200k + send exec.c expr.c format.c format_data.c from f2c/src + + If you have trouble generating gram.c, you can ask netlib to + send gram.c from f2c/src + Then `xsum gram.c` should report + gram.c 5529f4f 58745 + Alternatively, if you have bison, you might get a working + gram.c by saying + make gram.c YACC=bison YFLAGS=-y + (but please do not complain if this gives a bad gram.c). + +NOTE: For now, you may exercise f2c by sending netlib a message whose + first line is "execute f2c" and whose remaining lines are + the Fortran 77 source that you wish to have converted. + Return mail brings you the resulting C, with f2c's error + messages between #ifdef uNdEfInEd and #endif at the end. + (To understand line numbers in the error messages, regard + the "execute f2c" line as line 0. It is stripped away by + the netlib software before f2c sees your Fortran input.) + Options described in the man page may be transmitted to + netlib by having the first line of input be a comment + whose first 6 characters are "c$f2c " and whose remaining + characters are the desired options, e.g., "c$f2c -R -u". + + You may say "execute f2c" in the Subject line instead of (but + *not* in addition to) in the first line of the message body. + + The incoming Fortran is saved, at least for a while. Don't + send any secrets! + + +BUGS: Please send bug reports (including the shortest example + you can find that illustrates the bug) to research!dmg + or dmg@bell-labs.com . You might first check whether + the bug goes away when you turn optimization off. + + +NOTE: f2c.h defines several types, e.g., real, integer, doublereal. + The definitions in f2c.h are suitable for most machines, but if + your machine has sizeof(double) > 2*sizeof(long), you may need + to adjust f2c.h appropriately. f2c assumes + sizeof(doublecomplex) = 2*sizeof(doublereal) + sizeof(doublereal) = sizeof(complex) + sizeof(doublereal) = 2*sizeof(real) + sizeof(real) = sizeof(integer) + sizeof(real) = sizeof(logical) + sizeof(real) = 2*sizeof(shortint) + EQUIVALENCEs may not be translated correctly if these + assumptions are violated. + + On machines, such as those using a DEC Alpha processor, on + which sizeof(short) == 2, sizeof(int) == sizeof(float) == 4, + and sizeof(long) == sizeof(double) == 8, it suffices to + modify f2c.h by removing the first occurrence of "long " + on each line containing "long ", e.g., by issuing the + commands + mv f2c.h f2c.h0 + sed 's/long //' f2c.h0 >f2c.h + On such machines, one can enable INTEGER*8 by uncommenting + the typedef of longint in f2c.h, so it reads + typedef long longint; + by compiling libI77 with -DAllow_TYQUAD, and by adjusting + libF77/makefile as described in libF77/README. + + Some machines may have sizeof(int) == 4 and + sizeof(long long) == 8. On such machines, adjust f2c.h + by changing "long int " to "long long ", e.g., by saying + mv f2c.h f2c.h0 + sed 's/long int /long long /' f2c.h0 >f2c.h + One can enable INTEGER*8 on such machines as described + above, but with + typedef long long longint; + + There exists a C compiler that objects to the lines + typedef VOID C_f; /* complex function */ + typedef VOID H_f; /* character function */ + typedef VOID Z_f; /* double complex function */ + in f2c.h . If yours is such a compiler, do two things: + 1. Complain to your vendor about this compiler bug. + 2. Find the line + #define VOID void + in f2c.h and change it to + #define VOID int + (For readability, the f2c.h lines shown above have had two + tabs inserted before their first character.) + +FTP: All the material described above is now available by anonymous + ftp from netlib.bell-labs.com (login: anonymous; Password: your + E-mail address; cd netlib/f2c). Note that you can say, e.g., + + cd /netlib/f2c/src + binary + prompt + mget *.Z + + to get all the .Z files in src. You must uncompress the .Z + files once you have a copy of them, e.g., by + + uncompress *.Z + + Subdirectory msdos contains two PC versions of f2c, + f2c.exe.Z and f2cx.exe.Z; the latter uses extended memory. + The README in that directory provides more details. + + Changes appear first in the f2c files available by E-mail + from netlib@netlib.bell-labs.com. If the deamons work right, + changed files are available the next day by ftp from + netlib.bell-labs.com. In due course, they reach other netlib servers. + +CHANGE NOTIFICATION: + Send the E-mail message + subscribe f2c + to netlib@netlib.bell-labs.com to request notification of new and + changed f2c files. (Beware that automatically sent change + notifications may reach you before changes have reached + ftp://netlib.bell-labs.com/netlib/f2c or to other netlib servers.) + Send the E-mail message + unsubscribe f2c + to recant your notification request. + +----------------- +Recent change log (partial) +----------------- + +Mon May 13 23:35:26 EDT 1996 + Recognize Fortran 90's /= as a synonym for .NE.. (<> remains a +synonym for .NE..) + Emit an empty int function of no arguments to supply an external +name to named block data subprograms (so they can be called somewhere +to force them to be loaded from a library). + Fix bug (memory fault) in handling the following illegal Fortran: + parameter(i=1) + equivalence(i,j) + end + Treat cdabs, cdcos, cdexp, cdlog, cdsin, and cdsqrt as synonyms for +the double complex intrinsics zabs, zcos, zexp, zlog, zsin, and zsqrt, +respectively, unless -cd is specified. + Recognize the Fortran 90 bit-manipulation intrinsics btest, iand, +ibclr, ibits, ibset, ieor, ior, ishft, and ishftc, unless -i90 is +specified. Note that iand, ieor, and ior are thus now synonyms for +"and", "xor", and "or", respectively. + Add three macros (bit_test, bit_clear, bit_set) to f2c.h for use +with btest, ibclr, and ibset, respectively. Add new functions +[lq]bit_bits, [lq]bit_shift, and [lq]_bit_cshift to libF77 for +use with ibits, ishft, and ishftc, respectively. + Add integer function ftell(unit) (returning -1 on error) and +subroutine fseek(unit, offset, whence, *) to libI77 (with branch to +label * on error). + +Tue May 14 23:21:12 EDT 1996 + Fix glitch (possible memory fault, or worse) in handling multiple +entry points with names over 28 characters long. + +Mon Jun 10 01:20:16 EDT 1996 + Update netlib E-mail and ftp addresses in f2c/readme and +f2c/src/readme (which are different files) -- to reflect the upcoming +breakup of AT&T. + libf77: trivial tweaks to F77_aloc.c and system_.c; Version.c not +changed. + libi77: Adjust rsli.c and lread.c so internal list input with too +few items in the input string will honor end= . + +Mon Jun 10 22:59:57 EDT 1996 + Add Bits_per_Byte to sysdep.h and adjust definition of Table_size +to depend on Bits_per_Byte (forcing Table_size to be a power of 2); in +lex.c, change "comstart[c & 0xfff]" to "comstart[c & (Table_size-1)]" +to avoid an out-of-range subscript on end-of-file. + +Wed Jun 12 00:24:28 EDT 1996 + Fix bug in output.c (dereferencing a freed pointer) revealed in + print * !np in out_call in output.c clobbered by free + end !during out_expr. + +Wed Jun 19 08:12:47 EDT 1996 + f2c.h: add types uinteger, ulongint (for libF77); add qbit_clear +and qbit_set macros (in a commented-out section) for integer*8. + For integer*8, use qbit_clear and qbit_set for ibclr and ibset. + libf77: add casts to unsigned in [lq]bitshft.c. + +Thu Jun 20 13:30:43 EDT 1996 + Complain at character*(*) in common (rather than faulting). + Fix bug in recognizing hex constants that start with "16#" (e.g., +16#1234abcd, which is a synonym for z'1234abcd'). + Fix bugs in constant folding of expressions involving btest, ibclr, +and ibset. + Fix bug in constant folding of rshift(16#80000000, -31) (on a 32-bit +machine; more generally, the bug was in constant folding of +rshift(ibset(0,NBITS-1), 1-NBITS) when f2c runs on a machine with +long ints having NBITS bits. + +Mon Jun 24 07:58:53 EDT 1996 + Adjust struct Literal and newlabel() function to accommodate huge +source files (with more than 32767 newlabel() invocations). + Omit .c file when the .f file has a missing final end statement. + +Wed Jun 26 14:00:02 EDT 1996 + libi77: Add discussion of MXUNIT (highest allowed Fortran unit number) +to libI77/README. + +Fri Jun 28 14:16:11 EDT 1996 + Fix glitch with -onetrip: the temporary variable used for nonconstant +initial loop variable values was recycled too soon. Example: + do i = j+1, k + call foo(i+1) ! temp for j+1 was reused here + enddo + end + +Tue Jul 2 16:11:27 EDT 1996 + formatdata.c: add a 0 to the end of the basetype array (for TYBLANK) +(an omission that was harmless on most machines). + expr.c: fix a dereference of NULL that was only possible with buggy +input, such as + subroutine $sub(s) ! the '$' is erroneous + character s*(*) + s(1:) = ' ' + end + +Sat Jul 6 00:44:56 EDT 1996 + Fix glitch in the intrinsic "real" function when applied to a +complex (or double complex) variable and passed as an argument to +some intrinsic functions. Example: + complex a + b = sqrt(real(a)) + end + Fix glitch (only visible if you do not use f2c's malloc and the +malloc you do use is defective in the sense that malloc(0) returns 0) +in handling include files that end with another include (perhaps +followed by comments). + Fix glitch with character*(*) arguments named "h" and "i" when +the body of the subroutine invokes the intrinsic LEN function. + Arrange that after a previous "f2c -P foo.f" has produced foo.P, +running "f2c foo.P foo.f" will produce valid C when foo.f contains + call sub('1234') + end + subroutine sub(msg) + end +Specifically, the length argument in "call sub" is now suppressed. +With or without foo.P, it is also now suppressed when the order of +subprograms in file foo.f is reversed: + subroutine sub(msg) + end + call sub('1234') + end + Adjust copyright notices to reflect AT&T breakup. + +Wed Jul 10 09:25:49 EDT 1996 + Fix bug (possible memory fault) in handling erroneously placed +and inconsistent declarations. Example that faulted: + character*1 w(8) + call foo(w) + end + subroutine foo(m) + data h /0.5/ + integer m(2) ! should be before data + end + Fix bug (possible fault) in handling illegal "if" constructions. +Example (that faulted): + subroutine foo(i,j) + if (i) then ! bug: i is integer, not logical + else if (j) then ! bug: j is integer, not logical + endif + end + Fix glitch with character*(*) argument named "ret_len" to a +character*(*) function. + +Wed Jul 10 23:04:16 EDT 1996 + Fix more glitches in the intrinsic "real" function when applied to a +complex (or double complex) variable and passed as an argument to +some intrinsic functions. Example: + complex a, b + r = sqrt(real(conjg(a))) + sqrt(real(a*b)) + end + +Thu Jul 11 17:27:16 EDT 1996 + Fix a memory fault associated with complicated, illegal input. +Example: + subroutine goo + character a + call foo(a) ! inconsistent with subsequent def and call + end + subroutine foo(a) + end + call foo(a) + end + +Wed Jul 17 19:18:28 EDT 1996 + Fix yet another case of intrinsic "real" applied to a complex +argument. Example: + complex a(3) + x = sqrt(real(a(2))) ! gave error message about bad tag + end + +Mon Aug 26 11:28:57 EDT 1996 + Tweak sysdep.c for non-Unix systems in which process ID's can be +over 5 digits long. + +Tue Aug 27 08:31:32 EDT 1996 + Adjust the ishft intrinsic to use unsigned right shifts. (Previously, +a negative constant second operand resulted in a possibly signed shift.) + +Thu Sep 12 14:04:07 EDT 1996 + equiv.c: fix glitch with -DKR_headers. + libi77: fmtlib.c: fix bug in printing the most negative integer. + +Fri Sep 13 08:54:40 EDT 1996 + Diagnose some illegal appearances of substring notation. + +Tue Sep 17 17:48:09 EDT 1996 + Fix fault in handling some complex parameters. Example: + subroutine foo(a) + double complex a, b + parameter(b = (0,1)) + a = b ! f2c faulted here + end + +Thu Sep 26 07:47:10 EDT 1996 + libi77: fmt.h: for formatted writes of negative integer*1 values, +make ic signed on ANSI systems. If formatted writes of integer*1 +values trouble you when using a K&R C compiler, switch to an ANSI +compiler or use a compiler flag that makes characters signed. + +Tue Oct 1 14:41:36 EDT 1996 + Give a better error message when dummy arguments appear in data +statements. + +Thu Oct 17 13:37:22 EDT 1996 + Fix bug in typechecking arguments to character and complex (or +double complex) functions; the bug could cause length arguments +for character arguments to be omitted on invocations appearing +textually after the first invocation. For example, in + subroutine foo + character c + complex zot + call goo(zot(c), zot(c)) + end +the length was omitted from the second invocation of zot, and +there was an erroneous error message about inconsistent calling +sequences. + +Wed Dec 4 13:59:14 EST 1996 + Fix bug revealed by + subroutine test(cdum,rdum) + complex cdum + rdum=cos(real(cdum)) ! "Unexpected tag 3 in opconv_fudge" + end + Fix glitch in parsing "DO 10 D0 = 1, 10". + Fix glitch in parsing + real*8 x + real*8 x ! erroneous "incompatible type" message + call foo(x) + end + lib[FI]77/makefile: add comment about omitting -x under Solaris. + +Mon Dec 9 23:15:02 EST 1996 + Fix glitch in parameter adjustments for arrays whose lower +bound depends on a scalar argument. Example: + subroutine bug(p,z,m,n) + integer z(*),m,n + double precision p(z(m):z(m) + n) ! p_offset botched + call foo(p(0), p(n)) + end + libi77: complain about non-positive rec= in direct read and write +statements. + libf77: trivial adjustments; Version.c not changed. + +Wed Feb 12 00:18:03 EST 1997 + output.c: fix (seldom problematic) glitch in out_call: put parens +around the ... in a test of the form "if (q->tag == TADDR && ...)". + vax.c: fix bug revealed in the "psi_offset =" assignment in the +following example: + subroutine foo(psi,m) + integer z(100),m + common /a/ z + double precision psi(z(m):z(m) + 10) + call foo(m+1, psi(0),psi(10)) + end + +Mon Feb 24 23:44:54 EST 1997 + For consistency with f2c's current treatment of adjacent character +strings in FORMAT statements, recognize a Hollerith string following +a string (and merge adjacent strings in FORMAT statements). + +Wed Feb 26 13:41:11 EST 1997 + New libf2c.zip, a combination of the libf77 and libi77 bundles (and +available only by ftp). + libf77: adjust functions with a complex output argument to permit +aliasing it with input arguments. (For now, at least, this is just +for possible benefit of g77.) + libi77: tweak to ftell_.c for systems with strange definitions of +SEEK_SET, etc. + +Tue Apr 8 20:57:08 EDT 1997 + libf77: [cz]_div.c: tweaks invisible on most systems (that may +improve things slightly with optimized compilation on systems that use +gratuitous extra precision). + libi77: fmt.c: adjust to complain at missing numbers in formats +(but still treat missing ".nnn" as ".0"). + +Fri Apr 11 14:05:57 EDT 1997 + libi77: err.c: attempt to make stderr line buffered rather than +fully buffered. (Buffering is needed for format items T and TR.) + +Thu Apr 17 22:42:43 EDT 1997 + libf77: add F77_aloc.o to makefile (and makefile.u in libf2c.zip). + +Fri Apr 25 19:32:09 EDT 1997 + libf77: add [de]time_.c (which may give trouble on some systems). + +Tue May 27 09:18:52 EDT 1997 + libi77: ftell_.c: fix typo that caused the third argument to be +treated as 2 on some systems. + +Mon Jun 9 00:04:37 EDT 1997 + libi77 (and libf2c.zip): adjust include order in err.c lread.c wref.c +rdfmt.c to include fmt.h (etc.) after system includes. Version.c not +changed. + +Mon Jun 9 14:29:13 EDT 1997 + src/gram.c updated; somehow it did not reflect the change of +19961001 to gram.dcl. + +Mon Jul 21 16:04:54 EDT 1997 + proc.c: fix glitch in logic for "nonpositive dimension" message. + libi77: inquire.c: always include string.h (for possible use with +-DNON_UNIX_STDIO); Version.c not changed. + +Thu Jul 24 17:11:23 EDT 1997 + Tweak "Notice" to reflect the AT&T breakup -- we missed it when +updating the copyright notices in the source files last summer. + Adjust src/makefile so malloc.o is not used by default, but can +be specified with "make MALLOC=malloc.o". + Add comments to src/README about the "CRAY" T3E. + +Tue Aug 5 14:53:25 EDT 1997 + Add definition of calloc to malloc.c; this makes f2c's malloc +work on some systems where trouble hitherto arose because references +to calloc brought in the system's malloc. (On sensible systems, +calloc is defined separately from malloc. To avoid confusion on +other systems, f2c/malloc.c now defines calloc.) + libi77: lread.c: adjust to accord with a change to the Fortran 8X +draft (in 1990 or 1991) that rescinded permission to elide quote marks +in namelist input of character data; to get the old behavior, compile +with F8X_NML_ELIDE_QUOTES #defined. wrtfmt.o: wrt_G: tweak to print +the right number of 0's for zero under G format. + +Sat Aug 16 05:45:32 EDT 1997 + libi77: iio.c: fix bug in internal writes to an array of character +strings that sometimes caused one more array element than required by +the format to be blank-filled. Example: format(1x). + +Wed Sep 17 00:39:29 EDT 1997 + libi77: fmt.[ch] rdfmt.c wrtfmt.c: tweak struct syl for machines +with 64-bit pointers and 32-bit ints that did not 64-bit align +struct syl (e.g., Linux on the DEC Alpha). This change should be +invisible on other machines. + +Sun Sep 21 22:05:19 EDT 1997 + libf77: [de]time_.c (Unix systems only): change return type to double. + +Current timestamps of files in "all from f2c/src", sorted by time, +appear below (mm/dd/year hh:mm:ss). To bring your source up to date, +obtain source files with a timestamp later than the time shown in your +version.c. Note that the time shown in the current version.c is the +timestamp of the source module that immediately follows version.c below: + + 8/05/1997 14:51:56 xsum0.out + 8/05/1997 14:42:48 version.c + 8/05/1997 10:31:26 malloc.c + 7/24/1997 17:10:55 README + 7/24/1997 17:00:57 makefile + 7/24/1997 16:06:19 Notice + 7/21/1997 12:58:44 proc.c + 2/19/1997 13:34:09 lex.c + 2/11/1997 23:39:14 vax.c +12/22/1996 11:51:22 output.c +12/04/1996 13:07:53 gram.exec +10/17/1996 13:10:40 putpcc.c +10/01/1996 14:36:18 gram.dcl +10/01/1996 14:36:18 init.c +10/01/1996 14:36:18 defs.h +10/01/1996 14:36:17 data.c + 9/17/1996 17:29:44 expr.c + 9/12/1996 12:12:46 equiv.c + 8/27/1996 8:30:32 intr.c + 8/26/1996 9:41:13 sysdep.c + 7/09/1996 10:41:13 format.c + 7/09/1996 10:40:45 names.c + 7/04/1996 9:58:31 formatdata.c + 7/04/1996 9:55:45 sysdep.h + 7/04/1996 9:55:43 put.c + 7/04/1996 9:55:41 pread.c + 7/04/1996 9:55:40 parse_args.c + 7/04/1996 9:55:40 p1output.c + 7/04/1996 9:55:38 niceprintf.c + 7/04/1996 9:55:37 misc.c + 7/04/1996 9:55:36 memset.c + 7/04/1996 9:55:36 mem.c + 7/04/1996 9:55:35 main.c + 7/04/1996 9:55:33 io.c + 7/04/1996 9:55:30 exec.c + 7/04/1996 9:55:29 error.c + 7/04/1996 9:55:27 cds.c + 7/03/1996 15:47:49 xsum.c + 6/19/1996 7:04:27 f2c.h + 6/19/1996 2:52:05 defines.h + 5/13/1996 0:40:32 gram.head + 5/12/1996 23:37:11 f2c.1 + 5/12/1996 23:37:02 f2c.1t + 2/25/1994 2:07:19 parse.h + 2/22/1994 19:07:20 iob.h + 2/22/1994 18:56:53 p1defs.h + 2/22/1994 18:53:46 output.h + 2/22/1994 18:51:14 names.h + 2/22/1994 18:30:41 format.h + 1/18/1994 18:12:52 tokens + 3/06/1993 14:13:58 gram.expr + 1/28/1993 9:03:16 ftypes.h + 4/06/1990 0:00:57 gram.io + 2/03/1990 0:58:26 niceprintf.h + 1/07/1990 1:20:01 usignal.h +11/27/1989 8:27:37 machdefs.h + 7/01/1989 11:59:44 pccdefs.h